1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 09:28:05 +11:00

Compare commits

...

3 Commits

Author SHA1 Message Date
Virgil Dupras
5d5517ac44 forth: allow DEFINE's ";" to be at the start of a newline
Previous to this commit, DEFINE's algo would miss a ";" right after a newline.

This allows for a much nicer formatting+comment of core.fs.
2020-03-16 22:09:23 -04:00
Virgil Dupras
aec98a7a3a forth: separate COMPILE and [COMPILE] 2020-03-16 21:31:43 -04:00
Virgil Dupras
f404c2f4d0 forth: TIL forth source file extension is "fs" 2020-03-16 19:51:10 -04:00
6 changed files with 92 additions and 50 deletions

49
apps/forth/core.fs Normal file
View File

@ -0,0 +1,49 @@
: H HERE @ ;
: -^ SWAP - ;
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: , H ! 2 ALLOT ;
: C, H C! 1 ALLOT ;
: BEGIN H ; IMMEDIATE
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
: NOT 1 SWAP SKIP? EXIT 0 * ;
: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; 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. However, LITN is an
immediate and has to be indirectly executed. Then, write
a reference to "," so that this word is written to HERE.
NOT: a bit convulted because we don't have IF yet )
: 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 = ;

View File

@ -1,29 +0,0 @@
: H HERE @ ;
: -^ SWAP - ;
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: , H ! 2 ALLOT ;
: C, H C! 1 ALLOT ;
: BEGIN H ; IMMEDIATE
: AGAIN ['] (bbr) , H -^ C, ; IMMEDIATE
: NOT 1 SWAP SKIP? EXIT 0 * ;
: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; 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
NOT: a bit convulted because we don't have IF yet
IF true, skip following (fbr). Also, push br cell ref H,
to PS )
: IF ['] SKIP? , ['] (fbr) , H 1 ALLOT ; IMMEDIATE
( Subtract TOS from H to get offset to write to IF or ELSE's
br cell )
: THEN DUP H -^ SWAP C! ; IMMEDIATE
( write (fbr) addr, allot, then same as THEN )
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
: ? @ . ;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ;
: = CMP NOT ;
: < CMP 0 1 - = ;
: > CMP 1 = ;

View File

@ -225,7 +225,7 @@ EXECUTE:
jp (hl) ; go! jp (hl) ; go!
.db "COMPILE" .db "[COMPIL"
.dw EXECUTE .dw EXECUTE
.db 1 ; IMMEDIATE .db 1 ; IMMEDIATE
COMPILE: COMPILE:
@ -278,7 +278,7 @@ DEFINE:
ld (HERE), hl ld (HERE), hl
.loop: .loop:
; did we reach ";"? ; did we reach ";"?
ld hl, (INPUTPOS) call toword
ld a, (hl) ld a, (hl)
cp ';' cp ';'
jr nz, .compile jr nz, .compile

View File

@ -42,13 +42,28 @@ directly, but as part of another word.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
CREATE x -- Create cell named x. Doesn't allocate a PF. CREATE x -- Create cell named x. Doesn't allocate a PF.
COMPILE x -- Compile word x and write it to HERE [COMPILE] x -- Compile word x and write it to HERE
COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file DOES> -- See description at top of file
IMMEDIATE -- Flag the latest defined word as immediate. IMMEDIATE -- Flag the latest defined word as immediate.
LITN n -- *I* Inserts number from TOS as a literal LITN n -- *I* Inserts number from TOS as a literal
VARIABLE c -- Creates cell x with 2 bytes allocation. VARIABLE c -- Creates cell x with 2 bytes allocation.
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
its straightforward: It writes down to HERE wither the address of the word or
a number literal.
When you *meta* compile, it's a bit more mind blowing. It fetches the address
of the word specified by the caller, then writes that number as a literal,
followed by a reference to ",".
Example: ": foo [COMPILE] bar;" is the equivalent of ": foo bar ;" if bar is
not an immediate. However, ": foo COMPILE bar ;" is the equivalent of
": foo ['] bar , ;". Got it?
Meta-compile only works with real words, not number literals.
*** Flow *** *** Flow ***
Note about flow words: flow words can only be used in definitions. In the Note about flow words: flow words can only be used in definitions. In the
INTERPRET loop, they don't have the desired effect because each word from the INTERPRET loop, they don't have the desired effect because each word from the

View File

@ -4,25 +4,35 @@ pad:
ld a, PADDING ld a, PADDING
jp addHL jp addHL
; Advance (INPUTPOS) until a non-whitespace is met. If needed,
; call fetchline.
; Set HL to newly set (INPUTPOS)
toword:
ld hl, (INPUTPOS)
; skip leading whitespace
dec hl ; offset leading "inc hl"
.loop:
inc hl
ld a, (hl)
or a
; When at EOL, fetch a new line directly
jr z, .empty
cp ' '+1
jr c, .loop
ret
.empty:
call fetchline
jr toword
; Read word from (INPUTPOS) and return, in HL, a null-terminated word. ; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
; Advance (INPUTPOS) to the character following the whitespace ending the ; Advance (INPUTPOS) to the character following the whitespace ending the
; word. ; word.
; When we're at EOL, we call fetchline directly, so this call always returns ; When we're at EOL, we call fetchline directly, so this call always returns
; a word. ; a word.
readword: readword:
ld hl, (INPUTPOS) call toword
; skip leading whitespace
dec hl ; offset leading "inc hl"
.loop1:
inc hl
ld a, (hl)
or a
; When at EOL, fetch a new line directly
jr z, .empty
cp ' '+1
jr c, .loop1
push hl ; --> lvl 1. that's our result push hl ; --> lvl 1. that's our result
.loop2: .loop:
inc hl inc hl
ld a, (hl) ld a, (hl)
; special case: is A null? If yes, we will *not* inc A so that we don't ; special case: is A null? If yes, we will *not* inc A so that we don't
@ -30,7 +40,7 @@ readword:
or a or a
jr z, .noinc jr z, .noinc
cp ' '+1 cp ' '+1
jr nc, .loop2 jr nc, .loop
; we've just read a whitespace, HL is pointing to it. Let's transform ; we've just read a whitespace, HL is pointing to it. Let's transform
; it into a null-termination, inc HL, then set (INPUTPOS). ; it into a null-termination, inc HL, then set (INPUTPOS).
xor a xor a
@ -40,9 +50,6 @@ readword:
ld (INPUTPOS), hl ld (INPUTPOS), hl
pop hl ; <-- lvl 1. our result pop hl ; <-- lvl 1. our result
ret ; Z set from XOR A ret ; Z set from XOR A
.empty:
call fetchline
jr readword
; Sets Z if (HL) == E and (HL+1) == D ; Sets Z if (HL) == E and (HL+1) == D
HLPointsDE: HLPointsDE:

View File

@ -36,8 +36,8 @@ forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h
forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h
$(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@ $(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@
forth/core.bin: $(APPS)/forth/core.fth forth/stage1 forth/core.bin: $(APPS)/forth/core.fs forth/stage1
./forth/stage1 $(APPS)/forth/core.fth | tee $@ > /dev/null ./forth/stage1 $(APPS)/forth/core.fs | tee $@ > /dev/null
forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN) forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN)
$(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null $(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null