duskos

commit f9a43bb5a605067bca973143c6617df52e808390
parent 6a371179beafe5b40825e503d1b32a9e6c6d01f2
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Thu, 16 Mar 2023 15:16:35 -0400

hal i386: implement "@!," "<<n," ">>n,"

EAX=1135 at bye

Diffstat:
M
fs/xcomp/bootlo2.fs
 | 
5
++++-
M
fs/xcomp/i386/kernel.fs
 | 
32
+++++++++++++++++++++-----------

2 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/fs/xcomp/bootlo2.fs b/fs/xcomp/bootlo2.fs
@@ -4,5 +4,8 @@ code : ] code ] ;
 : noop ;
 : Z) $11 ; : NZ) $01 ; : C) $22 ; : NC) $02 ;
 code dup dup, exit,
-: foo $1234 ;
+code swap PSP) @!, exit,
+code << 1 <<n, exit,
+code >> 1 >>n, exit,
+: foo $2345 $1234 swap >> >> << ;
 foo 44 - 'A' - bye
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -28,10 +28,9 @@
 \ Constants and labels
 0 to realmode
 : values ( n -- ) for 0 value next ;
-21 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
+20 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
           lblsysdict lblparsec lblparseh lblparseud lblerrmsg lblhere lbl[rcnt]
-          lblwriterange lblfind lblcompiling lblidt lblmod
-          lblrelwr lblcallwr lblgrp1i
+          lblwriterange lblfind lblcompiling lblidt lblmod lblrelwr lblcallwr
 $8000 const HERESTART
 $500 to binstart
 $2000 const STACKSZ
@@ -89,7 +88,6 @@ lblcurword xconst curword
 pc to lblnextmeta 0 ,
 lblnextmeta xconst nextmeta
 
-
 pc to lblcompiling 0 ,
 xcode compiling
   dup, ax lblcompiling m) mov, ret,
@@ -184,23 +182,20 @@ pc to lblwriterange \ bx=addr cx=u. destroys cx
   si pop, di pop,
   ret,
 
-\ Group1 op (add, sub, etc.)
-pc to lblgrp1i \ bx=dstmodrm cx=i dx=reg
-  dx 3 i) shl,
-  bx dx or,
+\ Assembler words
+pc to L1 \ bx=dstmodrm cx=i
   cx $100 i) cmp, forward8 jb,
     $81 i) cwrite, bl cwrite, cx dwrite, ret,
   forward!
   $83 i) cwrite, bl cwrite, cl cwrite, ret,
 
-\ Assembler words
 xcode rs+, ( n -- ) \ sp XX i) add,
-  bx MODRM_SP i) mov, cx ax mov, dx dx xor, ( add ) lblgrp1i abscall,
+  bx MODRM_SP i) mov, cx ax mov, L1 abscall,
   lbl[rcnt] m) ax add,
   xdrop, ret,
 
 xcode ps+, ( n -- ) \ si XX i) add,
-  bx MODRM_SI i) mov, cx ax mov, dx dx xor, ( add ) lblgrp1i abscall,
+  bx MODRM_SI i) mov, cx ax mov, L1 abscall,
   xdrop, ret,
 
 pc to L1
@@ -232,6 +227,13 @@ xcode !, ( operand -- ) \ operand ax mov,
   xdrop,
   ret,
 
+xcode @!, ( operand -- ) \ operand ax xchg,
+  ax $8600 i) or,
+  al ah xchg,
+  ax wwrite,
+  xdrop,
+  ret,
+
 xcode dup,
   -4 xlit, wcall, ps+,
   wcall, PSP)
@@ -241,6 +243,14 @@ xcode litn
   wcall, dup,
   wjmp, LIT>W,
 
+xcode <<n, ( n -- ) \ ax XX i) shl,
+  $e0c1 i) wwrite, al cwrite,
+  xdrop, ret,
+
+xcode >>n, ( n -- ) \ ax XX i) shr,
+  $e8c1 i) wwrite, al cwrite,
+  xdrop, ret,
+
 pc 3 nc, $5b $ff $d3 \ bx pop, bx call,
 xcode yield ximm
   ( pc ) 3 movewrite, ret,