forth: Forth-ify IF and ELSE

Now, I really need comments...
This commit is contained in:
Virgil Dupras 2020-03-12 21:49:10 -04:00
parent d5a7d5faf8
commit d0d92a4559
3 changed files with 11 additions and 50 deletions

View File

@ -1,11 +1,15 @@
: H HERE @ ;
: -^ SWAP - ;
: ? @ . ; : ? @ . ;
: +! SWAP OVER @ + SWAP ! ; : +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ; : ALLOT HERE +! ;
: VARIABLE CREATE 2 ALLOT ; : VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE HERE @ ! DOES> @ ; : CONSTANT CREATE H ! DOES> @ ;
: , HERE @ ! 2 ALLOT ; : , H ! 2 ALLOT ;
: C, HERE @ C! 1 ALLOT ; : C, H C! 1 ALLOT ;
: THEN DUP HERE @ SWAP - SWAP C! ; IMMEDIATE : IF ['] (fbr?) , H 0 C, ; IMMEDIATE
: THEN DUP H -^ SWAP C! ; IMMEDIATE
: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
: NOT IF 0 ELSE 1 THEN ; : NOT IF 0 ELSE 1 THEN ;
: = CMP NOT ; : = CMP NOT ;
: < CMP 0 1 - = ; : < CMP 0 1 - = ;

View File

@ -676,53 +676,8 @@ FBRC:
jp exit jp exit
; : IF ' (fbr?) , HERE @ 0 C, ; IMMEDIATE
.db "IF"
.fill 5
.dw FBRC
.db 1 ; IMMEDIATE
IF:
.dw nativeWord
; Spit a conditional branching atom, followed by an empty 1b cell. Then,
; push the address of that cell on the PS. ELSE or THEN will pick
; them up and set the offset.
ld hl, (HERE)
ld de, FBRC
call DEinHL
push hl ; address of cell to fill
inc hl ; empty 1b cell
ld (HERE), hl
jp exit
.db "ELSE"
.fill 3
.dw IF
.db 1 ; IMMEDIATE
ELSE:
.dw nativeWord
; First, let's set IF's branching cell.
pop de ; cell's address
ld hl, (HERE)
; also skip ELSE word.
inc hl \ inc hl \ inc hl
or a ; clear carry
sbc hl, de ; HL now has relative offset
ld a, l
ld (de), a
; Set IF's branching cell to current atom address and spit our own
; uncondition branching cell, which will then be picked up by THEN.
; First, let's spit our 4 bytes
ld hl, (HERE)
ld de, FBR
call DEinHL
push hl ; address of cell to fill
inc hl ; empty 1b cell
ld (HERE), hl
jp exit
.db "RECURSE" .db "RECURSE"
.dw ELSE .dw FBRC
.db 0 .db 0
RECURSE: RECURSE:
.dw nativeWord .dw nativeWord

View File

@ -77,11 +77,13 @@ C@ a -- c Set c to byte at address a
C! c a -- Store byte c in address a C! c a -- Store byte c in address a
CURRENT -- n Set n to wordref of last added entry. CURRENT -- n Set n to wordref of last added entry.
HERE -- a Push HERE's address HERE -- a Push HERE's address
H -- a HERE @
*** Arithmetic *** *** Arithmetic ***
+ a b -- c a + b -> c + a b -- c a + b -> c
- a b -- c a - b -> c - a b -- c a - b -> c
-^ a b -- c b - a -> c
* a b -- c a * b -> c * a b -- c a * b -> c
/ a b -- c a / b -> c / a b -- c a / b -> c