mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:10:54 +11:00
Compare commits
8 Commits
04a6784de4
...
c2d8fc845d
Author | SHA1 | Date | |
---|---|---|---|
|
c2d8fc845d | ||
|
3e934a2a3b | ||
|
77ecbc4918 | ||
|
6d8edeec63 | ||
|
66412a1c30 | ||
|
1871f7cdb4 | ||
|
eb6a07a162 | ||
|
7beac94b5a |
@ -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 z80a.fs dummy.fs
|
||||
FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs z80a.fs dummy.fs
|
||||
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
|
||||
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
|
||||
OBJS = emul.o libz80/libz80.o
|
||||
|
Binary file not shown.
@ -1,20 +1,26 @@
|
||||
: H HERE @ ;
|
||||
: H@ HERE @ ;
|
||||
: -^ SWAP - ;
|
||||
: [LITN] LITN ; IMMEDIATE
|
||||
: LIT ROUTINE S [LITN] , ;
|
||||
: LITS LIT SCPY ;
|
||||
: LIT< WORD LITS ; IMMEDIATE
|
||||
: _err LIT< word-not-found (print) ABORT ;
|
||||
: ' WORD (find) SKIP? _err ;
|
||||
: ['] WORD (find) SKIP? _err LITN ; IMMEDIATE
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
: [COMPILE] ' , ; IMMEDIATE
|
||||
: BEGIN H ; IMMEDIATE
|
||||
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
|
||||
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; 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
|
||||
( 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
|
||||
|
||||
"_": words starting with "_" are meant to be "private",
|
||||
that is, only used by their immediate surrondings.
|
||||
|
||||
COMPILE: Tough one. Get addr of caller word (example above
|
||||
(bbr)) and then call LITN on it. )
|
||||
|
||||
@ -24,21 +30,21 @@
|
||||
: IF ( -- a | a: br cell addr )
|
||||
COMPILE SKIP? ( if true, don't branch )
|
||||
COMPILE (fbr)
|
||||
H ( push a )
|
||||
H@ ( push a )
|
||||
1 ALLOT ( br cell allot )
|
||||
; IMMEDIATE
|
||||
|
||||
: THEN ( a -- | a: br cell addr )
|
||||
DUP H -^ SWAP ( a-H a )
|
||||
DUP H@ -^ SWAP ( a-H a )
|
||||
C!
|
||||
; IMMEDIATE
|
||||
|
||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||
COMPILE (fbr)
|
||||
1 ALLOT
|
||||
DUP H -^ SWAP ( a-H a )
|
||||
DUP H@ -^ SWAP ( a-H a )
|
||||
C!
|
||||
H 1 - ( push a. -1 for allot offset )
|
||||
H@ 1 - ( push a. -1 for allot offset )
|
||||
; IMMEDIATE
|
||||
|
||||
: CREATE
|
||||
@ -47,18 +53,18 @@
|
||||
, ( write it )
|
||||
;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: CONSTANT CREATE H ! DOES> @ ;
|
||||
: CONSTANT CREATE H@ ! DOES> @ ;
|
||||
: = CMP NOT ;
|
||||
: < CMP 0 1 - = ;
|
||||
: > CMP 1 = ;
|
||||
: / /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 to PS at runtime )
|
||||
: DO
|
||||
COMPILE SWAP COMPILE >R COMPILE >R
|
||||
H
|
||||
H@
|
||||
; IMMEDIATE
|
||||
|
||||
( One could think that we should have a sub word to avoid all
|
||||
@ -67,7 +73,7 @@
|
||||
: LOOP
|
||||
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
||||
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)
|
||||
H -^ C,
|
||||
H@ -^ C,
|
||||
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
||||
; IMMEDIATE
|
||||
|
||||
@ -84,3 +90,16 @@
|
||||
SYSVNXT @ ,
|
||||
2 SYSVNXT +!
|
||||
;
|
||||
|
||||
: ."
|
||||
LIT
|
||||
BEGIN
|
||||
C< DUP ( c c )
|
||||
( 34 is ASCII for " )
|
||||
DUP 34 = IF DROP DROP 0 0 THEN
|
||||
C,
|
||||
0 = UNTIL
|
||||
COMPILE (print)
|
||||
; IMMEDIATE
|
||||
|
||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
||||
|
@ -124,7 +124,7 @@ C@ a -- c Set c to byte at address a
|
||||
C! c a -- Store byte c in address a
|
||||
CURRENT -- a Set a to wordref of last added entry.
|
||||
HERE -- a Push HERE's address
|
||||
H -- a HERE @
|
||||
H@ -- a HERE @
|
||||
|
||||
*** Arithmetic / Bits ***
|
||||
|
||||
|
@ -7,5 +7,5 @@
|
||||
current HERE value. The staging executable needs it to know
|
||||
what to dump. )
|
||||
|
||||
HERE @ 256 / 2 PC!
|
||||
HERE @ 2 PC!
|
||||
H@ 256 / 2 PC!
|
||||
H@ 2 PC!
|
||||
|
149
forth/forth.asm
149
forth/forth.asm
@ -21,11 +21,6 @@
|
||||
;
|
||||
; PutC: Write character specified in A onto the device.
|
||||
;
|
||||
; *** ASCII ***
|
||||
.equ BS 0x08
|
||||
.equ CR 0x0d
|
||||
.equ LF 0x0a
|
||||
.equ DEL 0x7f
|
||||
; *** Const ***
|
||||
; Base of the Return Stack
|
||||
.equ RS_ADDR 0xf000
|
||||
@ -139,7 +134,7 @@ forthMain:
|
||||
call find
|
||||
ld (PARSEPTR), de
|
||||
; Set up CINPTR
|
||||
; do we have a C< impl?
|
||||
; do we have a (c<) impl?
|
||||
ld hl, .cinName
|
||||
call find
|
||||
jr z, .skip
|
||||
@ -155,7 +150,7 @@ forthMain:
|
||||
jp EXECUTE+2
|
||||
|
||||
.cinName:
|
||||
.db "C<", 0
|
||||
.db "(c<)", 0
|
||||
|
||||
BEGIN:
|
||||
.dw compiledWord
|
||||
@ -738,36 +733,9 @@ PRINT:
|
||||
inc hl
|
||||
jr .loop
|
||||
|
||||
; ( c port -- )
|
||||
.db "PC!"
|
||||
.fill 4
|
||||
.dw $-PRINT
|
||||
.db 0
|
||||
PSTORE:
|
||||
.dw nativeWord
|
||||
pop bc
|
||||
pop hl
|
||||
call chkPS
|
||||
out (c), l
|
||||
jp next
|
||||
|
||||
; ( port -- c )
|
||||
.db "PC@"
|
||||
.fill 4
|
||||
.dw $-PSTORE
|
||||
.db 0
|
||||
PFETCH:
|
||||
.dw nativeWord
|
||||
pop bc
|
||||
call chkPS
|
||||
ld h, 0
|
||||
in l, (c)
|
||||
push hl
|
||||
jp next
|
||||
|
||||
.db "C,"
|
||||
.fill 5
|
||||
.dw $-PFETCH
|
||||
.dw $-PRINT
|
||||
.db 0
|
||||
CWR:
|
||||
.dw nativeWord
|
||||
@ -1023,43 +991,10 @@ FIND_:
|
||||
push de
|
||||
jp next
|
||||
|
||||
.db "'"
|
||||
.fill 6
|
||||
.dw $-FIND_
|
||||
.db 0
|
||||
FIND:
|
||||
.dw compiledWord
|
||||
.dw WORD
|
||||
.dw FIND_
|
||||
.dw CSKIP
|
||||
.dw FINDERR
|
||||
.dw EXIT
|
||||
|
||||
.db "[']"
|
||||
.fill 4
|
||||
.dw $-FIND
|
||||
.db 0b01 ; IMMEDIATE
|
||||
FINDI:
|
||||
.dw compiledWord
|
||||
.dw WORD
|
||||
.dw FIND_
|
||||
.dw CSKIP
|
||||
.dw FINDERR
|
||||
.dw LITN
|
||||
.dw EXIT
|
||||
|
||||
FINDERR:
|
||||
.dw compiledWord
|
||||
.dw DROP ; Drop str addr, we don't use it
|
||||
.dw LIT
|
||||
.db "word not found", 0
|
||||
.dw PRINT
|
||||
.dw ABORT
|
||||
|
||||
; ( -- c )
|
||||
.db "KEY"
|
||||
.fill 4
|
||||
.dw $-FINDI
|
||||
.dw $-FIND_
|
||||
.db 0
|
||||
KEY:
|
||||
.dw nativeWord
|
||||
@ -1070,8 +1005,11 @@ KEY:
|
||||
jp next
|
||||
|
||||
; This is an indirect word that can be redirected through "CINPTR"
|
||||
; This is not a real word because it's not meant to be referred to in Forth
|
||||
; code: it is replaced in readln.fs.
|
||||
.db "C<"
|
||||
.fill 5
|
||||
.dw $-KEY
|
||||
.db 0
|
||||
CIN:
|
||||
.dw compiledWord
|
||||
.dw NUMBER
|
||||
@ -1088,7 +1026,7 @@ CIN:
|
||||
; 32 CMP 1 -
|
||||
.db "WS?"
|
||||
.fill 4
|
||||
.dw $-KEY
|
||||
.dw $-CIN
|
||||
.db 0
|
||||
ISWS:
|
||||
.dw compiledWord
|
||||
@ -1320,23 +1258,10 @@ STORE:
|
||||
ld (iy+1), h
|
||||
jp next
|
||||
|
||||
; ( n a -- )
|
||||
.db "C!"
|
||||
.fill 5
|
||||
.dw $-STORE
|
||||
.db 0
|
||||
CSTORE:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
pop de
|
||||
call chkPS
|
||||
ld (hl), e
|
||||
jp next
|
||||
|
||||
; ( a -- n )
|
||||
.db "@"
|
||||
.fill 6
|
||||
.dw $-CSTORE
|
||||
.dw $-STORE
|
||||
.db 0
|
||||
FETCH:
|
||||
.dw nativeWord
|
||||
@ -1346,24 +1271,10 @@ FETCH:
|
||||
push hl
|
||||
jp next
|
||||
|
||||
; ( a -- c )
|
||||
.db "C@"
|
||||
.fill 5
|
||||
.dw $-FETCH
|
||||
.db 0
|
||||
CFETCH:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
call chkPS
|
||||
ld l, (hl)
|
||||
ld h, 0
|
||||
push hl
|
||||
jp next
|
||||
|
||||
; ( a -- )
|
||||
.db "DROP"
|
||||
.fill 3
|
||||
.dw $-CFETCH
|
||||
.dw $-FETCH
|
||||
.db 0
|
||||
DROP:
|
||||
.dw nativeWord
|
||||
@ -1537,49 +1448,13 @@ DIVMOD:
|
||||
jp next
|
||||
|
||||
|
||||
.db "OR"
|
||||
.fill 5
|
||||
.dw $-DIVMOD
|
||||
.db 0
|
||||
OR:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
pop de
|
||||
call chkPS
|
||||
ld a, e
|
||||
or l
|
||||
ld l, a
|
||||
ld a, d
|
||||
or h
|
||||
ld h, a
|
||||
push hl
|
||||
jp next
|
||||
|
||||
.db "XOR"
|
||||
.fill 4
|
||||
.dw $-OR
|
||||
.db 0
|
||||
XOR:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
pop de
|
||||
call chkPS
|
||||
ld a, e
|
||||
xor l
|
||||
ld l, a
|
||||
ld a, d
|
||||
xor h
|
||||
ld h, a
|
||||
push hl
|
||||
jp next
|
||||
|
||||
; It might look peculiar to have specific words for "0" and "1", but although
|
||||
; it slightly beefs ups the ASM part of the binary, this one-byte-save-per-use
|
||||
; really adds up when we compare total size.
|
||||
|
||||
.db "0"
|
||||
.fill 6
|
||||
.dw $-XOR
|
||||
.dw $-DIVMOD
|
||||
.db 0
|
||||
ZERO:
|
||||
.dw nativeWord
|
||||
|
@ -1,14 +0,0 @@
|
||||
( Higher level stuff that generally requires all core units )
|
||||
|
||||
: ."
|
||||
LIT
|
||||
BEGIN
|
||||
C< DUP ( c c )
|
||||
( 34 is ASCII for " )
|
||||
DUP 34 = IF DROP DROP 0 0 THEN
|
||||
C,
|
||||
0 = UNTIL
|
||||
COMPILE (print)
|
||||
; IMMEDIATE
|
||||
|
||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
@ -21,9 +21,9 @@
|
||||
|
||||
( Initializes the readln subsystem )
|
||||
: (c<$)
|
||||
HERE @ IN( !
|
||||
H@ IN( !
|
||||
INBUFSZ ALLOT
|
||||
HERE @ IN) !
|
||||
H@ IN) !
|
||||
(infl)
|
||||
;
|
||||
|
||||
@ -69,8 +69,8 @@
|
||||
IN( @ IN> !
|
||||
;
|
||||
|
||||
( And finally, implement a replacement for the C< routine )
|
||||
: C<
|
||||
( 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 )
|
||||
|
@ -43,7 +43,6 @@
|
||||
;
|
||||
0x04 OP1r INCr,
|
||||
0x46 OP1r LDr(HL),
|
||||
0x70 OP1r LD(HL)r,
|
||||
|
||||
( r -- )
|
||||
: OP1r0
|
||||
@ -52,7 +51,10 @@
|
||||
C@ ( r op )
|
||||
OR A,
|
||||
;
|
||||
0x70 OP1r0 LD(HL)r,
|
||||
0xa0 OP1r0 ANDr,
|
||||
0xb0 OP1r0 ORr,
|
||||
0xa8 OP1r0 XORr,
|
||||
|
||||
( qq -- also works for ss )
|
||||
: OP1qq
|
||||
@ -107,12 +109,25 @@
|
||||
C@ ( b r op )
|
||||
ROT ( r op b )
|
||||
8 * ( r op b<<3 )
|
||||
OR OR Z,
|
||||
OR OR A,
|
||||
;
|
||||
0xc0 OP2br SETbr,
|
||||
0x80 OP2br RESbr,
|
||||
0x40 OP2br BITbr,
|
||||
|
||||
( cell contains both bytes. MSB is spit as-is, LSB is ORed with r )
|
||||
( r -- )
|
||||
: OP2r
|
||||
CREATE ,
|
||||
DOES>
|
||||
@ 256 /MOD ( r lsb msb )
|
||||
A, ( r lsb )
|
||||
SWAP 8 * ( lsb r<<3 )
|
||||
OR A,
|
||||
;
|
||||
0xed41 OP2r OUT(C)r,
|
||||
0xed40 OP2r INr(C),
|
||||
|
||||
( dd nn -- )
|
||||
: OP3ddnn
|
||||
CREATE C,
|
||||
|
@ -83,3 +83,59 @@ CODE AND
|
||||
H A LDrr,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE OR
|
||||
HL POPqq,
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
A E LDrr,
|
||||
L ORr,
|
||||
L A LDrr,
|
||||
A D LDrr,
|
||||
H ORr,
|
||||
H A LDrr,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE XOR
|
||||
HL POPqq,
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
A E LDrr,
|
||||
L XORr,
|
||||
L A LDrr,
|
||||
A D LDrr,
|
||||
H XORr,
|
||||
H A LDrr,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE C!
|
||||
HL POPqq,
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
E LD(HL)r,
|
||||
;CODE
|
||||
|
||||
CODE C@
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
L LDr(HL),
|
||||
H 0 LDrn,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE PC!
|
||||
BC POPqq,
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
L OUT(C)r,
|
||||
;CODE
|
||||
|
||||
CODE PC@
|
||||
BC POPqq,
|
||||
chkPS,
|
||||
H 0 LDrn,
|
||||
L INr(C),
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
Loading…
Reference in New Issue
Block a user