diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index 6fd374a..7c82ddb 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -5,8 +5,9 @@ include "inc/cmdsys.plh" // // bytes usage // ----- ----- -// [1] name lenght and flags +// [1] name length and flags // [1..31] name string +// [1] FFA (flag field address) // [2] LFA (link field address) // [2] CFA (code field address) // [2] PFA (param field address) @@ -15,9 +16,9 @@ include "inc/cmdsys.plh" // // Mask and flags for dictionary entries // -const len_mask = $1F -const imm_flag = $20 -const hidden_flag = $80 +const imm_flag = $20 +const componly_flag = $40 +const hidden_flag = $80 // // Predefine instrinsics // @@ -32,129 +33,171 @@ predef _var_(a)#0, _const_(a)#0,_lit_#1, _tick_#1, _forget_#0 predef _vlist_#0, _tron_#0, _troff_#0, _show_#0, _bye_#0, _abort_#0 // DROP char d_drop = "DROP" +byte = 0 word = 0, @_drop_, 0 // SWAP char d_swap = "SWAP" +byte = 0 word = @d_drop, @_swap_, 0 // DUP char d_dup = "DUP" +byte = 0 word = @d_swap, @_dup_, 0 // OVER word d_over = "OVER" +byte = 0 word = @d_dup, @_over_, 0 // ROT word d_rot = "ROT" +byte = 0 word = @d_over, @_rot_, 0 // ADD char d_add = "+" +byte = 0 word = @d_rot, @_add_, 0 // SUB char d_sub = "-" +byte = 0 word = @d_add, @_sub_, 0 // MUL char d_mul = "*" +byte = 0 word = @d_sub, @_mul_, 0 // DIV char d_div = "/" +byte = 0 word = @d_mul, @_div_, 0 // CHAR SET char d_cset = "C!" +byte = 0 word = @d_div, @_cset_, 0 // WORD SET char d_wset = "!" +byte = 0 word = @d_cset, @_wset_, 0 // CHAR GET char d_cget = "C@" +byte = 0 word = @d_wset, @_cget_, 0 // WORD SET char d_wget = "@" +byte = 0 word = @d_cget, @_wget_, 0 // TO RSTACK char d_torstk = ">R" +byte = 0 word = @d_wget, @_tors_, 0 // FROM RSTACK char d_fromrstk = "R>" +byte = 0 word = @d_torstk, @_fromrs_, 0 // TOP OF RSTACK char d_toprstk = "R@" +byte = 0 word = @d_fromrstk, @_toprs_, 0 // VARIABLE char d_var = "VARIABLE" +byte = 0 word = @d_toprstk, @_var_, 0 // CONSTANT char d_const = "CONSTANT" +byte = 0 word = @d_var, @_const_, 0 // HERE char d_here = "HERE" +byte = 0 word = @d_const, @heapmark, 0 // ALLOT char d_allot = "ALLOT" +byte = 0 word = @d_here, @heapalloc, 0 // BRANCH char d_branch = "(BRANCH)" +byte = 0 word = @d_allot, @_branch_, 0 // BRANCH IF 0 char d_branch0 = "(BRANCH0)" +byte = 0 word = @d_branch, @_branch0_, 0 // IF char d_if = "IF" +byte = imm_flag word = @d_branch0, @_if_, 0 // ELSE char d_else = "ELSE" +byte = imm_flag word = @d_if, @_else_, 0 // THEN char d_then = "THEN" +byte = imm_flag word = @d_else, @_then_, 0 // FORGET char d_forget = "FORGET" +byte = 0 word = @d_then, @_forget_, 0 // BUILDS char d_builds = " ^(dentry+i) break fin next - if i > len + if i > ^dentry //puts("[Found name = "); puts(dentry); puts("]\n") return dentry fin fin - dentry = *(dentry + len + 1) + dentry = *(dentry + ^dentry + 2) loop // Not found return 0 @@ -307,16 +348,12 @@ end // Execute code in CFA // def execword(dentry)#0 - char l - if ^$C000 == $83 // CTRL-C + ^$C010 // Clear KB strobe _abort_ fin if trace - l = ^dentry - ^dentry = l & len_mask puts(": "); puts(dentry); putln - ^dentry = l fin W = _cfa_(dentry) (*W)()#0 @@ -343,14 +380,12 @@ def _doconst_#1 return *(W + 2) end def _docolon_#0 - //puts("DOCOLON:\n") execwords(W + 2) end def _pushPFA_#1 return W + 2 end def _dodoes_(words)#0 - //puts("DODOES:\n") (@_pushPFA_)()#0 // Stack hacks execwords(words) end @@ -396,23 +431,17 @@ end def _wget_(a)#1 return *a end +def _ffa_(dentry)#1 + return dentry + ^dentry + 1 +end def _lfa_(dentry)#1 - char l - - l = ^dentry & len_mask - return dentry + l + 1 + return dentry + ^dentry + 2 end def _cfa_(dentry)#1 - char l - - l = ^dentry & len_mask - return dentry + l + 3 + return dentry + ^dentry + 4 end def _pfa_(dentry)#1 - char l - - l = ^dentry & len_mask - return dentry + l + 5 + return dentry + ^dentry + 6 end def _tors_(a)#0 RSP-- @@ -449,7 +478,9 @@ def _create_#0 namechars++ namelen-- loop - *bldptr = plist; + ^bldptr = 0 // Flags + bldptr++ + *bldptr = plist; // Link ptr bldptr = bldptr + 2 heapalloc(bldptr - vlist + 2) end @@ -459,11 +490,11 @@ def _does_#0 // Build PLASMA bytecode routine ^(heapalloc(1)) = (@divmod)->0 // JSR INTERP *(heapalloc(2)) = (@divmod)=>1 - ^(heapalloc(1)) = $2C // CONSTANT WORD + ^(heapalloc(1)) = $2C // CONSTANT WORD *(heapalloc(2)) = heapmark + 6 - ^(heapalloc(1)) = $54 // CALL _dodoes_ + ^(heapalloc(1)) = $54 // CALL _dodoes_ *(heapalloc(2)) = @_dodoes_ - ^(heapalloc(1)) = $5C // RET + ^(heapalloc(1)) = $5C // RET end def _pset_(a)#0 *(heapalloc(2)) = a @@ -511,13 +542,11 @@ def _then_#0 *_fromrs_ = heapmark end def _semi_#0 - if state == comp_flag - *(heapalloc(2)) = 0 - state = 0 - fin + *(heapalloc(2)) = 0 + state = 0 end def _immediate_#0 - ^vlist = ^vlist | imm_flag + ^_ffa_(vlist) = ^_ffa_(vlist) | imm_flag end def _tick_#1 return find(toknext) @@ -535,7 +564,6 @@ def _bye_#0 end def _show_#0 word dentry, pfa, w - char l, f dentry = find(toknext) if dentry @@ -546,11 +574,7 @@ def _show_#0 fin w = *pfa while w - f = ^w - l = f & len_mask - ^w = l puts(" "); puts(w); putln - ^w = f pfa = pfa + 2 w = *pfa loop @@ -564,16 +588,11 @@ def _troff_#0 end def _vlist_#0 word d - char f, l d = vlist while d - f = ^d - l = f & len_mask - ^d = l puts(d); puts(" ") - ^d = f - d = *(d + l + 1) + d = *(d + ^d + 2) loop end // @@ -609,16 +628,11 @@ def _quit_#0 // // Set flags on words // - d_semi = d_semi | imm_flag - d_does = d_does | imm_flag - d_if = d_if | imm_flag - d_else = d_else | imm_flag - d_then = d_then | imm_flag repeat inchars, inlen = toknext dentry = find(inchars, inlen) if dentry - if (not state & comp_flag) or (^dentry & imm_flag) + if (not state & comp_flag) or (^_ffa_(dentry) & imm_flag) execword(dentry) else _pset_(dentry)