diff --git a/images/apple/PLFORTH.PO b/images/apple/PLFORTH.PO index ac4f0ea..abd4433 100755 Binary files a/images/apple/PLFORTH.PO and b/images/apple/PLFORTH.PO differ diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index cad56ff..7b7f5a3 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -86,6 +86,7 @@ byte = $60 // RTS const inline_flag = $01 const inlinew_flag = $02 const param_flag = $04 +const showcr_flag = $08 // Help pretty print SHOW const itc_flag = $10 const imm_flag = $20 const componly_flag = $40 @@ -118,7 +119,7 @@ predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0 predef _compword_(dentry)#0, _compliteral_(a)#0, _execword_(dentry)#0, _isnum_(a,b)#2 // DROP char d_drop = "DROP" -byte = inline_flag +byte = inline_flag | showcr_flag word = 0, 0, 0, $30 // SWAP char d_swap = "SWAP" @@ -254,15 +255,15 @@ byte = 0 word = @d_min, 0, @_max_ // CHAR PUT char d_cset = "C!" -byte = inline_flag +byte = inline_flag | showcr_flag word = @d_max, 0, 0, $70 // WORD PUT char d_wset = "!" -byte = inline_flag +byte = inline_flag | showcr_flag word = @d_cset, 0, 0, $72 // WORD PLUS PUT char d_wplusset = "+!" -byte = 0 +byte = showcr_flag word = @d_wset, 0, @_wplusset_ // CHAR GET char d_cget = "C@" @@ -274,11 +275,11 @@ byte = inline_flag word = @d_cget, 0, 0, $62 // EXECUTE char d_execute = "EXECUTE" -byte = 0 +byte = showcr_flag word = @d_wget, 0, @_execword_ // TO RSTACK char d_torstk = ">R" -byte = 0 +byte = showcr_flag word = @d_execute, 0, @_tors_ // FROM RSTACK char d_fromrstk = "R>" @@ -326,11 +327,11 @@ byte = 0 word = @d_pad, 0, @_allot_ // BRANCH ( not in vocabulary ) char d_branch = "(BRANCH)" -byte = param_flag | inline_flag +byte = param_flag | inline_flag | showcr_flag word = 0, 0, @_branch_, $C4 // BRANCH IF 0 ( not in vocabulary ) char d_0branch = "(0BRANCH)" -byte = param_flag | inline_flag +byte = param_flag | inline_flag | showcr_flag word = 0, 0, @_0branch_, $C2 // IF char d_if = "IF" @@ -362,7 +363,7 @@ byte = imm_flag | componly_flag word = @d_endof, 0, @_endcase_ // COMPILED DO ( not in vocabulary ) char d_dodo = "(DO)" -byte = 0 +byte = showcr_flag word = 0, 0, @_dodo_ // DO char d_do = "DO" @@ -374,7 +375,7 @@ byte = componly_flag word = @d_do, 0, @_leave_ // COMPILED LOOP ( not in vocabulary ) char d_doloop = "(DOLOOP)" -byte = param_flag +byte = param_flag | showcr_flag word = 0, 0, @_doloop_ // LOOP char d_loop = "LOOP" @@ -382,7 +383,7 @@ byte = imm_flag | componly_flag word = @d_leave, 0, @_loop_ // COMPILED LOOP+ ( not in vocabulary ) char d_doplusloop = "(+DOLOOP)" -byte = param_flag +byte = param_flag | showcr_flag word = 0, 0, @_doplusloop_ // LOOP char d_plusloop = "+LOOP" @@ -418,15 +419,15 @@ byte = imm_flag | componly_flag word = @d_while, 0, @_repeat_ // FORGET char d_forget = "FORGET" -byte = 0 +byte = interponly_flag word = @d_repeat, 0, @_forget_ // CREATE char d_create = "CREATE" -byte = 0 +byte = showcr_flag word = @d_forget, 0, @_create_ // RECREATE/DOES COMPILE TIME ( not in vocabulary ) char d_createdoes = "(CREATEDOES)" -byte = 0 +byte = showcr_flag word = 0, 0, @_itcdoes_ // DOES char d_does = "DOES>" @@ -434,11 +435,11 @@ byte = imm_flag | componly_flag word = @d_create, 0, @_does_ // COMMA char d_comma = "," -byte = 0 +byte = showcr_flag word = @d_does, 0, @_dictaddw_ // COMMA char d_commab = "C," -byte = 0 +byte = showcr_flag word = @d_comma, 0, @_dictaddb_ // COLON char d_colon = ":" @@ -470,7 +471,7 @@ byte = imm_flag word = @d_interponly, 0, @_immediate_ // EXIT char d_exit = "EXIT" -byte = imm_flag | componly_flag +byte = imm_flag | componly_flag | showcr_flag word = @d_immediate, 0, @_exit_ // SEMI char d_semi = ";" @@ -522,19 +523,19 @@ byte = 0 word = @d__isnum_, 0, @_trailing_ // PRINT @TOS char d_prat = "?" -byte = 0 +byte = showcr_flag word = @d_trailing, 0, @_prat_ // PRINT TOS char d_prtos = "." -byte = 0 +byte = showcr_flag word = @d_prat, 0, @_prval_ // PRINT TOS HEX char d_prtoshex = "$." -byte = 0 +byte = showcr_flag word = @d_prtos, 0, @_prhex_ // PRINT TOS HEX BYTE char d_prtosbyte = "C$." -byte = 0 +byte = showcr_flag word = @d_prtoshex, 0, @_prbyte_ // EMIT char d_emit = "EMIT" @@ -574,7 +575,7 @@ byte = param_flag | inline_flag word = 0, 0, @_slit_, $2E // PRINT STRING FROM STACK char d_doprstr = "(.\")" -byte = 0 +byte = showcr_flag word = @d_str, 0, @puts // PRINT STRING char d_prstr = ".\"" @@ -586,7 +587,7 @@ byte = imm_flag word = @d_prstr, 0, @_prpstr_ // READ SOURCE FILE FROM STACK char d_src = "SRC" -byte = 0 +byte = showcr_flag word = @d_prpstr, 0, @_src_ // READ SOURCE FILE FROM INPUT char d_srcstr = "SRC\"" @@ -594,7 +595,7 @@ byte = imm_flag word = @d_src, 0, @_srcstr_ // END SOURCE FILE char d_endsrc = "ENDSRC" -byte = 0 +byte = showcr_flag word = @d_srcstr, 0, @_endsrc_ // CONTINUE AFTER BRK char d_cont = "CONT" @@ -602,15 +603,15 @@ byte = interponly_flag word = @d_endsrc, 0, @_cont_ // QUIT char d_quit = "QUIT" -byte = 0 +byte = showcr_flag word = @d_cont, 0, @_quit_ // ABORT IF <> 0 char d_abort = "ABORT" -byte = 0 +byte = showcr_flag word = @d_quit, 0, @_abort_ // DOABORTSTR char d_doabortstr = "(ABORT\")" -byte = 0 +byte = showcr_flag word = @d_abort, 0, @_doabortstr_ // ABORTSTR char d_abortstr = "ABORT\"" @@ -618,11 +619,11 @@ byte = imm_flag word = @d_doabortstr, 0, @_abortstr_ // COLD exitforth char d_exitforth = "COLD" -byte = 0 +byte = showcr_flag word = @d_abortstr, 0, @_restart_ // COMMENT char d_comment = "(" -byte = imm_flag +byte = imm_flag | showcr_flag word = @d_exitforth, 0, @_comment_ // // PLFORTH custom words @@ -1233,8 +1234,9 @@ end def _does_#0 if state & comp_itc_flag _dictaddw_(@d_lit) - _dictaddw_(heapmark + 6) // Pointer to DOES code + _dictaddw_(heapmark + 8) // Pointer to DOES code _dictaddw_(@d_createdoes) + _dictaddw_(0) // Double zero for SHOW _dictaddw_(0) // End of else // comp_pbc_flag @@ -1253,7 +1255,7 @@ def _colon_#0 newdict state = state | comp_mode if state & comp_itc_flag - ^(_ffa_(vlist)) = itc_flag + ^(_ffa_(vlist)) = itc_flag | showcr_flag *(_cfa_(vlist)) = @_docolon_ else // comp_pbc_flag _dictaddb_(JSR); _dictaddw_(vmvect) @@ -1274,6 +1276,9 @@ def _exit_#0 end def _semi_#0 _exit_ + if state & comp_itc_flag // Add double zero at end of definition for SHOW + _dictaddw_(0) + fin addhash(vlist) state = state & ~comp_flag end @@ -1718,7 +1723,7 @@ def _show_#0 fin w = *pfa while w - puts(" ") + puts(" ") if ^_ffa_(w) & param_flag pfa = pfa + 2 fin @@ -1732,9 +1737,17 @@ def _show_#0 else puts(w) fin - putln + if ^_ffa_(w) & showcr_flag; putln; fin pfa = pfa + 2 w = *pfa + if !w + puts(" EXIT\n") + pfa = pfa + 2 + w = *pfa + fin + if conio:keypressed() + getc; getc + fin loop fin end @@ -1891,9 +1904,9 @@ while vlist if *_cfa_(vlist) == 0 *_cfa_(vlist) = heapmark _dictaddb_(JSR); _dictaddw_(vmvect) - if ^_ffa_(vlist) == inline_flag + if ^_ffa_(vlist) & inline_flag _dictaddb_(^_pfa_(vlist)) - elsif ^_ffa_(vlist) == inlinew_flag + elsif ^_ffa_(vlist) & inlinew_flag _dictaddw_(*_pfa_(vlist)) else puts(vlist); puts(": Invalid dictionary\n")