collapseos/forth/core.fs
Virgil Dupras 68a7be3707 forth: Remove RAM offsets from stable ABI
Doing this was a bit stupid. These offsets are constants. Moreover,
having them in stable ABI had us construct the boot binary from the
stable ABI of the host, making it very difficult to change RAMSTART
for a new system.
2020-04-02 10:20:51 -04:00

132 lines
3.5 KiB
Forth

: H@ HERE @ ;
: -^ SWAP - ;
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE
: ] R> DROP ;
: LIT 34 , ;
: LITS LIT SCPY ;
: LIT< WORD LITS ; IMMEDIATE
: _err LIT< word-not-found (print) ABORT ;
: ' WORD (find) NOT (?br) [ 4 , ] _err ;
: ['] ' LITN ; IMMEDIATE
: COMPILE ' LITN ['] , , ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - , ; 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
"_": words starting with "_" are meant to be "private",
that is, only used by their immediate surrondings.
LIT: 34 == LIT
COMPILE: Tough one. Get addr of caller word (example above
(br)) and then call LITN on it. )
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: IF ( -- a | a: br cell addr )
COMPILE (?br)
H@ ( push a )
2 ALLOT ( br cell allot )
; IMMEDIATE
: THEN ( a -- | a: br cell addr )
DUP H@ -^ SWAP ( a-H a )
!
; IMMEDIATE
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
COMPILE (br)
2 ALLOT
DUP H@ -^ SWAP ( a-H a )
!
H@ 2 - ( push a. -2 for allot offset )
; IMMEDIATE
: CREATE
(entry) ( empty header with name )
11 ( 11 == cellWord )
, ( write it )
;
( We run this when we're in an entry creation context. Many
things we need to do.
1. Change the code link to doesWord
2. Leave 2 bytes for regular cell variable.
3. Write down RS' RTOS to entry.
4. exit parent definition
)
: DOES>
( Overwrite cellWord in CURRENT )
( 43 == doesWord )
43 CURRENT @ !
( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. )
CURRENT @ 4 + HERE !
( HERE points to where we should write R> )
R> ,
( We're done. Because we've popped RS, we'll exit parent
definition )
;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE , DOES> @ ;
: / /MOD SWAP DROP ;
: MOD /MOD DROP ;
( 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 (?br)
H@ - ,
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
; IMMEDIATE
( WARNING: there are no limit checks. We must be cautious, in
core code, not to create more than SYSV_BUFSIZE/2 sys vars.
Also: SYSV shouldn't be used during runtime: SYSVNXT won't
point at the right place. It should only be used during
stage1 compilation. This is why this word is not documented
in dictionary.txt )
: (sysv)
( Get new sysv addr )
( RAM+46 (2e) == SYSVNXT )
46 RAM+ @
CONSTANT
( increase current sysv counter )
2 46 RAM+ +!
;
( Set up initial SYSVNXT value, which is 2 bytes after its
own address )
46 RAM+ DUP 2 + SWAP !
: ."
LIT
BEGIN
C< DUP ( c c )
( 34 is ASCII for " )
DUP 34 = IF DROP DROP 0 0 THEN
C,
0 = UNTIL
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE