De-stabilize (br), (?br), (loop), (s)

When writing the xcomp documentation, I realized that with careful
threading and by accepting a bit of code duplication in the xcomp
toolset, I could de-stabilize a couple of words.

(n) and EXIT are a bit trickier, but I think it can be done. It
would be nice to get rid of stable wordrefs...
This commit is contained in:
Virgil Dupras 2020-09-19 13:54:01 -04:00
parent 3295f1689e
commit eefbf66e95
20 changed files with 32 additions and 68 deletions

View File

@ -1 +1 @@
1 LOAD+ 3 LOAD+ 6 LOAD+ 1 3 LOADR+

20
blk/263
View File

@ -1,15 +1,15 @@
CREATE XCURRENT 0 , CREATE XCURRENT 0 ,
: XCON XCURRENT CURRENT* ! ; : XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ;
: XCOFF 0x02 RAM+ CURRENT* ! ; : (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ;
: (xentry) XCON (entry) XCOFF ; : XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ;
: XCREATE (xentry) 2 C, ;
: XCODE XCON CODE XCOFF ;
: XIMM XCON IMMEDIATE XCOFF ;
: _xapply ( a -- a-off ) : _xapply ( a -- a-off )
DUP ORG @ > IF ORG @ - BIN( @ + THEN ; DUP ORG @ > IF ORG @ - BIN( @ + THEN ;
: X' XCON ' XCOFF ; : XFIND XCURRENT @ SWAP _find DROP _xapply ;
: X['] XCON ' _xapply LITN XCOFF ; : X' XCON ' XCOFF ; : X['] XCON ' _xapply LITN XCOFF ;
: XCOMPILE : XCOMPILE XCON ' _xapply LITN
XCON ' _xapply LITN
LIT< , FIND DROP _xapply , XCOFF ; LIT< , FIND DROP _xapply , XCOFF ;
: X[COMPILE] XCON ' _xapply , XCOFF ; : X[COMPILE] XCON ' _xapply , XCOFF ;
: XDO LIT< 2>R XFIND , H@ ;
: XLOOP LIT< (loop) XFIND , H@ - C, ;
: XIF LIT< (?br) XFIND , H@ 1 ALLOT ;
: XELSE LIT< (br) XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ;

17
blk/264
View File

@ -1,14 +1,3 @@
The "X:" word : XAGAIN LIT< (br) XFIND , H@ - C, ;
: XUNTIL LIT< (?br) XFIND , H@ - C, ;
Because the ";" word goes back only one level in RSP and : XLIT< LIT< (s) XFIND , WORD DUP C@ 1+ MOVE, ;
this limits our ability to separate X: in sub words and this
means a rather cramped B265. This means no inline comments,
hence this block here.
0x0e is compiledWord. first _find is on xdict. If found, we
compile it with offsets. We abort on IMMED? because we're
never supposed to encounter an immediate at this point.
If not found, we try the same word on system dict (RAM+02).
If found and is immediate, execute. If found and not immediate,
error. If not found, try number.

View File

@ -2,6 +2,10 @@
: ['] X['] ; IMMEDIATE : ['] X['] ; IMMEDIATE
: COMPILE XCOMPILE ; IMMEDIATE : COMPILE XCOMPILE ; IMMEDIATE
: [COMPILE] X[COMPILE] ; IMMEDIATE : [COMPILE] X[COMPILE] ; IMMEDIATE
: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE
: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE
: LIT< XLIT< ; IMMEDIATE
: IMMEDIATE XIMM ; : IMMEDIATE XIMM ;
: (entry) (xentry) ; : (entry) (xentry) ;
: CREATE XCREATE ; : CREATE XCREATE ;

View File

@ -6,8 +6,6 @@ NOP, NOP, ( 06, uflw ) NOP, NOP, ( 08, LATEST ) NOP, ( unused )
NOP, NOP, NOP, NOP, NOP, ( unused ) NOP, NOP, NOP, NOP, NOP, ( unused )
0 JP, ( 1a, next ) NOP, NOP, NOP, ( unused ) 0 JP, ( 1a, next ) NOP, NOP, NOP, ( unused )
0 JP, ( RST 20 ) 0 A, 0 JP, ( 23, (n) ) NOP, ( unused ) 0 JP, ( RST 20 ) 0 A, 0 JP, ( 23, (n) ) NOP, ( unused )
0 JP, ( RST 28 ) 0 A, 0 JP, ( 2b, (s) ) NOP, ( unused ) 0 JP, ( RST 28 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused )
0 JP, ( RST 30 ) 0 A, 0 JP, ( 33, 2>R ) NOP, ( unused ) 0 JP, ( RST 30 ) 0 A, 0 A, 0 A, 0 A, 0 A, ( unused )
0 JP, ( RST 38 ) 0 JP, ( RST 38 )
0 A, 0 JP, ( 3b, (br) ) 0 A, 0 JP, ( 3f, (?br) )
0 A, 0 JP, ( 43, (loop) )

View File

@ -1,12 +1,10 @@
CODE (br) CODE (br)
L1 BSET ( used in ?br and loop ) L1 BSET ( used in ?br and loop )
PC ORG @ 0x3d + ! ( stable ABI JP )
LDA(BC), H 0 LDri, L A LDrr, LDA(BC), H 0 LDri, L A LDrr,
RLA, IFC, H DECr, THEN, RLA, IFC, H DECr, THEN,
BC ADDHLd, B H LDrr, C L LDrr, BC ADDHLd, B H LDrr, C L LDrr,
;CODE ;CODE
CODE (?br) CODE (?br)
PC ORG @ 0x41 + ! ( stable ABI JP )
HL POP, HL POP,
HLZ, HLZ,
JRZ, L1 BWR ( br + 1. False, branch ) JRZ, L1 BWR ( br + 1. False, branch )

View File

@ -1,5 +1,4 @@
CODE (loop) CODE (loop)
PC ORG @ 0x45 + ! ( stable ABI JP )
0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ ) 0 IX+ INC(IXY+), IFZ, 1 IX+ INC(IXY+), THEN, ( I++ )
( Jump if I <> I' ) ( Jump if I <> I' )
A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch ) A 0 IX+ LDrIXY, 2 IX- CP(IXY+), JRNZ, L1 BWR ( branch )

View File

@ -1,5 +1,4 @@
CODE (s) ( string literal ) CODE (s) ( string literal )
PC ORG @ 0x2d + ! ( stable ABI JP )
( Like (n) but instead of being followed by a 2 bytes ( Like (n) but instead of being followed by a 2 bytes
number, it's followed by a string. When called, puts the number, it's followed by a string. When called, puts the
string's address on PS ) string's address on PS )

View File

@ -1,7 +1,7 @@
CODE R> CODE R>
L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, HL PUSH, L 0 IX+ LDrIXY, H 1 IX+ LDrIXY, IX DECd, IX DECd, HL PUSH,
;CODE ;CODE
CODE 2>R PC ORG @ 0x35 + ! ( stable ABI JP ) CODE 2>R
DE POP, HL POP, chkPS, DE POP, HL POP, chkPS,
IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr, IX INCd, IX INCd, 0 IX+ L LDIXYr, 1 IX+ H LDIXYr,
IX INCd, IX INCd, 0 IX+ E LDIXYr, 1 IX+ D LDIXYr, IX INCd, IX INCd, 0 IX+ E LDIXYr, 1 IX+ D LDIXYr,

View File

@ -1,7 +1,7 @@
( Now we have "as late as possible" stuff. See bootstrap doc. ) ( Now we have "as late as possible" stuff. See bootstrap doc. )
: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ; : _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
: DO 0x33 ( 2>R ) , H@ ; IMMEDIATE : DO COMPILE 2>R H@ ; IMMEDIATE
: LOOP 0x43 ( loop ) , H@ - _bchk C, ; IMMEDIATE : LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
( LEAVE is implemented in low xcomp ) ( LEAVE is implemented in low xcomp )
: LITN 0x23 ( n ) , , ; : LITN 0x23 ( n ) , , ;
( gets its name at the very end. can't comment afterwards ) ( gets its name at the very end. can't comment afterwards )

View File

@ -1,11 +1,11 @@
: IF ( -- a | a: br cell addr ) : IF ( -- a | a: br cell addr )
0x3f ( ?br ) , H@ 1 ALLOT ( br cell allot ) COMPILE (?br) H@ 1 ALLOT ( br cell allot )
; IMMEDIATE ; IMMEDIATE
: THEN ( a -- | a: br cell addr ) : THEN ( a -- | a: br cell addr )
DUP H@ -^ _bchk SWAP ( a-H a ) C! DUP H@ -^ _bchk SWAP ( a-H a ) C!
; IMMEDIATE ; IMMEDIATE
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) : ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
0x3b ( br ) , COMPILE (br)
1 ALLOT 1 ALLOT
[COMPILE] THEN [COMPILE] THEN
H@ 1- ( push a. 1- for allot offset ) H@ 1- ( push a. 1- for allot offset )

View File

@ -1,7 +1,7 @@
: LIT< 0x2b ( s ) , WORD DUP C@ 1+ MOVE, ; IMMEDIATE : LIT< COMPILE (s) WORD DUP C@ 1+ MOVE, ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE : BEGIN H@ ; IMMEDIATE
: AGAIN 0x3b ( br ) , H@ - _bchk C, ; IMMEDIATE : AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
: UNTIL 0x3f ( ?br ) , H@ - _bchk C, ; IMMEDIATE : UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE
: [ INTERPRET ; IMMEDIATE : [ INTERPRET ; IMMEDIATE
: ] R> DROP ; : ] R> DROP ;
: COMPILE ' LITN ['] , , ; IMMEDIATE : COMPILE ' LITN ['] , , ; IMMEDIATE

View File

@ -8,9 +8,3 @@ JMPn, 0 A,, ( 0b, EXIT )
0 A,, 0 A,, 0 A, ( unused ) 0 A,, 0 A,, 0 A, ( unused )
JMPn, 0 A,, ( 1a, next ) 0 A,, 0 A,, 0 A,, ( unused ) JMPn, 0 A,, ( 1a, next ) 0 A,, 0 A,, 0 A,, ( unused )
0 A, JMPn, 0 A,, ( 23, (n) ) 0 A, JMPn, 0 A,, ( 23, (n) )
0 A,, 0 A,, ( unused )
0 A, JMPn, 0 A,, ( 2b, (s) ) 0 A, ( unused )
0 A, 0 A,, ( unused )
0 A, JMPn, 0 A,, ( 33, 2>R ) 0 A, 0 A, 0 A,, ( unused )
0 A, JMPn, 0 A,, ( 3b, (br) ) 0 A, JMPn, 0 A,, ( 3f, (?br) )
0 A, JMPn, 0 A,, ( 43, (loop) )

View File

@ -1,12 +1,10 @@
( TODO: move these words with other native words. ) ( TODO: move these words with other native words. )
H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
CODE (br) L1 BSET ( used in ?br ) CODE (br) L1 BSET ( used in ?br )
PC 0x3f - ORG @ 0x3d + ! ( stable abi )
DI DX MOVxx, AL [DI] MOVr[], AH AH XORrr, CBW, DI DX MOVxx, AL [DI] MOVr[], AH AH XORrr, CBW,
DX AX ADDxx, DX AX ADDxx,
;CODE ;CODE
CODE (?br) CODE (?br)
PC 0x43 - ORG @ 0x41 + ! ( stable abi )
AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch ) AX POPx, AX AX ORxx, JZ, L1 @ RPCs, ( False, branch )
( True, skip next byte and don't branch ) ( True, skip next byte and don't branch )
DX INCx, DX INCx,

View File

@ -1,5 +1,4 @@
CODE (loop) CODE (loop)
PC 0x47 - ORG @ 0x45 + ! ( stable abi )
[BP] 0 INC[w]+, ( I++ ) [BP] 0 INC[w]+, ( I++ )
( Jump if I <> I' ) ( Jump if I <> I' )
AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+, AX [BP] 0 MOVx[]+, AX [BP] -2 CMPx[]+,

View File

@ -4,7 +4,6 @@ PC 0x27 - ORG @ 0x25 + ! ( stable abi )
DX INCx, DX INCx, DX INCx, DX INCx,
;CODE ;CODE
CODE (s) ( string literal, see B287 ) CODE (s) ( string literal, see B287 )
PC 0x2f - ORG @ 0x2d + ! ( stable abi )
DI DX MOVxx, ( IP ) DI DX MOVxx, ( IP )
AH AH XORrr, AL [DI] MOVr[], ( slen ) AH AH XORrr, AL [DI] MOVr[], ( slen )
DX PUSHx, DX INCx, DX AX ADDxx, DX PUSHx, DX INCx, DX AX ADDxx,

View File

@ -5,7 +5,6 @@ CODE R>
[BP] 0 PUSH[w]+, BP DECx, BP DECx, [BP] 0 PUSH[w]+, BP DECx, BP DECx,
;CODE ;CODE
CODE 2>R CODE 2>R
PC 0x37 - ORG @ 0x35 + ! ( stable abi )
[BP] 4 POP[w]+, [BP] 2 POP[w]+, BP 4 ADDxi, [BP] 4 POP[w]+, [BP] 2 POP[w]+, BP 4 ADDxi,
;CODE ;CODE
CODE 2R> 2 chkPS, CODE 2R> 2 chkPS,

Binary file not shown.

View File

@ -15,16 +15,6 @@ H@ ORG !
0 C, 0 C, ( EXIT ) 0 C, 0 C, ( EXIT )
0x16 ALLOT0 0x16 ALLOT0
0 C, 0x05 C, ( (n) ) 0 C, 0x05 C, ( (n) )
0x6 ALLOT0
0 C, 0x06 C, ( (s) )
0x6 ALLOT0
0 C, 0x04 C, ( 2>R )
0x6 ALLOT0
0 C, 0x01 C, ( (br) )
0x2 ALLOT0
0 C, 0x02 C, ( (?br) )
0x2 ALLOT0
0 C, 0x03 C, ( (loop) )
( END OF STABLE ABI ) ( END OF STABLE ABI )
H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
0x00 CODE EXIT 0x00 CODE EXIT

View File

@ -195,9 +195,7 @@ otherwise be difficult to access. Here's the complete list of
these references: these references:
04 BOOT addr 06 (uflw) addr 08 LATEST 04 BOOT addr 06 (uflw) addr 08 LATEST
13 (oflw) addr 2b (s) wordref 33 2>R wordref 0b EXIT wordref 13 (oflw) addr 23 (n) wordref
42 EXIT wordref 53 (br) wordref 67 (?br) wordref
80 (loop) wordref bf (n) wordref
BOOT, (uflw) and (oflw) exist because they are referred to BOOT, (uflw) and (oflw) exist because they are referred to
before those words are defined (in core words). LATEST is a before those words are defined (in core words). LATEST is a
@ -205,9 +203,9 @@ critical part of the initialization sequence.
Stable wordrefs are there for more complicated reasons. When Stable wordrefs are there for more complicated reasons. When
cross-compiling Collapse OS, we use immediate words from the cross-compiling Collapse OS, we use immediate words from the
host and some of them compile wordrefs (IF compiles (?br), host and some of them compile wordrefs (LITN compiles (n),
LOOP compiles (loop), etc.). These compiled wordref need to ";" compiles EXIT). These compiled wordref need to be stable
be stable across binaries, so they're part of the stable ABI. across binaries, so they're part of the stable ABI.
Another layer of complexity is the fact that some binaries Another layer of complexity is the fact that some binaries
don't begin at offset 0. In that case, the stable ABI doesn't don't begin at offset 0. In that case, the stable ABI doesn't