duskos

commit 96b211539cb38f25953e6494aace9625f82d4c17
parent 0ec09a0bb39be905edc36b3c8cd8a3ea2485d7dd
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon, 13 Jun 2022 13:17:14 -0400

cc: change AST_ASSIGN semantics

Instead of being the child to its lvalue, it's the lvalue that's the child of
the assign node.

Diffstat:
M
fs/cc/ast.fs
 | 
25
++++++++++++++-----------
M
fs/cc/gen.fs
 | 
20
+++++++++++---------

2 files changed, 25 insertions(+), 20 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -50,9 +50,9 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
 6 value AST_ARGSPECS
 7 value AST_LVALUE     \ data1=varname
 8 value AST_UNARYOP    \ data1=uopid
-\ 9 = unused
+9 value AST_ASSIGN
 10 value AST_BINARYOP  \ data1=bopid
-11 value AST_ASSIGN
+\ 11 = unused
 \ 12 = unused
 13 value AST_VARIABLE  \ data1=name
 14 value AST_FUNCALL   \ data1=name data2=MAP_FUNCTION
@@ -60,7 +60,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
 create astidnames 7 c, ," declare"  4 c, ," unit"     8 c, ," function"
                   6 c, ," return"   8 c, ," constant" 5 c, ," stmts"
                   4 c, ," args"     6 c, ," lvalue"   7 c, ," unaryop"
-                  1 c, ," _"        5 c, ," binop"    6 c, ," assign"
+                  6 c, ," assign"   5 c, ," binop"    6 c, ," assign"
                   1 c, ," _"        3 c, ," var"      4 c, ," call"
                   0 c,
 
@@ -93,7 +93,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 
 : printast ( node -- )
     ?dup not if ." null" exit then
-    dup astid idname stype
+    dup astid dup AST_FUNCTION = if nl> then idname stype
     astdatatbl over astid wexec
     firstchild ?dup if
       '(' emit begin
@@ -182,10 +182,6 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
     ( node tok ) to nexttputback
   then ;
 
-: parseAssign ( parentnode tok -- )
-  '=' expectChar AST_ASSIGN newnode ( anode )
-  _nextt parseExpression read; ( anode expr ) swap addnode ;
-
 : parseDeclare ( parentnode -- dnode )
   0 begin ( pnode *lvl )
     _nextt dup S" *" s= if drop 1+ 0 else 1 then until ( pnode *lvl tok )
@@ -193,7 +189,10 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
   swap , swap , ( dnode ) ;
 
 : parseDeclarationList ( stmtsnode -- )
-  parseDeclare _nextt parseAssign ;
+  parseDeclare _nextt '=' expectChar dup data1 ( dnode name )
+  swap parentnode AST_ASSIGN newnode ( name anode )
+  AST_LVALUE newnode ( name lvnode ) swap , parentnode ( anode )
+  _nextt parseExpression read; ( anode expr ) swap addnode ;
 
 : parseArgSpecs ( funcnode -- )
   _nextt '(' expectChar AST_ARGSPECS newnode _nextt ( argsnode tok )
@@ -213,8 +212,12 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
       swap addnode ( snode )
     else ( snode tok )
       dup isType? if drop dup parseDeclarationList else ( snode tok )
-        expectIdent over AST_LVALUE newnode ( snode ident lvnode )
-        swap , _nextt parseAssign then
+        \ --> assign(lvalue, expr)
+        over AST_ASSIGN newnode swap ( snode anode tok )
+        expectIdent swap AST_LVALUE newnode parentnode ( snode ident anode )
+        swap , _nextt '=' expectChar ( snode anode )
+        _nextt parseExpression read; ( snode anode expr )
+        swap addnode ( snode ) then
     then ( snode )
     _nextt again ;
 
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -63,13 +63,13 @@ alias noop gennode ( node -- ) \ forward declaration
 
 : spit ( a u -- ) A>r >r >A begin Ac@+ .x1 spc> next r>A ;
 : getfuncmap ( node -- funcentry ) AST_FUNCTION parentnodeid data2 ;
-\ get SF offset of AST_DECLARE node
-: declsfoff ( dnode -- off )
+\ get SF offset of AST_LVALUE node
+: lvsfoff ( dnode -- off )
   dup data1 swap getfuncmap ( name funcentry ) findvarinmap ( varentry )
   vmap.sfoff ;
 
 ASTIDCNT wordtbl gentbl ( node -- )
-'w genchildren ( Declare )
+'w drop ( Declare )
 'w genchildren ( Unit )
 :w ( Function )
   _debug if ." debugging: " dup data1 stype nl> then
@@ -89,19 +89,21 @@ ASTIDCNT wordtbl gentbl ( node -- )
 :w ( Constant ) eax data1 i32 mov, ;
 :w ( Statements ) genchildren ;
 'w genchildren ( ArgSpecs )
-'w genchildren ( Lvalue )
+'w _err ( Lvalue )
 :w ( UnaryOp ) dup genchildren data1 uopgentbl swap wexec ;
-'w genchildren ( Factor )
+:w ( Assign )
+  firstchild ?dup not if _err then ( lvnode )
+  dup nextsibling ?dup not if _err then ( lvnode exprnode )
+  gennode lvsfoff ( off )
+  [ebp]+ eax mov, ;
 :w ( BinaryOp )
   ( node ) >r
   r@ childcount 2 = not if abort" binop node with more than 2 children!" then
   r@ firstchild dup nextsibling swap ( n1 n2 )
   gennode bopgentblmiddle r@ data1 wexec eax push,
   gennode ebx pop, bopgentblpost r> data1 wexec ;
-:w ( Assign )
-  dup genchildren ( node ) parentnode ( declnode ) declsfoff ( off )
-  [ebp]+ eax mov, ;
-'w genchildren ( DeclarationList )
+'w _err ( unused )
+'w _err ( unused )
 :w ( Variable )
   dup data1 ( node name )
   swap getfuncmap findvarinmap ( varnode ) vmap.sfoff