|
@@ -66,6 +66,8 @@ |
|
|
.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 |
|
@@ -151,6 +153,10 @@ 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 |
|
@@ -174,6 +180,8 @@ 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 |
|
|
|
|
|
|
|
@@ -195,7 +203,7 @@ INTERPRET: |
|
|
.dw DROP |
|
|
.dw DROP |
|
|
.dw EXECUTE |
|
|
.dw EXECUTE |
|
|
|
|
|
|
|
|
.fill 31 |
|
|
|
|
|
|
|
|
.fill 13 |
|
|
|
|
|
|
|
|
; *** 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 |
|
@@ -681,8 +689,11 @@ abortUnderflow: |
|
|
.word: |
|
|
.word: |
|
|
.dw compiledWord |
|
|
.dw compiledWord |
|
|
.dw LIT |
|
|
.dw LIT |
|
|
.db "stack underflow", 0 |
|
|
|
|
|
.dw PRINT |
|
|
|
|
|
|
|
|
.db "stack underfl", 0 |
|
|
|
|
|
.dw NUMBER |
|
|
|
|
|
.dw PRINTPTR |
|
|
|
|
|
.dw FETCH |
|
|
|
|
|
.dw EXECUTE |
|
|
.dw ABORT |
|
|
.dw ABORT |
|
|
|
|
|
|
|
|
.db "BYE" |
|
|
.db "BYE" |
|
@@ -692,6 +703,9 @@ BYE: |
|
|
.dw nativeWord |
|
|
.dw nativeWord |
|
|
halt |
|
|
halt |
|
|
|
|
|
|
|
|
|
|
|
; STABLE ABI |
|
|
|
|
|
; Offset: 02aa |
|
|
|
|
|
.out $ |
|
|
; ( c -- ) |
|
|
; ( c -- ) |
|
|
.db "EMIT" |
|
|
.db "EMIT" |
|
|
.dw $-BYE |
|
|
.dw $-BYE |
|
@@ -705,43 +719,10 @@ EMIT: |
|
|
.dw EXIT |
|
|
.dw EXIT |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "(print)" |
|
|
|
|
|
.dw $-EMIT |
|
|
|
|
|
.db 7 |
|
|
|
|
|
PRINT: |
|
|
|
|
|
.dw compiledWord ; a |
|
|
|
|
|
; BBR mark |
|
|
|
|
|
.dw DUP ; a a |
|
|
|
|
|
.dw .getc ; a c |
|
|
|
|
|
.dw DUP ; a c f |
|
|
|
|
|
.dw CSKIP ; a c |
|
|
|
|
|
; zero, end of string |
|
|
|
|
|
.dw FBR |
|
|
|
|
|
.db 12 |
|
|
|
|
|
.dw EMIT ; a |
|
|
|
|
|
.dw NUMBER ; a 1 |
|
|
|
|
|
.dw 1 |
|
|
|
|
|
.dw PLUS ; a+1 |
|
|
|
|
|
.dw BBR |
|
|
|
|
|
.db 21 |
|
|
|
|
|
; FBR mark |
|
|
|
|
|
.dw DROP |
|
|
|
|
|
.dw DROP |
|
|
|
|
|
.dw EXIT |
|
|
|
|
|
|
|
|
|
|
|
; Yes, very much like C@, but it has already been Forth-ified... |
|
|
|
|
|
.getc: |
|
|
|
|
|
.dw nativeWord |
|
|
|
|
|
pop hl |
|
|
|
|
|
call chkPS |
|
|
|
|
|
ld l, (hl) |
|
|
|
|
|
ld h, 0 |
|
|
|
|
|
push hl |
|
|
|
|
|
jp next |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.fill 49 |
|
|
|
|
|
|
|
|
.db "C," |
|
|
.db "C," |
|
|
.dw $-PRINT |
|
|
|
|
|
|
|
|
.dw $-EMIT |
|
|
.db 2 |
|
|
.db 2 |
|
|
CWR: |
|
|
CWR: |
|
|
.dw nativeWord |
|
|
.dw nativeWord |
|
|