mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 14:20:56 +11:00
Compare commits
10 Commits
61abafbc1a
...
ac914c3847
Author | SHA1 | Date | |
---|---|---|---|
|
ac914c3847 | ||
|
f4b969986d | ||
|
def4ebd7ea | ||
|
145fdd8e05 | ||
|
4627e1c977 | ||
|
6487c713ef | ||
|
9791c0957d | ||
|
b47a3ee234 | ||
|
c1ece95089 | ||
|
2feb246334 |
@ -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
|
||||
|
@ -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 LITS ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
||||
: ( BEGIN LIT< ) 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
|
||||
(bbr)) and then call LITN on it.
|
||||
COMPILE: Tough one. Get addr of caller word (example above
|
||||
(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
|
||||
to PS at runtime )
|
||||
( In addition to pushing H this compiles 2 >R so that loop
|
||||
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,
|
||||
but we can't because otherwise it messes with the RS )
|
||||
( One could think that we should have a sub word to avoid all
|
||||
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)
|
||||
|
@ -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
|
||||
|
||||
|
@ -23,6 +23,8 @@
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: ? @ . ;
|
||||
|
||||
: PUSHDGTS
|
||||
999 SWAP ( stop indicator )
|
||||
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
|
||||
|
884
forth/forth.asm
884
forth/forth.asm
File diff suppressed because it is too large
Load Diff
79
forth/readln.fs
Normal file
79
forth/readln.fs
Normal file
@ -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 )
|
||||
;
|
@ -6,5 +6,7 @@
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: BS 8 EMIT ;
|
||||
: LF 10 EMIT ;
|
||||
: CR 13 EMIT ;
|
||||
: SPC 32 EMIT ;
|
||||
|
Loading…
Reference in New Issue
Block a user