1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-24 14:28:06 +11:00

forth: Forth-ify "DOES>"

This commit is contained in:
Virgil Dupras 2020-03-30 19:01:28 -04:00
parent 36e200adbb
commit f366732424
3 changed files with 27 additions and 27 deletions

Binary file not shown.

View File

@ -53,8 +53,30 @@
11 ( 11 == cellWord )
, ( write it )
;
( We run this when we're in an entry creation context. Many
things we need to do.
1. Change the code link to doesWord
2. Leave 2 bytes for regular cell variable.
3. Write down RS' RTOS to entry.
4. exit parent definition
)
: DOES>
( Overwrite cellWord in CURRENT )
( 63 == doesWord )
63 CURRENT @ !
( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. )
CURRENT @ 4 + HERE !
( HERE points to where we should write R> )
R> ,
( We're done. Because we've popped RS, we'll exit parent
definition )
;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H@ ! DOES> @ ;
: CONSTANT CREATE , DOES> @ ;
: = CMP NOT ;
: < CMP 0 1 - = ;
: > CMP 1 = ;

View File

@ -136,6 +136,7 @@
.dw HERE
.dw CURRENT
jp parseDecimal
jp doesWord
; *** Code ***
forthMain:
@ -166,7 +167,7 @@ forthMain:
.bootName:
.db "BOOT", 0
.fill 98
.fill 95
; STABLE ABI
; Offset: 00cd
@ -687,33 +688,10 @@ EXECUTE:
jp (hl) ; go!
.fill 77
.db "DOES>"
.dw $-EXECUTE
.db 5
DOES:
.dw nativeWord
; We run this when we're in an entry creation context. Many things we
; need to do.
; 1. Change the code link to doesWord
; 2. Leave 2 bytes for regular cell variable.
; 3. Write down IP+2 to entry.
; 3. exit. we're done here.
ld hl, (CURRENT)
ld de, doesWord
call DEinHL
inc hl \ inc hl ; cell variable space
ld de, (IP)
call DEinHL
ld (HERE), hl
jp EXIT+2
.fill 566
.fill 677
.db "_bend"
.dw $-DOES
.dw $-EXECUTE
.db 5
; Offset: 0647
.out $