duskos

commit fe06e0668e247d4b060bbc69f965181ef59f37c1
parent 1445ed34b684d0edbf48406538ab15d969f251ac
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu,  3 Nov 2022 19:39:48 -0400

cc: code consolidation

Diffstat:
M
fs/cc/ast.fs
 | 
31
+++++++++++--------------------
M
fs/cc/cc.fs
 | 
11
++++++-----
M
fs/tests/cc/ast.fs
 | 
7
+++++--

3 files changed, 22 insertions(+), 27 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -18,8 +18,6 @@ Arena :new structbind Arena _arena
 : _err ( -- ) abort" ast error" ;
 : _assert ( f -- ) not if _err then ;
 
-0 value curunit \ points to current Unit, the beginning of the AST
-
 \ Symbols are anything that an Ident node can refer to: function or variable.
 \ This dictionary below contain global symbols of the current unit
 create symbols 0 , 0 c, \ this is a dict link
@@ -28,7 +26,7 @@ create symbols 0 , 0 c, \ this is a dict link
   symbols over CType name dup c@ ( ctype 'dict name len )
   ENTRYSZ + 8 + _arena :[ entry , _arena :] drop ;
 : findSymbol ( name -- ctype-or-0 ) symbols find dup if @ then ;
-: ccast$ _arena :reset 0 to curunit 0 symbols ! ;
+: ccast$ _arena :reset 0 symbols ! ;
 
 \ Unary operators
 7 const UOPSCNT
@@ -69,7 +67,7 @@ create bopsprectbl BOPSCNT nc,
 \ AST node types
 22 const ASTIDCNT
 0 const AST_DECLARE
-1 const AST_UNIT
+\ 1 is unused
 2 const AST_FUNCTION
 3 const AST_RETURN
 4 const AST_CONSTANT
@@ -462,30 +460,23 @@ alias noop parseStatement ( funcnode -- ) \ forward declaration
       nip statementhandler swap wexec then ;
 current to parseStatement
 
-: parseFuncDef ( unitnode ctype -- fnode )
-  dup addSymbol Function :new ( unode fnode )
-  dup rot Node :add ( fnode ) dup parseStatement ;
+: parseFuncDef ( ctype -- fnode )
+  dup addSymbol Function :new ( fnode ) dup parseStatement ;
 
-: parseGlobalDecl ( unitnode ctype -- dnode )
-  Declare :new ( unode dnode ) dup rot Node :add ( dnode )
+: parseGlobalDecl ( ctype -- dnode )
+  Declare :new ( dnode )
   dup Declare ctype addSymbol
   STORAGE_MEM over Declare ctype to CType storage ( dnode )
   parseDeclareInit ( dnode initnode )
   ?dup if over Node :add then read; ;
 
 \\ Parse the next element in a Unit node
-: parseUnit ( unitnode tok -- node-or-0 )
-  dup S" #[" s= if drop #[0 drop 0 exit then
+: parseUnit ( tok -- node-or-0 )
+  dup S" #[" s= if drop #[0 0 exit then
   0 to curstatic
   dup S" static" s= if drop nextt 1 to curstatic then
-  parseType _assert ( unode type )
+  parseType _assert ( type )
   nextt dup ';' isChar? if \ Only a type on a line is fine, carry on
-    2drop drop 0 exit then
-  to nexttputback parseDeclarator ( unode ctype )
+    2drop 0 exit then
+  to nexttputback parseDeclarator ( ctype )
   dup CType :funcsig? if parseFuncDef else parseGlobalDecl then ;
-
-: newparseunit ( -- unit ) AST_UNIT ASTNode :new dup to curunit ;
-: parseast ( -- )
-  newparseunit
-  begin ( unode ) nextt? ?dup while over swap parseUnit drop repeat drop
-  _ccdebug if nl> ." used space for AST: " _arena :usedsz .x nl> then ;
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -9,13 +9,14 @@
 \ Compiles input coming from the stdin alias and writes the
 \ result to here. Aborts on error.
 : cc1, ( -- )
-  cctypes$ ccast$
-  parseast _ccdebug if curunit printast nl> then
-  curunit trnode _ccdebug if curunit printast nl> then
-  curunit gennode ;
+  cctypes$ ccast$ begin ( )
+    nextt? ?dup while parseUnit ( node-or-0 ) ?dup if
+      _ccdebug if dup printast nl> then ( node )
+      dup trnode _ccdebug if dup printast nl> then ( node )
+      gennode then repeat ;
 
 : :c
-  newparseunit nextt parseUnit ?dup if
+  nextt parseUnit ?dup if
     _ccdebug if dup printast nl> then
     dup trnode _ccdebug if dup printast nl> then gennode then ;
 
diff --git a/fs/tests/cc/ast.fs b/fs/tests/cc/ast.fs
@@ -2,9 +2,12 @@
 ?f<< cc/ast.fs
 testbegin
 \ Tests for the C compiler AST
-' parseast S" tests/cc/test.c" with-stdin-file
+: _parse cctypes$ ccast$ nextt parseUnit ;
+current with-stdin< short retconst() {
+    return 42 ;
+}
 
-curunit Node firstchild dup Node id AST_FUNCTION #eq ( fnode )
+dup Node id AST_FUNCTION #eq ( fnode )
 dup Function name S" retconst" #s=
 Node firstchild dup Node id AST_STATEMENTS #eq ( snode )
 Node firstchild dup Node id AST_RETURN #eq ( rnode )