mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:30:55 +11:00
Compare commits
4 Commits
4eca827d36
...
5067d40e3b
Author | SHA1 | Date | |
---|---|---|---|
|
5067d40e3b | ||
|
733aff7b7a | ||
|
65bc3b73ad | ||
|
b01de82fd1 |
18
blk/042
18
blk/042
@ -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
29
blk/043
@ -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.)
|
|
||||||
|
4
blk/044
4
blk/044
@ -1,4 +0,0 @@
|
|||||||
(cont.)
|
|
||||||
UNTIL f -- *I* Jump backwards to BEGIN if f is
|
|
||||||
false.
|
|
||||||
EXIT! -- Exit current INTERPRET loop.
|
|
@ -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
|
||||||
|
|
||||||
|
61
drv/acia.z80
61
drv/acia.z80
@ -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,
|
||||||
|
@ -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 )
|
||||||
|
@ -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. )
|
||||||
|
@ -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
13
tests/forth/test_flow.fs
Normal 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
|
Loading…
Reference in New Issue
Block a user