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:
parent
3295f1689e
commit
eefbf66e95
20
blk/263
20
blk/263
@ -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
17
blk/264
@ -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.
|
|
||||||
|
4
blk/270
4
blk/270
@ -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 ;
|
||||||
|
6
blk/283
6
blk/283
@ -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) )
|
|
||||||
|
2
blk/297
2
blk/297
@ -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 )
|
||||||
|
1
blk/298
1
blk/298
@ -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 )
|
||||||
|
1
blk/307
1
blk/307
@ -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 )
|
||||||
|
2
blk/326
2
blk/326
@ -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,
|
||||||
|
4
blk/397
4
blk/397
@ -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 )
|
||||||
|
4
blk/398
4
blk/398
@ -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 )
|
||||||
|
6
blk/399
6
blk/399
@ -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
|
||||||
|
6
blk/805
6
blk/805
@ -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) )
|
|
||||||
|
2
blk/806
2
blk/806
@ -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,
|
||||||
|
1
blk/807
1
blk/807
@ -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[]+,
|
||||||
|
1
blk/812
1
blk/812
@ -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,
|
||||||
|
1
blk/813
1
blk/813
@ -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,
|
||||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
10
cvm/xcomp.fs
10
cvm/xcomp.fs
@ -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
|
||||||
|
10
doc/impl.txt
10
doc/impl.txt
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user