; core of Fifth include 'define.inc' link = 0 org 0 lpad: xnum 1 ; load rest of core into RAM xnum 1024 xnum 3 xcall lload xnum 4 ; load highlevel Fifth boot code into RAM xnum 1500000 xnum 32 xcall lload xnum -1 ; initialize dictionary space xnum lend xnum 30000 xcfill xjmp lmain times 15 db '*PAD*' lload: ;( fromdisk tomem amount -- ) l46: xdup xif l45 xdec xpush xover xover xdisk@ xnum 1024 xplus xswap xinc xswap xpop xjmp l46 l45: xdrop xdrop xdrop xret ibuf: dd 0, 0, 0, 0, 0, 0, 0, 0 lh: dd last+24000 llp: dd lastp lcount: xinc xdup xdec xc@ xret vloc dd 200000h llemit: ; xemit xnum vloc x@ xdup xinc xnum vloc x! xc! xret lhere: xnum lh x@ xret lemit: xjmp llemit ltype: xdup xif l2 xdec xpush xcall lcount xcall lemit xpop xjmp ltype l2: xdrop xdrop xret lwrite: xcall lcount xcall ltype xret lsadd: xdup xc@ xinc xover xover xswap xc! xplus xc! xret llfkey: xnum d1 x@ xcall lcount xswap xnum d1 x! xret d1 dd 1500000 lfkey: xjmp llfkey lskey: xcall lfkey xdup xnum 254 xminus xif l47 xdup xnum 253 xminus xif l47 xret l47: xdrop xnum 255 xret lscan: xnum 0 xnum lpad xc! l4: xcall lskey xover xover xminus xif l3 xnum lpad xcall lsadd xjmp l4 l3: xdrop xnum lpad xc@ xif lscan xdrop xret lstrEQstr: xdup xc@ xinc l8: xdup xif l6 xdec xpush xover xc@ xover xc@ xminus xif l7 xpop xdrop xdrop xdrop xnum 0 xret l7: xinc xswap xinc xpop xjmp l8 l6: xdrop xdrop xdrop xnum -1 xret lstrEQpad: xnum lpad xjmp lstrEQstr lfind: xnum llp l9: xdup xnum lprev x! x@ xdup xif l11 xdup xinc xinc xinc xinc xcall lstrEQpad xif l9 l11: xret lprev: dd 0 lmode: db 1 ; 0 compile ; 1 interpret lgoto: xnum l44+1 x! l44: xjmp 0 lexecute: xnum lmode xc@ xif l19 xcall setint l19: xcall lfind xdup xif l12 ; not found ? xnum 19 xplus xdup xc@ ; ( addr+19 c ) xdup xif cmpnum xdec xdup xif cmpmod xdec xif cmpimm xdrop xjmp clrint setint: xnum l14 x@ xif l15 xret l14 dd 0 l15: xnum lh x@ xnum l14 x! xnum ibuf xnum lh x! xret clrint: xnum l14 x@ xif l20 xnum 11 xcall lcsto xnum l14 x@ xnum lh x! xnum 0 xnum l14 x! xjmp ibuf l20: xret cmpnum: xdrop xnum 3 xjmp cmpn cmpmod: xdrop xnum 5 xjmp cmpn cmpimm: xcall setint xnum 5 xjmp cmpn cmpn: xcall lcsto xinc x@ xcall lsto xjmp clrint l12: xdrop xcall l2num xif l23 xnum 3 xcall lcsto xcall lsto xjmp clrint l23: xdrop xnum lpad xcall lwrite xnum msg1 xcall lwrite xjmp clrint msg1 db 3, ' ? ' l2num: xnum lpad xcall lcount ; ( addr len ) xnum numlen xc! xnum 0 l13: xnum numlen ; ( addr num ) xc@ xdup xif numend xdec xnum numlen xc! xnum 16 xmul xswap xcall lcount ; ( num addr c ) xdup xnum 45 xminus xif l22 l28: xdup xnum 16 xcmpg xif l21 xdrop xdrop xnum 0 xret l21: xrot xplus ; ( addr num ) xjmp l13 numend: xdrop xswap xdrop xnum numneg xc@ xif l16 xnum -1 xmul xnum 0 xnum numneg xc! l16: xnum -1 xret numlen db 0 numneg db 0 l22: xnum numneg xc! xnum 0 xjmp l28 lcsto: xnum lh x@ xover xover ; ( n addr n addr ) xc! xinc xnum lh x! xdrop xret lsto: xnum lh x@ xover xover x! xnum 4 xplus xnum lh x! xdrop xret lhalt: xhalt l@: xnum 20 xjmp bcode l!: xnum 21 xjmp bcode lc@: xnum 12 xjmp bcode lc!: xnum 13 xjmp bcode linc: xnum 6 xjmp bcode ldec: xnum 7 xjmp bcode lcmpg: xnum 28 xjmp bcode lcmpl: xnum 29 xjmp bcode lret: xnum 11 xjmp bcode lplus: xnum 24 xjmp bcode lminus: xnum 25 xjmp bcode lmul: xnum 26 xjmp bcode ldrop: xnum 9 xjmp bcode ldup: xnum 8 xjmp bcode lswap: xnum 23 xjmp bcode ldisk@: xnum 18 xjmp bcode lpush: xnum 14 xjmp bcode lpop: xnum 15 xjmp bcode lover: xnum 22 xjmp bcode lcmove: xnum 43 xjmp bcode bcode: xnum lmode xc@ xif lcsto xnum l25 xc! l25: db 0 xret lne: xcall lfind xif lne3 xnum lpad xcall lwrite xnum msg2 xcall lwrite lne3: xnum sf ; pick next address x@ xdup xnum 24 xplus xdup xnum last+23999 xcmpg xif lne1 xdrop xnum last lne1: xnum sf x! xdup ; is cell empty x@ xinc xif lne2 xdrop xjmp lne3 lne2: xnum llp ; create entry x@ xover x! xdup xnum llp x! xnum lpad xover xinc xinc xinc xinc xnum 15 xcmove xnum 19 xplus xdup xinc xpush xc! xpop x! xret sf dd lend msg2 db 3, ' ! ' lcolon: xnum 255 xcall lscan xnum lh x@ xnum 1 xcall lne xnum 0 xnum lmode xc! xret lI: xnum 1 xnum lmode xc! xret ldadd: l27: xdup xif l26 xdec xpush xcall lcount xcall lcsto xpop xjmp l27 l26: xdrop xdrop xret lincmod: xcall lcount xjmp ldadd lif: xcall lhere xinc xnum d6 xcall lincmod l35: xnum 255 xcall lscan xnum d7 xcall lstrEQpad xif l36 xcall lhere xinc xnum d9 xcall lincmod xswap xcall lhere xswap x! xjmp l35 l36: xnum d8 xcall lstrEQpad xif l37 xcall lhere xswap x! xret l37: xcall lexecute xjmp l35 d6 db 5, 10, 0, 0, 0, 0 d7 db 4, 'else' d8 db 4, 'then' d9 db 5, 4, 0, 0, 0, 0 ldo: xcall lhere xinc xinc xnum d4 xcall lincmod l33: xnum 255 xcall lscan xnum d5 xcall lstrEQpad xif l34 xnum 15 xcall lsto xnum 4 xcall lcsto xdup xdec xdec xcall lsto xcall lhere xswap x! xnum 9 xcall lcsto xret l34: xcall lexecute xjmp l33 d4 db 8, 8, 10, 0, 0, 0, 0, 7, 14 d5 db 4, 'loop' lfor: xcall lhere xnum d10 xcall lincmod l38: xnum 255 xcall lscan xnum d5 xcall lstrEQpad xif l39 xnum d11 xcall lincmod xcall lhere xover xnum 5 xplus x! xinc xcall lhere xdec xdec xdec xdec x! xnum d12 xcall lincmod xret l39: xcall lexecute xjmp l38 d10 db 10, 14, 8, 31, 25, 10, 0,0,0,0, 14 d11 db 7, 15, 6, 4, 0,0,0,0 d12 db 3, 9, 15, 9 luntil: xnum d14 xcall lincmod xcall lhere l40: xnum 255 xcall lscan xnum d5 xcall lstrEQpad xif l41 xnum d15 xcall lincmod xcall lhere xnum 6 xminus x! xret l41: xcall lexecute xjmp l40 d14 db 6, 3, 0, 0, 0, 0, 14 d15 db 8, 31, 10, 0, 0, 0, 0, 15, 9 lmain: l32: xnum 255 xcall lscan xcall lexecute xjmp l32 last: head 2, 'lp', 0, llp head 5, 'count', 1, lcount head 4, 'emit', 1, lemit head 4, 'type', 1, ltype head 5, 'write', 1, lwrite head 3, 'pad', 0, lpad head 5, 'c+str', 1, lsadd head 4, 'fkey', 1, lfkey head 4, 'scan', 1, lscan head 8, 'str=str?', 1, lstrEQstr head 4, 'find', 1, lfind head 4, 'mode', 0, lmode head 4, 'goto', 1, lgoto head 7, 'execute', 1, lexecute head 4, '2num', 1, l2num head 2, 'c,', 1, lcsto head 1, ',', 1, lsto head 4, 'halt', 1, lhalt head 1, '@', 2, l@ head 1, '!', 2, l! head 2, 'c@', 2, lc@ head 2, 'c!', 2, lc! head 2, '1+', 2, linc head 2, '1-', 2, ldec head 1, '>', 2, lcmpg head 1, '<', 2, lcmpl head 3, 'ret', 2, lret head 1, '+', 2, lplus head 1, '-', 2, lminus head 1, '*', 2, lmul head 4, 'drop', 2, ldrop head 3, 'dup', 2, ldup head 4, 'swap', 2, lswap head 5, 'disk@', 2, ldisk@ head 4, 'push', 2, lpush head 3, 'pop', 2, lpop head 4, 'over', 2, lover head 5, 'cmove', 2, lcmove head 2, 'ne', 1, lne head 1, ':', 1, lcolon head 1, 'I', 2, lI head 5, 'bcode', 1, bcode head 4, 'dadd', 1, ldadd head 6, 'incmod', 1, lincmod head 2, 'if', 2, lif head 4, 'here', 1, lhere head 2, 'do', 2, ldo head 3, 'for', 2, lfor head 5, 'until', 2, luntil head 4, 'prev', 0, lprev head 4, 'skey', 1, lskey lastp: head 1, 'h', 0, lh lend: