From 9aba6b71f17627ef24b9f66f40a9cce1079371b3 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Wed, 3 Jan 2024 00:00:30 -0800 Subject: [PATCH] Lots of forth word verification --- src/mkrel | 9 +- src/samplesrc/gr.4th | 45 ----- src/samplesrc/plasma.4th | 95 ---------- src/{samplesrc => scripts}/bounce.4th | 0 src/{samplesrc => scripts}/grlib.4th | 0 src/scripts/plasma.4th | 82 +++++++++ src/toolsrc/plforth.pla | 243 ++++++++++++++++++-------- 7 files changed, 258 insertions(+), 216 deletions(-) delete mode 100644 src/samplesrc/gr.4th delete mode 100644 src/samplesrc/plasma.4th rename src/{samplesrc => scripts}/bounce.4th (100%) rename src/{samplesrc => scripts}/grlib.4th (100%) create mode 100644 src/scripts/plasma.4th diff --git a/src/mkrel b/src/mkrel index ece1bd1..b0cd5ff 100755 --- a/src/mkrel +++ b/src/mkrel @@ -202,12 +202,15 @@ cp samplesrc/lz4cat.pla prodos/bld/samples/LZ4CAT.PLA.TXT cp samplesrc/sfm.pla prodos/bld/samples/SFM.PLA.TXT cp samplesrc/sfmsprt.pla prodos/bld/samples/SFMSPRT.PLA.TXT cp samplesrc/fppow.pla prodos/bld/samples/FPPOW.PLA.TXT -cp samplesrc/plasma.4th prodos/bld/samples/PLASMA.4TH.TXT -cp samplesrc/grlib.4th prodos/bld/samples/GRLIB.4TH.TXT -cp samplesrc/bounce.4th prodos/bld/samples/BOUNCE.4TH.TXT cp utilsrc/apple/mon.pla prodos/bld/samples/MON.PLA.TXT cp utilsrc/apple/zipchip.pla prodos/bld/samples/ZIPCHIP.PLA.TXT +rm -rf prodos/scripts +mkdir prodos/scripts +cp scripts/plasma.4th prodos/scripts/PLASMA.4TH.TXT +cp scripts/grlib.4th prodos/scripts/GRLIB.4TH.TXT +cp scripts/bounce.4th prodos/scripts/BOUNCE.4TH.TXT + #mkdir prodos/bld/examples #cp samplesrc/examples/ex.1.pla prodos/bld/examples/EX.1.PLA.TXT #cp samplesrc/examples/ex.2.pla prodos/bld/examples/EX.2.PLA.TXT diff --git a/src/samplesrc/gr.4th b/src/samplesrc/gr.4th deleted file mode 100644 index d263e94..0000000 --- a/src/samplesrc/gr.4th +++ /dev/null @@ -1,45 +0,0 @@ -: GR ( set lores graphics mode ) - $FB40 0 0 0 0 CALL DROP -; -: TEXT - $FB39 0 0 0 0 CALL DROP -; -: COLOR ( color ) - $F864 SWAP 0 0 0 CALL DROP -; -: PLOT ( Y X ) - $F800 ROT ROT 0 SWAP 0 CALL DROP -; - -15 VARIABLE BALLCLR -10 VARIABLE BALLX -20 VARIABLE BALLY -10 VARIABLE OLDX -20 VARIABLE OLDY -1 VARIABLE INCX -1 VARIABLE INCY - -: MOVEBALL - BALLX @ 0= IF INCX @ NEG INCX ! THEN - BALLX @ 39 = IF INCX @ NEG INCX ! THEN - BALLY @ 0= IF INCY @ NEG INCY ! THEN - BALLY @ 37 = IF INCY @ NEG INCY ! THEN - INCX @ BALLX +! - INCY @ BALLY +! - BALLCLR @ COLOR - BALLY @ BALLX @ PLOT - 0 COLOR - OLDY @ OLDX @ PLOT - BALLX @ OLDX ! - BALLY @ OLDY ! -; - -: BOUNCE - GR - BEGIN - MOVEBALL - ?TERMINAL - UNTIL - KEY - TEXT -; diff --git a/src/samplesrc/plasma.4th b/src/samplesrc/plasma.4th deleted file mode 100644 index 9467509..0000000 --- a/src/samplesrc/plasma.4th +++ /dev/null @@ -1,95 +0,0 @@ -: IFACE 2 * + @ ; - -LOOKUP CMDSYS 0 IFACE CONSTANT PLASMA_VER -LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE -LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD -LOOKUP STRCPY PLASMA STRCPY -LOOKUP STRCAT PLASMA STRCAT - -: .PLASMAVER - PLASMA_VER 12 RSHIFT $0F AND 48 + EMIT - PLASMA_VER 8 RSHIFT $0F AND 48 + EMIT - 46 EMIT - PLASMA_VER 4 RSHIFT $0F AND 48 + EMIT - PLASMA_VER $0F AND 48 + EMIT -; - -: CPYCMD - CMDLINE " . " STRCPY DROP ( Need a dummy value for the module name ) - 34 WORD CMDLINE SWAP STRCAT DROP ( Quote deliminted string ) -; - -: CMDEXEC - CPYCMD - EXECMOD 0< IF ." Failed to exec module" CR THEN -; - -: LOADMOD - EXECMOD 0< IF ." Failed to load module" CR THEN -; - -: LOADMOD" - 34 WORD ( Quote deliminted string ) - LOADMOD -; - -: EDIT - " ED" EXECMOD 0< IF ." Failed to run ED" CR ABORT THEN -; - -: EDIT" - CPYCMD - " ED" EXECMOD 0< IF ." Failed to run ED" CR ABORT THEN -; - -: CAT - " CAT" EXECMOD 0< IF ." Failed to run CAT" CR ABORT THEN -; - -: CAT" - CPYCMD - " CAT" EXECMOD 0< IF ." Failed to run CAT" CR ABORT THEN -; - -: DEL" - CPYCMD - " DEL" EXECMOD 0< IF ." Failed to run DEL" CR ABORT THEN -; - -: REN" - CPYCMD - " REN" EXECMOD 0< IF ." Failed to run REN" CR ABORT THEN -; - -: COPY" - CPYCMD - " COPY" EXECMOD 0< IF ." Failed to run COPY" CR ABORT THEN -; - -: NEWDIR" - CPYCMD - " NEWDIR" EXECMOD 0< IF ." Failed to run NEWDIR" CR ABORT THEN -; - - -( LOADMOD" FILEIO" FILEIO is already available in plforth ) - -LOOKUP FILEIO CONSTANT FILEIOAPI -FILEIOAPI 0 IFACE PLASMA GETPFX -FILEIOAPI 1 IFACE PLASMA SETPFX - -: .PFX - HERE GETPFX HERE (.") -; - -: SETPFX" - 34 WORD SETPFX DROP -; - -( LOADMOD" CONIO" CONIO is already available in plforth ) - -LOOKUP CONIO CONSTANT CONIOAPI -CONIOAPI 3 IFACE PLASMA HOME -CONIOAPI 4 IFACE PLASMA GOTOXY -CONIOAPI 11 IFACE PLASMA TONE -CONIOAPI 12 IFACE PLASMA RAND diff --git a/src/samplesrc/bounce.4th b/src/scripts/bounce.4th similarity index 100% rename from src/samplesrc/bounce.4th rename to src/scripts/bounce.4th diff --git a/src/samplesrc/grlib.4th b/src/scripts/grlib.4th similarity index 100% rename from src/samplesrc/grlib.4th rename to src/scripts/grlib.4th diff --git a/src/scripts/plasma.4th b/src/scripts/plasma.4th new file mode 100644 index 0000000..8d30f11 --- /dev/null +++ b/src/scripts/plasma.4th @@ -0,0 +1,82 @@ +: IFACE 2 * + @ ; + +LOOKUP CMDSYS 0 IFACE CONSTANT PLASMA_VER +LOOKUP CMDSYS 2 IFACE CONSTANT CMDLINE +LOOKUP CMDSYS 3 IFACE PLASMA EXECMOD +LOOKUP STRCPY PLASMA STRCPY +LOOKUP STRCAT PLASMA STRCAT + +: .PLASMAVER + PLASMA_VER 12 RSHIFT $0F AND 48 + EMIT + PLASMA_VER 8 RSHIFT $0F AND 48 + EMIT + 46 EMIT + PLASMA_VER 4 RSHIFT $0F AND 48 + EMIT + PLASMA_VER $0F AND 48 + EMIT +; + +: LOADMOD ( modulename paramstr -- ) + CMDLINE " . " STRCPY DROP ( Dummy parameter for module name ) + CMDLINE SWAP STRCAT DROP + EXECMOD 0< ABORT" Failed to load module" +; + +: LOADMOD" ( modulename -- ) + PAD SWAP STRCPY ( Move module name out of the way in case its immediate ) + [ ' " CFA @ ] LITERAL EXECUTE ( Exec word to build a string from input ) + LOADMOD +; + +: EDIT + " ED" " " LOADMOD +; + +: EDIT" + " ED" LOADMOD" +; + +: CAT + " CAT" " " LOADMOD +; + +: CAT" + " CAT" LOADMOD" +; + +: DEL" + " DEL" LOADMOD" +; + +: REN" + " REN" LOADMOD" +; + +: COPY" + " COPY" LOADMOD" +; + +: NEWDIR" + " NEWDIR" LOADMOD" +; + + +( LOADMOD" FILEIO" FILEIO is already available in plforth ) + +LOOKUP FILEIO CONSTANT FILEIOAPI +FILEIOAPI 0 IFACE PLASMA GETPFX +FILEIOAPI 1 IFACE PLASMA SETPFX + +: .PFX + HERE GETPFX DROP HERE (.") +; + +: SETPFX" + 34 WORD SETPFX DROP +; + +( LOADMOD" CONIO" CONIO is already available in plforth ) + +LOOKUP CONIO CONSTANT CONIOAPI +CONIOAPI 3 IFACE PLASMA HOME +CONIOAPI 4 IFACE PLASMA GOTOXY +CONIOAPI 11 IFACE PLASMA TONE +CONIOAPI 12 IFACE PLASMA RAND diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index 67d603e..3d527d3 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -7,15 +7,19 @@ include "inc/longjmp.plh" // Internal variables // word vlist -word startheap, arg, infunc, inptr, IIP, W, exit +word startheap, arg, infunc, inptr, IIP, W const keyinbuf = $1FF const SRCREFS = 2 const INBUF_SIZE = 81 byte srclevel = 0 +word inbufptr byte inref[SRCREFS] word previnptr[SRCREFS] -char inbuf[SRCREFS * INBUF_SIZE] -word inbufptr +// +// Internal buffers +// +res[SRCREFS * INBUF_SIZE] inbuf +res[t_except] exit // // RSTACK // @@ -33,6 +37,7 @@ word hashtbl[HASH_SIZE] // const exit_flag = $01 const trace_flag = $02 +const step_flag = $04 const comp_itc_flag = $10 const comp_pbc_flag = $20 const comp_flag = comp_itc_flag | comp_pbc_flag @@ -42,9 +47,9 @@ const comp_flag = comp_itc_flag | comp_pbc_flag byte comp_mode = comp_itc_flag byte state = 0 byte savestate = 0 -byte brk = 0 word brkentry = 0 word brkcfa = 0 +byte brk = 0 byte _get_estack = $8A // TXA byte = $49, $FF // EOR #$FF byte = $38 // SEC @@ -97,19 +102,22 @@ predef _ffa_(a)#1, _lfa_(a)#1, _hfa_(a)#1, _cfa_(a)#1, _pfa_(a)#1, _allot_(a)#0 predef _eq_(a,b)#1, _gt_(a,b)#1, _lt_(a,b)#1, _0lt_(a)#1, _0eq_(a)#1 predef _branch_#0, _0branch_(a)#0, _if_#0, _else_#0, _then_#0 predef _begin_#0, _again_#0, _until_#0, _while_#0, _repeat_#0 -predef _case_#0, _of_#0, _endof_#0, _endcase_#0, _literal_(a)#0 +predef _case_#0, _of_#0, _endof_#0, _endcase_#0, _literal_(a)#0, _iscomp_#1 predef _do_#0, _doloop_#0, _doplusloop_(a)#0, _plusloop_#0, _loop_#0, _leave_#0, _j_#1 predef _create_#0, _itcdoes_(a)#0, _does_#0, _compoff_#0, _compon_#0 -predef _forcecomp_#0, pfillw(a)#0, pfillb(a)#0, _colon_#0, _semi_#0 +predef _compcomp_#0, pfillw(a)#0, pfillb(a)#0, _colon_#0, _semi_#0 +predef _immediate_#0, _exit_#0, _pad_#1 predef _tors_(a)#0, _fromrs_#1, _toprs_#1, _execute_(a)#0, _lookup_#1 predef _cmove_(a,b,c)#0, _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0 predef _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _find_(a)#2, _tick_#1 predef _forget_#0, _terminal_#1, _prat_(a)#0, _str_#0, _prstr_#0 predef _src_(a)#0, _srcstr_#0, _query_#0, _expect_(a,b)#0, _type_(a,b)#0 -predef _vlist_#0, _tron_#0, _troff_#0, _itc_#0, _pbc_#0, _comment_#0 +predef _vlist_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0 +predef _itc_#0, _pbc_#0, _comment_#0, _docompile_(a)#0 predef _brkout_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2 predef _space_#0, _spaces_(a)#0, _show_#0, _showstack_#0, _showrstack_#0 -predef _showhash_#0, _cont_#0, _restart_#0, _bye_#0, _quit_#0, _abort_#0 +predef _showhash_#0, _cont_#0, _restart_#0, _bye_#0, _quit_#0 +predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0 // DROP char d_drop = "DROP" byte = inline_flag @@ -278,10 +286,14 @@ word = @d_plasma, 0, @_var_ char d_const = "CONSTANT" byte = 0 word = @d_var, 0, @_const_ +// COMPILING? +char d_iscomp = "?COMP" +byte = 0 +word = @d_const, 0, @_iscomp_ // CMOVE char d_cmove = "CMOVE" byte = 0 -word = @d_const, 0, @_cmove_ +word = @d_iscomp, 0, @_cmove_ // MOVE char d_move = "MOVE" byte = 0 @@ -294,10 +306,14 @@ word = @d_move, 0, @_fill_ char d_here = "HERE" byte = 0 word = @d_fill, 0, @heapmark +// PAD +char d_pad = "PAD" +byte = 0 +word = @d_here, 0, @_pad_ // ALLOT char d_allot = "ALLOT" byte = 0 -word = @d_here, 0, @_allot_ +word = @d_pad, 0, @_allot_ // BRANCH char d_branch = "(BRANCH)" byte = componly_flag | param_flag @@ -426,14 +442,26 @@ word = @d_colon, 0, @_compoff_ char d_compon = "]" byte = imm_flag word = @d_compoff, 0, @_compon_ -// FORCE COMPILE -char d_forcecomp = "[COMPILE]" +// COMPILE NEXT WORD +char d_compcomp = "[COMPILE]" byte = imm_flag -word = @d_compon, 0, @_forcecomp_ +word = @d_compon, 0, @_compcomp_ +// DO COMPILE +char d_docomp = "(COMPILE)" +byte = 0 +word = @d_compcomp, 0, @_docompile_ +// IMMEDIATE +char d_immediate = "IMMEDIATE" +byte = imm_flag +word = @d_docomp, 0, @_immediate_ +// EXIT +char d_exit = "EXIT" +byte = imm_flag +word = @d_immediate, 0, @_exit_ // SEMI char d_semi = ";" byte = imm_flag -word = @d_forcecomp, 0, @_semi_ +word = @d_exit, 0, @_semi_ // COUNT char d_count = "COUNT" byte = 0 @@ -446,18 +474,22 @@ word = @d_count, 0, @_find_ char d_tick = "'" byte = imm_flag word = @d_find, 0, @_tick_ +// CFA +char d_cfa = "CFA" +byte = 0 +word = @d_tick, 0, @_cfa_ // INLINE LITERAL NUMBER char d_lit = "LIT" byte = param_flag -word = @d_tick, 0, @_lit_ -// COMPILED LITERAL NUMBER +word = @d_cfa, 0, @_lit_ +// COMPILED LITERAL VALUE FROM STACK char d_literal = "LITERAL" byte = imm_flag word = @d_lit, 0, @_literal_ // ?TERMINAL char d_terminal = "?TERMINAL" byte = 0 -word = @d_lit, 0, @_terminal_ +word = @d_literal, 0, @_terminal_ // KEY char d_key = "KEY" byte = 0 @@ -546,10 +578,18 @@ word = @d_cont, 0, @_quit_ char d_abort = "ABORT" byte = 0 word = @d_quit, 0, @_abort_ +// DOABORTSTR +char d_doabortstr = "(ABORT\")" +byte = 0 +word = @d_abort, 0, @_doabortstr_ +// ABORTSTR +char d_abortstr = "ABORT\"" +byte = imm_flag +word = @d_doabortstr, 0, @_abortstr_ // RESTART char d_restart = "RESTART" byte = 0 -word = @d_abort, 0, @_restart_ +word = @d_abortstr, 0, @_restart_ // BYE char d_bye = "BYE" byte = 0 @@ -578,10 +618,18 @@ word = @d_showhash, 0, @_tron_ char d_troff = "TROFF" byte = 0 word = @d_tron, 0, @_troff_ +// SINGLE STEP ON +char d_stepon = "STEPON" +byte = 0 +word = @d_troff, 0, @_stepon_ +// SINGLE STEP OFF +char d_stepoff = "STEPOFF" +byte = 0 +word = @d_stepon, 0, @_stepoff_ // BREAK OUT char d_brkout = "BRKOUT" byte = 0 -word = @d_troff, 0, @_brkout_ +word = @d_stepoff, 0, @_brkout_ // BREAK ON char d_brkon = "BRKON" byte = 0 @@ -617,16 +665,8 @@ def keyin#0 byte i repeat - if state & comp_flag - inptr = gets(']'|$80) // Compilation continuation prompt - else - if brk - puts(" BRK("); puti(brk); putc(')') - else - puts(" OK") - fin - inptr = gets('\n'|$80) - fin + puts(brk ?? " BRK\n" :: " OK\n") + inptr = gets(state & comp_flag ?? ']'|$80 :: '>'|$80) until ^inptr ^(inptr + ^inptr + 1) = 0 // NULL terminate inptr++ @@ -785,28 +825,28 @@ end // Break handler // def showtrace(dentry)#0 - puts("\n[ "); _showstack_; puts("] "); puts(dentry); puts(": ") + puts("\n( "); _showstack_; puts(") "); puts(dentry); putc(' ') end def brkhandle(dentry)#0 word brk_infn, brk_inptr, brk_iip byte brk_state showtrace(dentry) - brk++ - brk_state = state brk_iip = IIP brk_infn = infunc brk_inptr = inptr - state = 0 - infunc = @keyin - inptr = keyinbuf - ^inptr = 0 + infunc = @keyin + inptr = keyinbuf + ^inptr = 0 + brk_state = state & comp_flag + state = state & ~comp_flag + brk++ interpret - state = brk_state - IIP = brk_iip - infunc = brk_infn - inptr = brk_inptr brk-- + state = brk_state | state + IIP = brk_iip + infunc = brk_infn + inptr = brk_inptr end // // Execute code in CFA @@ -824,12 +864,17 @@ def execword(dentry)#0 wend if state & trace_flag showtrace(dentry) + if state & step_flag + if getc == $03 // CTRL-C + brkhandle(dentry) + fin + fin fin W = _cfa_(dentry) (*W)()#0 if (@_get_estack)()#1 > 16 puts("Stack over/underflow\n") - _abort_ + _quit_ fin end def execwords(wlist)#0 @@ -885,7 +930,10 @@ def coldstart#0 heaprelease(startheap) buildhashtbl end -def docompile(dentry)#0 +// +// Compile a word into the dictionary: ITC and PBC +// +def _docompile_(dentry)#0 if state & comp_itc_flag pfillw(dentry) elsif state & comp_pbc_flag @@ -904,7 +952,10 @@ def docompile(dentry)#0 fin else puts("[COMPILE] not compiling\n") - _abort_ + _quit_ + fin + if state & trace_flag + putc('['); puts(dentry); puts("] ") fin end def interpret#0 @@ -924,11 +975,11 @@ def interpret#0 ^inchars = inlen puts(inchars) puts(" : Compile ony word\n") - _abort_ + _quit_ fin execword(dentry) else - docompile(dentry) + _docompile_(dentry) fin else value, valid = isnum(inchars, inlen) @@ -959,6 +1010,7 @@ def interpret#0 fin fin until state & exit_flag + state = state & ~exit_flag end // // Intrinsics @@ -1084,7 +1136,7 @@ end def _tors_(a)#0 if RSP == 0 puts("Return stack overflow\n") - _abort_ + _quit_ fin RSP-- RSTACK[RSP] = a @@ -1092,7 +1144,7 @@ end def _fromrs_#1 if RSP == RSTK_SIZE puts("Return stack underflow\n") - _abort_ + _quit_ fin RSP++ return RSTACK[RSP - 1] @@ -1126,6 +1178,9 @@ end def _fill_(a,b,c)#0 memset(a, c | (c << 8), b) end +def _pad_#1 + return heapmark + 128 +end def stodci(str, dci) byte len, c @@ -1284,42 +1339,49 @@ def _colon_#0 pfillb(^(@divmod)) // Hack - get VM entry vector from divmod pfillw(*(@divmod + 1)) fin + if state & trace_flag + puts(vlist); putc(' ') + fin end -def _semi_#0 +def _exit_#0 if state & comp_itc_flag pfillw(0) elsif state & comp_pbc_flag pfillb($5C) // RET else puts("; Not compiling\n") - _abort_ + _quit_ fin +end +def _semi_#0 + _exit_ state = state & ~comp_flag addhash(vlist) end -def _forcecomp_#0 +def _compcomp_#0 word dentry dentry = find(nextword(' ')) if dentry - docompile(dentry) + _literal_(dentry) + _docompile_(@d_docomp) fin end def _compoff_#0 if state & comp_flag - savestate = state + savestate = state & comp_flag state = state & ~comp_flag else puts("[ Not compiling\n") - _abort_ + _quit_ fin end def _compon_#0 - state = savestate + state = state | savestate savestate = 0 if not (state & comp_flag) puts("[ Not compiling\n") - _abort_ + _quit_ fin end def _immediate_#0 @@ -1574,11 +1636,14 @@ def _forget_#0 end def _cont_#0 if brk - state = exit_flag + state = state | exit_flag else putc('?') fin end +def _iscomp_#1 + return state & comp_flag +end def _query_#0 inptr = gets('>'|$80) ^(inptr + ^inptr + 1) = 0 @@ -1624,14 +1689,17 @@ def _str_#0 str-- ^str = len len++ - if state & comp_itc_flag - pfillw(@d_slit) - elsif state & comp_pbc_flag - pfillb($2E) // CONSTANT STRING + if state & comp_flag + if state & comp_itc_flag + pfillw(@d_slit) + elsif state & comp_pbc_flag + pfillb($2E) // CONSTANT STRING + fin + memcpy(heapalloc(len), str, len) // Add to dictionary else (@push)(heapmark)#0 + memcpy(heapmark, str, len) // Copy to HERE fin - memcpy(heapalloc(len), str, len) end def _type_(a,b)#0 while b @@ -1662,7 +1730,7 @@ end def _src_(a)#0 if srclevel >= SRCREFS puts("Too many nested SRC") - _abort_ + _quit_ fin inref[srclevel] = fileio:open(a) if inref[srclevel] @@ -1766,7 +1834,13 @@ def _tron_#0 state = state | trace_flag end def _troff_#0 - state = state & ~trace_flag + state = state & ~(trace_flag | step_flag) +end +def _stepon_#0 + state = state | step_flag | trace_flag +end +def _stepoff_#0 + state = state & ~step_flag end def brkpoint#0 brkhandle(brkentry) @@ -1823,42 +1897,65 @@ end // def _quit_#0 warmstart - throw(exit, FALSE) + throw(@exit, FALSE) end // // Abort // -def _abort_#0 - puts("Abort\n") - _quit_ +def _abort_(a)#0 + if a + puts("Abort\n") + _quit_ + fin +end +def _doabortstr_(a,b)#0 + if a + puts("Abort: "); puts(b); putln + _quit_ + fin +end +def _abortstr_#0 + word str + byte len + + _str_ + if state & comp_flag + if state & comp_itc_flag + pfillw(@d_doabortstr) + else // comp_pbc_flag + pfillb($54) // CALL + pfillw(@d_doabortstr) + fin + else + (@_doabortstr_)()#0 + fin end // // Restart // def _restart_#0 coldstart - throw(exit, FALSE) + throw(@exit, FALSE) end // // Leave FORTH // def _bye_#0 - throw(exit, TRUE) + throw(@exit, TRUE) end -puts("PLFORTH WIP\n") +puts("FORTH for PLASMA 2.0 WIP\n") if cmdsys:sysver < $0201 puts("PLASMA >= 2.01 required\n") return fin -fileio:iobufalloc(4) // Allocate a bunch of file buffers _estkl = ^(@syscall + 1) // Hack to fill in parameter stack locations _estkh = ^(@syscall + 3) -exit = heapalloc(t_except) +fileio:iobufalloc(4) // Allocate a bunch of file buffers startheap = heapmark coldstart inptr = argNext(argFirst) -if not except(exit) +if not except(@exit) if ^inptr; inptr++; _srcstr_; fin interpret fin