|
|
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 - metrics - download
Length: 6930 (0x1b12)
Types: TextFile
Names: »LSCP.S«
└─⟦ffe699cee⟧ Bits:30005101 8" CR80 Floppy CR80FD_0060 ( VOL: SCC.V NSC Directories: EVR.D OCP.D SCCINIT.D )
└─⟦9c1658a4c⟧
└─⟦this⟧ »OCP.D!LSCP.S«
MAINMODULE LSCP;
LABEL TERM;
LABEL OUT1;
CONST
ELS_CMD = #0000;
ELS_RANGE = #0001;
ELS_THRES = #0002;
ELS_LENGTH = #0003;
ELS_READ = #0004;
ELS_RMTCB = #0005;
ELS_VDUIO = #0006;
ELS_INSMTCB = #0007;
ELS_INSQE = #0008;
MDST = 0;
CCOK = 0;
CCEE = 1;
%NOLIST
%SOURCE @**GENS.D*SWELLPREFIX.D*GENERALPARAMS.S
%SOURCE @**GENS.D*SWELLPREFIX.D*MONITORNAMES.S
%SOURCE @**GENS.D*SWELLPREFIX.D*IOSPARAMS.S
%SOURCE @**SCCNAMES.D*QACCESS_TYPES.S
%SOURCE @**SCCNAMES.D*SCC_MON.N
%SOURCE @**SCCNAMES.D*SCCNAME.N
%SOURCE @**SCCNAMES.D*SCCDATA.N
%SOURCE @**SCCNAMES.D*SCCHEAD.N
%SOURCE @**SCCNAMES.D*SCCREC.N
%SOURCE @**NSCNAMES.D*NSC.N
%SOURCE @**SCCNAMES.D*SCCMTCB.N
IMPORT PROCEDURE READ_MTCB(R0; R4; R6);
IMPORT PROCEDURE INSERT_MTCB(R0; R4; R6);
IMPORT PROCEDURE INSERT_QE(R0; R1; R2; R6);
%LIST
TYPE
QIOCB =
RECORD
W1,W2,W3,W4,W5 : INTEGER;
S0,S1,S2,S3,S4 : INTEGER;
S5,S6,S7 : INTEGER;
END;
VDUCB =
RECORD
IO_TY : INTEGER;
CMD_EV : INTEGER;
CHAR_POS : INTEGER;
LINE_POS : INTEGER;
OUT_CNT : INTEGER;
OUT_BUF_ADDR : INTEGER;
END;
VAR
MSG : ARRAY[0..4] OF INTEGER;
LSCC_CTL_CMD : LSCC_CTL_PMX;
QBLOCK : QIOCB;
DTG_AREA : ARRAY[0..12] OF INTEGER;
MTCBX : INTEGER;
MEVENT : INTEGER;
M_BLOCK : REAL;
QLENGTH : INTEGER;
MSG_BUF : ARRAY[0..11] OF INTEGER;
VCB : VDUCB;
NAR_BUF : INTEGER;
CTL_BUF : ARRAY[0..3] OF INTEGER;
MTCB_BUF : ARRAY[0..3] OF INTEGER;
CONST
VDUIOO = 0;
BEGIN
MON(WAITEVENT, ADDRESS(MSG)=>R1, BMMESSAGE=>R2, R7);
R2 => MEVENT;
R1@INTEGER => R0 => R2;
R0 EXTRACT 8;
IF R0 <> MDST THEN
BEGIN
ELS_CMD => R0;
GOTO TERM;
END;
MSG[2] => R0;
IF R0 = MSG[3] THEN
GOTO OUT1
ELSE BEGIN
R0 => R1;
R0 EXTRACT 8;
R1 SHIFTRL 8;
IF R0 < MSG[3] LOGOR (R1-1) >= MSG[3] THEN
BEGIN
ELS_RANGE => R0;
GOTO TERM;
END;
END;
OUT1 :
R2 SHIFTRL 8;
ADDRESS(LSCC_CTL_CMD) => R4;
TYCE => R1=> R4@STD_OP_C_PMX.HEAD.MTY;
CLC => R1 => R4@STD_OP_C_PMX.HEAD.SCA;
ADDRESS(QBLOCK) => R5;
CASE MSG[1]=>R1 OF
0: BEGIN
'IQ' => R0;
' ' => R3;
END;
1: BEGIN
'LO' => R0;
'G ' => R3;
END;
2: BEGIN
'RE' => R0;
'P ' => R3;
END;
3: BEGIN
'AU' => R0;
'X ' => R3;
END;
31: BEGIN
IF MSG[2]=>R1 = #0006 THEN
BEGIN
'MD' => R0;
'Q ' => R3;
END
ELSE BEGIN
IF R1 = #0707 THEN
'NM' => R0
ELSE 'NC' => R0;
' ' => R3;
END;
END;
32: BEGIN
'TQ' => R0;
' ' => R3;
END;
33: BEGIN
'CT' => R0;
'R ' => R3;
END;
34: BEGIN
IF MSG[2]=>R1 = #0000 THEN
'EV' => R0
ELSE 'OU' => R0;
' ' => R3;
END;
35: BEGIN
'CQ' => R0;
' ' => R0;
END;
36: BEGIN
'IC' => R0;
' ' => R3;
END;
37: BEGIN
'TC' => R0;
'NT' => R3;
END;
38: BEGIN
'NT' => R0;
' ' => R3;
END;
39: BEGIN
IF MSG[2]=>R1 = #0000 THEN
BEGIN
'MC' => R0;
' ' => R3;
END
ELSE BEGIN
'IL' => R0;
'Q ' => R3;
END;
END;
40: BEGIN
'CM' => R0;
'Q ' => R3;
END;
41: BEGIN
'NS' => R0;
' ' => R3;
END;
END; "CASE
R0 => R4@LSCC_CTL_PMX.Q_ID.MOST;
R3 => R4@LSCC_CTL_PMX.Q_ID.LEAST;
CASE R2 OF
0: BEGIN
LCCT => R1 => R4@LSCC_CTL_PMX.HEAD.MCC;
MSG[4] => R1 => R4@LSCC_CTL_PMX.PAR;
MSG[1] => R1 => R5@QIOCB.W1;
MSG[3] => R1 => R5@QIOCB.W2;
MSG[4] => R1 => R5@QIOCB.W3;
SWITCH MON(QACCESS, SET_THRESH, ADDRESS(QBLOCK)=>R0, 1=>R1, R7):ERROR_DONE TO
ERR : BEGIN
ELS_THRES => R0;
GOTO TERM;
END;
END; "SWITCH
END;
1: BEGIN
LCDQ => R1 => R4@LSCC_CTL_PMX.HEAD.MCC;
MSG[1] => R1 => R5@QIOCB.W1;
MSG[3] => R1 => R5@QIOCB.W2;
SWITCH MON(QACCESS, LENGTH, ADDRESS(QBLOCK)=>R0, R1, R7):ERROR_DONE TO
ERR : BEGIN
ELS_LENGTH => R0;
GOTO TERM;
END;
END; "SWITCH
R5@QIOCB.W1 => R1 + 1 => QLENGTH;
1 => R2;
ADDRESS(VCB) => R5;
REPEAT
R2 => R4@QIOCB.W3;
SWITCH MON(QACCESS, READ_NON, ADDRESS(QBLOCK)=>R0, R1, R7):ERROR_DONE TO
ERR : BEGIN
ELS_READ => R0;
GOTO TERM;
END;
END; "SWITCH
R0@INTEGER => R0;
SWITCH READ_MTCB(R0, ADDRESS(MSG_BUF)=>R4, R6):ERROR_DONE TO
ERR : BEGIN
ELS_RMTCB => R0;
GOTO TERM;
END;
END; "SWITCH
IF MSG_BUF[1]=> R0 = 0 THEN
BEGIN
MSG_BUF[16] => R1;
R1@INTEGER => R0 => NAR_BUF;
ADDRESS(NAR_BUF) =>R0 => R5@VDUCB.OUT_BUF_ADDR;
1 => R0 => R5@VDUCB.OUT_CNT;
END
ELSE IF R0 = 1 THEN
BEGIN
MSG_BUF[3] => R1 => CTL_BUF[0];
MSG_BUF[8] => R1 => CTL_BUF[1];
MSG_BUF[9] => R1 => CTL_BUF[2];
MSG_BUF[10] => R1 => CTL_BUF[3];
ADDRESS(CTL_BUF) => R0 => R5@VDUCB.OUT_BUF_ADDR;
4 => R0 => R5@VDUCB.OUT_CNT;
END
ELSE BEGIN
MSG_BUF[0] => R1 => MTCB_BUF[0];
MSG_BUF[1] => R1 => MTCB_BUF[1];
MSG_BUF[2] => R1 => MTCB_BUF[2];
MSG_BUF[3] => R1 => MTCB_BUF[3];
ADDRESS(MTCB_BUF) => R0 => R5@VDUCB.OUT_BUF_ADDR;
4 => R0 => R5@VDUCB.OUT_CNT;
END;
MEVENT => R1 => R5@VDUCB.CMD_EV;
0 => R1 => R5@VDUCB.CHAR_POS;
VDUIOO => R1 => R5@VDUCB.IO_TY;
R2 => R5@VDUCB.LINE_POS;
"SWITCH VDUIO( ADDRESS(VCB)=> R4, R6):ERROR_DONE TO
" ERR : BEGIN
" ELS_VDUIO => R0;
" GOTO TERM;
" END;
"END;
UNTIL (R2+1) = QLENGTH;
END;
END; "CASE
MON(GETDTG, ADDRESS(DTG_AREA) => R5, R7);
DTG_AREA[11] => R1 => R4@LSCC_CTL_PMX.LOG_DTG.LEAST;
DTG_AREA[12] => R1 => R4@LSCC_CTL_PMX.LOG_DTG.MOST;
"CREATE EVENT PSUDO MTCB AND INSERT IT INTO 'EV' QUEUE
SWITCH INSERT_MTCB(R0, R4, R6): ERROR_DONE TO
ERR : BEGIN
ELS_INSMTCB => R0;
GOTO TERM;
END;
END; "SWITCH
R0=>R2;
SWITCH INSERT_QE(34=>R0, 0=>R1, R2, R6):ERROR_DONE TO
ERR : BEGIN
ELS_INSQE => R0;
GOTO TERM;
END;
END; "SWITCH
0 => R0;
TERM :
IF R0 = 0 THEN
CCOK => R2 => MSG[1]
ELSE CCEE =>R2 => MSG[1];
MON(SENDANSWER, ADDRESS(MSG)=>R1, MEVENT=>R2, R7);
MON(TERMINATE, R0 , R1, R7);
END
ENDMODULE