2020-03-12 21:49:10 -04:00
|
|
|
: H HERE @ ;
|
|
|
|
: -^ SWAP - ;
|
2020-03-18 20:04:44 -04:00
|
|
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
2020-03-21 16:17:51 -04:00
|
|
|
: [COMPILE] ' , ; IMMEDIATE
|
2020-03-18 16:39:22 -04:00
|
|
|
: BEGIN H ; IMMEDIATE
|
2020-03-16 21:31:43 -04:00
|
|
|
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
|
2020-03-18 16:39:22 -04:00
|
|
|
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
|
2020-03-21 16:27:21 -04:00
|
|
|
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
2020-03-14 19:10:39 -04:00
|
|
|
( Hello, hello, krkrkrkr... do you hear me?
|
|
|
|
Ah, voice at last! Some lines above need comments
|
|
|
|
BTW: Forth lines limited to 64 cols because of default
|
|
|
|
input buffer size in Collapse OS
|
2020-03-16 21:31:43 -04:00
|
|
|
|
2020-03-20 13:35:02 -04:00
|
|
|
COMPILE: Tough one. Get addr of caller word (example above
|
|
|
|
(bbr)) and then call LITN on it. )
|
2020-03-18 16:39:22 -04:00
|
|
|
|
2020-03-20 13:35:02 -04:00
|
|
|
: +! SWAP OVER @ + SWAP ! ;
|
|
|
|
: ALLOT HERE +! ;
|
2020-03-16 22:09:23 -04:00
|
|
|
|
|
|
|
: IF ( -- a | a: br cell addr )
|
|
|
|
COMPILE SKIP? ( if true, don't branch )
|
|
|
|
COMPILE (fbr)
|
|
|
|
H ( push a )
|
|
|
|
1 ALLOT ( br cell allot )
|
|
|
|
; IMMEDIATE
|
|
|
|
|
|
|
|
: THEN ( a -- | a: br cell addr )
|
|
|
|
DUP H -^ SWAP ( a-H a )
|
|
|
|
C!
|
|
|
|
; IMMEDIATE
|
|
|
|
|
|
|
|
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
|
|
|
COMPILE (fbr)
|
|
|
|
1 ALLOT
|
|
|
|
DUP H -^ SWAP ( a-H a )
|
|
|
|
C!
|
|
|
|
H 1 - ( push a. -1 for allot offset )
|
|
|
|
; IMMEDIATE
|
|
|
|
|
2020-03-13 19:33:16 -04:00
|
|
|
: VARIABLE CREATE 2 ALLOT ;
|
|
|
|
: CONSTANT CREATE H ! DOES> @ ;
|
2020-03-12 00:14:44 -04:00
|
|
|
: = CMP NOT ;
|
|
|
|
: < CMP 0 1 - = ;
|
|
|
|
: > CMP 1 = ;
|
2020-03-16 22:36:29 -04:00
|
|
|
: / /MOD SWAP DROP ;
|
|
|
|
: MOD /MOD DROP ;
|
2020-03-18 20:04:44 -04:00
|
|
|
|
2020-03-21 17:21:01 -04:00
|
|
|
( In addition to pushing H this compiles 2 >R so that loop
|
|
|
|
variables are sent to PS at runtime )
|
2020-03-18 20:04:44 -04:00
|
|
|
: DO
|
|
|
|
COMPILE SWAP COMPILE >R COMPILE >R
|
|
|
|
H
|
|
|
|
; IMMEDIATE
|
|
|
|
|
2020-03-21 17:21:01 -04:00
|
|
|
( One could think that we should have a sub word to avoid all
|
|
|
|
these COMPILE, but we can't because otherwise it messes with
|
|
|
|
the RS )
|
2020-03-18 20:04:44 -04:00
|
|
|
: LOOP
|
|
|
|
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
|
|
|
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)
|
|
|
|
H -^ C,
|
|
|
|
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
|
|
|
; IMMEDIATE
|
|
|
|
|