1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-25 04:58:05 +11:00

pcat: implement does

This commit is contained in:
Virgil Dupras 2020-06-21 10:40:09 -04:00
parent d83d12899b
commit dcaa515929
15 changed files with 143 additions and 140 deletions

12
blk/816
View File

@ -6,10 +6,8 @@ lblexec BSET PC 0x36 - ORG @ 0x34 + ! ( DI -> wordref )
AL [DI] MOVr[], DI INCx, ( PFA )
AL AL ORrr, IFZ, DI JMPr, THEN, ( native )
AL DECr, IFNZ, ( cell or does )
DI PUSHx, ( push PFA ) JMPs, lblnext @ RPCs,
( TODO: implement does )
THEN, ( compiled )
BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
DI [DI] MOVx[],
JMPs, lblexec @ RPCs,
DI PUSHx, ( push PFA )
AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN,
( does, see B302 )
DI INCx, DI INCx, DI [DI] MOVx[],
THEN, ( continue to compiled cont. )

20
blk/817
View File

@ -1,15 +1,5 @@
lblfind BSET
( find word the same name as str in SI starting from tip in
DI. Returns wordref in DI. Z if found, NZ if not. )
CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
SI INCx, ( first char ) AX AX XORxx, ( initial prev )
BEGIN, ( loop )
DI AX SUBxx, ( jump to prev wordref )
AL [DI] -1 MOVr[]+, ( strlen )
CL AL CMPrr, IFZ, ( same len )
SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
CLD, REPZ, CMPSB,
CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
IFZ, RETn, THEN,
THEN,
( compiled )
BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
DI [DI] MOVx[],
JMPs, lblexec @ RPCs,

View File

@ -1,5 +0,0 @@
( find cont. )
DI 3 SUBxi, AX [DI] MOVx[], ( prev )
AX AX ORxx,
JNZ, AGAIN, ( loop )
SI DECx, ( start of string, and NZ ) RETn,

28
blk/819
View File

@ -1,13 +1,15 @@
L3 BSET 4 A, 'B' A, 'O' A, 'O' A, 'T' A,
PC 3 - ORG @ 1+ ! ( main )
SP PS_ADDR MOVxI, BP RS_ADDR MOVxI,
DI 0x08 MOVxm, ( LATEST )
( HERE begins at CURRENT )
BX RAMSTART MOVxI,
[BX] 0x04 ( HERE ) DI MOV[]+x,
[BX] 0x02 ( CURRENT ) DI MOV[]+x,
SI L3 @ MOVxI,
CALLn, lblfind @ RPCn, ( find )
IFZ, JMPn, lblexec @ RPCn, ( execute ) THEN,
AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
BEGIN, JMPs, AGAIN,
lblfind BSET
( find word the same name as str in SI starting from tip in
DI. Returns wordref in DI. Z if found, NZ if not. )
CH CH XORrr, CL [SI] MOVr[], ( CX -> strlen )
SI INCx, ( first char ) AX AX XORxx, ( initial prev )
BEGIN, ( loop )
DI AX SUBxx, ( jump to prev wordref )
AL [DI] -1 MOVr[]+, ( strlen )
CL AL CMPrr, IFZ, ( same len )
SI PUSHx, DI PUSHx, CX PUSHx, ( --> lvl 3 )
3 ADDALi, ( header ) AH AH XORrr, DI AX SUBxx,
CLD, REPZ, CMPSB,
CX POPx, DI POPx, SI POPx, ( <-- lvl 3 )
IFZ, RETn, THEN,
THEN,

21
blk/820
View File

@ -1,16 +1,5 @@
( native words )
CODE EXECUTE
DI POPx, JMPn, lblexec @ RPCn,
CODE >R
BP INCx, BP INCx, [BP] 0 POP[w]+,
;CODE NOP, NOP, NOP,
CODE R>
[BP] 0 PUSH[w]+, BP DECx, BP DECx,
;CODE
CODE 2R>
[BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
;CODE
CODE ROT ( a b c -- b c a )
CX POPx, BX POPx, AX POPx,
BX PUSHx, CX PUSHx, AX PUSHx,
;CODE
( find cont. )
DI 3 SUBxi, AX [DI] MOVx[], ( prev )
AX AX ORxx,
JNZ, AGAIN, ( loop )
SI DECx, ( start of string, and NZ ) RETn,

29
blk/821
View File

@ -1,16 +1,13 @@
CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;CODE
CODE ?DUP AX POPx, AX AX ORxx, AX PUSHx,
IFNZ, AX PUSHx, THEN, ;CODE
CODE DROP AX POPx, ;CODE
CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
CODE OVER ( a b -- a b a )
DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
CODE PICK
DI POPx, DI SHLx1, ( x2 )
DI SP ADDxx, DI [DI] MOVx[], DI PUSHx,
;CODE
CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
CX POPx, SI SP MOVxx, SI CX ADDxx,
DI SI MOVxx, SI DECx, SI DECx,
STD, REPZ, MOVSB,
;CODE
L3 BSET 4 A, 'B' A, 'O' A, 'O' A, 'T' A,
PC 3 - ORG @ 1+ ! ( main )
SP PS_ADDR MOVxI, BP RS_ADDR MOVxI,
DI 0x08 MOVxm, ( LATEST )
( HERE begins at CURRENT )
BX RAMSTART MOVxI,
[BX] 0x04 ( HERE ) DI MOV[]+x,
[BX] 0x02 ( CURRENT ) DI MOV[]+x,
SI L3 @ MOVxI,
CALLn, lblfind @ RPCn, ( find )
IFZ, JMPn, lblexec @ RPCn, ( execute ) THEN,
AH 0x0e MOVri, ( print char ) AL '!' MOVri, 0x10 INT,
BEGIN, JMPs, AGAIN,

26
blk/822
View File

@ -1,14 +1,16 @@
CODE 2DROP SP 4 ADDxi, ;CODE
CODE 2DUP
AX POPx, BX POPx,
BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
( native words )
CODE EXECUTE
DI POPx, JMPn, lblexec @ RPCn,
CODE >R
BP INCx, BP INCx, [BP] 0 POP[w]+,
;CODE NOP, NOP, NOP,
CODE R>
[BP] 0 PUSH[w]+, BP DECx, BP DECx,
;CODE
CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
CODE 'S SP PUSHx, ;CODE
CODE AND AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
CODE OR AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
CODE XOR AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
CODE NOT
AX POPx, AX AX ORxx,
IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
CODE 2R>
[BP] -2 PUSH[w]+, [BP] 0 PUSH[w]+, BP 4 SUBxi,
;CODE
CODE ROT ( a b c -- b c a )
CX POPx, BX POPx, AX POPx,
BX PUSHx, CX PUSHx, AX PUSHx,
;CODE

25
blk/823
View File

@ -1,13 +1,16 @@
CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
CODE *
AX POPx, BX POPx,
DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
AX PUSHx,
CODE DUP AX POPx, AX PUSHx, AX PUSHx, ;CODE
CODE ?DUP AX POPx, AX AX ORxx, AX PUSHx,
IFNZ, AX PUSHx, THEN, ;CODE
CODE DROP AX POPx, ;CODE
CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
CODE OVER ( a b -- a b a )
DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
CODE PICK
DI POPx, DI SHLx1, ( x2 )
DI SP ADDxx, DI [DI] MOVx[], DI PUSHx,
;CODE
CODE /MOD
BX POPx, AX POPx, DX PUSHx, ( protect )
DX DX XORxx, BX DIVx,
BX DX MOVxx, DX POPx, ( unprotect )
BX PUSHx, ( modulo ) AX PUSHx, ( division )
CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
CX POPx, SI SP MOVxx, SI CX ADDxx,
DI SI MOVxx, SI DECx, SI DECx,
STD, REPZ, MOVSB,
;CODE

25
blk/824
View File

@ -1,11 +1,14 @@
CODE ! DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE
CODE @ DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE
CODE C! DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE
CODE C@
DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE
CODE I [BP] 0 PUSH[w]+, ;CODE
CODE I' [BP] -2 PUSH[w]+, ;CODE
CODE J [BP] -4 PUSH[w]+, ;CODE
CODE (resSP) SP PS_ADDR MOVxI, ;CODE
CODE (resRS) BP RS_ADDR MOVxI, ;CODE
CODE BYE BEGIN, JMPs, AGAIN, ;CODE
CODE 2DROP SP 4 ADDxi, ;CODE
CODE 2DUP
AX POPx, BX POPx,
BX PUSHx, AX PUSHx, BX PUSHx, AX PUSHx,
;CODE
CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
CODE 'S SP PUSHx, ;CODE
CODE AND AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
CODE OR AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
CODE XOR AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
CODE NOT
AX POPx, AX AX ORxx,
IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
;CODE

24
blk/825
View File

@ -1,15 +1,13 @@
CODE S=
SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
CL [DI] CMPr[],
IFZ, ( same size? )
SI INCx, DI INCx, CLD, REPZ, CMPSB,
THEN,
PUSHZ,
CODE + AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
CODE - BX POPx, AX POPx, AX BX SUBxx, AX PUSHx, ;CODE
CODE *
AX POPx, BX POPx,
DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
AX PUSHx,
;CODE
CODE CMP
BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
IFNZ, ( < or > )
CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
THEN,
CX PUSHx,
CODE /MOD
BX POPx, AX POPx, DX PUSHx, ( protect )
DX DX XORxx, BX DIVx,
BX DX MOVxx, DX POPx, ( unprotect )
BX PUSHx, ( modulo ) AX PUSHx, ( division )
;CODE

20
blk/826
View File

@ -1,9 +1,11 @@
CODE _find ( cur w -- a f )
SI POPx, ( w ) DI POPx, ( cur )
CALLn, lblfind @ RPCn,
IFNZ, ( not found )
SI PUSHx, AX AX XORxx, AX PUSHx,
JMPn, lblnext @ RPCn,
THEN, ( found )
DI PUSHx, AX 1 MOVxI, AX PUSHx,
;CODE
CODE ! DI POPx, AX POPx, [DI] AX MOV[]x, ;CODE
CODE @ DI POPx, AX [DI] MOVx[], AX PUSHx, ;CODE
CODE C! DI POPx, AX POPx, [DI] AX MOV[]r, ;CODE
CODE C@
DI POPx, AH AH XORrr, AL [DI] MOVr[], AX PUSHx, ;CODE
CODE I [BP] 0 PUSH[w]+, ;CODE
CODE I' [BP] -2 PUSH[w]+, ;CODE
CODE J [BP] -4 PUSH[w]+, ;CODE
CODE (resSP) SP PS_ADDR MOVxI, ;CODE
CODE (resRS) BP RS_ADDR MOVxI, ;CODE
CODE BYE BEGIN, JMPs, AGAIN, ;CODE

26
blk/827
View File

@ -1,11 +1,15 @@
CODE 0 AX AX XORxx, AX PUSHx, ;CODE
CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE
CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE
CODE 1+ DI SP MOVxx, [DI] INC[w], ;CODE
CODE 1- DI SP MOVxx, [DI] DEC[w], ;CODE
CODE 2+ DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE
CODE 2- DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE
CODE RSHIFT ( n u -- n )
CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
CODE LSHIFT ( n u -- n )
CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE
CODE S=
SI POPx, DI POPx, CH CH XORrr, CL [SI] MOVr[],
CL [DI] CMPr[],
IFZ, ( same size? )
SI INCx, DI INCx, CLD, REPZ, CMPSB,
THEN,
PUSHZ,
;CODE
CODE CMP
BX POPx, AX POPx, CX CX XORxx, AX BX CMPxx,
IFNZ, ( < or > )
CX INCx, IFNC, ( < ) CX DECx, CX DECx, THEN,
THEN,
CX PUSHx,
;CODE

9
blk/828 Normal file
View File

@ -0,0 +1,9 @@
CODE _find ( cur w -- a f )
SI POPx, ( w ) DI POPx, ( cur )
CALLn, lblfind @ RPCn,
IFNZ, ( not found )
SI PUSHx, AX AX XORxx, AX PUSHx,
JMPn, lblnext @ RPCn,
THEN, ( found )
DI PUSHx, AX 1 MOVxI, AX PUSHx,
;CODE

11
blk/829 Normal file
View File

@ -0,0 +1,11 @@
CODE 0 AX AX XORxx, AX PUSHx, ;CODE
CODE 1 AX 1 MOVxI, AX PUSHx, ;CODE
CODE -1 AX -1 MOVxI, AX PUSHx, ;CODE
CODE 1+ DI SP MOVxx, [DI] INC[w], ;CODE
CODE 1- DI SP MOVxx, [DI] DEC[w], ;CODE
CODE 2+ DI SP MOVxx, [DI] INC[w], [DI] INC[w], ;CODE
CODE 2- DI SP MOVxx, [DI] DEC[w], [DI] DEC[w], ;CODE
CODE RSHIFT ( n u -- n )
CX POPx, AX POPx, AX SHRxCL, AX PUSHx, ;CODE
CODE LSHIFT ( n u -- n )
CX POPx, AX POPx, AX SHLxCL, AX PUSHx, ;CODE

View File

@ -4,7 +4,7 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
750 LOAD ( 8086 asm )
262 LOAD ( xcomp )
270 LOAD ( xcomp overrides )
812 827 LOADR
812 829 LOADR
353 LOAD ( xcomp core low )
CODE (emit)
AX POPx, AH 0x0e MOVri, ( print char ) 0x10 INT,