commit 7c580086f523c19090cf479a4a130c7375260bee
parent 457eec6f128cdf3736547bcd5f4dcf26d4305afc
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 7 Jun 2022 15:05:25 -0400
cc: add && and || ops and make them shortcut properly
Diffstat:
8 files changed, 60 insertions(+), 20 deletions(-)
diff --git a/fs/asm.fs b/fs/asm.fs
@@ -61,6 +61,9 @@
\ operations
: add, isimm? if 0 $81 else src $01 then modrm2, ;
: cmp, isimm? if 7 $81 else src $39 then modrm2, ;
+: jmp, ( rel32 -- ) $e9 c, , ;
+: jz, ( rel32 -- ) $0f c, $84 c, , ;
+: jnz, ( rel32 -- ) $0f c, $85 c, , ;
: mov, isimm? if prefix, $b8 tgtid or c, , asm$ else src $89 modrm2, then ;
: mul, 4 $f7 modrm1, ;
: neg, 3 $f7 modrm1, ;
@@ -68,6 +71,7 @@
: pop, prefix, $58 tgtid or c, asm$ ;
: push, prefix, $50 tgtid or c, asm$ ;
: ret, $c3 inh, ;
+: setg, $0f c, 0 $9f modrm1, ;
: setl, $0f c, 0 $9c modrm1, ;
: setz, $0f c, 0 $94 modrm1, ;
: sub, isimm? if 5 $81 else src $29 then modrm2, ;
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -24,12 +24,14 @@ create uopssyms ," -~!?"
\ 2 * Multiplication
\ 3 / Division
-8 value BOPSCNT
-create BOPTlist 1 c, ," +" 1 c, ," -" 1 c, ," *" 1 c, ," /"
- 1 c, ," <" 1 c, ," >" 1 c, ," <=" 1 c, ," >="
+12 value BOPSCNT
+create BOPTlist 1 c, ," +" 1 c, ," -" 1 c, ," *" 1 c, ," /"
+ 1 c, ," <" 1 c, ," >" 2 c, ," <=" 2 c, ," >="
+ 2 c, ," ==" 2 c, ," !=" 2 c, ," &&" 2 c, ," ||"
0 c,
\ binary ops precedence. lower means more precedence
create bopsprectbl 1 c, 1 c, 0 c, 0 c, 2 c, 2 c, 2 c, 2 c,
+ 3 c, 3 c, 4 c, 4 c,
: bopid ( ta tl -- opid? f )
>s BOPTlist sfind dup 0< if drop 0 else 1 then ;
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -1,3 +1,4 @@
+0 value _debug
f<< str.fs
f<< wordtbl.fs
f<< asm.fs
diff --git a/fs/cc/cc1.fs b/fs/cc/cc1.fs
@@ -3,4 +3,5 @@
\ Compiles input coming from the cc< alias (defaulting to in<) and writes the
\ result to here. Aborts on error.
-: cc1, ( -- ) parseast curunit gennode ;
+: cc1, ( -- )
+ parseast curunit _debug if dup printast nl> then gennode ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -8,7 +8,7 @@
: _err ( node -- ) printast abort" unexpected node" ;
-UOPSCNT wordtbl opgentbl ( -- )
+UOPSCNT wordtbl uopgentbl ( -- )
:w ( - ) eax neg, ;
:w ( ~ ) eax not, ;
:w ( ! )
@@ -16,10 +16,26 @@ UOPSCNT wordtbl opgentbl ( -- )
eax 0 i32 mov,
al setz, ;
-: genuop ( opid -- ) opgentbl swap wexec ;
-
\ In binary Ops, the result is in EAX and the source operand is EBX.
-BOPSCNT wordtbl opgentbl ( -- )
+BOPSCNT wordtbl bopgentblmiddle ( node -- node )
+'w noop ( + )
+'w noop ( - )
+'w noop ( * )
+'w noop ( / )
+'w noop ( < )
+'w noop ( > )
+'w noop ( <= )
+'w noop ( >= )
+'w noop ( == )
+'w noop ( != )
+:w ( && ) ( node -- jump_addr node )
+ eax eax test,
+ 0 jz, here 4 - swap ;
+:w ( || ) ( node -- jump_addr node )
+ eax eax test,
+ 0 jnz, here 4 - swap ;
+
+BOPSCNT wordtbl bopgentblpost ( -- )
:w ( + ) eax ebx add, ;
:w ( - ) eax ebx sub, ;
:w ( * ) ebx mul, ;
@@ -27,19 +43,23 @@ BOPSCNT wordtbl opgentbl ( -- )
:w ( < )
eax ebx cmp,
eax 0 i32 mov,
- al setl, ;
+ al setg, ;
:w ( > ) abort" TODO" ;
:w ( <= ) abort" TODO" ;
:w ( >= ) abort" TODO" ;
-
-: genbop ( opid -- ) opgentbl swap wexec ;
+:w ( == )
+ eax ebx cmp,
+ 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 ! ;
alias noop gennode ( node -- ) \ forward declaration
: genchildren ( node -- )
firstchild ?dup if begin dup gennode nextsibling ?dup not until then ;
-1 value _debug
: spit ( a u -- ) A>r >r >A begin Ac@+ .x1 spc> next r>A ;
ASTIDCNT wordtbl gentbl ( node -- )
@@ -56,12 +76,14 @@ ASTIDCNT wordtbl gentbl ( node -- )
:w ( Statements ) genchildren ret, ;
'w genchildren ( Arguments )
'w genchildren ( Expression )
-:w ( UnaryOp ) dup genchildren intdata genuop ;
+:w ( UnaryOp ) dup genchildren intdata uopgentbl swap wexec ;
'w genchildren ( Factor )
:w ( BinaryOp )
- dup childcount 2 = not if abort" binop node with more than 2 children!" then
- dup firstchild dup nextsibling ( parent n1 n2 )
- gennode eax push, gennode ebx pop, intdata genbop ;
+ ( node ) >r
+ r@ childcount 2 = not if abort" binop node with more than 2 children!" then
+ r@ firstchild dup nextsibling swap ( n1 n2 )
+ gennode bopgentblmiddle r@ intdata wexec eax push,
+ gennode ebx pop, bopgentblpost r> intdata wexec ;
: _ ( node -- ) gentbl over astid wexec ;
current to gennode
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -2,12 +2,18 @@
alias in< cc<
0 value putback
+: _err abort" tokenization error" ;
: _cc< ( -- c ) putback ?dup if 0 to putback else cc< then ;
create buf LNSZ allot
: 0-9? ( c -- f ) '0' - 10 < ;
: a-z? ( c -- f ) dup 'A' - 26 < swap 'a' - 26 < or ;
: identifier? ( c -- f ) dup 0-9? swap a-z? or ;
+\ list of possible first chars for "special stuff"
+create special1st ," (){}!~+-*/<>=&|;" \ 16
+\ list of possible second chars for "special stuff"
+create special2nd ," =&|" \ 3
+
\ advance to the next non-whitespace and return the char encountered.
\ if end of stream is reached, c is 0
: tonws ( -- c ) 0 begin ( c )
@@ -18,6 +24,10 @@ create buf LNSZ allot
\ to consume.
: nextt ( -- sa? sl-or-0 ) tonws dup if ( c )
A>r buf >A dup identifier? if begin ( c )
- Ac!+ cc< dup identifier? not until to putback
- else Ac!+ then
+ Ac!+ cc< dup identifier? not until to putback
+ else \ special characters
+ dup special1st 16 [c]? 0< if _err then
+ Ac!+ cc<
+ dup special2nd 3 [c]? 0< if to putback else Ac!+ then
+ then
buf A> buf - ( sa sl ) r>A then ;
diff --git a/fs/test.c b/fs/test.c
@@ -9,5 +9,5 @@ int exprbinops() {
return 1 + 2 * 3;
}
int boolops() {
- return 42 < 54;
+ return 66 < 54 && 2 == 2;
}
diff --git a/tests/testcc.fs b/tests/testcc.fs
@@ -9,4 +9,4 @@ retconst 42 #eq
neg -42 #eq
bwnot $ffffffd5 #eq
exprbinops 7 #eq
-boolops 1 #eq
+boolops 0 #eq
