diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index 0def663..41eebc3 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -25,9 +25,9 @@ predef _drop_(a)#0, _swap_(a,b)#2, _dup_(a)#2 predef _add_(a,b)#1, _sub_(a,b)#1, _mul_(a,b)#1, _div_(a,b)#1 predef _cset_(a,b)#0, _cget_(a)#1, _wset_(a,b)#0, _wget_(a)#1 predef _cfa_(a)#1, _lfa_(a)#1 -predef _create_#0, _builds_#0, _does_#0, _pset_(a)#0, _colon_#0, _semi_#0 -predef _var_(a)#0, _lit_#1, _forget_#0 -predef _vlist_#0, _show_#0, _bye_#0 +predef _create_#0, _builds_#0, _dodoes_(words)#0, _filldoes_#0, _does_#0, _pset_(a)#0, _colon_#0, _semi_#0 +predef _var_(a)#0, _lit_#1, _tick_#1, _forget_#0 +predef _vlist_#0, _tron_#0, _troff_#0, _show_#0, _bye_#0 // DROP char d_drop = "DROP" word = 0, @_drop_, 0 @@ -75,9 +75,15 @@ word = @d_allot, @_forget_, 0 // BUILDS char d_builds = "0 // JSR INTERP + *(heapalloc(2)) = (@divmod)=>1 + ^(heapalloc(1)) = $2C // CONSTANT WORD + *(heapalloc(2)) = heapmark + 6 + ^(heapalloc(1)) = $54 // CALL _dodoes_ + *(heapalloc(2)) = @_dodoes_ + ^(heapalloc(1)) = $5C // RET end def _pset_(a)#0 *(heapalloc(2)) = a @@ -306,6 +347,12 @@ end def _immediate_#0 ^vlist = ^vlist | imm_flag end +def _tick_#1 + while ^inptr == ' ' + inptr++ + loop + return find +end def _forget_#0 word dentry @@ -321,13 +368,17 @@ def _show_#0 word dentry, pfa, w char l, f -while ^inptr == ' ' - inptr++ -loop -if ^inptr > ' ' - dentry = find + while ^inptr == ' ' + inptr++ + loop + if ^inptr > ' ' + dentry = find if dentry - pfa = _pfa_(dentry) + if *_cfa_(dentry) == @_docolon_ + pfa = _pfa_(dentry) + else + pfa = *_cfa_(dentry) + 10 + fin w = *pfa while w f = ^w @@ -341,6 +392,12 @@ if ^inptr > ' ' fin fin end +def _tron_#0 + trace = 1 +end +def _troff_#0 + trace = 0 +end def _vlist_#0 word d char f, l @@ -368,6 +425,7 @@ def _quit_#0 // Set flags on words // d_semi = d_semi | imm_flag + d_does = d_does | imm_flag repeat puts(" OK") inptr = gets('\n'|$80) @@ -388,7 +446,7 @@ def _quit_#0 dentry = find if dentry if (not state & comp_flag) or (^dentry & imm_flag) - exec(dentry) + execword(dentry) else //puts("Compile "); puts(dentry); putln _pset_(dentry)