mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 16:20:55 +11:00
Compare commits
No commits in common. "ffe61a12f8543cf4c2081dab219edee2b4827ae1" and "33e47d4938010a3f1ab2fb7e689035dec8e77805" have entirely different histories.
ffe61a12f8
...
33e47d4938
@ -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 high.fs z80a.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 RAMSTART ; override
|
||||
.equ LATEST CODE_END ; override
|
||||
.equ STDIO_PORT 0x00
|
||||
|
||||
jp init
|
||||
@ -26,6 +26,9 @@ emulPutC:
|
||||
out (STDIO_PORT), a
|
||||
ret
|
||||
|
||||
.out $ ; should be the same as in glue0
|
||||
.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:
|
||||
.bin "core.bin"
|
||||
RAMSTART:
|
||||
|
||||
@ -71,6 +71,9 @@ 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,9 +1,5 @@
|
||||
: 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
|
||||
@ -41,11 +37,6 @@
|
||||
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,10 +52,6 @@ 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",
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
( 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,10 +119,12 @@ forthMain:
|
||||
push af \ push af \ push af
|
||||
ld (INITIAL_SP), sp
|
||||
ld ix, RS_ADDR
|
||||
; 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
|
||||
; 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.
|
||||
ld hl, LATEST
|
||||
call intoHL
|
||||
ld (CURRENT), hl
|
||||
ld hl, HERE_INITIAL
|
||||
ld (HERE), hl
|
||||
@ -414,12 +416,9 @@ 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
|
||||
@ -430,21 +429,15 @@ 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 contains prev offset
|
||||
pop hl ; <-- lvl 1
|
||||
; HL is prev field's addr
|
||||
; Is offset zero?
|
||||
ld a, d
|
||||
ex de, hl ; de preserved by intoHL, so no push/pop needed
|
||||
; DE points to prev. Is it zero?
|
||||
xor a
|
||||
or d
|
||||
or e
|
||||
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
|
||||
; Z will be set if DE is zero
|
||||
ret
|
||||
|
||||
; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
|
||||
flagsToBC:
|
||||
@ -526,14 +519,11 @@ 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 offset
|
||||
; - 2b prev pointer
|
||||
; - 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".
|
||||
@ -652,7 +642,7 @@ EXIT:
|
||||
; ( R:I -- )
|
||||
.db "QUIT"
|
||||
.fill 3
|
||||
.dw $-EXIT
|
||||
.dw EXIT
|
||||
.db 0
|
||||
QUIT:
|
||||
.dw compiledWord
|
||||
@ -669,7 +659,7 @@ QUIT:
|
||||
|
||||
.db "ABORT"
|
||||
.fill 2
|
||||
.dw $-QUIT
|
||||
.dw QUIT
|
||||
.db 0
|
||||
ABORT:
|
||||
.dw compiledWord
|
||||
@ -695,7 +685,7 @@ abortUnderflow:
|
||||
|
||||
.db "BYE"
|
||||
.fill 4
|
||||
.dw $-ABORT
|
||||
.dw ABORT
|
||||
.db 0
|
||||
BYE:
|
||||
.dw nativeWord
|
||||
@ -710,7 +700,7 @@ BYE:
|
||||
; ( c -- )
|
||||
.db "EMIT"
|
||||
.fill 3
|
||||
.dw $-BYE
|
||||
.dw BYE
|
||||
.db 0
|
||||
EMIT:
|
||||
.dw nativeWord
|
||||
@ -721,7 +711,7 @@ EMIT:
|
||||
jp next
|
||||
|
||||
.db "(print)"
|
||||
.dw $-EMIT
|
||||
.dw EMIT
|
||||
.db 0
|
||||
PRINT:
|
||||
.dw nativeWord
|
||||
@ -738,7 +728,7 @@ PRINT:
|
||||
; ( c port -- )
|
||||
.db "PC!"
|
||||
.fill 4
|
||||
.dw $-PRINT
|
||||
.dw PRINT
|
||||
.db 0
|
||||
PSTORE:
|
||||
.dw nativeWord
|
||||
@ -751,7 +741,7 @@ PSTORE:
|
||||
; ( port -- c )
|
||||
.db "PC@"
|
||||
.fill 4
|
||||
.dw $-PSTORE
|
||||
.dw PSTORE
|
||||
.db 0
|
||||
PFETCH:
|
||||
.dw nativeWord
|
||||
@ -764,7 +754,7 @@ PFETCH:
|
||||
|
||||
.db "C,"
|
||||
.fill 5
|
||||
.dw $-PFETCH
|
||||
.dw PFETCH
|
||||
.db 0
|
||||
CWR:
|
||||
.dw nativeWord
|
||||
@ -779,7 +769,7 @@ CWR:
|
||||
|
||||
.db ","
|
||||
.fill 6
|
||||
.dw $-CWR
|
||||
.dw CWR
|
||||
.db 0
|
||||
WR:
|
||||
.dw nativeWord
|
||||
@ -791,63 +781,9 @@ 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 $-ROUTINE
|
||||
.dw WR
|
||||
.db 0
|
||||
EXECUTE:
|
||||
.dw nativeWord
|
||||
@ -864,7 +800,7 @@ EXECUTE:
|
||||
|
||||
.db ";"
|
||||
.fill 6
|
||||
.dw $-EXECUTE
|
||||
.dw EXECUTE
|
||||
.db 1 ; IMMEDIATE
|
||||
ENDDEF:
|
||||
.dw compiledWord
|
||||
@ -879,7 +815,7 @@ ENDDEF:
|
||||
|
||||
.db ":"
|
||||
.fill 6
|
||||
.dw $-ENDDEF
|
||||
.dw ENDDEF
|
||||
.db 1 ; IMMEDIATE
|
||||
DEFINE:
|
||||
.dw compiledWord
|
||||
@ -924,7 +860,7 @@ DEFINE:
|
||||
|
||||
.db "DOES>"
|
||||
.fill 2
|
||||
.dw $-DEFINE
|
||||
.dw DEFINE
|
||||
.db 0
|
||||
DOES:
|
||||
.dw nativeWord
|
||||
@ -945,7 +881,7 @@ DOES:
|
||||
|
||||
|
||||
.db "IMMEDIA"
|
||||
.dw $-DOES
|
||||
.dw DOES
|
||||
.db 0
|
||||
IMMEDIATE:
|
||||
.dw nativeWord
|
||||
@ -957,7 +893,7 @@ IMMEDIATE:
|
||||
|
||||
.db "IMMED?"
|
||||
.fill 1
|
||||
.dw $-IMMEDIATE
|
||||
.dw IMMEDIATE
|
||||
.db 0
|
||||
ISIMMED:
|
||||
.dw nativeWord
|
||||
@ -975,7 +911,7 @@ ISIMMED:
|
||||
; ( n -- )
|
||||
.db "LITN"
|
||||
.fill 3
|
||||
.dw $-ISIMMED
|
||||
.dw ISIMMED
|
||||
.db 0
|
||||
LITN:
|
||||
.dw nativeWord
|
||||
@ -990,7 +926,7 @@ LITN:
|
||||
|
||||
.db "SCPY"
|
||||
.fill 3
|
||||
.dw $-LITN
|
||||
.dw LITN
|
||||
.db 0
|
||||
SCPY:
|
||||
.dw nativeWord
|
||||
@ -1001,9 +937,41 @@ 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 $-SCPY
|
||||
.dw LITRD
|
||||
.db 0
|
||||
FIND_:
|
||||
.dw nativeWord
|
||||
@ -1023,7 +991,7 @@ FIND_:
|
||||
|
||||
.db "'"
|
||||
.fill 6
|
||||
.dw $-FIND_
|
||||
.dw FIND_
|
||||
.db 0
|
||||
FIND:
|
||||
.dw compiledWord
|
||||
@ -1035,7 +1003,7 @@ FIND:
|
||||
|
||||
.db "[']"
|
||||
.fill 4
|
||||
.dw $-FIND
|
||||
.dw FIND
|
||||
.db 0b01 ; IMMEDIATE
|
||||
FINDI:
|
||||
.dw compiledWord
|
||||
@ -1057,7 +1025,7 @@ FINDERR:
|
||||
; ( -- c )
|
||||
.db "KEY"
|
||||
.fill 4
|
||||
.dw $-FINDI
|
||||
.dw FINDI
|
||||
.db 0
|
||||
KEY:
|
||||
.dw nativeWord
|
||||
@ -1086,7 +1054,7 @@ CIN:
|
||||
; 32 CMP 1 -
|
||||
.db "WS?"
|
||||
.fill 4
|
||||
.dw $-KEY
|
||||
.dw KEY
|
||||
.db 0
|
||||
ISWS:
|
||||
.dw compiledWord
|
||||
@ -1100,7 +1068,7 @@ ISWS:
|
||||
|
||||
.db "NOT"
|
||||
.fill 4
|
||||
.dw $-ISWS
|
||||
.dw ISWS
|
||||
.db 0
|
||||
NOT:
|
||||
.dw nativeWord
|
||||
@ -1120,7 +1088,7 @@ NOT:
|
||||
; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
|
||||
.db "TOWORD"
|
||||
.fill 1
|
||||
.dw $-NOT
|
||||
.dw NOT
|
||||
.db 0
|
||||
TOWORD:
|
||||
.dw compiledWord
|
||||
@ -1137,7 +1105,7 @@ TOWORD:
|
||||
; HL point to WORDBUF.
|
||||
.db "WORD"
|
||||
.fill 3
|
||||
.dw $-TOWORD
|
||||
.dw TOWORD
|
||||
.db 0
|
||||
WORD:
|
||||
.dw compiledWord
|
||||
@ -1184,7 +1152,7 @@ WORD:
|
||||
|
||||
|
||||
.db "(parsed"
|
||||
.dw $-WORD
|
||||
.dw WORD
|
||||
.db 0
|
||||
PARSED:
|
||||
.dw nativeWord
|
||||
@ -1205,7 +1173,7 @@ PARSED:
|
||||
|
||||
|
||||
.db "(parse)"
|
||||
.dw $-PARSED
|
||||
.dw PARSED
|
||||
.db 0
|
||||
PARSE:
|
||||
.dw compiledWord
|
||||
@ -1234,9 +1202,6 @@ 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
|
||||
@ -1246,11 +1211,6 @@ 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
|
||||
@ -1261,6 +1221,19 @@ 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
|
||||
@ -1268,7 +1241,7 @@ ENTRYHEAD:
|
||||
; this word is not documented in dictionary.txt
|
||||
.db "(sysv)"
|
||||
.fill 1
|
||||
.dw $-ENTRYHEAD
|
||||
.dw CREATE
|
||||
.db 0
|
||||
SYSV:
|
||||
.dw compiledWord
|
||||
@ -1296,21 +1269,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
|
||||
@ -1318,7 +1291,7 @@ PARSEPTR_:
|
||||
|
||||
.db "FLAGS"
|
||||
.fill 2
|
||||
.dw $-PARSEPTR_
|
||||
.dw PARSEPTR_
|
||||
.db 0
|
||||
FLAGS_:
|
||||
.dw sysvarWord
|
||||
@ -1327,7 +1300,7 @@ FLAGS_:
|
||||
; ( n a -- )
|
||||
.db "!"
|
||||
.fill 6
|
||||
.dw $-FLAGS_
|
||||
.dw FLAGS_
|
||||
.db 0
|
||||
STORE:
|
||||
.dw nativeWord
|
||||
@ -1341,7 +1314,7 @@ STORE:
|
||||
; ( n a -- )
|
||||
.db "C!"
|
||||
.fill 5
|
||||
.dw $-STORE
|
||||
.dw STORE
|
||||
.db 0
|
||||
CSTORE:
|
||||
.dw nativeWord
|
||||
@ -1354,7 +1327,7 @@ CSTORE:
|
||||
; ( a -- n )
|
||||
.db "@"
|
||||
.fill 6
|
||||
.dw $-CSTORE
|
||||
.dw CSTORE
|
||||
.db 0
|
||||
FETCH:
|
||||
.dw nativeWord
|
||||
@ -1367,7 +1340,7 @@ FETCH:
|
||||
; ( a -- c )
|
||||
.db "C@"
|
||||
.fill 5
|
||||
.dw $-FETCH
|
||||
.dw FETCH
|
||||
.db 0
|
||||
CFETCH:
|
||||
.dw nativeWord
|
||||
@ -1381,7 +1354,7 @@ CFETCH:
|
||||
; ( a -- )
|
||||
.db "DROP"
|
||||
.fill 3
|
||||
.dw $-CFETCH
|
||||
.dw CFETCH
|
||||
.db 0
|
||||
DROP:
|
||||
.dw nativeWord
|
||||
@ -1391,7 +1364,7 @@ DROP:
|
||||
; ( a b -- b a )
|
||||
.db "SWAP"
|
||||
.fill 3
|
||||
.dw $-DROP
|
||||
.dw DROP
|
||||
.db 0
|
||||
SWAP:
|
||||
.dw nativeWord
|
||||
@ -1404,7 +1377,7 @@ SWAP:
|
||||
; ( a b c d -- c d a b )
|
||||
.db "2SWAP"
|
||||
.fill 2
|
||||
.dw $-SWAP
|
||||
.dw SWAP
|
||||
.db 0
|
||||
SWAP2:
|
||||
.dw nativeWord
|
||||
@ -1422,7 +1395,7 @@ SWAP2:
|
||||
; ( a -- a a )
|
||||
.db "DUP"
|
||||
.fill 4
|
||||
.dw $-SWAP2
|
||||
.dw SWAP2
|
||||
.db 0
|
||||
DUP:
|
||||
.dw nativeWord
|
||||
@ -1435,7 +1408,7 @@ DUP:
|
||||
; ( a b -- a b a b )
|
||||
.db "2DUP"
|
||||
.fill 3
|
||||
.dw $-DUP
|
||||
.dw DUP
|
||||
.db 0
|
||||
DUP2:
|
||||
.dw nativeWord
|
||||
@ -1451,7 +1424,7 @@ DUP2:
|
||||
; ( a b -- a b a )
|
||||
.db "OVER"
|
||||
.fill 3
|
||||
.dw $-DUP2
|
||||
.dw DUP2
|
||||
.db 0
|
||||
OVER:
|
||||
.dw nativeWord
|
||||
@ -1466,7 +1439,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
|
||||
@ -1486,7 +1459,7 @@ OVER2:
|
||||
; ( a b c -- b c a)
|
||||
.db "ROT"
|
||||
.fill 4
|
||||
.dw $-OVER2
|
||||
.dw OVER2
|
||||
.db 0
|
||||
ROT:
|
||||
.dw nativeWord
|
||||
@ -1501,7 +1474,7 @@ ROT:
|
||||
|
||||
.db ">R"
|
||||
.fill 5
|
||||
.dw $-ROT
|
||||
.dw ROT
|
||||
.db 0
|
||||
P2R:
|
||||
.dw nativeWord
|
||||
@ -1512,7 +1485,7 @@ P2R:
|
||||
|
||||
.db "R>"
|
||||
.fill 5
|
||||
.dw $-P2R
|
||||
.dw P2R
|
||||
.db 0
|
||||
R2P:
|
||||
.dw nativeWord
|
||||
@ -1522,7 +1495,7 @@ R2P:
|
||||
|
||||
.db "I"
|
||||
.fill 6
|
||||
.dw $-R2P
|
||||
.dw R2P
|
||||
.db 0
|
||||
I:
|
||||
.dw nativeWord
|
||||
@ -1533,7 +1506,7 @@ I:
|
||||
|
||||
.db "I'"
|
||||
.fill 5
|
||||
.dw $-I
|
||||
.dw I
|
||||
.db 0
|
||||
IPRIME:
|
||||
.dw nativeWord
|
||||
@ -1544,7 +1517,7 @@ IPRIME:
|
||||
|
||||
.db "J"
|
||||
.fill 6
|
||||
.dw $-IPRIME
|
||||
.dw IPRIME
|
||||
.db 0
|
||||
J:
|
||||
.dw nativeWord
|
||||
@ -1556,7 +1529,7 @@ J:
|
||||
; ( a b -- c ) A + B
|
||||
.db "+"
|
||||
.fill 6
|
||||
.dw $-J
|
||||
.dw J
|
||||
.db 0
|
||||
PLUS:
|
||||
.dw nativeWord
|
||||
@ -1570,7 +1543,7 @@ PLUS:
|
||||
; ( a b -- c ) A - B
|
||||
.db "-"
|
||||
.fill 6
|
||||
.dw $-PLUS
|
||||
.dw PLUS
|
||||
.db 0
|
||||
MINUS:
|
||||
.dw nativeWord
|
||||
@ -1585,7 +1558,7 @@ MINUS:
|
||||
; ( a b -- c ) A * B
|
||||
.db "*"
|
||||
.fill 6
|
||||
.dw $-MINUS
|
||||
.dw MINUS
|
||||
.db 0
|
||||
MULT:
|
||||
.dw nativeWord
|
||||
@ -1612,7 +1585,7 @@ MULT:
|
||||
|
||||
.db "/MOD"
|
||||
.fill 3
|
||||
.dw $-MULT
|
||||
.dw MULT
|
||||
.db 0
|
||||
DIVMOD:
|
||||
.dw nativeWord
|
||||
@ -1627,7 +1600,7 @@ DIVMOD:
|
||||
|
||||
.db "AND"
|
||||
.fill 4
|
||||
.dw $-DIVMOD
|
||||
.dw DIVMOD
|
||||
.db 0
|
||||
AND:
|
||||
.dw nativeWord
|
||||
@ -1645,7 +1618,7 @@ AND:
|
||||
|
||||
.db "OR"
|
||||
.fill 5
|
||||
.dw $-AND
|
||||
.dw AND
|
||||
.db 0
|
||||
OR:
|
||||
.dw nativeWord
|
||||
@ -1663,7 +1636,7 @@ OR:
|
||||
|
||||
.db "XOR"
|
||||
.fill 4
|
||||
.dw $-OR
|
||||
.dw OR
|
||||
.db 0
|
||||
XOR:
|
||||
.dw nativeWord
|
||||
@ -1685,7 +1658,7 @@ XOR:
|
||||
|
||||
.db "0"
|
||||
.fill 6
|
||||
.dw $-XOR
|
||||
.dw XOR
|
||||
.db 0
|
||||
ZERO:
|
||||
.dw nativeWord
|
||||
@ -1695,7 +1668,7 @@ ZERO:
|
||||
|
||||
.db "1"
|
||||
.fill 6
|
||||
.dw $-ZERO
|
||||
.dw ZERO
|
||||
.db 0
|
||||
ONE:
|
||||
.dw nativeWord
|
||||
@ -1706,7 +1679,7 @@ ONE:
|
||||
; ( a1 a2 -- b )
|
||||
.db "SCMP"
|
||||
.fill 3
|
||||
.dw $-ONE
|
||||
.dw ONE
|
||||
.db 0
|
||||
SCMP:
|
||||
.dw nativeWord
|
||||
@ -1721,7 +1694,7 @@ SCMP:
|
||||
; ( n1 n2 -- f )
|
||||
.db "CMP"
|
||||
.fill 4
|
||||
.dw $-SCMP
|
||||
.dw SCMP
|
||||
.db 0
|
||||
CMP:
|
||||
.dw nativeWord
|
||||
@ -1739,7 +1712,7 @@ CMP:
|
||||
; to after null-termination.
|
||||
.db "SKIP?"
|
||||
.fill 2
|
||||
.dw $-CMP
|
||||
.dw CMP
|
||||
.db 0
|
||||
CSKIP:
|
||||
.dw nativeWord
|
||||
@ -1797,7 +1770,7 @@ CSKIP:
|
||||
; contain 3. Add this value to RS.
|
||||
.db "(fbr)"
|
||||
.fill 2
|
||||
.dw $-CSKIP
|
||||
.dw CSKIP
|
||||
.db 0
|
||||
FBR:
|
||||
.dw nativeWord
|
||||
@ -1811,7 +1784,7 @@ FBR:
|
||||
|
||||
.db "(bbr)"
|
||||
.fill 2
|
||||
.dw $-FBR
|
||||
.dw FBR
|
||||
.db 0
|
||||
BBR:
|
||||
.dw nativeWord
|
||||
@ -1823,11 +1796,5 @@ 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,19 +1,12 @@
|
||||
( 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
|
||||
;
|
||||
|
||||
( To debug, change C, to .X )
|
||||
: A, C, ;
|
||||
: A, .X ;
|
||||
7 CONSTANT A
|
||||
0 CONSTANT B
|
||||
1 CONSTANT C
|
||||
@ -129,4 +122,3 @@
|
||||
|
||||
( Specials )
|
||||
: JRe, 0x18 A, 2 - A, ;
|
||||
: JPNEXT, ROUTINE N [LITN] JPnn, ;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user