1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 10:20:55 +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 effect because each word from the input stream is executed
immediately. In this context, branching doesn't work. immediately. In this context, branching doesn't work.
(br) -- Branches by the number specified in the 2 following f IF A ELSE B THEN: if f is true, execute A, if false, execute
bytes. Can be negative. B. ELSE is optional.
(?br) f -- Branch if f is false. BEGIN .. f UNTIL: if f is false, branch to BEGIN.
( -- *I* Comment. Ignore rest of line until ")" is read. BEGIN .. AGAIN: Always branch to BEGIN.
[ -- Begin interpretative mode. In a definition, words x y DO .. LOOP: LOOP increments y. if y != x, branch to DO.
between here and "]" will be executed instead of x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute
compiled. A, if x == z, execute B. Otherwise, execute C.
] -- End interpretative mode.
ABORT -- Resets PS and RS and returns to interpreter. (cont.) (cont.)

25
blk/043
View File

@ -1,16 +1,15 @@
(cont.) (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. 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 EXECUTE a -- Execute wordref at addr a
IF -- I:a *I* Compiles a (fbr?) and pushes its INTERPRET -- Get a line from stdin, compile it in tmp memory,
cell's addr then execute the compiled contents.
INTERPRET -- Get a line from stdin, compile it in tmp QUIT -- Return to interpreter prompt immediately
memory, then execute the compiled EXIT! -- Exit current INTERPRET loop.
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.)

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

@ -29,7 +29,7 @@ ACIA_MEM: Address in memory that can be used variables shared
: ACIA$ : ACIA$
H@ DUP DUP ACIA( ! ACIAR> ! H@ DUP DUP ACIA( ! ACIAR> !
1 + ACIAW> ! ( write index starts one position later ) 1+ ACIAW> ! ( write index starts one position later )
ACIABUFSZ ALLOT ACIABUFSZ ALLOT
H@ ACIA) ! H@ ACIA) !
( setup ACIA ( setup ACIA
@ -49,7 +49,7 @@ ACIA_MEM: Address in memory that can be used variables shared
: KEY : KEY
( inc then fetch ) ( inc then fetch )
ACIAR> @ 1 + DUP ACIA) @ = IF ACIAR> @ 1+ DUP ACIA) @ = IF
DROP ACIA( @ DROP ACIA( @
THEN THEN

View File

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

View File

@ -55,6 +55,27 @@
H@ 2- ( push a. -2 for allot offset ) H@ 2- ( push a. -2 for allot offset )
; IMMEDIATE ; 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 : CREATE
(entry) ( empty header with name ) (entry) ( empty header with name )
11 ( 11 == cellWord ) 11 ( 11 == cellWord )

View File

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