\ Load Screen - More Basics 19jan83mcs10 13 THRU 80 LOAD ( PANEL ) \ P@ P! 22sep82mcsCODE P@ ( addr -- c ) H POP L A MOV HERE 4 + STA 0 IN A L MOV HPUSH JMP C; CODE P! ( c addr -- ) H POP D POP L A MOV HERE 5 + STA E A MOV 0 OUT NEXT JMP C; \ CASE STATEMENT 22sep82mcs : KEYCASE ?COMP CSP @ !CSP 4 ; IMMEDIATE : OF 4 ?PAIRS COMPILE OVER COMPILE = COMPILE ?BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0= WHILE 2 [COMPILE] THEN REPEAT CSP ! ; IMMEDIATE \ BINARY LL BB 22sep82mcs: BINARY ( -- ) 2 BASE ! ; : LL ( -- ) N L ; : BB ( -- ) B L ; \ ##. A. DMPLN DU DUMP 22sep82mcs: ##. ( n -- ) 0 <# # # #> TYPE SPACE ; : A. ( c -- ) DUP BL < OVER 127 > OR IF DROP ASCII . THEN EMIT ; : DMPLN ( addr ) BASE @ HEX SWAP DUP 4 U.R 2 SPACES 16 0 DO I 3 AND 0= IF SPACE THEN DUP I + C@ ##. LOOP 2 SPACES 16 RANGE DO I C@ A. LOOP CR BASE ! ; : DU ( addr -- ) CR 64 RANGE DO I DMPLN 16 +LOOP ; : DUMP ( addr cnt -- ) CR RANGE DO I DMPLN ?KEY IF LEAVE THEN 16 +LOOP ; \ INPUT STUFF 22SEP82MCS: PAD1 ( -- ) PAD 1+ ; : -INPUT ( -- ) PAD1 C/L EXPECT ; \ AUTO CODE - Load Screen 11may83mcsBLK @ LIST CR CR ." WARNING - CRC uses master reset on HARD DISK" CR ." Code is transformed in compiler" CR CR 1 37 HEX +THRU \ Load the code HEX A000 200 DECIMAL CP/M SAVE PROM.DAT CR ." Prom Image Saved as PROM.DAT" CR CR ." Code 08 09" CR DECIMAL EXIT \ AUTO MODE - Compiler 11may83mcsHEX 7F00 2000 + 200 - CONSTANT EPROM-ORG A000 CONSTANT PROM-ORG A200 CONSTANT RAM-ORG VARIABLE OP-CODE VARIABLE DP-PROM : OP-SEC ( op sec -- ) 20 * SWAP 80 * + DP-PROM ! ; : RAM ( -- n ) 0 ; : SR ( -- n ) 2 ; : CRC ( -- n ) 1 ; : CW ( bus rd cm mk pr ie eprom -- ) DP-PROM @ EPROM-ORG + C! 4 * SWAP NOT 8 * + 20 + SWAP 10 * + SWAP 40 * + SWAP 80 * + + DP-PROM @ PROM-ORG + ! 1 DP-PROM +! DEPTH IF ( DROP ) DP-PROM @ RAM-ORG 1 - + C! THEN ; \ AUTO CODE - READ SECTOR 10may83mcsEXIT Entry requirements: HL 17E3 PCHL target for READ SYNC C 20 Sector Size / 32 LATCH ? RAM, READ, CMPR, MARK, PROM REVS 2 Index interrupts for timeout MODE 1 No interrupt response IE 1 Interrupts enabled Header 17E4 Location of header image COMMAND 3 1K sectors ( see C register ) EPROM LOCATION ARE RELATIVE TO ERPOM SIZE - 200H. \ AUTO CODE - READ SECTOR 11may83mcs0 2 OP-SEC \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 37 CW \ scf A1 RAM 1 0 0 0 1 E9 CW \ pchl FE RAM 1 1 0 1 1 B7 CW \ ora a 00 RAM 1 1 0 1 1 00 CW \ nop 00 RAM 1 1 0 1 1 00 CW \ nop 00 RAM 1 1 0 1 1 00 CW \ nop 00 CRC 1 1 0 1 1 00 CW \ nop CRC 1 1 0 1 1 00 CW \ nop RAM 1 1 0 1 1 21 CW \ lxi h, RAM 1 0 0 1 1 0ED CW \ data RAM 0 0 0 1 1 F7 CW \ pchl+1 \ AUTO CODE - READ SECTOR 11may83mcs\ BUS R C M P L EPROM COMMENT A1 RAM 1 0 0 0 1 E9 CW \ pchl - loop until sF8 SR 1 1 0 1 1 DD CW \ jmp SR 1 0 0 1 1 E9 CW \ around write EXIT \ AUTO CODE - READ SECTOR 09jan83mcs0 1 OP-SEC \ BUS R C M P L EPROM COMMENT SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop \ AUTO CODE - READ SECTOR 09jan83mcs \ BUS R C M P L EPROM COMMENT SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop \ AUTO CODE - READ SECTOR 09jan83mcs \ BUS R C M P L EPROM COMMENT SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop \ AUTO CODE - READ SECTOR 11may83mcs \ BUS R C M P L EPROM COMMENT SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 0D CW \ dcr c SR 1 0 0 1 1 CA CW \ jz SR 1 0 0 1 1 00 CW \ after SR 1 0 0 1 1 FC CW \ data field SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop \ AUTO CODE - READ SECTOR 11may83mcs0 3 OP-SEC \ BUS R C M P L EPROM COMMENT CRC 1 0 0 1 1 00 CW \ nop CRC 1 1 0 1 1 00 CW \ nop 00 RAM 1 1 0 1 1 C3 CW \ jmp 00 RAM 1 0 0 1 1 03 CW \ addr 00 RAM 0 0 0 1 1 00 CW \ addr 00 RAM 0 0 0 1 1 00 CW \ addr \ AUTO CODE - WRITE SECTOR 10may83mcsEXIT \ \ Entry requirements: \ \ HL 17E3 PCHL target for READ SYNC \ C 20 Sector Size / 32 \ LATCH ? RAM, READ, CMPR, MARK, PROM \ REVS 2 Index interrupts for timeout \ MODE 1 No interrupt response \ IE 1 Interrupts enabled \ Header 17E4 Location of header image \ COMMAND 3 1K sectors ( see C register ) \ \ AUTO CODE - WRITE SECTOR 11may83mcs1 2 OP-SEC \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 37 CW \ scf A1 RAM 1 0 0 0 1 E9 CW \ pchl FE RAM 1 1 0 1 1 B7 CW \ ora a 00 RAM 1 1 0 1 1 00 CW \ nop 00 RAM 1 1 0 1 1 00 CW \ nop 00 RAM 1 1 0 1 1 00 CW \ nop 00 CRC 1 1 0 1 1 00 CW \ nop CRC 1 1 0 1 1 C3 CW \ jmp RAM 1 1 0 1 1 F7 CW \ around RAM 1 0 0 1 1 F7 CW \ read \ AUTO CODE - WRITE SECTOR 10may83mcs \ BUS R C M P L EPROM COMMENT 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop 00 RAM 0 0 0 1 1 00 CW \ nop \ AUTO CODE - WRITE SECTOR 11may83mcs \ BUS R C M P L EPROM COMMENT 00 RAM 0 0 0 1 1 16 CW \ mvi d, 00 RAM 0 1 0 1 1 03 CW \ 3 00 RAM 0 1 0 1 1 15 CW \ dcr d 00 RAM 0 1 0 1 1 C2 CW \ jnz 00 RAM 0 1 0 1 1 F9 CW \ loop for 00 RAM 0 1 0 1 1 F7 CW \ preamble 00 RAM 0 1 0 0 1 00 CW \ nop A1 RAM 0 1 1 1 1 00 CW \ nop F8 RAM 0 1 0 1 1 00 CW \ nop \ AUTO CODE - WRITE SECTOR 10may83mcs1 1 OP-SEC \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop EXIT \ AUTO CODE - WRITE SECTOR 10may83mcs \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop EXIT \ AUTO CODE - WRITE SECTOR 10may83mcs \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop EXIT \ AUTO CODE - WRITE SECTOR 10may83mcs \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 00 CW \ nop E5 RAM 0 1 0 1 1 0D CW \ dcr c E5 RAM 0 1 0 1 1 CA CW \ jz E5 RAM 0 1 0 1 1 00 CW \ addr E5 RAM 0 1 0 1 1 FC CW \ addr E5 RAM 0 1 0 1 1 00 CW \ nop EXIT \ AUTO CODE - WRITE SECTOR 10may83mcs1 3 OP-SEC \ BUS R C M P L EPROM COMMENT CRC 0 1 0 1 1 00 CW \ nop CRC 0 1 0 1 1 00 CW \ nop RAM 0 1 0 1 1 00 CW \ nop 00 RAM 0 1 0 1 1 C3 CW \ jmp 00 RAM 0 1 0 1 1 03 CW \ addr 00 RAM 0 0 0 1 1 00 CW \ addr \ AUTO CODE - READ HEADER 10may83mcsEXIT \ \ Entry requirements: \ \ LATCH ? SR, READ, PROM \ REVS 2 Index interrupts for timeout \ MODE 1 No interrupt response \ IE 1 Interrupts enabled \ \ F801 7 bytes of header which follow m \ AUTO CODE - READ HEADER 11may83mcs2 2 OP-SEC \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 C3 CW \ jmp RAM 0 0 0 1 1 FB CW \ RAM 0 0 0 1 1 F7 CW \ RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop \ AUTO CODE - READ HEADER 10may83mcs \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop \ AUTO CODE - READ HEADER 10may83mcs \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 00 CW \ nop RAM 0 0 0 1 1 21 CW \ lxi h, RAM 0 0 0 1 1 FF CW \ data RAM 0 0 0 1 1 F7 CW \ pchl+1 A1 RAM 1 0 0 0 1 E9 CW \ pchl SR 1 0 0 1 1 00 CW \ nop \ AUTO CODE - READ HEADER 11may83mcs2 1 OP-SEC \ BUS R C M P L EPROM COMMENT SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop SR 1 0 0 1 1 00 CW \ nop RAM 1 0 0 1 1 00 CW \ nop RAM 1 0 0 1 1 C3 CW \ jmp RAM 1 0 0 1 1 03 CW \ RAM 0 0 0 1 1 00 CW \ RAM 0 0 0 1 1 00 CW \ \ AUTO CODE - FORMAT 15jun83mcsEXIT \ \ Entry requirements: \ B 3 Revolutions C 8 Number of sectors H 0F Gap 3 / 4 L 20 Sector Size / 32 Values shown are for 8 sectors of 1024 bytes \ AUTO CODE - FORMAT 11may83mcs3 2 OP-SEC \ Wait for index \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 78 CW \ mov a,b RAM 0 0 0 1 1 FE CW \ cpi , RAM 0 0 0 1 1 01 CW \ 1 RAM 0 0 0 1 1 CA CW \ jz RAM 0 0 0 1 1 E7 CW \ RAM 0 0 0 1 1 F7 CW \ RAM 0 0 0 1 1 76 CW \ hlt EXIT f7e0-f7e6 \ AUTO CODE - FORMAT 23may83mcs \ Write 16 bytes of 4E at start of track. \ BUS R C M P L EPROM COMMENT RAM 0 0 0 1 1 16 CW \ mvi d, RAM 0 0 0 1 1 04 CW \ 4 4E RAM 0 1 0 1 1 15 CW \ dcr d 4E RAM 0 1 0 1 1 C2 CW \ jnz 4E RAM 0 1 0 1 1 E9 CW \ F7E9 4E RAM 0 1 0 1 1 F7 CW \ EXIT f7e7-f7ec \ AUTO CODE - FORMAT 23may83mcs \ Write preamble of 13 bytes of 00. \ BUS R C M P L EPROM COMMENT 00 RAM 0 1 0 1 1 16 CW \ mvi d, 00 RAM 0 1 0 1 1 02 CW \ 2 00 RAM 0 1 0 1 1 15 CW \ dcr d 00 RAM 0 1 0 1 1 00 CW \ nop 00 RAM 0 1 0 1 1 C2 CW \ jnz 00 RAM 0 1 0 1 1 EF CW \ F7EF 00 RAM 0 1 0 1 1 F7 CW \ 00 RAM 0 1 0 0 1 00 CW \ EXIT f7ed-f7f4 \ AUTO CODE - FORMAT 11may83mcs \ Write header mark. \ BUS R C M P L EPROM COMMENT A1 RAM 0 1 1 1 1 00 CW \ FE RAM 0 1 0 1 1 00 CW \ EXIT f7f5-f7f6 \ AUTO CODE - FORMAT 11may83mcs \ RAM BUS R C M P L EPROM COMMENT 11 RAM 0 1 0 1 1 06 CW \ mvi b, 11 RAM 0 1 0 1 1 FC CW \ FC 11 RAM 0 1 0 1 1 0A CW \ ldax b CRC 0 1 0 1 1 16 CW \ mvi d, RAM 0 1 0 1 1 03 CW \ 3 00 RAM 0 1 0 0 1 15 CW \ dcr d 00 RAM 0 1 0 0 1 00 CW \ 00 RAM 0 1 0 0 1 C2 CW \ jnz 00 RAM 0 1 0 0 1 FC CW \ F7FC EXIT f7f7-f7ff \ AUTO CODE - FORMAT 15jun83mcs3 1 OP-SEC \ BUS R C M P L EPROM COMMENT 00 RAM 0 1 0 0 1 F7 CW \ A1 RAM 0 1 1 1 1 00 CW \ F8 RAM 0 1 0 1 1 5D CW \ mov e,l EXIT f800-f802 \ AUTO CODE - FORMAT 23may83mcs \ Write 22 bytes of data field \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 16 CW \ mvi d, E5 RAM 0 1 0 1 1 05 CW \ 5 E5 RAM 0 1 0 1 1 15 CW \ dcr d E5 RAM 0 1 0 1 1 C2 CW \ jnz E5 RAM 0 1 0 1 1 05 CW \ F805 E5 RAM 0 1 0 1 1 F8 CW \ EXIT f803-f808 \ AUTO CODE - FORMAT 15jun83mcs \ Exit outer loop early if last 32 byte block. \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 1D CW \ dcr e E5 RAM 0 1 0 1 1 CA CW \ jz E5 RAM 0 1 0 1 1 13 CW \ F813 E5 RAM 0 1 0 1 1 F8 CW \ EXIT f809-f80c \ AUTO CODE - FORMAT 15jun83mcs \ Complete outer loop if more blocks of 32 bytes. \ BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 C3 CW \ jmp E5 RAM 0 1 0 1 1 03 CW \ F803 E5 RAM 0 1 0 1 1 F8 CW \ EXIT f80d-f812 \ AUTO CODE - FORMAT 15jun83mcs \ Complete outer loop for final block of 32 bytes. \ RAM BUS R C M P L EPROM COMMENT E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 RAM 0 1 0 1 1 00 CW \ E5 CRC 0 1 0 1 1 C3 CW \ jmp CRC 0 1 0 1 1 10 CW \ FC10 RAM 0 1 0 1 1 FC CW \ EXIT f813-f81a \ AUTO CODE - FORMAT 15jun83mcs3 3 OP-SEC \ RAM BUS R C M P L EPROM COMMENT 00 CRC 0 1 0 1 1 00 CW \ 08 CRC 0 1 0 1 1 00 CW \ 07 CRC 0 1 0 1 1 00 CW \ 06 CRC 0 1 0 1 1 00 CW \ 05 CRC 0 1 0 1 1 00 CW \ 04 CRC 0 1 0 1 1 00 CW \ 03 CRC 0 1 0 1 1 00 CW \ 02 CRC 0 1 0 1 1 00 CW \ 01 CRC 0 1 0 1 1 00 CW \ EXIT fc00-fc08 \ AUTO CODE - FORMAT 15jun83mcs \ RAM BUS R C M P L EPROM COMMENT 08 CRC 0 1 0 1 1 00 CW \ 07 CRC 0 1 0 1 1 00 CW \ 06 CRC 0 1 0 1 1 00 CW \ 05 CRC 0 1 0 1 1 00 CW \ 04 CRC 0 1 0 1 1 00 CW \ 03 CRC 0 1 0 1 1 00 CW \ 02 CRC 0 1 0 1 1 00 CW \ EXIT fc09-fc0f \ AUTO CODE - FORMAT 19jan83mcs \ Write postamble and Gap3. \ RAM BUS R C M P L EPROM COMMENT 00 RAM 0 1 0 1 1 54 CW \ mov d,h 00 RAM 0 1 0 1 1 15 CW \ dcr d 4E RAM 0 1 0 1 1 15 CW \ dcr d 4E RAM 0 1 0 1 1 C2 CW \ jnz 4E RAM 0 1 0 1 1 02 CW \ FC02 4E RAM 0 1 0 1 1 FC CW \ EXIT fc10-fc15 \ AUTO CODE - FORMAT 19jan83mcs \ Complete postamble. Loop if more sectors to do. \ RAM BUS R C M P L EPROM COMMENT 4E RAM 0 1 0 0 1 0D CW \ dcr c 4E RAM 0 1 0 0 1 C2 CW \ jnz 4E RAM 0 1 0 0 1 0ED CW \ F7ED 4E RAM 0 1 0 0 1 F7 CW \ \ Write 4E to end of track if no more sectors. 4E RAM 0 1 0 0 1 06 CW \ mvi b, 4E RAM 0 1 0 0 1 01 CW \ 1 4E RAM 0 1 0 0 1 76 CW \ hlt - until index EXIT fc16-fc1c \ COLD for RAM system TASK 19jan83mcsHEX : +ORIGON ( N -- N ) 100 + ; : COLD 12 +ORIGIN 22 +ORIGON @ 6 + 10 CMOVE INIT-VEC SP! ['] DONE IS QUIT ['] NOOP IS WHERE HEX DNLD DONE ; \ FIRST USE ! FIRST PREV ! \ 0C +ORIGIN @ ['] FORTH ! 0 OFFSET ! EMPTY-BUFFERS \ ['] (WARN) IS WARN ['] NOOP IS WHERE \ DEFAULT-FILE \ FORTH DEFINITIONS DECIMAL \ ['] (QUIT) IS QUIT NOOP QUIT ; DECIMAL ' COLD CFA ' TASK 2+ ! BYE \ Qume - variables, constants & strobes 20sep82mcs 12 CONSTANT HMI 8 CONSTANT VMI 240 CONSTANT PRTH 241 CONSTANT PRTL : EXEC (S stb -- ) ( strobe name ) CREATE , DOES> (S n -- ) @ >R 256 /MOD SWAP PRTL P! R> BEGIN PRTH P@ OVER AND UNTIL OR PRTH P! ; HEX 20 EXEC VSTB 40 EXEC HSTB 48 EXEC HRSTB 80 EXEC CSTB E0 EXEC RESTORE DECIMAL 120 12 * CONSTANT HMAX ( 12 inches at 120 to the inch )VARIABLE HCUR VARIABLE VCUR ( Logical Position Cursor ) VARIABLE VPOS VARIABLE HPOS ( Physical Position ) : SP (S -- ) HCUR @ HMAX < IF HMI HCUR +! THEN ; : CR (S -- ) 0 HCUR ! ; : LF (S -- ) VMI 2* VSTB ; : FF (S -- ) ; --> \ C. Itoh Matrix Printer on Spectrum Parallel Port 09NOV82MCSHEX 81 CONSTANT SPEC : MTRX@ ( -- c ) SPEC P@ ; : MTRX! ( c -- ) DUP 80 OR SPEC P! DUP 7F AND SPEC P! 80 OR SPEC P! ; : NOT-BUSY ( -- f ) MTRX@ 80 AND 0= ; DECIMAL : MEMIT ( c -- ) BEGIN NOT-BUSY UNTIL MTRX! ; : (MEMIT) ( c -- ) EPRINT @ IF DUP MEMIT THEN (EMIT) ; : MATRIX ( -- ) ['] (MEMIT) IS EMIT ; \ Load Screen for PRINT Utility 11MAY82HHLBLK @ LIST 1 4 +THRU EXIT The Print Utility allows you to print a range of screens on your printer. If your printer allows it, you can print 6 screens per page. The top level word is SHOW which takes a starting and ending screen number and prints all the non blank screens within the range. To list the entire disk you need only type LISTING. Finally, if you are using SHADOW screens, the editor's version of SHOW will list each screen along with its shadow. The print utility is currently initialized for an EPSON. If you do not have an EPSON you may have to change the word called INIT-PRINT. \ Variables for print utility 29SEP82MCSCREATE SCR#S ( Holds the Nth screen number ) 14 ALLOT ( enough room for 6 Screens ) VARIABLE PAGE# ( Current page number ) VARIABLE SCRS/PAGE ( Number of screens per page ) : .ID (S -- ) CR 58 SPACES ." Michael Stolowitz 1982" ; \ Print 2 screens across on a page 29SEP82MCS: 2PR (S Scr1# Scr2# line# -- ) ?KEY ABORT" Stop" CR >R R@ 2 .R SPACE PAD 132 2DUP BLANK EDITOR <# SWAP BLOCK R@ C/L * + 0 C/L # BLOCK R> C/L * + C/L 1+ C/L # #> -TRAILING TYPE ; : 2SCR (S Scr1 Scr2 --- ) CR CR 4 SPACES OVER 4 .R 61 SPACES DUP 4 .R 16 0 DO 2DUP I 2PR LOOP 2DROP ; : PRINT (S Scr -- ) 1 SCR#S +! SCR#S DUP @ 2* + ! SCR#S @ SCRS/PAGE @ = IF 1 PAGE# +! CR CR 5 SPACES ." Page# " PAGE# ? CR SCR#S 2+ SCRS/PAGE @ 2/ 0 DO DUP 2@ SWAP 2SCR 4 + LOOP DROP 0 SCR#S ! CR .ID CR 12 ( FF ) EMIT THEN ; \ Setup & Finish Printing 02OCT82MCS: PR-FLUSH (S -- ) SCR#S @ IF ( Any screens left over? ) BEGIN SCR#S @ SCRS/PAGE @ 1- < WHILE 0 PRINT REPEAT 1 PRINT THEN ; : INIT-PRINT (S -- ) 0 SCR#S ! 0 PAGE# ! ( C. ITOH ) 6 SCRS/PAGE ! 13 EMIT 28 EMIT ( CONDENSED ) ; EXIT \ Print a set of screens 09NOV82MCS: TEXT? (S Scr# -- f ) BLOCK B/BUF -TRAILING SWAP DROP 0= NOT ; : SHOW (S n1 n2 -- ) INIT-PRINT 1+ SWAP DO I TEXT? IF I PRINT THEN LOOP PR-FLUSH ; EXIT \ ASCII 09NOV82MCS: ASCII ( -- ) BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE \ Jedec PALs - Load Screen 28apr83mcs 119 LOAD \ Error Trapping 100 LOAD \ PALS 120 130 THRU \ Text File Interpretation EXIT \ PALS Load Screen 12mar83mcs BLK @ LIST 1 7 +THRU EXIT The PALS compiler produces a PAL ( Programmable Array Logic ) bit map by interpretation of boolean logic equations much the same way that Forth assemblers work. The compiler uses a source notation which provides useful documentation of the target parts. \ JEDEC - PAL H/L MAXFUSE FUSE/ROW DEVCD 19jan83mcsVARIABLE PAL-TYPE 0 CONSTANT MAP : (PAL) CREATE , DOES> @ PAL-TYPE @ + @ ; 2 (PAL) H/L 4 (PAL) MAXFUSE 6 (PAL) FUSE/ROW 8 (PAL) DEVCD : PAL ( devcd fuse/row maxfuse h/l scr -- ) CREATE , , , , , DOES> DUP PAL-TYPE ! @ 107 + LOAD HERE DUP ['] MAP ! DUP MAXFUSE 2* ALLOT MAXFUSE 2* ERASE ; EXIT \ fuse addr pwr2 map in/out invert last-out row h/l 28jan83mcs VARIABLE IN/OUT VARIABLE INVERT VARIABLE LAST-OUT VARIABLE ROW : ADDR ( col -- addr ) ROW @ + 2* MAP + ; : FUSE ( col f -- ) SWAP INVERT @ + 0 INVERT ! ADDR ! ; \ (input) input next-term 19jan83mcs : (INPUT) (S 'col -- ) @ 0 FUSE 0 IN/OUT ! ; : INPUT (S col -- ) ( pin's dot name ) CREATE , DOES> (S -- ) ( pin's signal name ) @ CREATE , DOES> IN/OUT @ 0= ABORT" Output Required." (INPUT) ; : NEXT-TERM (S -- ) LAST-OUT @ DUP @ 0= ABORT" Too Many Terms." -1 OVER +! 2+ DUP @ ROW ! FUSE/ROW SWAP +! FUSE/ROW 0 DO I 1 FUSE LOOP 1 IN/OUT ! ; \ output twk pal. 19jan83mcs: OUTPUT (S row #rows col -- ) ( pin's dot name ) CREATE , , , DOES> (S -- ) ( pin's signal name ) CREATE , DOES> @ IN/OUT @ IF ( input expected ) DUP @ 254 > ABORT" No Internal Feedback." (INPUT) ELSE ( output expected ) INVERT @ H/L XOR 1 - ABORT" Invert Output Equation." 2+ LAST-OUT ! 0 INVERT ! NEXT-TERM THEN ; : PAL. CR CR MAXFUSE 0 DO I ROW ! I 4 .R 2 SPACES FUSE/ROW 0 DO I ADDR @ IF ." 1" ELSE ." 0" THEN I 10 MOD 9 = IF SPACE THEN LOOP CR ?KEY IF LEAVE THEN FUSE/ROW +LOOP ; \ SKIP NC + / * HI PAL PALS 12mar83mcs: SKIP ( -- ) BL WORD DROP ; 255 CONSTANT NA VOCABULARY SEAL IMMEDIATE SEAL DEFINITIONS : NC (S -- ) BL WORD DROP ; : + (S -- ) NEXT-TERM ; : / (S -- ) 1 INVERT ! ; : * (S -- ) IN/OUT @ ABORT" Input Expected." 1 IN/OUT ! ; : HI (S -- ) 0 IN/OUT ! ; : = (S -- ) ; FORTH DEFINITIONS : PALS (S -- ) [COMPILE] SEAL DEFINITIONS ; \ JEDEC PAL-TYPE 19jan83mcs SEAL DEFINITIONS 9513 20 320 0 1 PAL 10L8 9518 20 320 1 1 PAL 10H8 9514 24 384 0 2 PAL 12L6 9519 24 384 1 2 PAL 12H6 9515 28 448 0 3 PAL 14L4 9520 28 448 1 3 PAL 14H4 9516 32 512 0 4 PAL 16L2 9522 32 512 1 4 PAL 16H2 9517 32 2048 0 5 PAL 16L8 9524 32 2048 0 6 PAL 16R4 9524 32 2048 0 6 PAL 16R6 9524 32 2048 0 6 PAL 16R8 9503 32 640 0 7 PAL 16L6 9527 40 2560 0 8 PAL 20R4 FORTH DEFINITIONS \ JEDEC - 10L8 10H8 04apr83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 6 INPUT 4. 8 INPUT 5. 10 INPUT 6. 12 INPUT 7. 14 INPUT 8. 16 INPUT 9. : 10. SKIP ; 18 INPUT 11. : 20. SKIP ; 0 2 NA OUTPUT 19. 40 2 NA OUTPUT 18. 80 2 NA OUTPUT 17. 120 2 NA OUTPUT 16. 160 2 NA OUTPUT 15. 200 2 NA OUTPUT 14. 240 2 NA OUTPUT 13. 280 2 NA OUTPUT 12. EXIT \ JEDEC - 12H6 12L6 12mar83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 10 INPUT 5. 12 INPUT 6. 14 INPUT 7. 16 INPUT 8. 20 INPUT 9. : 10. SKIP ; 22 INPUT 11. : 20. SKIP ; 6 INPUT 19. 18 INPUT 12. 288 4 NA OUTPUT 13. 240 2 NA OUTPUT 14. 192 2 NA OUTPUT 15. 144 2 NA OUTPUT 16. 96 2 NA OUTPUT 17. 0 4 NA OUTPUT 18. EXIT \ JEDEC - 14H4 14L4 31mar83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 12 INPUT 5. 14 INPUT 6. 16 INPUT 7. 20 INPUT 8. 24 INPUT 9. : 10. SKIP ; 26 INPUT 11. : 20. SKIP ; 6 INPUT 19. 22 INPUT 12. 10 INPUT 18. 18 INPUT 13. 0 4 NA OUTPUT 17. 112 4 NA OUTPUT 16. 224 4 NA OUTPUT 15. 336 4 NA OUTPUT 14. EXIT \ JEDEC - 16H2 16L2 31mar83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 12 INPUT 5. 16 INPUT 6. 20 INPUT 7. 24 INPUT 8. 28 INPUT 9. : 10. SKIP ; 30 INPUT 11. : 20. SKIP ; 6 INPUT 19. 26 INPUT 12. 10 INPUT 18. 22 INPUT 13. 14 INPUT 17. 18 INPUT 14. 0 8 NA OUTPUT 16. 256 8 NA OUTPUT 15. EXIT \ JEDEC - 16L8 04apr83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 12 INPUT 5. 16 INPUT 6. 20 INPUT 7. 24 INPUT 8. 28 INPUT 9. : 10. SKIP ; 30 INPUT 11. : 20. SKIP ; 0 8 NA OUTPUT 19. 256 8 6 OUTPUT 18. 512 8 10 OUTPUT 17. 768 8 14 OUTPUT 16. 1024 8 18 OUTPUT 15. 1280 8 22 OUTPUT 14. 1536 8 26 OUTPUT 13. 1792 8 NA OUTPUT 12. EXIT \ JEDEC - 16R4 16R6 16R8 04apr83mcs : 1. SKIP ; 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 12 INPUT 5. 16 INPUT 6. 20 INPUT 7. 24 INPUT 8. 28 INPUT 9. : 10. SKIP ; : 11. SKIP ; : 20. SKIP ; 0 8 2 OUTPUT 19. 256 8 6 OUTPUT 18. 512 8 10 OUTPUT 17. 768 8 14 OUTPUT 16. 1024 8 18 OUTPUT 15. 1280 8 22 OUTPUT 14. 1536 8 26 OUTPUT 13. 1792 8 30 OUTPUT 12. EXIT \ JEDEC - 16L6 19jan83mcs 2 INPUT 1. 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 6 INPUT 23. 10 INPUT 22. 12 INPUT 5. 14 INPUT 6. 16 INPUT 7. 18 INPUT 8. 20 INPUT 9. 22 INPUT 15. 24 INPUT 10. 26 INPUT 14. 28 INPUT 11. 30 INPUT 13. : 12. SKIP ; : 24. SKIP ; 0 4 NA OUTPUT 21. 128 4 NA OUTPUT 20. 256 2 NA OUTPUT 19. 320 2 NA OUTPUT 18. 384 4 NA OUTPUT 17. 512 4 NA OUTPUT 16. EXIT \ JEDEC - 20R4 19jan83mcs : 1. SKIP ; 0 INPUT 2. 4 INPUT 3. 8 INPUT 4. 12 INPUT 5. 16 INPUT 6. 20 INPUT 7. 24 INPUT 8. 28 INPUT 9. 32 INPUT 10. 36 INPUT 11. : 12. SKIP ; : 13. SKIP ; : 24. SKIP ; 2 INPUT 23. 38 INPUT 14. 0 8 6 OUTPUT 22. 320 8 10 OUTPUT 21. 640 8 14 OUTPUT 20. 960 8 18 OUTPUT 19. 1280 8 22 OUTPUT 18. 1600 8 26 OUTPUT 17. 1920 8 30 OUTPUT 16. 2240 8 34 OUTPUT 15. EXIT \ ERROR 06dec82mcsVARIABLE ERRORS : ABORT ( -- ) CR CR ." Aborted" CR 3 EXECUTE ; : (ABORT") ( f -- ) IF CR CR 7 EMIT ." Error --> " ASCII " EMIT HERE COUNT TYPE ASCII " EMIT SPACE R@ COUNT TYPE ." to continue, to abort. " BEGIN KEY DUP 27 = IF ABORT THEN 13 = UNTIL CR 1 ERRORS +! THEN R> COUNT + >R ; : ABORT" ( -- ) ?COMP COMPILE (ABORT") ASCII " WORD C@ 1+ ALLOT ; IMMEDIATE : (FATAL") ( f -- ) IF R> COUNT TYPE ABORT THEN R> COUNT + >R ; : FATAL" ( -- ) ?COMP COMPILE (FATAL") ASCII " WORD C@ 1+ ALLOT ; IMMEDIATE \ TEXT-LINE 19jan83mcs 92 CONSTANT FCB1 128 CONSTANT BUF VARIABLE EOF : END ( -- ) 1 EOF ! ; : TWEEK ( -- ) 1 EOF ! ; : CH>PAD ( C --- ) >IN @ PAD + C! 1 >IN +! ; : ERROR ( -- ) 1 ABORT" is undefined." ; : INTERPRET ( -- ) BEGIN -FIND IF DROP EXECUTE ELSE ERROR THEN AGAIN ; : INTERP ( -- ) PAD TIB @ >IN @ CMOVE ( tib @ du ) 0 >IN ! INTERPRET ; : TEXT-LINE ( -- ) PAD >IN @ -TRAILING TYPE CR 0 CH>PAD 0 CH>PAD INTERP 0 >IN ! ; : TAB ( -- ) 8 >IN @ OVER MOD - 0 DO BL CH>PAD LOOP ; \ TEXT-BUF 19jan83mcs: TEXT-BUF ( -- ) BUF 128 RANGE DO I C@ 127 AND ( MASK 8 BIT ) DUP BL < IF ( CTL ) DUP 13 = IF ( CR ) DROP TEXT-LINE ELSE DUP 9 = IF ( TAB ) DROP TAB ELSE DUP 26 = IF ( EOF ) DROP TEXT-LINE 1 EOF ! LEAVE ELSE DROP THEN THEN THEN ELSE ( PRINTABLE ) DUP ASCII \ = IF 0 CH>PAD CH>PAD ELSE DUP 127 < IF ( NOT DELETE ) CH>PAD ELSE DROP THEN THEN THEN EOF @ IF LEAVE THEN LOOP ; EXIT SEND PRINTABLE CHARACTERS TO PAD. EXPAND TABS. EXECUTES TEXT-LINE AT END OF LINE ( CR ). CTL Z DOES TEXT-LINE, THEN SETSEND OF FILE AND LEAVES. OTHER CONTROL CHARACTERS ARE DROPPED. \ DOS-FNC FCBQ BUF FILE-TYPE ... 19jan83mcs 92 CONSTANT FCB1 128 CONSTANT BUF : DOS-FNC ( n -- ) CREATE , DOES> ( arg -- f ) @ FCB1 SWAP BDOS ; 20 DOS-FNC SEQ-READ 21 DOS-FNC SEQ-WRITE 19 DOS-FNC DELETE 22 DOS-FNC MAKE 16 DOS-FNC CLOSE 15 DOS-FNC OPEN : FILE-TYPE ( -- addr ) FCB @ 9 + ; \ WRITE-FILE 19jan83mcsEXIT : WRITE-FILE ( -- ) FCB1 FCB ! FILE-TYPE 28 ERASE " DAT" FILE-TYPE SWAP CMOVE ( Insert default output type ) DELETE DROP ( Remove any old output file ) MAKE CPM-ERR? FATAL" File Make Error" ( Make file & check ) MAP 512 RANGE DO I SET-DMA SEQ-WRITE CPM-ERR? FATAL" Disk Write Error" 128 +LOOP CLOSE CPM-ERR? FATAL" File Close Error" ; \ DATA STAT TBE+RTS PROG-EMIT POFF PON 19jan83mcs142 LOAD EXIT 04 CONSTANT DATA 05 CONSTANT STAT 128 CONSTANT RTS 01 CONSTANT TBE VARIABLE CHECKSUM : POFF ( -- ) ['] (EMIT) IS EMIT ; : PROG-EMIT ( c -- ) DUP CHECKSUM +! DUP (EMIT) BEGIN ?KEY IF KEY 27 = IF POFF ABORT THEN THEN STAT P@ RTS TBE OR AND TBE = UNTIL DATA P! ; : PON ( -- ) ['] PROG-EMIT IS EMIT ; EXIT : PON ( -- ) ; \ DUPLEX 19jan83mcsEXIT 2 CONSTANT DAV : ?DATA ( -- f ) STAT P@ DAV AND ; : DUPLEX ( -- ) BEGIN ?DATA IF DATA P@ EMIT THEN ?KEY IF PROG-EMIT THEN 0 UNTIL ; EXIT \ JEDEC file 19jan83mcs: ARRAY ( N -- ) ( NAME ) CREATE 2* ALLOT DOES> SWAP 2* + ; 8 ARRAY CHKSUMS : ####. ( n -- ) 0 <# # # # # #> TYPE ; : NSEND ( addr n -- ) RANGE DO I 2* MAP + @ IF 1 I 7 AND CHKSUMS +! ." 1" ELSE ." 0" THEN LOOP CR ; : SEND-DATA ( -- ) ['] CHKSUMS 16 ERASE 0 BEGIN DUP MAXFUSE < WHILE DUP 200 MOD 0= IF ." *L" DUP ####. SPACE CR THEN MAXFUSE OVER - 20 MIN 2DUP NSEND + REPEAT ; : SUM-CHECK ( -- n ) 0 -1 7 DO 2* I CHKSUMS @ + -1 +LOOP ; \ JEDEC file 19jan83mcs: STX 2 EMIT ( ." STX" ) ; : ETX 3 EMIT ( ." ETX" ) ; : SEND-JEDEC ( -- ) 0 CHECKSUM ! DECIMAL PON STX CR ( Design identifier ) ." *D" DEVCD ####. ( Device identifier ) ." *F0" CR ( Default Value ) ." *G1" SPACE CR ( Protect fuse ) SEND-DATA ( Fuse data ) ." *C" HEX SUM-CHECK ####. CR ( Data sum-check ) ." *" ETX ( End of checked stream ) CHECKSUM @ ####. POFF ; ( Message checksum ) \ OPEN-SOURCE READ-FILE APPL 19jan83mcs: NAME. ( addr -- ) CR ." Source File = " DUP C@ ?DUP IF [ ASCII A 1- ] LITERAL + EMIT ." :" THEN 1+ DUP 8 -TRAILING TYPE ." ." 8 + 3 -TRAILING TYPE CR CR ; : OPEN-SOURCE ( -- ) FCB1 FCB ! FILE-TYPE 28 ERASE " TXT" FILE-TYPE SWAP CMOVE FCB @ NAME. OPEN-FILE CPM-ERR? FATAL" File Open Error" ; : READ-FILE ( -- ) 0 >IN ! 0 EOF ! BEGIN BUF SET-DMA SEQ-READ EOF @ OR NOT ( not EOF ) WHILE TEXT-BUF REPEAT ; : APPL ( -- ) OPEN-SOURCE READ-FILE ERRORS @ NOT IF SEND-JEDEC ( DUPLEX ) THEN CR CR ." Errors = " ERRORS ? CR ; \ SIGN-ON 19jan83mcs147 LOAD EXIT : SIGN-ON ( -- ) 24 0 DO CR LOOP ." PAL Logic Compiler - Version 3.1" CR CR ." Copyright 1983 by Michael Stolowitz" CR CR ." JEDEC format output to Data I/O with PLDS" CR CR ; : (QUIT) 0 BLK ! [COMPILE] [ RP! APPL 3 EXECUTE ; : PATCH ; EXIT : PATCH ( -- ) " DATA BLK" ['] DEFAULT 3 + SWAP CMOVE ; EXIT \ COLD for RAM system TASK 19jan83mcsHEX : +ORIGON ( N -- N ) 100 + ; : COLD 12 +ORIGIN 22 +ORIGON @ 6 + 10 CMOVE FIRST USE ! FIRST PREV ! INIT-VEC SP! SIGN-ON 0C +ORIGIN @ ['] FORTH ! 0 OFFSET ! EMPTY-BUFFERS ['] DROP IS WARN ['] NOOP IS WHERE 0 FILES ! PATCH ( DEFAULT-FILE ) [COMPILE] FORTH DEFINITIONS DECIMAL 80 ['] C/L ! ['] (QUIT) IS QUIT QUIT ; DECIMAL ' COLD CFA ' TASK 2+ ! ( BYE ) \ ERROR - DEBUG 04apr83mcsVARIABLE ERRORS : FATAL" ( -- ) [COMPILE] ABORT" ; IMMEDIATE EXIT \ DOS-FNC FCBQ BUF FILE-TYPE ... 19jan83mcsCREATE BUF 128 ALLOT CREATE FCB1 38 ALLOT CREATE FCB2 38 ALLOT : DOS-FNC ( n -- ) CREATE , DOES> ( arg -- f ) @ FCB @ SWAP BDOS ; 17 DOS-FNC SEARCH0 18 DOS-FNC SEARCH 20 DOS-FNC SEQ-READ 21 DOS-FNC SEQ-WRITE 19 DOS-FNC DELETE 22 DOS-FNC MAKE 16 DOS-FNC CLOSE 15 DOS-FNC OPEN : FILE-TYPE ( -- addr ) FCB @ 9 + ; \ 19jan83mcsVARIABLE NRECORDS : COPY-REC ( fr to -- ) 2DUP . . 1 NRECORDS +! FCB1 FCB ! BUF SET-DMA SWAP RANDOM ! REC-READ ABORT" Disk Read Error" FCB2 FCB ! BUF SET-DMA RANDOM ! REC-WRITE ABORT" Disk Write Error" ; \ 19jan83mcsHEX : SC-PACK ( -- ) 0 NRECORDS ! FCB1 FCB ! !FCB OPEN CPM-ERR? ABORT" Open Error" FCB2 FCB ! !FCB DELETE DROP MAKE CPM-ERR? ABORT" Make Error" BE 0 DO I I COPY-REC LOOP 3A4 300 DO I I 242 - COPY-REC LOOP FCB2 FCB ! CLOSE CPM-ERR? ABORT" Close Error " CR NRECORDS ? ." RECORDS COPIED" CR ; DECIMAL \ 19jan83mcsHEX : SC-UNPACK ( -- ) 0 NRECORDS ! FCB1 FCB ! !FCB OPEN CPM-ERR? ABORT" Open Error" FCB2 FCB ! !FCB DELETE DROP MAKE CPM-ERR? ABORT" Make Error" BE 0 DO I I COPY-REC LOOP 162 BE DO I I 242 + COPY-REC LOOP FCB2 FCB ! CLOSE CPM-ERR? ABORT" Close Error " CR NRECORDS ? ." RECORDS COPIED" CR ; DECIMAL \ XDIR 06apr83mcs: DIR ( -- ) CP/M FCB2 FCB ! FCB2 13 ASCII ? FILL CR PAD SET-DMA SEARCH0 BEGIN 32 * PAD + DLN SEARCH DUP CPM-ERR? UNTIL DROP ; EXIT : DIR " ????????.???" (!FCB) CR PAD SET-DMA SEARCH0 BEGIN 32 * PAD + 1+ DUP 8 TYPE SPACE 8 + 3 TYPE SPACE ASCII | EMIT SPACE ?CR SEARCH DUP CPM-ERR? \ DATA I/O MODEL 19 ON SWITCHBOARD 28apr83mcsBLK @ LIST 1 5 +THRU EXIT \ DATA STAT TBE+RTS PROG-EMIT POFF PON 19jan83mcsHEX 00 CONSTANT DATA 02 CONSTANT STAT 08 CONSTANT TBE VARIABLE CHECKSUM : PROG-EMIT ( c -- ) DUP CHECKSUM +! DUP (EMIT) BEGIN ?KEY IF KEY 1B = ABORT" Aborted" THEN STAT P@ TBE AND UNTIL DATA P! ; : POFF ( -- ) ['] (EMIT) IS EMIT ; : PON ( -- ) ['] PROG-EMIT IS EMIT ; DECIMAL EXIT \ FCB BUFFER OPEN READ SET-DMA 19jan83mcs 92 CONSTANT FCB 128 CONSTANT BUFFER ASCII A 1 - CONSTANT A-1 : OPEN ( -- flg ) FCB 15 BDOS ; : READ-SEQ ( -- flg ) FCB 20 BDOS ; : SET-DMA ( addr -- ) 26 BDOS DROP ; : NAME. ( -- ) CR CR ." File Name = " FCB DUP C@ ?DUP IF A-1 + EMIT ." :" THEN 1+ DUP 8 -TRAILING TYPE ." ." 8 + 3 -TRAILING TYPE CR CR ; \ SEND ADDR. LINE. SEND NULLS LEADER TRAILER 19jan83mcs VARIABLE CHECK VARIABLE TARGET 0 CONSTANT NULL 2 CONSTANT CTLB 3 CONSTANT CTLC : ####. ( n -- ) 0 <# # # # # #> TYPE ; : SUM-CHECK ( -- ) CR CR ." $S" CHECK @ ####. ." ," ; : ADDR. ( -- ) CR CR TARGET @ ." $A" ####. ." ," CR ; : LINE. ( addr -- ) CR 16 RANGE DO I C@ DUP CHECK +! ##. LOOP ; : SEND ( -- ) PON BUFFER ADDR. 128 RANGE DO I LINE. 16 +LOOP 128 TARGET +! POFF ASCII * EMIT ; : NULLS ( -- ) 16 0 DO NULL EMIT LOOP ; : LEADER ( -- ) PON NULLS CTLB EMIT POFF ; : TRAILER ( -- ) PON CR CR SUM-CHECK CTLC EMIT NULLS POFF ; \ DNLD 19jan83mcs: DNLD ( -- ) HEX CR CR ." DOWN LOAD - Data File To Programmer - Rev 1.1" CR CR ." DATA I/O MODEL 19 ON MORROW SWITCHBOARD" CR CR ." SELECT 50 ENTER ( ASCII HEX SPACE )" CR ." SELECT D1 ENTER START ( PORT TO RAM )" NAME. OPEN CPM-ERR? ABORT" File Open Error" 0 CHECK ! 0 TARGET ! LEADER BEGIN BUFFER SET-DMA READ-SEQ NOT WHILE SEND REPEAT TRAILER CR CR TARGET @ 5 U.R ." h = Bytes Transferred" CR CR CHECK @ 5 U.R ." h = Check Sum" CR CR ; : DONE ( -- ) POFF CR CR 3 EXECUTE ; \ COLD for RAM system TASK 19jan83mcsHEX : +ORIGON ( N -- N ) 100 + ; : COLD 12 +ORIGIN 22 +ORIGON @ 6 + 10 CMOVE INIT-VEC SP! ['] DONE IS QUIT ['] NOOP IS WHERE HEX DNLD DONE ; \ FIRST USE ! FIRST PREV ! \ 0C +ORIGIN @ ['] FORTH ! 0 OFFSET ! EMPTY-BUFFERS \ ['] (WARN) IS WARN ['] NOOP IS WHERE \ DEFAULT-FILE \ FORTH DEFINITIONS DECIMAL \ ['] (QUIT) IS QUIT NOOP QUIT ; DECIMAL ' COLD CFA ' TASK 2+ ! BYE \ SIGN-ON 19jan83mcs: SIGN-ON ( -- ) 24 0 DO CR LOOP ." PAL Logic Compiler - Version 3.1" CR CR ." Copyright 1983 by Michael Stolowitz" CR CR ." DATA I/O model 19 on Morrow SWITCHBOARD" CR CR ." JEDEC format output to Data I/O with PLDS" CR CR ." SELECT EB ENTER ( JEDEC )" CR CR ." SELECT D1 ENTER START ( PORT TO RAM )" CR CR ; : (QUIT) 0 BLK ! [COMPILE] [ RP! APPL 3 EXECUTE ; : PATCH ; EXIT : PATCH ( -- ) " DATA BLK" ['] DEFAULT 3 + SWAP CMOVE ; EXIT ( CHANGES TO DATAIO ) ;S 1. CHANGE BYE TO CALL LOCATION ADDRESS 1 INDIRECT WHICH WILL RESULT IN A COLD BOOT. 2. IF THE PROGRAMMER WILL NOT THROTTLE ON CTS, LOWER ITS BUAD RATE TO 4800 AND MODIFY THE CODE. 3. PROVIDE AN ESCAPE TO FORTH ? 4. PROVIDE AN UP-LOAD CAPABILITY ? ( DATAIO - EQUATES MCS 81SEP03 ) HEX 02 CONSTANT DATA ( INTERFACER I/O PORTS ) 03 CONSTANT STAT 80 CONSTANT RTS ( REQUEST TO SEND ) 2 CONSTANT DAV ( DATA AVAILABLE ) 1 CONSTANT TBE ( TRANSMIT BUFFER EMPTY ) : CTS 0 STAT P! ; ( ASSERT CLEAR TO SEND ) : -CTS 8 STAT P! ; ( NEGATE CLEAR TO SEND ) ( DATAIO - DATAIN PUT DATAOUT DATAIO MCS 81SEP03 ) : DATAIN CTS STAT P@ DAV AND IF DATA P@ EMIT ( -CTS ) ENDIF ; : PUT ( C -- ) BEGIN STAT P@ [ RTS TBE AND ] LITERAL AND 1 = UNTIL DATA P! ; : DATAOUT ( -- F ) 0 ?TERMINAL IF KEY DUP CHR X - IF ( NOT BREAK ) PUT ELSE DROP 1+ ENDIF ENDIF ; : DATAIO BEGIN DATAIN DATAOUT UNTIL ; ( DATAIO - EQUATES MCS 81SEP03 ) HEX 02 CONSTANT DATA ( INTERFACER I/O PORTS ) 03 CONSTANT STAT 80 CONSTANT RTS ( REQUEST TO SEND ) 2 CONSTANT DAV ( DATA AVAILABLE ) 1 CONSTANT TBE ( TRANSMIT BUFFER EMPTY ) : CTS 0 STAT P! ; ( ASSERT CLEAR TO SEND ) : -CTS 8 STAT P! ; ( NEGATE CLEAR TO SEND ) --> ( DATAIO - DATA STAT PUT MCS 81SEP03 ) : DATAIN CTS STAT P@ DAV AND IF DATA P@ EMIT ( -CTS ) ENDIF ; : PUT ( C -- ) ( WAIT FOR RTS AND TBE, THEN SEND ) BEGIN STAT P@ 81 AND 1 = UNTIL DATA P! 1 MSEC ; : KPUT PUT 10 0 DO DATAIN LOOP ; --> ( DATAIO 0 $PUT (DIO" DIO" CRP MCS 81SEP03 ) : (DIO") R COUNT DUP 1+ R> + >R RANGE DO I C@ KPUT LOOP CTL M KPUT ; : DIO" ?COMP COMPILE (DIO") CHR " WORD HERE C@ 1+ ALLOT ; IMMEDIATE : SET-FORMAT DIO" FM50" ; : SEND-DI DIO" DI" ; --> ( DATAIO - HEX-NIB HEX-BYTE CHECK-SUM MCS 81SEP03 )0 VARIABLE CHECK : HEX-NIB ( C -- N ) DUP A < IF CHR 0 ELSE A - CHR A ENDIF + ; : HEX-BYTE ( C -- ) DUP CHECK +! 10 /MOD HEX-NIB PUT HEX-NIB PUT ; : CHECK-SUM CHR $ PUT CHR S PUT CHECK @ 0 100 M/ HEX-BYTE HEX-BYTE CHR , PUT ; --> ( DATAIO - DATAIN PUT DATAOUT DATAIO MCS 81SEP03 ) : DATAOUT ( -- F ) 0 ?TERMINAL IF KEY DUP CHR X - IF ( NOT BREAK ) PUT ELSE DROP 1+ ENDIF ENDIF ; : DATAIO BEGIN DATAIN DATAOUT UNTIL ; --> ( DATAIO - BUF FCB READ-FILE MCS 81SEP21 ) 80 CONSTANT BUF 5C CONSTANT FCB : HEX-FILE SET-FORMAT SEND-DI CTL B PUT 0 DO ( FOR EACH RECORD ) FCB 14 BDOS DISK-ERROR @ IF ( READ A RECORD ) ." DISK READ ERROR" CR BYE ENDIF ( CHECK READ ) BUF 80 RANGE DO I C@ HEX-BYTE BL PUT LOOP ( SEND DATA ) LOOP CTL C PUT CHECK-SUM ( SEND CHECK ) 11 0 DO BL KPUT LOOP ; ( SEND 16 BLANKS ) --> ( DATAIO - BUF FCB READ-FILE MCS 81SEP21 ) 20 CONSTANT MAXSEC : LOAD-FILE FCB F BDOS DISK-ERROR @ FF = IF ( OPEN THE FILE ) ." FILE OPEN ERROR" CR BYE ENDIF ( CHECK OPEN ) FCB 23 BDOS FCB 21 + @ MAXSEC MIN ( GET SIZE ) BUF 1A BDOS ( SET DMA ADDRESS ) HEX-FILE ( SEND DATA ) FCB 10 BDOS ; ( CLOSE THE FILE ) --> ( PROG - SIGN-ON MCS 81SEP20 ) : HEAD E 0 DO CR LOOP ." DATA I/O SYSTEM 17 - SOFTWARE DRIVER PROGRAM" CR CR ." Copyright 1981 by Michael Stolowitz Rev 0.0" CR ." - Compu-Pro INTERFACER ports 2 & 3" CR ." - CTS is required for 9600 buad" CR CR ." Call program with data file name :" CR ." A>PROG " CR CR ." X to exit to CP/M" CR CR ; --> ( DATAIO - ?FILE ABORT MCS 81SEP21 ) : ?FILE ( -- F ) FCB 1+ C@ BL - ; ' ABORT ( ADDRESS OF OLD DEF ) : ABORT ( R> DROP ) ( BECAUSE A PATCH ) SP! DECIMAL ?STACK CR [COMPILE] FORTH DEFINITIONS HEAD ?FILE IF LOAD-FILE ENDIF DATAIO BYE ; ' ABORT CFA SWAP ! ( INSTALL ADDRESS OF NEW DEF ) 1 ' BYE ! ( USE 1 IN MEMORY AS A CFA - COLD BOOT ) DECIMAL