izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-12-25 17:08:07 +11:00
Code Issues Releases Wiki Activity

forth: implement THEN in Forth

Browse Source 
Also, add "," and "C,"
This commit is contained in:
Virgil Dupras 2020-03-12 13:52:27 -04:00
parent 3819dbc083
commit fb54fd51af
4 changed files with 9 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
apps/forth/core.fth
View File

@ -3,6 +3,9 @@
: ALLOT HERE +! ; : ALLOT HERE +! ;
: VARIABLE CREATE 2 ALLOT ; : VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE HERE @ ! DOES> @ ; : CONSTANT CREATE HERE @ ! DOES> @ ;
: , HERE @ ! 2 ALLOT ;
: C, HERE @ C! 1 ALLOT ;
: THEN DUP HERE @ SWAP - SWAP C! ; IMMEDIATE
: NOT IF 0 ELSE 1 THEN ; : NOT IF 0 ELSE 1 THEN ;
: = CMP NOT ; : = CMP NOT ;
: < CMP 0 1 - = ; : < CMP 0 1 - = ;

19
apps/forth/dict.asm
View File

@ -321,8 +321,6 @@ IMMEDIATE:
.dw nativeWord .dw nativeWord
ld hl, (CURRENT) ld hl, (CURRENT)
dec hl dec hl
dec hl
dec hl
set FLAG_IMMED, (hl) set FLAG_IMMED, (hl)
jp exit jp exit
@ -675,24 +673,9 @@ ELSE:
ld (HERE), hl ld (HERE), hl
jp exit jp exit
.db "THEN"
.fill 3
.dw ELSE
.db 1 ; IMMEDIATE
THEN:
.dw nativeWord
; See comments in IF and ELSE
pop de ; cell's address
ld hl, (HERE)
; There is nothing to skip because THEN leaves nothing.
or a ; clear carry
sbc hl, de ; HL now has relative offset
ld a, l
ld (de), a
jp exit
.db "RECURSE" .db "RECURSE"
.dw THEN .dw ELSE
.db 0 .db 0
RECURSE: RECURSE:
.dw nativeWord .dw nativeWord

2
apps/forth/dictionary.txt
View File

@ -28,7 +28,9 @@ also be references to NUMBER and LIT.
*** Defining words *** *** Defining words ***
: x ... -- Define a new word : x ... -- Define a new word
; R:I -- Exit a colon definition ; R:I -- Exit a colon definition
, n -- Write n in HERE and advance it.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
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.
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

5
apps/forth/main.asm
View File

@ -19,6 +19,7 @@
.equ INITIAL_SP FORTH_RAMSTART .equ INITIAL_SP FORTH_RAMSTART
.equ CURRENT @+2 .equ CURRENT @+2
.equ HERE @+2 .equ HERE @+2
.equ OLDHERE @+2
; Pointer to where we currently are in the interpretation of the current line. ; Pointer to where we currently are in the interpretation of the current line.
.equ INPUTPOS @+2 .equ INPUTPOS @+2
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE. ; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
@ -88,7 +89,7 @@ forthRdLine:
; We're about to compile the line and possibly execute IMMEDIATE words. ; We're about to compile the line and possibly execute IMMEDIATE words.
; Let's save current (HERE) and temporarily set it to COMPBUF. ; Let's save current (HERE) and temporarily set it to COMPBUF.
ld hl, (HERE) ld hl, (HERE)
push hl ; Saving HERE ld (OLDHERE), hl
ld hl, COMPBUF ld hl, COMPBUF
ld (HERE), hl ld (HERE), hl
forthInterpret: forthInterpret:
@ -136,7 +137,7 @@ forthInterpret:
ld de, QUIT ld de, QUIT
call .writeDE call .writeDE
; Compilation done, let's restore (HERE) and execute! ; Compilation done, let's restore (HERE) and execute!
pop hl ; Restore old (HERE) ld hl, (OLDHERE)
ld (HERE), hl ld (HERE), hl
ld iy, COMPBUF ld iy, COMPBUF
jp compiledWord jp compiledWord