duskos

commit 8436cbc10ee990e1f64f44929f68348d5142efe3
parent 521b1cca1cd62b64a56eb47e2387a07d466d30fd
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 17 Jun 2022 09:26:15 -0400

cc: add types

Diffstat:
M
fs/cc/ast.fs
 | 
30
++++++++++++++++++------------
M
fs/cc/cc.fs
 | 
1
+
A
fs/cc/type.fs
 | 
23
+++++++++++++++++++++++

3 files changed, 42 insertions(+), 12 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -35,7 +35,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
 
 \ AST node types
 15 const ASTIDCNT
-0 const AST_DECLARE    \ data1=name data2='*' levels
+0 const AST_DECLARE    \ data1=name data2='*' levels data3=type
 1 const AST_UNIT
 2 const AST_FUNCTION   \ data1=name data2=MAP_FUNCTION
 3 const AST_RETURN
@@ -66,7 +66,10 @@ ASTIDCNT stringlist astidnames
 : _i _[ dup data1 .x _] ;
 
 ASTIDCNT wordtbl astdatatbl ( node -- node )
-:w ( Declare ) _[ dup data1 stype spc> dup data2 .x1 _] ;
+:w ( Declare ) _[
+  dup data1 stype spc>
+  dup data2 .x1 spc>
+  dup data3 printtype _] ;
 'w noop ( Unit )
 'w _s ( Function )
 'w noop ( Return )
@@ -106,7 +109,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 \ Takes a token and returns the corresponding typedef (not AST type).
 \ For now, we always return 1 on "int".
 : isType? ( tok -- f ) S" int" s= ;
-: expectType ( tok -- tok ) dup isType? not if _err then ;
+: expectType ( tok -- type ) findtype not if _err then ( type ) ;
 : expectConst ( tok -- n ) dup parse if nip else _err then ;
 : isIdent? ( tok -- f )
   dup 1+ c@ identifier1st? not if drop 0 exit then
@@ -186,13 +189,14 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
   ( node tok ) to nexttputback ;
 current to parseExpression
 
-: parseDeclare ( parentnode -- dnode )
-  0 begin ( pnode *lvl )
-    _nextt dup S" *" s= if drop 1+ 0 else 1 then until ( pnode *lvl tok )
-  expectIdent rot ( *lvl name pnode ) AST_DECLARE newnode ( *lvl name dnode )
-  swap , swap , ( dnode ) ;
+: parseDeclare ( type parentnode -- dnode )
+  0 begin ( type pnode *lvl )
+    _nextt dup S" *" s= if drop 1+ 0 else 1 then until ( type pnode *lvl tok )
+  expectIdent rot ( type *lvl name pnode )
+  AST_DECLARE newnode ( type *lvl name dnode )
+  swap , ( type *lvl dnode ) rot> , , ( dnode ) ;
 
-: parseDeclarationList ( stmtsnode -- )
+: parseDeclarationList ( type stmtsnode -- )
   parseDeclare _nextt '=' expectChar dup data1 ( dnode name )
   swap parentnode AST_BINARYOP newnode ( name anode ) 12 ( = ) ,
   AST_LVALUE newnode ( name lvnode ) swap , parentnode ( anode )
@@ -202,7 +206,7 @@ current to parseExpression
   _nextt '(' expectChar AST_ARGSPECS newnode _nextt ( argsnode tok )
   dup S" )" s= if 2drop exit then
   begin ( argsnode tok )
-    expectType drop dup parseDeclare drop
+    expectType over parseDeclare drop
     _nextt dup S" )" s= if 2drop exit then
     ',' expectChar _nextt again ;
 
@@ -228,7 +232,8 @@ alias noop parseStatements ( funcnode -- ) \ forward declaration
   begin ( snode tok )
     dup S" }" s= if 2drop exit then
     dup statementnames sfind dup 0< if ( snode tok -1 )
-      drop dup isType? if drop dup parseDeclarationList else ( snode tok )
+      drop dup findtype if ( snode tok type )
+        nip over parseDeclarationList else ( snode tok )
         parseExpression over addnode read; then ( snode )
     else ( snode tok idx ) nip statementhandler swap wexec then ( snode )
     _nextt again ;
@@ -241,5 +246,6 @@ current to parseStatements
 : parseast ( -- )
   AST_UNIT createnode dup to curunit
    nextt ?dup not if exit then begin ( unitnode tok )
-    isType? _assert _nextt expectIdent over swap parseFunction ( unitnode )
+    findtype _assert drop
+    _nextt expectIdent over swap parseFunction ( unitnode )
     nextt ?dup not until ( unitnode ) drop ;
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -4,6 +4,7 @@ f<< lib/str.fs
 f<< lib/wordtbl.fs
 f<< lib/xdict.fs
 f<< asm.fs
+f<< cc/type.fs
 f<< cc/vm.fs
 f<< cc/tok.fs
 f<< cc/tree.fs
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -0,0 +1,23 @@
+\ C compiler types
+
+\ All information related to a basic type fits in a 32b integer, so that's
+\ how "type" is passed around. Structure:
+\ b2:0 = size. 0=0 1=8 2=16 3=32 4+=reserved for future use
+\ b3 =   sign. 0=unsigned 1=signed
+
+4 const TYPECNT
+create types
+  $00 , \ void
+  $05 , \ char
+  $06 , \ short
+  $07 , \ int
+
+TYPECNT stringlist typenames "void" "char" "short" "int"
+create _ 0 c, 8 c, 16 c, 32 c,
+: typesize ( type -- size-in-bytes ) 3 and _ + c@ ;
+: typesigned? ( type -- flags ) 2 rshift 1 and ;
+
+: findtype ( name -- type? f )
+  typenames sfind dup 0>= if 4 * types + @ 1 else drop 0 then ;
+
+: printtype ( type -- ) 3 and typenames slistiter stype ;