mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-30 20:48:06 +11:00
forth: Forth-ify "KEY"
This commit is contained in:
parent
636407969d
commit
966f6df0c5
@ -8,3 +8,10 @@ CODE (emit)
|
|||||||
A L LDrr,
|
A L LDrr,
|
||||||
0 OUTnA,
|
0 OUTnA,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE KEY
|
||||||
|
0 INAn,
|
||||||
|
H 0 LDrn,
|
||||||
|
L A LDrr,
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
@ -9,11 +9,3 @@ init:
|
|||||||
ld sp, 0xffff
|
ld sp, 0xffff
|
||||||
call forthMain
|
call forthMain
|
||||||
halt
|
halt
|
||||||
|
|
||||||
emulGetC:
|
|
||||||
; Blocks until a char is returned
|
|
||||||
in a, (STDIO_PORT)
|
|
||||||
cp a ; ensure Z
|
|
||||||
ret
|
|
||||||
|
|
||||||
.equ GETC emulGetC
|
|
||||||
|
Binary file not shown.
@ -141,7 +141,8 @@ forthMain:
|
|||||||
call find
|
call find
|
||||||
jr z, .skip
|
jr z, .skip
|
||||||
; no? then use KEY
|
; no? then use KEY
|
||||||
ld de, KEY
|
ld hl, .keyName
|
||||||
|
call find
|
||||||
.skip:
|
.skip:
|
||||||
ld (CINPTR), de
|
ld (CINPTR), de
|
||||||
; Set up SYSVNXT
|
; Set up SYSVNXT
|
||||||
@ -157,6 +158,8 @@ forthMain:
|
|||||||
.db "(c<)", 0
|
.db "(c<)", 0
|
||||||
.emitName:
|
.emitName:
|
||||||
.db "(emit)", 0
|
.db "(emit)", 0
|
||||||
|
.keyName:
|
||||||
|
.db "KEY", 0
|
||||||
|
|
||||||
BEGIN:
|
BEGIN:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
@ -985,22 +988,10 @@ FIND_:
|
|||||||
push de
|
push de
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; ( -- c )
|
|
||||||
.db "KEY"
|
|
||||||
.dw $-FIND_
|
|
||||||
.db 3
|
|
||||||
KEY:
|
|
||||||
.dw nativeWord
|
|
||||||
call GETC
|
|
||||||
ld h, 0
|
|
||||||
ld l, a
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; This is an indirect word that can be redirected through "CINPTR"
|
; This is an indirect word that can be redirected through "CINPTR"
|
||||||
; code: it is replaced in readln.fs.
|
; code: it is replaced in readln.fs.
|
||||||
.db "C<"
|
.db "C<"
|
||||||
.dw $-KEY
|
.dw $-FIND_
|
||||||
.db 2
|
.db 2
|
||||||
CIN:
|
CIN:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
|
Loading…
Reference in New Issue
Block a user