mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-26 09:28:05 +11:00
Compare commits
5 Commits
33e47d4938
...
ffe61a12f8
| Author | SHA1 | Date | |
|---|---|---|---|
|
ffe61a12f8 | ||
|
|
00de336976 | ||
|
|
46833f3819 | ||
|
|
54fd5fbb2b | ||
|
|
1e886f5f34 |
@ -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
|
||||
FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs z80a.fs dummy.fs
|
||||
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
|
||||
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
|
||||
OBJS = emul.o libz80/libz80.o
|
||||
|
||||
@ -34,6 +34,6 @@ emulPutC:
|
||||
out (STDIO_PORT), a
|
||||
ret
|
||||
|
||||
.dw 0 ; placeholder used in glue1.
|
||||
CODE_END:
|
||||
.out LATEST
|
||||
.out $ ; should be the same as in glue1
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
; Warning: The offsets of native dict entries must be exactly the same between
|
||||
; glue0.asm and glue1.asm
|
||||
.equ LATEST CODE_END ; override
|
||||
.equ LATEST RAMSTART ; override
|
||||
.equ STDIO_PORT 0x00
|
||||
|
||||
jp init
|
||||
@ -26,9 +26,6 @@ emulPutC:
|
||||
out (STDIO_PORT), a
|
||||
ret
|
||||
|
||||
.out $ ; should be the same as in glue0, minus 2
|
||||
; stage0 spits, at the beginning of the binary, the address of the latest word
|
||||
; Therefore, we can set the LATEST label to here and we should be good.
|
||||
CODE_END:
|
||||
.out $ ; should be the same as in glue0
|
||||
.bin "core.bin"
|
||||
RAMSTART:
|
||||
|
||||
@ -71,9 +71,6 @@ int main(int argc, char *argv[])
|
||||
|
||||
#ifndef DEBUG
|
||||
// We're done, now let's spit dict data
|
||||
// let's start with LATEST spitting.
|
||||
putchar(m->mem[CURRENT]);
|
||||
putchar(m->mem[CURRENT+1]);
|
||||
uint16_t here = m->mem[HERE] + (m->mem[HERE+1] << 8);
|
||||
for (int i=sizeof(KERNEL); i<here; i++) {
|
||||
putchar(m->mem[i]);
|
||||
|
||||
@ -1,5 +1,9 @@
|
||||
: H HERE @ ;
|
||||
: -^ SWAP - ;
|
||||
: [LITN] LITN ; IMMEDIATE
|
||||
: LIT ROUTINE S [LITN] , ;
|
||||
: LITS LIT SCPY ;
|
||||
: LIT< WORD LITS ; IMMEDIATE
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
: [COMPILE] ' , ; IMMEDIATE
|
||||
: BEGIN H ; IMMEDIATE
|
||||
@ -37,6 +41,11 @@
|
||||
H 1 - ( push a. -1 for allot offset )
|
||||
; IMMEDIATE
|
||||
|
||||
: CREATE
|
||||
WORD (entry) ( empty header with name )
|
||||
ROUTINE C [LITN] ( push cellWord addr )
|
||||
, ( write it )
|
||||
;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: CONSTANT CREATE H ! DOES> @ ;
|
||||
: = CMP NOT ;
|
||||
|
||||
@ -52,6 +52,10 @@ DOES> -- See description at top of file
|
||||
IMMED? a -- f Checks whether wordref at a is immediate.
|
||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||
LITN n -- Write number n as a literal.
|
||||
[LITN] n -- *I* Immediate version of LITN.
|
||||
ROUTINE x -- a Push the addr of the specified core routine
|
||||
C=cellWord L=compiledWord V=nativeWord N=next S=LIT
|
||||
N=NUMBER Y=sysvarWord D=doesWord
|
||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||
|
||||
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
|
||||
|
||||
4
forth/dummy.fs
Normal file
4
forth/dummy.fs
Normal file
@ -0,0 +1,4 @@
|
||||
( When building a compiled dict, always include this unit at
|
||||
the end of it so that Forth knows how to hook LATEST into
|
||||
it )
|
||||
WORD _______ (entry)
|
||||
275
forth/forth.asm
275
forth/forth.asm
@ -119,12 +119,10 @@ forthMain:
|
||||
push af \ push af \ push af
|
||||
ld (INITIAL_SP), sp
|
||||
ld ix, RS_ADDR
|
||||
; LATEST is a *indirect* label to the latest entry of the dict. See
|
||||
; default at the bottom of dict.asm. This indirection allows us to
|
||||
; override latest to a value set in a binary dict compiled separately,
|
||||
; for example by the stage0 bin.
|
||||
; LATEST is a label to the latest entry of the dict. This can be
|
||||
; overridden if a binary dict has been grafted to the end of this
|
||||
; binary
|
||||
ld hl, LATEST
|
||||
call intoHL
|
||||
ld (CURRENT), hl
|
||||
ld hl, HERE_INITIAL
|
||||
ld (HERE), hl
|
||||
@ -416,9 +414,12 @@ find:
|
||||
call strncmp
|
||||
pop de ; <-- lvl 1, return to wordref
|
||||
jr z, .end ; found
|
||||
push hl ; .prev destroys HL
|
||||
call .prev
|
||||
pop hl
|
||||
jr nz, .inner
|
||||
; Z set? end of dict unset Z
|
||||
xor a
|
||||
inc a
|
||||
.end:
|
||||
pop bc
|
||||
@ -429,15 +430,21 @@ find:
|
||||
; Z is set if DE point to 0 (no entry). NZ if not.
|
||||
.prev:
|
||||
dec de \ dec de \ dec de ; prev field
|
||||
push de ; --> lvl 1
|
||||
ex de, hl
|
||||
call intoHL
|
||||
ex de, hl ; de preserved by intoHL, so no push/pop needed
|
||||
; DE points to prev. Is it zero?
|
||||
xor a
|
||||
or d
|
||||
ex de, hl ; DE contains prev offset
|
||||
pop hl ; <-- lvl 1
|
||||
; HL is prev field's addr
|
||||
; Is offset zero?
|
||||
ld a, d
|
||||
or e
|
||||
; Z will be set if DE is zero
|
||||
ret
|
||||
ret z ; no prev entry
|
||||
; get absolute addr from offset
|
||||
; carry cleared from "or e"
|
||||
sbc hl, de
|
||||
ex de, hl ; result in DE
|
||||
ret ; NZ set from SBC
|
||||
|
||||
; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
|
||||
flagsToBC:
|
||||
@ -519,11 +526,14 @@ chkPS:
|
||||
; It's important that this part is at the end of the resulting binary.
|
||||
; A dictionary entry has this structure:
|
||||
; - 7b name (zero-padded)
|
||||
; - 2b prev pointer
|
||||
; - 2b prev offset
|
||||
; - 1b flags (bit 0: IMMEDIATE)
|
||||
; - 2b code pointer
|
||||
; - Parameter field (PF)
|
||||
;
|
||||
; The prev offset is the number of bytes between the prev field and the
|
||||
; previous word's code pointer.
|
||||
;
|
||||
; The code pointer point to "word routines". These routines expect to be called
|
||||
; with IY pointing to the PF. They themselves are expected to end by jumping
|
||||
; to the address at (IP). They will usually do so with "jp next".
|
||||
@ -642,7 +652,7 @@ EXIT:
|
||||
; ( R:I -- )
|
||||
.db "QUIT"
|
||||
.fill 3
|
||||
.dw EXIT
|
||||
.dw $-EXIT
|
||||
.db 0
|
||||
QUIT:
|
||||
.dw compiledWord
|
||||
@ -659,7 +669,7 @@ QUIT:
|
||||
|
||||
.db "ABORT"
|
||||
.fill 2
|
||||
.dw QUIT
|
||||
.dw $-QUIT
|
||||
.db 0
|
||||
ABORT:
|
||||
.dw compiledWord
|
||||
@ -685,7 +695,7 @@ abortUnderflow:
|
||||
|
||||
.db "BYE"
|
||||
.fill 4
|
||||
.dw ABORT
|
||||
.dw $-ABORT
|
||||
.db 0
|
||||
BYE:
|
||||
.dw nativeWord
|
||||
@ -700,7 +710,7 @@ BYE:
|
||||
; ( c -- )
|
||||
.db "EMIT"
|
||||
.fill 3
|
||||
.dw BYE
|
||||
.dw $-BYE
|
||||
.db 0
|
||||
EMIT:
|
||||
.dw nativeWord
|
||||
@ -711,7 +721,7 @@ EMIT:
|
||||
jp next
|
||||
|
||||
.db "(print)"
|
||||
.dw EMIT
|
||||
.dw $-EMIT
|
||||
.db 0
|
||||
PRINT:
|
||||
.dw nativeWord
|
||||
@ -728,7 +738,7 @@ PRINT:
|
||||
; ( c port -- )
|
||||
.db "PC!"
|
||||
.fill 4
|
||||
.dw PRINT
|
||||
.dw $-PRINT
|
||||
.db 0
|
||||
PSTORE:
|
||||
.dw nativeWord
|
||||
@ -741,7 +751,7 @@ PSTORE:
|
||||
; ( port -- c )
|
||||
.db "PC@"
|
||||
.fill 4
|
||||
.dw PSTORE
|
||||
.dw $-PSTORE
|
||||
.db 0
|
||||
PFETCH:
|
||||
.dw nativeWord
|
||||
@ -754,7 +764,7 @@ PFETCH:
|
||||
|
||||
.db "C,"
|
||||
.fill 5
|
||||
.dw PFETCH
|
||||
.dw $-PFETCH
|
||||
.db 0
|
||||
CWR:
|
||||
.dw nativeWord
|
||||
@ -769,7 +779,7 @@ CWR:
|
||||
|
||||
.db ","
|
||||
.fill 6
|
||||
.dw CWR
|
||||
.dw $-CWR
|
||||
.db 0
|
||||
WR:
|
||||
.dw nativeWord
|
||||
@ -781,9 +791,63 @@ WR:
|
||||
jp next
|
||||
|
||||
|
||||
.db "ROUTINE"
|
||||
.dw $-WR
|
||||
.db 1 ; IMMEDIATE
|
||||
ROUTINE:
|
||||
.dw compiledWord
|
||||
.dw WORD
|
||||
.dw .private
|
||||
.dw EXIT
|
||||
|
||||
.private:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
call chkPS
|
||||
ld a, (hl)
|
||||
ld de, cellWord
|
||||
cp 'C'
|
||||
jr z, .end
|
||||
ld de, compiledWord
|
||||
cp 'L'
|
||||
jr z, .end
|
||||
ld de, nativeWord
|
||||
cp 'V'
|
||||
jr z, .end
|
||||
ld de, next
|
||||
cp 'N'
|
||||
jr z, .end
|
||||
ld de, sysvarWord
|
||||
cp 'Y'
|
||||
jr z, .end
|
||||
ld de, doesWord
|
||||
cp 'D'
|
||||
jr z, .end
|
||||
ld de, LIT
|
||||
cp 'S'
|
||||
jr z, .end
|
||||
ld de, NUMBER
|
||||
cp 'N'
|
||||
jr z, .end
|
||||
ld de, chkPS
|
||||
cp 'P'
|
||||
jr nz, .notgood
|
||||
; continue to end on match
|
||||
.end:
|
||||
; is our slen 1?
|
||||
inc hl
|
||||
ld a, (hl)
|
||||
or a
|
||||
jr z, .good
|
||||
.notgood:
|
||||
ld de, 0
|
||||
.good:
|
||||
push de
|
||||
jp next
|
||||
|
||||
; ( addr -- )
|
||||
.db "EXECUTE"
|
||||
.dw WR
|
||||
.dw $-ROUTINE
|
||||
.db 0
|
||||
EXECUTE:
|
||||
.dw nativeWord
|
||||
@ -800,7 +864,7 @@ EXECUTE:
|
||||
|
||||
.db ";"
|
||||
.fill 6
|
||||
.dw EXECUTE
|
||||
.dw $-EXECUTE
|
||||
.db 1 ; IMMEDIATE
|
||||
ENDDEF:
|
||||
.dw compiledWord
|
||||
@ -815,7 +879,7 @@ ENDDEF:
|
||||
|
||||
.db ":"
|
||||
.fill 6
|
||||
.dw ENDDEF
|
||||
.dw $-ENDDEF
|
||||
.db 1 ; IMMEDIATE
|
||||
DEFINE:
|
||||
.dw compiledWord
|
||||
@ -860,7 +924,7 @@ DEFINE:
|
||||
|
||||
.db "DOES>"
|
||||
.fill 2
|
||||
.dw DEFINE
|
||||
.dw $-DEFINE
|
||||
.db 0
|
||||
DOES:
|
||||
.dw nativeWord
|
||||
@ -881,7 +945,7 @@ DOES:
|
||||
|
||||
|
||||
.db "IMMEDIA"
|
||||
.dw DOES
|
||||
.dw $-DOES
|
||||
.db 0
|
||||
IMMEDIATE:
|
||||
.dw nativeWord
|
||||
@ -893,7 +957,7 @@ IMMEDIATE:
|
||||
|
||||
.db "IMMED?"
|
||||
.fill 1
|
||||
.dw IMMEDIATE
|
||||
.dw $-IMMEDIATE
|
||||
.db 0
|
||||
ISIMMED:
|
||||
.dw nativeWord
|
||||
@ -911,7 +975,7 @@ ISIMMED:
|
||||
; ( n -- )
|
||||
.db "LITN"
|
||||
.fill 3
|
||||
.dw ISIMMED
|
||||
.dw $-ISIMMED
|
||||
.db 0
|
||||
LITN:
|
||||
.dw nativeWord
|
||||
@ -926,7 +990,7 @@ LITN:
|
||||
|
||||
.db "SCPY"
|
||||
.fill 3
|
||||
.dw LITN
|
||||
.dw $-LITN
|
||||
.db 0
|
||||
SCPY:
|
||||
.dw nativeWord
|
||||
@ -937,41 +1001,9 @@ SCPY:
|
||||
jp next
|
||||
|
||||
|
||||
.db "LIT"
|
||||
.fill 4
|
||||
.dw SCPY
|
||||
.db 0
|
||||
LIT_:
|
||||
.dw compiledWord
|
||||
.dw NUMBER
|
||||
.dw LIT
|
||||
.dw WR
|
||||
.dw EXIT
|
||||
|
||||
.db "LITS"
|
||||
.fill 3
|
||||
.dw LIT_
|
||||
.db 0
|
||||
LITS:
|
||||
.dw compiledWord
|
||||
.dw LIT_
|
||||
.dw SCPY
|
||||
.dw EXIT
|
||||
|
||||
|
||||
.db "LIT<"
|
||||
.fill 3
|
||||
.dw LITS
|
||||
.db 1 ; IMMEDIATE
|
||||
LITRD:
|
||||
.dw compiledWord
|
||||
.dw WORD
|
||||
.dw LITS
|
||||
.dw EXIT
|
||||
|
||||
.db "(find)"
|
||||
.fill 1
|
||||
.dw LITRD
|
||||
.dw $-SCPY
|
||||
.db 0
|
||||
FIND_:
|
||||
.dw nativeWord
|
||||
@ -991,7 +1023,7 @@ FIND_:
|
||||
|
||||
.db "'"
|
||||
.fill 6
|
||||
.dw FIND_
|
||||
.dw $-FIND_
|
||||
.db 0
|
||||
FIND:
|
||||
.dw compiledWord
|
||||
@ -1003,7 +1035,7 @@ FIND:
|
||||
|
||||
.db "[']"
|
||||
.fill 4
|
||||
.dw FIND
|
||||
.dw $-FIND
|
||||
.db 0b01 ; IMMEDIATE
|
||||
FINDI:
|
||||
.dw compiledWord
|
||||
@ -1025,7 +1057,7 @@ FINDERR:
|
||||
; ( -- c )
|
||||
.db "KEY"
|
||||
.fill 4
|
||||
.dw FINDI
|
||||
.dw $-FINDI
|
||||
.db 0
|
||||
KEY:
|
||||
.dw nativeWord
|
||||
@ -1054,7 +1086,7 @@ CIN:
|
||||
; 32 CMP 1 -
|
||||
.db "WS?"
|
||||
.fill 4
|
||||
.dw KEY
|
||||
.dw $-KEY
|
||||
.db 0
|
||||
ISWS:
|
||||
.dw compiledWord
|
||||
@ -1068,7 +1100,7 @@ ISWS:
|
||||
|
||||
.db "NOT"
|
||||
.fill 4
|
||||
.dw ISWS
|
||||
.dw $-ISWS
|
||||
.db 0
|
||||
NOT:
|
||||
.dw nativeWord
|
||||
@ -1088,7 +1120,7 @@ NOT:
|
||||
; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
|
||||
.db "TOWORD"
|
||||
.fill 1
|
||||
.dw NOT
|
||||
.dw $-NOT
|
||||
.db 0
|
||||
TOWORD:
|
||||
.dw compiledWord
|
||||
@ -1105,7 +1137,7 @@ TOWORD:
|
||||
; HL point to WORDBUF.
|
||||
.db "WORD"
|
||||
.fill 3
|
||||
.dw TOWORD
|
||||
.dw $-TOWORD
|
||||
.db 0
|
||||
WORD:
|
||||
.dw compiledWord
|
||||
@ -1152,7 +1184,7 @@ WORD:
|
||||
|
||||
|
||||
.db "(parsed"
|
||||
.dw WORD
|
||||
.dw $-WORD
|
||||
.db 0
|
||||
PARSED:
|
||||
.dw nativeWord
|
||||
@ -1173,7 +1205,7 @@ PARSED:
|
||||
|
||||
|
||||
.db "(parse)"
|
||||
.dw PARSED
|
||||
.dw $-PARSED
|
||||
.db 0
|
||||
PARSE:
|
||||
.dw compiledWord
|
||||
@ -1202,6 +1234,9 @@ PARSEI:
|
||||
|
||||
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||
; HL points to new (HERE)
|
||||
.db "(entry)"
|
||||
.dw $-PARSE
|
||||
.db 0
|
||||
ENTRYHEAD:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -1211,6 +1246,11 @@ ENTRYHEAD:
|
||||
ld de, (CURRENT)
|
||||
ld a, NAMELEN
|
||||
call addHL
|
||||
push hl ; --> lvl 1
|
||||
or a ; clear carry
|
||||
sbc hl, de
|
||||
ex de, hl
|
||||
pop hl ; <-- lvl 1
|
||||
call DEinHL
|
||||
; Set word flags: not IMMED, so it's 0
|
||||
xor a
|
||||
@ -1221,19 +1261,6 @@ ENTRYHEAD:
|
||||
jp next
|
||||
|
||||
|
||||
.db "CREATE"
|
||||
.fill 1
|
||||
.dw PARSE
|
||||
.db 0
|
||||
CREATE:
|
||||
.dw compiledWord
|
||||
.dw WORD
|
||||
.dw ENTRYHEAD
|
||||
.dw NUMBER
|
||||
.dw cellWord
|
||||
.dw WR
|
||||
.dw EXIT
|
||||
|
||||
; WARNING: there are no limit checks. We must be cautious, in core code, not
|
||||
; to create more than SYSV_BUFSIZE/2 sys vars.
|
||||
; Also: SYSV shouldn't be used during runtime: SYSVNXT won't point at the
|
||||
@ -1241,7 +1268,7 @@ CREATE:
|
||||
; this word is not documented in dictionary.txt
|
||||
.db "(sysv)"
|
||||
.fill 1
|
||||
.dw CREATE
|
||||
.dw $-ENTRYHEAD
|
||||
.db 0
|
||||
SYSV:
|
||||
.dw compiledWord
|
||||
@ -1269,21 +1296,21 @@ SYSV:
|
||||
|
||||
.db "HERE"
|
||||
.fill 3
|
||||
.dw SYSV
|
||||
.dw $-SYSV
|
||||
.db 0
|
||||
HERE_: ; Caution: conflicts with actual variable name
|
||||
.dw sysvarWord
|
||||
.dw HERE
|
||||
|
||||
.db "CURRENT"
|
||||
.dw HERE_
|
||||
.dw $-HERE_
|
||||
.db 0
|
||||
CURRENT_:
|
||||
.dw sysvarWord
|
||||
.dw CURRENT
|
||||
|
||||
.db "(parse*"
|
||||
.dw CURRENT_
|
||||
.dw $-CURRENT_
|
||||
.db 0
|
||||
PARSEPTR_:
|
||||
.dw sysvarWord
|
||||
@ -1291,7 +1318,7 @@ PARSEPTR_:
|
||||
|
||||
.db "FLAGS"
|
||||
.fill 2
|
||||
.dw PARSEPTR_
|
||||
.dw $-PARSEPTR_
|
||||
.db 0
|
||||
FLAGS_:
|
||||
.dw sysvarWord
|
||||
@ -1300,7 +1327,7 @@ FLAGS_:
|
||||
; ( n a -- )
|
||||
.db "!"
|
||||
.fill 6
|
||||
.dw FLAGS_
|
||||
.dw $-FLAGS_
|
||||
.db 0
|
||||
STORE:
|
||||
.dw nativeWord
|
||||
@ -1314,7 +1341,7 @@ STORE:
|
||||
; ( n a -- )
|
||||
.db "C!"
|
||||
.fill 5
|
||||
.dw STORE
|
||||
.dw $-STORE
|
||||
.db 0
|
||||
CSTORE:
|
||||
.dw nativeWord
|
||||
@ -1327,7 +1354,7 @@ CSTORE:
|
||||
; ( a -- n )
|
||||
.db "@"
|
||||
.fill 6
|
||||
.dw CSTORE
|
||||
.dw $-CSTORE
|
||||
.db 0
|
||||
FETCH:
|
||||
.dw nativeWord
|
||||
@ -1340,7 +1367,7 @@ FETCH:
|
||||
; ( a -- c )
|
||||
.db "C@"
|
||||
.fill 5
|
||||
.dw FETCH
|
||||
.dw $-FETCH
|
||||
.db 0
|
||||
CFETCH:
|
||||
.dw nativeWord
|
||||
@ -1354,7 +1381,7 @@ CFETCH:
|
||||
; ( a -- )
|
||||
.db "DROP"
|
||||
.fill 3
|
||||
.dw CFETCH
|
||||
.dw $-CFETCH
|
||||
.db 0
|
||||
DROP:
|
||||
.dw nativeWord
|
||||
@ -1364,7 +1391,7 @@ DROP:
|
||||
; ( a b -- b a )
|
||||
.db "SWAP"
|
||||
.fill 3
|
||||
.dw DROP
|
||||
.dw $-DROP
|
||||
.db 0
|
||||
SWAP:
|
||||
.dw nativeWord
|
||||
@ -1377,7 +1404,7 @@ SWAP:
|
||||
; ( a b c d -- c d a b )
|
||||
.db "2SWAP"
|
||||
.fill 2
|
||||
.dw SWAP
|
||||
.dw $-SWAP
|
||||
.db 0
|
||||
SWAP2:
|
||||
.dw nativeWord
|
||||
@ -1395,7 +1422,7 @@ SWAP2:
|
||||
; ( a -- a a )
|
||||
.db "DUP"
|
||||
.fill 4
|
||||
.dw SWAP2
|
||||
.dw $-SWAP2
|
||||
.db 0
|
||||
DUP:
|
||||
.dw nativeWord
|
||||
@ -1408,7 +1435,7 @@ DUP:
|
||||
; ( a b -- a b a b )
|
||||
.db "2DUP"
|
||||
.fill 3
|
||||
.dw DUP
|
||||
.dw $-DUP
|
||||
.db 0
|
||||
DUP2:
|
||||
.dw nativeWord
|
||||
@ -1424,7 +1451,7 @@ DUP2:
|
||||
; ( a b -- a b a )
|
||||
.db "OVER"
|
||||
.fill 3
|
||||
.dw DUP2
|
||||
.dw $-DUP2
|
||||
.db 0
|
||||
OVER:
|
||||
.dw nativeWord
|
||||
@ -1439,7 +1466,7 @@ OVER:
|
||||
; ( a b c d -- a b c d a b )
|
||||
.db "2OVER"
|
||||
.fill 2
|
||||
.dw OVER
|
||||
.dw $-OVER
|
||||
.db 0
|
||||
OVER2:
|
||||
.dw nativeWord
|
||||
@ -1459,7 +1486,7 @@ OVER2:
|
||||
; ( a b c -- b c a)
|
||||
.db "ROT"
|
||||
.fill 4
|
||||
.dw OVER2
|
||||
.dw $-OVER2
|
||||
.db 0
|
||||
ROT:
|
||||
.dw nativeWord
|
||||
@ -1474,7 +1501,7 @@ ROT:
|
||||
|
||||
.db ">R"
|
||||
.fill 5
|
||||
.dw ROT
|
||||
.dw $-ROT
|
||||
.db 0
|
||||
P2R:
|
||||
.dw nativeWord
|
||||
@ -1485,7 +1512,7 @@ P2R:
|
||||
|
||||
.db "R>"
|
||||
.fill 5
|
||||
.dw P2R
|
||||
.dw $-P2R
|
||||
.db 0
|
||||
R2P:
|
||||
.dw nativeWord
|
||||
@ -1495,7 +1522,7 @@ R2P:
|
||||
|
||||
.db "I"
|
||||
.fill 6
|
||||
.dw R2P
|
||||
.dw $-R2P
|
||||
.db 0
|
||||
I:
|
||||
.dw nativeWord
|
||||
@ -1506,7 +1533,7 @@ I:
|
||||
|
||||
.db "I'"
|
||||
.fill 5
|
||||
.dw I
|
||||
.dw $-I
|
||||
.db 0
|
||||
IPRIME:
|
||||
.dw nativeWord
|
||||
@ -1517,7 +1544,7 @@ IPRIME:
|
||||
|
||||
.db "J"
|
||||
.fill 6
|
||||
.dw IPRIME
|
||||
.dw $-IPRIME
|
||||
.db 0
|
||||
J:
|
||||
.dw nativeWord
|
||||
@ -1529,7 +1556,7 @@ J:
|
||||
; ( a b -- c ) A + B
|
||||
.db "+"
|
||||
.fill 6
|
||||
.dw J
|
||||
.dw $-J
|
||||
.db 0
|
||||
PLUS:
|
||||
.dw nativeWord
|
||||
@ -1543,7 +1570,7 @@ PLUS:
|
||||
; ( a b -- c ) A - B
|
||||
.db "-"
|
||||
.fill 6
|
||||
.dw PLUS
|
||||
.dw $-PLUS
|
||||
.db 0
|
||||
MINUS:
|
||||
.dw nativeWord
|
||||
@ -1558,7 +1585,7 @@ MINUS:
|
||||
; ( a b -- c ) A * B
|
||||
.db "*"
|
||||
.fill 6
|
||||
.dw MINUS
|
||||
.dw $-MINUS
|
||||
.db 0
|
||||
MULT:
|
||||
.dw nativeWord
|
||||
@ -1585,7 +1612,7 @@ MULT:
|
||||
|
||||
.db "/MOD"
|
||||
.fill 3
|
||||
.dw MULT
|
||||
.dw $-MULT
|
||||
.db 0
|
||||
DIVMOD:
|
||||
.dw nativeWord
|
||||
@ -1600,7 +1627,7 @@ DIVMOD:
|
||||
|
||||
.db "AND"
|
||||
.fill 4
|
||||
.dw DIVMOD
|
||||
.dw $-DIVMOD
|
||||
.db 0
|
||||
AND:
|
||||
.dw nativeWord
|
||||
@ -1618,7 +1645,7 @@ AND:
|
||||
|
||||
.db "OR"
|
||||
.fill 5
|
||||
.dw AND
|
||||
.dw $-AND
|
||||
.db 0
|
||||
OR:
|
||||
.dw nativeWord
|
||||
@ -1636,7 +1663,7 @@ OR:
|
||||
|
||||
.db "XOR"
|
||||
.fill 4
|
||||
.dw OR
|
||||
.dw $-OR
|
||||
.db 0
|
||||
XOR:
|
||||
.dw nativeWord
|
||||
@ -1658,7 +1685,7 @@ XOR:
|
||||
|
||||
.db "0"
|
||||
.fill 6
|
||||
.dw XOR
|
||||
.dw $-XOR
|
||||
.db 0
|
||||
ZERO:
|
||||
.dw nativeWord
|
||||
@ -1668,7 +1695,7 @@ ZERO:
|
||||
|
||||
.db "1"
|
||||
.fill 6
|
||||
.dw ZERO
|
||||
.dw $-ZERO
|
||||
.db 0
|
||||
ONE:
|
||||
.dw nativeWord
|
||||
@ -1679,7 +1706,7 @@ ONE:
|
||||
; ( a1 a2 -- b )
|
||||
.db "SCMP"
|
||||
.fill 3
|
||||
.dw ONE
|
||||
.dw $-ONE
|
||||
.db 0
|
||||
SCMP:
|
||||
.dw nativeWord
|
||||
@ -1694,7 +1721,7 @@ SCMP:
|
||||
; ( n1 n2 -- f )
|
||||
.db "CMP"
|
||||
.fill 4
|
||||
.dw SCMP
|
||||
.dw $-SCMP
|
||||
.db 0
|
||||
CMP:
|
||||
.dw nativeWord
|
||||
@ -1712,7 +1739,7 @@ CMP:
|
||||
; to after null-termination.
|
||||
.db "SKIP?"
|
||||
.fill 2
|
||||
.dw CMP
|
||||
.dw $-CMP
|
||||
.db 0
|
||||
CSKIP:
|
||||
.dw nativeWord
|
||||
@ -1770,7 +1797,7 @@ CSKIP:
|
||||
; contain 3. Add this value to RS.
|
||||
.db "(fbr)"
|
||||
.fill 2
|
||||
.dw CSKIP
|
||||
.dw $-CSKIP
|
||||
.db 0
|
||||
FBR:
|
||||
.dw nativeWord
|
||||
@ -1784,7 +1811,7 @@ FBR:
|
||||
|
||||
.db "(bbr)"
|
||||
.fill 2
|
||||
.dw FBR
|
||||
.dw $-FBR
|
||||
.db 0
|
||||
BBR:
|
||||
.dw nativeWord
|
||||
@ -1796,5 +1823,11 @@ BBR:
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
; To allow dict binaries to "hook themselves up", we always end such binary
|
||||
; with a dummy, *empty* entry. Therefore, we can have a predictable place for
|
||||
; getting a prev label.
|
||||
|
||||
.db "_______"
|
||||
.dw $-BBR
|
||||
.db 0
|
||||
LATEST:
|
||||
.dw BBR
|
||||
|
||||
@ -1,12 +1,19 @@
|
||||
( Z80 assembler )
|
||||
|
||||
: CODE
|
||||
( same as CREATE, but with ROUTINE V )
|
||||
WORD (entry)
|
||||
ROUTINE V [LITN] ,
|
||||
;
|
||||
|
||||
( Splits word into msb/lsb, lsb being on TOS )
|
||||
: SPLITB
|
||||
DUP 0x100 /
|
||||
SWAP 0xff AND
|
||||
;
|
||||
|
||||
: A, .X ;
|
||||
( To debug, change C, to .X )
|
||||
: A, C, ;
|
||||
7 CONSTANT A
|
||||
0 CONSTANT B
|
||||
1 CONSTANT C
|
||||
@ -122,3 +129,4 @@
|
||||
|
||||
( Specials )
|
||||
: JRe, 0x18 A, 2 - A, ;
|
||||
: JPNEXT, ROUTINE N [LITN] JPnn, ;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user