~vdupras/duskos

18b601d8b433feac1c4ef3eb33b45e68a23defa7 — Virgil Dupras a month ago 9fe129f
halcc: fix pointer logic bugs
M Makefile => Makefile +2 -2
@@ 66,8 66,8 @@ testhal: dusk
	echo "' byefail ' abort realias f<< tests/asm/hal.fs bye" | ./dusk || (echo; exit 1)

.PHONY: testtext
testcos: dusk
	echo "' byefail ' abort realias f<< tests/emul/cos/all.fs bye" | ./dusk || (echo; exit 1)
testuxn: dusk
	echo "' byefail ' abort realias f<< tests/emul/uxn/all.fs bye" | ./dusk || (echo; exit 1)

.PHONY: clean
clean:

M fs/comp/c/egen.fs => fs/comp/c/egen.fs +3 -3
@@ 140,9 140,9 @@ code _callA branchA,
: _arrow ( res -- res )
  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
  \ TODO: use :reference? instead of nbelem, but there's a mixup for funcs
  dup Result cdecl CDecl nbelem not if Result :* then ;
  over Result :?>W i) +, ( field-cdecl res ) tuck Result :cdecl!
  dup Result cdecl CDecl :reference? not if
    1 over to+ Result lvl Result :* then ;

\ parses, if possible, a postfix operator. If none, this is a noop.
\ We parse postfix args as long as there are any.

M fs/comp/c/expr.fs => fs/comp/c/expr.fs +5 -8
@@ 7,7 7,7 @@
: _assert ( f -- ) not if _err then ;

: nb) ( halop sz -- halop )
  case 1 of = 8b) endof 2 of = 16b) endof 4 of = 32b) endof _err endcase ;
  case 1 of = 8b) endof 2 of = 16b) endof 4 of = 32b) endof abort" nb)" endcase ;

NULLSTR TYPE_UINT CDecl :new const UintCDecl



@@ 59,19 59,16 @@ struct[ Result
  : :copymeta ( other self -- )
    over cdecl over to cdecl
    swap lvl swap to lvl ;
  : :cdecl! ( cdecl self -- ) over CDecl :lvl over to lvl to cdecl ;
  : :& ( self -- res )
    dup type DEREF = if target exit then
    dup :iscdecl? _assert
    dup cdecl CDecl :reference? if exit then
    dup :iscdecl? _assert
    0 REF :new ( tgt res ) 2dup :copymeta tuck to target 1 over to+ lvl ;
  : :* ( self -- res )
    0 DEREF :new 2dup :copymeta tuck to target
    dup lvl if -1 over to+ lvl else
      dup cdecl CDecl type over to cdecl dup cdecl CDecl :lvl over to lvl then ;
  : :cdecl ( cdecl -- res )
    0 CDECL :new ( cdecl res )
    over CDecl :lvl over to lvl tuck to cdecl ;

    dup lvl if -1 over to+ lvl else dup cdecl CDecl type over :cdecl! then ;
  : :cdecl ( cdecl -- res ) 0 CDECL :new ( cdecl res ) tuck :cdecl! ;
  : :basesz cdecl CDecl type typesize ;
  : :unsigned? cdecl typeunsigned? ;
  : :nb) ( halop self -- halop ) dup lvl if drop else :basesz nb) then ;

M fs/comp/c/type.fs => fs/comp/c/type.fs +2 -1
@@ 123,7 123,8 @@ struct[ CDecl
    r@ storage _storagechars + c@ emit spc>
    r@ offset if '+' emit r@ offset .x? spc> then
    r@ :struct? if ." struct" else
      r@ type _printtype r@ lvl for '*' emit next then
      '{' emit r@ type _printtype '}' emit
      r@ lvl for '*' emit next then
    r@ name c@ if spc> r@ name stype then
    r@ nbelem if '[' emit r@ nbelem . ']' emit then
    r@ :funcsig? if '(' emit r@ args _.children ')' emit then rdrop ;

M fs/emul/uxn/vm.fs => fs/emul/uxn/vm.fs +1 -1
@@ 2,7 2,7 @@
?f<< /comp/c/lib.fs
cc<< /emul/uxn/vm.c

S" Device" findTypedef CType :export
S" Device" findTypedef CDecl :export

: uxn_set_dev ( port dei deo -- )
  rot uxn_dev tuck to Device deo to Device dei ;

M fs/tests/comp/c/cc.fs => fs/tests/comp/c/cc.fs +2 -0
@@ 100,6 100,7 @@ structop5 42 #eq
structop6 54 #eq
structop7 42 #eq
12 42 structop8 54 #eq
structop9 123 #eq
cond2 scnt not # \ don't crash or leak
opwidth1 42 #eq
opwidth2 42 #eq


@@ 120,6 121,7 @@ myval 42 #eq
ptrari5 6 + @ 42 #eq
123 456 ptrari6 123 456 + #eq
$1234 2 ptrari7 $1238 #eq
ptrari8 @ 42 #eq \ struct that was changed in ptrari5()
funcall1 138 #eq
42 funcall2 85 #eq
funcall3 scnt not # \ no PS leak/underflow

M fs/tests/comp/c/test.c => fs/tests/comp/c/test.c +13 -0
@@ 420,6 420,14 @@ int structop8(int a, int b) {
    return ptr->func(a, b);
}

struct StructWithRef { MyStruct *ref; };
int structop9() {
	StructWithRef s;
	s.ref = &globdata;
	globdata.foo = 123;
	return s.ref->foo;
}

// we used to leak VM ops in condition blocks without {}
void cond1() {
    int x = 42;


@@ 507,6 515,11 @@ int ptrari6(int a, int b) {
int* ptrari7(int *a, uint offset) {
	return a+offset-1;
}
// Spurious & on "reference" CDecls (declarations that "naturally" yield
// references) is accepted. Useless, but accepted.
SixBytes* ptrari8() {
    return &globstructarray[1];
}
// unary op, apart from ++ and --, *don't* modify their target.
int unaryop1(int n) {
    !n;

M fs/tests/comp/c/type.fs => fs/tests/comp/c/type.fs +2 -2
@@ 26,7 26,7 @@ S" bar" over CDecl :find
\ once defined, parseType will find the struct in typedefs
_parse Struct1 STOP over #eq
capture printstruct
S" M struct Struct1 {N unsigned int foo, N +04 short* bar, N +08 char baz[2], }" #s=
S" M struct Struct1 {N {unsigned int} foo, N +04 {short}* bar, N +08 {char} baz[2], }" #s=

\ Anonymous structs work too
_parse struct { int foo; } STOP typesize 4 #eq


@@ 93,5 93,5 @@ CDecl type

_parse Struct1 *mystructptr STOP
capture printtype
S" M M struct Struct1* mystructptr" #s=
S" M {M struct Struct1}* mystructptr" #s=
testend