1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-30 20:18:06 +11:00

forth: Forth-ify "ABORT""

This commit is contained in:
Virgil Dupras 2020-03-21 16:17:51 -04:00
parent 6487c713ef
commit 4627e1c977
4 changed files with 39 additions and 50 deletions

View File

@ -1,6 +1,7 @@
: H HERE @ ; : H HERE @ ;
: -^ SWAP - ; : -^ SWAP - ;
: COMPILE ' LITN ['] , , ; IMMEDIATE : COMPILE ' LITN ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H ; IMMEDIATE : BEGIN H ; IMMEDIATE
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE : AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE : UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
@ -36,7 +37,6 @@
H 1 - ( push a. -1 for allot offset ) H 1 - ( push a. -1 for allot offset )
; IMMEDIATE ; IMMEDIATE
: ? @ . ;
: VARIABLE CREATE 2 ALLOT ; : VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ; : CONSTANT CREATE H ! DOES> @ ;
: = CMP NOT ; : = CMP NOT ;
@ -44,6 +44,7 @@
: > CMP 1 = ; : > CMP 1 = ;
: / /MOD SWAP DROP ; : / /MOD SWAP DROP ;
: MOD /MOD DROP ; : MOD /MOD DROP ;
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
( In addition to pushing H this compiles 2 >R so that loop variables are sent ( In addition to pushing H this compiles 2 >R so that loop variables are sent
to PS at runtime ) to PS at runtime )

View File

@ -44,7 +44,8 @@ directly, but as part of another word.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
CREATE x -- Create cell named x. Doesn't allocate a PF. CREATE x -- Create cell named x. Doesn't allocate a PF.
[COMPILE] x -- Compile word x and write it to HERE [COMPILE] x -- Compile word x and write it to HERE. IMMEDIATE
words are *not* executed.
COMPILE x -- Meta compiles. Kind of blows the mind. See below. COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file DOES> -- See description at top of file

View File

@ -23,6 +23,8 @@
AGAIN AGAIN
; ;
: ? @ . ;
: PUSHDGTS : PUSHDGTS
999 SWAP ( stop indicator ) 999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case ) DUP 0 = IF '0' EXIT THEN ( 0 is a special case )

View File

@ -712,21 +712,9 @@ abortUnderflow:
.dw PRINT .dw PRINT
.dw ABORT .dw ABORT
.db "ABORT", '"'
.fill 1
.dw ABORT
.db 1 ; IMMEDIATE
ABORTI:
.dw compiledWord
.dw PRINTI
.dw NUMBER
.dw ABORT
.dw WR
.dw EXIT
.db "BYE" .db "BYE"
.fill 4 .fill 4
.dw ABORTI .dw ABORT
.db 0 .db 0
BYE: BYE:
.dw nativeWord .dw nativeWord
@ -871,42 +859,9 @@ EXECUTE:
jp (hl) ; go! jp (hl) ; go!
.db "[COMPIL"
.dw EXECUTE
.db 1 ; IMMEDIATE
COMPILE:
.dw compiledWord
.dw WORD
.dw FIND_
.dw CSKIP
.dw .maybeNum
.dw DUP
.dw ISIMMED
.dw CSKIP
.dw .word
; is immediate. just execute.
.dw EXECUTE
.dw EXIT
.word:
.dw compiledWord
.dw WR
.dw R2P ; exit COMPILE
.dw DROP
.dw EXIT
.maybeNum:
.dw compiledWord
.dw PARSEI
.dw LITN
.dw R2P ; exit COMPILE
.dw DROP
.dw EXIT
.db ";" .db ";"
.fill 6 .fill 6
.dw COMPILE .dw EXECUTE
.db 1 ; IMMEDIATE .db 1 ; IMMEDIATE
ENDDEF: ENDDEF:
.dw compiledWord .dw compiledWord
@ -931,11 +886,41 @@ DEFINE:
.dw compiledWord .dw compiledWord
.dw WR .dw WR
; BBR branch mark ; BBR branch mark
.dw COMPILE .dw .compile
.dw BBR .dw BBR
.db 4 .db 4
; no need for EXIT, ENDDEF takes care of taking us out ; no need for EXIT, ENDDEF takes care of taking us out
.compile:
.dw compiledWord
.dw WORD
.dw FIND_
.dw CSKIP
.dw .maybeNum
.dw DUP
.dw ISIMMED
.dw CSKIP
.dw .word
; is immediate. just execute.
.dw EXECUTE
.dw EXIT
.word:
.dw compiledWord
.dw WR
.dw R2P ; exit .compile
.dw DROP
.dw EXIT
.maybeNum:
.dw compiledWord
.dw PARSEI
.dw LITN
.dw R2P ; exit .compile
.dw DROP
.dw EXIT
.db "DOES>" .db "DOES>"
.fill 2 .fill 2