DataMuseum.dk

Presents historical artifacts from the history of:

CR80 Hard and Floppy Disks

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CR80 Hard and Floppy Disks

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦fc2732805⟧ TextFile

    Length: 6930 (0x1b12)
    Types: TextFile
    Names: »LSCP.S«

Derivation

└─⟦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«

TextFile

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