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 readln.fs fmt.fs high.fs
+FORTHSRCS = core.fs str.fs parse.fs fmt.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o

forth/core.fs

@@ -1,21 +1,23 @@
 : 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
-: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
+: NOT 1 SWAP SKIP? EXIT 0 * ;
+: ( 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.
 
-: +! SWAP OVER @ + SWAP ! ;
+  NOT: a bit convulted because we don't have IF yet )
-: ALLOT HERE +! ;
 
 : IF                ( -- a | a: br cell addr )
     COMPILE SKIP?   ( if true, don't branch )
@@ -37,6 +39,7 @@
     H 1 -           ( push a. -1 for allot offset )
 ; IMMEDIATE
 
+: ? @ . ;
 : VARIABLE CREATE 2 ALLOT ;
 : CONSTANT CREATE H ! DOES> @ ;
 : = CMP NOT ;
@@ -45,16 +48,15 @@
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
 
-( In addition to pushing H this compiles 2 >R so that loop
+( In addition to pushing H this compiles 2 >R so that loop variables are sent
-  variables are sent to PS at runtime )
+  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
+( One could think that we should have a sub word to avoid all these COMPILE,
-  these COMPILE, but we can't because otherwise it messes with
+  but we can't because otherwise it messes with the RS )
-  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)      a -- a f        Read at a and find it in dict. If found, f=1 and
+(find) x    -- a f          Read word x 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,8 +44,7 @@ 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. IMMEDIATE
+[COMPILE] x --              Compile word x and write it to HERE
-                            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
@@ -121,7 +120,7 @@ CURRENT     -- a            Set a to wordref of last added entry.
 HERE        -- a            Push HERE's address
 H           -- a            HERE @
 
-*** Arithmetic / Bits ***
+*** Arithmetic ***
 
 +           a b -- c        a + b -> c
 -           a b -- c        a - b -> c
@@ -130,9 +129,6 @@ 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
@@ -143,13 +139,8 @@ 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 ***
-LIT         --              Write a LIT entry. You're expected to write actual
+LITS x      -- a            Read following LIT and push its addr to a
-                            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 ***
@@ -195,7 +186,6 @@ 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.
@@ -205,8 +195,6 @@ 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,8 +23,6 @@
     AGAIN
 ;
 
-: ? @ . ;
-
 : PUSHDGTS
     999 SWAP        ( stop indicator )
     DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )

forth/readln.fs

@@ -1,79 +0,0 @@
-( 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,7 +6,5 @@
     AGAIN
 ;
 
-: BS 8 EMIT ;
 : LF 10 EMIT ;
-: CR 13 EMIT ;
 : SPC 32 EMIT ;