From d8d2e05eb2ecce663eecdfb4c3863d891255919c Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 15 Jun 2020 06:23:19 -0400
Subject: [PATCH] pcat: make find compare strings
find is the biggest chunk of logic of the boot code. The 8086 version
is significantly terser than the z80 one. REP/CMPS helps...
---
blk/812 | 2 +-
blk/813 | 2 +-
blk/814 | 6 +++---
blk/815 | 24 +++++++++++++-----------
blk/816 | 12 ++++++------
blk/817 | 8 ++++++++
recipes/pcat/xcomp.fs | 2 +-
7 files changed, 33 insertions(+), 23 deletions(-)
create mode 100644 blk/817
diff --git a/blk/812 b/blk/812
index c22280d..b50ddcf 100644
--- a/blk/812
+++ b/blk/812
@@ -5,7 +5,7 @@ JMPn, 0 A,, ( 00, main ) JMPn, 0 A,, ( 03, find )
0 A, ( 0a, unused ) JMPn, 0 A,, ( 0b, cellWord )
JMPn, 0 A,, ( 0e compiledWord ) JMPn, 0 A,, ( 11, pushRS )
JMPn, 0 A,, ( 14, popRS )
-BX JMPr, ( 17, nativeWord ) 0 A,
+DI JMPr, ( 17, nativeWord ) 0 A,
JMPn, 0 A,, ( 1a, next ) JMPn, 0 A,, ( 1d, unused )
0 A, 0 A, ( 20, numberWord ) 0 A, 0 A, ( 22, litWord )
0 A, 0 A, ( 24, addrWord ) 0 A, 0 A, ( 26, unused )
diff --git a/blk/813 b/blk/813
index eab0231..d1f9126 100644
--- a/blk/813
+++ b/blk/813
@@ -9,5 +9,5 @@ H@ XCURRENT ! ( set current tip of dict, 0x42 )
;CODE
CODE FOO
AH 0x0e MOVri, ( print char ) AL 'X' MOVri, 0x10 INT,
- L2 BSET JMPs, L2 @ RPCs,
+ BEGIN, JMPs, AGAIN,
;CODE
diff --git a/blk/814 b/blk/814
index 49b30b6..d08ff0c 100644
--- a/blk/814
+++ b/blk/814
@@ -1,5 +1,5 @@
-L1 BSET PC 3 - ORG @ 0x34 + ! ( execute -- BX -> wordref )
+L1 BSET PC 3 - ORG @ 0x34 + ! ( execute -- DI -> wordref )
AH AH XORrr,
- AL [BX] MOVr[],
- BX INCx, ( PFA )
+ AL [DI] MOVr[],
+ DI INCx, ( PFA )
AX JMPr,
diff --git a/blk/815 b/blk/815
index 6c0b7e7..fed4712 100644
--- a/blk/815
+++ b/blk/815
@@ -1,14 +1,16 @@
L4 BSET PC 3 - ORG @ 4 + ! ( find )
( find word the same name as str in SI starting from tip in
- BX. Returns wordref in BX. Z if found, NZ if not. )
+ DI. Returns wordref in BX. Z if found, NZ if not. )
CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
- SI INCx,
- AX AX XORxx, ( initial prev )
- BEGIN, ( inner )
- BX AX SUBxx, ( jump to prev wordref )
- BX DECx, AL [BX] MOVr[], ( strlen )
- CL AL CMPrr, IFZ, BX INCx, RETn, THEN,
- BX DECx, BX DECx, AX [BX] MOVx[], ( prev )
- AX AX ORxx,
- JNZ, AGAIN,
- BEGIN, JMPs, AGAIN,
+ SI INCx, ( first char ) AX AX XORxx, ( initial prev )
+ BEGIN, ( loop )
+ DI AX SUBxx, ( jump to prev wordref )
+ DI DECx, AL [DI] MOVr[], ( strlen )
+ CL AL CMPrr, IFZ, ( same len )
+ SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
+ 2 ADDALi, ( prev ) AH AH XORrr, DI AX SUBxx,
+ REPZ, CMPSB,
+ CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
+ IFZ, DI INCx, AL AL XORrr, ( Z ) RETn, THEN,
+ THEN,
+ ( cont. )
diff --git a/blk/816 b/blk/816
index fd812e5..6831b7f 100644
--- a/blk/816
+++ b/blk/816
@@ -1,6 +1,6 @@
-L3 BSET 3 A, 'F' A, 'O' A, 'O' A,
-PC 3 - ORG @ 1+ ! ( main )
- BX 0x08 MOVxm, ( LATEST )
- SI L3 @ MOVxi,
- CALLn, L4 @ RPCn, ( find )
- JMPs, L1 @ RPCs, ( execute )
+( find cont. )
+ DI DECx, DI DECx, AX [DI] MOVx[], ( prev )
+ AX AX ORxx,
+ JNZ, AGAIN, ( loop )
+ AX INCx, ( NZ ) RETn,
+
diff --git a/blk/817 b/blk/817
new file mode 100644
index 0000000..ab07de1
--- /dev/null
+++ b/blk/817
@@ -0,0 +1,8 @@
+L3 BSET 3 A, 'F' A, 'O' A, 'O' A,
+PC 3 - ORG @ 1+ ! ( main )
+ DI 0x08 MOVxm, ( LATEST )
+ SI L3 @ MOVxi,
+ CALLn, L4 @ RPCn, ( find )
+ IFZ, JMPs, L1 @ RPCs, ( execute ) THEN,
+ AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
+ BEGIN, JMPs, AGAIN,
diff --git a/recipes/pcat/xcomp.fs b/recipes/pcat/xcomp.fs
index 0eb7708..656add7 100644
--- a/recipes/pcat/xcomp.fs
+++ b/recipes/pcat/xcomp.fs
@@ -1,7 +1,7 @@
750 LOAD ( 8086 asm )
262 LOAD ( xcomp )
270 LOAD ( xcomp overrides )
-812 816 LOADR
+812 817 LOADR
(entry) _
( Update LATEST )
PC ORG @ 8 + !