forth: Make (parse) indirect and Forth-ify (parsec)

This commit is contained in:
Virgil Dupras 2020-03-17 21:19:56 -04:00
parent 4212d5161f
commit 9451c599e0
5 changed files with 50 additions and 27 deletions

View File

@ -49,6 +49,24 @@
: / /MOD SWAP DROP ; : / /MOD SWAP DROP ;
: MOD /MOD DROP ; : MOD /MOD DROP ;
( Parse numbers )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
DUP 2 + C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
( surrounded by apos, good, return )
1 + C@ 1 ( -- n 1 )
;
: (parse) ( a -- n )
(parsec) NOT SKIP? EXIT
(parsed) NOT SKIP? EXIT
( nothing works )
ABORT" unknown word! "
;
' (parse) (parse*) !
( Format numbers ) ( Format numbers )
( TODO FORGET this word ) ( TODO FORGET this word )
: PUSHDGTS : PUSHDGTS

View File

@ -339,7 +339,7 @@ COMPILE:
.db 0b10 ; UNWORD .db 0b10 ; UNWORD
.maybeNum: .maybeNum:
.dw compiledWord .dw compiledWord
.dw PARSE .dw PARSEI
.dw LITN .dw LITN
.dw R2P ; exit COMPILE .dw R2P ; exit COMPILE
.dw DROP .dw DROP
@ -554,10 +554,6 @@ PARSED:
.dw nativeWord .dw nativeWord
pop hl pop hl
call chkPS call chkPS
; temporary: run parseCharLit in here until it's implemented in Forth
; core.fs needs char literal parsing.
call parseCharLit
jr z, .success
call parseDecimal call parseDecimal
jr z, .success jr z, .success
; error ; error
@ -573,7 +569,7 @@ PARSED:
.db "(parse)" .db "(parse)"
.dw WORD .dw PARSED
.db 0 .db 0
PARSE: PARSE:
.dw compiledWord .dw compiledWord
@ -592,6 +588,16 @@ PARSE:
.dw ABORT .dw ABORT
; Indirect parse caller. Reads PARSEPTR and calls
.db 0b10 ; UNWORD
PARSEI:
.dw compiledWord
.dw PARSEPTR_
.dw FETCH
.dw EXECUTE
.dw EXIT
.db "CREATE" .db "CREATE"
.fill 1 .fill 1
.dw PARSE .dw PARSE
@ -622,9 +628,16 @@ CURRENT_:
.dw sysvarWord .dw sysvarWord
.dw CURRENT .dw CURRENT
.db "(parse*"
.dw CURRENT_
.db 0
PARSEPTR_:
.dw sysvarWord
.dw PARSEPTR
.db "IN>" .db "IN>"
.fill 4 .fill 4
.dw CURRENT_ .dw PARSEPTR_
.db 0 .db 0
INP: INP:
.dw sysvarWord .dw sysvarWord

View File

@ -176,6 +176,8 @@ core.
Parses string at a as a number and push the result Parses string at a as a number and push the result
in n as well as whether parsing was a success in f in n as well as whether parsing was a success in f
(0 = failure, 1 = success) (0 = failure, 1 = success)
(parse*) -- a Variable holding the current pointer for system
number parsing. By default, (parse).
(print) a -- Print string at addr a. (print) a -- Print string at addr a.
. n -- Print n in its decimal form . n -- Print n in its decimal form
.X n -- Print n in its hexadecimal form. In hex, numbers .X n -- Print n in its hexadecimal form. In hex, numbers

View File

@ -25,7 +25,11 @@
.equ IP @+2 .equ IP @+2
; Pointer to where we currently are in the interpretation of the current line. ; Pointer to where we currently are in the interpretation of the current line.
.equ INPUTPOS @+2 .equ INPUTPOS @+2
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE. ; Pointer to the system's number parsing function. It points to then entry that
; had the "(parse)" name at startup. During stage0, it's out builtin PARSE,
; but at stage1, it becomes "(parse)" from core.fs. It can also be changed at
; runtime.
.equ PARSEPTR @+2
.equ FORTH_RAMEND @+2 .equ FORTH_RAMEND @+2
; (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,
@ -84,6 +88,10 @@ forthMain:
ld (INPUTPOS), hl ld (INPUTPOS), hl
xor a xor a
ld (hl), a ld (hl), a
; Set up PARSEPTR
ld hl, PARSE-CODELINK_OFFSET
call find
ld (PARSEPTR), de
forthRdLine: forthRdLine:
ld hl, msgOk ld hl, msgOk
call printstr call printstr
@ -106,7 +114,7 @@ INTERPRET:
.maybeNum: .maybeNum:
.dw compiledWord .dw compiledWord
.dw PARSE .dw PARSEI
.dw R2P ; exit INTERPRET .dw R2P ; exit INTERPRET
.dw DROP .dw DROP
.dw EXIT .dw EXIT

View File

@ -181,24 +181,6 @@ parseDecimal:
cp a ; ensure Z cp a ; ensure Z
ret ret
parseCharLit:
ld a, (hl)
cp 0x27 ; apostrophe
ret nz
ld d, 0 ; preset
inc hl
ld e, (hl) ; our result
inc hl
cp (hl)
ret z
; Z unset and there's an error
; In all error conditions, HL is advanced by 2. Rewind.
dec hl \ dec hl
; NZ already set
ret
; *** Forth-specific part *** ; *** Forth-specific part ***
; Return address of scratchpad in HL ; Return address of scratchpad in HL
pad: pad: