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

Compare commits

..

4 Commits

Author SHA1 Message Date
Virgil Dupras
5067d40e3b Add CASE..OF words 2020-04-16 15:07:31 -04:00
Virgil Dupras
733aff7b7a rc2014: adjust bootstrapping instructions 2020-04-16 09:27:49 -04:00
Virgil Dupras
65bc3b73ad link: adjust (br) and (?br) hardcoded offsets
They changed in my earlier commit.
2020-04-16 09:26:01 -04:00
Virgil Dupras
b01de82fd1 drv/acia: latest bells and whistles 2020-04-16 08:18:55 -04:00
9 changed files with 95 additions and 65 deletions

18
blk/042
View File

@ -5,12 +5,12 @@ definitions. In the INTERPRET loop, they don't have the desired
effect because each word from the input stream is executed
immediately. In this context, branching doesn't work.
(br) -- Branches by the number specified in the 2 following
bytes. Can be negative.
(?br) f -- Branch if f is false.
( -- *I* Comment. Ignore rest of line until ")" is read.
[ -- Begin interpretative mode. In a definition, words
between here and "]" will be executed instead of
compiled.
] -- End interpretative mode.
ABORT -- Resets PS and RS and returns to interpreter. (cont.)
f IF A ELSE B THEN: if f is true, execute A, if false, execute
B. ELSE is optional.
BEGIN .. f UNTIL: if f is false, branch to BEGIN.
BEGIN .. AGAIN: Always branch to BEGIN.
x y DO .. LOOP: LOOP increments y. if y != x, branch to DO.
x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute
A, if x == z, execute B. Otherwise, execute C.
(cont.)

25
blk/043
View File

@ -1,16 +1,15 @@
(cont.)
(br) -- Branches by the number specified in the 2
following bytes. Can be negative.
(?br) f -- Branch if f is false.
( -- *I* Comment. Ignore input until ")" is read.
[ -- Begin interpretative mode. In a definition,
execute words instead of compiling them.
] -- End interpretative mode.
ABORT -- Resets PS and RS and returns to interpreter.
ABORT" x" -- *I* Compiles a ." followed by a ABORT.
AGAIN I:a -- *I* Jump backwards to preceeding BEGIN.
BEGIN -- I:a *I* Marker for backward branching with
AGAIN.
ELSE I:a -- *I* Compiles a (fbr) and set branching
cell at a.
EXECUTE a -- Execute wordref at addr a
IF -- I:a *I* Compiles a (fbr?) and pushes its
cell's addr
INTERPRET -- Get a line from stdin, compile it in tmp
memory, then execute the compiled
contents.
QUIT R:drop -- Return to interpreter prompt immediately
RECURSE R:I -- R:I-2 Run the current word again.
THEN I:a -- *I* Set branching cell at a. (cont.)
INTERPRET -- Get a line from stdin, compile it in tmp memory,
then execute the compiled contents.
QUIT -- Return to interpreter prompt immediately
EXIT! -- Exit current INTERPRET loop.

View File

@ -1,4 +0,0 @@
(cont.)
UNTIL f -- *I* Jump backwards to BEGIN if f is
false.
EXIT! -- Exit current INTERPRET loop.

View File

@ -20,8 +20,8 @@ ACIA_MEM
( Read our character from ACIA into our BUFIDX )
ACIA_CTL INAn,
0x01 ANDn, ( is ACIA rcv buf full? )
JRZ, L2 FWR ( end, no, wrong interrupt cause. )
IFNZ,
( correct interrupt cause )
( +2 == ACIAW> )
ACIA_MEM 2+ LDHL(nn),
( is it == to ACIAR>? )
@ -29,8 +29,8 @@ ACIA_MEM
DE ACIA_MEM LDdd(nn),
( carry cleared from ANDn above )
DE SBCHLss,
JRZ, L3 FWR ( end, buffer full )
IFNZ, ( buffer full? )
( no, continue )
DE ADDHLss, ( restore ACIAW> )
( buffer not full, let's write )
ACIA_IO INAn,
@ -43,14 +43,15 @@ ACIA_MEM
( +6 == ACIA) )
DE ACIA_MEM 6 + LDdd(nn),
DE SUBHLss,
JRNZ, L4 FWR ( skip )
( end of buffer reached )
IFZ, ( end of buffer reached? )
( yes )
( +4 == ACIA( )
ACIA_MEM 4 + LDHL(nn),
( +2 == ACIAW> )
ACIA_MEM 2+ LD(nn)HL,
L4 FSET ( skip )
L3 FSET L2 FSET ( end )
THEN,
THEN,
THEN,
DE POPqq,
HL POPqq,

View File

@ -55,6 +55,27 @@
H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE
( During a CASE, the stack grows by 1 at each ENDOF so that
we can fill all those ENDOF branching addrs. So that we
know when to stop, we put a 0 on PSP. That's our stopgap. )
: CASE 0 ; IMMEDIATE
: OF
COMPILE OVER COMPILE =
[COMPILE] IF
; IMMEDIATE
: ENDOF [COMPILE] ELSE ; IMMEDIATE
( At this point, we have something like "0 e1 e2 e3 val". We
want top drop val, and then call THEN as long as we don't
hit 0. )
: ENDCASE
BEGIN
DUP NOT IF DROP EXIT THEN
[COMPILE] THEN
AGAIN
COMPILE DROP
; IMMEDIATE
: CREATE
(entry) ( empty header with name )
11 ( 11 == cellWord )

View File

@ -27,7 +27,7 @@
: ASKIP
DUP @ ( a n )
( ?br or br or NUMBER )
DUP <>{ 0x70 &= 0x58 |= 0x20 |= 0x24 |= <>}
DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
IF DROP 4 + EXIT THEN
( regular word )
0x22 = NOT IF 2+ EXIT THEN
@ -155,9 +155,9 @@
as variable space. )
4 + ( u+4 )
DUP H@ + ( u we )
DUP .X LF
DUP .X CRLF
SWAP CURRENT @ + ( we wr )
DUP .X LF
DUP .X CRLF
BEGIN ( we wr )
DUP ROT ( wr wr we )
( call RLWORD. we need a sig: ol o wr we )
@ -174,7 +174,7 @@
( Are we finished? We're finished if wr-4 <= H@ )
DUP 4 - H@ <=
UNTIL
H@ 4 + .X LF
H@ 4 + .X CRLF
;
( Relink a regular Forth full interpreter. )

View File

@ -169,7 +169,7 @@ same (`8d60`), the end offset depends on the situation.
If you look at data between `99f6` and `9a3c`, you'll see that this data is not
100% dictionary entry material. Some of it is buffer data allocated at
initialization. To locate the end of a word, look for `0043`, the address for
initialization. To locate the end of a word, look for `0042`, the address for
`EXIT`. In my case, it's at `9a1a` and it's the end of the `INIT` word.
Moreover, the `INIT` routine that is in there is not quite what we want,

13
tests/forth/test_flow.fs Normal file
View File

@ -0,0 +1,13 @@
: foo
CASE
'X' OF 42 ENDOF
0x12 OF 43 ENDOF
255 OF 44 ENDOF
45
ENDCASE
;
'X' foo 42 #eq
0x12 foo 43 #eq
255 foo 44 #eq
254 foo 45 #eq