commit 73314397c6607e206e353c0cfb85f518e0ba86bd
parent 7c580086f523c19090cf479a4a130c7375260bee
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 7 Jun 2022 18:11:40 -0400
cc: remove flags field from tree nodes
It was useless. Also, revamped printast data printing.
Diffstat:
4 files changed, 48 insertions(+), 38 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -15,7 +15,7 @@ create uopssyms ," -~!?"
: uopid ( ta tl -- opid? f )
1 = if c@ uopssyms UOPSCNT [c]? dup 0< if drop 0 else 1 then
else drop 0 then ;
-: uopchar ( opid -- c ) UOPSCNT max uopssyms + c@ ;
+: uopchar ( opid -- c ) UOPSCNT min uopssyms + c@ ;
\ Binary operators
\ ID Sym Name
@@ -36,19 +36,23 @@ create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
: bopid ( ta tl -- opid? f )
>s BOPTlist sfind dup 0< if drop 0 else 1 then ;
: bopprec ( opid -- precedence ) BOPSCNT min bopsprectbl + c@ ;
+: boptoken ( opid -- ta tl )
+ BOPSCNT min ?dup if ( opid )
+ >r BOPTlist begin ( a ) c@+ + next c@+ else
+ BOPTlist c@+ then ;
\ AST node types
11 value ASTIDCNT
1 value AST_UNIT
-2 value AST_FUNCTION \ strdata=name
+2 value AST_FUNCTION \ data: 1b namelen xb name
3 value AST_RETURN
-4 value AST_CONSTANT \ intdata=value
+4 value AST_CONSTANT \ data: 4b value
5 value AST_STATEMENTS
6 value AST_ARGUMENTS
7 value AST_EXPRESSION
-8 value AST_UNARYOP
+8 value AST_UNARYOP \ data: 4b uopid
9 value AST_FACTOR \ a constant or variable
-10 value AST_BINARYOP
+10 value AST_BINARYOP \ data: 4b bopid
\ 8 chars per name
create astidnames
@@ -64,11 +68,29 @@ create astidnames
: skipnext 1 to _skip ;
\ is currently active node empty?
: activeempty? ( -- f ) activenode firstchild not ;
+
+: _[ '[' emit ;
+: _] ']' emit ;
+: _s _[ dup strdata stype _] ;
+: _i _[ dup intdata .x _] ;
+
+ASTIDCNT wordtbl astdatatbl ( node -- node )
+'w noop
+'w noop ( Unit )
+'w _s ( Function )
+'w noop ( Return )
+'w _i ( Constant )
+'w noop ( Statements )
+'w noop ( Arguments )
+'w noop ( Expression )
+:w ( UnaryOp ) _[ dup 'data @ uopchar emit _] ;
+'w noop ( Factor )
+:w ( BinaryOp ) _[ dup 'data @ boptoken stype _] ;
+
: printast ( node -- )
?dup not if ." null" exit then
- dup astid idname stype dup flags ( node flags )
- dup $04 and if ( int data ) '[' emit over intdata .x ']' emit then
- $08 and if ( str data ) '[' emit over strdata stype ']' emit then
+ dup astid idname stype
+ astdatatbl over astid wexec
firstchild ?dup if
'(' emit begin
dup printast nextsibling dup if ',' emit then ?dup not until
@@ -85,16 +107,16 @@ create astidnames
0 over cslots! begin parentnode dup nodeclosed? not until
to activenode ;
: Unit ( -- )
- -1 $01 AST_UNIT createnode dup to curunit to activenode ;
-: Function ( 'name namelen -- ) 2 $09 AST_FUNCTION newnode dup c, move, ;
-: Return ( -- ) 1 $03 AST_RETURN newnode ;
-: Constant ( n -- ) 0 $04 AST_CONSTANT newnode , ;
-: Statements ( -- ) -1 $01 AST_STATEMENTS newnode ;
-: Arguments ( -- ) -1 $01 AST_ARGUMENTS newnode ;
-: Expression ( -- ) -1 $01 AST_EXPRESSION newnode ;
-: UnaryOp ( opid -- ) 1 $07 AST_UNARYOP newnode , ;
-: Factor ( -- ) 1 $01 AST_FACTOR newnode ;
-: BinaryOp ( opid -- node ) 2 $07 AST_BINARYOP newnode , ;
+ -1 AST_UNIT createnode dup to curunit to activenode ;
+: Function ( 'name namelen -- ) 2 AST_FUNCTION newnode dup c, move, ;
+: Return ( -- ) 1 AST_RETURN newnode ;
+: Constant ( n -- ) 0 AST_CONSTANT newnode , ;
+: Statements ( -- ) -1 AST_STATEMENTS newnode ;
+: Arguments ( -- ) -1 AST_ARGUMENTS newnode ;
+: Expression ( -- ) -1 AST_EXPRESSION newnode ;
+: UnaryOp ( opid -- ) 1 AST_UNARYOP newnode , ;
+: Factor ( -- ) 1 AST_FACTOR newnode ;
+: BinaryOp ( opid -- node ) 2 AST_BINARYOP newnode , ;
: _err ( ta tl -- )
stype spc>
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -52,7 +52,7 @@ BOPSCNT wordtbl bopgentblpost ( -- )
eax 0 i32 mov,
al setz, ;
:w ( != ) abort" TODO" ;
-:w ( && ) ( jump_addr -- ) here over - 4 - swap .S nl> ! ;
+:w ( && ) ( jump_addr -- ) here over - 4 - swap ! ;
:w ( || ) ( jump_addr -- ) here over - 4 - swap ! ;
alias noop gennode ( node -- ) \ forward declaration
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -3,7 +3,7 @@
\ same memory layout, which is a series of nodes linked to each other:
\ 1b type id
-\ 1b flags (see below)
+\ 1b reserved
\ 1b child slots
\ 4b addr of parent node (0 if root)
\ 4b addr of child node (0 if none)
@@ -11,22 +11,12 @@
\ 4b addr of prev sibling (0 if none)
\ ... maybe data
-\ Type id: a numerical id. The higest 2 bits determine the category of the
-\ node: 0=AST 1=expression 2=unused 3=unused
-
-\ Flags
-\ b2 int data The 'data section contains a 4b integer
-\ b3 str data The 'data section contains a 1b str length followed by a
-\ string of that length.
-
\ Child slots
\ Indicate the number of children that this node can have. 0 means none, -1
\ means unlimited, other numbers indicate the number of slots. Each time a
\ children is added, the slot is decreased. When 0 is reached, we close it.
: nodeid ( node -- id ) c@ ;
-: flags ( node -- flags ) 1+ c@ ;
-: flags! ( flags node -- ) 1+ c! ;
: cslots ( node -- slots ) 1+ 1+ c@ ;
: cslots! ( slots node -- ) 1+ 1+ c! ;
: cslots- ( node -- ) dup cslots 1- swap cslots! ;
@@ -53,7 +43,7 @@
: nodedepth ( node -- n ) firstchild ?dup if nodedepth 1+ else 0 then ;
: childcount ( node -- n )
0 swap firstchild ?dup if begin swap 1+ swap nextsibling ?dup not until then ;
-: createnode ( slots flags id -- node ) here >r c, c, c, 16 allot0 r> ;
+: createnode ( slots id -- node ) here >r c, 0 c, c, 16 allot0 r> ;
: addnode ( node parent -- )
dup nodeclosed? if abort" node is closed" then
2dup swap parentnode! dup cslots- ( node parent )
diff --git a/tests/testcctree.fs b/tests/testcctree.fs
@@ -1,11 +1,11 @@
\ C compiler tree unit
f<< cc/tree.fs
-2 0 1 createnode value root
+2 1 createnode value root
root nodeid 1 #eq
root nodeclosed? not #
--1 0 2 createnode value n1
+-1 2 createnode value n1
n1 root addnode
n1 nodeid 2 #eq
n1 parentnode root #eq
@@ -14,10 +14,10 @@ n1 prevsibling 0 #eq
n1 firstchild 0 #eq
root firstchild n1 #eq
-0 $04 3 createnode 42 , value n2
+0 3 createnode 42 , value n2
n2 root addnode
n2 nodeid 3 #eq
-n2 intdata 42 #eq
+n2 'data @ 42 #eq
n2 parentnode root #eq
n2 nextsibling 0 #eq
n2 prevsibling n1 #eq
@@ -26,15 +26,13 @@ root firstchild n1 #eq
root nodeclosed? #
root lastchild n2 #eq
-0 $08 4 createnode 3 c, ," foo" value n3
+0 4 createnode value n3
n3 n1 addnode
n3 nodeid 4 #eq
n3 parentnode n1 #eq
n3 nextsibling 0 #eq
n3 prevsibling 0 #eq
n1 firstchild n3 #eq
-: foo S" foo" ;
-n3 strdata foo S= #
root nodedepth 2 #eq
n1 nodedepth 1 #eq
