forth: consolidation

The commit ended up being much bigger than anticipated. This was a long thread
of underlying complexities. This lead to the creation of interesting concepts
such as (sysv).

emul/Makefile

@@ -7,7 +7,7 @@ AVRABIN = zasm/avra
 SHELLAPPS = zasm ed
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 # Those Forth source files are in a particular order
-FORTHSRCS = core.fs str.fs parse.fs fmt.fs
+FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o

forth/core.fs

@@ -1,23 +1,21 @@
 : H HERE @ ;
 : -^ SWAP - ;
-: +! SWAP OVER @ + SWAP ! ;
-: ALLOT HERE +! ;
-: C, H C! 1 ALLOT ;
 : COMPILE ' LITN ['] , , ; IMMEDIATE
+: [COMPILE] ' , ; IMMEDIATE
 : BEGIN H ; IMMEDIATE
 : AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
 : UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
-: NOT 1 SWAP SKIP? EXIT 0 * ;
+: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
-: ( BEGIN LITS ) WORD SCMP NOT UNTIL ; IMMEDIATE
 ( Hello, hello, krkrkrkr... do you hear me?
   Ah, voice at last! Some lines above need comments
   BTW: Forth lines limited to 64 cols because of default
   input buffer size in Collapse OS
 
-  COMPILE; Tough one. Get addr of caller word (example above
+  COMPILE: Tough one. Get addr of caller word (example above
-  (bbr)) and then call LITN on it.
+  (bbr)) and then call LITN on it. )
 
-  NOT: a bit convulted because we don't have IF yet )
+: +! SWAP OVER @ + SWAP ! ;
+: ALLOT HERE +! ;
 
 : IF                ( -- a | a: br cell addr )
     COMPILE SKIP?   ( if true, don't branch )
@@ -39,7 +37,6 @@
     H 1 -           ( push a. -1 for allot offset )
 ; IMMEDIATE
 
-: ? @ . ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
 : = CMP NOT ;
@@ -48,15 +45,16 @@
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
 
-( In addition to pushing H this compiles 2 >R so that loop variables are sent
+( In addition to pushing H this compiles 2 >R so that loop
-  to PS at runtime )
+  variables are sent to PS at runtime )
 : DO
     COMPILE SWAP COMPILE >R COMPILE >R
     H
 ; IMMEDIATE
 
-( One could think that we should have a sub word to avoid all these COMPILE,
+( One could think that we should have a sub word to avoid all
-  but we can't because otherwise it messes with the RS )
+  these COMPILE, but we can't because otherwise it messes with
+  the RS )
 : LOOP
     COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
     COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)

forth/dictionary.txt

@@ -32,7 +32,7 @@ directly, but as part of another word.
 "*I*" in description indicates an IMMEDIATE word.
 
 *** Defining words ***
-(find) x    -- a f          Read word x and find it in dict. If found, f=1 and
+(find)      a -- a f        Read at a and find it in dict. If found, f=1 and
                             a = wordref. If not found, f=0 and a = string addr.
 : x ...     --              Define a new word
 ;           R:I --          Exit a colon definition
@@ -44,7 +44,8 @@ directly, but as part of another word.
 ALLOT       n --            Move HERE by n bytes
 C,          b --            Write byte b in HERE and advance it.
 CREATE x    --              Create cell named x. Doesn't allocate a PF.
-[COMPILE] x --              Compile word x and write it to HERE
+[COMPILE] x --              Compile word x and write it to HERE. IMMEDIATE
+                            words are *not* executed.
 COMPILE x   --              Meta compiles. Kind of blows the mind. See below.
 CONSTANT x  n --            Creates cell x that when called pushes its value
 DOES>       --              See description at top of file
@@ -120,7 +121,7 @@ CURRENT     -- a            Set a to wordref of last added entry.
 HERE        -- a            Push HERE's address
 H           -- a            HERE @
 
-*** Arithmetic ***
+*** Arithmetic / Bits ***
 
 +           a b -- c        a + b -> c
 -           a b -- c        a - b -> c
@@ -129,6 +130,9 @@ H           -- a            HERE @
 /           a b -- c        a / b -> c
 MOD         a b -- c        a % b -> c
 /MOD        a b -- r q      r:remainder q:quotient
+AND         a b -- c        a & b -> c
+OR          a b -- c        a | b -> c
+XOR         a b -- c        a ^ b -> c
 
 *** Logic ***
 =           n1 n2 -- f      Push true if n1 == n2
@@ -139,8 +143,13 @@ CMP         n1 n2 -- n      Compare n1 and n2 and set n to -1, 0, or 1.
 NOT         f -- f          Push the logical opposite of f
 
 *** Strings ***
-LITS x      -- a            Read following LIT and push its addr to a
+LIT         --              Write a LIT entry. You're expected to write actual
+                            string to HERE right afterwards.
+LIT< x      --              Read following word and write to HERE as a string
+                            literal.
+LITS        a --            Write word at addr a as a atring literal.
 SCMP        a1 a2 -- n      Compare strings a1 and a2. See CMP
+SCPY        a --            Copy string at addr a into HERE.
 SLEN        a -- n          Push length of str at a.
 
 *** I/O ***
@@ -186,6 +195,7 @@ core.
 ." xxx"     --              *I* Compiles string literal xxx followed by a call
                             to (print)
                             are never considered negative. "-1 .X -> ffff"
+C<          -- c            Read one char from buffered input.
 EMIT        c --            Spit char c to output stream
 IN>         -- a            Address of variable containing current pos in input
                             buffer.
@@ -195,6 +205,8 @@ PC@         a -- c          Fetch c from port a
 WORD        -- a            Read one word from buffered input and push its addr
 
 There are also ascii const emitters:
+BS
+CR
 LF
 SPC
 

forth/fmt.fs

@@ -23,6 +23,8 @@
     AGAIN
 ;
 
+: ? @ . ;
+
 : PUSHDGTS
     999 SWAP        ( stop indicator )
     DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )

forth/readln.fs

@@ -0,0 +1,79 @@
+( requires core, parse )
+
+( Managing variables in a core module is tricky. Sure, we
+  have (sysv), but here we need to allocate a big buffer, and
+  that cannot be done through (sysv). What we do is that we
+  allocate that buffer at runtime and use (sysv) to point to
+  it, a pointer that is set during the initialization
+  routine. )
+
+64 CONSTANT INBUFSZ
+( points to INBUF )
+(sysv) IN(
+( points to INBUF's end )
+(sysv) IN)
+( current position in INBUF )
+(sysv) IN>
+
+( flush input buffer )
+( set IN> to IN( and set IN> @ to null )
+: (infl) 0 IN( @ DUP IN> ! ! ;
+
+( Initializes the readln subsystem )
+: (c<$)
+    HERE @ IN( !
+    INBUFSZ ALLOT
+    HERE @ IN) !
+    (infl)
+;
+
+( handle backspace: go back one char in IN>, if possible, then
+  emit SPC + BS )
+: (inbs)
+    ( already at IN( ? )
+    IN> @ IN( @ = IF EXIT THEN
+    IN> @ 1 - IN> !
+    SPC BS
+;
+
+( read one char into input buffer and returns whether we
+  should continue, that is, whether newline was not met. )
+: (rdlnc)                   ( -- f )
+    ( buffer overflow? stop now )
+    IN> @ IN) @ = IF 0 EXIT THEN
+    ( get and echo back )
+    KEY DUP                     ( c c )
+    ( del? same as backspace )
+    DUP 0x7f = IF DROP DROP 0x8 DUP THEN
+    EMIT                        ( c )
+    ( bacspace? handle and exit )
+    DUP 0x8 = IF (inbs) EXIT THEN
+    ( write and advance )
+    DUP     ( keep as result )  ( c c )
+    IN> @ ! 1 IN> +!            ( c )
+    ( not newline? exit now )
+    DUP 0xa = NOT IF EXIT THEN  ( c )
+    ( newline? make our result 0 and write it to indicate
+      EOL )
+    DROP 0
+    DUP IN> @ !                 ( c )
+;
+
+( Read one line in input buffer and make IN> point to it )
+: (rdln)
+    ( Should we prompt? if we're executing a word, FLAGS bit
+      0, then we shouldn't. )
+    FLAGS @ 0x1 AND NOT IF LF '>' EMIT SPC THEN
+    (infl)
+    BEGIN (rdlnc) NOT UNTIL
+    IN( @ IN> !
+;
+
+( And finally, implement a replacement for the C< routine )
+: C<
+    IN> @ C@                    ( c )
+    ( not EOL? good, inc and return )
+    DUP IF 1 IN> +! EXIT THEN   ( c )
+    ( EOL ? readline. we still return typed char though )
+    (rdln)                      ( c )
+;

forth/str.fs

@@ -6,5 +6,7 @@
     AGAIN
 ;
 
+: BS 8 EMIT ;
 : LF 10 EMIT ;
+: CR 13 EMIT ;
 : SPC 32 EMIT ;