commit ad42cd65e112ee557ee0ed5dd93d0290ed96bc7c
parent ae14e7963b3eba512374a5c8819d23be57786cdf
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 3 Jun 2022 11:28:33 -0400
cc: begin implementing unary ops
Diffstat:
6 files changed, 84 insertions(+), 37 deletions(-)
diff --git a/fs/asm.fs b/fs/asm.fs
@@ -50,11 +50,16 @@
: prefix, ( -- ) exit
tgt is16? if $66 c, then src dup isimm? not swap is16? and if $67 c, then ;
: inh, ( op -- ) c, asm$ ;
-: modrm, ( imm? op -- )
+: modrm1, ( reg op -- ) \ modrm op with 1 argument
+ prefix, c, ( reg ) 3 lshift tgtid tgt mod or or ( modrm ) c,
+ disp? if disp c, then asm$ ;
+: modrm2, ( imm? op -- ) \ modrm op with 2 arguments
prefix, c, tgtid tgt mod or ( modrm ) src isimm?
if $28 or ( 5 in reg ) c, , else c, then disp? if disp c, then asm$ ;
\ operations
-: mov, src isimm? if prefix, $b8 tgtid or c, , asm$ else $89 modrm, then ;
-: sub, $81 modrm, ;
+: mov, src isimm? if prefix, $b8 tgtid or c, , asm$ else $89 modrm2, then ;
+: neg, 3 $f7 modrm1, ;
+: not, 2 $f7 modrm1, ;
+: sub, $81 modrm2, ;
: ret, $c3 inh, ;
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -7,7 +7,7 @@
\ 1b type id
\ 1b flags (see below)
-\ 1b parse stage
+\ 1b child slots
\ 4b addr of parent element (0 if root)
\ 4b addr of next element (0 if none)
\ ... maybe data
@@ -22,22 +22,23 @@
\ 5 Statements
\ 6 Arguments
\ 7 Expression
+\ 8 UnaryOp opid
\ Flags
\ b0 haschildren this element can contain children
-\ b1 autoclose close automatically when a children closes
\ 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.
-\ Parse stage
-\ Stores the stage at which the element is, parse-wise. For example, a Function
-\ starts at 0. When Arguments have been parsed, it becomes 1. When Statements
-\ have been parsed, it becomes 2.
+\ Child slots
+\ Indicate the number of children that this element 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.
-8 value ASTIDCNT
+9 value ASTIDCNT
\ 8 chars per name
-create astidnames ,"
-) unit functionreturn constantstmts args expr "
+create astidnames
+," ) unit functionreturn constantstmts args expr "
+," unaryop "
0 value curunit \ points to current Unit, the beginning of the AST
0 value lastelem \ last element of the chain
@@ -48,35 +49,40 @@ create astidnames ,"
: idname ( id -- sa sl ) 8 * astidnames + 8 rtrim ;
: astid ( elem -- id ) c@ ;
: flags ( elem -- flags ) 1+ c@ ;
-: pstage ( elem -- pstage ) 1+ 1+ c@ ;
-: pstage+ ( elem -- newpstage ) dup pstage 1+ over 1+ 1+ c! pstage ;
+: cslots ( elem -- slots ) 1+ 1+ c@ ;
+: cslots! ( slots elem -- ) 1+ 1+ c! ;
+: cslots- ( elem -- newslots ) dup cslots 1- tuck swap cslots! ;
: haschildren? ( elem -- f ) flags $01 and ;
-: autoclose? ( elem -- f ) flags $02 and ;
: parentelem ( elem -- parent ) 3 + @ ;
: nextelem ( elem -- next ) 7 + @ ;
: 'data ( elem -- 'data ) 11 + ;
: intdata ( elem -- n ) 'data @ ;
: strdata ( elem -- sa sl ) 'data c@+ ;
-: newelem ( flags id -- )
- here lastelem 7 + ! here to lastelem c, c, 0 c, activeelem , 0 ,
+: newelem ( slots flags id -- )
+ here lastelem 7 + ! here to lastelem c, c, c, activeelem , 0 ,
lastelem haschildren? if lastelem to activeelem then ;
\ AST elements
: SeqClose ( -- )
- 0 0 newelem activeelem
+ 0 0 0 newelem activeelem
?dup not if abort" can't go beyond root!" then
parentelem to activeelem
- activeelem autoclose? if SeqClose then ;
+ activeelem cslots- not if SeqClose then ;
: Unit ( -- )
- here to curunit here to lastelem here to activeelem 1 c, $01 c, 9 allot0 ;
-: Function ( 'name namelen -- ) $09 2 newelem dup c, move, ;
-: Return ( -- ) $03 3 newelem ;
-: Constant ( n -- ) $04 4 newelem , ;
-: Statements ( -- ) $01 5 newelem ;
-: Arguments ( -- ) $01 6 newelem ;
-: Expression ( -- ) $01 7 newelem ;
+ here to curunit here to lastelem here to activeelem
+ 1 c, $01 c, -1 c, 9 allot0 ;
+: Function ( 'name namelen -- ) 2 $09 2 newelem dup c, move, ;
+: Return ( -- ) 1 $03 3 newelem ;
+: Constant ( n -- ) 0 $04 4 newelem , ;
+: Statements ( -- ) -1 $01 5 newelem ;
+: Arguments ( -- ) -1 $01 6 newelem ;
+: Expression ( -- ) 1 $01 7 newelem ;
+: UnaryOp ( opid -- ) 1 $07 8 newelem , ;
-: _err ( ta tl -- ) stype abort" parsing error" abort ;
+: _err ( ta tl -- )
+ stype spc>
+ activeelem ?dup if astid .x1 spc> then
+ abort" parsing error" ;
: _assert ( ta tl f -- ) not if _err then ;
: _nextt nextt ?dup not if abort" expecting token!" then ;
@@ -88,25 +94,35 @@ create astidnames ,"
A>r 2dup >r >A begin Ac@+ identifier? _assert next r>A ;
: expectChar ( ta tl c -- )
>r 2dup 1 = not if drop _err then c@ r> = _assert 2drop ;
+\ Search the given token in a string list. if found, run the corresponding word
+\ in optbl. Otherwise, parse error.
+: tokenfromlist ( ta tl list optbl -- )
+ >r rot> >s ( list R:optbl ) sfind dup 0< if s> _err then r> swap wexec ;
\ Parse words. Each of those words have the signature "ta tl -- ".
\ To be clear on the semantincs, the word represents the *context*, not the
\ element being parsed. For example, in "Function", we're not parsing the
\ Function AST element, but we're parsing its *children*.
+create StatementsTList 1 c, ," }" 6 c, ," return" 0 c,
+2 wordtbl StatementsOps ( -- )
+'w SeqClose ( } )
+:w ( return ) Return Expression ;
+
ASTIDCNT wordtbl astparsetbl
'w _err ( SeqClose )
:w ( Unit ) isType? _assert drop _nextt expectIdent Function ;
-:w ( Function ) activeelem pstage+ dup 1 = if
- drop '(' expectChar Arguments else
- 2 = if '{' expectChar Statements else SeqClose then then ;
+:w ( Function ) activeelem cslots 2 = if
+ '(' expectChar Arguments else
+ '{' expectChar Statements then ;
'w _err ( Return )
'w _err ( Constant )
-:w ( Statements )
- 2dup S" }" S= if 2drop SeqClose else
- 2dup S" return" S= _assert 2drop Return Expression then ;
+:w ( Statements ) StatementsTList StatementsOps tokenfromlist ;
:w ( Arguments ) ')' expectChar SeqClose ;
-:w ( Expression ) expectConst Constant _nextt ';' expectChar SeqClose ;
+:w ( Expression )
+ 2dup uopid if UnaryOp 2drop Expression else
+ expectConst Constant _nextt ';' expectChar SeqClose then ;
+'w _err ( UnaryOp )
: parseast ( -- ) Unit begin
nextt ?dup not if exit then
diff --git a/fs/cc/cc1.fs b/fs/cc/cc1.fs
@@ -20,9 +20,10 @@ ASTIDCNT wordtbl posttbl
:w ( Statements ) ret, ;
'w noop ( Arguments )
'w noop ( Expression )
+:w ( UnaryOp ) dup intdata genuop ;
ASTIDCNT wordtbl pretbl
-:w ( SeqClose ) posttbl over parentelem astid wexec ;
+:w ( SeqClose ) dup parentelem posttbl over astid wexec drop ;
'w noop ( Unit )
:w ( Function ) dup strdata entry ;
'w noop ( Return )
@@ -30,6 +31,7 @@ ASTIDCNT wordtbl pretbl
'w noop ( Statements )
'w noop ( Arguments )
'w noop ( Expression )
+'w noop ( UnaryOp )
\ Compiles input coming from the cc< alias (defaulting to in<) and writes the
\ result to here. Aborts on error.
diff --git a/fs/cc/ops.fs b/fs/cc/ops.fs
@@ -0,0 +1,22 @@
+\ C compiler operators
+\ Requires wordtbl.fs and asm.fs
+\ Unary operators
+\ ID Sym Name
+\ 0 - Negate
+\ 1 ~ Complement
+\ 2 ! Not
+
+3 value UOPSCNT
+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@ ;
+
+UOPSCNT wordtbl opgentbl ( -- )
+:w ( - ) eax neg, ;
+:w ( ~ ) eax not, ;
+:w ( ! ) abort" TODO" ;
+
+: genuop ( opid -- ) opgentbl swap wexec ;
diff --git a/fs/test.c b/fs/test.c
@@ -1,3 +1,3 @@
int main() {
- return 42;
+ return ~42;
}
diff --git a/tests/testcc.fs b/tests/testcc.fs
@@ -1,11 +1,13 @@
\ Tests for the C compiler
+f<< str.fs
f<< wordtbl.fs
f<< asm.fs
f<< cc/tok.fs
+f<< cc/ops.fs
f<< cc/ast.fs
f<< cc/cc1.fs
: opentestc S" test.c" fopen not if abort" can't open" then ;
opentestc
' f< to cc<
cc1,
-main 42 #eq
+main $ffffffd5 #eq
