commit 6b3e0070bde0711ce26791070704d0392b323ede
parent 1c2f3d836836d6884f4f48b09a21b903be20d8d8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 15 Jun 2022 16:22:19 -0400
cc: add if statement
Diffstat:
5 files changed, 55 insertions(+), 33 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -9,7 +9,7 @@
\ 1 ~ Complement
\ 2 ! Not
-3 value UOPSCNT
+3 const UOPSCNT
create uopssyms ," -~!?"
: uopid ( tok -- opid? f )
@@ -21,7 +21,7 @@ create uopssyms ," -~!?"
\ ID Sym Name
\ 0 & Reference
\ 1 * Dereference
-2 value LOPSCNT
+2 const LOPSCNT
create lopssyms ," &*?"
: lopid ( tok -- opid? f )
@@ -36,7 +36,7 @@ create lopssyms ," &*?"
\ 2 * Multiplication
\ 3 / Division
-12 value BOPSCNT
+12 const BOPSCNT
create BOPTlist 1 c, ," +" 1 c, ," -" 1 c, ," *" 1 c, ," /"
1 c, ," <" 1 c, ," >" 2 c, ," <=" 2 c, ," >="
2 c, ," ==" 2 c, ," !=" 2 c, ," &&" 2 c, ," ||"
@@ -51,28 +51,28 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
: boptoken ( opid -- tok ) BOPTlist slistiter ;
\ AST node types
-15 value ASTIDCNT
-0 value AST_DECLARE \ data1=name data2='*' levels
-1 value AST_UNIT
-2 value AST_FUNCTION \ data1=name data2=MAP_FUNCTION
-3 value AST_RETURN
-4 value AST_CONSTANT \ data1=value
-5 value AST_STATEMENTS
-6 value AST_ARGSPECS
-7 value AST_LVALUE \ data1=varname
-8 value AST_UNARYOP \ data1=uopid
-9 value AST_ASSIGN
-10 value AST_BINARYOP \ data1=bopid
-11 value AST_LVALUEOP \ data1=lopid
-\ 12 = unused
+15 const ASTIDCNT
+0 const AST_DECLARE \ data1=name data2='*' levels
+1 const AST_UNIT
+2 const AST_FUNCTION \ data1=name data2=MAP_FUNCTION
+3 const AST_RETURN
+4 const AST_CONSTANT \ data1=value
+5 const AST_STATEMENTS
+6 const AST_ARGSPECS
+7 const AST_LVALUE \ data1=varname
+8 const AST_UNARYOP \ data1=uopid
+9 const AST_ASSIGN
+10 const AST_BINARYOP \ data1=bopid
+11 const AST_LVALUEOP \ data1=lopid
+12 const AST_IF
\ 13 = unused
-14 value AST_FUNCALL \ data1=name data2=MAP_FUNCTION
+14 const AST_FUNCALL \ data1=name data2=MAP_FUNCTION
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"
6 c, ," assign" 5 c, ," binop" 6 c, ," lvalop"
- 1 c, ," _" 3 c, ," var" 4 c, ," call"
+ 2 c, ," if" 1 c, ," _" 4 c, ," call"
0 c,
0 value curunit \ points to current Unit, the beginning of the AST
@@ -236,19 +236,30 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
_nextt '=' expectChar ( anode )
_nextt parseExpression read; ( anode expr ) swap addnode ;
-: parseStatements ( funcnode -- )
+alias noop parseStatements ( funcnode -- ) \ forward declaration
+
+create statementnames 6 c, ," return" 2 c, ," if" 0 c,
+2 wordtbl statementhandler ( snode -- snode )
+:w ( return )
+ dup AST_RETURN newnode ( snode rnode )
+ _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
+ parseStatements ;
+
+: _ ( parentnode -- ) \ parseStatements
_nextt '{' expectChar AST_STATEMENTS newnode _nextt
begin ( snode tok )
dup S" }" s= if 2drop exit then
- dup S" return" s= if
- drop AST_RETURN createnode ( snode rnode ) 2dup swap addnode
- _nextt parseExpression read; ( snode rnode expr )
- swap addnode ( snode )
- else ( snode tok )
- dup isType? if drop dup parseDeclarationList else ( snode tok )
- over rot> parseAssign ( snode ) then
- then ( snode )
+ dup statementnames sfind dup 0< if ( snode tok -1 )
+ drop dup isType? if drop dup parseDeclarationList else ( snode tok )
+ over rot> parseAssign then ( snode )
+ else ( snode tok idx ) nip statementhandler swap wexec then ( snode )
_nextt again ;
+current to parseStatements
: parseFunction ( unitnode tok -- )
swap AST_FUNCTION newnode swap , 0 , ( funcnode )
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -26,8 +26,8 @@ BOPSCNT wordtbl bopgentblmiddle ( node -- node )
'w noop ( >= )
'w noop ( == )
'w noop ( != )
-'w vmjz, ( && )
-'w vmjnz, ( || )
+:w ( && ) vmjz, swap ;
+:w ( || ) vmjnz, swap ;
BOPSCNT wordtbl bopgentblpost ( -- )
'w vmadd, ( + )
@@ -96,7 +96,10 @@ ASTIDCNT wordtbl gentbl ( node -- )
:w ( LValueOp )
dup firstchild ?dup not if _err then gennode
data1 lopgentbl swap wexec ;
-'w _err ( unused )
+:w ( If )
+ firstchild ?dup not if _err then dup gennode ( exprnode )
+ operand?>result vmjz, swap ( jump_addr exprnode )
+ nextsibling ?dup not if _err then gennode ( jump_addr ) vmjmp! ;
'w _err ( unused )
:w ( FunCall )
\ pass arguments
diff --git a/fs/cc/vm.fs b/fs/cc/vm.fs
@@ -167,7 +167,7 @@ VM_NONE value operand
: vmjmp! ( 'jump_addr -- ) here over - 4 - swap ! ;
: vmjz, ( -- addr )
eax eax test, 0 to resultset?
- 0 jz, here 4 - swap ;
+ 0 jz, here 4 - ;
: vmjnz, ( -- addr )
eax eax test, 0 to resultset?
- 0 jnz, here 4 - swap ;
+ 0 jnz, here 4 - ;
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -15,4 +15,6 @@ funcall 42 #eq
42 plusone 43 #eq
ptrget 42 #eq
ptrset 54 #eq
+12 condif 12 #eq
+42 condif 142 #eq
testend
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -37,3 +37,9 @@ int ptrset() {
*b = 54;
return a;
}
+int condif(int x) {
+ if (x == 42) {
+ x = x+100;
+ }
+ return x;
+}
