forth: Forth-ify IF and ELSE
Now, I really need comments...
This commit is contained in:
parent
d5a7d5faf8
commit
d0d92a4559
@ -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 - = ;
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user