commit fa79542264d6ea6676f200275b0f24c3db596c34
parent 6cc5b70d228153a592fdc6841fc9612639e65864
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 13 Jun 2022 07:27:39 -0400
cc: use xdict in map.fs instead of cc/tree
It makes more sense and is simpler overall.
Diffstat:
6 files changed, 64 insertions(+), 65 deletions(-)
diff --git a/dusk.asm b/dusk.asm
@@ -752,7 +752,7 @@ _find_loop:
mov edi, edx
dec edi
mov al, [edi]
- and al, 0x7f
+ and al, 0x3f ; 3f instead of 7f? we reserve space for another flag.
cmp al, cl
jnz _find_skip1
; same length
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -2,6 +2,7 @@
f<< sys/scratch.fs
f<< lib/str.fs
f<< lib/wordtbl.fs
+f<< lib/xdict.fs
f<< asm.fs
f<< cc/tok.fs
f<< cc/tree.fs
diff --git a/fs/cc/cc1.fs b/fs/cc/cc1.fs
@@ -5,5 +5,5 @@
\ result to here. Aborts on error.
: cc1, ( -- )
parseast curunit _debug if dup printast nl> then
- dup mapunit _debug if curmap printmap then
+ dup mapunit _debug if printmap then
gennode ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -61,7 +61,7 @@ alias noop gennode ( node -- ) \ forward declaration
firstchild ?dup if begin dup gennode nextsibling ?dup not until then ;
: spit ( a u -- ) A>r >r >A begin Ac@+ .x1 spc> next r>A ;
-: getfuncnode ( node -- node ) AST_FUNCTION parentnodeid data2 ;
+: getfuncmap ( node -- funcentry ) AST_FUNCTION parentnodeid data2 ;
ASTIDCNT wordtbl gentbl ( node -- )
'w genchildren ( Declare )
@@ -70,13 +70,13 @@ ASTIDCNT wordtbl gentbl ( node -- )
_debug if ." debugging: " dup data1 stype nl> then
dup data1 entry
dup data2 ( astfunc mapfunc )
- here over data4! \ set address
- dup data2 swap data3 - ?dup if \ has SF-args
+ here over fmap.address! \ set address
+ dup fmap.sfsize swap fmap.argsize - ?dup if \ has SF-args
ebp i32 sub, then
genchildren
_debug if current here current - spit nl> then ;
:w ( Return ) dup genchildren ( node )
- getfuncnode data2 ?dup if
+ getfuncmap fmap.sfsize ?dup if
ebp i32 add, then
ebp 4 i32 sub,
[ebp] eax mov,
@@ -96,12 +96,12 @@ ASTIDCNT wordtbl gentbl ( node -- )
:w ( Assign )
dup genchildren ( node )
dup data1 ( node name )
- swap getfuncnode findvarinmap ( varnode ) data2 ( offset )
+ swap getfuncmap findvarinmap ( varnode ) vmap.sfoff
[ebp]+ eax mov, ;
'w genchildren ( DeclarationList )
:w ( Variable )
dup data1 ( node name )
- swap getfuncnode findvarinmap ( varnode ) data2 ( offset )
+ swap getfuncmap findvarinmap ( varnode ) vmap.sfoff
eax [ebp]+ mov, ;
:w ( FunCall )
\ pass arguments
@@ -111,10 +111,9 @@ ASTIDCNT wordtbl gentbl ( node -- )
[ebp] eax mov,
nextsibling ?dup not until then
\ find in map
- data1 ( name )
- curmap findfuncinmap ?dup not if _err then ( mapfunc )
+ data1 ( name ) findfuncinmap ( mapfunc )
\ call!
- data4 ( addr ) call,
+ fmap.address call,
\ get result
eax [ebp] mov,
ebp 4 i32 add, ;
diff --git a/fs/cc/map.fs b/fs/cc/map.fs
@@ -1,75 +1,68 @@
\ C compiler local variable map
-\ This tree is generated after AST parsing, before code generation to map
+\ these maps are generated after AST parsing, before code generation to map
\ some names to some numbers, namely:
\ 1. Functions address
\ 2. Local variable stack frame (SF) offsets
-3 value MAPIDCNT
-0 value MAP_UNIT
-1 value MAP_FUNCTION \ data1=AST_FUNCTION data2=SF size
- \ data3=args size data4=address
- \ Note: SF size *includes* args. SF-args = local vars sz
-2 value MAP_VARIABLE \ data1=name data2=SF offset
+\ Those maps are xdicts. The first level is a dictionary of functions. It is
+\ located at "curmap". Each function in the AST results in an entry in this
+\ map. Each entry has this structure:
-create mapidnames 4 c, ," unit" 8 c, ," function" 3 c, ," var"
- 0 c,
+\ 4b link to AST_FUNCTION node
+\ 4b SF size, which *includes* args size. SF-args=local vars
+\ 4b args size
+\ 4b address
+\ 4b variable declaration xdict
-0 value curmap \ points to current Unit, the beginning of the map
-0 value activenode \ node we're currently adding to
+\ Then, each entry in the variable declaration xdict is:
+\ 4b SF offset
+newxdict curmap
-: _err ( -- ) abort" mapping error" ;
-: Unit ( -- ) MAP_UNIT createnode dup to curmap to activenode ;
-: Function ( name -- )
- MAP_FUNCTION createnode dup curmap addnode to activenode
- ( name ) , 0 , 0 , 0 , ;
-: Variable ( offset name -- )
- MAP_VARIABLE createnode activenode addnode , , ;
-
-: _[ '[' emit ;
-: _] ']' emit ;
+: fmap.astnode @ ;
+: fmap.sfsize 4 + @ ;
+\ Return fmap Stack Frame size and then increase it by 4.
+: fmap.sfsize+ ( fmap -- sfoff )
+ dup fmap.sfsize swap 4 + ( sz a ) 4 swap +! ( sz ) ;
+: fmap.argsize 8 + @ ;
+: fmap.argsize+ ( n fmap -- ) 8 + +! ;
+: fmap.address 12 + @ ;
+: fmap.address! 12 + ! ;
+: fmap.vmap 16 + ;
+: vmap.sfoff @ ;
-MAPIDCNT wordtbl mapdatatbl ( node -- node )
-'w noop ( Unit )
-:w ( Function ) _[
- dup data1 data1 stype ',' emit dup data2 .x ',' emit dup data3 .x _] ;
-:w ( Variable ) _[ dup data1 stype ',' emit dup data2 .x _] ;
+: _err ( -- ) abort" mapping error" ;
+\ print curmap in reverse order of parsing
+: printmap ( -- )
+ curmap @ ?dup not if exit then begin ( w )
+ dup wordname[] rtype spc>
+ dup fmap.sfsize .x spc> dup fmap.argsize .x nl>
+ dup fmap.vmap @ ?dup if begin ( w vmap )
+ spc> spc> dup wordname[] rtype spc> dup vmap.sfoff .x nl>
+ prevword ?dup not until then ( w )
+ prevword ?dup not until ;
-: printmap ( node -- )
- ?dup not if ." null" exit then
- dup nodeid mapidnames slistiter stype
- mapdatatbl over nodeid wexec
- firstchild ?dup if
- '(' emit begin
- dup printmap nextsibling dup if ',' emit then ?dup not until
- ')' emit then ;
+: Function ( astnode -- entry )
+ dup data1 ( name ) curmap xentry ( astnode )
+ here swap , 16 allot0 ( entry ) ;
-\ Return node Stack Frame size and then increase it by 4.
-: funsfsz+ ( node -- sfsz )
- dup nodeid MAP_FUNCTION = not if _err then
- dup data2 tuck ( sz n sz ) 4 + swap 'data 4 + ! ;
+: Variable ( offset name -- ) curmap @ fmap.vmap xentry , ;
-: findvarinmap ( name node -- varnode )
- dup nodeid MAP_FUNCTION = not if _err then
- firstchild dup if begin ( name node )
- 2dup data1 s= if nip exit then nextsibling dup not
- until then ( name node ) nip ;
+: findvarinmap ( name funcentry -- varentry )
+ fmap.vmap xfind not if _err then ;
-: findfuncinmap ( name node -- funcnode )
- dup nodeid MAP_UNIT = not if _err then
- firstchild dup if begin ( name node )
- 2dup data1 data1 s= if nip exit then nextsibling dup not
- until then ( name node ) nip ;
+: findfuncinmap ( name -- funcentry ) curmap xfind not if _err then ;
: mapfunction ( astfunction -- )
- dup Function activenode over data2! dup begin ( astfunc astfunc )
- AST_DECLARE nextnodeid dup if
+ dup Function ( astfunc fmap ) over data2! ( astfunc ) begin ( curnode )
+ AST_DECLARE nextnodeid dup if ( astdecl )
dup parentnode nodeid AST_ARGSPECS = if \ inc argssize field
- activenode data3 4 + activenode data3! then
- dup data1 activenode funsfsz+ swap Variable 0 else 1 then
- until 2drop ;
+ 4 curmap @ fmap.argsize+ then
+ dup data1 curmap @ fmap.sfsize+ swap Variable 0 else 1 then
+ until ( curnode ) drop ;
\ create a new map from "astunit"
: mapunit ( astunit -- )
- Unit firstchild ?dup not if exit then begin ( astnode )
+ 0 curmap !
+ firstchild ?dup not if exit then begin ( astnode )
dup nodeid AST_FUNCTION = if dup mapfunction then
nextsibling ?dup not until ;
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -38,6 +38,12 @@ $08 const BS $04 const EOF
begin dup Ac@+ = if leave then next ( c )
A- Ac@ = if A> r> - ( i ) else r~ -1 then r>A ;
+\ Dictionary
+: prevword ( w -- w ) 5 - @ ;
+: wordlen ( w -- len ) 1- c@ $3f and ;
+: wordname[] ( w -- sa sl )
+ dup wordlen swap 5 - over - ( sl sa ) swap ;
+
\ Number formatting
create _ ," 0123456789abcdef"
: .xh $f and _ + c@ emit ;
