duskos

commit 26616840b09b8589dcc905d443dd3940092fc794
parent 9a94607b0c751cf1b4fe56c1c80242d1e7e71a93
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Mon, 19 Sep 2022 14:50:12 -0400

cc: add while and do..while

Diffstat:
M
fs/cc/ast.fs
 | 
28
++++++++++++++++++++++------
M
fs/cc/gen.fs
 | 
11
+++++++++++
M
fs/cc/ttr.fs
 | 
2
++
M
fs/tests/cc/cc.fs
 | 
2
++
M
fs/tests/cc/test.c
 | 
14
++++++++++++++

5 files changed, 51 insertions(+), 6 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -42,7 +42,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
 : boptoken ( opid -- tok ) BOPTlist slistiter ;
 
 \ AST node types
-19 const ASTIDCNT
+21 const ASTIDCNT
 0 const AST_DECLARE
 1 const AST_UNIT
 2 const AST_FUNCTION
@@ -62,6 +62,8 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 3 c, 3 c, 3 c, 3 c,
 16 const AST_PSPUSH
 17 const AST_PSPOP
 18 const AST_BREAK
+19 const AST_WHILE
+20 const AST_DO
 
 extends Node struct[ ASTNode
 ]struct
@@ -208,6 +210,7 @@ extends ASTNode struct[ StrLit
 ASTIDCNT stringlist astidnames
 "declare" "unit" "function" "return" "constant" "stmts" "args" "ident"
 "unaryop" "postop" "binop" "list" "if" "str" "call" "for" "push" "pop" "break"
+"while" "do"
 
 0 value curextern \ is current definition "extern"?
 
@@ -243,6 +246,8 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 'w noop ( PSPush )
 'w noop ( PSPop )
 'w noop ( Break )
+'w noop ( While )
+'w noop ( Do )
 
 : printast ( node -- )
     ?dup not if ." null" exit then
@@ -439,8 +444,8 @@ current to parseExpression
 
 alias noop parseStatements ( funcnode -- ) \ forward declaration
 
-5 stringlist statementnames "return" "if" "for" "pspush" "break"
-5 wordtbl statementhandler ( snode -- snode )
+7 stringlist statementnames "return" "if" "for" "pspush" "break" "while" "do"
+7 wordtbl statementhandler ( snode -- snode )
 :w ( return )
   dup AST_RETURN newnode ( snode rnode )
   nextt dup S" ;" s= if \ empty returns are allowed
@@ -458,17 +463,28 @@ alias noop parseStatements ( funcnode -- ) \ forward declaration
 :w ( for ) dup AST_FOR newnode ( snode fornode )
   nextt '(' expectChar
   nextt parseExpression ( sn forn expr ) over Node :add
-  nextt ';' expectChar
+  read;
   nextt parseExpression ( sn forn expr ) over Node :add
-  nextt ';' expectChar
+  read;
   nextt parseExpression ( sn forn expr ) over Node :add
   nextt ')' expectChar
-  parseStatements ( snode ifnode ) ;
+  parseStatements ( snode ) ;
 :w ( pspush ) dup AST_PSPUSH newnode ( snode pushnode )
   nextt '(' expectChar
   nextt parseExpression swap Node :add
   nextt ')' expectChar read; ;
 :w ( break ) dup AST_BREAK newnode drop ( snode ) read; ;
+:w ( while ) dup AST_WHILE newnode ( snode whilenode )
+  nextt '(' expectChar
+  nextt parseExpression ( sn whilen expr ) over Node :add
+  nextt ')' expectChar
+  parseStatements ( snode ) ;
+:w ( do ) dup AST_DO newnode ( snode donode )
+  dup parseStatements ( snode donode )
+  nextt S" while" s= _assert
+  nextt '(' expectChar
+  nextt parseExpression ( sn don expr ) swap Node :add
+  nextt ')' expectChar read; ;
 
 : _ ( parentnode -- ) \ parseStatements
   nextt '{' expectChar AST_STATEMENTS newnode nextt
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -243,6 +243,17 @@ ASTIDCNT wordtbl gentbl ( node -- )
 :w ( PSPush ) Node firstchild dup _assert gennode vmpspush, ;
 :w ( PSPop ) drop vmpspop, ;
 :w ( Break ) drop addbreak ;
+:w ( While )
+  here swap ( loop_addr node )
+  Node firstchild dup _assert dup gennode \ control
+  vmjz[, swap ( loop' cond' node ) ops$
+  Node nextsibling ( loop' cond' stmtnode ) dup _assert gennode \ body
+  ( loop' cond' ) swap vmjmp, ]vmjmp resolvebreaks ;
+:w ( Do )
+  here swap ( loop_addr node )
+  Node firstchild dup _assert dup gennode \ body
+  Node nextsibling ( loop' node ) dup _assert gennode \ control
+  vmjnz, ops$ resolvebreaks ;
 
 : _ ( node -- ) gentbl over Node id wexec ;
 current to gennode
diff --git a/fs/cc/ttr.fs b/fs/cc/ttr.fs
@@ -76,6 +76,8 @@ ASTIDCNT wordtbl trtbl ( node -- )
 'w drop ( PSPush )
 'w drop ( PSPop )
 'w drop ( Break )
+'w trchildren ( While )
+'w trchildren ( Do )
 
 : _ ( node -- ) trtbl over Node id wexec ;
 current to trnode
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -49,6 +49,8 @@ S" foobar" 2 get8b 'o' #eq
 S" foobar" 4 get8b 'b' #eq
 S" foobar" dup 2 'X' set8b S" fXobar" #s=
 S" foobar" dup 6 'X' set8b S" foobaX" #s=
+5 whilesum 15 #eq
+5 dowhilesum 15 #eq
 
 \ and what about inline functions?
 :cfunc int myinline() { return 42; }
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -175,3 +175,17 @@ extern char get8b(char *s, int i) {
 extern void set8b(char *s, int i, char c) {
     s[i] = c;
 }
+extern void whilesum(int n) {
+    int res = 0;
+    while (n) {
+        res = res + n--;
+    }
+    return res;
+}
+extern void dowhilesum(int n) {
+    int res = 0;
+    do {
+        res = res + n--;
+    } while (n);
+    return res;
+}