commit ba8c097f27fee341fcf288eb722ae5095b0481fe
parent 5383af43de8b81fffff7d995cf8a13ac9cdf4dc8
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 29 Nov 2022 22:13:37 -0500
comp/c: add support for the "x ? y : z" operators
Diffstat:
7 files changed, 52 insertions(+), 9 deletions(-)
diff --git a/fs/ar/puff.c b/fs/ar/puff.c
@@ -388,11 +388,8 @@ static int codes(state *s, huffman *lencode, huffman *distcode)
if (s->outcnt + len > s->outlen)
return 1;
while (len--) {
- // TODO: add "cond ? x : y" form
- if (dist > s->outcnt)
- s->out[s->outcnt] = 0;
- else
- s->out[s->outcnt] = s->out[s->outcnt - dist];
+ s->out[s->outcnt] = dist > s->outcnt ?
+ 0 : s->out[s->outcnt - dist];
s->outcnt++;
}
}
@@ -711,6 +708,7 @@ int puff(unsigned char *dest, /* pointer to destination pointer */
do {
last = bits(&s, 1); /* one if last block */
type = bits(&s, 2); /* block type 0..3 */
+ // TODO: the ?: ops fail on this
if (type == 0) err = stored(&s);
else if (type == 1) err = fixed(&s);
else if (type == 2) err = dynamic(&s);
diff --git a/fs/comp/c/pgen.fs b/fs/comp/c/pgen.fs
@@ -53,15 +53,19 @@ POPSCNT wordtbl popgentbl ( -- )
: poptoken ( opid -- tok ) POPTlist slistiter ;
\ Binary operators
-29 const BOPSCNT
+31 const BOPSCNT
BOPSCNT stringlist BOPTlist
"+" "-" "*" "/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "&" "^" "|"
- "&&" "||" "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|="
+ "&&" "||" "=" "+=" "-=" "*=" "/=" "%=" "<<=" ">>=" "&=" "^=" "|=" "?" ":"
\ binary ops precedence. lower means more precedence
create bopsprectbl BOPSCNT nc,
1 1 0 0 0 2 2 3 3 3 3 4 4 5 5 5
- 6 6 7 7 7 7 7 7 7 7 7 7 7
+ 6 6 7 7 7 7 7 7 7 7 7 7 7 8 9
+
+MAXARGCNT Stack :new structbind Stack _stack?:
+: _? vmop :push _stack?: :push selop^ ;
+: _: _stack?: :pop vm?:, ;
BOPSCNT wordtbl bopgentbl ( -- )
'w vm+, 'w vm-, 'w vm*, 'w vm/,
@@ -71,7 +75,7 @@ BOPSCNT wordtbl bopgentbl ( -- )
'w vm&&, 'w vm||, 'w vm=, 'w vm+=,
'w vm-=, 'w vm*=, 'w vm/=, 'w vm%=,
'w vm<<=, 'w vm>>=, 'w vm&=, 'w vm^=,
-'w vm|=,
+'w vm|=, 'w _? 'w _:
: bopid ( tok -- opid? f )
BOPTlist sfind dup 0< if drop 0 else 1 then ;
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -161,3 +161,11 @@ LOGOPCNT wordtbl _tblunsigned
: vmjz[, ( -- a ) _ [compile] if ;
: vmjnz, ( a -- ) _ compile not [compile] until ;
: vmjnz[, ( -- a ) _ compile not [compile] if ;
+
+: vm?:, ( condop -- )
+ vmop^ :compile$ \ false-res on TOS
+ vmop^ :pop vmop^ :compile$ [compile] if PS-
+ \ we're in the "true" branch. drop the false res, replace with true.
+ compile drop PS- vmop :compile$
+ ]vmjmp vmop :>reg ;
+
diff --git a/fs/comp/c/vm/i386.fs b/fs/comp/c/vm/i386.fs
@@ -293,3 +293,9 @@ LOGOPCNT wordtbl _tblunsigned
: vmjz[, ( -- a ) vmtest, forward jz, ;
: vmjnz, ( a -- ) vmtest, abs>rel jnz, ;
: vmjnz[, ( -- a ) vmtest, forward jnz, ;
+
+: vm?:, ( condop -- )
+ vmop :>res \ true op in reg
+ 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 ;
diff --git a/fs/doc/cc/impl.txt b/fs/doc/cc/impl.txt
@@ -158,6 +158,27 @@ Assign op: Same as Binary op.
vmret,: Requires a deallocated vmop^. If vmop is allocated, compile a push to
PS and then de-allocate it.
+### vm?:, ( condop -- )
+
+(I intend to have a more complete documentation of the different operation
+types, but for now I just want to document this tricky little op while it's
+fresh.)
+
+Now that's a special little op, a triop masquerading as a binop. The idea is
+that we do a little bit like a if() *except* that it leaks a value, something
+that the regular if() doesn't do (this has implication for the Forth VM which
+tracks PS levels).
+
+You call this op at the ":" operator. When you encountered the "?" operator, you
+simply :push'ed your operand and kept it around, and kept vmop^ (the "result if
+true" operand) as vmop. Now, at ":" time, you have your true op in vmop and your
+false one in vmop^.
+
+Calling vm?:, will compile both ops, wraping them around jumps, but, more
+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.
+
### Jumping in the VM
There are 2 kinds of jumps: forward and backward. In forward jumps, we need to
@@ -177,3 +198,4 @@ Backward jumps are written with the non-"[" words:
here ... vmjmp,
here ... vmjnz,
+
diff --git a/fs/tests/comp/c/cc.fs b/fs/tests/comp/c/cc.fs
@@ -16,6 +16,8 @@ binopshl 336 #eq
binopshr 10 #eq
binopdiv 14 #eq
binopmod 1 #eq
+1 binopcondeval 42 #eq
+0 binopcondeval 12 #eq
assignops 83 #eq
boolops 0 #eq
funcall 42 #eq
diff --git a/fs/tests/comp/c/test.c b/fs/tests/comp/c/test.c
@@ -52,6 +52,9 @@ int binopmod() {
int a=43;
return a % 3;
}
+int binopcondeval(int x) {
+ return x ? 42 : 12 ;
+}
int assignops() {
int a=42, b=2, c=3;
a += b; // 44
