mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 17:28:06 +11:00
forth: Forth-ify "CREATE"
This commit is contained in:
parent
1e886f5f34
commit
54fd5fbb2b
@ -37,6 +37,12 @@
|
|||||||
H 1 - ( push a. -1 for allot offset )
|
H 1 - ( push a. -1 for allot offset )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
|
: [LITN] LITN ; IMMEDIATE
|
||||||
|
: CREATE
|
||||||
|
WORD (entry) ( empty header with name )
|
||||||
|
ROUTINE C [LITN] ( push cellWord addr )
|
||||||
|
, ( write it )
|
||||||
|
;
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
: CONSTANT CREATE H ! DOES> @ ;
|
: CONSTANT CREATE H ! DOES> @ ;
|
||||||
: = CMP NOT ;
|
: = CMP NOT ;
|
||||||
|
@ -52,6 +52,7 @@ DOES> -- See description at top of file
|
|||||||
IMMED? a -- f Checks whether wordref at a is immediate.
|
IMMED? a -- f Checks whether wordref at a is immediate.
|
||||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||||
LITN n -- Write number n as a literal.
|
LITN n -- Write number n as a literal.
|
||||||
|
[LITN] n -- *I* Immediate version of LITN.
|
||||||
ROUTINE x -- a Push the addr of the specified core routine
|
ROUTINE x -- a Push the addr of the specified core routine
|
||||||
C=cellWord L=compiledWord V=nativeWord N=next S=LIT
|
C=cellWord L=compiledWord V=nativeWord N=next S=LIT
|
||||||
N=NUMBER Y=sysvarWord D=doesWord
|
N=NUMBER Y=sysvarWord D=doesWord
|
||||||
|
@ -783,7 +783,7 @@ WR:
|
|||||||
|
|
||||||
.db "ROUTINE"
|
.db "ROUTINE"
|
||||||
.dw WR
|
.dw WR
|
||||||
.db 0
|
.db 1 ; IMMEDIATE
|
||||||
ROUTINE:
|
ROUTINE:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw WORD
|
.dw WORD
|
||||||
@ -1253,6 +1253,9 @@ PARSEI:
|
|||||||
|
|
||||||
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||||
; HL points to new (HERE)
|
; HL points to new (HERE)
|
||||||
|
.db "(entry)"
|
||||||
|
.dw PARSE
|
||||||
|
.db 0
|
||||||
ENTRYHEAD:
|
ENTRYHEAD:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
@ -1272,19 +1275,6 @@ ENTRYHEAD:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.db "CREATE"
|
|
||||||
.fill 1
|
|
||||||
.dw PARSE
|
|
||||||
.db 0
|
|
||||||
CREATE:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw WORD
|
|
||||||
.dw ENTRYHEAD
|
|
||||||
.dw NUMBER
|
|
||||||
.dw cellWord
|
|
||||||
.dw WR
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
; WARNING: there are no limit checks. We must be cautious, in core code, not
|
; WARNING: there are no limit checks. We must be cautious, in core code, not
|
||||||
; to create more than SYSV_BUFSIZE/2 sys vars.
|
; to create more than SYSV_BUFSIZE/2 sys vars.
|
||||||
; Also: SYSV shouldn't be used during runtime: SYSVNXT won't point at the
|
; Also: SYSV shouldn't be used during runtime: SYSVNXT won't point at the
|
||||||
@ -1292,7 +1282,7 @@ CREATE:
|
|||||||
; this word is not documented in dictionary.txt
|
; this word is not documented in dictionary.txt
|
||||||
.db "(sysv)"
|
.db "(sysv)"
|
||||||
.fill 1
|
.fill 1
|
||||||
.dw CREATE
|
.dw ENTRYHEAD
|
||||||
.db 0
|
.db 0
|
||||||
SYSV:
|
SYSV:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
|
Loading…
Reference in New Issue
Block a user