At line 3 added 3,451 lines |
{{{ |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 0 |
00 ****** fig-FORTH MODEL ****** |
01 |
02 Through the courtesy of |
03 |
04 |
05 FORTH INTEREST GROUP |
06 P. O. BOX 1105 |
07 SAN CARLOS, CA. 94070 |
08 |
09 Implemented on the |
0A ATARI 800/400 |
0B by |
0C Steve Calfee |
0D 1/26/81 |
0E |
0F Copywrite 1981 |
10 |
11 RELEASE 1 |
12 WITH COMPILER SECURITY |
13 AND |
14 VARIABLE LENGTH NAMES |
15 |
16 |
17 |
18 |
19 Further distribution must |
1A include the above notice. |
1B |
1C |
1D |
1E |
1F |
|
|
****** fig-FORTH MODEL ****** Through the courtesy of FORTH |
INTEREST GROUP P. O. BOX 1105 SAN CARLOS, |
CA. 94070 Implemented on the ATARI 800/400 by Steve Calfee |
1/26/81 Copywrite 1981 RELEASE 1 WITH COMPILER SECURITY AND |
VARIABLE LENGTH |
NAMES Further distribution must include the above notice. |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1 |
00 ****** fig-FORTH MODEL ****** |
01 |
02 Through the courtesy of |
03 |
04 |
05 FORTH INTEREST GROUP |
06 P. O. BOX 1105 |
07 SAN CARLOS, CA. 94070 |
08 |
09 Implemented on the |
0A ATARI 800/400 |
0B by |
0C Steve Calfee |
0D 1/26/81 |
0E |
0F Copywrite 1981 |
10 |
11 RELEASE 1 |
12 WITH COMPILER SECURITY |
13 AND |
14 VARIABLE LENGTH NAMES |
15 |
16 |
17 |
18 |
19 Further distribution must |
1A include the above notice. |
1B |
1C |
1D |
1E |
1F |
|
|
****** fig-FORTH MODEL ****** Through the courtesy of FORTH |
INTEREST GROUP P. O. BOX 1105 SAN CARLOS, |
CA. 94070 Implemented on the ATARI 800/400 by Steve Calfee |
1/26/81 Copywrite 1981 RELEASE 1 WITH COMPILER SECURITY AND |
VARIABLE LENGTH |
NAMES Further distribution must include the above notice. |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 2 |
00 BREAK Abort. |
01 |
02 IOCB already open. |
03 |
04 Non-existant device. |
05 |
06 IOCB is write-only. |
07 |
08 Invalid command (for this device |
09 ) |
0A Device or file not open. |
0B |
0C Bad IOCB # |
0D |
0E IOCB is read-only |
0F |
10 End Of File |
11 |
12 Truncated Record |
13 |
14 Device Timeout |
15 |
16 Device NAK (Negative AcKnowledge |
17 ) |
18 Serial Bus input framing error |
19 |
1A Cursor out of range |
1B |
1C Serial Bus data-frame overrun |
1D |
1E Serial Bus data-frame checksum e |
1F rror. |
|
|
BREAK Abort. IOCB already open. Non-existant device. IOCB is |
write-only. Invalid command (for this device) Device or file |
not open. Bad IOCB # IOCB is read-only End Of File Truncated |
Record Device Timeout Device NAK (Negative AcKnowledge) Serial |
Bus input framing error Cursor out of range Serial Bus |
data-frame overrun Serial Bus data-frame checksum error. |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 3 |
00 Device-done error |
01 |
02 Read-after-write compare error |
03 |
04 Function not implemented in hand |
05 ler |
06 Insufficient RAM |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
Device-done error Read-after-write compare error Function not |
implemented in handler Insufficient RAM |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 4 |
00 ( ERROR MESSAGES ) 135 159 |
01 9 8 7 10 ;S |
02 empty stack |
03 |
04 dictionary full |
05 |
06 has incorrect address mode |
07 |
08 isn't unique |
09 |
0A |
0B |
0C disc range ?? |
0D |
0E full stack ! |
0F |
10 disc error ! |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( ERROR MESSAGES ) |
135 159 9 8 7 10 ;S empty stack dictionary full has incorrect |
address mode isn't unique disc range ?? full stack ! disc error |
! |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 5 |
00 ( ERROR MESSAGES ) |
01 |
02 compilation only, use in definit |
03 ion |
04 execution only |
05 |
06 conditionals not paired |
07 |
08 definition not finished |
09 |
0A in protected dictionary |
0B |
0C use only when loading |
0D |
0E off current editing screen |
0F |
10 declare vocabulary |
11 |
12 outside allocated file space |
13 |
14 writing off current line |
15 |
16 |
17 |
18 |
19 |
1A string stack empty !! |
1B |
1C |
1D |
1E |
1F |
|
|
( ERROR MESSAGES ) |
compilation only, |
use in definition execution only conditionals not paired |
definition not finished in protected dictionary use only when |
loading off current editing screen declare vocabulary outside |
allocated file space writing off current line string stack |
empty !! |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 6 |
00 ( TARGET COMPILER ERROR MESSAGE |
01 S WFR-79JUN02 ) |
02 |
03 |
04 below lower bound of virtual mem |
05 ory |
06 disc compiler assembly error in |
07 mode of |
08 can't find in TARGET |
09 |
0A target redef. |
0B |
0C T: error, is it paired with T; |
0D ? |
0E above virtual memory bounds |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( TARGET COMPILER ERROR MESSAGES WFR-79JUN02 ) |
below lower bound of virtual memory disc compiler assembly |
error in mode of can't find in TARGET target redef. T: error, |
is it paired with T; ? above virtual memory bounds |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 7 |
00 ( <UNUSED> ) ;S |
01 |
02 |
03 |
04 |
05 |
06 |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( <UNUSED> ) |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 8 |
00 ( <UNUSED> ) ;S |
01 |
02 |
03 |
04 |
05 |
06 |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( <UNUSED> ) |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 9 |
00 ( compile assembler |
01 and editor SRC 7/6/80 ) |
02 BASE @ ( PRESERVE THE RADIX ) |
03 |
04 DECIMAL 31 WIDTH ! |
05 |
06 13 LOAD ( ASSEMBLER ) |
07 |
08 HEX 1E LOAD ( DECUS FORTH ADDS) |
09 |
0A HEX 15 LOAD ( EDITOR ) |
0B |
0C FORTH DEFINITIONS |
0D |
0E 25 CONSTANT LPWORDS |
0F |
10 27 CONSTANT FORMY |
11 : SAVENFAs ( MOVE FORTH NFAS TO |
12 ORIGIN AREA ) #LINKS 0 DO |
13 ' FORTH 4 + I 4 * + @ |
14 22 I 2* + +ORIGIN ! LOOP ; |
15 DECIMAL |
16 HERE 28 +ORIGIN ! ( FENCE ) |
17 |
18 HERE 30 +ORIGIN ! ( DP ) |
19 |
1A HERE FENCE ! |
1B 1 WARNING ! ( DISK WARNINGS ) |
1C SAVENFAs : TASK ; |
1D BASE ! |
1E ;S |
1F |
|
|
( compile assembler and editor SRC 7/6/80 ) |
BASE @ ( PRESERVE THE RADIX ) |
DECIMAL 31 WIDTH ! 13 LOAD |
( ASSEMBLER ) |
HEX 1E LOAD |
( DECUS FORTH ADDS) |
HEX 15 LOAD |
( EDITOR ) |
FORTH DEFINITIONS 25 CONSTANT LPWORDS |
27 CONSTANT FORMY |
: SAVENFAs |
( MOVE FORTH NFAS TO ORIGIN AREA ) |
#LINKS 0 |
DO |
' FORTH 4 + I 4 * + @ 22 I 2* + +ORIGIN ! |
LOOP |
; |
DECIMAL HERE 28 +ORIGIN ! ( FENCE ) |
HERE 30 +ORIGIN ! ( DP ) |
HERE FENCE ! 1 WARNING ! ( DISK WARNINGS ) |
SAVENFAs |
: TASK |
; |
BASE ! ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # A |
00 ( <UNUSED> ) ;S |
01 |
02 |
03 |
04 |
05 |
06 |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( <UNUSED> ) |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # B |
00 ( CLONING WORDS 7/21/80-SRC ) |
01 HEX FORTH DEFINITIONS |
02 : COPYDISK DR0 4E 0 DO I I 0800 |
03 + EDITOR COPY FORTH LOOP ; |
04 : CLONE DR0 0 PHYSOFF ! |
05 4E B + 0 DO I I 0800 + |
06 EDITOR COPY FORTH LOOP DR0 ; |
07 : 1.2TO1.3 DR0 8 OFFSET ! 4E 0 |
08 DO I I 0803 + EDITOR COPY |
09 FORTH LOOP DR0 ; |
0A : 1.3TO1.4 DR0 B PHYSOFF ! 4E 0 |
0B DO I I 0801 + COPY LOOP DR0 ; |
0C |
0D : OBJ DR0 0 PHYSOFF ! |
0E C 0 DO I I 0800 + EDITOR |
0F COPY FORTH LOOP DR0 ; |
10 CR |
11 ." INSERT SRCE DISK IN DRIVE 1 |
12 " CR |
13 ." INSERT DEST DISK IN DRIVE 2" |
14 CR |
15 ." TYPE CLONE TO COPY ALL OF IT |
16 " CR ." INCLUDING BOOT PROGRAM" |
17 CR ." TYPE COPYDISK TO COPY" |
18 CR ." SCREENS 0 TO 4E" |
19 CR ." TYPE OBJ TO COPY JUST" |
1A CR ." THE BOOTSTRAP B BLOCKS" |
1B CR ." TYPE 1.2TO1.3 TO COPY " |
1C CR ." OR TYPE 1.3TO1.4 TO COPY" |
1D CR ." YOUR OLD DISK SOURCES " |
1E CR ." TO THE NEW VERSION " |
1F CR ;S |
|
|
( CLONING WORDS 7/21/80-SRC ) |
HEX FORTH DEFINITIONS |
: COPYDISK |
DR0 4E 0 |
DO |
I I 0800 + EDITOR COPY FORTH |
LOOP |
; |
: CLONE |
DR0 0 PHYSOFF ! 4E B + 0 |
DO |
I I 0800 + EDITOR COPY FORTH |
LOOP |
DR0 |
; |
: 1.2TO1.3 |
DR0 8 OFFSET ! 4E 0 |
DO |
I I 0803 + EDITOR COPY FORTH |
LOOP |
DR0 |
; |
: 1.3TO1.4 |
DR0 B PHYSOFF ! 4E 0 |
DO |
I I 0801 + COPY |
LOOP |
DR0 |
; |
: OBJ |
DR0 0 PHYSOFF ! C 0 |
DO |
I I 0800 + EDITOR COPY FORTH |
LOOP |
DR0 |
; |
CR ." INSERT SRCE DISK IN DRIVE 1 " CR ." INSERT DEST DISK IN |
DRIVE 2" CR ." TYPE CLONE TO COPY ALL OF IT" CR ." INCLUDING |
BOOT PROGRAM" CR ." TYPE COPYDISK TO COPY" CR ." SCREENS 0 TO |
4E" CR ." TYPE OBJ TO COPY JUST" CR ." THE BOOTSTRAP B BLOCKS" |
CR ." TYPE 1.2TO1.3 TO COPY " CR ." OR TYPE 1.3TO1.4 TO COPY" |
CR ." YOUR OLD DISK SOURCES " CR ." TO THE NEW VERSION " CR ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # C |
00 ( <UNUSED> ) ;S |
01 |
02 |
03 |
04 |
05 |
06 |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( <UNUSED> ) |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # D |
00 ( FORTH-65 ASSEMBLER |
01 WFR-79JUN03 ) |
02 HEX |
03 |
04 VOCABULARY ASSEMBLER IMMEDIATE |
05 ASSEMBLER DEFINITIONS |
06 |
07 |
08 ( LOCATE EXISTING REGISTERS ) |
09 |
0A FF CONSTANT XSAVE 0FB CONS |
0B TANT W 0FD CONSTANT UP |
0C F8 CONSTANT IP F0 CO |
0D NSTANT N |
0E |
0F |
10 ( LOCATE EXISTING CODE PROCEEDU |
11 RES ) |
12 ' (DO) 0E + CONSTANT POP |
13 ( FROM COMPUTATION STACK *) |
14 ' (DO) 0C + CONSTANT POPT |
15 WO |
16 ' LIT 13 + CONSTANT PUT |
17 |
18 ' LIT 11 + CONSTANT PUSH |
19 |
1A ' LIT 18 + CONSTANT NEXT |
1B |
1C ' EXECUTE NFA 11 - CONSTANT |
1D SETUP |
1E --> |
1F |
|
|
( FORTH-65 ASSEMBLER WFR-79JUN03 ) |
HEX VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS |
( LOCATE EXISTING REGISTERS ) |
FF CONSTANT XSAVE |
0FB CONSTANT W |
0FD CONSTANT UP |
F8 CONSTANT IP |
F0 CONSTANT N |
( LOCATE EXISTING CODE PROCEEDURES ) |
' (DO) 0E + CONSTANT POP |
( FROM COMPUTATION STACK *) |
' (DO) 0C + CONSTANT POPTWO |
' LIT 13 + CONSTANT PUT |
' LIT 11 + CONSTANT PUSH |
' LIT 18 + CONSTANT NEXT |
' EXECUTE NFA 11 - CONSTANT SETUP |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # E |
00 ( ASSEMBLER, CONT. |
01 WFR-780CT03 ) |
02 0 VARIABLE INDEX -2 AL |
03 LOT |
04 0909 , 1505 , 0115 , 8011 , 8009 |
05 , 1D0D , 8019 , 8080 , |
06 0080 , 1404 , 8014 , 8080 , 8080 |
07 , 1C0C , 801C , 2C80 , |
08 |
09 |
0A 2 VARIABLE MODE |
0B |
0C : .A 0 MODE ! ; : # 1 MO |
0D DE ! ; : MEM 2 MODE ! ; |
0E : ,X 3 MODE ! ; : ,Y 4 MO |
0F DE ! ; : X) 5 MODE ! ; |
10 : )Y 6 MODE ! ; : ) F MO |
11 DE ! ; |
12 |
13 |
14 : BOT ,X 0 ; ( ADD |
15 RESS THE BOTTOM OF THE STACK *) |
16 : SEC ,X 2 ; ( |
17 ADDRESS SECOND ITEM ON STACK *) |
18 : RP) ,X 101 ; ( AD |
19 DRESS BOTTOM OF RETURN STACK *) |
1A --> |
1B |
1C |
1D |
1E |
1F |
|
|
( ASSEMBLER, CONT. WFR-780CT03 ) |
0 VARIABLE INDEX |
-2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 |
, 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 , 2 |
VARIABLE MODE |
: .A |
0 MODE ! |
; |
: # |
1 MODE ! |
; |
: MEM |
2 MODE ! |
; |
: ,X |
3 MODE ! |
; |
: ,Y |
4 MODE ! |
; |
: X) |
5 MODE ! |
; |
: )Y |
6 MODE ! |
; |
: ) |
F MODE ! |
; |
: BOT |
,X 0 |
; |
( ADDRESS THE BOTTOM OF THE STACK *) |
: SEC |
,X 2 |
; |
( ADDRESS SECOND ITEM ON STACK *) |
: RP) |
,X 101 |
; |
( ADDRESS BOTTOM OF RETURN STACK *) |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # F |
00 ( UPMODE, CPU |
01 WFR-78OCT23 ) |
02 |
03 |
04 : UPMODE IF MODE C@ 8 AND |
05 0= IF 8 MODE +! ENDIF ENDIF |
06 1 MODE C@ 0F AND -DUP IF |
07 0 DO DUP + LOOP ENDIF |
08 OVER 1+ @ AND 0= ; |
09 |
0A |
0B |
0C : CPU <BUILDS C, DOES> C@ |
0D C, MEM ; |
0E 00 CPU BRK, 18 CPU CLC, |
0F D8 CPU CLD, 58 CPU CLI, |
10 B8 CPU CLV, CA CPU DEX, |
11 88 CPU DEY, E8 CPU INX, |
12 C8 CPU INY, EA CPU NOP, |
13 48 CPU PHA, 08 CPU PHP, |
14 68 CPU PLA, 28 CPU PLP, |
15 40 CPU RTI, 60 CPU RTS, |
16 38 CPU SEC, F8 CPU SED, |
17 78 CPU SEI, AA CPU TAX, |
18 A8 CPU TAY, BA CPU TSX, |
19 8A CPU TXA, 9A CPU TXS, |
1A 98 CPU TYA, |
1B |
1C --> |
1D |
1E |
1F |
|
|
( UPMODE, CPU WFR-78OCT23 ) |
: UPMODE |
IF |
MODE C@ 8 AND 0= |
IF |
8 MODE +! |
ENDIF |
ENDIF |
1 MODE C@ 0F AND -DUP |
IF |
0 |
DO |
DUP + |
LOOP |
ENDIF |
OVER 1+ @ AND 0= |
; |
: CPU |
<BUILDS C, DOES> C@ C, MEM |
; |
00 CPU BRK, |
18 CPU CLC, |
D8 CPU CLD, |
58 CPU CLI, |
B8 CPU CLV, |
CA CPU DEX, |
88 CPU DEY, |
E8 CPU INX, |
C8 CPU INY, |
EA CPU NOP, |
48 CPU PHA, |
08 CPU PHP, |
68 CPU PLA, |
28 CPU PLP, |
40 CPU RTI, |
60 CPU RTS, |
38 CPU SEC, |
F8 CPU SED, |
78 CPU SEI, |
AA CPU TAX, |
A8 CPU TAY, |
BA CPU TSX, |
8A CPU TXA, |
9A CPU TXS, |
98 CPU TYA, |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 10 |
00 ( M/CPU, MULTI-MODE OP-CODES |
01 WFR-79MAR26 ) |
02 : M/CPU <BUILDS C, , DOES> |
03 |
04 DUP 1+ C@ 80 AND IF |
05 10 MODE +! ENDIF OVER |
06 FF00 AND UPMODE UPMODE |
07 IF MEM CR LATEST ID. |
08 3 ERROR ENDIF C@ MODE |
09 C@ |
0A INDEX + C@ + C, MODE |
0B C@ 7 AND IF MODE C@ |
0C 0F AND 7 < IF C, EL |
0D SE , ENDIF ENDIF MEM ; |
0E |
0F |
10 1C6E 60 M/CPU ADC, 1C6E 20 M |
11 /CPU AND, 1C6E C0 M/CPU CMP, |
12 1C6E 40 M/CPU EOR, 1C6E A0 M |
13 /CPU LDA, 1C6E 00 M/CPU ORA, |
14 1C6E E0 M/CPU SBC, 1C6C 80 M |
15 /CPU STA, 0D0D 01 M/CPU ASL, |
16 0C0C C1 M/CPU DEC, 0C0C E1 M |
17 /CPU INC, 0D0D 41 M/CPU LSR, |
18 0D0D 21 M/CPU ROL, 0D0D 61 M |
19 /CPU ROR, 0414 81 M/CPU STX, |
1A 0486 E0 M/CPU CPX, 0486 C0 M |
1B /CPU CPY, 1496 A2 M/CPU LDX, |
1C 0C8E A0 M/CPU LDY, 048C 80 M |
1D /CPU STY, 0480 14 M/CPU JSR, |
1E 8480 40 M/CPU JMP, 0484 20 M |
1F /CPU BIT, --> |
|
|
( M/CPU, MULTI-MODE OP-CODES WFR-79MAR26 ) |
: M/CPU |
<BUILDS C, , DOES> DUP 1+ C@ 80 AND |
IF |
10 MODE +! |
ENDIF |
OVER FF00 AND UPMODE UPMODE |
IF |
MEM CR LATEST ID. 3 ERROR |
ENDIF |
C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND |
IF |
MODE C@ 0F AND 7 < |
IF |
C, |
ELSE |
, |
ENDIF |
ENDIF |
MEM |
; |
1C6E 60 M/CPU ADC, |
1C6E 20 M/CPU AND, |
1C6E C0 M/CPU CMP, |
1C6E 40 M/CPU EOR, |
1C6E A0 M/CPU LDA, |
1C6E 00 M/CPU ORA, |
1C6E E0 M/CPU SBC, |
1C6C 80 M/CPU STA, |
0D0D 01 M/CPU ASL, |
0C0C C1 M/CPU DEC, |
0C0C E1 M/CPU INC, |
0D0D 41 M/CPU LSR, |
0D0D 21 M/CPU ROL, |
0D0D 61 M/CPU ROR, |
0414 81 M/CPU STX, |
0486 E0 M/CPU CPX, |
0486 C0 M/CPU CPY, |
1496 A2 M/CPU LDX, |
0C8E A0 M/CPU LDY, |
048C 80 M/CPU STY, |
0480 14 M/CPU JSR, |
8480 40 M/CPU JMP, |
0484 20 M/CPU BIT, |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 11 |
00 ( ASSEMBLER CONDITIONALS |
01 WFR-79MAR26 ) |
02 : BEGIN, HERE 1 ; IMMEDIATE |
03 : UNTIL, ?EXEC >R 1 ?PAIRS R> |
04 C, HERE 1+ - C, ; IMMEDIATE |
05 : IF, C, HERE 0 C, 2 ; IMMEDIATE |
06 : ENDIF, ?EXEC 2 ?PAIRS HERE |
07 OVER C@ |
08 IF SWAP ! ELSE OVER 1+ - |
09 SWAP C! ENDIF ; IMMEDIATE |
0A : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, |
0B SWAP HERE OVER 1+ - SWAP C! 2 ; |
0C IMMEDIATE |
0D : THEN, [COMPILE] ENDIF, ; |
0E IMMEDIATE : END, [COMPILE] |
0F UNTIL, ; IMMEDIATE |
10 : NOT 20 + ; |
11 ( REVERSE ASSEMBLY TEST ) |
12 90 CONSTANT CS ( ASSEMBLER |
13 TEST FOR CARRY SET ) |
14 D0 CONSTANT 0= ( ASSEMBLER |
15 TEST FOR EQUAL ZERO ) |
16 10 CONSTANT 0< ( ASSEMBLER |
17 TEST FOR LESS THAN ZERO ) |
18 90 CONSTANT >= ( ASSEMBLER |
19 TEST FOR GREATER OR EQUAL ZERO ) |
1A ( >= IS ONLY CORRECT AFTER SUB, |
1B OR CMP, ) |
1C 50 CONSTANT VS ( ASSEMBLER |
1D TEST FOR OVERFLOW BIT SET ) |
1E --> |
1F |
|
|
( ASSEMBLER CONDITIONALS WFR-79MAR26 ) |
: BEGIN, |
HERE 1 |
; |
IMMEDIATE |
: UNTIL, |
?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, |
; |
IMMEDIATE |
: IF, |
C, HERE 0 C, 2 |
; |
IMMEDIATE |
: ENDIF, |
?EXEC 2 ?PAIRS HERE OVER C@ |
IF |
SWAP ! |
ELSE |
OVER 1+ - SWAP C! |
ENDIF |
; |
IMMEDIATE |
: ELSE, |
2 ?PAIRS HERE 1+ 1 JMP, |
SWAP HERE OVER 1+ - SWAP C! 2 |
; |
IMMEDIATE |
: THEN, |
[COMPILE] |
ENDIF, |
; |
IMMEDIATE |
: END, |
[COMPILE] |
UNTIL, |
; |
IMMEDIATE |
: NOT |
20 + |
; |
( REVERSE ASSEMBLY TEST ) |
90 CONSTANT CS |
( ASSEMBLER TEST FOR CARRY SET ) |
D0 CONSTANT 0= |
( ASSEMBLER TEST FOR EQUAL ZERO ) |
10 CONSTANT 0< |
( ASSEMBLER TEST FOR LESS THAN ZERO ) |
90 CONSTANT >= |
( ASSEMBLER TEST FOR GREATER OR EQUAL ZERO ) |
( >= IS ONLY CORRECT AFTER SUB, OR CMP, ) |
50 CONSTANT VS |
( ASSEMBLER TEST FOR OVERFLOW BIT SET ) |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 12 |
00 ( USE OF ASSEMBLER |
01 WFR-79APR28 ) |
02 : C; |
03 ( END OF CODE DEFINITION *) |
04 CURRENT @ CONTEXT ! ?EXEC |
05 ?CSP SMUDGE ; IMMEDIATE |
06 |
07 |
08 FORTH DEFINITIONS |
09 |
0A : CODE ( CREATE WORD AT ASS |
0B EMBLY CODE LEVEL *) |
0C ?EXEC CREATE [COMPILE] |
0D ASSEMBLER |
0E ASSEMBLER MEM !CSP ; |
0F IMMEDIATE |
10 DECIMAL |
11 ' ASSEMBLER CFA ' ;CODE 8 |
12 + ! ( OVER-WRITE SMUDGE ) |
13 |
14 --> |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( USE OF ASSEMBLER WFR-79APR28 ) |
: C; |
( END OF CODE DEFINITION *) |
CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE |
; |
IMMEDIATE FORTH DEFINITIONS |
: CODE |
( CREATE WORD AT ASSEMBLY CODE LEVEL *) |
?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP |
; |
IMMEDIATE DECIMAL ' ASSEMBLER CFA ' |
;CODE |
8 + ! ( OVER-WRITE SMUDGE ) |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 13 |
00 ( EXEC, routines ) BASE @ HEX |
01 ASSEMBLER DEFINITIONS |
02 CODE xec IP LDA, W STA, IP 1+ |
03 LDA, W 1+ STA, ( save IP ) |
04 PLA, CLC, 1 # ADC, IP STA, |
05 PLA, |
06 0 # ADC, IP 1+ STA, ( get new |
07 IP) |
08 W 1+ LDA, PHA, W LDA, PHA, |
09 ( save last IP ) NEXT JMP, C; |
0A CODE xec2 IP LDA, W STA, IP 1+ |
0B LDA, W 1+ STA, ( save IP to |
0C continue in the code routine ) |
0D PLA, IP STA, PLA, IP 1+ STA, |
0E ( Restore old IP ) |
0F W ) JMP, C; |
10 |
11 : EXEC, ( addr -- ^ EXECUTE |
12 COLON WORD IN A CODE DEF ) |
13 ( addr = PFA OF COLON WORD ) |
14 ' xec JSR, |
15 CFA , ' xec2 CFA , ; |
16 |
17 FORTH DEFINITIONS DECIMAL |
18 |
19 HERE 28 +ORIGIN ! ( FENCE ) |
1A |
1B HERE 30 +ORIGIN ! ( DP ) |
1C |
1D ' ASSEMBLER 2 + |
1E 32 +ORIGIN ! ( VOC-LINK ) |
1F HERE FENCE ! BASE ! ;S |
|
|
( EXEC, routines ) |
BASE @ HEX ASSEMBLER DEFINITIONS |
CODE xec |
IP LDA, |
W STA, |
IP 1+ LDA, |
W 1+ STA, |
( save IP ) |
PLA, |
CLC, |
1 # ADC, |
IP STA, |
PLA, |
0 # ADC, |
IP 1+ STA, |
( get new IP) |
W 1+ LDA, |
PHA, |
W LDA, |
PHA, |
( save last IP ) |
NEXT JMP, |
C; |
CODE xec2 |
IP LDA, |
W STA, |
IP 1+ LDA, |
W 1+ STA, |
( save IP to continue in the code routine ) |
PLA, |
IP STA, |
PLA, |
IP 1+ STA, |
( Restore old IP ) |
W ) JMP, |
C; |
: EXEC, |
( addr -- ^ EXECUTE COLON WORD IN A CODE DEF ) |
( addr = PFA OF COLON WORD ) |
' xec JSR, |
CFA , ' xec2 CFA , |
; |
FORTH DEFINITIONS DECIMAL HERE 28 +ORIGIN ! ( FENCE ) |
HERE 30 +ORIGIN ! ( DP ) |
' ASSEMBLER 2 + 32 +ORIGIN ! ( VOC-LINK ) |
HERE FENCE ! BASE ! ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 14 |
00 ( LPWORDS FOR JOYSTICK CONTROLLE |
01 R JACKS ) |
02 CODE STROBE BOT LDA, D301 STA, |
03 80 # ORA, D301 STA, |
04 POP JMP, C; : PRT D303 C@ FB |
05 AND D303 C! FF D301 C! D303 |
06 C@ 4 OR D303 C! BEGIN D013 C@ 1 |
07 AND 0= UNTIL 7F AND STROBE ; |
08 : LYP1 DUP IF 0 DO DUP I + C@ PR |
09 T LOOP DROP |
0A ELSE DROP DROP THEN ; |
0B : LYPE LYP1 20 PRT ; |
0C : CRLP 0D PRT 0A PRT ; : FFLP 0C |
0D PRT CRLP ; |
0E : .LP S->D SWAP OVER DABS <# #S |
0F SIGN #> |
10 LYPE ; |
11 |
12 : LISTLP DUP SCR ! CRLP |
13 0E PRT ( [ SCREEN ] LYPE ) .LP |
14 0F PRT 10 0 DO CRLP I DUP .LP |
15 LINE C/L -TRAILING LYPE LOOP |
16 CRLP ; : SHOWLP 1+ SWAP |
17 DO I LISTLP 3 0 DO CRLP |
18 LOOP LOOP ; |
19 |
1A ;S |
1B |
1C |
1D |
1E |
1F |
|
|
( LPWORDS FOR JOYSTICK CONTROLLER JACKS ) |
CODE STROBE |
BOT LDA, |
D301 STA, |
80 # ORA, |
D301 STA, |
POP JMP, |
C; |
: PRT |
D303 C@ FB AND D303 C! FF D301 C! D303 C@ 4 OR D303 C! |
BEGIN |
D013 C@ 1 AND 0= |
UNTIL |
7F AND STROBE |
; |
: LYP1 |
DUP |
IF |
0 |
DO |
DUP I + C@ PRT |
LOOP |
DROP |
ELSE |
DROP DROP |
THEN |
; |
: LYPE |
LYP1 20 PRT |
; |
: CRLP |
0D PRT 0A PRT |
; |
: FFLP |
0C PRT CRLP |
; |
: .LP |
S->D SWAP OVER DABS <# #S SIGN #> LYPE |
; |
: LISTLP |
DUP SCR ! CRLP 0E PRT ( [ SCREEN ] LYPE ) |
.LP 0F PRT 10 0 |
DO |
CRLP I DUP .LP LINE C/L -TRAILING LYPE |
LOOP |
CRLP |
; |
: SHOWLP |
1+ SWAP |
DO |
I LISTLP 3 0 |
DO |
CRLP |
LOOP |
LOOP |
; |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 15 |
00 HEX VOCABULARY EDITOR IMMEDIATE |
01 |
02 1A LOAD 1B LOAD ( GRAPHICS ) |
03 |
04 : EDIT SCR ! [COMPILE] EDITOR ; |
05 |
06 EDITOR DEFINITIONS |
07 0 VARIABLE TOPFLAG |
08 : ULL DUP TOPFLAG ! 0 GR. 2203 |
09 LMARGN ! 3 0 POS. ( 32 CHAR ) |
0A 1 2FE C! ( PRINT ALL CHARS ) |
0B SCR @ BLOCK + 200 TYPE ( PRINT ) |
0C 0 2FE C! ( CURSOR CNTRLS ) |
0D CR ." DOIT" CR 0AAAA 2B2 ! ; |
0E : UL 0 ULL ; ( SHOW UPPER 16 |
0F LINES ) |
10 : LL 200 ULL ; ( SHOW LOWER 16 |
11 LINES ) |
12 : DOIT 10 0 DO -1 2B2 ! |
13 |
14 3 I POS. ( POINT CURSOR ) |
15 |
16 SCR @ BLOCK I 20 * + TOPFLAG @ + |
17 |
18 ICBAL ! 20 ICBLL ! GET DROP |
19 |
1A LOOP UPDATE 0 GR. TOPFLAG @ 0= |
1B IF UL ELSE LL ENDIF ; |
1C : FLUSH 2602 LMARGN ! |
1D [COMPILE] FORTH FLUSH ; |
1E --> |
1F |
|
|
HEX VOCABULARY EDITOR IMMEDIATE 1A LOAD |
1B LOAD |
( GRAPHICS ) |
: EDIT |
SCR ! [COMPILE] EDITOR |
; |
EDITOR DEFINITIONS 0 VARIABLE TOPFLAG |
: ULL |
DUP TOPFLAG ! 0 GR. 2203 LMARGN ! 3 0 POS. ( 32 CHAR ) |
1 2FE C! ( PRINT ALL CHARS ) |
SCR @ BLOCK + 200 TYPE ( PRINT ) |
0 2FE C! ( CURSOR CNTRLS ) |
CR ." DOIT" CR 0AAAA 2B2 ! |
; |
: UL |
0 ULL |
; |
( SHOW UPPER 16 LINES ) |
: LL |
200 ULL |
; |
( SHOW LOWER 16 LINES ) |
: DOIT |
10 0 |
DO |
-1 2B2 ! 3 I POS. ( POINT CURSOR ) |
SCR @ BLOCK I 20 * + TOPFLAG @ + ICBAL ! 20 ICBLL ! |
GET DROP |
LOOP |
UPDATE 0 GR. TOPFLAG @ 0= |
IF |
UL |
ELSE |
LL |
ENDIF |
; |
: FLUSH |
2602 LMARGN ! [COMPILE] FORTH FLUSH |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 16 |
00 ( TEXT, LINE, WHERE USED IN |
01 EDITOR 7/7/80-SRC ) |
02 FORTH DEFINITIONS HEX |
03 |
04 |
05 |
06 : TEXT ( ACCEPT |
07 FOLLOWING TEXT TO PAD *) |
08 HERE C/L 1+ BLANKS WORD |
09 HERE PAD C/L 1+ CMOVE ; |
0A : #OFLINES B/BUF B/SCR * C/L / ; |
0B |
0C : LINE ( RELATIVE TO |
0D SCR, LEAVE ADDRESS OF LINE *) |
0E DUP #OFLINES MINUS |
0F AND IF ." NOT ON SCREEN" ABORT |
10 ENDIF ( KEEP ON THIS SCREEN ) |
11 SCR @ (LINE) DROP ; |
12 |
13 --> |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( TEXT, LINE, WHERE USED IN EDITOR 7/7/80-SRC ) |
FORTH DEFINITIONS HEX |
: TEXT |
( ACCEPT FOLLOWING TEXT TO PAD *) |
HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE |
; |
: #OFLINES |
B/BUF B/SCR * C/L / |
; |
: LINE |
( RELATIVE TO SCR, LEAVE ADDRESS OF LINE *) |
DUP #OFLINES MINUS AND |
IF |
." NOT ON SCREEN" ABORT |
ENDIF |
( KEEP ON THIS SCREEN ) |
SCR @ (LINE) DROP |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 17 |
00 ( LINE EDITING COMMANDS ) |
01 EDITOR DEFINITIONS |
02 : -MOVE ( MOVE IN BLOCK BUFFER |
03 ADDR FROM-2, LINE TO-1 *) |
04 LINE C/L CMOVE UPDATE ; |
05 |
06 : HL ( HOLD |
07 NUMBERED LINE AT PAD *) |
08 LINE PAD 1+ C/L DUP PAD |
09 C! CMOVE ; |
0A : BL ( ERASE |
0B LINE-1 WITH BLANKS *) |
0C LINE C/L BLANKS UPDATE ; |
0D |
0E : SL ( SPREAD |
0F MAKING LINE # BLANK *) |
10 DUP 1 - ( LIMIT ) |
11 #OFLINES 2 - ( FIRST TO MOVE ) |
12 DO I LINE I 1+ -MOVE |
13 -1 +LOOP BL ; |
14 : DL ( DELETE LINE-1, |
15 BUT HOLD IN PAD *) |
16 DUP HL #OFLINES 1 - |
17 DUP ROT |
18 DO I 1+ LINE I -MOVE |
19 LOOP BL ; |
1A : CL ( COPY LINE-2 OF SCREEN-1 |
1B TO PAD ) |
1C SCR @ >R SCR ! HL R> SCR ! ; |
1D |
1E --> |
1F |
|
|
|
( LINE EDITING COMMANDS ) |
EDITOR DEFINITIONS |
: -MOVE |
( MOVE IN BLOCK BUFFER ADDR FROM-2, LINE TO-1 *) |
LINE C/L CMOVE UPDATE |
; |
: HL |
( HOLD NUMBERED LINE AT PAD *) |
LINE PAD 1+ C/L DUP PAD C! CMOVE |
; |
: BL |
( ERASE LINE-1 WITH BLANKS *) |
LINE C/L BLANKS UPDATE |
; |
: SL |
( SPREAD MAKING LINE # BLANK *) |
DUP 1 - ( LIMIT ) |
#OFLINES 2 - ( FIRST TO MOVE ) |
DO |
I LINE I 1+ -MOVE -1 |
+LOOP |
BL |
; |
: DL |
( DELETE LINE-1, BUT HOLD IN PAD *) |
DUP HL #OFLINES 1 - DUP ROT |
DO |
I 1+ LINE I -MOVE |
LOOP |
BL |
; |
: CL |
( COPY LINE-2 OF SCREEN-1 TO PAD ) |
SCR @ >R SCR ! HL R> SCR ! |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 18 |
00 ( LINE EDITING COMMANDS |
01 WFR-790105 ) |
02 : RL |
03 ( REPLACE ON LINE-1, FROM PAD ) |
04 PAD 1+ SWAP -MOVE ; |
05 |
06 |
07 |
08 : $ ( PUT |
09 FOLLOWING TEXT ON LINE-1 ) |
0A 1 TEXT RL QUIT ; |
0B |
0C |
0D |
0E : % ( INSERT TEXT |
0F FOLLOWING AFTER LINE-1 *) |
10 1 TEXT 1+ DUP SL RL ; |
11 |
12 |
13 |
14 : IL ( INSERT PAD AFTER |
15 LINE-1 ) 1+ DUP SL RL ; |
16 |
17 |
18 : TL ( TYPE LINE BY #-1, SAVE |
19 ALSO IN PAD *) |
1A DUP . ." $ " |
1B DUP C/L * R# ! HL |
1C PAD 1+ C/L TYPE CR ; |
1D |
1E --> |
1F |
|
|
( LINE EDITING COMMANDS WFR-790105 ) |
: RL |
( REPLACE ON LINE-1, FROM PAD ) |
PAD 1+ SWAP -MOVE |
; |
: $ |
( PUT FOLLOWING TEXT ON LINE-1 ) |
1 TEXT RL QUIT |
; |
: % |
( INSERT TEXT FOLLOWING AFTER LINE-1 *) |
1 TEXT 1+ DUP SL RL |
; |
: IL |
( INSERT PAD AFTER LINE-1 ) |
1+ DUP SL RL |
; |
: TL |
( TYPE LINE BY #-1, SAVE ALSO IN PAD *) |
DUP . ." $ " DUP C/L * R# ! HL PAD 1+ C/L TYPE CR |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 19 |
00 ( SCREEN EDITING COMMANDS ) |
01 FORTH DEFINITIONS |
02 |
03 |
04 : COPY ( DUPLICATE SCREEN-2, |
05 ONTO SCREEN-1 *) |
06 SWAP BLOCK DROP PREV @ ! |
07 UPDATE FLUSH ; |
08 |
09 |
0A : LIST 2602 LMARGN ! LIST ; |
0B |
0C |
0D : SHOW 1+ SWAP DO I LIST LOOP ; |
0E |
0F |
10 : L SCR @ LIST ( RE-LIST SCR ) ; |
11 |
12 : N SCR @ 1+ LIST ; ( LIST NEXT |
13 SCR) |
14 |
15 : WHERE ( OFFSET BLK --- ) DUP |
16 SCR ! ." SCR # " . CR C/L /MOD |
17 EDITOR TL FORTH 2 + SPACES |
18 5E EMIT [COMPILE] EDITOR QUIT ; |
19 |
1A BASE @ DECIMAL |
1B ' EDITOR 2 + 32 +ORIGIN ! |
1C ( VOC-LINK ) BASE ! |
1D ;S |
1E |
1F |
|
|
( SCREEN EDITING COMMANDS ) |
FORTH DEFINITIONS |
: COPY |
( DUPLICATE SCREEN-2, ONTO SCREEN-1 *) |
SWAP BLOCK DROP PREV @ ! UPDATE FLUSH |
; |
: LIST |
2602 LMARGN ! LIST |
; |
: SHOW |
1+ SWAP |
DO |
I LIST |
LOOP |
; |
: L |
SCR @ LIST ( RE-LIST SCR ) |
; |
: N |
SCR @ 1+ LIST |
; |
( LIST NEXT SCR) |
: WHERE |
( OFFSET BLK --- ) |
DUP SCR ! ." SCR # " . CR C/L /MOD EDITOR TL FORTH 2 + |
SPACES 5E EMIT [COMPILE] EDITOR QUIT |
; |
BASE @ DECIMAL ' EDITOR 2 + 32 +ORIGIN ! ( VOC-LINK ) |
BASE ! ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1A |
00 ( OS & HDW CONSTANTS ) : CN CONS |
01 TANT ; |
02 D200 CN F1AUD D201 CN C1AUD |
03 |
04 D202 CN F2AUD D203 CN C2AUD |
05 |
06 D204 CN F3AUD D205 CN C3AUD |
07 |
08 D206 CN F4AUD D207 CN C4AUD |
09 |
0A D20F CN SKCTL D208 CN AUDCTL |
0B |
0C 230 CN DLST 22F CN DMCT |
0D |
0E 14 CN RTCLK 2F0 CN CRSINH |
0F |
10 2F4 CN CHBAS 2C4 CN COL0 |
11 |
12 2C5 CN COL1 2C6 CN COL2 |
13 |
14 2C7 CN COL3 2C8 CN COL4 |
15 |
16 D01F CN CONSOL 2FC CN CH |
17 |
18 2BF CN BOTSC 52 CN LMARGN |
19 |
1A 2FB CN ATACHR |
1B |
1C ;S |
1D |
1E |
1F |
|
|
( OS & HDW CONSTANTS ) |
: CN |
CONSTANT ; |
D200 CN F1AUD |
D201 CN C1AUD |
D202 CN F2AUD |
D203 CN C2AUD |
D204 CN F3AUD |
D205 CN C3AUD |
D206 CN F4AUD |
D207 CN C4AUD |
D20F CN SKCTL |
D208 CN AUDCTL |
230 CN DLST |
22F CN DMCT |
14 CN RTCLK |
2F0 CN CRSINH |
2F4 CN CHBAS |
2C4 CN COL0 |
2C5 CN COL1 |
2C6 CN COL2 |
2C7 CN COL3 |
2C8 CN COL4 |
D01F CN CONSOL |
2FC CN CH |
2BF CN BOTSC |
52 CN LMARGN |
2FB CN ATACHR |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1B |
00 ( CIO CALL ROUTINES ) |
01 |
02 340 VARIABLE IOC 0 VARIABLE IOB |
03 |
04 : IOCB 7 MIN 0 MAX 10 * DUP IOB |
05 ! 340 + IOC ! ; |
06 : .IOC <BUILDS , DOES> @ IOC @ + |
07 ; |
08 1 .IOC ICDNO 2 .IOC ICCOM 3 .IOC |
09 ICSTA |
0A 4 .IOC ICBAL 6 .IOC ICPTL |
0B |
0C 8 .IOC ICBLL A .IOC I1CAX B .IOC |
0D I2CAX |
0E CODE CIO TXA, PHA, IOB LDX, E456 |
0F JSR, PLA, TAX, NEXT JMP, C; |
10 CODE Get XSAVE STX, IOB LDX, E45 |
11 6 JSR, |
12 XSAVE LDX, PHA, 0 # LDA, PUSH JM |
13 P, C; |
14 : GET 7 ICCOM C! Get ; |
15 |
16 : CLOSE 0C ICCOM C! CIO ; |
17 |
18 : OPEN 3 ICCOM C! ICBAL ! I1CAX |
19 C! I2CAX C! CIO ; |
1A CODE ACIO XSAVE STX, BOT LDA, IO |
1B B LDX, E456 JSR, |
1C XSAVE LDX, POP JMP, C; |
1D |
1E --> |
1F |
|
|
( CIO CALL ROUTINES ) |
340 VARIABLE IOC |
0 VARIABLE IOB |
: IOCB |
7 MIN 0 MAX 10 * DUP IOB ! 340 + IOC ! |
; |
: .IOC |
<BUILDS , DOES> @ IOC @ + |
; |
1 .IOC ICDNO 2 .IOC ICCOM 3 .IOC ICSTA 4 .IOC ICBAL 6 .IOC |
ICPTL 8 .IOC ICBLL A .IOC I1CAX B .IOC I2CAX |
CODE CIO |
TXA, |
PHA, |
IOB LDX, |
E456 JSR, |
PLA, |
TAX, |
NEXT JMP, |
C; |
CODE Get |
XSAVE STX, |
IOB LDX, |
E456 JSR, |
XSAVE LDX, |
PHA, |
0 # LDA, |
PUSH JMP, |
C; |
: GET |
7 ICCOM C! Get |
; |
: CLOSE |
0C ICCOM C! CIO |
; |
: OPEN |
3 ICCOM C! ICBAL ! I1CAX C! I2CAX C! CIO |
; |
CODE ACIO |
XSAVE STX, |
BOT LDA, |
IOB LDX, |
E456 JSR, |
XSAVE LDX, |
POP JMP, |
C; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1C |
00 ( COLLEEN GRAPHICS ) |
01 |
02 3A53 VARIABLE S: 2FD CONSTANT |
03 FILDAT 0 VARIABLE Qbase |
04 : PBASE Qbase @ ; : SPB HIMEM @ |
05 1+ F800 AND 800 - DUP |
06 Qbase ! 17F + HIMEM ! ; SPB |
07 : POS. 54 C! 55 ! ; |
08 : GR. 1 IOCB CLOSE 0 ICBLL ! DUP |
09 F AND SWAP 30 AND 10 |
0A XOR 0C + S: OPEN SPB ; |
0B : GRAPHICS GR. ; |
0C : LOC. POS. GET ; 1 VARIABLE Col |
0D or |
0E : C. DUP Color C! FILDAT C! ; |
0F : PUT 0B ICCOM C! ACIO ; |
10 : PL. POS. ICBLL 0SET Color C@ P |
11 UT ; |
12 : SE. SWAP 10 * + SWAP 2C4 + C! |
13 ; |
14 : DR. POS. 11 ICCOM C! Color C@ |
15 DUP 2FB C! FILDAT C! CIO ; |
16 : PLOT PL. ; : LOCATE LOC. |
17 ; |
18 : SETCOLOR SE. ; : COLOR C. ; |
19 |
1A : POSITION POS. ; : DRAWTO DR. ; |
1B |
1C : CLEAR 0 0 POS. 7D PUT ; |
1D |
1E : XIO18 ( FILL ) DUP 2FD C! 2FB |
1F C! 12 ICCOM C! CIO ; --> |
|
|
( COLLEEN GRAPHICS ) |
3A53 VARIABLE S: |
2FD CONSTANT FILDAT |
0 VARIABLE Qbase |
: PBASE |
Qbase @ |
; |
: SPB |
HIMEM @ 1+ F800 AND 800 - DUP Qbase ! 17F + HIMEM ! |
; |
SPB |
: POS. |
54 C! 55 ! |
; |
: GR. |
1 IOCB CLOSE 0 ICBLL ! DUP F AND SWAP 30 AND 10 XOR 0C |
+ S: OPEN SPB |
; |
: GRAPHICS |
GR. |
; |
: LOC. |
POS. GET |
; |
1 VARIABLE Color |
: C. |
DUP Color C! FILDAT C! |
; |
: PUT |
0B ICCOM C! ACIO |
; |
: PL. |
POS. ICBLL 0SET Color C@ PUT |
; |
: SE. |
SWAP 10 * + SWAP 2C4 + C! |
; |
: DR. |
POS. 11 ICCOM C! Color C@ DUP 2FB C! FILDAT C! CIO |
; |
: PLOT |
PL. |
; |
: LOCATE |
LOC. |
; |
: SETCOLOR |
SE. |
; |
: COLOR |
C. |
; |
: POSITION |
POS. |
; |
: DRAWTO |
DR. |
; |
: CLEAR |
0 0 POS. 7D PUT |
; |
: XIO18 |
( FILL ) |
DUP 2FD C! 2FB C! 12 ICCOM C! CIO |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1D |
00 ( SOUND CONTROLLERS RND PLAYER/M |
01 ISSILES ) |
02 : SOUND 3 D20F C! 0 D208 C! SWAP |
03 |
04 10 * + 100 * + SWAP 2 * D200 + ! |
05 ; |
06 : PADDLE 270 + C@ ; |
07 : PTRIG 27C + C@ ; |
08 : STICK 278 + C@ ; |
09 : STRIG 284 + C@ ; |
0A : RND D20A C@ ; |
0B 22F CONSTANT DMACTL |
0C D01D CONSTANT GRACTL |
0D D407 CONSTANT PMBASE |
0E D01B CONSTANT PRIOR |
0F D016 CONSTANT VDELAY |
10 2C0 CONSTANT COLPM |
11 26F CONSTANT GPRIOR |
12 PBASE 1 - HIMEM ! |
13 |
14 : PLAYER Qbase 1+ C@ PMBASE C! 3 |
15 GRACTL C! 2 - IF 1C |
16 ELSE 0C ENDIF DMACTL @ E3 AND |
17 OR DMACTL C! ; |
18 : HPOS! D000 + C! ; |
19 ( H-posn plyr# -> ) |
1A : SIZE! D008 + C! ; |
1B ( size-code plyr# -> ) |
1C : COLPM! COLPM + C! ; |
1D ( color plyr# -> ) |
1E : NOPLY GRACTL 0SET D000 11 0 FI |
1F LL ; ;S |
|
|
( SOUND CONTROLLERS RND PLAYER/MISSILES ) |
: SOUND |
3 D20F C! 0 D208 C! SWAP 10 * + 100 * + SWAP 2 * D200 + |
! |
; |
: PADDLE |
270 + C@ |
; |
: PTRIG |
27C + C@ |
; |
: STICK |
278 + C@ |
; |
: STRIG |
284 + C@ |
; |
: RND |
D20A C@ |
; |
22F CONSTANT DMACTL |
D01D CONSTANT GRACTL |
D407 CONSTANT PMBASE |
D01B CONSTANT PRIOR |
D016 CONSTANT VDELAY |
2C0 CONSTANT COLPM |
26F CONSTANT GPRIOR |
PBASE 1 - HIMEM ! |
: PLAYER |
Qbase 1+ C@ PMBASE C! 3 GRACTL C! 2 - |
IF |
1C |
ELSE |
0C |
ENDIF |
DMACTL @ E3 AND OR DMACTL C! |
; |
: HPOS! |
D000 + C! |
; |
( H-posn plyr# -> ) |
: SIZE! |
D008 + C! |
; |
( size-code plyr# -> ) |
: COLPM! |
COLPM + C! |
; |
( color plyr# -> ) |
: NOPLY |
GRACTL 0SET D000 11 0 FILL |
; |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1E |
00 ( DECUS-FORTH ADDITIONS ) |
01 |
02 : 1+! 1 SWAP +! ; : 1- 1 - ; |
03 |
04 : 0SET 0 SWAP ! ; : 2* DUP + ; |
05 |
06 : HD DUP 0A < IF 30 ELSE 37 |
07 ENDIF + EMIT ; |
08 : CHH DUP 0F0 AND 10 / HD 0F AND |
09 HD ; |
0A : CH? C@ CHH ; |
0B |
0C : HH DUP 0FF00 AND 100 / 0FF AND |
0D CHH CHH ; |
0E : H? @ HH ; |
0F |
10 : BDUMP 1+ SWAP DO I HH SPACE I |
11 |
12 8 0 DO DUP I + CH? SPACE LOOP |
13 DROP ." \" CR 8 +LOOP ; |
14 |
15 : \ 10 0 DO SP@ 0E + I - @ SP@ |
16 12 + @ I 2 / + C! |
17 2 +LOOP DROP DROP DROP |
18 DROP DROP DROP DROP DROP DROP |
19 QUIT ; |
1A : TBL <BUILDS DOES> ; |
1B |
1C : ALLOC DUP + ALLOT ; ( FOR RAM |
1D BASED SYSTEMS,) |
1E : ARRAY <BUILDS ALLOC DOES> ; |
1F ;S |
|
|
( DECUS-FORTH ADDITIONS ) |
: 1+! |
1 SWAP +! |
; |
: 1- |
1 - |
; |
: 0SET |
0 SWAP ! |
; |
: 2* |
DUP + |
; |
: HD |
DUP 0A < |
IF |
30 |
ELSE |
37 |
ENDIF |
+ EMIT |
; |
: CHH |
DUP 0F0 AND 10 / HD 0F AND HD |
; |
: CH? |
C@ CHH |
; |
: HH |
DUP 0FF00 AND 100 / 0FF AND CHH CHH |
; |
: H? |
@ HH |
; |
: BDUMP |
1+ SWAP |
DO |
I HH SPACE I 8 0 |
DO |
DUP I + CH? SPACE |
LOOP |
DROP ." \" CR 8 |
+LOOP |
; |
: \ |
10 0 |
DO |
SP@ 0E + I - @ SP@ 12 + @ I 2 / + C! 2 |
+LOOP |
DROP DROP DROP DROP DROP DROP DROP DROP DROP QUIT |
; |
: TBL |
<BUILDS DOES> |
; |
: ALLOC |
DUP + ALLOT |
; |
( FOR RAM BASED SYSTEMS,) |
: ARRAY |
<BUILDS ALLOC DOES> |
; |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 1F |
00 ( DISPLAY LIST STUFF ) |
01 |
02 0 VARIABLE 3BYT 0 VARIABLE DLADR |
03 |
04 : DINST DLADR @ C@ DUP 0F AND IF |
05 |
06 DUP 0F AND 1 = IF 40 AND IF ." J |
07 VB " |
08 ELSE ." JMP " ENDIF DLADR 1+! DL |
09 ADR @ |
0A @ DUP DLADR ! HH 3BYT 0SET ELSE |
0B DUP 0F AND |
0C 8 OVER < IF ." MAP" ELSE ." CHR" |
0D |
0E ENDIF 7 AND . DUP 10 AND IF ." H |
0F " |
10 THEN DUP 20 AND IF ." V" THEN DU |
11 P |
12 80 AND IF ." I" ENDIF DUP 0B0 |
13 |
14 AND IF DUP 40 AND IF ." ," ENDIF |
15 |
16 ENDIF 40 AND IF 3 DLADR @ 1+ H? |
17 ELSE |
18 1 ENDIF 3BYT ! ENDIF ELSE ." BLK |
19 " |
1A DUP 80 AND IF ." I," ENDIF 70 |
1B |
1C AND 10 / . 1 3BYT ! ENDIF CR |
1D |
1E 3BYT @ DLADR +! ; ;S |
1F |
|
|
( DISPLAY LIST STUFF ) |
0 VARIABLE 3BYT |
0 VARIABLE DLADR |
: DINST |
DLADR @ C@ DUP 0F AND |
IF |
DUP 0F AND 1 = |
IF |
40 AND |
IF |
." JVB " |
ELSE |
." JMP " |
ENDIF |
DLADR 1+! DLADR @ @ DUP DLADR ! HH 3BYT 0SET |
ELSE |
DUP 0F AND 8 OVER < |
IF |
." MAP" |
ELSE |
." CHR" |
ENDIF |
7 AND . DUP 10 AND |
IF |
." H" |
THEN |
DUP 20 AND |
IF |
." V" |
THEN |
DUP 80 AND |
IF |
." I" |
ENDIF |
DUP 0B0 AND |
IF |
DUP 40 AND |
IF |
." ," |
ENDIF |
ENDIF |
40 AND |
IF |
3 DLADR @ 1+ H? |
ELSE |
1 |
ENDIF |
3BYT ! |
ENDIF |
ELSE |
." BLK" DUP 80 AND |
IF |
." I," |
ENDIF |
70 AND 10 / . 1 3BYT ! |
ENDIF |
CR 3BYT @ DLADR +! |
; |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 20 |
00 ( WRITE BOOTABLE OBJECT 1 OF 2 ) |
01 |
02 BASE @ FORTH DEFINITIONS HEX |
03 SAVENFAs ( PRESERV ALL NFAS ) |
04 ( LATEST 0C +ORIGIN ! ) |
05 ( TOP NFA ) |
06 HERE 1C +ORIGIN ! ( FENCE ) |
07 |
08 HERE 1E +ORIGIN ! ( DP ) |
09 |
0A HERE DUP FENCE ! 0 +ORIGIN - 80 |
0B / 1+ CONSTANT #SECT |
0C CODE CALLDK XSAVE STX, E453 JSR, |
0D TYA, PHA, ( STATUS ) |
0E XSAVE LDX, PUSH JMP, C; |
0F |
10 : DKIO 301 ! ( CMD, DRIVE # ) |
11 30A ! ( SECT. # ) |
12 304 ! ( RAM BUFFER ADDR ) |
13 CALLDK ( JSR DKHND) |
14 DUP 0< IF ." ERROR " 0FF AND |
15 BASE @ SWAP DECIMAL |
16 . BASE ! QUIT ENDIF DROP ; |
17 |
18 : WTSEC 5701 DKIO ; |
19 : RDSEC 5201 DKIO ; |
1A : FORMAT ." FORMAT DRIVE " DUP . |
1B |
1C ." -ARE YOU SURE?" 0 PAD ! PAD |
1D 1 EXPECT PAD C@ 59 ( Y) = |
1E IF 2100 OR PAD 0 ROT DKIO ELSE |
1F DROP THEN ; --> |
|
|
( WRITE BOOTABLE OBJECT 1 OF 2 ) |
BASE @ FORTH DEFINITIONS HEX SAVENFAs ( PRESERV ALL NFAS ) |
( LATEST 0C +ORIGIN ! ) |
( TOP NFA ) |
HERE 1C +ORIGIN ! ( FENCE ) |
HERE 1E +ORIGIN ! ( DP ) |
HERE DUP FENCE ! 0 +ORIGIN - 80 / 1+ CONSTANT #SECT |
CODE CALLDK |
XSAVE STX, |
E453 JSR, |
TYA, |
PHA, |
( STATUS ) |
XSAVE LDX, |
PUSH JMP, |
C; |
: DKIO |
301 ! ( CMD, DRIVE # ) |
30A ! ( SECT. # ) |
304 ! ( RAM BUFFER ADDR ) |
CALLDK ( JSR DKHND) |
DUP 0< |
IF |
." ERROR " 0FF AND BASE @ SWAP DECIMAL . BASE ! QUIT |
ENDIF |
DROP |
; |
: WTSEC |
5701 DKIO |
; |
: RDSEC |
5201 DKIO |
; |
: FORMAT |
." FORMAT DRIVE " DUP . ." -ARE YOU SURE?" 0 PAD ! PAD |
1 EXPECT PAD C@ 59 ( Y) |
= |
IF |
2100 OR PAD 0 ROT DKIO |
ELSE |
DROP |
THEN |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 21 |
00 ( WRITE BOOTABLE OBJECT 2 OF 2 ) |
01 |
02 0 VARIABLE BOOT ( ->CODE) |
03 : WTOBJ FLUSH EMPTY-BUFFERS |
04 ." INSERT NEW DISK, TYPE Y" CR |
05 0 PAD ! ( DEFAULT ) |
06 PAD 3 EXPECT PAD C@ 59 = IF BOO |
07 T @ 1 WTSEC #SECT 0 DO I |
08 80 * +ORIGIN I 2 + WTSEC I 2 + |
09 . LOOP ." DONE" CR THEN ; |
0A ( FOLLOWING IS BOOT SECTOR CODE |
0B ) HERE BOOT ! ( PT TO US ) |
0C ASSEMBLER 1FF , 480 , E4C0 , #SE |
0D CT # LDA, 0= IF, 0 +ORIGIN , |
0E 1 , ENDIF, N STA, 52 # LDA, 302 |
0F STA, 48C LDA, 30A STA, |
10 48D LDA, 30B STA, ( FIRST SECTO |
11 R) 1 # LDA, ( DRV) 301 STA, |
12 48A LDA, 304 STA, 48B LDA, |
13 305 STA, ( ORIGIN) |
14 BEGIN, 30A INC, 0= IF, 30B INC, |
15 ENDIF, E453 JSR, 303 LDA, |
16 .A ASL, CS IF, RTS, ( FRETURN ) |
17 ENDIF, 304 LDA, 80 # EOR, |
18 304 STA, 0< NOT IF, 305 INC, |
19 ENDIF, ( BUMP PTR.) |
1A N DEC, 0= UNTIL, 48A LDA, 0A ST |
1B A, 48B LDA, 0B STA, CLC, |
1C RTS, FORTH BASE ! ." n FORMAT" |
1D CR ." to Format Disk Drive n" CR |
1E ." WTOBJ to write boot version |
1F of current object" CR ;S |
|
|
( WRITE BOOTABLE OBJECT 2 OF 2 ) |
0 VARIABLE BOOT |
( ->CODE) |
: WTOBJ |
FLUSH EMPTY-BUFFERS ." INSERT NEW DISK, |
TYPE Y" CR 0 PAD ! ( DEFAULT ) |
PAD 3 EXPECT PAD C@ 59 = |
IF |
BOOT @ 1 WTSEC #SECT 0 |
DO |
I 80 * +ORIGIN I 2 + WTSEC I 2 + . |
LOOP |
." DONE" CR |
THEN |
; |
( FOLLOWING IS BOOT SECTOR CODE ) |
HERE BOOT ! ( PT TO US ) |
ASSEMBLER 1FF , 480 , E4C0 , #SECT # LDA, |
0= |
IF, |
0 +ORIGIN , 1 , |
ENDIF, |
N STA, |
52 # LDA, |
302 STA, |
48C LDA, |
30A STA, |
48D LDA, |
30B STA, |
( FIRST SECTOR) |
1 # LDA, |
( DRV) |
301 STA, |
48A LDA, |
304 STA, |
48B LDA, |
305 STA, |
( ORIGIN) |
BEGIN, |
30A INC, |
0= |
IF, |
30B INC, |
ENDIF, |
E453 JSR, |
303 LDA, |
.A ASL, |
CS |
IF, |
RTS, |
( FRETURN ) |
ENDIF, |
304 LDA, |
80 # EOR, |
304 STA, |
0< NOT |
IF, |
305 INC, |
ENDIF, |
( BUMP PTR.) |
N DEC, |
0= |
UNTIL, |
48A LDA, |
0A STA, |
48B LDA, |
0B STA, |
CLC, |
RTS, |
FORTH BASE ! ." n FORMAT" CR ." to Format Disk Drive n" CR ." |
WTOBJ to write boot version of current object" CR ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 22 |
00 ( <UNUSED> ) ;S |
01 |
02 |
03 |
04 |
05 |
06 |
07 |
08 |
09 |
0A |
0B |
0C |
0D |
0E |
0F |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( <UNUSED> ) |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 23 |
00 ( COLLEEN TO DEVSYS COMMUNICATIO |
01 NS WORDS -- SEND ) |
02 D303 CONSTANT PIADIR D301 CONSTA |
03 NT PIA |
04 : NIBSEND ( SEND LOW NIBBLE OF |
05 TOS ) |
06 80 OR PIA C! ( SEND DATA ) |
07 BEGIN PIA C@ 40 AND ( WAIT FOR |
08 ACK ) END 0 PIA C! ( ACK-ACK) |
09 BEGIN PIA C@ 40 AND 0= END |
0A ( WAIT FOR ACK-ACK-ACK ) ; |
0B : DBSND ( TOS=BLOCK PTR ) |
0C 400 0 DO I OVER + ( DATA PTR ) |
0D C@ DUP NIBSEND |
0E ( LOW NIBBLE ) 10 / NIBSEND ( |
0F HIGH NIBBLE ) LOOP DROP ; |
10 : BSND ( SET UP PIA AND SEND A |
11 BLOCK -- TOS = BLOCK NUMBER ) |
12 PIADIR C@ FB AND PIADIR C! |
13 8F PIA C! ( SET DATA DIRECTION) |
14 PIADIR C@ 4 OR PIADIR C! |
15 0 PIA C! |
16 BEGIN PIA C@ 40 AND 0= END |
17 BLOCK DBSND ( SEND THE BLOCK ) |
18 ; |
19 |
1A ( FRST LAST SMOV MOVE BLOCKS ) |
1B : SMOV 1+ SWAP DO I . I BSND |
1C LOOP ; |
1D |
1E --> |
1F |
|
|
( COLLEEN TO DEVSYS COMMUNICATIONS WORDS -- SEND ) |
D303 CONSTANT PIADIR |
D301 CONSTANT PIA |
: NIBSEND |
( SEND LOW NIBBLE OF TOS ) |
80 OR PIA C! ( SEND DATA ) |
BEGIN |
PIA C@ 40 AND ( WAIT FOR ACK ) |
END |
0 PIA C! ( ACK-ACK) |
BEGIN |
PIA C@ 40 AND 0= |
END |
( WAIT FOR ACK-ACK-ACK ) |
; |
: DBSND |
( TOS=BLOCK PTR ) |
400 0 |
DO |
I OVER + ( DATA PTR ) |
C@ DUP NIBSEND ( LOW NIBBLE ) |
10 / NIBSEND ( HIGH NIBBLE ) |
LOOP |
DROP |
; |
: BSND |
( SET UP PIA AND SEND A BLOCK -- TOS = BLOCK NUMBER ) |
PIADIR C@ FB AND PIADIR C! 8F PIA C! |
( SET DATA DIRECTION) |
PIADIR C@ 4 OR PIADIR C! 0 PIA C! |
BEGIN |
PIA C@ 40 AND 0= |
END |
BLOCK DBSND ( SEND THE BLOCK ) |
; |
( FRST LAST SMOV MOVE BLOCKS ) |
: SMOV |
1+ SWAP |
DO |
I . I BSND |
LOOP |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 24 |
00 ( COLLEEN TO DEVSYS COMMUNICATIO |
01 NS WORDS -- RECEIVE ) |
02 CODE NIBRECV 0 # LDA, PIA STA, |
03 BEGIN, PIA BIT, 0< UNTIL, |
04 PIA LDA, 0F # AND, 40 # LDY, |
05 PIA STY, |
06 BEGIN, PIA BIT, 0< NOT UNTIL, |
07 PHA, 0 # LDA, PIA STA, |
08 PUSH JMP, C; |
09 ( READY TO RECEIVE ) |
0A : DBREC ( TOS - BLOCK POINTER ) |
0B 400 0 DO NIBRECV NIBRECV 10 * + |
0C ( GET A BYTE ) OVER I + |
0D C! ( AND STORE IT IN BUFFER ) |
0E LOOP DROP ; |
0F |
10 : BREC ( SET UP PIA AND RECV A |
11 BLOCK -- TOS = BLOCK NUMBER ) |
12 PIADIR C@ FB AND PIADIR C! |
13 40 PIA C! ( ONLY SEND ACK BIT ) |
14 PIADIR C@ 4 OR PIADIR C! |
15 BUFFER DBREC ( RECV THE BLOCK ) |
16 UPDATE FLUSH ( WRITE TO DISK ) |
17 ; |
18 ( FRST LAST RMOV -- MOVE A SET |
19 OF BLOCKS ) |
1A : RMOV 1+ SWAP DO I . I BREC |
1B LOOP ; ;S |
1C |
1D |
1E |
1F |
|
|
( COLLEEN TO DEVSYS COMMUNICATIONS WORDS -- RECEIVE ) |
CODE NIBRECV |
0 # LDA, |
PIA STA, |
BEGIN, |
PIA BIT, |
0< |
UNTIL, |
PIA LDA, |
0F # AND, |
40 # LDY, |
PIA STY, |
BEGIN, |
PIA BIT, |
0< NOT |
UNTIL, |
PHA, |
0 # LDA, |
PIA STA, |
PUSH JMP, |
C; |
( READY TO RECEIVE ) |
: DBREC |
( TOS - BLOCK POINTER ) |
400 0 |
DO |
NIBRECV NIBRECV 10 * + ( GET A BYTE ) |
OVER I + C! ( AND STORE IT IN BUFFER ) |
LOOP |
DROP |
; |
: BREC |
( SET UP PIA AND RECV A BLOCK -- TOS = BLOCK NUMBER ) |
PIADIR C@ FB AND PIADIR C! 40 PIA C! |
( ONLY SEND ACK BIT ) |
PIADIR C@ 4 OR PIADIR C! BUFFER DBREC |
( RECV THE BLOCK ) |
UPDATE FLUSH ( WRITE TO DISK ) |
; |
( FRST LAST RMOV -- MOVE A SET OF BLOCKS ) |
: RMOV |
1+ SWAP |
DO |
I . I BREC |
LOOP |
; |
;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 25 |
00 ( LINE PRINTER WORDS 1/27/81 |
01 SRC ) 3A50 VARIABLE P: |
02 CODE PCIO XSAVE STX, 70 # LDX, |
03 E456 JSR, XSAVE LDX, TYA, PHA, |
04 PUSH JMP, C; 0 VARIABLE LPCNT |
05 : PERR? DUP 0< IF FF AND |
06 ." P: ERROR " ERROR THEN |
07 DROP ; |
08 : LPOPEN 3 3B2 C! P: 3B4 ! 2 3B8 |
09 ! 8 3BA ! PCIO PERR? ; |
0A : LYP1 3B8 ! 3B4 ! 0B 3B2 C! PCI |
0B O PERR? ; : LPEMIT SP@ 1 LYP1 DR |
0C OP ; : LPCR 9B LPEMIT 1 LPCNT +! |
0D ; : LYPE DUP IF DUP 50 > IF |
0E 1 LPCNT +! THEN LYP1 ELSE DROP |
0F DROP THEN 20 SP@ 1 LYP1 DROP ; |
10 : CRLP LPCR LPCNT @ 3D > IF |
11 LPCR LPCR LPCR LPCR 0 LPCNT ! |
12 THEN ; |
13 : FFLP CRLP BEGIN LPCNT @ WHILE |
14 CRLP REPEAT ; |
15 : SHRINK 1B LPEMIT 14 LPEMIT |
16 CRLP ; : EXPAND 1B LPEMIT 13 |
17 LPEMIT CRLP ; |
18 : .CLP 0 <# # # #> LYPE ; |
19 : .LP 0 <# #S #> LYPE ; |
1A : LINELP DUP .CLP SCR @ (LINE) |
1B -TRAILING 1 MAX LYPE CRLP ; |
1C 4353 VARIABLE SCR# 2052 , 2023 , |
1D : LISTLP DUP SCR ! SCR# 6 LYPE |
1E .LP LPCR B/SCR B/BUF * C/L / |
1F 0 DO I LINELP LOOP ; --> |
|
|
( LINE PRINTER WORDS 1/27/81 SRC ) |
3A50 VARIABLE P: |
CODE PCIO |
XSAVE STX, |
70 # LDX, |
E456 JSR, |
XSAVE LDX, |
TYA, |
PHA, |
PUSH JMP, |
C; |
0 VARIABLE LPCNT |
: PERR? |
DUP 0< |
IF |
FF AND ." P: ERROR " ERROR |
THEN |
DROP |
; |
: LPOPEN |
3 3B2 C! P: 3B4 ! 2 3B8 ! 8 3BA ! PCIO PERR? |
; |
: LYP1 |
3B8 ! 3B4 ! 0B 3B2 C! PCIO PERR? |
; |
: LPEMIT |
SP@ 1 LYP1 DROP |
; |
: LPCR |
9B LPEMIT 1 LPCNT +! |
; |
: LYPE |
DUP |
IF |
DUP 50 > |
IF |
1 LPCNT +! |
THEN |
LYP1 |
ELSE |
DROP DROP |
THEN |
20 SP@ 1 LYP1 DROP |
; |
: CRLP |
LPCR LPCNT @ 3D > |
IF |
LPCR LPCR LPCR LPCR 0 LPCNT ! |
THEN |
; |
: FFLP |
CRLP |
BEGIN |
LPCNT @ |
WHILE |
CRLP |
REPEAT |
; |
: SHRINK |
1B LPEMIT 14 LPEMIT CRLP |
; |
: EXPAND |
1B LPEMIT 13 LPEMIT CRLP |
; |
: .CLP |
0 <# # # #> LYPE |
; |
: .LP |
0 <# #S #> LYPE |
; |
: LINELP |
DUP .CLP SCR @ (LINE) -TRAILING 1 MAX LYPE CRLP |
; |
4353 VARIABLE SCR# |
2052 , 2023 , |
: LISTLP |
DUP SCR ! SCR# 6 LYPE .LP LPCR B/SCR B/BUF * C/L / 0 |
DO |
I LINELP |
LOOP |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 26 |
00 ( MORE LINE PRINTER WORDS |
01 1/27/81 SRC ) |
02 : LPSPC 0 DO 20 LPEMIT LOOP ; |
03 : SHOWLP 1+ SWAP C/L 20 = IF |
04 DO CRLP |
05 SCR# 6 LYPE I .LP |
06 1F LPSPC SCR# 6 LYPE I 1+ |
07 .LP CRLP |
08 I 20 0 DO DUP SCR ! I .CLP |
09 I SCR @ (LINE) LYPE |
0A 5 LPSPC |
0B DUP 1+ SCR ! I LINELP LOOP |
0C DROP 2 +LOOP |
0D ELSE DO CRLP I LISTLP LOOP |
0E ENDIF FFLP ; |
0F |
10 : LPINDEX 1+ SWAP DO I .LP |
11 0 I (LINE) -TRAILING LYPE LPCR |
12 LOOP ; |
13 LPOPEN |
14 ;S |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( MORE LINE PRINTER WORDS 1/27/81 SRC ) |
: LPSPC |
0 |
DO |
20 LPEMIT |
LOOP |
; |
: SHOWLP |
1+ SWAP C/L 20 = |
IF |
DO |
CRLP SCR# 6 LYPE I .LP 1F LPSPC SCR# 6 LYPE I 1+ |
.LP CRLP I 20 0 |
DO |
DUP SCR ! I .CLP I SCR @ (LINE) LYPE 5 LPSPC DUP |
1+ SCR ! I LINELP |
LOOP |
DROP 2 |
+LOOP |
ELSE |
DO |
CRLP I LISTLP |
LOOP |
ENDIF |
FFLP |
; |
: LPINDEX |
1+ SWAP |
DO |
I .LP 0 I (LINE) -TRAILING LYPE LPCR |
LOOP |
; |
LPOPEN ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 27 |
00 ( FORMATTED LIST PROGRAM) : THAT |
01 ; VOCABULARY FORMX IMMEDIATE |
02 FORMX DEFINITIONS : CN CONSTANT |
03 ; : OCTAL 8 BASE ! ; |
04 BASE @ OCTAL 40 CN SPACBYT 54 |
05 CN COMCHR : IARRAY 0 VARIABLE -2 |
06 ALLOT ; : 0> DUP 0= IF DROP 0 |
07 ELSE 0< 0= THEN ; |
08 0 VARIABLE INDENT 106 CN FCONS |
09 111 CN ICONS 0 VARIABLE TLFLG |
0A 0 VARIABLE KERKNT 100 CN MAXLIN |
0B : NXSPACE >R 1+ >R 0 R> R> DO |
0C SPACBYT I C@ = IF DROP I LEAVE |
0D THEN LOOP ; : NXNSPACE >R 1+ >R |
0E 0 R> R> DO SPACBYT I C@ = 0= IF |
0F |
10 DROP I LEAVE THEN LOOP ; : GTNX |
11 WD DUP IF + OVER SWAP NXSPACE |
12 ELSE DROP THEN DUP IF OVER SWAP |
13 NXNSPACE DUP IF OVER OVER |
14 NXSPACE DUP IF OVER - ELSE DROP |
15 OVER OVER - 1+ THEN ELSE DUP |
16 THEN ELSE DUP THEN ; : TORLCR TL |
17 FLG @ IF CRLP ELSE CR THEN KERKN |
18 T 0SET ; : TORLY DUP 1+ KERKNT + |
19 ! TLFLG @ IF LYPE ELSE TYPE SPAC |
1A E THEN ; : DOIND INDENT @ 0> IF |
1B INDENT @ 0 DO 0 0 TORLY LOOP THE |
1C N ; : PRWORD DUP 1+ KERKNT @ + M |
1D AXLIN > IF TORLCR THEN KERKNT @ |
1E 0= IF DOIND THEN OVER OVER TORLY |
1F ; : 1SET 1 SWAP ! ; --> |
|
|
( FORMATTED LIST PROGRAM) |
: THAT |
; |
VOCABULARY FORMX IMMEDIATE FORMX DEFINITIONS |
: CN |
CONSTANT ; |
: OCTAL |
8 BASE ! |
; |
BASE @ OCTAL 40 CN SPACBYT |
54 CN COMCHR |
: IARRAY |
0 VARIABLE -2 |
ALLOT |
; |
: 0> |
DUP 0= |
IF |
DROP 0 |
ELSE |
0< 0= |
THEN |
; |
0 VARIABLE INDENT |
106 CN FCONS |
111 CN ICONS |
0 VARIABLE TLFLG |
0 VARIABLE KERKNT |
100 CN MAXLIN |
: NXSPACE |
>R 1+ >R 0 R> R> |
DO |
SPACBYT I C@ = |
IF |
DROP I LEAVE |
THEN |
LOOP |
; |
: NXNSPACE |
>R 1+ >R 0 R> R> |
DO |
SPACBYT I C@ = 0= |
IF |
DROP I LEAVE |
THEN |
LOOP |
; |
: GTNXWD |
DUP |
IF |
+ OVER SWAP NXSPACE |
ELSE |
DROP |
THEN |
DUP |
IF |
OVER SWAP NXNSPACE DUP |
IF |
OVER OVER NXSPACE DUP |
IF |
OVER - |
ELSE |
DROP OVER OVER - 1+ |
THEN |
ELSE |
DUP |
THEN |
ELSE |
DUP |
THEN |
; |
: TORLCR |
TLFLG @ |
IF |
CRLP |
ELSE |
CR |
THEN |
KERKNT 0SET |
; |
: TORLY |
DUP 1+ KERKNT +! TLFLG @ |
IF |
LYPE |
ELSE |
TYPE SPACE |
THEN |
; |
: DOIND |
INDENT @ 0> |
IF |
INDENT @ 0 |
DO |
0 0 TORLY |
LOOP |
THEN |
; |
: PRWORD |
DUP 1+ KERKNT @ + MAXLIN > |
IF |
TORLCR |
THEN |
KERKNT @ 0= |
IF |
DOIND |
THEN |
OVER OVER TORLY |
; |
: 1SET |
1 SWAP ! |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 28 |
00 : ( 51 WORD 6 ALLOT ; |
01 |
02 : IA IARRAY ; IA L1G 10 , ( :) |
03 ( CODE) ( ,CODE) ( SUBROUTINE) |
04 ( IA) ( IARRAY) ( LABEL) ( TBL) |
05 IA L2G 2 , ( ;) ( C;) |
06 IA L3G 2 , ( NXT,) ( NEXT,) IA |
07 L4G 6 , ( IF) ( DO) ( IF,) |
08 ( CASE) ( BEGIN) ( BEGIN,) IA |
09 L5G 3 , ( ELSE,) ( ELSE) |
0A ( WHILE) IA L6G 16 , ( THEN,) |
0B ( THEN) ( END,) ( END) ( SOB,) |
0C ( BACK) ( UNTIL) ( AGAIN) ( REPE |
0D AT) ( ENDIF,) |
0E ( UNTIL,) ( LOOP) ( +LOOP) ( E |
0F NDIF) IA L7G 7 , ( CONSTANT) |
10 ( IR) ( VARIABLE) ( CN) |
11 ( ARRAY) ( INTEGER) ( ORCON) |
12 IA L8G 1 , ( () IA L9G 3 , ( |
13 LD,) ( ST,) ( LOAD) |
14 IA LAG 1 , ( ;CODE) |
15 |
16 : CMPWORD DUP >R C@ OVER = R> |
17 SWAP IF >R OVER |
18 R> SWAP OVER DUP C@ DUP 4 > IF |
19 DROP 4 THEN 0 |
1A DO I OVER + 1+ C@ >R OVER R> |
1B SWAP I + C@ |
1C = 0= IF 0 LEAVE THEN LOOP |
1D |
1E 0= IF DROP DROP 0 THEN ELSE 0 |
1F THEN ; --> |
|
|
: ( |
51 WORD 6 ALLOT |
; |
: IA |
IARRAY ; |
IA L1G |
10 , ( :) |
( CODE) |
( ,CODE) |
( SUBROUTINE) |
( IA) |
( IARRAY) |
( LABEL) |
( TBL) |
IA L2G |
2 , ( ;) |
( C;) |
IA L3G |
2 , ( NXT,) |
( NEXT,) |
IA L4G |
6 , ( IF) |
( DO) |
( IF,) |
( CASE) |
( BEGIN) |
( BEGIN,) |
IA L5G |
3 , ( ELSE,) |
( ELSE) |
( WHILE) |
IA L6G |
16 , ( THEN,) |
( THEN) |
( END,) |
( END) |
( SOB,) |
( BACK) |
( UNTIL) |
( AGAIN) |
( REPEAT) |
( ENDIF,) |
( UNTIL,) |
( LOOP) |
( +LOOP) |
( ENDIF) |
IA L7G |
7 , ( CONSTANT) |
( IR) |
( VARIABLE) |
( CN) |
( ARRAY) |
( INTEGER) |
( ORCON) |
IA L8G |
1 , ( () |
IA L9G |
3 , ( LD,) |
( ST,) |
( LOAD) |
IA LAG |
1 , ( ;CODE) |
: CMPWORD |
DUP >R C@ OVER = R> SWAP |
IF |
>R OVER R> SWAP OVER DUP C@ DUP 4 > |
IF |
DROP 4 |
THEN |
0 |
DO |
I OVER + 1+ C@ >R OVER R> SWAP I + C@ = 0= |
IF |
0 LEAVE |
THEN |
LOOP |
0= |
IF |
DROP DROP 0 |
THEN |
ELSE |
0 |
THEN |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 29 |
00 : GSCAN DUP @ SWAP 2+ SWAP 0 DO |
01 CMPWORD IF LEAVE |
02 0 ELSE 6 + THEN LOOP IF 0 ELSE |
03 DROP 1 THEN ; |
04 : NEWCR KERKNT @ IF TORLCR THEN |
05 ; |
06 : DUPBC OVER >R >R OVER R> SWAP |
07 R> ; |
08 : FINDCHAR SWAP >R SWAP 1+ R> |
09 DO DUP I C@ = |
0A IF DROP I LEAVE 0 THEN LOOP IF |
0B 0 THEN ; |
0C : PRNEWL PRWORD TORLCR ; |
0D |
0E : >= OVER OVER = IF DROP DROP |
0F 1 ELSE > THEN ; --> |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
: GSCAN |
DUP @ SWAP 2+ SWAP 0 |
DO |
CMPWORD |
IF |
LEAVE 0 |
ELSE |
6 + |
THEN |
LOOP |
IF |
0 |
ELSE |
DROP 1 |
THEN |
; |
: NEWCR |
KERKNT @ |
IF |
TORLCR |
THEN |
; |
: DUPBC |
OVER >R >R OVER R> SWAP R> |
; |
: FINDCHAR |
SWAP >R SWAP 1+ R> |
DO |
DUP I C@ = |
IF |
DROP I LEAVE 0 |
THEN |
LOOP |
IF |
0 |
THEN |
; |
: PRNEWL |
PRWORD TORLCR |
; |
: >= |
OVER OVER = |
IF |
DROP DROP 1 |
ELSE |
> |
THEN |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 2A |
00 : EL1G NEWCR INDENT 0SET PRWORD |
01 GTNXWD PRNEWL |
02 10 INDENT ! ; |
03 |
04 : EL2G NEWCR PRNEWL INDENT 0SET |
05 ; |
06 : EL3G NEWCR PRNEWL ; |
07 |
08 : EL4G NEWCR PRNEWL 2 INDENT +! |
09 ; |
0A : EL5G NEWCR -2 INDENT +! PRNEWL |
0B 2 INDENT +! ; |
0C : EL6G NEWCR -2 INDENT +! PRNEWL |
0D ; |
0E : EL7G PRWORD GTNXWD PRNEWL INDE |
0F NT 0SET ; |
10 : EL8G DUPBC 51 FINDCHAR DUP |
11 |
12 IF SWAP DROP OVER - 1+ PRNEWL |
13 ELSE DROP PRWORD THEN ; |
14 : EL9G PRNEWL ; |
15 |
16 : ELAG NEWCR 10 INDENT ! PRNEWL |
17 ; |
18 : ASSWRD DUP 4 >= IF OVER OVER + |
19 1- C@ COMCHR = IF |
1A OVER DUP C@ ICONS = SWAP 1+ |
1B C@ FCONS = AND |
1C IF 2 ELSE 1 THEN ELSE 0 THEN E |
1D LSE 0 THEN ; |
1E --> |
1F |
|
|
: EL1G |
NEWCR INDENT 0SET PRWORD GTNXWD PRNEWL 10 INDENT ! |
; |
: EL2G |
NEWCR PRNEWL INDENT 0SET |
; |
: EL3G |
NEWCR PRNEWL |
; |
: EL4G |
NEWCR PRNEWL 2 INDENT +! |
; |
: EL5G |
NEWCR -2 INDENT +! PRNEWL 2 INDENT +! |
; |
: EL6G |
NEWCR -2 INDENT +! PRNEWL |
; |
: EL7G |
PRWORD GTNXWD PRNEWL INDENT 0SET |
; |
: EL8G |
DUPBC 51 FINDCHAR DUP |
IF |
SWAP DROP OVER - 1+ PRNEWL |
ELSE |
DROP PRWORD |
THEN |
; |
: EL9G |
PRNEWL |
; |
: ELAG |
NEWCR 10 INDENT ! PRNEWL |
; |
: ASSWRD |
DUP 4 >= |
IF |
OVER OVER + 1- C@ COMCHR = |
IF |
OVER DUP C@ ICONS = SWAP 1+ C@ FCONS = AND |
IF |
2 |
ELSE |
1 |
THEN |
ELSE |
0 |
THEN |
ELSE |
0 |
THEN |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 2B |
00 : PRCWRD L1G GSCAN IF EL1G ELSE |
01 L2G GSCAN IF EL2G ELSE |
02 L3G GSCAN IF EL3G ELSE L4G GSC |
03 AN IF EL4G ELSE L5G GSCAN |
04 IF EL5G ELSE L6G GSCAN IF EL6G |
05 ELSE L7G GSCAN IF EL7G |
06 ELSE L8G GSCAN IF EL8G ELSE L9 |
07 G GSCAN IF EL9G ELSE |
08 LAG GSCAN IF ELAG ELSE ASSWRD |
09 IF ASSWRD 2 = |
0A IF EL4G ELSE PRNEWL THEN ELSE |
0B PRWORD |
0C THEN THEN THEN THEN THEN THEN |
0D THEN THEN THEN THEN THEN ; |
0E : FORLST TORLCR DUP TLFLG @ IF L |
0F ISTLP ELSE |
10 TORLCR LIST THEN TORLCR TORLCR |
11 DUP BLK ! |
12 BLOCK DUP 1777 + SWAP KERKNT 0 |
13 SET INDENT 0SET 0 BEGIN GTNXWD |
14 DUP IF PRCWRD THEN DUP 0= END |
15 DROP DROP DROP BLK 0SET ; |
16 : ASTER TORLCR 40 0 DO 52 SP@ 1 |
17 TORLY DROP LOOP TORLCR ; |
18 : FORSHW 1+ OVER DO ASTER I FORL |
19 ST TORLCR LOOP DROP ; |
1A FORTH DEFINITIONS : FLST FORMX T |
1B LFLG 0SET FORLST ; : FLSTLP FORM |
1C X TLFLG 1SET FORLST FFLP ; : FSH |
1D W FORMX TLFLG 0SET FORSHW ; : FS |
1E HWLP FORMX TLFLG 1SET FORSHW |
1F FFLP ; BASE ! ;S |
|
|
: PRCWRD |
L1G GSCAN |
IF |
EL1G |
ELSE |
L2G GSCAN |
IF |
EL2G |
ELSE |
L3G GSCAN |
IF |
EL3G |
ELSE |
L4G GSCAN |
IF |
EL4G |
ELSE |
L5G GSCAN |
IF |
EL5G |
ELSE |
L6G GSCAN |
IF |
EL6G |
ELSE |
L7G GSCAN |
IF |
EL7G |
ELSE |
L8G GSCAN |
IF |
EL8G |
ELSE |
L9G GSCAN |
IF |
EL9G |
ELSE |
LAG GSCAN |
IF |
ELAG |
ELSE |
ASSWRD |
IF |
ASSWRD 2 = |
IF |
EL4G |
ELSE |
PRNEWL |
THEN |
ELSE |
PRWORD |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
THEN |
; |
: FORLST |
TORLCR DUP TLFLG @ |
IF |
LISTLP |
ELSE |
TORLCR LIST |
THEN |
TORLCR TORLCR DUP BLK ! BLOCK DUP 1777 + SWAP KERKNT |
0SET INDENT 0SET 0 |
BEGIN |
GTNXWD DUP |
IF |
PRCWRD |
THEN |
DUP 0= |
END |
DROP DROP DROP BLK 0SET |
; |
: ASTER |
TORLCR 40 0 |
DO |
52 SP@ 1 TORLY DROP |
LOOP |
TORLCR |
; |
: FORSHW |
1+ OVER |
DO |
ASTER I FORLST TORLCR |
LOOP |
DROP |
; |
FORTH DEFINITIONS |
: FLST |
FORMX TLFLG 0SET FORLST |
; |
: FLSTLP |
FORMX TLFLG 1SET FORLST FFLP |
; |
: FSHW |
FORMX TLFLG 0SET FORSHW |
; |
: FSHWLP |
FORMX TLFLG 1SET FORSHW FFLP |
; |
BASE ! ;S |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 2C |
00 ( RS232 SUPPORT ) |
01 |
02 CODE SIO XSAVE STX, BOT LDA, E45 |
03 9 JSR, ( SIOV) XSAVE LDX, |
04 BOT STA, BOT 1+ STY, NEXT JMP, |
05 C; |
06 : SERR DUP 0< IF 0 100 U/ BASE @ |
07 DECIMAL ." SIO ERROR " |
08 . BASE ! QUIT ELSE DROP THEN ; |
09 |
0A CODE DORL XSAVE STX, 506 JSR, |
0B |
0C HERE 8 + JSR, XSAVE LDX, NEXT |
0D JMP, 0C ) JMP, C; |
0E : GETR: HERE 2E7 ! ( SET MEMLO ) |
0F FLUSH EMPTY-BUFFERS |
10 150 300 ! ( DDEVIC,DUNIT) |
11 |
12 403F 302 ! ( ? CMD,EXPECT DATA |
13 ) 5 306 C! ( TIMEOUT) |
14 500 304 ! ( BUFFER ADDR) |
15 |
16 0C 308 ! ( LENGTH ) |
17 |
18 0 30A ! ( AUXES ) |
19 0 SIO SERR ( ERRORS?) |
1A 500 300 0C CMOVE 0 SIO SERR DOR |
1B L |
1C ( RUN RELOCATOR ) 2E7 @ HERE - |
1D |
1E ALLOT HERE FENCE ! ; --> |
1F |
|
|
( RS232 SUPPORT ) |
CODE SIO |
XSAVE STX, |
BOT LDA, |
E459 JSR, |
( SIOV) |
XSAVE LDX, |
BOT STA, |
BOT 1+ STY, |
NEXT JMP, |
C; |
: SERR |
DUP 0< |
IF |
0 100 U/ BASE @ DECIMAL ." SIO ERROR " . BASE ! QUIT |
ELSE |
DROP |
THEN |
; |
CODE DORL |
XSAVE STX, |
506 JSR, |
HERE 8 + JSR, |
XSAVE LDX, |
NEXT JMP, |
0C ) JMP, |
C; |
: GETR: |
HERE 2E7 ! ( SET MEMLO ) |
FLUSH EMPTY-BUFFERS 150 300 ! ( DDEVIC,DUNIT) |
403F 302 ! ( ? CMD,EXPECT DATA) |
5 306 C! ( TIMEOUT) |
500 304 ! ( BUFFER ADDR) |
0C 308 ! ( LENGTH ) |
0 30A ! ( AUXES ) |
0 SIO SERR ( ERRORS?) |
500 300 0C CMOVE 0 SIO SERR DORL ( RUN RELOCATOR ) |
2E7 @ HERE - ALLOT HERE FENCE ! |
; |
--> |
|
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
|
SCR # 2D |
00 ( RS232 ) |
01 |
02 : R1: " R1: " DROP ; |
03 |
04 : R1OPEN 0 8 R1: OPEN ICSTA CH? |
05 ; |
06 : RYPE -DUP IF 1 IOCB 0B ICCOM C |
07 ! ICBLL ! ICBAL ! CIO |
08 20 ICCOM C! 0 I1CAX ! CIO ELSE |
09 DROP THEN ; |
0A : CRR 0A9B SP@ 2 RYPE DROP ; |
0B : REMIT SP@ 1 RYPE DROP ; |
0C : SET9600 1 IOCB 0E I1CAX ! 24 |
0D ICCOM C! R1: ICBAL ! |
0E CIO ICSTA CH? ; |
0F |
10 : LINER SCR @ (LINE) -TRAILING |
11 RYPE ; |
12 100 VARIABLE LSPD |
13 |
14 : LISTR DUP SCR ! CRR " SCR#" RY |
15 PE 0 <# #S #> RYPE CRR 10 0 |
16 DO I 0 <# # # #> RYPE I LINER |
17 CRR LOOP ; |
18 ;S |
19 |
1A |
1B |
1C |
1D |
1E |
1F |
|
|
( RS232 ) |
: R1: |
" R1: " DROP |
; |
: R1OPEN |
0 8 R1: OPEN ICSTA CH? |
; |
: RYPE |
-DUP |
IF |
1 IOCB 0B ICCOM C! ICBLL ! ICBAL ! CIO 20 ICCOM C! 0 |
I1CAX ! CIO |
ELSE |
DROP |
THEN |
; |
: CRR |
0A9B SP@ 2 RYPE DROP |
; |
: REMIT |
SP@ 1 RYPE DROP |
; |
: SET9600 |
1 IOCB 0E I1CAX ! 24 ICCOM C! R1: ICBAL ! CIO ICSTA CH? |
; |
: LINER |
SCR @ (LINE) -TRAILING RYPE |
; |
100 VARIABLE LSPD |
: LISTR |
DUP SCR ! CRR " SCR#" RYPE 0 <# #S #> RYPE CRR 10 0 |
DO |
I 0 <# # # #> RYPE I LINER CRR |
LOOP |
; |
;S |
|
}}} |
|