Move flags into seperate field

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 = "<BUILDS"
+byte = imm_flag
 word = @d_forget, @_create_, 0
 // FILL DOES COMPILE TIME
 char d_filldoes = "FILLDOES"
+byte = 0
 word = @d_builds, @_filldoes_, 0
 // DO DOES RUN TIME
 char d_dodoes = "DODOES>"
+byte = 0
 word = @d_filldoes, @_dodoes_, 0
 // DOES
 char d_does = "DOES>"
+byte = imm_flag
 word = @d_dodoes, @_does_, 0
 // COMMA
 char d_comma = ","
+byte = 0
 word = @d_does, @_pset_, 0
 // COLON
 char d_colon = ":"
+byte = 0
 word = @d_comma, @_colon_, 0
 // SEMI
 char d_semi = ";"
+byte = imm_flag
 word = @d_colon, @_semi_, 0
 // TICK
 char d_tick = "'"
+byte = 0
 word = @d_semi, @_tick_, 0
 // LITERAL
 char d_lit = "LIT"
+byte = 0
 word = @d_tick, @_lit_, 0
 // PRINT TOS
 char d_prtos = "."
+byte = 0
 word = @d_lit, @puti, 0
 // PRINT TOS HEX
 char d_prtoshex = ".$"
+byte = 0
 word = @d_prtos, @puth, 0
-// EXIT
+// BYE
 char d_bye = "BYE"
+byte = 0
 word = @d_prtoshex, @_bye_, 0
 // SHOW DEFINITION
 char d_show = "SHOW"
+byte = 0
 word = @d_bye, @_show_, 0
 // TRACE ON
 char d_tron = "TRON"
+byte = 0
 word = @d_show, @_tron_, 0
 // TRACE OFF
 char d_troff = "TROFF"
+byte = 0
 word = @d_tron, @_troff_, 0
 // LIST VOCAB
 char d_vlist = "VLIST"
+byte = 0
 word = @d_troff, @_vlist_, 0
 //
 // Internal variables
@@ -170,9 +213,8 @@ word RSTACK[RSTK_SIZE]
 //
 // State flags
 //
-const comp_flag   = $01
-const build_flag  = $02
-const exit_flag   = $80
+const exit_flag = $01
+const comp_flag = $02
 char state = 0
 char trace = 0
 byte _reset_stacks = $A2, $FE // LDX #$FE
@@ -232,24 +274,23 @@ end
 //
 def find(matchchars, matchlen)#1
   word dentry
-  byte len, i
+  byte i
 
   matchchars--
   dentry = vlist
   while dentry
-    len = ^dentry & len_mask
-    if len == matchlen
-      for i = 1 to len
+    if ^dentry == matchlen
+      for i = 1 to ^dentry
         if ^(matchchars+i) <> ^(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)