|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 9388 (0x24ac)
Types: TextFile
Names: »CONSOLE.S«
└─⟦17728abc9⟧ Bits:30005143 8" CR80 Floppy CR80FD_0130 ( CR/D/1422 FLERCPU Source )
└─⟦1815caf3d⟧
└─ ⟦this⟧ »CONSOLE.S«
CONST "***** GENERAL STATUS CONSTANTS *****"
BUSY = 15;
"***** MAP INSTRUCTIONS FOR AV24 I/O PORT *****"
WRITE_BLOCKSIZE = #89D3;
WRITE_TIME = #89D4;
WRITE_STOPCHAR = #89D5;
WRITE_MODE = #89D6;
READ_INPUT_STATUS = #89D0;
WRITE_INPUT_COMMAND= READ_INPUT_STATUS;
READ_ISIZE = #89D1;
READ_ISTART = #89D2;
READ_INPUT_DATA = #8C00;
READ_OUTPUT_STATUS = #89D8;
WRITE_OUTPUT_COMMAND = READ_OUTPUT_STATUS;
WRITE_OSIZE = #89D9;
WRITE_OSTART = #89DA;
WRITE_OUTPUT_DATA = #8E00;
"****** OC INTERFACE ******"
BLOCKSIZE = 511;
STOPCHAR = 13;
TIME = 0 ; "NO TIMEOUT WILL OCCUR
AUTO_ECHO_MODE = 1; "ON
"****** CONDITIONAL COMPILATION *****"
NRSIGN = FALSE;
VAR
HEXCH : ARRAY [0..15] OF CHAR ; "ASCII CHARACTERS FOR"
"HEX. INTEGERS "
VAR
CH_COUNT : INTEGER; "POINTER TO CURRENT CHARACTER
CH_COUNT1: INTEGER;
LOC_COUNT,LOC_COUNT1: INTEGER;
OUTBUF, INBUF : INTEGER;
LAST_IN : INTEGER; "LAST INPUT CHARACTER READ
BREAK_JUMP_LOC: INTEGER; "LOC TO BEE JUMPED TO AFTER 'BREAK'
INIT
HEXCH [00..00] = '0';
HEXCH [01..01] = '1';
HEXCH [02..02] = '2';
HEXCH [03..03] = '3';
HEXCH [04..04] = '4';
HEXCH [05..05] = '5';
HEXCH [06..06] = '6';
HEXCH [07..07] = '7';
HEXCH [08..08] = '8';
HEXCH [09..09] = '9';
HEXCH [#A..#A] = 'A';
HEXCH [#B..#B] = 'B';
HEXCH [#C..#C] = 'C';
HEXCH [#D..#D] = 'D';
HEXCH [#E..#E] = 'E';
HEXCH [#F..#F] = 'F';
CH_COUNT = 0;
CH_COUNT1 = BLOCKSIZE + 1; "FORCES READING OF FIRST BUFFER
LAST_IN = STOPCHAR ; " DITTO
LOC_COUNT = 0;
LOC_COUNT1= 0;
OUTBUF = 0;
INBUF = 0;
"PAGE«ff»
EXPORT PROCEDURE INIT_OC
"======================"
(R7; " C BREAK JUMP LOCATION
R6); "LINK"
VAR S7, LINK: INTEGER;
BEGIN
R6 => LINK;
R7 => BREAK_JUMP_LOC;
CIO(BLOCKSIZE=>R7, WRITE_BLOCKSIZE=>R6);
CIO(TIME =>R7, WRITE_TIME =>R6);
CIO(STOPCHAR =>R7, WRITE_STOPCHAR=>R6);
CIO(AUTO_ECHO_MODE =>R7, WRITE_MODE=>R6);
BREAK_JUMP_LOC => R7;
EXIT(LINK);
END; "INIT_IF"
"PAGE«ff»
FORWARD PROCEDURE OUTTEXT(R3;R6);
EXPORT
PROCEDURE FLUSHOUT (R6);
CONST
TRANSMIT_DATA = #8000;
OUTPUT_BUFFER_EMPTY = 8;
VAR
LINK,S7: INTEGER;
BEGIN
R6=>LINK;
R7=>S7;
CH_COUNT=>R6;
IF R6 EXTRACT 1 <> 0
THEN BEGIN
WRITE_OUTPUT_DATA=>R7 IOR (LOC_COUNT=>R6);
CIO(OUTBUF=>R6, R7);
END;
CIO(0=>R6, WRITE_OSTART=>R7);
CIO(CH_COUNT=>R6, WRITE_OSIZE=>R7);
0=>R6;
R6=>CH_COUNT; R6=>LOC_COUNT; R6=>OUTBUF;
CIO(TRANSMIT_DATA=>R6, WRITE_OUTPUT_COMMAND=>R7);
REPEAT
SIO(R6, READ_OUTPUT_STATUS=>R7);
UNTIL NOT R6[BUSY];
S7=>R7;
EXIT(LINK);
END;
"PAGE«ff»
EXPORT PROCEDURE OUTCHAR
"======================"
(R3; "CHARACTER
R6); "LINK"
VAR
LINK,S3,S7: INTEGER;
BEGIN
R6=>LINK; R3=>S3; R7=>S7;
CH_COUNT=>R6;
IF R6 EXTRACT 1 <> 0
THEN
BEGIN
OUTBUF=>R7 IOR (R3 SHIFTLL 8);
LOC_COUNT=>R3;
CIO(R7, WRITE_OUTPUT_DATA=>R6 IOR R3);
R3+1=>LOC_COUNT;
0=>R7=>OUTBUF;
END
ELSE
R3=>OUTBUF;
ADDRESS(CH_COUNT)=>R6;
INC(R6@INTEGER);
IF R6@INTEGER >= BLOCKSIZE + 1 THEN FLUSHOUT(R6);
S3=>R3; S7=>R7;
EXIT(LINK);
END; "OUTCHAR"
«ff»
EXPORT PROCEDURE OUTTEXT
"======================"
(R3; "ADDRESS OF TEXT"
R6); "LINK"
"--------------------------------------------------------
" PRINT A STRING OF CHARACTERS
" TERMINATED BY (:0:)
"--------------------------------------------------------
VAR
SAVEREGS: ARRAY [0..7] OF INTEGER;
BEGIN
R7 => SAVEREGS[7];
STC(6,ADDRESS(SAVEREGS[7])=>R7);
R3 => R2;
0=>R4;
REPEAT
OUTCHAR(R2@STRING[R4] => R3, R6);
R4 + 1;
UNTIL R3 = 0;
UNS (7,ADDRESS(SAVEREGS[0])=>R7);
EXIT(R6);
END; "OUTTEXT"
"PAGE«ff»
EXPORT
PROCEDURE CHECKBREAK (R6);
"R3 IS DESTROYED IN CASE OF BREAK OR ERROR
CONST
"BIT NUMBERS"
BREAK = 9;
IOV = 10;
PARITY_ERR = 11;
TIMED_OUT = 13;
VAR
LINK: INTEGER;
BEGIN
R6=>LINK;
SIO(R6, READ_INPUT_STATUS=>R6);
IF NOT R6[BUSY] THEN
BEGIN
IF R6[BREAK] THEN
BEGIN
OUTTEXT(ADDRESS(' *BREAK(:0:)')=>R3,R6);
EXIT(BREAK_JUMP_LOC);
END;
IF R6[IOV] THEN
BEGIN
OUTTEXT(ADDRESS(' *OVERFLOW IN BUF(:0:)')=>R3,R6);
EXIT(BREAK_JUMP_LOC);
END;
IF R6[PARITY_ERR] THEN
BEGIN
OUTTEXT(ADDRESS(' *PAR ERR IN BUF(:0:)')=>R3,R6);
EXIT(BREAK_JUMP_LOC);
END;
IF R6[TIMED_OUT] THEN
BEGIN
OUTTEXT(ADDRESS(' *TIMED OUT(:0:)')=>R3,R6);
EXIT(BREAK_JUMP_LOC);
END;
END;
EXIT(LINK);
END;
"PAGE«ff»
EXPORT PROCEDURE OUTNEWLINE
"========================="
(R6); "LINK"
"--------------------------------------------------------
" PRINT A CR CHARACTER ON THE CONSOLE
" THEN ISSUE 8 FILLER CHARACTERS ( NULLS) TO GIVE THE CARRIAGE
" TIME TO RETURN BEFORE THE NL (LINE FEED) CHARACTER IS ISSUED.
"--------------------------------------------------------
VAR S2, S3, S6 : INTEGER;
BEGIN
R2 => S2; R3 => S3; R6 => S6;
OUTCHAR(CR => R3, R6);
0 => R2;
NULL => R3;
REPEAT
OUTCHAR( R3, R6);
UNTIL ( R2 + 1) = 8;
OUTCHAR( NL => R3, R6);
FLUSHOUT(R6);
S2 => R2;
S3 => R3;
EXIT(S6);
END; "OUTNEWLINE"
"PAGE«ff»
EXPORT PROCEDURE OUTHEX
"====================="
(R3; "INTEGER TO BE PRINTED"
R6); "LINK"
"--------------------------------------------------------
" OUTPUT AN INTEGER IN ITS HEX.
" REPRESENTATION PRECEDED WITH A BLANK OR SHARP
"--------------------------------------------------------
VAR
SAVEREGS: ARRAY [0..7] OF INTEGER;
BEGIN
R7 => SAVEREGS[7];
STC(6,ADDRESS(SAVEREGS[7])=>R7);
%WHEN NRSIGN = FALSE SKIP
OUTCHAR('#'=>R3, R6);
%COMPILE
%WHEN NRSIGN = TRUE SKIP
OUTCHAR(SP=>R3, R6);
%COMPILE
SAVEREGS[3]=>R4;
0 => R5;
REPEAT
R4 SHIFTLC 4;
R4=>R6 EXTRACT 4;
OUTCHAR(HEXCH[R6]=>R3, R6);
UNTIL R5+1 = 4;
CHECKBREAK(R6);
UNS (7,ADDRESS(SAVEREGS[0])=>R7);
EXIT(R6);
END; "OUTHEXA"
"PAGE«ff»
EXPORT PROCEDURE OUTINT
"====================="
(R3; "INTEGER TO BE PRINTED"
R6); "LINK"
"--------------------------------------------------------
" OUTPUT AN INTEGER IN ITS DECIMAL
" REPRESENTATION (UNSIGNED AND WITH LEADING ZEROES SUPPRESSED)
" THIS ROUTINE DON'T USE DIVIDE INSTRUCTION !!.
"--------------------------------------------------------
VAR
SAVEREGS: ARRAY[ 0..7] OF INTEGER;
EXP_OF_TEN: ARRAY[ 1..4] OF INTEGER;
LINE: ARRAY [0..4] OF CHAR;
INIT
EXP_OF_TEN = 10, 100, 1000, 10000;
BEGIN
R7 => SAVEREGS[7];
STC(6,ADDRESS(SAVEREGS[7])=>R7);
4 => R4;
REPEAT
EXP_OF_TEN[ R4] => R1;
0 => R0;
0 => R2;
WHILE R3 >= ( R2 + R1) DO R0 + 1;
R2 - R1;
R3 - R2;
R0 + '0' => LINE[ R4];
UNTIL ( R4 - 1) = 0;
R3 + '0' => LINE[ R4];
TRUE => R0;
4 => R4;
REPEAT
LINE[ R4] => R3;
IF R0 = TRUE LOGAND R4 >= 1 LOGAND R3 = '0'
THEN SP => R3
ELSE FALSE => R0;
OUTCHAR( R3, R6);
UNTIL ( R4 - 1) < 0;
UNS (7,ADDRESS(SAVEREGS[0])=>R7);
EXIT(R6);
END; "OUT INTEGER"
"PAGE«ff»
EXPORT PROCEDURE IN_BYTE
"======================"
(R3; "CHARACTER VALUE (RETURN)"
R6); "LINK"
CONST
CLEAR_INPUT_BUFFER = #8001;
GET_DATA = #8000;
IBR = 8;
VAR
SAVE: ARRAY [0..7] OF INTEGER;
BEGIN
R7=>SAVE[7]; STC(6, ADDRESS(SAVE[7])=>R7);
CH_COUNT1=>R0; LOC_COUNT1=>R1;
IF R0 >= BLOCKSIZE+1 LOGOR LAST_IN=>R6 = STOPCHAR THEN
BEGIN
CIO(CLEAR_INPUT_BUFFER=>R7, WRITE_INPUT_COMMAND=>R6);
REPEAT
SIO(R7, READ_INPUT_STATUS=>R6);
UNTIL NOT R7[BUSY];
0=>R0; 0=>R1;
CIO(GET_DATA=>R7, WRITE_INPUT_COMMAND=>R6);
REPEAT
CHECKBREAK(R6);
SIO(R7, READ_INPUT_STATUS=>R6);
UNTIL NOT R7[BUSY];
END "NEW BUFFER";
IF R0=>R6 EXTRACT 1 = 0
THEN
BEGIN
SIO(R3, READ_INPUT_DATA=>R6 IOR R1);
R3=>INBUF;
R3 EXTRACT 7;
R1+1=>LOC_COUNT1;
END
ELSE
INBUF=>R3 SHIFTRL 8;
R3=>LAST_IN;
R3=>SAVE[3];
R0+1=>CH_COUNT1;
UNS(7,ADDRESS(SAVE[0])=>R7);
EXIT(R6);
END; "IN_BYTE"
"page«ff»
type charclass = (alfa, numeric, delimiter);
export
procedure getchar (r0; "char
r7; "charclass
r6); "link
var
s3,link: integer;
begin
r6=>link; r3=>s3;
in_byte (r3, r6); r3=>r0;
if r3 >= 'A'
then alfa=>r7
else
if r3 >= '0' logand r3 <'9'+1
then numeric=>r7
else delimiter=>r7;
s3=>r3;
exit(link);
end;
export
procedure inhexa (r3; "hexa
r0; "delimiter
r6); "link
var
s7,link: integer;
begin
r6=>link;
r7=>s7;
getchar (r0, r7, r6);
0=>r3;
while r7 < delimiter logand r0 < 'G' do
begin
if r7 = numeric then r0-'0' else r0-('A'-10);
r3 shiftll 4 + r0;
getchar (r0, r7, r6);
end;
s7=>r7;
exit(link);
end;
«a5»