1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 10:30: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.)

29
blk/043
View File

@ -1,16 +1,15 @@
(cont.) (cont.)
ABORT" x" -- *I* Compiles a ." followed by a ABORT. (br) -- Branches by the number specified in the 2
AGAIN I:a -- *I* Jump backwards to preceeding BEGIN. following bytes. Can be negative.
BEGIN -- I:a *I* Marker for backward branching with (?br) f -- Branch if f is false.
AGAIN. ( -- *I* Comment. Ignore input until ")" is read.
ELSE I:a -- *I* Compiles a (fbr) and set branching [ -- Begin interpretative mode. In a definition,
cell at a. execute words instead of compiling them.
EXECUTE a -- Execute wordref at addr a ] -- End interpretative mode.
IF -- I:a *I* Compiles a (fbr?) and pushes its ABORT -- Resets PS and RS and returns to interpreter.
cell's addr ABORT" x" -- *I* Compiles a ." followed by a ABORT.
INTERPRET -- Get a line from stdin, compile it in tmp EXECUTE a -- Execute wordref at addr a
memory, then execute the compiled INTERPRET -- Get a line from stdin, compile it in tmp memory,
contents. then execute the compiled contents.
QUIT R:drop -- Return to interpreter prompt immediately QUIT -- Return to interpreter prompt immediately
RECURSE R:I -- R:I-2 Run the current word again. EXIT! -- Exit current INTERPRET loop.
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,37 +20,38 @@ 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> )
ACIA_MEM 2+ LDHL(nn),
( is it == to ACIAR>? )
( +0 == ACIAR> )
DE ACIA_MEM LDdd(nn),
( carry cleared from ANDn above )
DE SBCHLss,
IFNZ, ( buffer full? )
( no, continue )
DE ADDHLss, ( restore ACIAW> )
( buffer not full, let's write )
ACIA_IO INAn,
(HL) A LDrr,
( +2 == ACIAW> ) ( advance W> )
ACIA_MEM 2 + LDHL(nn), HL INCss,
( is it == to ACIAR>? ) ( +2 == ACIAW> )
( +0 == ACIAR> ) ACIA_MEM 2+ LD(nn)HL,
DE ACIA_MEM LDdd(nn), ( +6 == ACIA) )
( carry cleared from ANDn above ) DE ACIA_MEM 6 + LDdd(nn),
DE SBCHLss, DE SUBHLss,
JRZ, L3 FWR ( end, buffer full ) IFZ, ( end of buffer reached? )
( yes )
DE ADDHLss, ( restore ACIAW> ) ( +4 == ACIA( )
( buffer not full, let's write ) ACIA_MEM 4 + LDHL(nn),
ACIA_IO INAn, ( +2 == ACIAW> )
(HL) A LDrr, ACIA_MEM 2+ LD(nn)HL,
THEN,
( advance W> ) THEN,
HL INCss, THEN,
( +2 == ACIAW> )
ACIA_MEM 2 + LD(nn)HL,
( +6 == ACIA) )
DE ACIA_MEM 6 + LDdd(nn),
DE SUBHLss,
JRNZ, L4 FWR ( skip )
( end of buffer reached )
( +4 == ACIA( )
ACIA_MEM 4 + LDHL(nn),
( +2 == ACIAW> )
ACIA_MEM 2 + LD(nn)HL,
L4 FSET ( skip )
L3 FSET L2 FSET ( end )
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