duskos

dusk os fork
git clone git://git.alexwennerberg.com/duskos
Log | Files | Refs | README | LICENSE

commit 0fa1aa68c00e91c087b2cafd445b0360fc66891b
parent a442db3cd24d490a0afb5946250b3b040aa05020
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sat, 24 Sep 2022 16:02:07 -0400

cc: allow the referencing of system structs in C code

Diffstat:
Mfs/cc/ast.fs | 24++++++++++++++++++++++--
Mfs/cc/type.fs | 9+++++----
Mfs/cc/vm/commonlo.fs | 2+-
Mfs/lib/str.fs | 1+
Mfs/tests/cc/cc.fs | 3+++
Mfs/tests/cc/test.c | 9+++++++++
6 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs @@ -249,6 +249,21 @@ extends NamedNode struct[ Arrow extends NamedNode struct[ CStruct \ "Struct" clashes with bootlo : :new 0 align4 AST_STRUCT NamedNode :new ; + + \ Add struct field "field" to CStruct node "node" recursively, beginning with + \ the last field of the list. "field" is a word reference. + : _ ( field node -- ) >r + dup does' Field next ?dup if r@ _ then ( field ) + dup does' Field size inttypeofsize NULLSTR Declare :new ( field dnode ) + dup r> Node :add ( field dnode ) + here over to Declare name over wordname[] dup c, move, ( field dnode ) + swap does' Field offset swap to Declare address ; + + \ Given a Forth struct of name "name" and create a CStruct from it. + : :fromSysStruct ( name -- node ) + dup sysdict @ find ?dup _assert ( name struct' ) does' Struct lastfield + ( name field ) :new rot over :storename ( field node ) tuck _ + dup curunit Node :add ; ]struct ASTIDCNT stringlist astidnames @@ -258,6 +273,11 @@ ASTIDCNT stringlist astidnames : idname ( id -- str ) astidnames slistiter ; +: printtype ( type -- ) + dup typestruct? if + ." struct " dup typestruct' CStruct name stype printType* + else printIntType then ; + : _[ '[' emit ; : _] ']' emit ; @@ -456,8 +476,8 @@ current to parseExpression : parseType ( tok -- type? f ) dup S" struct" s= if drop nextt dup Unit :find ?dup if - dup Node id AST_STRUCT = _assert nip - else abort" TODO" then ( struct' ) + nip dup Node id AST_STRUCT = _assert + else ( name ) CStruct :fromSysStruct then ( struct' ) dup type*lvl not _assert 1 else parseIntType then ; diff --git a/fs/cc/type.fs b/fs/cc/type.fs @@ -69,8 +69,9 @@ create _ 0 c, 1 c, 2 c, 4 c, dup S" unsigned" s= if drop $10 nextt else $00 swap then ( type tok ) typenames sfind dup 0>= if ( type idx ) << << or 1 else 2drop 0 then ; -: printtype ( type -- ) - dup typestruct? if ." struct" else +: printType* ( type -- ) type*lvl begin ?dup while '*' emit 1- repeat ; + +: printIntType ( type -- ) + dup typestruct? not if dup typeunsigned? if ." unsigned " then - dup >> >> 3 and typenames slistiter stype then - type*lvl ?dup if >r begin '*' emit next then ; + dup >> >> 3 and typenames slistiter stype printType* then ; diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs @@ -12,7 +12,7 @@ \ stored in the location. If, for example, we have a int* stored in a \ VM_REGISTER, it's the exact equivalent of having an int stored in a \ VM_*REGISTER. The number is the same. -?f<< /cc/type.fs +?f<< /cc/ast.fs : _err abort" vm error" ; : _assert not if _err then ; diff --git a/fs/lib/str.fs b/fs/lib/str.fs @@ -2,6 +2,7 @@ \\ maximum size of strings (including size byte) $100 value STR_MAXSZ +create NULLSTR 0 c, \ is c a whitespace? : ws? ( c -- f ) SPC <= ; diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs @@ -57,6 +57,9 @@ S" foobar" dup 6 'X' set8b S" foobaX" #s= 42 unaryopmut 42 #eq create mydata 42 , $12345678 , $23456789 , mydata structget $5678 #eq +mydata $42 structset mydata 4 + @ $12425678 #eq +mydata sysstructget $23456789 #eq +mydata 42 sysstructset mydata 8 + @ 42 #eq 2 3 binop1 1 #eq '2' binop2 44 #eq diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c @@ -216,6 +216,15 @@ struct MyStruct { extern short structget(struct MyStruct *s) { return s->bar; } +extern void structset(struct MyStruct *s, char val) { + s->baz = val; +} +extern int sysstructget(struct Field *f) { + return f->size; +} +extern void sysstructset(struct Field *f, int val) { + f->size = val; +} // Below this comment are simple construct that were buggy before extern int binop1(int a, int b) { int c;