opensourcemirror
/
collapseos
mirror of https://git.sr.ht/~vdupras/collapseos
1
0
Fork 0
Code Issues Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
blk/263
View File

@ -1,6 +1,7 @@
CREATE XCURRENT 0 ,
: XCON XCURRENT CURRENT* ! ; : XCOFF 0x02 RAM+ CURRENT* ! ;
: (xentry) XCON (entry) XCOFF ; : XCREATE (xentry) 2 C, ;
: X:** (xentry) 5 C, , ;
: XCODE XCON CODE XCOFF ; : XIMM XCON IMMEDIATE XCOFF ;
: _xapply ( a -- a-off )
DUP ORG @ > IF ORG @ - BIN( @ + THEN ;

3
blk/270
View File

@ -7,8 +7,7 @@
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE
: LIT" XLIT" ; IMMEDIATE : LITN XLITN ;
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ;
: (entry) (xentry) ; : CREATE XCREATE ; : :** X:** ;
: : [ ' X: , ] ;
CURRENT @ XCURRENT !

3
blk/287
View File

@ -3,6 +3,9 @@ lblexec BSET L1 FSET ( B284 ) L2 FSET ( B286 )
LDA(DE), DE INCd, EXDEHL, ( HL points to PFA )
A ORr, IFZ, JP(HL), THEN,
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,
A DECr, JRZ, lblnext BWR ( cell )
HL INCd, HL INCd, LDDE(HL), EXDEHL, ( does )

3
blk/289
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
3. Execute the first atom of the list. )
IX INCd, IX INCd,

2
blk/355
View File

@ -1,4 +1,6 @@
: +! TUCK @ + SWAP ! ;
: *! ( addr alias -- ) 1+ ! ;
: **! ( addr switch -- ) 1+ @ ! ;
: / /MOD NIP ;
: MOD /MOD DROP ;
: ALLOT HERE +! ;

2
blk/380
View File

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

2
blk/381
View File

@ -4,7 +4,7 @@
: (print) C@+ ( a len ) 0 DO C@+ EMIT LOOP DROP ;
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) EXECUTE ;
0x0a RAM+ :** NL
: (uflw) LIT" stack underflow" ERR ;
XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + !
: (oflw) LIT" stack overflow" ERR ;

5
blk/394
View File

@ -3,8 +3,9 @@
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
( Now, adev stuff )
: A@* 0x3e RAM+ ; : A@ A@* @ EXECUTE ;
: A!* 0x40 RAM+ ; : A! A!* @ EXECUTE ;
0x3e RAM+ :** A@
0x40 RAM+ :** A!
( src dst u -- )
: AMOVE
( u ) 0 DO

4
blk/396
View File

@ -5,10 +5,10 @@
0 0x08 RAM+ ! ( 08 == C<* override )
0 0x53 RAM+ ! ( 53 == (emit) override )
0 0x55 RAM+ ! ( 55 == (key) override )
['] CRLF 0x0a RAM+ ! ( NLPTR )
['] CRLF ['] NL **!
( 0c == C<* )
['] (boot<) 0x0c RAM+ !
['] C@ A@* ! ['] C! A!* !
['] C@ ['] A@ ! ['] C! ['] A! **!
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ ! INTERPRET
RDLN$ LIT" _sys" [entry]

17
blk/397
View File

@ -1,15 +1,4 @@
( 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, , ;

30
blk/398
View File

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

29
blk/399
View File

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

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 )
AL [DI] MOVr[], DI INCx, ( PFA )
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 )
( compiled )
BP INCx, BP INCx, [BP] 0 DX MOV[]+x, ( pushRS )
DX DI MOVxx, DX INCx, DX INCx, ( --> IP )
DI [DI] MOVx[],
JMPs, lblexec @ RPCs,
DI [DI] MOVx[], JMPs, lblexec @ RPCs,

2
cvm/avra.sh
View File

@ -1,2 +1,2 @@
#!/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

BIN
cvm/forth.bin
View File

Binary file not shown.

31
cvm/vm.c
View File

@ -109,19 +109,36 @@ static void pushRS(word val) {
// dictionary (doc/dict.txt)
static void execute(word wordref) {
byte wtype = vm.mem[wordref];
if (wtype == 0) { // native
switch (wtype) {
case 0: // native
vm.nativew[vm.mem[wordref+1]]();
} else if (wtype == 1) { // compiled
break;
case 1: // compiled
pushRS(vm.IP);
vm.IP = wordref+1;
} else { // cell or does
break;
case 2: // cell
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) {
byte len = vm.mem[waddr];
while (1) {

2
cvm/zasm.sh
View File

@ -1,2 +1,2 @@
#!/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

5
doc/asm.txt
View File

@ -139,6 +139,11 @@ CALL RST DJNZ
DI EI EXDEHL EXX HALT
NOP RET [,c] RETI RETN SCF
Macros:
SUBHLd PUSH [0,1,Z,A] HLZ DEZ
LDDE(HL) OUT [HL,DE]
# 8086 assembler
Load with "30 LOAD". As with the Z80 assembler, it is incom-

4
doc/dict.txt
View File

@ -64,6 +64,8 @@ WORD( a -- a Get wordref's beginning addr.
# Defining words
: 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.
[COMPILE] x -- *I* Compile word x and write it to HERE.
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 -- a+1 Store byte c in a and inc 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 A pointer to active CURRENT*. Useful
when we have multiple active dicts.

9
doc/impl.txt
View File

@ -82,8 +82,8 @@ below.
# 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.
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
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
There are some core variables in the core system that are

40
doc/usage.txt
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
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
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