mirror of https://github.com/hsoft/collapseos.git
65 lines
1.7 KiB
Forth
65 lines
1.7 KiB
Forth
: H HERE @ ;
|
|
: -^ SWAP - ;
|
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
|
: [COMPILE] ' , ; IMMEDIATE
|
|
: BEGIN H ; IMMEDIATE
|
|
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
|
|
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
|
|
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
|
( 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
|
|
|
|
COMPILE: Tough one. Get addr of caller word (example above
|
|
(bbr)) and then call LITN on it. )
|
|
|
|
: +! SWAP OVER @ + SWAP ! ;
|
|
: ALLOT HERE +! ;
|
|
|
|
: 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
|
|
|
|
: VARIABLE CREATE 2 ALLOT ;
|
|
: CONSTANT CREATE H ! DOES> @ ;
|
|
: = CMP NOT ;
|
|
: < CMP 0 1 - = ;
|
|
: > CMP 1 = ;
|
|
: / /MOD SWAP DROP ;
|
|
: MOD /MOD DROP ;
|
|
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
|
|
|
( In addition to pushing H this compiles 2 >R so that loop variables are sent
|
|
to PS at runtime )
|
|
: DO
|
|
COMPILE SWAP COMPILE >R COMPILE >R
|
|
H
|
|
; IMMEDIATE
|
|
|
|
( 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 )
|
|
: 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
|
|
|