1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-24 14:28:06 +11:00

Change SCMP for S=

Remove flagsToBC boot routine.
This commit is contained in:
Virgil Dupras 2020-04-15 12:15:35 -04:00
parent 16d5cd91de
commit 2439f1ed86
5 changed files with 21 additions and 19 deletions

View File

@ -5,6 +5,6 @@ LIT -- Write a LIT entry. You're expected to write
LIT< x -- Read following word and write to HERE as a
string literal.
LITS a -- Write word at addr a as a atring literal.
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
S= a1 a2 -- f Compare strings a1 and a2, return true if equal
SCPY a -- Copy string at addr a into HERE.
SLEN a -- n Push length of str at a.

Binary file not shown.

View File

@ -27,7 +27,7 @@ NOP, NOP, ( 20, numberWord )
NOP, NOP, ( 22, litWord )
NOP, NOP, ( 24, addrWord )
NOP, NOP, ( 26, unused )
0 JPnn, ( 28, flagsToBC )
RAMSTART 0x4e + JPnn, ( 28, RST 28 )
0 JPnn, ( 2b, doesWord )
NOP, NOP, ( 2e, unused )
RAMSTART 0x4e + JPnn, ( RST 30 )
@ -218,16 +218,6 @@ L4 FSET ( end )
BC POPqq,
RET,
PC ORG @ 0x29 + ! ( flagsToBC )
BC 0 LDddnn,
CZ RETcc, ( equal )
BC INCss,
CC RETcc, ( > )
( < )
BC DECss,
BC DECss,
RET,
PC ORG @ 0x12 + ! ( pushRS )
IX INCss,
IX INCss,

View File

@ -18,7 +18,7 @@
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
: ( BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
( Hello, hello, krkrkrkr... do you hear me?
Ah, voice at last! Some lines above need comments
BTW: Forth lines limited to 64 cols because of default

View File

@ -311,10 +311,13 @@ CODE (resRS)
IX RS_ADDR LDddnn,
;CODE
CODE SCMP
CODE S=
DE POPqq,
HL POPqq,
chkPS,
( pre-push false )
BC 0 LDddnn,
BC PUSHqq,
BEGIN, ( loop )
LDA(DE),
(HL) CPr,
@ -324,10 +327,11 @@ CODE SCMP
HL INCss,
DE INCss,
JRNZ, AGAIN, ( loop )
( success, change false to true )
HL POPqq,
HL INCss,
HL PUSHqq,
L1 FSET ( end )
( 40 == flagsToBC )
40 CALLnn,
BC PUSHqq,
;CODE
CODE CMP
@ -335,8 +339,16 @@ CODE CMP
DE POPqq,
chkPS,
DE SUBHLss,
( 40 == flagsToBC )
40 CALLnn,
BC 0 LDddnn,
IFZ,
( not equal )
BC INCss,
IFC,
( < )
BC DECss,
BC DECss,
THEN,
THEN,
BC PUSHqq,
;CODE