1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 18:30:56 +11:00

Compare commits

..

No commits in common. "ac914c384731218bff6eb25d91d70fa178924eb6" and "61abafbc1ac49d76f79d4405fe96733dccc2dece" have entirely different histories.

7 changed files with 432 additions and 581 deletions

View File

@ -7,7 +7,7 @@ AVRABIN = zasm/avra
SHELLAPPS = zasm ed SHELLAPPS = zasm ed
SHELLTGTS = ${SHELLAPPS:%=cfsin/%} SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
# Those Forth source files are in a particular order # 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/%} FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
OBJS = emul.o libz80/libz80.o OBJS = emul.o libz80/libz80.o

View File

@ -1,21 +1,23 @@
: H HERE @ ; : H HERE @ ;
: -^ SWAP - ; : -^ SWAP - ;
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: C, H C! 1 ALLOT ;
: COMPILE ' LITN ['] , , ; IMMEDIATE : COMPILE ' LITN ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H ; IMMEDIATE : BEGIN H ; IMMEDIATE
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE : AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
: UNTIL COMPILE SKIP? 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? ( Hello, hello, krkrkrkr... do you hear me?
Ah, voice at last! Some lines above need comments Ah, voice at last! Some lines above need comments
BTW: Forth lines limited to 64 cols because of default BTW: Forth lines limited to 64 cols because of default
input buffer size in Collapse OS 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 ) : IF ( -- a | a: br cell addr )
COMPILE SKIP? ( if true, don't branch ) COMPILE SKIP? ( if true, don't branch )
@ -37,6 +39,7 @@
H 1 - ( push a. -1 for allot offset ) H 1 - ( push a. -1 for allot offset )
; IMMEDIATE ; IMMEDIATE
: ? @ . ;
: VARIABLE CREATE 2 ALLOT ; : VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ; : CONSTANT CREATE H ! DOES> @ ;
: = CMP NOT ; : = CMP NOT ;
@ -45,16 +48,15 @@
: / /MOD SWAP DROP ; : / /MOD SWAP DROP ;
: MOD /MOD 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 : DO
COMPILE SWAP COMPILE >R COMPILE >R COMPILE SWAP COMPILE >R COMPILE >R
H H
; IMMEDIATE ; 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 : LOOP
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr) COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)

View File

@ -32,7 +32,7 @@ directly, but as part of another word.
"*I*" in description indicates an IMMEDIATE word. "*I*" in description indicates an IMMEDIATE word.
*** Defining words *** *** 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. a = wordref. If not found, f=0 and a = string addr.
: x ... -- Define a new word : x ... -- Define a new word
; R:I -- Exit a colon definition ; R:I -- Exit a colon definition
@ -44,8 +44,7 @@ directly, but as part of another word.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
CREATE x -- Create cell named x. Doesn't allocate a PF. 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. COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file 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 HERE -- a Push HERE's address
H -- a HERE @ H -- a HERE @
*** Arithmetic / Bits *** *** Arithmetic ***
+ a b -- c a + b -> c + a b -- c a + b -> c
- 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 / a b -- c a / b -> c
MOD a b -- c a % b -> c MOD a b -- c a % b -> c
/MOD a b -- r q r:remainder q:quotient /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 *** *** Logic ***
= n1 n2 -- f Push true if n1 == n2 = 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 NOT f -- f Push the logical opposite of f
*** Strings *** *** 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 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. SLEN a -- n Push length of str at a.
*** I/O *** *** I/O ***
@ -195,7 +186,6 @@ core.
." xxx" -- *I* Compiles string literal xxx followed by a call ." xxx" -- *I* Compiles string literal xxx followed by a call
to (print) to (print)
are never considered negative. "-1 .X -> ffff" are never considered negative. "-1 .X -> ffff"
C< -- c Read one char from buffered input.
EMIT c -- Spit char c to output stream EMIT c -- Spit char c to output stream
IN> -- a Address of variable containing current pos in input IN> -- a Address of variable containing current pos in input
buffer. 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 WORD -- a Read one word from buffered input and push its addr
There are also ascii const emitters: There are also ascii const emitters:
BS
CR
LF LF
SPC SPC

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

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