1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 12:20:56 +11:00

Compare commits

..

No commits in common. "5067d40e3b650cf951a73da255ce5ef30a73b4a2" and "4eca827d365bb183caee2cb04e67944ed66ca1e2" have entirely different histories.

9 changed files with 65 additions and 95 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.
f IF A ELSE B THEN: if f is true, execute A, if false, execute (br) -- Branches by the number specified in the 2 following
B. ELSE is optional. bytes. Can be negative.
BEGIN .. f UNTIL: if f is false, branch to BEGIN. (?br) f -- Branch if f is false.
BEGIN .. AGAIN: Always branch to BEGIN. ( -- *I* Comment. Ignore rest of line until ")" is read.
x y DO .. LOOP: LOOP increments y. if y != x, branch to DO. [ -- Begin interpretative mode. In a definition, words
x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute between here and "]" will be executed instead of
A, if x == z, execute B. Otherwise, execute C. compiled.
] -- End interpretative mode.
(cont.) ABORT -- Resets PS and RS and returns to interpreter. (cont.)

29
blk/043
View File

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

View File

@ -0,0 +1,4 @@
(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,38 +20,37 @@ 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? )
IFNZ, JRZ, L2 FWR ( end, no, wrong interrupt cause. )
( 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,
( advance W> ) ( +2 == ACIAW> )
HL INCss, ACIA_MEM 2 + LDHL(nn),
( +2 == ACIAW> ) ( is it == to ACIAR>? )
ACIA_MEM 2+ LD(nn)HL, ( +0 == ACIAR> )
( +6 == ACIA) ) DE ACIA_MEM LDdd(nn),
DE ACIA_MEM 6 + LDdd(nn), ( carry cleared from ANDn above )
DE SUBHLss, DE SBCHLss,
IFZ, ( end of buffer reached? ) JRZ, L3 FWR ( end, buffer full )
( yes )
( +4 == ACIA( ) DE ADDHLss, ( restore ACIAW> )
ACIA_MEM 4 + LDHL(nn), ( buffer not full, let's write )
( +2 == ACIAW> ) ACIA_IO INAn,
ACIA_MEM 2+ LD(nn)HL, (HL) A LDrr,
THEN,
THEN, ( advance W> )
THEN, HL INCss,
( +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,27 +55,6 @@
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 <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>} DUP <>{ 0x70 &= 0x58 |= 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 CRLF DUP .X LF
SWAP CURRENT @ + ( we wr ) SWAP CURRENT @ + ( we wr )
DUP .X CRLF DUP .X LF
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 CRLF H@ 4 + .X LF
; ;
( 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 `0042`, the address for initialization. To locate the end of a word, look for `0043`, 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,

View File

@ -1,13 +0,0 @@
: 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