duskos

commit f35afc9f025b822eff8ab20eee67f33b53a32863
parent d841f36f933a42f1cc5a36b55c039a19639a5c80
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu, 16 Jun 2022 15:13:14 -0400

cc: add ++ and -- operators

... as prefix operators. postfix not done yet.

Diffstat:
M
fs/asm.fs
 | 
1
+
M
fs/cc/ast.fs
 | 
11
+++++------
M
fs/cc/gen.fs
 | 
7
++++++-
M
fs/cc/vm.fs
 | 
11
++++++++---
M
fs/tests/cc/cc.fs
 | 
1
+
M
fs/tests/cc/test.c
 | 
5
+++++

6 files changed, 26 insertions(+), 10 deletions(-)
diff --git a/fs/asm.fs b/fs/asm.fs
@@ -86,6 +86,7 @@ $00e9 op jmp,      $0f84 op jz,        $0f85 op jnz,
 : op ( reg opcode -- ) doer , c, does> ( a -- )
   dup @ swap 4 + c@ swap modrm1, ;
 4 $f7   op mul,    3 $f7   op neg,     2 $f7   op not,
+1 $ff   op dec,    0 $ff   op inc,
 0 $0f9f op setg,   0 $0f9c op setl,    0 $0f94 op setz,
 
 \ Two operands
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -4,13 +4,12 @@
 \ representing the nodes found in a C source file. See tree.fs for structure.
 
 \ Unary operators
-5 const UOPSCNT
-create uopssyms ," -~!&*?"
+7 const UOPSCNT
+UOPSCNT stringlist UOPTlist "-" "~" "!" "&" "*" "++" "--"
 
 : uopid ( tok -- opid? f )
-  c@+ 1 = if c@ uopssyms UOPSCNT [c]? dup 0< if drop 0 else 1 then
-    else drop 0 then ;
-: uopchar ( opid -- c ) UOPSCNT min uopssyms + c@ ;
+  UOPTlist sfind dup 0< if drop 0 else 1 then ;
+: uoptoken ( opid -- tok ) UOPTlist slistiter ;
 
 \ Binary operators
 13 const BOPSCNT
@@ -67,7 +66,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
 'w noop ( Statements )
 'w noop ( ArgSpecs )
 'w _s ( LValue )
-:w ( UnaryOp ) _[ dup data1 uopchar emit _] ;
+:w ( UnaryOp ) _[ dup data1 uoptoken stype _] ;
 'w noop ( unused )
 :w ( BinaryOp ) _[ dup data1 boptoken stype _] ;
 'w noop ( Unused )
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -11,6 +11,8 @@ UOPSCNT wordtbl uopgentbl ( -- )
 :w ( ! ) operand?>result vmboolnot, ;
 'w operand>&operand ( & )
 'w operand>[operand] ( * )
+:w ( ++ ) vminc, ;
+:w ( -- ) vmdec, ;
 
 BOPSCNT wordtbl bopgentblmiddle ( node -- node )
 'w noop ( + )
@@ -77,10 +79,13 @@ ASTIDCNT wordtbl gentbl ( node -- )
 :w ( Return )
   genchildren operand?>result vmret, ;
 :w ( Constant ) data1 const>operand ;
-:w ( Statements ) genchildren ;
+:w ( Statements )
+  \ we run vm$ between each statement to discard any unused Result
+  firstchild ?dup if begin dup gennode vm$ nextsibling ?dup not until then ;
 'w genchildren ( ArgSpecs )
 :w ( LValue ) lvsfoff sf+>operand ;
 :w ( UnaryOp )
+  dup printast nl>
   dup genchildren
   data1 uopgentbl swap wexec ;
 'w _err ( unused )
diff --git a/fs/cc/vm.fs b/fs/cc/vm.fs
@@ -56,15 +56,16 @@ VM_NONE value operand
 : opersf+ ( -- off ) operandarg callsz + ;
 
 \ Resolve current operand as an assembler "src" argument.
-: operandAsm ( -- )
+: operandAsmKeep ( -- )
   operand VM_CONSTANT = if
     operandarg i32
   else operand VM_REGISTER = if
       ebx
     else operand VM_STACKFRAME = if
       opersf+ [ebp]+
-    else _err then then then
-  VM_NONE to operand ;
+    else _err then then then ;
+
+: operandAsm ( -- ) operandAsmKeep VM_NONE to operand ;
 
 : result! 1 to resultset? ;
 
@@ -156,6 +157,10 @@ VM_NONE value operand
   eax eax test,
   eax 0 i32 mov,
   al setz, ;
+\ inc/dec are special because they operate on the current *operand*, not the
+\ result.
+: vminc, operandAsmKeep inc, ;
+: vmdec, operandAsmKeep dec, ;
 : vm<,
   eax operandAsm cmp,
   eax 0 i32 mov,
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -17,4 +17,5 @@ ptrget 42 #eq
 ptrset 54 #eq
 12 condif 13 #eq
 42 condif 142 #eq
+42 incdec 43 #eq
 testend
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -45,3 +45,8 @@ int condif(int x) {
     }
     return x;
 }
+int incdec(int x) {
+    ++x;
+    --x;
+    return ++x;
+}