commit 7ba873823bc6e6c1ccee409d64789f6669ba284c
parent 0ecb7f0ea439ef4c6753bfd0193d895e45d160c3
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 24 Jul 2022 14:09:08 -0400
i386: add parse runword
Diffstat:
3 files changed, 136 insertions(+), 26 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -30,6 +30,8 @@
: w, here w! 2 allot ;
: isbyte? ( n -- f ) $100 < ;
: is16bit? realmode ;
+: 8b! 1 to op8b ;
+: 16b! realmode not if $66 c, then ;
\ in 16bit, abs mem = mod0 + rm 6, in 32-bit, it's rm 5
: memoprm 5 is16bit? + ;
: maybe8b ( opcode -- opcode ) op8b not or ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -4,10 +4,13 @@
\ ESP and EBP are uninitialized.
?f<< /xcomp/tools.fs
+: [ebp] bp 0 d) ;
+: [esi] si 0 d) ;
: ps+, bp CELLSZ i) sub, ;
: ps-, bp CELLSZ i) add, ;
-: pspush, ( regid -- ) ps+, bp 0 d) r! mov, ;
-: pspop, ( regid -- ) r! bp 0 d) mov, ps-, ;
+: pspush, ( regid -- ) ps+, [ebp] r! mov, ;
+: pspushN, ( n -- ) ps+, [ebp] i) mov, ;
+: pspop, ( regid -- ) r! [ebp] mov, ps-, ;
0 to realmode
0 value L1
@@ -21,6 +24,9 @@
0 value lblret \ label for whenever you need to return early
0 value lblcurrent
0 value lblemit
+0 value lblparsec
+0 value lblparseh
+0 value lblparseud
$8000 to binstart \ This code lives at $8000.
$6000 const RSTOP
$8000 const PSTOP
@@ -105,31 +111,35 @@ xcode abort
bp PSTOP i) mov,
xwordlbl quit abs>rel jmp,
+xcode drop
+ ps-,
+ ret,
+
xcode dup
- ax bp 0 d) mov,
+ ax [ebp] mov,
AX pspush,
ret,
xcode swap
- ax bp 0 d) mov,
+ ax [ebp] mov,
bx bp CELLSZ d) mov,
- bp 0 d) bx mov,
+ [ebp] bx mov,
bp CELLSZ d) ax mov,
ret,
xcode 1+
- bp 0 d) inc,
+ [ebp] inc,
ret,
xcode 1-
- bp 0 d) dec,
+ [ebp] dec,
ret,
xcode c@
- si bp 0 d) mov,
+ si [ebp] mov,
ax ax xor,
- al si 0 d) mov,
- bp 0 d) ax mov,
+ al [esi] mov,
+ [ebp] ax mov,
ret,
xcode !
@@ -154,7 +164,7 @@ xcode rtype ( a u -- )
SI pspop,
pc
ax ax xor,
- al si 0 d) mov,
+ al [esi] mov,
AX pspush,
si push, cx push,
xwordlbl emit abs>rel call,
@@ -168,7 +178,7 @@ pc to lblbootptr 0 ,
xcode boot<
si lblbootptr m) mov,
ax ax xor,
- al si 0 d) mov,
+ al [esi] mov,
lblbootptr m) inc,
AX pspush,
ret,
@@ -181,7 +191,7 @@ pc to lblin<
pc to lblcurword $20 allot0
xcode curword
- ps+, bp 0 d) lblcurword i) mov,
+ lblcurword pspushN,
ret,
pc to L1 ( word_eof )
@@ -220,12 +230,12 @@ L1 forward! ( stoploop )
lbltoptr m) ax mov,
bx lblcurword 1+ i) sub,
lblcurword m) bl mov,
- ps+, bp 0 d) lblcurword i) mov,
+ lblcurword pspushN,
ret,
xcode word
xwordlbl maybeword abs>rel call,
- bp 0 d) -1 i) test,
+ [ebp] -1 i) test,
lblret abs>rel jnz,
0 jmp, \ TODO add error message
@@ -233,11 +243,11 @@ xcode current
xwordlbl (val) abs>rel call,
pc to lblcurrent 0 ,
-xcode find ( str -- word-or-0 ) pc lblcurrent pc>addr !
- si bp 0 d) mov,
+xcode find ( str -- word-or-0 )
+ si [ebp] mov,
cx cx xor,
- cl si 0 d) mov,
- bp 0 d) inc,
+ cl [esi] mov,
+ [ebp] inc,
dx lblcurrent m) mov,
pc ( loop )
di dx mov,
@@ -249,11 +259,11 @@ pc ( loop )
\ same length
di 4 i) sub,
di cx sub,
- si bp 0 d) mov,
+ si [ebp] mov,
repz, cmpsb,
forward jnz, to L2 ( skip2 )
\ same contents
- bp 0 d) dx mov,
+ [ebp] dx mov,
ret,
L2 forward! ( skip2 )
cl al mov,
@@ -263,17 +273,115 @@ L1 forward! ( skip1 )
dx dx test,
( pc ) abs>rel jnz, ( loop )
\ not found
- bp 0 d) 0 i) mov,
+ [ebp] 0 i) mov,
+ ret,
+
+pc to L1 \ parse unsuccessful
+ [ebp] 0 i) mov,
+ ret,
+
+pc to lblparsec ( str -- n? f ) \ esi=sa ecx=sl
+ cx 3 i) cmp,
+ L1 abs>rel jnz, \ fail
+ 8b! si 2 d) ''' i) cmp,
+ L1 abs>rel jnz, \ fail
+ ax ax xor,
+ al si 1 d) mov,
+ [ebp] ax mov,
+ 1 pspushN,
+ ret,
+
+pc to lblparseh ( str -- n? f ) \ esi=sa ecx=sl
+ cx 2 i) cmp,
+ L1 abs>rel jc, \ fail
+ si inc, \ skip $
+ cx dec,
+ ax ax xor,
+ bx bx xor,
+pc ( loop )
+ bl [esi] mov,
+ bl $20 i) or,
+ bl '0' i) sub,
+ L1 abs>rel jc, \ fail
+ bl 10 i) cmp,
+ forward jc, to L2 \ parse ok, under 10
+ bl 'a' '0' - i) sub,
+ L1 abs>rel jc, \ fail
+ bl 10 i) add,
+ bl 16 i) cmp,
+ L1 abs>rel jnc, \ fail
+L2 forward! \ parse ok
+ ax 4 i) shl, \ res*16
+ ax bx add,
+ si inc,
+ cx dec,
+ ( pc ) abs>rel jnz, ( loop )
+ [ebp] ax mov,
+ 1 pspushN,
+ ret,
+
+pc to lblparseud ( str -- n? f ) \ esi=sa ecx=sl
+ cx cx test,
+ L1 abs>rel jz, \ fail
+ ax ax xor, \ res
+pc ( loop )
+ bx 10 i) mov,
+ bx mul,
+ bl [esi] mov,
+ bl '0' i) sub,
+ L1 abs>rel jc, \ fail
+ bl 10 i) cmp,
+ L1 abs>rel jnc, \ fail
+ ax bx add,
+ si inc,
+ cx dec,
+ ( pc ) abs>rel jnz, ( loop )
+ [ebp] ax mov,
+ 1 pspushN,
+ ret,
+
+xcode parse ( str -- n? f )
+ si [ebp] mov,
+ cx cx xor,
+ cl [esi] mov,
+ si inc,
+ 8b! [esi] ''' i) cmp,
+ lblparsec abs>rel jz,
+ 8b! [esi] '$' i) cmp,
+ lblparseh abs>rel jz,
+ 8b! [esi] '-' i) cmp,
+ lblparseud abs>rel jnz,
+ si inc,
+ cx dec,
+ lblparseud abs>rel call,
+ [ebp] -1 i) test,
+ L1 abs>rel jz, \ fail
+ bp CELLSZ d) neg,
ret,
+xcode execute
+ AX pspop,
+ ax jmp,
+
+xcode runword ( str -- ) pc lblcurrent pc>addr !
+ xwordlbl parse abs>rel call,
+ AX pspop,
+ ax ax test,
+ lblret abs>rel jnz, \ is a literal
+ \ not a literal
+ lblcurword pspushN,
+ xwordlbl find abs>rel call,
+ [ebp] -1 i) test,
+ 0 jz, \ TODO: implement (wnf)
+ xwordlbl execute abs>rel call,
+ ret, \ TODO implement stack?
+
pc lblmainalias pc>addr !
xwordlbl (s) abs>rel call,
12 c, ," Hello World!"
pc ( loop )
xwordlbl word abs>rel call,
- xwordlbl find abs>rel call,
- AX pspop,
- ax call,
+ xwordlbl runword abs>rel call,
( pc ) abs>rel jmp,
pc lblbootptr pc>addr !
diff --git a/fs/xcomp/pc/boot.fs b/fs/xcomp/pc/boot.fs
@@ -1,2 +1,2 @@
-dup 1+ swap c@ rtype bye
+1+ $0c rtype bye
