duskos

commit 705e6c868adf4939b81e051d7341d8e6a926c9bf
parent e9a0327f92c2489ec5dd451d2fb69dfbb9e305b6
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 17 Mar 2023 09:43:41 -0400

hal i386: add "cmp," instruction

EAX=1 at bye

Diffstat:
M
fs/xcomp/bootlo2.fs
 | 
43
+++++++++++++++++++++++++++++++++++++++++--
M
fs/xcomp/i386/kernel.fs
 | 
3
+++

2 files changed, 44 insertions(+), 2 deletions(-)
diff --git a/fs/xcomp/bootlo2.fs b/fs/xcomp/bootlo2.fs
@@ -232,6 +232,45 @@ alias execute | immediate
   2dup < if to j to i begin yield 1 to+ i i j >= until else 2drop then unyield ;
 
 : fill ( a u c -- ) rot> over + for2 dup i c! next drop ;
+: allot0 ( n -- ) here over 0 fill allot ;
+: nc, ( n -- ) for word runword c, next ;
 
-create hello $12345678 ,
-: foo hello @ bye ; hello 4 42 fill foo
+\ index of "c" inside range "a u". -1 if not found
+: [c]? ( c a u -- i )
+  -1 >r swap >r 0 swap for2 ( c ) \ V1=res V2=a
+  dup 8b to@+ V2 = if j to@! i to V1 then next ( c )
+  drop rdrop r> ( i ) ;
+
+\ Emitting
+$20 const SPC $0d const CR $0a const LF $08 const BS $1b const ESC
+alias drop emit
+: nl> LF emit ; : spc> SPC emit ;
+: _ ( a u ) for c@+ emit next drop ;
+current ' rtype realias
+: stype ( str -- ) c@+ rtype ;
+create _escapes 'n' c, 'r' c, '0' c,
+create _repl    LF  c, CR  c, 0   c,
+: "< ( -- c )
+  in< dup '"' = if drop -1 else dup '\' = if
+    drop in< dup _escapes 3 [c]? dup 0>= if nip _repl + c@ else drop then
+  then then ;
+: ," begin "< dup -1 <> while c, repeat drop ;
+code (s) r@ W>A, W) 8b) @, 1 W+n, RSP) +, rdrop W<>A, branchA,
+: S" ( comp: -- ) ( not-comp: -- str )
+  compiling if compile (s) else here then
+  here 1 allot here ," here -^ ( 'len len ) swap c! ; immediate
+: ."
+  compiling if [compile] S" compile stype else
+    begin "< dup 0>= while emit repeat drop then ; immediate
+: abort" [compile] ." compile abort ; immediate
+: word" [compile] S" NEXTWORD litn compile ! ; immediate
+
+code []= ( a1 a2 u -- f )
+  W=0>Z, 0 Z) branchC, PSP) @!, W>A, begin \ P+4=a1 P+0=u A=a2
+    PSP) 4 +) 8b) [@], A) 8b) cmp, 0 Z) branchC,
+      8 ps+, 0 LIT>W, exit, then
+    1 A+n, 1 PSP) 4 +) [+n], -1 PSP) [+n], NZ) branchC, drop then
+  8 ps+, 1 LIT>W, exit,
+: s= ( s1 s2 -- f ) over c@ 1+ []= ;
+
+: foo S" foo" S" foo" s= bye ; foo
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -256,6 +256,9 @@ xcode @!, ( operand -- ) \ operand ax xchg,
 xcode +, ( operand -- ) \ ax operand add,
   ax $0200 i) or, L1 absjmp,
 
+xcode cmp, ( operand -- ) \ ax operand cmp,
+  ax $3a00 i) or, L1 absjmp,
+
 xcode lea, ( operand -- ) \ ax operand lea,
   ax $8d00 i) or, L1 absjmp,