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

Compare commits

...

8 Commits

Author SHA1 Message Date
Virgil Dupras
c2d8fc845d forth: bring ." and ABORT" down to core.fs level 2020-03-25 20:39:07 -04:00
Virgil Dupras
3e934a2a3b forth: fix name conflict with "H" in core and z80a 2020-03-25 20:13:33 -04:00
Virgil Dupras
77ecbc4918 forth: Forth-ify "'" and "[']" 2020-03-25 20:06:06 -04:00
Virgil Dupras
6d8edeec63 forth: Forth-ify "C!" and "C@" 2020-03-25 17:52:51 -04:00
Virgil Dupras
66412a1c30 forth: Forth-ify "XOR" 2020-03-25 17:24:46 -04:00
Virgil Dupras
1871f7cdb4 forth: Forth-ify "OR" 2020-03-25 17:19:47 -04:00
Virgil Dupras
eb6a07a162 forth: Forth-ify "PC@" 2020-03-25 17:13:10 -04:00
Virgil Dupras
7beac94b5a forth: Forth-ify "PC!" 2020-03-25 17:07:15 -04:00
10 changed files with 124 additions and 173 deletions

View File

@ -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.

View File

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

View File

@ -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 ***

View File

@ -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!

View File

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

View File

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

View File

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

View File

@ -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,

View File

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