Add alias and switch word types

I'm pretty happy about how lightweight the implementation turns
out to be.

blk/263

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

blk/270

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

blk/287

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

blk/289

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

blk/355

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

blk/380

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

blk/381

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

blk/394

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

blk/396

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

blk/397

@@ -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 ;
+: :* ( 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 ;

blk/398

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

blk/399

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

blk/400

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

blk/449

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

cvm/avra.sh

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

cvm/vm.c

@@ -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) {
+        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) {
     byte len = vm.mem[waddr];
     while (1) {

cvm/zasm.sh

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

doc/asm.txt

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

doc/dict.txt

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

doc/impl.txt

@@ -82,8 +82,8 @@ below.
 
 # 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.
 
 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

doc/usage.txt

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