commit 2a421f5e6d2e4e005a64c8490ab027e06840efde
parent d67a41ba37e859772d87aed8530fcb555428d03c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 1 Apr 2023 19:06:14 -0400
halcc: almost all struct tests passing!
Logic for struct -> and . operators was messy. It's clearer now.
Diffstat:
8 files changed, 59 insertions(+), 13 deletions(-)
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -133,20 +133,25 @@ code _callA branchA,
swap Result :hal$ A>) lea, A) @, A) [+n], Result :W ;
: _arrow ( res -- res )
- dup Result lvl 1 = _assert dup Result cdecl nextt ( res cdecl name )
+ 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 ;
+ over Result :?>W i) +, ( field-cdecl res ) tuck to Result cdecl
+ dup Result cdecl CDecl nbelem not if Result :* then ;
\ 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 )
nextt case ( )
'[' of isChar?^ \ x[y] is the equivalent of *(x+y)
- nextt parseExpression _+, Result :*
+ dup Result :. nextt parseExpression _+, Result :*
nextt ']' expectChar parsePostfixOp endof
'(' of isChar?^ _funcall parsePostfixOp endof
- S" ->" of s= _arrow parsePostfixOp endof
- '.' of isChar?^ _arrow Result :* parsePostfixOp endof
+ S" ->" of s=
+ dup Result cdecl CDecl :structarrow? _assert
+ _arrow parsePostfixOp endof
+ '.' of isChar?^
+ dup Result cdecl CDecl :structdot? _assert
+ _arrow parsePostfixOp endof
S" ++" of s= 1 _incdec, endof
S" --" of s= -1 _incdec, endof
r@ to nexttputback
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -75,7 +75,7 @@ struct[ Result
CONST of = arg i) endof
CDECL of = dup cdecl CDecl :halop swap :nb) endof
PS of = arg PSP+) endof
- REF of = target :hal# &) endof
+ REF of = target :hal# &) 32b) endof
DEREF of =
dup target dup :isW? if :release W) &) else :hal# then ( self halop )
A>) @, A) swap :nb) endof
diff --git a/fs/comp/c/type.fs b/fs/comp/c/type.fs
@@ -44,7 +44,7 @@ STORAGE_MEM value curstorage
: cdecl? ( type -- f ) $f > ;
: nb) ( halop sz -- halop )
- case 1 of = 8b) endof 2 of = 16b) endof 4 of = endof _err endcase ;
+ case 1 of = 8b) endof 2 of = 16b) endof 4 of = 32b) endof _err endcase ;
\ CDecl flags
\ b0=is a struct? if 1, this is an "empty" CDecl with the name of the struct.
@@ -78,11 +78,14 @@ struct[ CDecl
: :isarg? ( self -- f ) storage STORAGE_PS = ;
: :isvar? ( self -- f ) storage STORAGE_RS = ;
: :isglobal? ( self -- f ) storage STORAGE_MEM = ;
- : :structref? ( self -- f ) \ is a direct Struct reference?
- dup lvl if drop 0 else type dup cdecl? if :struct? else drop 0 then then ;
+ : _ type dup cdecl? if :struct? else drop 0 then ;
+ : :structdot? ( self -- f ) \ is a direct Struct reference?
+ dup lvl if drop 0 else _ then ;
+ : :structarrow? ( self -- f ) \ is an indirect Struct reference?
+ dup lvl 1 = if _ else drop 0 then ;
\ Arrays, function signatures and struct ident "naturally" yield references.
- : :reference? bi+ nbelem bool | :funcsig? or swap :structref? or ;
+ : :reference? bi+ nbelem bool | :funcsig? or swap :structdot? or ;
: :lvl bi lvl | :reference? + ;
: :halop ( self -- operand ) dup bi offset | storage case ( self offset )
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -12,6 +12,9 @@ PSP) -- op
RSP) -- op
m) addr -- op
+) op disp -- op Can be applied multiple times
+8b) op -- op
+16b) op -- op
+32b) op -- op
Maximum displacement in Low HAL: 8-bit
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -94,11 +94,11 @@ $72 2 binop11 $1c #eq
structop1 44 #eq
structop2 45 #eq
structop3 42 #eq
-testend \s
structop4 globdata 12 + #eq
structop5 42 #eq
structop6 54 #eq
structop7 42 #eq
+testend \s
12 42 structop8 54 #eq
cond2 scnt not # \ don't crash or leak
opwidth1 42 #eq
diff --git a/fs/tests/comp/c/test2.c b/fs/tests/comp/c/test2.c
@@ -386,3 +386,38 @@ unsigned char structop3() {
int structop4() {
return &globdata.array[1];
}
+// the combination of struct pointer, struct field subscripting, assignment and
+// postop all at once caused the i386 VM to misallocate registers.
+int structop5() {
+ MyStruct *s = &globdata;
+ s->foo = 1;
+ s->baz[s->foo++] = 42;
+ return globdata.baz[1];
+}
+// in the forth VM, PS would get mixed up in assignops that weren't "=", when
+// being assigned a complex expression.
+int structop6() {
+ int n = 12;
+ globdata.baz[1] = 42;
+ globdata.bar = 1;
+ n += globdata.baz[globdata.bar];
+ return n;
+}
+MyStruct *globdataptr;
+short structop7() {
+ globdata.bar = 42;
+ globdataptr = &globdata;
+ return globdataptr->bar;
+}
+
+// in the forth VM, the address of the call would get lost on PS in certain
+// situations, such as this one: a function living in a struct and accessed
+// through a pointer.
+struct StructWithFunc { int (*func)(int, int); };
+int structop8(int a, int b) {
+ StructWithFunc s;
+ StructWithFunc *ptr = &s;
+ s.func = adder;
+ return ptr->func(a, b);
+}
+
diff --git a/posix/dis.c b/posix/dis.c
@@ -196,10 +196,9 @@ void printhalop(int n) {
case 2: printf("PSP"); break;
case 3: printf("RSP"); break;
case 4: printf("m"); break;
- case 5: printf("i"); break;
default: printf("err");
}
- if (n & 0x10) printf("*");
+ if (n & 0x10) printf("&");
if (n & 0x20) printf(">A");
if (n & 0x40) printf("<>");
}
diff --git a/posix/vm.c b/posix/vm.c
@@ -1017,6 +1017,7 @@ static void buildsysdict() {
entry("rshift"); wopwr(0x12 /* @! */, OPPSP); binopwr(0x06, OPPSP); nipwr(); retwr();
entry("16b)"); litwr(OP16B); callwr(find("or")); retwr();
entry("8b)"); litwr(OP8B); callwr(find("or")); retwr();
+ entry("32b)"); litwr((OP8B|OP16B)^0xffffffff); callwr(find("and")); retwr();
entry("A>)"); litwr(OPADEST); callwr(find("or")); retwr();
entry("<>)"); litwr(OPINVERT); callwr(find("xor")); retwr();
entry("&)"); litwr(OPDIRECT); callwr(find("or")); retwr();
