commit 5a7c26b53082b3f3127bc24fcd008427c298aded
parent 8436cbc10ee990e1f64f44929f68348d5142efe3
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 17 Jun 2022 09:40:44 -0400
cc: parse the "unsigned" keyword and apply it to types
Diffstat:
5 files changed, 52 insertions(+), 49 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -98,18 +98,13 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: newnode ( parent astid -- newnode )
createnode ( parent node ) dup rot addnode ( node ) ;
-\ if not 0, next _nextt call will fetch token from here
-0 value nexttputback
: _err ( -- ) abort" parsing error" ;
: _assert ( f -- ) not if _err then ;
-: _nextt
- nexttputback ?dup if 0 to nexttputback exit then
- nextt ?dup not if abort" expecting token!" then ;
\ 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 -- type ) findtype not if _err then ( type ) ;
+: expectType ( tok -- type ) parseType 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
@@ -117,7 +112,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: expectIdent ( tok -- tok ) dup isIdent? _assert ;
: expectChar ( tok c -- )
over 1+ c@ = _assert dup c@ 1 = _assert drop ;
-: read; ( -- ) _nextt ';' expectChar ;
+: read; ( -- ) nextt ';' expectChar ;
\ Parse words
@@ -136,17 +131,17 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
\ 5. An expression inside () parens.
: parseFactor ( tok -- node-or-0 )
dup S" (" s= if ( tok )
- drop _nextt parseExpression _nextt ')' expectChar exit then
+ drop nextt parseExpression nextt ')' expectChar exit then
dup uopid if ( tok opid )
nip AST_UNARYOP createnode swap , ( opnode )
- _nextt parseFactor ?dup _assert over addnode ( opnode )
+ nextt parseFactor ?dup _assert over addnode ( opnode )
exit then ( tok )
dup isIdent? if \ lvalue or FunCall
- _nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
+ nextt ( prevtok newtok ) dup S" (" s= if \ FunCall
drop AST_FUNCALL createnode swap , begin ( node )
- _nextt dup parseFactor ?dup if \ an argument
+ nextt dup parseFactor ?dup if \ an argument
nip over addnode
- _nextt dup S" ," s= if drop else to nexttputback then 0
+ nextt dup S" ," s= if drop else to nexttputback then 0
else \ not an argument
')' expectChar 1 then until ( node )
else ( prevtok newtok ) \ lvalue
@@ -162,13 +157,13 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
\ 3. A binaryop containing two expressions.
: _ ( tok -- exprnode ) \ parseExpression
\ tok is expected to be a factor
- parseFactor ?dup _assert _nextt ( factor nexttok )
+ parseFactor ?dup _assert nextt ( factor nexttok )
dup bopid if ( factor tok binop )
nip ( factor binop ) AST_BINARYOP createnode swap , ( factor node )
- tuck addnode _nextt ( binnode tok )
+ tuck addnode nextt ( binnode tok )
\ now, let's consume tokens as long as we have binops coming.
begin ( bn tok )
- parseFactor ?dup _assert _nextt ( bn factor tok ) dup bopid if ( bn fn tok bopid )
+ parseFactor ?dup _assert nextt ( bn factor tok ) dup bopid if ( bn fn tok bopid )
nip AST_BINARYOP createnode swap , ( bn1 fn bn2 )
\ another binop! who will get fn? bn1 or bn2? the one that has the
\ best precedence!
@@ -178,7 +173,7 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
else \ bn1 wins. add fn to bn1, bn1 to bn2, bn2 becomes bn
rot over addnode ( bn2 bn1 ) over addnode ( bn2->bn )
then ( bn )
- _nextt 0 ( bn tok 0 )
+ nextt 0 ( bn tok 0 )
else ( bn fn tok ) \ not a binop
\ tok becomes nexttok and we add fn to bn to complete the chain
rot> over addnode swap 1 ( bn tok 1 ) then
@@ -191,24 +186,24 @@ current to parseExpression
: 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 )
+ 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 ( type stmtsnode -- )
- parseDeclare _nextt '=' expectChar dup data1 ( dnode name )
+ parseDeclare nextt '=' expectChar dup data1 ( dnode name )
swap parentnode AST_BINARYOP newnode ( name anode ) 12 ( = ) ,
AST_LVALUE newnode ( name lvnode ) swap , parentnode ( anode )
- _nextt parseExpression read; ( anode expr ) swap addnode ;
+ nextt parseExpression read; ( anode expr ) swap addnode ;
: parseArgSpecs ( funcnode -- )
- _nextt '(' expectChar AST_ARGSPECS newnode _nextt ( argsnode tok )
+ nextt '(' expectChar AST_ARGSPECS newnode nextt ( argsnode tok )
dup S" )" s= if 2drop exit then
begin ( argsnode tok )
expectType over parseDeclare drop
- _nextt dup S" )" s= if 2drop exit then
- ',' expectChar _nextt again ;
+ nextt dup S" )" s= if 2drop exit then
+ ',' expectChar nextt again ;
alias noop parseStatements ( funcnode -- ) \ forward declaration
@@ -216,27 +211,27 @@ alias noop parseStatements ( funcnode -- ) \ forward declaration
2 wordtbl statementhandler ( snode -- snode )
:w ( return )
dup AST_RETURN newnode ( snode rnode )
- _nextt parseExpression read; ( snode rnode expr )
+ nextt parseExpression read; ( snode rnode expr )
swap addnode ( snode ) ;
:w ( if ) dup AST_IF newnode ( snode ifnode )
- _nextt '(' expectChar
- _nextt parseExpression ( sn ifn expr ) over addnode
- _nextt ')' expectChar
+ nextt '(' expectChar
+ nextt parseExpression ( sn ifn expr ) over addnode
+ nextt ')' expectChar
dup parseStatements ( snode ifnode )
- _nextt dup S" else" s= if ( sn ifn tok )
+ nextt dup S" else" s= if ( sn ifn tok )
drop parseStatements else
to nexttputback drop then ;
: _ ( parentnode -- ) \ parseStatements
- _nextt '{' expectChar AST_STATEMENTS newnode _nextt
+ nextt '{' expectChar AST_STATEMENTS newnode nextt
begin ( snode tok )
dup S" }" s= if 2drop exit then
dup statementnames sfind dup 0< if ( snode tok -1 )
- drop dup findtype if ( snode tok type )
+ drop dup parseType 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 ;
+ nextt again ;
current to parseStatements
: parseFunction ( unitnode tok -- )
@@ -245,7 +240,7 @@ current to parseStatements
: parseast ( -- )
AST_UNIT createnode dup to curunit
- nextt ?dup not if exit then begin ( unitnode tok )
- findtype _assert drop
- _nextt expectIdent over swap parseFunction ( unitnode )
- nextt ?dup not until ( unitnode ) drop ;
+ nextt? ?dup not if exit then begin ( unitnode tok )
+ parseType _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,9 +4,9 @@ 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/type.fs
f<< cc/tree.fs
f<< cc/ast.fs
f<< cc/map.fs
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -61,7 +61,7 @@ create _ 8 c, ," 09AZaz__"
over >r c!+ ( c a ) begin c!+ next drop r> ( str ) ;
\ Returns the next token as a string or 0 when there's no more token to consume.
-: nextt ( -- tok-or-0 )
+: nextt? ( -- tok-or-0 )
tonws dup not if ( EOF ) exit then ( c )
dup isSym1? if ( c )
cc< 2dup isSym2? if ( c1 c2 )
@@ -79,3 +79,12 @@ create _ 8 c, ," 09AZaz__"
Ac!+ cc< dup identifier? not until to putback
r> ( buf ) A> over 1+ - ( tok len ) over c! r>A
then ;
+
+\ if not 0, next nextt call will fetch token from here
+0 value nexttputback
+
+\ Fetch the next token, aborting if there's none. Also, apply the "putback"
+\ logic.
+: nextt ( -- tok )
+ nexttputback ?dup if 0 to nexttputback exit then
+ nextt? ?dup not if abort" expecting token!" then ;
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -1,23 +1,22 @@
\ C compiler types
+\ Requires lib/str cc/tok
\ 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"
+4 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 ;
+\ Unlike ANSI C, "signed" doesn't exist and "unsigned" needs to be before the
+\ type name.
+: parseType ( tok -- type? f )
+ dup S" unsigned" s= if drop $04 nextt else $00 swap then ( type tok )
+ typenames sfind dup 0>= if ( type idx ) or 1 else 2drop 0 then ( type ) ;
-: printtype ( type -- ) 3 and typenames slistiter stype ;
+: printtype ( type -- )
+ dup typesigned? if ." unsigned " then
+ 3 and typenames slistiter stype ;
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -12,8 +12,8 @@ int boolops() {
return 66 < 54 && 2 == 2;
}
int variables() {
- int foo = 40;
- int _bar = 2;
+ unsigned int foo = 40;
+ unsigned int _bar = 2;
_bar = foo + _bar;
return foo + _bar;
}
