forth: inline kernel/stdio
This commit is contained in:
parent
6134694513
commit
cf95bbcace
@ -9,19 +9,12 @@
|
|||||||
.equ HERE 0xe700 ; override, in sync with stage1.c
|
.equ HERE 0xe700 ; override, in sync with stage1.c
|
||||||
.equ CURRENT 0xe702 ; override, in sync with stage1.c
|
.equ CURRENT 0xe702 ; override, in sync with stage1.c
|
||||||
.equ HERE_INITIAL CODE_END ; override
|
.equ HERE_INITIAL CODE_END ; override
|
||||||
|
|
||||||
.inc "ascii.h"
|
|
||||||
.equ STDIO_PORT 0x00
|
.equ STDIO_PORT 0x00
|
||||||
|
|
||||||
jp init
|
jp init
|
||||||
|
|
||||||
|
.equ GETC emulGetC
|
||||||
.equ STDIO_RAMSTART RAMSTART
|
.equ PUTC emulPutC
|
||||||
.equ STDIO_GETC emulGetC
|
|
||||||
.equ STDIO_PUTC emulPutC
|
|
||||||
.inc "stdio.asm"
|
|
||||||
|
|
||||||
.equ FORTH_RAMSTART STDIO_RAMEND
|
|
||||||
.inc "forth.asm"
|
.inc "forth.asm"
|
||||||
|
|
||||||
init:
|
init:
|
||||||
|
@ -1,17 +1,12 @@
|
|||||||
; Warning: The offsets of native dict entries must be exactly the same between
|
; Warning: The offsets of native dict entries must be exactly the same between
|
||||||
; glue0.asm and glue1.asm
|
; glue0.asm and glue1.asm
|
||||||
.equ LATEST CODE_END ; override
|
.equ LATEST CODE_END ; override
|
||||||
.inc "ascii.h"
|
|
||||||
.equ STDIO_PORT 0x00
|
.equ STDIO_PORT 0x00
|
||||||
|
|
||||||
jp init
|
jp init
|
||||||
|
|
||||||
.equ STDIO_RAMSTART RAMSTART
|
.equ GETC emulGetC
|
||||||
.equ STDIO_GETC emulGetC
|
.equ PUTC emulPutC
|
||||||
.equ STDIO_PUTC emulPutC
|
|
||||||
.inc "stdio.asm"
|
|
||||||
|
|
||||||
.equ FORTH_RAMSTART STDIO_RAMEND
|
|
||||||
.inc "forth.asm"
|
.inc "forth.asm"
|
||||||
|
|
||||||
init:
|
init:
|
||||||
|
125
forth/forth.asm
125
forth/forth.asm
@ -10,6 +10,22 @@
|
|||||||
; self-hosts in a more compact manner. File include is a big part of the
|
; 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.
|
; complexity in zasm. If we can get rid of it, we'll be more compact.
|
||||||
|
|
||||||
|
; *** 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.
|
||||||
|
;
|
||||||
|
; *** ASCII ***
|
||||||
|
.equ BS 0x08
|
||||||
|
.equ CR 0x0d
|
||||||
|
.equ LF 0x0a
|
||||||
|
.equ DEL 0x7f
|
||||||
; *** Const ***
|
; *** Const ***
|
||||||
; Base of the Return Stack
|
; Base of the Return Stack
|
||||||
.equ RS_ADDR 0xf000
|
.equ RS_ADDR 0xf000
|
||||||
@ -19,6 +35,9 @@
|
|||||||
.equ NAMELEN 7
|
.equ NAMELEN 7
|
||||||
; Offset of the code link relative to the beginning of the word
|
; Offset of the code link relative to the beginning of the word
|
||||||
.equ CODELINK_OFFSET NAMELEN+3
|
.equ CODELINK_OFFSET NAMELEN+3
|
||||||
|
; Size of the readline buffer. If a typed line reaches this size, the line is
|
||||||
|
; flushed immediately (same as pressing return).
|
||||||
|
.equ INPT_BUFSIZE 0x40
|
||||||
|
|
||||||
; Flags for the "flag field" of the word structure
|
; Flags for the "flag field" of the word structure
|
||||||
; IMMEDIATE word
|
; IMMEDIATE word
|
||||||
@ -28,7 +47,7 @@
|
|||||||
.equ FLAG_UNWORD 1
|
.equ FLAG_UNWORD 1
|
||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
.equ INITIAL_SP FORTH_RAMSTART
|
.equ INITIAL_SP RAMSTART
|
||||||
; wordref of the last entry of the dict.
|
; wordref of the last entry of the dict.
|
||||||
.equ CURRENT @+2
|
.equ CURRENT @+2
|
||||||
; Pointer to the next free byte in dict.
|
; Pointer to the next free byte in dict.
|
||||||
@ -42,14 +61,15 @@
|
|||||||
; but at stage1, it becomes "(parse)" from core.fs. It can also be changed at
|
; but at stage1, it becomes "(parse)" from core.fs. It can also be changed at
|
||||||
; runtime.
|
; runtime.
|
||||||
.equ PARSEPTR @+2
|
.equ PARSEPTR @+2
|
||||||
.equ FORTH_RAMEND @+2
|
.equ INPTBUF @+2
|
||||||
|
.equ RAMEND @+INPT_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 FORTH_RAMEND
|
.equ HERE_INITIAL RAMEND
|
||||||
|
|
||||||
; EXECUTION MODEL
|
; EXECUTION MODEL
|
||||||
; After having read a line through stdioReadLine, we want to interpret it. As
|
; After having read a line through readline, we want to interpret it. As
|
||||||
; a general rule, we go like this:
|
; a general rule, we go like this:
|
||||||
;
|
;
|
||||||
; 1. read single word from line
|
; 1. read single word from line
|
||||||
@ -151,7 +171,96 @@ msgOk:
|
|||||||
; transition, I make, right now, a copy of the routines actually used by Forth's
|
; transition, I make, right now, a copy of the routines actually used by Forth's
|
||||||
; native core. This also has the effect of reducing binary size right now and
|
; native core. This also has the effect of reducing binary size right now and
|
||||||
; give us an idea of Forth's compactness.
|
; give us an idea of Forth's compactness.
|
||||||
; These routines below are copy/paste from apps/lib.
|
; These routines below are copy/paste from apps/lib and stdio.
|
||||||
|
|
||||||
|
; print null-terminated string pointed to by HL
|
||||||
|
printstr:
|
||||||
|
push af
|
||||||
|
push hl
|
||||||
|
|
||||||
|
.loop:
|
||||||
|
ld a, (hl) ; load character to send
|
||||||
|
or a ; is it zero?
|
||||||
|
jr z, .end ; if yes, we're finished
|
||||||
|
call PUTC
|
||||||
|
inc hl
|
||||||
|
jr .loop
|
||||||
|
|
||||||
|
.end:
|
||||||
|
pop hl
|
||||||
|
pop af
|
||||||
|
ret
|
||||||
|
|
||||||
|
; Prints a line terminator. This routine is a bit of a misnomer because it's
|
||||||
|
; designed to be overridable to, for example, printlf, but we'll live with it
|
||||||
|
; for now...
|
||||||
|
printcrlf:
|
||||||
|
push af
|
||||||
|
ld a, CR
|
||||||
|
call PUTC
|
||||||
|
ld a, LF
|
||||||
|
call PUTC
|
||||||
|
pop af
|
||||||
|
ret
|
||||||
|
|
||||||
|
; Repeatedly calls stdioGetC until a whole line was read, that is, when CR or
|
||||||
|
; LF is read or if the buffer is full. Sets HL to the beginning of the read
|
||||||
|
; line, which is null-terminated.
|
||||||
|
;
|
||||||
|
; This routine also takes care of echoing received characters back to the TTY.
|
||||||
|
; It also manages backspaces properly.
|
||||||
|
readline:
|
||||||
|
push bc
|
||||||
|
ld hl, INPTBUF
|
||||||
|
ld b, INPT_BUFSIZE-1
|
||||||
|
.loop:
|
||||||
|
; Let's wait until something is typed.
|
||||||
|
call GETC
|
||||||
|
; got it. Now, is it a CR or LF?
|
||||||
|
cp CR
|
||||||
|
jr z, .complete ; char is CR? buffer complete!
|
||||||
|
cp LF
|
||||||
|
jr z, .complete
|
||||||
|
cp DEL
|
||||||
|
jr z, .delchr
|
||||||
|
cp BS
|
||||||
|
jr z, .delchr
|
||||||
|
|
||||||
|
; Echo the received character right away so that we see what we type
|
||||||
|
call PUTC
|
||||||
|
|
||||||
|
; Ok, gotta add it do the buffer
|
||||||
|
ld (hl), a
|
||||||
|
inc hl
|
||||||
|
djnz .loop
|
||||||
|
; buffer overflow, complete line
|
||||||
|
.complete:
|
||||||
|
; The line in our buffer is complete.
|
||||||
|
; Let's null-terminate it and return.
|
||||||
|
xor a
|
||||||
|
ld (hl), a
|
||||||
|
ld hl, INPTBUF
|
||||||
|
pop bc
|
||||||
|
ret
|
||||||
|
|
||||||
|
.delchr:
|
||||||
|
; Deleting is a tricky business. We have to decrease HL and increase B
|
||||||
|
; so that everything stays consistent. We also have to make sure that
|
||||||
|
; We don't do buffer underflows.
|
||||||
|
ld a, b
|
||||||
|
cp INPT_BUFSIZE-1
|
||||||
|
jr z, .loop ; beginning of line, nothing to delete
|
||||||
|
dec hl
|
||||||
|
inc b
|
||||||
|
; Char deleted in buffer, now send BS + space + BS for the terminal
|
||||||
|
; to clear its previous char
|
||||||
|
ld a, BS
|
||||||
|
call PUTC
|
||||||
|
ld a, ' '
|
||||||
|
call PUTC
|
||||||
|
ld a, BS
|
||||||
|
call PUTC
|
||||||
|
jr .loop
|
||||||
|
|
||||||
; Ensures that Z is unset (more complicated than it sounds...)
|
; Ensures that Z is unset (more complicated than it sounds...)
|
||||||
; There are often better inline alternatives, either replacing rets with
|
; There are often better inline alternatives, either replacing rets with
|
||||||
@ -578,7 +687,7 @@ DEinHL:
|
|||||||
|
|
||||||
fetchline:
|
fetchline:
|
||||||
call printcrlf
|
call printcrlf
|
||||||
call stdioReadLine
|
call readline
|
||||||
ld (INPUTPOS), hl
|
ld (INPUTPOS), hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -854,7 +963,7 @@ EMIT:
|
|||||||
pop hl
|
pop hl
|
||||||
call chkPS
|
call chkPS
|
||||||
ld a, l
|
ld a, l
|
||||||
call stdioPutC
|
call PUTC
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
.db "(print)"
|
.db "(print)"
|
||||||
@ -1178,7 +1287,7 @@ FINDERR:
|
|||||||
.db 0
|
.db 0
|
||||||
KEY:
|
KEY:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call stdioGetC
|
call GETC
|
||||||
ld h, 0
|
ld h, 0
|
||||||
ld l, a
|
ld l, a
|
||||||
push hl
|
push hl
|
||||||
|
Loading…
Reference in New Issue
Block a user