1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-27 13:38:05 +11:00

forth: Forth-ify "(uflw)"

This commit is contained in:
Virgil Dupras 2020-03-28 09:19:40 -04:00
parent 5471ef02a7
commit ab98e9bcd1
3 changed files with 12 additions and 26 deletions

Binary file not shown.

View File

@ -32,17 +32,11 @@
; *** Const *** ; *** Const ***
; Base of the Return Stack ; Base of the Return Stack
.equ RS_ADDR 0xf000 .equ RS_ADDR 0xf000
; Number of bytes we keep as a padding between HERE and the scratchpad
.equ PADDING 0x20
; Buffer where WORD copies its read word to. ; Buffer where WORD copies its read word to.
.equ WORD_BUFSIZE 0x20 .equ WORD_BUFSIZE 0x20
; Allocated space for sysvars (see comment above SYSVCNT) ; Allocated space for sysvars (see comment above SYSVCNT)
.equ SYSV_BUFSIZE 0x10 .equ SYSV_BUFSIZE 0x10
; Flags for the "flag field" of the word structure
; IMMEDIATE word
.equ FLAG_IMMED 7
; *** Variables *** ; *** Variables ***
.equ INITIAL_SP RAMSTART .equ INITIAL_SP RAMSTART
; wordref of the last entry of the dict. ; wordref of the last entry of the dict.
@ -66,8 +60,6 @@
.equ CINPTR @+2 .equ CINPTR @+2
; Pointer to (emit) word ; Pointer to (emit) word
.equ EMITPTR @+2 .equ EMITPTR @+2
; Pointer to (print) word
.equ PRINTPTR @+2
.equ WORDBUF @+2 .equ WORDBUF @+2
; Sys Vars are variables with their value living in the system RAM segment. We ; Sys Vars are variables with their value living in the system RAM segment. We
; need this mechanisms for core Forth source needing variables. Because core ; need this mechanisms for core Forth source needing variables. Because core
@ -156,10 +148,6 @@ forthMain:
ld hl, .emitName ld hl, .emitName
call find call find
ld (EMITPTR), de ld (EMITPTR), de
; Set up PRINTPTR
ld hl, .printName
call find
ld (PRINTPTR), de
; Set up CINPTR ; Set up CINPTR
; do we have a (c<) impl? ; do we have a (c<) impl?
ld hl, .cinName ld hl, .cinName
@ -184,8 +172,6 @@ forthMain:
.db "(c<)", 0 .db "(c<)", 0
.emitName: .emitName:
.db "(emit)", 0 .db "(emit)", 0
.printName:
.db "(print)", 0
.keyName: .keyName:
.db "KEY", 0 .db "KEY", 0
.bootName: .bootName:
@ -199,7 +185,7 @@ INTERPRET:
.dw DROP .dw DROP
.dw EXECUTE .dw EXECUTE
.fill 25 .fill 43
; *** Collapse OS lib copy *** ; *** Collapse OS lib copy ***
; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to ; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
@ -679,18 +665,14 @@ ABORT:
jp next jp next
abortUnderflow: abortUnderflow:
ld hl, .word ld hl, .name
push hl call find
push de
jp EXECUTE+2 jp EXECUTE+2
.word: .name:
.dw compiledWord .db "(uflw)", 0
.dw LIT
.db "stack underfl", 0 .fill 18
.dw NUMBER
.dw PRINTPTR
.dw FETCH
.dw EXECUTE
.dw ABORT
.db "BYE" .db "BYE"
.dw $-ABORT .dw $-ABORT

View File

@ -86,6 +86,10 @@
AGAIN AGAIN
; ;
: (uflw)
LIT< stack-underflow _c (print) ABORT
;
: C, : C,
HERE @ _c C! HERE @ _c C!
HERE @ 1 + HERE ! HERE @ 1 + HERE !