duskos

commit a72bc11f3f3b1aa72ee9acabadf419f7f2544b2d
parent abcdbcc66def1957b1b7679a3acc79e49838ab60
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 31 Mar 2023 17:12:19 -0400

halcc: structget() structset()

Diffstat:
M
fs/comp/c/egen.fs
 | 
17
+++++++++++------
M
fs/comp/c/expr.fs
 | 
5
+++--
M
fs/tests/comp/c/cc.fs
 | 
3
+--
M
fs/tests/comp/c/test2.c
 | 
18
++++++++++++++++++

4 files changed, 33 insertions(+), 10 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -46,16 +46,16 @@ UOPSCNT wordtbl uoptbl ( res -- res )
 
 \ ops that can freely swap their operands
 : _prep ( left right -- left halop )
-  dup Result :isW? if swap then over Result :?>W Result :hal$ ;
+  dup Result :hasW? if swap then over Result :?>W Result :hal$ ;
 : _*, _prep *, ; : _&, _prep and, ; : _^, _prep xor, ; : _|, _prep or, ;
 : _&&, _prep and, ;
 : _||, _prep or, W=0>Z, NZ) C>W, ;
+\ TODO: generalize CDecl hamonization (:copymeta below)
 : _+, ( left right -- res )
-  over Result :*arisz over Result :*arisz <> if
+  over >r over Result :*arisz over Result :*arisz <> if
     over Result :*arisz 1 = if swap then \ left has mutiplier
-    over Result :*arisz over Result :*n ( left right*arisz )
-    over >r _prep +, r> over Result :copymeta
-    else _prep +, then ;
+    over Result :*arisz over Result :*n ( left right*arisz ) then
+  _prep +, r> over Result :copymeta ;
 
 \ ops that can't freely swap their operands
 : _prep ( left right -- left halop ) Result :?>A$ over Result :?>W ;
@@ -130,6 +130,11 @@ code _callA branchA,
   over Result :*arisz *
   swap bi+ Result :hal# | Result :?>W ( incsz res halop ) rot swap [+n], ;
 
+: _arrow ( res -- res )
+  dup Result lvl 1 = _assert dup Result :cdecl# nextt ( res cdecl name )
+  swap CDecl type CDecl :find# tuck CDecl offset ( field-cdecl res offset )
+  over Result :?>W i) +, ( field-cdecl res ) tuck to Result cdecl ;
+
 \ parses, if possible, a postfix operator. If none, this is a noop.
 \ We parse postfix args as long as there are any.
 : parsePostfixOp ( res -- res )
@@ -138,7 +143,7 @@ code _callA branchA,
       nextt parseExpression _+, Result :*
       nextt ']' expectChar parsePostfixOp endof
     '(' of isChar?^ _funcall parsePostfixOp endof
-    S" ->" of s= abort" TODO ->" endof
+    S" ->" of s= _arrow parsePostfixOp endof
     '.' of isChar?^ abort" TODO ." endof
     S" ++" of s= 1 _incdec, endof
     S" --" of s= -1 _incdec, endof
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -34,6 +34,7 @@ struct[ Result
   : :const ( n -- res ) CONST :new ;
   : :W ( -- res ) :Wfree# 0 W :new dup to currentW ;
   : :isW? ( self -- f ) type W = ;
+  : :hasW? ( self -- f ) dup target ?dup if nip :hasW? else :isW? then ;
   : :release ( self -- ) dup :isW? if 0 to currentW then NONE swap to type ;
   : :>PS
     dup :isW? _assert dup :release
@@ -88,7 +89,7 @@ struct[ Result
   : :iszero? bi arg 0 = | :isconst? and ;
   : :isone? bi arg 1 = | :isconst? and ;
   : :const# dup :isconst? _assert arg ;
-  : :?>W dup :isW? if drop else :?freeCurrentW :>W then ;
+  : :?>W dup :hasW? not if :?freeCurrentW then :>W ;
   : :?>W$ dup :?>W :release ;
   \ Free up W by sending it to A if needed.
   : :?>A$ ( self -- halop )
@@ -106,7 +107,7 @@ struct[ Result
       0 of = drop 1 endof
       1 of = :basesz endof
       drop 4 endcase ;
-  : :toint ( self -- ) 0 over to cdecl 0 swap to lvl ;
+  : :toint ( self -- ) UintCDecl over to cdecl 0 swap to lvl ;
 ]struct
 
 BOPSCNT wordtbl _tbl ( a b -- n )
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -62,13 +62,12 @@ S" foobar" 4 get8b 'b' #eq
 S" foobar" dup 2 'X' set8b S" fXobar" #s=
 S" foobar" dup 6 'X' set8b S" foobaX" #s=
 typecast 1 #eq
-testend \s
 5 whilesum 15 #eq
 5 dowhilesum 15 #eq
-testend \s
 create mydata 42 , $12345678 , $23456789 ,
 mydata structget $35 #eq
 mydata $42 structset mydata 4 + @ $42345678 #eq
+testend \s
 42 globstructset globstructget 42 #eq
 globdata 4 + 16b @ 42 #eq
 0 callfuncidx 42 #eq
diff --git a/fs/tests/comp/c/test2.c b/fs/tests/comp/c/test2.c
@@ -249,3 +249,21 @@ void dowhilesum(int n) {
     } while (n);
     return res;
 }
+
+typedef char MyType;
+typedef MyType** MyTypePtr;
+
+struct MyStruct {
+    int foo;
+    short bar;
+    MyType baz[2];
+    int array[2], another;
+};
+
+MyType structget(MyStruct *s) {
+    int x = 1;
+    return s->baz[x-1] + 1;
+}
+void structset(MyStruct *s, char val) {
+    s->baz[1] = val;
+}