duskos

commit bc569eca1386dd3d9f51559a43a36de33509d3d2
parent 68b95efc36ff812e8de90bd4d7545b1c2f5c2c81
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sat, 12 Nov 2022 20:26:53 -0500

cc/vm: rename vm+n, to VMOp :+n

Also, make "if op is const, apply at compile time" logic be applied at the
"common" layer.

Diffstat:
M
fs/cc/gen.fs
 | 
2
+-
M
fs/cc/vm/commonhi.fs
 | 
8
++++++++
M
fs/cc/vm/commonlo.fs
 | 
1
+
M
fs/cc/vm/forth.fs
 | 
4
++--
M
fs/cc/vm/i386.fs
 | 
6
++----

5 files changed, 14 insertions(+), 7 deletions(-)
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -258,7 +258,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
   vmop type dup ctype? _assert dup type*lvl 1 = _assert ( name type )
   ctype' dup CType :struct? _assert ( name ctype )
   CType :find# ( field-ctype )
-  dup CType offset vm+n, vmop :*op ( field-ctype )
+  dup CType offset vmop :+n vmop :*op ( field-ctype )
   dup CType type to vmop type
   CType nbelem if vmop :&op then ;
 
diff --git a/fs/cc/vm/commonhi.fs b/fs/cc/vm/commonhi.fs
@@ -2,6 +2,14 @@
 
 : ops$ selop2 vmop :init selop1 vmop :init neutral# ;
 
+struct+[ VMOp
+  : :<<n
+    dup :isconstlo? if tuck arg swap lshift swap to arg else VMOp :<<n then ;
+  : :>>n
+    dup :isconstlo? if tuck arg swap rshift swap to arg else VMOp :>>n then ;
+  : :+n dup :isconstlo? if to+ arg else VMOp :+n then ;
+]struct
+
 : unop doer , does> @ unop, ;
 0 unop vmneg,      1 unop vmnot,       2 unop vmboolify,   3 unop vmboolnot,
 
diff --git a/fs/cc/vm/commonlo.fs b/fs/cc/vm/commonlo.fs
@@ -59,6 +59,7 @@ struct[ VMOp
   \ Is type a pointer?
   : :typeptr? type type*lvl bool ;
   : :isconst? loc VM_CONSTANT = ;
+  : :isconstlo? :loclo VM_CONSTANT = ;
   : :noop# loc VM_NONE = _assert ;
   : :hasop# loc VM_NONE <> _assert ;
   : :isconst# :isconst? _assert ;
diff --git a/fs/cc/vm/forth.fs b/fs/cc/vm/forth.fs
@@ -52,6 +52,8 @@ struct+[ VMOp
   : :*op dup :locptr? if dup :compile dup :>reg then VMOp :*op ;
   : :<<n ( n self -- ) tuck :compile litn compile lshift :>reg ;
   : :>>n ( n self -- ) tuck :compile litn compile rshift :>reg ;
+  : :+n ( n self -- ) tuck :compile litn compile + :>reg ;
+
 ]struct
 
 \ Verify that we're in "neutral" position with regards to PS
@@ -144,8 +146,6 @@ UNOPMUTCNT wordtbl _tbl8
   case 1 of = _tbl8 endof 2 of = _tbl16 endof _tbl32 endcase ( opid tbl )
   vmop :&loc vmop :compile swap wexec, ;
 
-: vm+n, ( n -- ) vmop :compile litn compile + ?tos>reg ;
-
 ARIOPCNT wordtbl _tbl
 'w +               'w -                'w *                'w /
 'w mod             'w and              'w or               'w xor
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -109,6 +109,8 @@ struct+[ VMOp
 
   : :<<n ( n self -- ) dup :>res :compile i) shl, ;
   : :>>n ( n self -- ) dup :>res :compile i) shr, ;
+  : :+n ( n self -- ) dup :>res :compile i) add, ;
+
 ]struct
 
 \ Verify that we're in "neutral" position with regards to registers
@@ -227,10 +229,6 @@ UNOPMUTCNT wordtbl _tbl
 
 : unopmut, ( opid -- ) _tbl swap wexec ;
 
-: vm+n, ( n -- ) vmop :loclo VM_CONSTANT = if
-    to+ vmop arg
-    else vmop :>res vmop :compile i) add, then ;
-
 : _
   vmop :>reg vmop :compilesz vmop^ :compile cmp, vmop^ :init
   vmop :compile 0 i) mov, vmop :compile ;