I'm pretty happy about how lightweight the implementation turns out to be.master
@@ -1,6 +1,7 @@ | |||||
CREATE XCURRENT 0 , | CREATE XCURRENT 0 , | ||||
: XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ; | : XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ; | ||||
: (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ; | : (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ; | ||||
: X:** (xentry) 5 C, , ; | |||||
: XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ; | : 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 ; | ||||
@@ -7,8 +7,7 @@ | |||||
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE | : AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE | ||||
: LIT" XLIT" ; IMMEDIATE : LITN XLITN ; | : LIT" XLIT" ; IMMEDIATE : LITN XLITN ; | ||||
: IMMEDIATE XIMM ; | : IMMEDIATE XIMM ; | ||||
: (entry) (xentry) ; | |||||
: CREATE XCREATE ; | |||||
: (entry) (xentry) ; : CREATE XCREATE ; : :** X:** ; | |||||
: : [ ' X: , ] ; | : : [ ' X: , ] ; | ||||
CURRENT @ XCURRENT ! | CURRENT @ XCURRENT ! |
@@ -3,6 +3,9 @@ lblexec BSET L1 FSET ( B284 ) L2 FSET ( B286 ) | |||||
LDA(DE), DE INCd, EXDEHL, ( HL points to PFA ) | LDA(DE), DE INCd, EXDEHL, ( HL points to PFA ) | ||||
A ORr, IFZ, JP(HL), THEN, | A ORr, IFZ, JP(HL), THEN, | ||||
A DECr, ( compiled? ) IFNZ, ( no ) | A DECr, ( compiled? ) IFNZ, ( no ) | ||||
3 CPi, IFZ, ( alias ) LDDE(HL), JR, lblexec BWR THEN, | |||||
IFNC, ( switch ) | |||||
LDDE(HL), EXDEHL, LDDE(HL), JR, lblexec BWR THEN, | |||||
( cell or does. push PFA ) HL PUSH, | ( cell or does. push PFA ) HL PUSH, | ||||
A DECr, JRZ, lblnext BWR ( cell ) | A DECr, JRZ, lblnext BWR ( cell ) | ||||
HL INCd, HL INCd, LDDE(HL), EXDEHL, ( does ) | HL INCd, HL INCd, LDDE(HL), EXDEHL, ( does ) | ||||
@@ -1,4 +1,5 @@ | |||||
( 1. Push current IP to RS | |||||
( compiled word | |||||
1. Push current IP to RS | |||||
2. Set new IP to the second atom of the list | 2. Set new IP to the second atom of the list | ||||
3. Execute the first atom of the list. ) | 3. Execute the first atom of the list. ) | ||||
IX INCd, IX INCd, | IX INCd, IX INCd, | ||||
@@ -1,4 +1,6 @@ | |||||
: +! TUCK @ + SWAP ! ; | : +! TUCK @ + SWAP ! ; | ||||
: *! ( addr alias -- ) 1+ ! ; | |||||
: **! ( addr switch -- ) 1+ @ ! ; | |||||
: / /MOD NIP ; | : / /MOD NIP ; | ||||
: MOD /MOD DROP ; | : MOD /MOD DROP ; | ||||
: ALLOT HERE +! ; | : ALLOT HERE +! ; | ||||
@@ -1 +1 @@ | |||||
1 19 LOADR+ ( xcomp core high ) | |||||
1 20 LOADR+ ( xcomp core high ) |
@@ -4,7 +4,7 @@ | |||||
: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; | : (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ; | ||||
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ; | : BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ; | ||||
: CRLF CR LF ; : SPC 32 EMIT ; | : CRLF CR LF ; : SPC 32 EMIT ; | ||||
: NL 0x0a RAM+ @ ( NLPTR ) EXECUTE ; | |||||
0x0a RAM+ :** NL | |||||
: (uflw) LIT" stack underflow" ERR ; | : (uflw) LIT" stack underflow" ERR ; | ||||
XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + ! | XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + ! | ||||
: (oflw) LIT" stack overflow" ERR ; | : (oflw) LIT" stack overflow" ERR ; | ||||
@@ -3,8 +3,9 @@ | |||||
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; | : LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; | ||||
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; | : LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; | ||||
( Now, adev stuff ) | ( Now, adev stuff ) | ||||
: A@* 0x3e RAM+ ; : A@ A@* @ EXECUTE ; | |||||
: A!* 0x40 RAM+ ; : A! A!* @ EXECUTE ; | |||||
0x3e RAM+ :** A@ | |||||
0x40 RAM+ :** A! | |||||
( src dst u -- ) | ( src dst u -- ) | ||||
: AMOVE | : AMOVE | ||||
( u ) 0 DO | ( u ) 0 DO | ||||
@@ -5,10 +5,10 @@ | |||||
0 0x08 RAM+ ! ( 08 == C<* override ) | 0 0x08 RAM+ ! ( 08 == C<* override ) | ||||
0 0x53 RAM+ ! ( 53 == (emit) override ) | 0 0x53 RAM+ ! ( 53 == (emit) override ) | ||||
0 0x55 RAM+ ! ( 55 == (key) override ) | 0 0x55 RAM+ ! ( 55 == (key) override ) | ||||
['] CRLF 0x0a RAM+ ! ( NLPTR ) | |||||
['] CRLF ['] NL **! | |||||
( 0c == C<* ) | ( 0c == C<* ) | ||||
['] (boot<) 0x0c RAM+ ! | ['] (boot<) 0x0c RAM+ ! | ||||
['] C@ A@* ! ['] C! A!* ! | |||||
['] C@ ['] A@ ! ['] C! ['] A! **! | |||||
( boot< always has a char waiting. 06 == C<?* ) | ( boot< always has a char waiting. 06 == C<?* ) | ||||
1 0x06 RAM+ ! INTERPRET | 1 0x06 RAM+ ! INTERPRET | ||||
RDLN$ LIT" _sys" [entry] | RDLN$ LIT" _sys" [entry] | ||||
@@ -1,15 +1,4 @@ | |||||
( 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 ; | |||||
: DO COMPILE 2>R H@ ; IMMEDIATE | |||||
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE | |||||
( LEAVE is implemented in low xcomp ) | |||||
: LITN COMPILE (n) , ; | |||||
( gets its name at the very end. can't comment afterwards ) | |||||
: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE | |||||
: _ ( : will get its name almost at the very end ) | |||||
(entry) 1 ( compiled ) C, | |||||
BEGIN | |||||
WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN | |||||
FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN | |||||
ELSE ( maybe number ) (parse) LITN THEN | |||||
AGAIN ; | |||||
: :* ( addr -- ) (entry) 4 ( alias ) C, , ; | |||||
: :** ( addr -- ) (entry) 5 ( switch ) C, , ; | |||||
@@ -1,16 +1,14 @@ | |||||
: IF ( -- a | a: br cell addr ) | |||||
COMPILE (?br) H@ 1 ALLOT ( br cell allot ) | |||||
; IMMEDIATE | |||||
: THEN ( a -- | a: br cell addr ) | |||||
DUP H@ -^ _bchk SWAP ( a-H a ) C! | |||||
; IMMEDIATE | |||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) | |||||
COMPILE (br) | |||||
1 ALLOT | |||||
[COMPILE] THEN | |||||
H@ 1- ( push a. 1- for allot offset ) | |||||
; IMMEDIATE | |||||
: LIT" | |||||
COMPILE (s) H@ 0 C, ," | |||||
DUP H@ -^ 1- ( a len ) SWAP C! | |||||
; IMMEDIATE | |||||
: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ; | |||||
: DO COMPILE 2>R H@ ; IMMEDIATE | |||||
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE | |||||
( LEAVE is implemented in low xcomp ) | |||||
: LITN COMPILE (n) , ; | |||||
( gets its name at the very end. can't comment afterwards ) | |||||
: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE | |||||
: _ ( : will get its name almost at the very end ) | |||||
(entry) 1 ( compiled ) C, | |||||
BEGIN | |||||
WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN | |||||
FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN | |||||
ELSE ( maybe number ) (parse) LITN THEN | |||||
AGAIN ; |
@@ -1,13 +1,16 @@ | |||||
( We don't use ." and ABORT in core, they're not xcomp-ed ) | |||||
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE | |||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE | |||||
: BEGIN H@ ; IMMEDIATE | |||||
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE | |||||
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE | |||||
: [ INTERPRET ; IMMEDIATE | |||||
: ] R> DROP ; | |||||
: COMPILE ' LITN ['] , , ; IMMEDIATE | |||||
: [COMPILE] ' , ; IMMEDIATE | |||||
: ['] ' LITN ; IMMEDIATE | |||||
':' X' _ 4 - C! ( give : its name ) | |||||
'(' X' _ 4 - C! | |||||
: IF ( -- a | a: br cell addr ) | |||||
COMPILE (?br) H@ 1 ALLOT ( br cell allot ) | |||||
; IMMEDIATE | |||||
: THEN ( a -- | a: br cell addr ) | |||||
DUP H@ -^ _bchk SWAP ( a-H a ) C! | |||||
; IMMEDIATE | |||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) | |||||
COMPILE (br) | |||||
1 ALLOT | |||||
[COMPILE] THEN | |||||
H@ 1- ( push a. 1- for allot offset ) | |||||
; IMMEDIATE | |||||
: LIT" | |||||
COMPILE (s) H@ 0 C, ," | |||||
DUP H@ -^ 1- ( a len ) SWAP C! | |||||
; IMMEDIATE |
@@ -0,0 +1,13 @@ | |||||
( We don't use ." and ABORT in core, they're not xcomp-ed ) | |||||
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE | |||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE | |||||
: BEGIN H@ ; IMMEDIATE | |||||
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE | |||||
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE | |||||
: [ INTERPRET ; IMMEDIATE | |||||
: ] R> DROP ; | |||||
: COMPILE ' LITN ['] , , ; IMMEDIATE | |||||
: [COMPILE] ' , ; IMMEDIATE | |||||
: ['] ' LITN ; IMMEDIATE | |||||
':' X' _ 4 - C! ( give : its name ) | |||||
'(' X' _ 4 - C! |
@@ -1,14 +1,15 @@ | |||||
lblexec BSET ( DI -> wordref ) | lblexec BSET ( DI -> wordref ) | ||||
AL [DI] MOVr[], DI INCx, ( PFA ) | AL [DI] MOVr[], DI INCx, ( PFA ) | ||||
AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) | AL AL ORrr, IFZ, DI JMPr, THEN, ( native ) | ||||
AL DECr, IFNZ, ( cell or does ) | |||||
DI PUSHx, ( push PFA ) | |||||
AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN, | |||||
( does, see B302 ) | |||||
DI INCx, DI INCx, DI [DI] MOVx[], | |||||
AL DECr, IFNZ, ( not compiled ) | |||||
AL DECr, IFZ, ( cell ) | |||||
DI PUSHx, JMPs, lblnext @ RPCs, THEN, | |||||
AL DECr, IFZ, ( does ) | |||||
DI PUSHx, DI INCx, DI INCx, DI [DI] MOVx[], THEN, | |||||
( alias or switch ) DI [DI] MOVx[], | |||||
AL DECr, IFNZ, ( switch ) DI [DI] MOVx[], THEN, | |||||
JMPs, lblexec @ RPCs, | |||||
THEN, ( continue to compiled ) | THEN, ( continue to compiled ) | ||||
( compiled ) | |||||
BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) | BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS ) | ||||
DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) | DX DI MOVxx, DX INCx, DX INCx, ( --> IP ) | ||||
DI [DI] MOVx[], | |||||
JMPs, lblexec @ RPCs, | |||||
DI [DI] MOVx[], JMPs, lblexec @ RPCs, |
@@ -1,2 +1,2 @@ | |||||
#!/bin/sh | #!/bin/sh | ||||
echo -e "660 LOAD H@ ORG !\n$(cat -)\nORG @ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC! " | ./stage | |||||
echo -e "50 LOAD H@ ORG !\n$(cat -)\nORG @ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC! " | ./stage |
@@ -109,19 +109,36 @@ static void pushRS(word val) { | |||||
// dictionary (doc/dict.txt) | // dictionary (doc/dict.txt) | ||||
static void execute(word wordref) { | static void execute(word wordref) { | ||||
byte wtype = vm.mem[wordref]; | byte wtype = vm.mem[wordref]; | ||||
if (wtype == 0) { // native | |||||
switch (wtype) { | |||||
case 0: // native | |||||
vm.nativew[vm.mem[wordref+1]](); | vm.nativew[vm.mem[wordref+1]](); | ||||
} else if (wtype == 1) { // compiled | |||||
break; | |||||
case 1: // compiled | |||||
pushRS(vm.IP); | pushRS(vm.IP); | ||||
vm.IP = wordref+1; | vm.IP = wordref+1; | ||||
} else { // cell or does | |||||
break; | |||||
case 2: // cell | |||||
push(wordref+1); | push(wordref+1); | ||||
if (wtype == 3) { | |||||
pushRS(vm.IP); | |||||
vm.IP = gw(wordref+3); | |||||
} | |||||
break; | |||||
case 3: // does | |||||
push(wordref+1); | |||||
pushRS(vm.IP); | |||||
vm.IP = gw(wordref+3); | |||||
break; | |||||
case 4: // alias | |||||
execute(gw(wordref+1)); | |||||
break; | |||||
case 5: // switch | |||||
execute(gw(gw(wordref+1))); | |||||
break; | |||||
} | } | ||||
} | } | ||||
static word find(word daddr, word waddr) { | static word find(word daddr, word waddr) { | ||||
byte len = vm.mem[waddr]; | byte len = vm.mem[waddr]; | ||||
while (1) { | while (1) { | ||||
@@ -1,2 +1,2 @@ | |||||
#!/bin/sh | #!/bin/sh | ||||
echo -e "212 LOAD\nH@ 256 /MOD 2 PC! 2 PC!\n$(cat -)\nH@ 256 /MOD 2 PC! 2 PC! " | ./stage | |||||
echo -e "5 LOAD\nH@ 256 /MOD 2 PC! 2 PC!\n$(cat -)\nH@ 256 /MOD 2 PC! 2 PC! " | ./stage |
@@ -139,6 +139,11 @@ CALL RST DJNZ | |||||
DI EI EXDEHL EXX HALT | DI EI EXDEHL EXX HALT | ||||
NOP RET [,c] RETI RETN SCF | NOP RET [,c] RETI RETN SCF | ||||
Macros: | |||||
SUBHLd PUSH [0,1,Z,A] HLZ DEZ | |||||
LDDE(HL) OUT [HL,DE] | |||||
# 8086 assembler | # 8086 assembler | ||||
Load with "30 LOAD". As with the Z80 assembler, it is incom- | Load with "30 LOAD". As with the Z80 assembler, it is incom- | ||||
@@ -64,6 +64,8 @@ WORD( a -- a Get wordref's beginning addr. | |||||
# Defining words | # Defining words | ||||
: x ... ; -- Define a new word | : x ... ; -- Define a new word | ||||
:* x a -- Define a new alias | |||||
:** x a -- Define a new switch | |||||
CREATE x -- Create cell named x. Doesn't allocate a PF. | CREATE x -- Create cell named x. Doesn't allocate a PF. | ||||
[COMPILE] x -- *I* Compile word x and write it to HERE. | [COMPILE] x -- *I* Compile word x and write it to HERE. | ||||
IMMEDIATE words are *not* executed. | IMMEDIATE words are *not* executed. | ||||
@@ -157,6 +159,8 @@ C@- a -- a-1 c Fetch c from a and dec a. | |||||
C! c a -- Store byte c in address a | C! c a -- Store byte c in address a | ||||
C!+ c a -- a+1 Store byte c in a and inc a. | C!+ c a -- a+1 Store byte c in a and inc a. | ||||
C!- c a -- a-1 Store byte c in a and dec a. | C!- c a -- a-1 Store byte c in a and dec a. | ||||
*! a al -- Change alias al's addr to a. | |||||
**! a sw -- Change switch sw's addr to a. | |||||
CURRENT -- a Set a to wordref of last added entry. | CURRENT -- a Set a to wordref of last added entry. | ||||
CURRENT* -- a A pointer to active CURRENT*. Useful | CURRENT* -- a A pointer to active CURRENT*. Useful | ||||
when we have multiple active dicts. | when we have multiple active dicts. | ||||
@@ -82,8 +82,8 @@ below. | |||||
# Word types | # Word types | ||||
There are 4 word types in Collapse OS. Whenever you have a | |||||
wordref, it's pointing to a byte with numbers 0 to 3. This | |||||
There are 6 word types in Collapse OS. Whenever you have a | |||||
wordref, it's pointing to a byte with numbers 0 to 5. This | |||||
number is the word type and the word's behavior depends on it. | number is the word type and the word's behavior depends on it. | ||||
0: native. This words PFA contains native binary code and is | 0: native. This words PFA contains native binary code and is | ||||
@@ -102,6 +102,11 @@ compiled word. Upon execution, after having pushed its cell | |||||
addr to PSP, it executes its reference exactly like a | addr to PSP, it executes its reference exactly like a | ||||
compiled word. | compiled word. | ||||
4: alias. See usage.txt. PFA is like a cell, but instead of | |||||
pushing it to PS, we execute it. | |||||
5: switch. Same as alias, but with an added indirection. | |||||
# System variables | # System variables | ||||
There are some core variables in the core system that are | There are some core variables in the core system that are | ||||
@@ -52,12 +52,44 @@ Interpreter output is unbuffered and only has EMIT. This | |||||
word can also be overriden, mostly as a companion to the | word can also be overriden, mostly as a companion to the | ||||
raison d'etre of your KEY override. | raison d'etre of your KEY override. | ||||
# Aliases and Switches | |||||
A common pattern in Forth is to add an indirection layer with | |||||
a pointer word. For example, if you have a word "FOO" for | |||||
which you would like to add an indirection layer, you would | |||||
rename "FOO" to "_FOO", add a variable "FOO*" pointing to | |||||
"_FOO" and re-defining "FOO" as ": FOO FOO* @ EXECUTE". | |||||
This is all well and good, but it is resource intensive and | |||||
verbose, which make us want to avoid this pattern for words | |||||
that are often used. | |||||
For this purpose, Collapse OS has two special word types: | |||||
alias and switches. | |||||
An alias is a variable that contains a pointer to another word. | |||||
When invoked, we invoke the specified pointer with minimal over- | |||||
head. Using our FOO example above, we would create an alias | |||||
with "' _FOO :* FOO". Invoking FOO will then invoke "_FOO". You | |||||
can change the alias' pointer with "*!" like this: | |||||
"' BAR ' FOO *!". FOO now invokes BAR. | |||||
A switch is like an alias, but with a second level of indi- | |||||
rection. The variable points to a cell pointing to our word. | |||||
It works like an alias, except you have to use ":**" and "**!". | |||||
Switches are used by core code which point to hardcoded | |||||
addresses in RAM (because the core code is designed to run from | |||||
ROM, we can't have regular variables). You are unlikely to | |||||
need switches in regular code. | |||||
# Addressed devices | # Addressed devices | ||||
A@ and A! are the indirect versions of C@ and C!. Their target | |||||
word is controlled through A@* and A!* and by default point to | |||||
C@ and C*. There is also a AMOVE word that is the same as MOVE | |||||
but using A@ and A!. | |||||
A@ and A! are the indirect versions of C@ and C!. They are | |||||
aliases and initially point to C@ and C!. There is also a AMOVE | |||||
word that is the same as MOVE but using A@ and A!. | |||||
Addressed device words can be useful to "pipe" processing to | |||||
places outside of regular memory. | |||||
# Disk blocks | # Disk blocks | ||||