mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:30:55 +11:00
Compare commits
10 Commits
61195a987d
...
031bfc6d72
Author | SHA1 | Date | |
---|---|---|---|
|
031bfc6d72 | ||
|
e5ab0dd1c9 | ||
|
5c03b33982 | ||
|
05045b2aa4 | ||
|
f366732424 | ||
|
36e200adbb | ||
|
5b01f797fc | ||
|
de3da19333 | ||
|
4756fb7763 | ||
|
80985460d4 |
@ -29,7 +29,7 @@ trouble of compiling defs to binary.
|
|||||||
|
|
||||||
//#define DEBUG
|
//#define DEBUG
|
||||||
// in sync with glue.asm
|
// in sync with glue.asm
|
||||||
#define RAMSTART 0x890
|
#define RAMSTART 0x840
|
||||||
#define STDIO_PORT 0x00
|
#define STDIO_PORT 0x00
|
||||||
// To know which part of RAM to dump, we listen to port 2, which at the end of
|
// To know which part of RAM to dump, we listen to port 2, which at the end of
|
||||||
// its compilation process, spits its HERE addr to port 2 (MSB first)
|
// its compilation process, spits its HERE addr to port 2 (MSB first)
|
||||||
|
Binary file not shown.
@ -2,7 +2,7 @@
|
|||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
|
||||||
: ] R> DROP ;
|
: ] R> DROP ;
|
||||||
: LIT JTBL 26 + , ;
|
: LIT 34 , ;
|
||||||
: LITS LIT SCPY ;
|
: LITS LIT SCPY ;
|
||||||
: LIT< WORD LITS ; IMMEDIATE
|
: LIT< WORD LITS ; IMMEDIATE
|
||||||
: _err LIT< word-not-found (print) ABORT ;
|
: _err LIT< word-not-found (print) ABORT ;
|
||||||
@ -22,6 +22,7 @@
|
|||||||
"_": words starting with "_" are meant to be "private",
|
"_": words starting with "_" are meant to be "private",
|
||||||
that is, only used by their immediate surrondings.
|
that is, only used by their immediate surrondings.
|
||||||
|
|
||||||
|
LIT: 34 == LIT
|
||||||
COMPILE: Tough one. Get addr of caller word (example above
|
COMPILE: Tough one. Get addr of caller word (example above
|
||||||
(br)) and then call LITN on it. )
|
(br)) and then call LITN on it. )
|
||||||
|
|
||||||
@ -49,11 +50,33 @@
|
|||||||
|
|
||||||
: CREATE
|
: CREATE
|
||||||
(entry) ( empty header with name )
|
(entry) ( empty header with name )
|
||||||
[ JTBL 3 + LITN ] ( push cellWord addr )
|
11 ( 11 == cellWord )
|
||||||
, ( write it )
|
, ( write it )
|
||||||
;
|
;
|
||||||
|
|
||||||
|
( We run this when we're in an entry creation context. Many
|
||||||
|
things we need to do.
|
||||||
|
1. Change the code link to doesWord
|
||||||
|
2. Leave 2 bytes for regular cell variable.
|
||||||
|
3. Write down RS' RTOS to entry.
|
||||||
|
4. exit parent definition
|
||||||
|
)
|
||||||
|
: DOES>
|
||||||
|
( Overwrite cellWord in CURRENT )
|
||||||
|
( 63 == doesWord )
|
||||||
|
63 CURRENT @ !
|
||||||
|
( When we have a DOES>, we forcefully place HERE to 4
|
||||||
|
bytes after CURRENT. This allows a DOES word to use ","
|
||||||
|
and "C," without messing everything up. )
|
||||||
|
CURRENT @ 4 + HERE !
|
||||||
|
( HERE points to where we should write R> )
|
||||||
|
R> ,
|
||||||
|
( We're done. Because we've popped RS, we'll exit parent
|
||||||
|
definition )
|
||||||
|
;
|
||||||
|
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
: CONSTANT CREATE H@ ! DOES> @ ;
|
: CONSTANT CREATE , DOES> @ ;
|
||||||
: = CMP NOT ;
|
: = CMP NOT ;
|
||||||
: < CMP 0 1 - = ;
|
: < CMP 0 1 - = ;
|
||||||
: > CMP 1 = ;
|
: > CMP 1 = ;
|
||||||
@ -85,17 +108,18 @@
|
|||||||
in dictionary.txt )
|
in dictionary.txt )
|
||||||
|
|
||||||
: (sysv)
|
: (sysv)
|
||||||
(entry)
|
|
||||||
( JTBL+0 == sysvarWord )
|
|
||||||
[ JTBL LITN ] ,
|
|
||||||
( JTBL+42 == SYSVNXT )
|
|
||||||
[ JTBL 42 + @ LITN ] DUP ( a a )
|
|
||||||
( Get new sysv addr )
|
( Get new sysv addr )
|
||||||
@ , ( a )
|
( 50 == SYSVNXT )
|
||||||
|
50 @ @
|
||||||
|
CONSTANT
|
||||||
( increase current sysv counter )
|
( increase current sysv counter )
|
||||||
2 SWAP +!
|
2 50 @ +!
|
||||||
;
|
;
|
||||||
|
|
||||||
|
( Set up initial SYSVNXT value, which is 2 bytes after its
|
||||||
|
own address )
|
||||||
|
50 @ DUP 2 + SWAP !
|
||||||
|
|
||||||
: ."
|
: ."
|
||||||
LIT
|
LIT
|
||||||
BEGIN
|
BEGIN
|
||||||
|
503
forth/forth.asm
503
forth/forth.asm
@ -1,34 +1,5 @@
|
|||||||
; Collapse OS' Forth
|
; Collapse OS Forth's boot binary
|
||||||
;
|
|
||||||
; Unlike other assembler parts of Collapse OS, this unit is one huge file.
|
|
||||||
;
|
|
||||||
; I do this because as Forth takes a bigger place, assembler is bound to take
|
|
||||||
; less and less place. I am thus consolidating that assembler code in one
|
|
||||||
; place so that I have a better visibility of what to minimize.
|
|
||||||
;
|
|
||||||
; I also want to reduce the featureset of the assembler so that Collapse OS
|
|
||||||
; self-hosts in a more compact manner. File include is a big part of the
|
|
||||||
; complexity in zasm. If we can get rid of it, we'll be more compact.
|
|
||||||
|
|
||||||
; *** ABI STABILITY ***
|
|
||||||
;
|
|
||||||
; This unit needs to have some of its entry points stay at a stable offset.
|
|
||||||
; These have a comment over them indicating the expected offset. These should
|
|
||||||
; not move until the Grand Bootstrapping operation has been completed.
|
|
||||||
;
|
|
||||||
; When you see random ".fill" here and there, it's to ensure that stability.
|
|
||||||
|
|
||||||
; *** Defines ***
|
|
||||||
; GETC: address of a GetC routine
|
|
||||||
; PUTC: address of a PutC routine
|
|
||||||
;
|
|
||||||
; Those GetC/PutC routines are hooked through defines and have this API:
|
|
||||||
;
|
|
||||||
; GetC: Blocks until a character is read from the device and return that
|
|
||||||
; character in A.
|
|
||||||
;
|
|
||||||
; PutC: Write character specified in A onto the device.
|
|
||||||
;
|
|
||||||
; *** Const ***
|
; *** Const ***
|
||||||
; Base of the Return Stack
|
; Base of the Return Stack
|
||||||
.equ RS_ADDR 0xf000
|
.equ RS_ADDR 0xf000
|
||||||
@ -65,49 +36,25 @@
|
|||||||
; that we can't compile a regular variable in it. SYSVNXT points to the next
|
; that we can't compile a regular variable in it. SYSVNXT points to the next
|
||||||
; free space in SYSVBUF. Then, at the word level, it's a regular sysvarWord.
|
; free space in SYSVBUF. Then, at the word level, it's a regular sysvarWord.
|
||||||
.equ SYSVNXT @+WORD_BUFSIZE
|
.equ SYSVNXT @+WORD_BUFSIZE
|
||||||
.equ SYSVBUF @+2
|
.equ RAMEND @+SYSV_BUFSIZE+2
|
||||||
.equ RAMEND @+SYSV_BUFSIZE
|
|
||||||
|
|
||||||
; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0,
|
; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0,
|
||||||
; (HERE) will begin at a strategic place.
|
; (HERE) will begin at a strategic place.
|
||||||
.equ HERE_INITIAL RAMEND
|
.equ HERE_INITIAL RAMEND
|
||||||
|
|
||||||
; EXECUTION MODEL
|
|
||||||
; After having read a line through readline, we want to interpret it. As
|
|
||||||
; a general rule, we go like this:
|
|
||||||
;
|
|
||||||
; 1. read single word from line
|
|
||||||
; 2. Can we find the word in dict?
|
|
||||||
; 3. If yes, execute that word, goto 1
|
|
||||||
; 4. Is it a number?
|
|
||||||
; 5. If yes, push that number to PS, goto 1
|
|
||||||
; 6. Error: undefined word.
|
|
||||||
;
|
|
||||||
; EXECUTING A WORD
|
|
||||||
;
|
|
||||||
; At it's core, executing a word is having the wordref in IY and call
|
|
||||||
; EXECUTE. Then, we let the word do its things. Some words are special,
|
|
||||||
; but most of them are of the compiledWord type, and that's their execution that
|
|
||||||
; we describe here.
|
|
||||||
;
|
|
||||||
; First of all, at all time during execution, the Interpreter Pointer (IP)
|
|
||||||
; points to the wordref we're executing next.
|
|
||||||
;
|
|
||||||
; When we execute a compiledWord, the first thing we do is push IP to the Return
|
|
||||||
; Stack (RS). Therefore, RS' top of stack will contain a wordref to execute
|
|
||||||
; next, after we EXIT.
|
|
||||||
;
|
|
||||||
; At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
|
|
||||||
; continues.
|
|
||||||
|
|
||||||
; *** Stable ABI ***
|
; *** Stable ABI ***
|
||||||
; Those jumps below are supposed to stay at these offsets, always. If they
|
; Those jumps below are supposed to stay at these offsets, always. If they
|
||||||
; change bootstrap binaries have to be adjusted because they rely on them.
|
; change bootstrap binaries have to be adjusted because they rely on them.
|
||||||
|
; Those entries are referenced directly by their offset in Forth code with a
|
||||||
|
; comment indicating what that number refers to.
|
||||||
|
;
|
||||||
; We're at 0 here
|
; We're at 0 here
|
||||||
jp forthMain
|
jp forthMain
|
||||||
.fill 0x08-$
|
; 3
|
||||||
JUMPTBL:
|
jp find
|
||||||
jp sysvarWord
|
nop \ nop ; unused
|
||||||
|
nop \ nop \ nop ; unused
|
||||||
|
; 11
|
||||||
jp cellWord
|
jp cellWord
|
||||||
jp compiledWord
|
jp compiledWord
|
||||||
jp pushRS
|
jp pushRS
|
||||||
@ -115,26 +62,105 @@ JUMPTBL:
|
|||||||
jp nativeWord
|
jp nativeWord
|
||||||
jp next
|
jp next
|
||||||
jp chkPS
|
jp chkPS
|
||||||
; 24
|
; 32
|
||||||
NUMBER:
|
|
||||||
.dw numberWord
|
.dw numberWord
|
||||||
LIT:
|
|
||||||
.dw litWord
|
.dw litWord
|
||||||
.dw INITIAL_SP
|
.dw INITIAL_SP
|
||||||
.dw WORDBUF
|
.dw WORDBUF
|
||||||
jp flagsToBC
|
jp flagsToBC
|
||||||
; 35
|
; 43
|
||||||
jp strcmp
|
jp strcmp
|
||||||
.dw RS_ADDR
|
.dw RS_ADDR
|
||||||
.dw CINPTR
|
.dw CINPTR
|
||||||
.dw SYSVNXT
|
.dw SYSVNXT
|
||||||
.dw FLAGS
|
.dw FLAGS
|
||||||
; 46
|
; 54
|
||||||
.dw PARSEPTR
|
.dw PARSEPTR
|
||||||
.dw HERE
|
.dw HERE
|
||||||
.dw CURRENT
|
.dw CURRENT
|
||||||
|
jp parseDecimal
|
||||||
|
jp doesWord
|
||||||
|
|
||||||
|
; *** Boot dict ***
|
||||||
|
; There are only 5 words in the boot dict, but these words' offset need to be
|
||||||
|
; stable, so they're part of the "stable ABI"
|
||||||
|
|
||||||
|
; Pop previous IP from Return stack and execute it.
|
||||||
|
; ( R:I -- )
|
||||||
|
.db "EXIT"
|
||||||
|
.dw 0
|
||||||
|
.db 4
|
||||||
|
EXIT:
|
||||||
|
.dw nativeWord
|
||||||
|
call popRSIP
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "(br)"
|
||||||
|
.dw $-EXIT
|
||||||
|
.db 4
|
||||||
|
BR:
|
||||||
|
.dw nativeWord
|
||||||
|
ld hl, (IP)
|
||||||
|
ld e, (hl)
|
||||||
|
inc hl
|
||||||
|
ld d, (hl)
|
||||||
|
dec hl
|
||||||
|
add hl, de
|
||||||
|
ld (IP), hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "(?br)"
|
||||||
|
.dw $-BR
|
||||||
|
.db 5
|
||||||
|
CBR:
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl
|
||||||
|
call chkPS
|
||||||
|
ld a, h
|
||||||
|
or l
|
||||||
|
jr z, BR+2 ; False, branch
|
||||||
|
; True, skip next 2 bytes and don't branch
|
||||||
|
ld hl, (IP)
|
||||||
|
inc hl
|
||||||
|
inc hl
|
||||||
|
ld (IP), hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db ","
|
||||||
|
.dw $-CBR
|
||||||
|
.db 1
|
||||||
|
WR:
|
||||||
|
.dw nativeWord
|
||||||
|
pop de
|
||||||
|
call chkPS
|
||||||
|
ld hl, (HERE)
|
||||||
|
ld (hl), e
|
||||||
|
inc hl
|
||||||
|
ld (hl), d
|
||||||
|
inc hl
|
||||||
|
ld (HERE), hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
; ( addr -- )
|
||||||
|
.db "EXECUTE"
|
||||||
|
.dw $-WR
|
||||||
|
.db 7
|
||||||
|
EXECUTE:
|
||||||
|
.dw nativeWord
|
||||||
|
pop iy ; is a wordref
|
||||||
|
call chkPS
|
||||||
|
ld l, (iy)
|
||||||
|
ld h, (iy+1)
|
||||||
|
; HL points to code pointer
|
||||||
|
inc iy
|
||||||
|
inc iy
|
||||||
|
; IY points to PFA
|
||||||
|
jp (hl) ; go!
|
||||||
|
|
||||||
|
; Offset: 00b8
|
||||||
|
.out $
|
||||||
|
; *** End of stable ABI ***
|
||||||
|
|
||||||
; *** Code ***
|
|
||||||
forthMain:
|
forthMain:
|
||||||
; STACK OVERFLOW PROTECTION:
|
; STACK OVERFLOW PROTECTION:
|
||||||
; To avoid having to check for stack underflow after each pop operation
|
; To avoid having to check for stack underflow after each pop operation
|
||||||
@ -152,9 +178,6 @@ forthMain:
|
|||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld hl, HERE_INITIAL
|
ld hl, HERE_INITIAL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
; Set up SYSVNXT
|
|
||||||
ld hl, SYSVBUF
|
|
||||||
ld (SYSVNXT), hl
|
|
||||||
ld hl, .bootName
|
ld hl, .bootName
|
||||||
call find
|
call find
|
||||||
push de
|
push de
|
||||||
@ -163,48 +186,6 @@ forthMain:
|
|||||||
.bootName:
|
.bootName:
|
||||||
.db "BOOT", 0
|
.db "BOOT", 0
|
||||||
|
|
||||||
.fill 101
|
|
||||||
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 00cd
|
|
||||||
.out $
|
|
||||||
; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
|
|
||||||
; ld must be done little endian, so least significant byte first.
|
|
||||||
intoHL:
|
|
||||||
push de
|
|
||||||
ld e, (hl)
|
|
||||||
inc hl
|
|
||||||
ld d, (hl)
|
|
||||||
ex de, hl
|
|
||||||
pop de
|
|
||||||
ret
|
|
||||||
|
|
||||||
; add the value of A into HL
|
|
||||||
; affects carry flag according to the 16-bit addition, Z, S and P untouched.
|
|
||||||
addHL:
|
|
||||||
push de
|
|
||||||
ld d, 0
|
|
||||||
ld e, a
|
|
||||||
add hl, de
|
|
||||||
pop de
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Copy string from (HL) in (DE), that is, copy bytes until a null char is
|
|
||||||
; encountered. The null char is also copied.
|
|
||||||
; HL and DE point to the char right after the null char.
|
|
||||||
; B indicates the length of the copied string, including null-termination.
|
|
||||||
strcpy:
|
|
||||||
ld b, 0
|
|
||||||
.loop:
|
|
||||||
ld a, (hl)
|
|
||||||
ld (de), a
|
|
||||||
inc hl
|
|
||||||
inc de
|
|
||||||
inc b
|
|
||||||
or a
|
|
||||||
jr nz, .loop
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Compares strings pointed to by HL and DE until one of them hits its null char.
|
; Compares strings pointed to by HL and DE until one of them hits its null char.
|
||||||
; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
|
; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
|
||||||
strcmp:
|
strcmp:
|
||||||
@ -229,19 +210,6 @@ strcmp:
|
|||||||
; early, set otherwise)
|
; early, set otherwise)
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Given a string at (HL), move HL until it points to the end of that string.
|
|
||||||
strskip:
|
|
||||||
push bc
|
|
||||||
ex af, af'
|
|
||||||
xor a ; look for null char
|
|
||||||
ld b, a
|
|
||||||
ld c, a
|
|
||||||
cpir ; advances HL regardless of comparison, so goes one too far
|
|
||||||
dec hl
|
|
||||||
ex af, af'
|
|
||||||
pop bc
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Parse string at (HL) as a decimal value and return value in DE.
|
; Parse string at (HL) as a decimal value and return value in DE.
|
||||||
; Reads as many digits as it can and stop when:
|
; Reads as many digits as it can and stop when:
|
||||||
; 1 - A non-digit character is read
|
; 1 - A non-digit character is read
|
||||||
@ -323,7 +291,6 @@ parseDecimal:
|
|||||||
xor a ; set Z
|
xor a ; set Z
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; *** Support routines ***
|
|
||||||
; Find the entry corresponding to word where (HL) points to and sets DE to
|
; Find the entry corresponding to word where (HL) points to and sets DE to
|
||||||
; point to that entry.
|
; point to that entry.
|
||||||
; Z if found, NZ if not.
|
; Z if found, NZ if not.
|
||||||
@ -381,8 +348,10 @@ find:
|
|||||||
dec de \ dec de \ dec de ; prev field
|
dec de \ dec de \ dec de ; prev field
|
||||||
push de ; --> lvl 2
|
push de ; --> lvl 2
|
||||||
ex de, hl
|
ex de, hl
|
||||||
call intoHL
|
ld e, (hl)
|
||||||
ex de, hl ; DE contains prev offset
|
inc hl
|
||||||
|
ld d, (hl)
|
||||||
|
; DE contains prev offset
|
||||||
pop hl ; <-- lvl 2
|
pop hl ; <-- lvl 2
|
||||||
; HL is prev field's addr
|
; HL is prev field's addr
|
||||||
; Is offset zero?
|
; Is offset zero?
|
||||||
@ -416,26 +385,6 @@ flagsToBC:
|
|||||||
dec bc
|
dec bc
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Write DE in (HL), advancing HL by 2.
|
|
||||||
DEinHL:
|
|
||||||
ld (hl), e
|
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
ret
|
|
||||||
|
|
||||||
; *** Stack management ***
|
|
||||||
; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
|
|
||||||
; maintained by IX. This allows us to generally use push and pop freely because
|
|
||||||
; PS is the most frequently used. However, this causes a problem with routine
|
|
||||||
; calls: because in Forth, the stack isn't balanced within each call, our return
|
|
||||||
; offset, when placed by a CALL, messes everything up. This is one of the
|
|
||||||
; reasons why we need stack management routines below. IX always points to RS'
|
|
||||||
; Top Of Stack (TOS)
|
|
||||||
;
|
|
||||||
; This return stack contain "Interpreter pointers", that is a pointer to the
|
|
||||||
; address of a word, as seen in a compiled list of words.
|
|
||||||
|
|
||||||
; Push value HL to RS
|
; Push value HL to RS
|
||||||
pushRS:
|
pushRS:
|
||||||
inc ix
|
inc ix
|
||||||
@ -481,30 +430,13 @@ chkPS:
|
|||||||
ret nc ; (INITIAL_SP) >= SP? good
|
ret nc ; (INITIAL_SP) >= SP? good
|
||||||
jp abortUnderflow
|
jp abortUnderflow
|
||||||
|
|
||||||
; *** Dictionary ***
|
abortUnderflow:
|
||||||
; It's important that this part is at the end of the resulting binary.
|
ld hl, .name
|
||||||
; A dictionary entry has this structure:
|
call find
|
||||||
; - Xb name. Arbitrary long number of character (but can't be bigger than
|
push de
|
||||||
; input buffer, of course). not null-terminated
|
jp EXECUTE+2
|
||||||
; - 2b prev offset
|
.name:
|
||||||
; - 1b size + IMMEDIATE flag
|
.db "(uflw)", 0
|
||||||
; - 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 size + flag indicate the size of the name field, with the 7th bit
|
|
||||||
; being the IMMEDIATE flag.
|
|
||||||
;
|
|
||||||
; 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".
|
|
||||||
;
|
|
||||||
; That's for "regular" words (words that are part of the dict chain). There are
|
|
||||||
; also "special words", for example NUMBER, LIT, FBR, that have a slightly
|
|
||||||
; different structure. They're also a pointer to an executable, but as for the
|
|
||||||
; other fields, the only one they have is the "flags" field.
|
|
||||||
|
|
||||||
; This routine is jumped to at the end of every word. In it, we jump to current
|
; This routine is jumped to at the end of every word. In it, we jump to current
|
||||||
; IP, but we also take care of increasing it my 2 before jumping
|
; IP, but we also take care of increasing it my 2 before jumping
|
||||||
@ -525,6 +457,8 @@ next:
|
|||||||
jp EXECUTE+2
|
jp EXECUTE+2
|
||||||
|
|
||||||
|
|
||||||
|
; *** Word routines ***
|
||||||
|
|
||||||
; Execute a word containing native code at its PF address (PFA)
|
; Execute a word containing native code at its PF address (PFA)
|
||||||
nativeWord:
|
nativeWord:
|
||||||
jp (iy)
|
jp (iy)
|
||||||
@ -552,13 +486,6 @@ cellWord:
|
|||||||
push iy
|
push iy
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; Pushes the address in the first word of the PF
|
|
||||||
sysvarWord:
|
|
||||||
ld l, (iy)
|
|
||||||
ld h, (iy+1)
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; The word was spawned from a definition word that has a DOES>. PFA+2 (right
|
; The word was spawned from a definition word that has a DOES>. PFA+2 (right
|
||||||
; after the actual cell) is a link to the slot right after that DOES>.
|
; after the actual cell) is a link to the slot right after that DOES>.
|
||||||
; Therefore, what we need to do push the cell addr like a regular cell, then
|
; Therefore, what we need to do push the cell addr like a regular cell, then
|
||||||
@ -590,206 +517,26 @@ numberWord:
|
|||||||
litWord:
|
litWord:
|
||||||
ld hl, (IP)
|
ld hl, (IP)
|
||||||
push hl
|
push hl
|
||||||
call strskip
|
; Skip to null char
|
||||||
inc hl ; after null termination
|
xor a ; look for null char
|
||||||
|
ld b, a
|
||||||
|
ld c, a
|
||||||
|
cpir
|
||||||
|
; CPIR advances HL regardless of comparison, so goes one char after
|
||||||
|
; NULL. This is good, because that's what we want...
|
||||||
ld (IP), hl
|
ld (IP), hl
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; Pop previous IP from Return stack and execute it.
|
.fill 6
|
||||||
; ( R:I -- )
|
; *** Dict hook ***
|
||||||
.db "EXIT"
|
; This dummy dictionary entry serves two purposes:
|
||||||
.dw 0
|
; 1. Allow binary grafting. Because each binary dict always end with a dummy
|
||||||
.db 4
|
; entry, we always have a predictable prev offset for the grafter's first
|
||||||
EXIT:
|
; entry.
|
||||||
.dw nativeWord
|
; 2. Tell icore's "_c" routine where the boot binary ends. See comment there.
|
||||||
call popRSIP
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 30
|
|
||||||
|
|
||||||
abortUnderflow:
|
|
||||||
ld hl, .name
|
|
||||||
call find
|
|
||||||
push de
|
|
||||||
jp EXECUTE+2
|
|
||||||
.name:
|
|
||||||
.db "(uflw)", 0
|
|
||||||
|
|
||||||
.db "(br)"
|
|
||||||
.dw $-EXIT
|
|
||||||
.db 4
|
|
||||||
BR:
|
|
||||||
.dw nativeWord
|
|
||||||
ld hl, (IP)
|
|
||||||
ld e, (hl)
|
|
||||||
inc hl
|
|
||||||
ld d, (hl)
|
|
||||||
dec hl
|
|
||||||
add hl, de
|
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 72
|
|
||||||
|
|
||||||
.db "(?br)"
|
|
||||||
.dw $-BR
|
|
||||||
.db 5
|
|
||||||
CBR:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ld a, h
|
|
||||||
or l
|
|
||||||
jp z, BR+2 ; False, branch
|
|
||||||
; True, skip next 2 bytes and don't branch
|
|
||||||
ld hl, (IP)
|
|
||||||
inc hl
|
|
||||||
inc hl
|
|
||||||
ld (IP), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 15
|
|
||||||
|
|
||||||
.db ","
|
|
||||||
.dw $-CBR
|
|
||||||
.db 1
|
|
||||||
WR:
|
|
||||||
.dw nativeWord
|
|
||||||
pop de
|
|
||||||
call chkPS
|
|
||||||
ld hl, (HERE)
|
|
||||||
call DEinHL
|
|
||||||
ld (HERE), hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 100
|
|
||||||
|
|
||||||
; ( addr -- )
|
|
||||||
.db "EXECUTE"
|
|
||||||
.dw $-WR
|
|
||||||
.db 7
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 0388
|
|
||||||
.out $
|
|
||||||
EXECUTE:
|
|
||||||
.dw nativeWord
|
|
||||||
pop iy ; is a wordref
|
|
||||||
call chkPS
|
|
||||||
ld l, (iy)
|
|
||||||
ld h, (iy+1)
|
|
||||||
; HL points to code pointer
|
|
||||||
inc iy
|
|
||||||
inc iy
|
|
||||||
; IY points to PFA
|
|
||||||
jp (hl) ; go!
|
|
||||||
|
|
||||||
|
|
||||||
.fill 77
|
|
||||||
|
|
||||||
.db "DOES>"
|
|
||||||
.dw $-EXECUTE
|
|
||||||
.db 5
|
|
||||||
DOES:
|
|
||||||
.dw nativeWord
|
|
||||||
; We run this when we're in an entry creation context. Many things we
|
|
||||||
; need to do.
|
|
||||||
; 1. Change the code link to doesWord
|
|
||||||
; 2. Leave 2 bytes for regular cell variable.
|
|
||||||
; 3. Write down IP+2 to entry.
|
|
||||||
; 3. exit. we're done here.
|
|
||||||
ld hl, (CURRENT)
|
|
||||||
ld de, doesWord
|
|
||||||
call DEinHL
|
|
||||||
inc hl \ inc hl ; cell variable space
|
|
||||||
ld de, (IP)
|
|
||||||
call DEinHL
|
|
||||||
ld (HERE), hl
|
|
||||||
jp EXIT+2
|
|
||||||
|
|
||||||
|
|
||||||
.fill 82
|
|
||||||
|
|
||||||
.db "SCPY"
|
|
||||||
.dw $-DOES
|
|
||||||
.db 4
|
|
||||||
SCPY:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
ld de, (HERE)
|
|
||||||
call strcpy
|
|
||||||
ld (HERE), de
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
.db "(find)"
|
|
||||||
.dw $-SCPY
|
|
||||||
.db 6
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 047c
|
|
||||||
.out $
|
|
||||||
FIND_:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call find
|
|
||||||
jr z, .found
|
|
||||||
; not found
|
|
||||||
push hl
|
|
||||||
ld de, 0
|
|
||||||
push de
|
|
||||||
jp next
|
|
||||||
.found:
|
|
||||||
push de
|
|
||||||
ld de, 1
|
|
||||||
push de
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 41
|
|
||||||
|
|
||||||
.db "NOT"
|
|
||||||
.dw $-FIND_
|
|
||||||
.db 3
|
|
||||||
NOT:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ld a, l
|
|
||||||
or h
|
|
||||||
ld hl, 0
|
|
||||||
jr nz, .skip ; true, keep at 0
|
|
||||||
; false, make 1
|
|
||||||
inc hl
|
|
||||||
.skip:
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
.fill 100
|
|
||||||
|
|
||||||
.db "(parsed)"
|
|
||||||
.dw $-NOT
|
|
||||||
.db 8
|
|
||||||
PARSED:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
call parseDecimal
|
|
||||||
jr z, .success
|
|
||||||
; error
|
|
||||||
ld de, 0
|
|
||||||
push de ; dummy
|
|
||||||
push de ; flag
|
|
||||||
jp next
|
|
||||||
.success:
|
|
||||||
push de
|
|
||||||
ld de, 1 ; flag
|
|
||||||
push de
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
.fill 224
|
|
||||||
|
|
||||||
.db "_bend"
|
.db "_bend"
|
||||||
.dw $-PARSED
|
.dw $-EXECUTE
|
||||||
.db 5
|
.db 5
|
||||||
; Offset: 0647
|
|
||||||
|
; Offset: 0237
|
||||||
.out $
|
.out $
|
||||||
|
@ -55,31 +55,29 @@
|
|||||||
, ( write! )
|
, ( write! )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: JTBL 0x08 ;
|
|
||||||
|
|
||||||
: FLAGS
|
: FLAGS
|
||||||
( JTBL+44 == FLAGS )
|
( 52 == FLAGS )
|
||||||
[ JTBL 44 + @ LITN ]
|
[ 52 @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: (parse*)
|
: (parse*)
|
||||||
( JTBL+46 == PARSEPTR )
|
( 54 == PARSEPTR )
|
||||||
[ JTBL 46 + @ LITN ]
|
[ 54 @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: HERE
|
: HERE
|
||||||
( JTBL+48 == HERE )
|
( 56 == HERE )
|
||||||
[ JTBL 48 + @ LITN ]
|
[ 56 @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: CURRENT
|
: CURRENT
|
||||||
( JTBL+50 == CURRENT )
|
( 58 == CURRENT )
|
||||||
[ JTBL 50 + @ LITN ]
|
[ 58 @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: QUIT
|
: QUIT
|
||||||
0 _c FLAGS _c ! _c (resRS)
|
0 _c FLAGS _c ! _c (resRS)
|
||||||
LIT< INTERPRET (find) _c DROP EXECUTE
|
LIT< INTERPRET _c (find) _c DROP EXECUTE
|
||||||
;
|
;
|
||||||
|
|
||||||
: ABORT _c (resSP) _c QUIT ;
|
: ABORT _c (resSP) _c QUIT ;
|
||||||
@ -87,7 +85,7 @@
|
|||||||
( This is only the "early parser" in earlier stages. No need
|
( This is only the "early parser" in earlier stages. No need
|
||||||
for an abort message )
|
for an abort message )
|
||||||
: (parse)
|
: (parse)
|
||||||
(parsed) NOT IF _c ABORT THEN
|
_c (parsed) _c NOT IF _c ABORT THEN
|
||||||
;
|
;
|
||||||
|
|
||||||
( a -- )
|
( a -- )
|
||||||
@ -96,7 +94,7 @@
|
|||||||
_c DUP ( a a )
|
_c DUP ( a a )
|
||||||
_c C@ ( a c )
|
_c C@ ( a c )
|
||||||
( exit if null )
|
( exit if null )
|
||||||
_c DUP NOT IF _c 2DROP EXIT THEN
|
_c DUP _c NOT IF _c 2DROP EXIT THEN
|
||||||
_c EMIT ( a )
|
_c EMIT ( a )
|
||||||
1 _c + ( a+1 )
|
1 _c + ( a+1 )
|
||||||
AGAIN
|
AGAIN
|
||||||
@ -107,8 +105,8 @@
|
|||||||
;
|
;
|
||||||
|
|
||||||
: C<
|
: C<
|
||||||
( JTBL+40 == CINPTR )
|
( 48 == CINPTR )
|
||||||
[ JTBL 40 + @ LITN ] _c @ EXECUTE
|
[ 48 @ LITN ] _c @ EXECUTE
|
||||||
;
|
;
|
||||||
|
|
||||||
: C,
|
: C,
|
||||||
@ -119,19 +117,19 @@
|
|||||||
( The NOT is to normalize the negative/positive numbers to 1
|
( The NOT is to normalize the negative/positive numbers to 1
|
||||||
or 0. Hadn't we wanted to normalize, we'd have written:
|
or 0. Hadn't we wanted to normalize, we'd have written:
|
||||||
32 CMP 1 - )
|
32 CMP 1 - )
|
||||||
: WS? 33 _c CMP 1 _c + NOT ;
|
: WS? 33 _c CMP 1 _c + _c NOT ;
|
||||||
|
|
||||||
: TOWORD
|
: TOWORD
|
||||||
BEGIN
|
BEGIN
|
||||||
_c C< _c DUP _c WS? NOT IF EXIT THEN _c DROP
|
_c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||||
return, make HL point to WORDBUF. )
|
return, make HL point to WORDBUF. )
|
||||||
: WORD
|
: WORD
|
||||||
( JTBL+30 == WORDBUF )
|
( 38 == WORDBUF )
|
||||||
[ JTBL 30 + @ LITN ] ( a )
|
[ 38 @ LITN ] ( a )
|
||||||
_c TOWORD ( a c )
|
_c TOWORD ( a c )
|
||||||
BEGIN
|
BEGIN
|
||||||
( We take advantage of the fact that char MSB is
|
( We take advantage of the fact that char MSB is
|
||||||
@ -144,13 +142,13 @@
|
|||||||
( a this point, PS is: a WS )
|
( a this point, PS is: a WS )
|
||||||
( null-termination is already written )
|
( null-termination is already written )
|
||||||
_c 2DROP
|
_c 2DROP
|
||||||
[ JTBL 30 + @ LITN ]
|
[ 38 @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: (entry)
|
: (entry)
|
||||||
_c HERE _c @ ( h )
|
_c HERE _c @ ( h )
|
||||||
_c WORD ( h s )
|
_c WORD ( h s )
|
||||||
SCPY ( h )
|
_c SCPY ( h )
|
||||||
( Adjust HERE -1 because SCPY copies the null )
|
( Adjust HERE -1 because SCPY copies the null )
|
||||||
_c HERE _c @ 1 _c - ( h h' )
|
_c HERE _c @ 1 _c - ( h h' )
|
||||||
_c DUP _c HERE _c ! ( h h' )
|
_c DUP _c HERE _c ! ( h h' )
|
||||||
@ -165,7 +163,7 @@
|
|||||||
: INTERPRET
|
: INTERPRET
|
||||||
BEGIN
|
BEGIN
|
||||||
_c WORD
|
_c WORD
|
||||||
(find)
|
_c (find)
|
||||||
IF
|
IF
|
||||||
1 _c FLAGS _c !
|
1 _c FLAGS _c !
|
||||||
EXECUTE
|
EXECUTE
|
||||||
@ -177,20 +175,20 @@
|
|||||||
;
|
;
|
||||||
|
|
||||||
: BOOT
|
: BOOT
|
||||||
LIT< (parse) (find) _c DROP _c (parse*) _c !
|
LIT< (parse) _c (find) _c DROP _c (parse*) _c !
|
||||||
LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN
|
LIT< (c<) _c (find) _c
|
||||||
( JTBL+40 == CINPTR )
|
NOT IF LIT< KEY _c (find) _c DROP THEN
|
||||||
[ JTBL 40 + @ LITN ] _c !
|
( 48 == CINPTR )
|
||||||
LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN
|
[ 48 @ LITN ] _c !
|
||||||
|
LIT< (c<$) _c (find) IF EXECUTE ELSE _c DROP THEN
|
||||||
_c INTERPRET
|
_c INTERPRET
|
||||||
;
|
;
|
||||||
|
|
||||||
( LITN has to be defined after the last immediate usage of
|
( LITN has to be defined after the last immediate usage of
|
||||||
it to avoid bootstrapping issues )
|
it to avoid bootstrapping issues )
|
||||||
: LITN
|
: LITN
|
||||||
( JTBL+24 == NUMBER )
|
( 32 == NUMBER )
|
||||||
_c JTBL 24 _c + ,
|
32 , ,
|
||||||
,
|
|
||||||
;
|
;
|
||||||
|
|
||||||
( : and ; have to be defined last because it can't be
|
( : and ; have to be defined last because it can't be
|
||||||
@ -200,11 +198,11 @@
|
|||||||
: X
|
: X
|
||||||
_c (entry)
|
_c (entry)
|
||||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||||
issues. JTBL+24 == NUMBER JTBL+6 == compiledWord )
|
issues. 32 == NUMBER 14 == compiledWord )
|
||||||
[ JTBL 24 + , JTBL 6 + , ] ,
|
[ 32 , 14 , ] ,
|
||||||
BEGIN
|
BEGIN
|
||||||
_c WORD
|
_c WORD
|
||||||
(find)
|
_c (find)
|
||||||
( is word )
|
( is word )
|
||||||
IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
|
IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
|
||||||
( maybe number )
|
( maybe number )
|
||||||
|
68
forth/notes.txt
Normal file
68
forth/notes.txt
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
Collapse OS' Forth implementation notes
|
||||||
|
|
||||||
|
*** EXECUTION MODEL
|
||||||
|
|
||||||
|
After having read a line through readln, we want to interpret it. As a general
|
||||||
|
rule, we go like this:
|
||||||
|
|
||||||
|
1. read single word from line
|
||||||
|
2. Can we find the word in dict?
|
||||||
|
3. If yes, execute that word, goto 1
|
||||||
|
4. Is it a number?
|
||||||
|
5. If yes, push that number to PS, goto 1
|
||||||
|
6. Error: undefined word.
|
||||||
|
|
||||||
|
*** EXECUTING A WORD
|
||||||
|
|
||||||
|
At it's core, executing a word is pushing the wordref on PS and calling EXECUTE.
|
||||||
|
Then, we let the word do its things. Some words are special, but most of them
|
||||||
|
are of the compiledWord type, and that's their execution that we describe here.
|
||||||
|
|
||||||
|
First of all, at all time during execution, the Interpreter Pointer (IP) points
|
||||||
|
to the wordref we're executing next.
|
||||||
|
|
||||||
|
When we execute a compiledWord, the first thing we do is push IP to the Return
|
||||||
|
Stack (RS). Therefore, RS' top of stack will contain a wordref to execute next,
|
||||||
|
after we EXIT.
|
||||||
|
|
||||||
|
At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
|
||||||
|
continues.
|
||||||
|
|
||||||
|
*** Stack management
|
||||||
|
|
||||||
|
The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
|
||||||
|
maintained by IX. This allows us to generally use push and pop freely because PS
|
||||||
|
is the most frequently used. However, this causes a problem with routine calls:
|
||||||
|
because in Forth, the stack isn't balanced within each call, our return offset,
|
||||||
|
when placed by a CALL, messes everything up. This is one of the reasons why we
|
||||||
|
need stack management routines below. IX always points to RS' Top Of Stack (TOS)
|
||||||
|
|
||||||
|
This return stack contain "Interpreter pointers", that is a pointer to the
|
||||||
|
address of a word, as seen in a compiled list of words.
|
||||||
|
|
||||||
|
*** Dictionary
|
||||||
|
|
||||||
|
A dictionary entry has this structure:
|
||||||
|
|
||||||
|
- Xb name. Arbitrary long number of character (but can't be bigger than
|
||||||
|
input buffer, of course). not null-terminated
|
||||||
|
- 2b prev offset
|
||||||
|
- 1b size + IMMEDIATE flag
|
||||||
|
- 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 size + flag indicate the size of the name field, with the 7th bit being the
|
||||||
|
IMMEDIATE flag.
|
||||||
|
|
||||||
|
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".
|
||||||
|
|
||||||
|
That's for "regular" words (words that are part of the dict chain). There are
|
||||||
|
also "special words", for example NUMBER, LIT, FBR, that have a slightly
|
||||||
|
different structure. They're also a pointer to an executable, but as for the
|
||||||
|
other fields, the only one they have is the "flags" field.
|
||||||
|
|
@ -39,6 +39,9 @@
|
|||||||
: OP1 CREATE C, DOES> C@ A, ;
|
: OP1 CREATE C, DOES> C@ A, ;
|
||||||
0xeb OP1 EXDEHL,
|
0xeb OP1 EXDEHL,
|
||||||
0x76 OP1 HALT,
|
0x76 OP1 HALT,
|
||||||
|
0xe9 OP1 JP(HL),
|
||||||
|
0x12 OP1 LD(DE)A,
|
||||||
|
0x1a OP1 LDA(DE),
|
||||||
0xc9 OP1 RET,
|
0xc9 OP1 RET,
|
||||||
0x17 OP1 RLA,
|
0x17 OP1 RLA,
|
||||||
0x07 OP1 RLCA,
|
0x07 OP1 RLCA,
|
||||||
@ -241,19 +244,19 @@
|
|||||||
SPLITB A, A,
|
SPLITB A, A,
|
||||||
;
|
;
|
||||||
|
|
||||||
( JTBL+18 == next )
|
( 26 == next )
|
||||||
: JPNEXT, [ JTBL 18 + LITN ] JPnn, ;
|
: JPNEXT, 26 JPnn, ;
|
||||||
|
|
||||||
: CODE
|
: CODE
|
||||||
( same as CREATE, but with native word )
|
( same as CREATE, but with native word )
|
||||||
(entry)
|
(entry)
|
||||||
( JTBL+15 == next )
|
( 23 == nativeWord )
|
||||||
[ JTBL 15 + LITN ] ,
|
23 ,
|
||||||
;
|
;
|
||||||
|
|
||||||
: ;CODE JPNEXT, ;
|
: ;CODE JPNEXT, ;
|
||||||
|
|
||||||
|
|
||||||
( Routines )
|
( Routines )
|
||||||
( JTBL+21 == next )
|
( 29 == chkPS )
|
||||||
: chkPS, [ JTBL 21 + LITN ] CALLnn, ;
|
: chkPS, 29 CALLnn, ;
|
||||||
|
@ -149,6 +149,19 @@ CODE XOR
|
|||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE NOT
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
A L LDrr,
|
||||||
|
H ORr,
|
||||||
|
HL 0 LDddnn,
|
||||||
|
3 JRNZe, ( skip)
|
||||||
|
( false, make 1 )
|
||||||
|
HL INCss,
|
||||||
|
( skip )
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
CODE +
|
CODE +
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
DE POPqq,
|
DE POPqq,
|
||||||
@ -283,13 +296,13 @@ CODE J
|
|||||||
CODE >R
|
CODE >R
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
chkPS,
|
chkPS,
|
||||||
( JTBL+9 == pushRS )
|
( 17 == pushRS )
|
||||||
JTBL 9 + CALLnn,
|
17 CALLnn,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
CODE R>
|
CODE R>
|
||||||
( JTBL+12 == popRS )
|
( 20 == popRS )
|
||||||
JTBL 12 + CALLnn,
|
20 CALLnn,
|
||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
@ -316,23 +329,23 @@ CODE BYE
|
|||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
CODE (resSP)
|
CODE (resSP)
|
||||||
( INITIAL_SP == JTBL+28 )
|
( INITIAL_SP == 36 )
|
||||||
SP JTBL 28 + @ LDdd(nn),
|
SP 36 @ LDdd(nn),
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
CODE (resRS)
|
CODE (resRS)
|
||||||
( RS_ADDR == JTBL+38 )
|
( RS_ADDR == 46 )
|
||||||
IX JTBL 38 + @ LDddnn,
|
IX 46 @ LDddnn,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
CODE SCMP
|
CODE SCMP
|
||||||
DE POPqq,
|
DE POPqq,
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
chkPS,
|
chkPS,
|
||||||
( JTBL+35 == strcmp )
|
( 43 == strcmp )
|
||||||
JTBL 35 + CALLnn,
|
43 CALLnn,
|
||||||
( JTBL+32 == flagsToBC )
|
( 40 == flagsToBC )
|
||||||
JTBL 32 + CALLnn,
|
40 CALLnn,
|
||||||
BC PUSHqq,
|
BC PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
@ -342,8 +355,58 @@ CODE CMP
|
|||||||
chkPS,
|
chkPS,
|
||||||
A ORr, ( clear carry )
|
A ORr, ( clear carry )
|
||||||
DE SBCHLss,
|
DE SBCHLss,
|
||||||
( JTBL+32 == flagsToBC )
|
( 40 == flagsToBC )
|
||||||
JTBL 32 + CALLnn,
|
40 CALLnn,
|
||||||
BC PUSHqq,
|
BC PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE (parsed)
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
( 60 == parseDecimal )
|
||||||
|
60 CALLnn,
|
||||||
|
10 JRZe, ( success )
|
||||||
|
( error )
|
||||||
|
DE 0 LDddnn,
|
||||||
|
DE PUSHqq, ( dummy )
|
||||||
|
DE PUSHqq, ( flag )
|
||||||
|
JPNEXT,
|
||||||
|
( success )
|
||||||
|
DE PUSHqq,
|
||||||
|
DE 1 LDddnn,
|
||||||
|
DE PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE (find)
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
( 3 == find )
|
||||||
|
3 CALLnn,
|
||||||
|
10 JRZe, ( found )
|
||||||
|
( not found )
|
||||||
|
HL PUSHqq,
|
||||||
|
DE 0 LDddnn,
|
||||||
|
DE PUSHqq,
|
||||||
|
JPNEXT,
|
||||||
|
( found )
|
||||||
|
DE PUSHqq,
|
||||||
|
DE 1 LDddnn,
|
||||||
|
DE PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE SCPY
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
DE HERE LDdd(nn),
|
||||||
|
B 0 LDrn,
|
||||||
|
( loop )
|
||||||
|
A (HL) LDrr,
|
||||||
|
LD(DE)A,
|
||||||
|
HL INCss,
|
||||||
|
DE INCss,
|
||||||
|
B INCr,
|
||||||
|
A ORr,
|
||||||
|
-6 JRNZe, ( loop )
|
||||||
|
DE A LD(dd)r
|
||||||
|
HERE DE LD(nn)dd,
|
||||||
|
;CODE
|
||||||
|
Loading…
Reference in New Issue
Block a user