1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-26 05:38:06 +11:00

Add alias and switch word types

I'm pretty happy about how lightweight the implementation turns
out to be.
This commit is contained in:
Virgil Dupras 2020-10-28 15:02:06 -04:00
parent a82db0739a
commit adea75e50a
22 changed files with 149 additions and 75 deletions

View File

@ -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 ;

View File

@ -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) ; : (entry) (xentry) ; : CREATE XCREATE ; : :** X:** ;
: CREATE XCREATE ;
: : [ ' X: , ] ; : : [ ' X: , ] ;
CURRENT @ XCURRENT ! CURRENT @ XCURRENT !

View File

@ -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 )

View File

@ -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,

View File

@ -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 +! ;

View File

@ -1 +1 @@
1 19 LOADR+ ( xcomp core high ) 1 20 LOADR+ ( xcomp core high )

View File

@ -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 ;

View File

@ -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 ; 0x3e RAM+ :** A@
: A!* 0x40 RAM+ ; : A! A!* @ EXECUTE ; 0x40 RAM+ :** A!
( src dst u -- ) ( src dst u -- )
: AMOVE : AMOVE
( u ) 0 DO ( u ) 0 DO

View File

@ -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]

17
blk/397
View File

@ -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 ; : :* ( addr -- ) (entry) 4 ( alias ) C, , ;
: DO COMPILE 2>R H@ ; IMMEDIATE : :** ( addr -- ) (entry) 5 ( switch ) C, , ;
: 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 ;

30
blk/398
View File

@ -1,16 +1,14 @@
: IF ( -- a | a: br cell addr ) : _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
COMPILE (?br) H@ 1 ALLOT ( br cell allot ) : DO COMPILE 2>R H@ ; IMMEDIATE
; IMMEDIATE : LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
: THEN ( a -- | a: br cell addr ) ( LEAVE is implemented in low xcomp )
DUP H@ -^ _bchk SWAP ( a-H a ) C! : LITN COMPILE (n) , ;
; IMMEDIATE ( gets its name at the very end. can't comment afterwards )
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell ) : _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
COMPILE (br) : _ ( : will get its name almost at the very end )
1 ALLOT (entry) 1 ( compiled ) C,
[COMPILE] THEN BEGIN
H@ 1- ( push a. 1- for allot offset ) WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
; IMMEDIATE FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
: LIT" ELSE ( maybe number ) (parse) LITN THEN
COMPILE (s) H@ 0 C, ," AGAIN ;
DUP H@ -^ 1- ( a len ) SWAP C!
; IMMEDIATE

29
blk/399
View File

@ -1,13 +1,16 @@
( We don't use ." and ABORT in core, they're not xcomp-ed ) : IF ( -- a | a: br cell addr )
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE COMPILE (?br) H@ 1 ALLOT ( br cell allot )
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE : THEN ( a -- | a: br cell addr )
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE DUP H@ -^ _bchk SWAP ( a-H a ) C!
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE ; IMMEDIATE
: [ INTERPRET ; IMMEDIATE : ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
: ] R> DROP ; COMPILE (br)
: COMPILE ' LITN ['] , , ; IMMEDIATE 1 ALLOT
: [COMPILE] ' , ; IMMEDIATE [COMPILE] THEN
: ['] ' LITN ; IMMEDIATE H@ 1- ( push a. 1- for allot offset )
':' X' _ 4 - C! ( give : its name ) ; IMMEDIATE
'(' X' _ 4 - C! : LIT"
COMPILE (s) H@ 0 C, ,"
DUP H@ -^ 1- ( a len ) SWAP C!
; IMMEDIATE

13
blk/400 Normal file
View File

@ -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!

17
blk/449
View File

@ -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 ) AL DECr, IFNZ, ( not compiled )
DI PUSHx, ( push PFA ) AL DECr, IFZ, ( cell )
AL DECr, IFZ, ( cell ) JMPs, lblnext @ RPCs, THEN, DI PUSHx, JMPs, lblnext @ RPCs, THEN,
( does, see B302 ) AL DECr, IFZ, ( does )
DI INCx, DI INCx, DI [DI] MOVx[], 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[], DI [DI] MOVx[], JMPs, lblexec @ RPCs,
JMPs, lblexec @ RPCs,

View File

@ -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

Binary file not shown.

View File

@ -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) { break;
pushRS(vm.IP);
vm.IP = gw(wordref+3); 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) {

View File

@ -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

View File

@ -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-

View File

@ -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.

View File

@ -82,8 +82,8 @@ below.
# Word types # Word types
There are 4 word types in Collapse OS. Whenever you have a There are 6 word types in Collapse OS. Whenever you have a
wordref, it's pointing to a byte with numbers 0 to 3. This 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

View File

@ -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 A@ and A! are the indirect versions of C@ and C!. They are
word is controlled through A@* and A!* and by default point to aliases and initially point to C@ and C!. There is also a AMOVE
C@ and C*. There is also a AMOVE word that is the same as MOVE word that is the same as MOVE but using A@ and A!.
but using A@ and A!.
Addressed device words can be useful to "pipe" processing to
places outside of regular memory.
# Disk blocks # Disk blocks