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

Compare commits

...

3 Commits

Author SHA1 Message Date
Virgil Dupras
7befe56597 forth: improve input flow
Readline, instead of being triggered by the end of execution of the last
compiled line is now triggered "just in time", by "WORD".

This allows IMMEDIATE words reading input buffer to span multiple lines
( comments for example, but colon definitions will soon follow ).
2020-03-14 19:10:39 -04:00
Virgil Dupras
e1f815baeb forth: Forth-ify main loop a bit
Add words "COMPILE" and "DROP". The goal is to soon make "DEFINE" immediate
and have it compile from input directly. This whole "main loop compiles
everything and DEFINE picks up compiled atoms" is a bit messy.
2020-03-14 17:48:24 -04:00
Virgil Dupras
764b2222c7 forth: replace (fbr?) by SKIP?
This will allow us to support backward branching with just one new (bbr) word.
Also, this allow us to have "(" word sooned in core.fth and thus allow for
earlier commenting.
2020-03-14 09:23:58 -04:00
5 changed files with 180 additions and 116 deletions

View File

@ -4,20 +4,24 @@
: ALLOT HERE +! ; : ALLOT HERE +! ;
: , H ! 2 ALLOT ; : , H ! 2 ALLOT ;
: C, H C! 1 ALLOT ; : C, H C! 1 ALLOT ;
: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE : NOT 1 SWAP SKIP? EXIT 0 * ;
: THEN DUP H -^ SWAP C! ; IMMEDIATE
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
: RECURSE R> R> 2 - >R >R EXIT ; : RECURSE R> R> 2 - >R >R EXIT ;
: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE : ( LIT@ ) WORD SCMP NOT SKIP? RECURSE ; IMMEDIATE
( Hello, hello, krkrkrkr... do you hear me? ) ( Hello, hello, krkrkrkr... do you hear me?
( Ah, voice at last! Some lines above need comments ) Ah, voice at last! Some lines above need comments
( IF: write (fbr?) addr, push HERE, create cell ) BTW: Forth lines limited to 64 cols because of default
( THEN: Subtract TOS from H to get offset to write to cell ) input buffer size in Collapse OS
( in that same TOS's addr ) NOT: a bit convulted because we don't have IF yet
( ELSE: write (fbr) addr, allot, then same as THEN ) RECURSE: RS TOS is for RECURSE itself, then we have to dig
( RECURSE: RS TOS is for RECURSE itself, then we have to dig ) one more level to get to RECURSE's parent's caller.
( one more level to get to RECURSE's parent's caller. ) IF true, skip following (fbr). Also, push br cell ref H,
: NOT IF 0 ELSE 1 THEN ; 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 ; : VARIABLE CREATE 2 ALLOT ;
: CONSTANT CREATE H ! DOES> @ ; : CONSTANT CREATE H ! DOES> @ ;

View File

@ -206,7 +206,6 @@ PFETCH:
EXECUTE: EXECUTE:
.dw nativeWord .dw nativeWord
pop iy ; is a wordref pop iy ; is a wordref
executeCodeLink:
ld l, (iy) ld l, (iy)
ld h, (iy+1) ld h, (iy+1)
; HL points to code pointer ; HL points to code pointer
@ -216,9 +215,68 @@ executeCodeLink:
jp (hl) ; go! jp (hl) ; go!
.db "COMPILE"
.dw EXECUTE
.db 1 ; IMMEDIATE
COMPILE:
.dw nativeWord
pop hl ; word addr
call find
jr nz, .maybeNum
ex de, hl
call HLisIMMED
jr z, .immed
ex de, hl
call .writeDE
jp next
.maybeNum:
push hl ; --> lvl 1. save string addr
call parseLiteral
pop hl ; <-- lvl 1
jr nz, .undef
; a valid number in DE!
ex de, hl
ld de, NUMBER
call .writeDE
ex de, hl ; number in DE
call .writeDE
jp next
.undef:
; When encountering an undefined word during compilation, we spit a
; reference to litWord, followed by the null-terminated word.
; This way, if a preceding word expect a string literal, it will read it
; by calling readLIT, and if it doesn't, the routine will be
; called, triggering an abort.
ld de, LIT
call .writeDE
ld de, (HERE)
call strcpyM
ld (HERE), de
jp next
.immed:
; For this IMMEDIATE word to be compatible with regular execution model,
; it needs to be compiled as an atom somewhere in memory.
; For example, RECURSE backtracks in RS and steps back 2 bytes. This
; can only work with our compiled atom being next to an EXIT atom.
ex de, hl ; atom to write in DE
ld hl, (OLDHERE)
push hl \ pop iy
call DEinHL
ld de, EXIT
call DEinHL
jp compiledWord
.writeDE:
push hl
ld hl, (HERE)
call DEinHL
ld (HERE), hl
pop hl
ret
.db ";" .db ";"
.fill 6 .fill 6
.dw EXECUTE .dw COMPILE
.db 0 .db 0
ENDDEF: ENDDEF:
.dw nativeWord .dw nativeWord
@ -377,7 +435,6 @@ KEY:
WORD: WORD:
.dw nativeWord .dw nativeWord
call readword call readword
jp nz, abort
push hl push hl
jp next jp next
@ -411,10 +468,18 @@ CURRENT_:
.dw sysvarWord .dw sysvarWord
.dw CURRENT .dw CURRENT
.db "IN>"
.fill 4
.dw CURRENT_
.db 0
INP:
.dw sysvarWord
.dw INPUTPOS
; ( n -- ) ; ( n -- )
.db "." .db "."
.fill 6 .fill 6
.dw CURRENT_ .dw INP
.db 0 .db 0
DOT: DOT:
.dw nativeWord .dw nativeWord
@ -487,10 +552,20 @@ LITFETCH:
push hl push hl
jp next jp next
; ( a -- )
.db "DROP"
.fill 3
.dw LITFETCH
.db 0
DROP:
.dw nativeWord
pop hl
jp next
; ( a b -- b a ) ; ( a b -- b a )
.db "SWAP" .db "SWAP"
.fill 3 .fill 3
.dw LITFETCH .dw DROP
.db 0 .db 0
SWAP: SWAP:
.dw nativeWord .dw nativeWord
@ -711,12 +786,27 @@ CMP:
push bc push bc
jp next jp next
.db "SKIP?"
.fill 2
.dw CMP
.db 0
CSKIP:
.dw nativeWord
pop hl
ld a, h
or l
jp z, next ; False, do nothing.
ld hl, (IP)
call compSkip
ld (IP), hl
jp next
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to ; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
; where to branch to. For example, The branching cell of "IF THEN" would ; where to branch to. For example, The branching cell of "IF THEN" would
; contain 3. Add this value to RS. ; contain 3. Add this value to RS.
.db "(fbr)" .db "(fbr)"
.fill 2 .fill 2
.dw CMP .dw CSKIP
.db 0 .db 0
FBR: FBR:
.dw nativeWord .dw nativeWord
@ -728,23 +818,6 @@ FBR:
pop de pop de
jp next jp next
; Conditional branch, only branch if TOS is zero
.db "(fbr?)"
.fill 1
.dw FBR
.db 0
FBRC:
.dw nativeWord
pop hl
ld a, h
or l
jr z, FBR+2
; skip next byte in RS
ld hl, (IP)
inc hl
ld (IP), hl
jp next
LATEST: LATEST:
.dw FBRC .dw FBR

View File

@ -49,10 +49,9 @@ LITERAL 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.
*** Flow *** *** Flow ***
(fbr?) f -- Conditionally branches forward by the number
specified in its atom's cell.
(fbr) -- Branches forward by the number specified in its (fbr) -- Branches forward by the number specified in its
atom's cell. atom's cell.
COMPILE a -- Compile string word at addr a and spit it to HERE.
ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a. ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a.
EXECUTE a -- Execute wordref at addr a EXECUTE a -- Execute wordref at addr a
IF -- I:a *I* Compiles a (fbr?) and pushes its cell's addr IF -- I:a *I* Compiles a (fbr?) and pushes its cell's addr
@ -60,9 +59,13 @@ INTERPRET -- Get a line from stdin, compile it in tmp memory,
then execute the compiled contents. then execute the compiled contents.
QUIT R:drop -- Return to interpreter promp immediately QUIT R:drop -- Return to interpreter promp immediately
RECURSE R:I -- R:I-2 Run the current word again. RECURSE R:I -- R:I-2 Run the current word again.
SKIP? f -- If f is true, skip the execution of the next atom.
Use this right before ";" and you're gonna have a
bad time.
THEN I:a -- *I* Set branching cell at a. THEN I:a -- *I* Set branching cell at a.
*** Parameter Stack *** *** Parameter Stack ***
DROP a --
DUP a -- a a DUP a -- a a
OVER a b -- a b a OVER a b -- a b a
SWAP a b -- b a SWAP a b -- b a
@ -109,10 +112,21 @@ LIT@ x -- a Read following LIT and push its addr to a
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
*** I/O *** *** I/O ***
A little word about inputs. There are two kind of inputs: direct and buffered.
As a general rule, we read line in a buffer, then feed words in it to the
interpreter. That's what "WORD" does. If it's at the End Of Line, it blocks and
wait until another line is entered.
KEY input, however, is direct. Regardless of the input buffer's state, KEY will
return the next typed key.
. n -- Print n in its decimal form . n -- Print n in its decimal form
EMIT c -- Spit char c to stdout EMIT c -- Spit char c to output stream
KEY -- c Get char c from stdin IN> -- a Address of variable containing current pos in input
buffer.
KEY -- c Get char c from direct input
PC! c a -- Spit c to port a PC! c a -- Spit c to port a
PC@ a -- c Fetch c from port a PC@ a -- c Fetch c from port a
WORD -- a Read one word from stdin and push its addr WORD -- a Read one word from buffered input and push its addr

View File

@ -69,7 +69,7 @@
; EXECUTING A WORD ; EXECUTING A WORD
; ;
; At it's core, executing a word is having the wordref in IY and call ; At it's core, executing a word is having the wordref in IY and call
; executeCodeLink. Then, we let the word do its things. Some words are special, ; EXECUTE. Then, we let the word do its things. Some words are special,
; but most of them are of the compiledWord type, and that's their execution that ; but most of them are of the compiledWord type, and that's their execution that
; we describe here. ; we describe here.
; ;
@ -102,16 +102,16 @@ forthMain:
ld (CURRENT), hl ld (CURRENT), hl
ld hl, HERE_INITIAL ld hl, HERE_INITIAL
ld (HERE), hl ld (HERE), hl
; Set (INPUTPOS) to somewhere where there's a NULL so we consider
; ourselves EOL.
ld (INPUTPOS), hl
xor a
ld (hl), a
forthRdLine: forthRdLine:
ld hl, msgOk ld hl, msgOk
call printstr call printstr
forthRdLineNoOk: forthRdLineNoOk:
call printcrlf ; Setup return stack. After INTERPRET, we run forthExecLine
call stdioReadLine
ld (INPUTPOS), hl
; Setup return stack. As a safety net, we set its bottom to ABORTREF.
ld hl, ABORTREF
ld (RS_ADDR), hl
ld ix, RS_ADDR ld ix, RS_ADDR
; We're about to compile the line and possibly execute IMMEDIATE words. ; We're about to compile the line and possibly execute IMMEDIATE words.
; Let's save current (HERE) and temporarily set it to COMPBUF. ; Let's save current (HERE) and temporarily set it to COMPBUF.
@ -119,61 +119,24 @@ forthRdLineNoOk:
ld (OLDHERE), hl ld (OLDHERE), hl
ld hl, COMPBUF ld hl, COMPBUF
ld (HERE), hl ld (HERE), hl
forthInterpret: ld hl, .retRef
call readword ld (IP), hl
jr nz, .execute ld hl, INTERPRET
call find push hl
jr nz, .maybeNum jp EXECUTE+2
ex de, hl .retRef:
call HLisIMMED .dw $+2
jr z, .immed .dw forthExecLine
ex de, hl
call .writeDE forthExecLine:
jr forthInterpret
.maybeNum:
push hl ; --> lvl 1. save string addr
call parseLiteral
pop hl ; <-- lvl 1
jr nz, .undef
; a valid number in DE!
ex de, hl
ld de, NUMBER
call .writeDE
ex de, hl ; number in DE
call .writeDE
jr forthInterpret
.undef:
; When encountering an undefined word during compilation, we spit a
; reference to litWord, followed by the null-terminated word.
; This way, if a preceding word expect a string literal, it will read it
; by calling readLIT, and if it doesn't, the routine will be
; called, triggering an abort.
ld de, LIT
call .writeDE
ld de, (HERE)
call strcpyM
ld (HERE), de
jr forthInterpret
.immed:
; For this IMMEDIATE word to be compatible with regular execution model,
; it needs to be compiled as an atom list. We need a temporary space for
; this, let's use (OLDHERE) while it isn't used.
ex de, hl ; atom to write in DE
ld hl, (OLDHERE)
call DEinHL
; Now, let's write the .retRef
ld de, .retRef
call DEinHL
ld iy, (OLDHERE)
jr .execIY
.execute:
ld de, QUIT ld de, QUIT
call .writeDE ld hl, (HERE)
call DEinHL
ld (HERE), hl
; Compilation done, let's restore (HERE) and execute! ; Compilation done, let's restore (HERE) and execute!
ld hl, (OLDHERE) ld hl, (OLDHERE)
ld (HERE), hl ld (HERE), hl
ld iy, COMPBUF ld iy, COMPBUF
.execIY:
; before we execute, let's play with our RS a bit: compiledWord is ; before we execute, let's play with our RS a bit: compiledWord is
; going to push (IP) on the RS, but we don't expect our compiled words ; going to push (IP) on the RS, but we don't expect our compiled words
; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and ; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and
@ -182,16 +145,22 @@ forthInterpret:
ld (IP), hl ld (IP), hl
ld ix, RS_ADDR-2 ld ix, RS_ADDR-2
jp compiledWord jp compiledWord
.writeDE:
push hl
ld hl, (HERE)
call DEinHL
ld (HERE), hl
pop hl
ret
.retRef: ; (we don't have RECURSE here. Calling interpret makes us needlessly use our
.dw forthInterpret ; RS stack, but it can take it, can't it? )
; WORD COMPILE IN> @ C@ (to check if null) SKIP? (skip if not null) EXIT INTERPRET
.db 0b10 ; UNWORD
INTERPRET:
.dw compiledWord
.dw WORD
.dw COMPILE
.dw INP
.dw FETCH
.dw CFETCH
.dw CSKIP
.dw EXIT
.dw INTERPRET
.dw EXIT
msgOk: msgOk:
.db " ok", 0 .db " ok", 0

View File

@ -7,7 +7,8 @@ pad:
; 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.
; Z set of word was read, unset if end of line. ; When we're at EOL, we call fetchline directly, so this call always returns
; a word.
readword: readword:
ld hl, (INPUTPOS) ld hl, (INPUTPOS)
; skip leading whitespace ; skip leading whitespace
@ -16,6 +17,7 @@ readword:
inc hl inc hl
ld a, (hl) ld a, (hl)
or a or a
; When at EOL, fetch a new line directly
jr z, .empty jr z, .empty
cp ' '+1 cp ' '+1
jr c, .loop1 jr c, .loop1
@ -39,9 +41,8 @@ readword:
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: .empty:
ld (hl), a call fetchline
inc a ; unset Z jr readword
ret
; Sets Z if (HL) == E and (HL+1) == D ; Sets Z if (HL) == E and (HL+1) == D
HLPointsDE: HLPointsDE:
@ -73,10 +74,6 @@ HLPointsBR:
push de push de
ld de, FBR ld de, FBR
call HLPointsDE call HLPointsDE
jr z, .end
ld de, FBRC
call HLPointsDE
.end:
pop de pop de
ret ret
@ -340,3 +337,10 @@ DEinHL:
ld (hl), d ld (hl), d
inc hl inc hl
ret ret
fetchline:
call printcrlf
call stdioReadLine
ld (INPUTPOS), hl
ret