duskos

commit afa6c6a9c39b33adc7112f14b2e40e11ca5b9b63
parent 293ee41767d34809be8d7090185040abf12b8a54
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sun,  3 Jul 2022 11:25:59 -0400

cc: add string literals

Diffstat:
M
fs/cc/ast.fs
 | 
30
+++++++++++++++++++-----------
M
fs/cc/gen.fs
 | 
5
++++-
M
fs/cc/tok.fs
 | 
4
++--
M
fs/tests/cc/cc.fs
 | 
1
+
M
fs/tests/cc/test.c
 | 
7
+++++++

5 files changed, 33 insertions(+), 14 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -48,7 +48,7 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
 10 const AST_BINARYOP
 11 const AST_LIST      \ list of lvalues or constants: {1, 2, 3}
 12 const AST_IF
-\ 13 = unused
+13 const AST_STRLIT
 14 const AST_FUNCALL
 
 \ It's important that decl.name and func.name have the same offset. Poor man's
@@ -66,10 +66,11 @@ NODESZ      ufield ast.lvalue.name
 NODESZ      ufield ast.uop.opid
 NODESZ      ufield ast.pop.opid
 NODESZ      ufield ast.bop.opid
+NODESZ      'ufield ast.strlit.value
 NODESZ      ufield ast.funcall.funcname
 ASTIDCNT stringlist astidnames
 "declare" "unit" "function" "return" "constant" "stmts" "args" "lvalue"
-"unaryop" "postop" "binop" "list" "if" "_" "call"
+"unaryop" "postop" "binop" "list" "if" "str" "call"
 
 0 value curunit \ points to current Unit, the beginning of the AST
 
@@ -132,9 +133,9 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 :w ( UnaryOp ) _[ dup ast.uop.opid uoptoken stype _] ;
 :w ( PostfixOp ) _[ dup ast.pop.opid poptoken stype _] ;
 :w ( BinaryOp ) _[ dup ast.bop.opid boptoken stype _] ;
-'w noop ( Unused )
+'w noop ( List )
 'w noop ( If )
-'w noop ( Unused )
+:w ( StrLit ) _[ dup ast.strlit.value stype _] ;
 :w ( FunCall ) _[ dup ast.funcall.funcname stype _] ;
 
 : printast ( node -- )
@@ -163,8 +164,9 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
   c@+ >r begin ( a )
     c@+ identifier? not if r~ drop 0 exit then next drop 1 ;
 : expectIdent ( tok -- tok ) dup isIdent? _assert ;
-: expectChar ( tok c -- )
-  over 1+ c@ = _assert dup c@ 1 = _assert drop ;
+: isChar? ( tok c -- f ) over 1+ c@ = swap c@ 1 = and ;
+: isChar?^ ( c tok -- f ) swap isChar? ; \ for "case..of"
+: expectChar ( tok c -- ) isChar? _assert ;
 : read; ( -- ) nextt ';' expectChar ;
 
 \ Parse words
@@ -173,7 +175,7 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
 
 \ The first '{' has already been read
 : parseList ( -- node )
-  AST_LIST createnode nextt dup S" }" s= if drop exit then
+  AST_LIST createnode nextt dup '}' isChar? if drop exit then
   begin ( lnode tok ) case
       of isIdent? ( lnode )
         AST_IDENT createnode swap , ( lnode inode ) over addnode endof
@@ -182,14 +184,14 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
       _err
     endcase
     nextt case
-      S" }" of s= r~ exit endof
-      S" ," of s= endof
+      '}' of isChar?^ r~ exit endof
+      ',' of isChar?^ endof
       _err
     endcase
   nextt again ;
 
 : parsePostfixOp ( tok inode -- node )
-  over S" [" s= if ( tok inode ) \ x[y] is the equivalent of *(x+y)
+  over '[' isChar? if ( tok inode ) \ x[y] is the equivalent of *(x+y)
     nip AST_BINARYOP createnode 0 ( + ) , ( inode bnode )
     tuck addnode ( bnode )
     AST_CONSTANT createnode nextt parse _assert , ( bnode cnode )
@@ -209,10 +211,16 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
 \ 3. A unaryop/postfixop containing a factor
 \ 4. A function call
 \ 5. An expression inside () parens.
+\ 6. A string literal
 : parseFactor ( tok -- node-or-0 )
   case
-  S" (" of s= ( )
+  '(' of isChar?^ ( )
     nextt parseExpression nextt ')' expectChar endof
+  '"' of isChar?^ ( )
+    AST_STRLIT createnode 0 c, 0 begin ( node cnt )
+      _cc< dup '"' = not while c, 1+ repeat ( node cnt c )
+    drop over NODESZ + c! ( node )
+  endof
   of uopid ( opid )
     AST_UNARYOP createnode swap , ( opnode )
     nextt parseFactor ?dup _assert over addnode ( opnode ) endof
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -212,7 +212,10 @@ ASTIDCNT wordtbl gentbl ( node -- )
   nextsibling ?dup if ( jump_addr elsenode )
     vmjmp, ( ja1 enode ja2 ) rot vmjmp! ( enode ja2 )
     swap gennode ( ja2 ) then ( jump_addr ) vmjmp! ;
-'w _err ( unused )
+:w ( StrLit )
+  vmjmp, here ( snode jaddr saddr )
+  rot ast.strlit.value dup c@ ( jaddr saddr str len )
+  1+ move, ( jaddr saddr ) const>op vmjmp! ;
 :w ( FunCall )
   \ pass arguments
   dup childcount 4 * callargallot,
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -23,9 +23,9 @@
 \ with a symbol that is also a 1 char symbol and all 3 chars symbols begin with
 \ 2 chars that are also a 2 chars symbol.
 \ list of 1 char symbols
-create symbols1 ," +-*/~&<>=[](){}.%^?:;,"
+create symbols1 ," +-*/~&<>=[](){}.%^?:;," '"' c,
 
-: isSym1? ( c -- f ) symbols1 22 [c]? 0>= ;
+: isSym1? ( c -- f ) symbols1 23 [c]? 0>= ;
 
 \ list of 2 chars symbols
 create symbols2 ," <=>===!=&&||++---><<>>+=-=*=/=%=&=^=|=/**///"
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -24,4 +24,5 @@ cnoop ( no result! ) scnt 0 #eq
 array 52 #eq
 global 1234 #eq
 42 142 sysword 142 #eq
+helloworld S" Hello World!" #s=
 testend
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -87,3 +87,10 @@ int global() {
 int sysword(int a, int b) {
     return max(a, b);
 }
+// TODO: the effect would be better with stype(), but unfortunately, because
+// stype doesn't return an argument, the stackframe is broken when we call it.
+// When we begin supporting C signature in forth word annotations, then we can
+// revisit this and call stype().
+int helloworld() {
+    return "Hello World!";
+}