commit 69600129406d3e2a7d2e06d6567325c158f22ced
parent 39758c47430b9d5cf0b8989ab82f983f1b64599b
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 3 Dec 2022 21:29:03 -0500
comp/c: add switch statement
Diffstat:
8 files changed, 116 insertions(+), 19 deletions(-)
diff --git a/ROADMAP.md b/ROADMAP.md
@@ -10,7 +10,6 @@ In a general way, here's the list of things missing from Dusk C for it to be
consider complete:
* union
-* switch
* enum
* goto
* float
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -164,7 +164,7 @@ ES _ es SS _ ss DS _ ds FS _ fs GS _ gs
$c3 op ret, $90 op nop, $fa op cli, $fb op sti,
$fc op cld,
$ac op lodsb, $ad op lods, $a6 op cmpsb, $a7 op cmps,
-$a4 op movsb, $a5 op movs,
+$a4 op movsb, $a5 op movs, $ae op scasb, $af op scas,
$f3 op repz, $f2 op repnz, $f3 op rep,
$9c op pushf, $9d op popf, $cf op iret,
diff --git a/fs/comp/c/pgen.fs b/fs/comp/c/pgen.fs
@@ -88,8 +88,12 @@ BOPSCNT wordtbl bopgentbl ( -- )
'w vm<<=, 'w vm>>=, 'w vm&=, 'w vm^=,
'w vm|=, 'w _? 'w _:
+\ Constant expressions have a reduced set of operators so that they don't
+\ conflict with some syntax where they're used (namely, inside a "case xxx:")
+0 value _isconstexpr
: bopid ( tok -- opid? f )
- BOPTlist sfind dup 0< if drop 0 else 1 then ;
+ BOPTlist sfind dup 0< if drop 0
+ else dup 17 > _isconstexpr and if drop 0 else 1 then then ;
: bopprec ( opid -- precedence ) BOPSCNT min bopsprectbl + c@ ;
: boptoken ( opid -- tok ) BOPTlist slistiter ;
: ptrbop? ( opid -- f ) 2 < ; \ can op be applied to pointers?
@@ -123,13 +127,15 @@ alias noop parseExpression ( tok -- ) \ forward declaration
',' expectChar dup nextt _arg ( ctype offset )
swap CType :offset! then ( offset ) ;
+: parseConstExpr ( tok -- n )
+ 1 to _isconstexpr parseExpression 0 to _isconstexpr
+ vmop^ :noop# vmop :isconst# vmop arg ops$ ;
+
\ parsing after the identifier
: _post ( ctype -- ctype )
begin ( ctype ) nextt case
'[' of isChar?^
- nextt parseExpression
- vmop^ :noop# vmop :isconst# vmop arg ops$ ( ctype nbelem )
- nextt ']' expectChar ( ctype nbelem )
+ nextt parseConstExpr nextt ']' expectChar ( ctype nbelem )
over to CType nbelem endof
'(' of isChar?^
dup CType :funcsig! STORAGE_PS to@! curstorage >r
@@ -336,21 +342,18 @@ alias noop parseStatement ( tok -- ) \ forward declaration
: parseStatements ( -- )
begin '}' readChar? not while parseStatement repeat ;
-8 stringlist statementnames
- "{" "return" "if" "for" "pspush" "break" "while" "do"
-8 wordtbl statementhandler ( -- )
-'w parseStatements ( { )
-:w ( return )
- \ empty returns are allowed
+: _return \ empty returns are allowed
';' readChar? not if parseExpression read; then vmret, ops$ ;
-:w ( if )
+
+: _if
read( nextt parseExpression read) vmjz[, ops$
nextt parseStatement ops$
nextt dup S" else" s= if ( jump_addr tok )
drop vmjmp[, swap ]vmjmp nextt parseStatement ops$
else to nexttputback then ( jump_addr )
]vmjmp ;
-:w ( for )
+
+: _for
breaks :count >r
read( ';' readChar? not if parseExpression ops$ read; then \ initialization
here nextt parseExpression read; vmjz[, vmjmp[, ( caddr cjmpz cjmp ) \ control
@@ -359,21 +362,62 @@ alias noop parseStatement ( tok -- ) \ forward declaration
swap vmjmp, ( cjmpz cjmp aaddr ) \ adjustment
swap ]vmjmp nextt parseStatement ( cjmpz aaddr )
vmjmp, ]vmjmp r> resolvebreaks ;
-:w ( pspush )
- read( nextt parseExpression vmpspush, read) read; ;
-:w ( break ) addbreak read; ;
-:w ( while )
+
+: _pspush read( nextt parseExpression vmpspush, read) read; ;
+
+: _break addbreak read; ;
+
+: _while
breaks :count >r
here read( nextt parseExpression read)
vmjz[, ops$ nextt parseStatement ( wjmp waddr )
swap vmjmp, ]vmjmp r> resolvebreaks ;
-:w ( do )
+
+: _do
breaks :count >r
here nextt parseStatement ( daddr )
nextt S" while" s= _assert
read( nextt parseExpression read) ( daddr )
vmjnz, read; r> resolvebreaks ;
+\ Switch works by constructing a lookup table of all the cases and generating
+\ all statements one after the other. Whenever there's a "case", we associate it
+\ to "here". Then, we evaluate the switch query and check in the lookup. Those
+\ lookup tables live in _litarena.
+\ However, this is tricky. We don't know beforehand how many cases we have for
+\ our lookup table. To palliate to this, we add a level of indirection. We
+\ generate our switch code so that it fetches its pointer to a lookup table at
+\ a specific literal. It's only when we're done generating the case code that
+\ we generate the lookup table and place a pointer to it at that placeholder.
+$40 const MAXSWITCHCASES
+MAXSWITCHCASES << Stack :new structbind Stack _cases
+: _switch
+ breaks :count >r \ V1=breakcnt
+ read( nextt parseExpression read)
+ CELLSZ _litarena :allot dup vmswitch, >r \ V2='lookup
+ vmjmp[, >r \ V3=defjump
+ nextt '{' expectChar nextt begin ( tok )
+ dup S" case" s= if
+ drop nextt parseConstExpr _cases :push here _cases :push
+ nextt ':' expectChar nextt then ( tok )
+ dup '}' isChar? not while ( tok )
+ dup S" default" s= not while ( tok )
+ parseStatement nextt repeat ( tok ) \ default
+ r> ( defjump ) ]vmjmp nextt ':' expectChar parseStatements else ( tok ) \ }
+ r> ( defjump ) ]vmjmp then ( tok ) drop
+ _cases :count 1+ CELLSZ * _litarena :[
+ _cases :count >> dup , begin ( totcnt )
+ _cases :count while
+ _cases :pop over CELLSZ * here + ! _cases :pop , repeat ( totcnt )
+ CELLSZ * allot _litarena :] r> ( 'lookup ) ! r> ( breakcnt ) resolvebreaks ;
+
+9 stringlist statementnames
+ "{" "return" "if" "for" "pspush" "break" "while" "do" "switch"
+9 wordtbl statementhandler ( -- )
+'w parseStatements 'w _return 'w _if 'w _for
+'w _pspush 'w _break 'w _while 'w _do
+'w _switch
+
0 value _laststmtid
: _ ( tok -- ) \ parseStatement
dup statementnames sfind dup >r dup 0< if ( tok -1 ) \ V1=stmtidx
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -167,3 +167,14 @@ LOGOPCNT wordtbl _tblunsigned
\ we're in the "true" branch. drop the false res, replace with true.
compile drop PS- vmop :compile vmop :init
]vmjmp vmop :>reg ;
+
+: _lookup ( nref lookup -- )
+ @+ ?dup if rot >r dup >r >r begin ( a ) \ V1=nref V2=totcnt V3=loop
+ @+ V1 = if ( a )
+ \ match! we jump to a blind spot by dropping the return address of this
+ \ call and replacing it with our target.
+ rdrop ( loop ) r> ( a totcnt ) 1- CELLSZ * + @ ( tgtaddr )
+ rdrop ( nref ) rdrop ( oldaddr ) >r exit then
+ next ( a ) drop rdrop rdrop else ( nref lookup ) 2drop then ;
+: vmswitch, ( 'lookup -- )
+ vmop :compile$ litn compile @ compile _lookup PS- PS- ;
diff --git a/fs/comp/c/vm/i386.fs b/fs/comp/c/vm/i386.fs
@@ -298,3 +298,19 @@ LOGOPCNT wordtbl _tblunsigned
vmop :push swap vmop :pop vmjnz[, swap vmop :pop \ vmop back to its res
vmop :compile vmop^ :compile mov, vmop^ :init \ move false op to true reg
]vmjmp ;
+
+: vmswitch, ( 'lookup -- )
+ DI regused? not _assert CX regused? not _assert
+ vmop :isAX? not if AX regused? if dx ax mov, then ax vmop :compile mov, then
+ di ( 'lookup ) m) mov,
+ cx di 0 d) mov,
+ cx push,
+ di CELLSZ i) add,
+ repnz, scas,
+ cx pop, \ Z preserved
+ vmop :isAX? not if AX regused? if ax dx mov, then then \ Z preserved
+ vmop :init
+ forward8 jnz,
+ \ we have a match
+ cx dec, cx 2 i) shl, di cx add, di 0 d) jmp,
+ forward! ;
diff --git a/fs/doc/cc/impl.txt b/fs/doc/cc/impl.txt
@@ -179,6 +179,18 @@ importantly, it will "merge" vmop and vmop^ into one single op, that is, the
location that *both* branches of the condition will return to. That will be the
result of this binop. This "merge" is arch-specific.
+### vmswitch, ( 'lookup -- )
+
+Resolve vmop and apply "switch" logic to the supplied *pointer* to lookup table.
+The lookup table has this format:
+
+- 4b count
+- count*4b values to compare
+- count*4b jump addresses
+
+We generate code to compare vmop with all elements of the lookup table and, if
+found, jump to the corresponding address. If no element match, no jump is made.
+
### Jumping in the VM
There are 2 kinds of jumps: forward and backward. In forward jumps, we need to
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -69,6 +69,10 @@ mydata $42 structset mydata 4 + @ $42345678 #eq
globdata 4 + 16b @ 42 #eq
0 callfuncidx 42 #eq
2 callfuncidx 82 #eq
+33 switchstmt 0 #eq
+42 switchstmt 12 #eq
+1234 switchstmt 3 #eq
+5678 switchstmt 2 #eq
2 3 binop1 1 #eq
'2' binop2 44 #eq
diff --git a/fs/tests/comp/c/test.c b/fs/tests/comp/c/test.c
@@ -276,6 +276,17 @@ int callfuncidx(int idx) {
}
}
+int switchstmt(int x) {
+ int y = 1;
+ switch (x) {
+ case 42: return 12;
+ case 1234: ++y;
+ case 5678: ++y; break;
+ default: --y;
+ }
+ return y;
+}
+
// Below this comment are simple construct that were buggy before
int binop1(int a, int b) {
int c;
