MAC2
          IDENT  SSIR 
          TITLE  SSIR - SPECIAL SYSTEM INTERFACE ROUTINES.
*COMMENT   SPECIAL SYSTEM INTERFACE ROUTINES. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
*****     SSIR - SPECIAL SYSTEM INTERFACE ROUTINES. 
* 
*         R. R. SEKHON       78/12/15.
          SPACE  4
*****            *SSIR* IS A COLLECTION OF RELOCATABLE MODULES
*         THAT PROVIDE THE INTERFACE BETWEEN *SYMPL* ROUTINES 
*         AND THE SPECIAL SYSTEM INTERFACE ROUTINES.
* 
*         THE CALLING ROUTINE SHOULD HAVE SSJ= ENTRY POINT IN 
*         ORDER TO CALL THESE SPECIAL SYSTEM INTERFACE ROUTINES.
*         THE *SYMPL* CALLING SEQUENCE IS SHOWN IN EACH MODULE
*         ALONG WITH THE OTHER PERTINENT INFORMATION E.G ENTRY, 
*         EXIT, *SYMPL* DATA TYPES NEEDED ETC.. 
          SPACE  4
*****            *SSIR* MODULES TRANSLATE PARAMETERS IN *SYMPL* 
*         CALL TO A FORMAT USABLE BY *COMPASS* CODE.
* 
*         ENTRY  *SYMPL* CALL USES THE ACTUAL PARAMETER LIST, CALL
*                BY REFERENCE CALLING SEQUENCE WHERE
*                 (A1)      = FWA OF PARAMETER ADDRESS LIST.
*                ((A1))     = FIRST PARAMETER.
*                ((A1+1))   = SECOND PARAMETER. 
*                  .          . 
*                  .          . 
*                  .          . 
*                ((A1+N-1)) = N-TH PARAMETER. 
*                ((A1+N))   = 0 (ZERO) (NOMINALLY)
*                 (X1)      = FIRST PARAMETER.
* 
*         NEEDS  THESE MODULES NEED COMCMAC, COMCCMD AND THE
*                COMMON DECKS DEFINED IN *NOSTEXT*. 
* 
*         NOTE   B1 IS SET TO ONE UPON ENTRY TO EACH MODULE.
* 
*         OTHER  *SSIR* IS A COLLECTION OF RELOCATABLE MODULES
*                COMBINED INTO ONE *MODIFY* DECK NAMED *SSIR*.
  
          SPACE  4,10 
*****     DAYFILE MESSAGES. 
* 
*         * RDPFC - ERROR IDLE, DN XX.* - *RDPFC* 
*         SKIPPED DEVICE X ON ACCOUNT OF ERROR
*         IDLE SET ON IT. 
* 
*         * RDPFC - PF UTILITY ACTIVE, DN XX.* - *RDPFC*
*         SKIPPED DEVICE X ON ACCOUNT OF PF UTILITY 
*         ACTIVE ON THE DEVICE. 
  
          END 
          IDENT  PFMAC
          ENTRY  ASIGNPF
          ENTRY  CKPFETC
          ENTRY  CLEARAF
          ENTRY  DROPDS 
          ENTRY  DROPIDS
          ENTRY  SETAF
          ENTRY  SETASA 
          ENTRY  SETDA
          ENTRY  UATTACH
          ENTRY  UGET 
          ENTRY  UREPLAC
          SYSCOM B1 
          TITLE  SPECIAL PFM MACROS.
*COMMENT   SPECIAL PFM MACROS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
*CALL COMCCMD 
          SPACE  4,40 
***       PFMAC - SPECIAL *PFM* MACROS. 
* 
*         ENTRY  (AF)   = ALTERNATE STORAGE FLAG. 
*                (AL)   = ACCESS LEVEL FOR FILE.
*                (ASA)  = ALTERNATE STORAGE ADDRESS.
*                         18/0,6/AT,36/AA 
*                         AT = ALTERNATE STORAGE TYPE.
*                         AA = ALTERNATE STORAGE ADDRESS. 
*                (CDT)  = CREATION DATE AND TIME. 
*                (EMA)  = ERROR MESSAGE RETURN ADDRESS. 
*                (FL)   = FILE LENGTH BEING REQUESTED.
*                (FM)   = FAMILY NAME.
*                (LFN)  = LOCAL FILE NAME, LEFT JUSTIFIED, ZERO 
*                         FILLED, SEVEN CHARACTERS MAXIMUM. 
*                (M)    = ACCESS MODE.
*                         = 0, READ/WRITE.
*                         = 1, READ.
*                         = 2, APPEND.
*                         = 3, EXECUTE. 
*                         = 4, NONE.
*                         = 5, MODIFY.
*                         = 6, READ AND ALLOW MODIFY. 
*                         = 7, READ AND ALLOW APPEND. 
*                         = 8, UPDATE.
*                         = 9, READ AND ALLOW UPDATE. 
* 
*                (PFC)  = 16 WORD BUFFER FOR THE CATALOG IMAGE. 
*                (PFID) = PERMANENT FILE CATALOG INDEX. 
*                         28/0,2/PEO,6/DN,12/TRACK,12/SECTOR
*                         PEO = PFC ORDINAL.
*                         DN = DEVICE NUMBER. 
*                         TRACK = TRACK NUMBER WHERE PFC RESIDES. 
*                         SECTOR = SECTOR ORDINAL.
*                (PFN)  = PERMANENT FILE NAME, SAME CHARACTERISTICS 
*                         AS *LFN*. 
*                (RP)   = RETURN PROCESSING.
*                         = 1, REAL TIME PROCESSING.
*                         = 2, STANDARD ERROR PROCESSING ONLY.
*                         = 3, STANDARD AND REAL TIME PROCESSING. 
*                         = 4, USER PROCESSING. 
*                         = 6, FULL ERROR PROCESSING OPTIONS. 
*                (STAT) = *PFM* RETURN STATUS.
*                (UI)   = USER INDEX. 
          SPACE  4,15 
**        INIT - INTIALIZE *PFM* FET. 
* 
*         ENTRY  (A1) = FWA OF PARAMETER ADDRESS LIST.
*                (X2) = RETURN JUMP TO THE MACRO INTERFACE
*                       CALLING ROUTINE.
*                (B2) = ERROR MESSAGE RETURN ADDRESS. 
* 
*         EXIT   (STATW) = ADDRESS OF RETURN STATUS WORD. 
*                (EXITA) = RETURN JUMP TO THE MACRO INTERFACE 
*                          CALLING ROUTINE. 
*                IF *PFET* COMPLETION BIT IS SET -
*                (PFET)  = INITIALIZED *PFM* FET. 
*                IF *PFET* IS BUSY -
*                (X6) .LT. ZERO (IF *PFET* IS BUSY, USER MAY RETRY).
* 
*         USES   X - 2, 3, 6. 
*                A - 2, 3, 6. 
*                B - 1. 
* 
*         MACROS SETFET.
  
  
 INIT     SUBR               ENTRY/EXIT 
          SB1    1
          SA3    PFET        FWA OF FET 
          BX6    X2          SAVE RETURN ADDRESS FOR MACRO
          SA6    EXITA
          SA2    A1+B1       SAVE ADDRESS OF RETURN STATUS WORD 
          BX6    X2 
          SA6    STATW
          LX3    59-0        CHECK COMPLETION BIT 
          MX6    -1          SET STATUS FOR (*PFET* BUSY, RETRY LATER)
          PL     X3,EXIT1    IF *PFET* BUSY 
          SETFET PFET,(LFN=#A1+B0),(ERP=#A1+2),(ERA=B2),(PFN=INITA) 
          EQ     INITX       RETURN 
  
  
 INITA    CON    0           DEFAULT PFN
          SPACE  4,10 
**        EXIT - COMMON EXIT FOR SPECIAL *PFM* MACROS.
* 
*         ENTRY  (EXITA) = RETURN JUMP TO THE MACRO INTERFACE 
*                          CALLING ROUTINE. 
*                (STATW) = ADDRESS OF RETURN STATUS WORD. 
*                AT *EXIT1*, TO RETURN STATUS SPECIFIED IN (X6).
* 
*         EXIT   (STAT) = ERROR STATUS. 
*                (STAT) .LT. ZERO, IF *PFET* BUSY.
* 
*         USES   A - 1, 2, 6. 
*                X - 0, 1, 2, 6.
* 
*         NOTES  REFER TO *COMSPFM* FOR ERROR STATUS VALUES.
  
  
 EXIT     BSS    0           ENTRY/EXIT 
          SA1    PFET        RETURN ERROR STATUS
          MX0    -8          MASK ERROR CODE
          AX1    10 
          BX6    -X0*X1 
 EXIT1    SA2    STATW       STORE ERROR CODE IN STATUS RETURN WORD 
          SA6    X2 
 EXITA    CON    0
*         EQU    *           SET FOR RETURN FROM MACRO CALLS
 ASIGNPF  SPACE  4,25 
***       ASIGNPF - ASSIGN PERMANENT FILE SPACE.
* 
*         ASIGNPF(LFN,STAT,RP,FL,UI,FM,AL,EMA);  (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS ASSIGNPF.
  
  
 ASIGNPF  SUBR               ENTRY/EXIT 
          SA2    ASIGNPF
          SA3    A1+7        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          ASSIGNPF  PFET,#A1+3,SRB,#A1+4,#A1+5,#A1+6
          EQ     EXIT        RETURN 
 CKPFETC  SPACE  4,25 
***       CKPFETC - CHECK *PFM* FET COMPLETION. 
* 
*         *SYMPL* CALL -
*         CKPFETC(LFN,STAT);
* 
*         EXIT   (STAT) .LT. ZERO IF *PFET* BUSY. 
* 
*         USES   X - 2, 3, 6. 
*                A - 2, 3, 6. 
*                B - 1. 
* 
*         CALLS  EXIT.
  
  
 CKPFETC  SUBR               ENTRY/EXIT 
          SB1    1
          SA2    CKPFETC     SET RETURN ADDRESS 
          BX6    X2 
          SA6    EXITA
          SA2    A1+B1       ADDRESS OF RETURN STATUS WORD
          SA3    PFET 
          BX6    X2 
          LX3    59-0        CHECK COMPLETION BIT 
          SA6    STATW       SAVE ADDRESS OF RETURN STATUS WORD 
          MX6    -1          SET STATUS FOR (*PFET* BUSY, RETRY LATER)
          PL     X3,EXIT1    IF *PFET* BUSY 
          EQ     EXIT        RETURN (WITH STATUS) 
 CLEARAF  SPACE  4,35 
***       CLEARAF - CLEAR ALTERNATE STORAGE FLAGS.
* 
*         CLEARAF(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,AF,EMA); 
*                            (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS CLEARAF. 
  
  
 CLEARAF  SUBR               ENTRY/EXIT 
          SA2    CLEARAF
          SA3    A1+9        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          CLEARAF  PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7,#A1+8 
          EQ     EXIT        RETURN 
 DROPDS   SPACE  4,30 
***       DROPDS - DROP DIRECT ACCESS FILE DISK SPACE.
* 
*         DROPDS(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,EMA);  (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS DROPDS.
  
  
 DROPDS   SUBR               ENTRY/EXIT 
          SA2    DROPDS 
          SA3    A1+8        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          DROPDS PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7 
          EQ     EXIT        RETURN 
 DROPIDS  SPACE  4,20 
***       DROPIDS - DROP INDIRECT ACCESS FILE DISK SPACE. 
* 
*         *SYMPL* CALL -
*         DROPIDS(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,EMA);
* 
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 2. 
* 
*         CALLS  INIT.
* 
*         MACROS DROPIDS. 
  
  
 DROPIDS  SUBR               ENTRY/EXIT 
          SA2    DROPIDS
          SA3    A1+8        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          DROPIDS  PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7 
          EQ     EXIT        RETURN 
 SETAF    SPACE  4,35 
***       SETAF - SET ALTERNATE STORAGE FLAGS.
* 
*         SETAF(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,AF,EMA);  (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS SETAF. 
  
  
 SETAF    SUBR               ENTRY/EXIT 
          SA2    SETAF
          SA3    A1+9        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          SETAF  PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7,#A1+8 
          EQ     EXIT        RETURN 
 SETASA   SPACE  4,30 
***       SETASA - SET ALTERNATE STORAGE ADDRESS IN CATALOG.
* 
*         SETASA(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,EMA);  (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS SETASA.
  
  
 SETASA   SUBR               ENTRY/EXIT 
          SA2    SETASA 
          SA3    A1+8        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          SETASA PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7 
          EQ     EXIT        RETURN 
  
 SETDA    SPACE  4,30 
***       SETDA - SET DISK ADDRESS. 
* 
*         SETDA(LFN,STAT,RP,UI,FM,PFID,ASA,CDT,EMA);  (*SYMPL* CALL)
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS SETDA. 
  
  
 SETDA    SUBR               ENTRY/EXIT 
          SA2    SETDA
          SA3    A1+8        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          SETDA  PFET,SRB,#A1+3,#A1+4,#A1+5,#A1+6,#A1+7 
          EQ     EXIT        RETURN 
 UATTACH  SPACE  4,45 
***       UATTACH - UTILITY ATTACH. 
* 
*         UATTACH(LFN,STAT,RP,PFN,M,UI,FM,PFID,PFC,CDT,EMA);
*                            (*SYMPL* CALL) 
* 
*         USES   A - 2, 3.
*                B - 2. 
*                X - 2, 3.
* 
*         CALLS  INIT, EXIT.
* 
*         MACROS UATTACH. 
  
  
 UATTACH  SUBR               ENTRY/EXIT 
          SA2    UATTACH
          SA3    A1+10       GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          SA2    A1+8        GET ADDRESS OF *PFC* 
          SB2    X2 
          UATTACH  PFET,#A1+3,#A1+4,SRB,#A1+5,#A1+6,#A1+7,B2,#A1+9
          EQ     EXIT        RETURN 
 UGET     SPACE  4,20 
***       UGET - UTILITY GET. 
* 
*         *SYMPL* CALL -
*         UGET(LFN,STAT,RP,PFN,UI,FM,PFID,PFC,CDT,EMA); 
* 
*         EXIT   *UGET* FUNCTION INITIATED. 
*                (FUNCTION IS PERFORMED WITHOUT AUTORECALL).
* 
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 2. 
* 
*         CALLS  INIT.
* 
*         MACROS UGET.
  
  
 UGET     SUBR               ENTRY/EXIT 
          SA2    UGET 
          SA3    A1+9        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          SA2    A1+7        GET ADDRESS OF *PFC* 
          SB2    X2 
          UGET   PFET,#A1+3,SRB,#A1+4,#A1+5,#A1+6,B2,#A1+8
          EQ     UGETX       RETURN 
 UREPLAC  SPACE  4,20 
***       UREPLAC - UTILITY REPLACE.
* 
*         *SYMPL* CALL -
*         UREPLAC(LFN,STAT,RP,PFN,UI,FM,PFID,ASA,CDT,EMA);
* 
*         EXIT   *UREPLACE* FUNCTION INITIATED. 
*                (FUNCTION IS PERFORMED WITHOUT AUTORECALL).
* 
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 2. 
* 
*         CALLS  INIT.
* 
*         MACROS UREPLAC. 
  
  
 UREPLAC  SUBR               ENTRY/EXIT 
          SA2    UREPLAC
          SA3    A1+9        GET ERROR MESSAGE RETURN ADDRESS 
          SA3    X3 
          SB2    X3 
          RJ     INIT        INITIALIZE *PFM* FET 
          UREPLAC  PFET,#A1+3,SRB,#A1+4,#A1+5,#A1+6,#A1+7,#A1+8 
          EQ     UREPLACX    RETURN 
FET       SPACE  4,10 
*         *PFM* FET USED/SHARED BY ALL MACRO INTERFACE ROUTINES.
  
 PFET     FILEB  DMMY,DMYL,(FET=16D)  DUMMY *PFM* FET 
 DMYL     EQU    0           LENGTH OF DUMMY *CIO* BUFFER 
 DMMY     BSS    0
 SRB      BSS    4           SPECIAL REQUEST BLOCK
 STATW    BSS    1           ADDRESS OF *STAT*
  
          END 
          IDENT  BUDT 
          ENTRY  BUDT 
          SYSCOM B1 
          SST 
          TITLE  BUDT - BUILD UNIT DEVICE TABLE.
*COMMENT   BUILD UNIT DEVICE TABLE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
  
 UDTN     EQU    5           NUMBER OF WORDS PER *UDT* ENTRY
 BUDT     SPACE  4,15 
***       BUDT - BUILD UNIT DEVICE TABLE. 
* 
*         THE ENTIRE EST IS READ, VIA *RDESTC*.  FOR EACH EST ENTRY 
*         FOR *MSS* EQUIPMENT A CORRESPONDING ENTRY IS SET
*         UP IN THE UNIT DEVICE TABLE.  *MSID* REPRESENTS 
*         THE *MSF* HARDWARE COMPONENT IDENTIFIER.
* 
*         BUDT(UDT);   (*SYMPL* CALL) 
* 
*         EXIT   (UDT) = UNIT DEVICE TABLE. 
* 
*         USES   A - 1, 2, 3, 4, 5, 6.
*                B - 1, 2, 3, 4, 5. 
*                X - 0, 1, 2, 3, 4, 5, 6. 
* 
*         CALLS  RDESTC.
* 
*         MACROS SYSTEM.
* 
*         NOTES  ARRAY *UDT* MUST BE 65 CM WORDS LONG.
  
 BUDT     SUBR               ENTRY/EXIT 
          BX6    X1          SAVE ADDRESS OF *UDT*
          SB4    B0 
          SA6    UDTA 
  
*         READ EST INTO *ESTB*. 
  
          SB2    ESTB        SET EST BUFFER ADDRESS 
          SB3    ESTN 
          SB1    1
          RJ     =XRDESTC    READ EST INTO *ESTB* 
          SX4    UDTN        NUMBER OF WORDS PER *UDT* ENTRY
          SA1    ESTN        SET LAST EST ORDINAL + 1 
          SB2    X1 
          SB3    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA5    UDTA        ADDRESS OF BUFFER TO HOLD *UDT*
          SB5    X5 
  
*         SEARCH EST AND BUILD *UDT*. 
  
 BDT1     SB3    B3+B1
          EQ     B2,B3,BUDTX IF END OF EST
          SX1    B3          CALCULATE *ESTB* OFFSET
          R=     X0,ESTE
          IX1    X1*X0
          SA1    ESTB+X1+EQDE  GET NEXT EST ENTRY 
          MX0    -11         CHECK FOR *MSS* EQUIPMENT
          LX0    22-10
          BX2    -X0*X1 
          LX2    10-22
          SX3    X2-2RCS
          ZR     X3,BDT2     IF SELECTOR EST ENTRY
          SX3    X2-2RCT
          NZ     X3,BDT1     IF NOT TRANSPORT EST ENTRY 
          MX0    -2          GET POSITION OF TRANSPORT IN *CSU* 
          LX0    7-1
          BX6    -X0*X1      SET TRANSPORT POSITION IN *UDT*
          SB4    B4+B1       INCREMENT INDEX OF *UDT* ENTRY FOR *CSU* 
          EQ     BDT3        BUILD REMAINING FIELDS IN *UDT* ENTRY
  
 BDT2     SB4    B0          INITIALIZE INDEX OF *UDT* ENTRY FOR *CSU*
          BX6    X6-X6
          MX0    -4          GET *CSU* INDEX
          LX0    8-3
          BX2    -X0*X1 
          LX2    3-8
          SX2    X2-1        CALCULATE ADDRESS OF *UDT* ENTRY FOR *CSU* 
          IX3    X2*X4
          SX5    X3+B5
 BDT3     MX0    5           BUILD *UDT* ENTRY
          LX0    40-59
          BX2    X0*X1
          LX6    26-7 
          LX2    58-40
          BX6    X2+X6       SET CHANNEL NUMBER IN *UDT* ENTRY
          MX0    4           GET *MSA* MSID 
          LX0    35-59
          BX2    X0*X1
          LX2    53-35
          BX6    X2+X6       SET *MSA* MSID IN *UDT* ENTRY
          MX0    8           GET UNIT MSID
          LX0    31-59
          BX2    X0*X1
          LX2    49-31
          BX6    X2+X6       SET UNIT MSID IN *UDT* ENTRY 
          MX0    1
          LX0    41-59
          BX6    X0+X6       MERGE ON/OFF STATUS
          LX0    23-41
          BX2    X0*X1       CHECK ON/OFF STATUS
          ZR     X2,BDT4     IF ON
          SX0    B0          OFF STATUS 
 BDT4     LX0    40-23
          BX6    X0+X6       SET CLEAN UP BIT 
          SX2    B3          SET EST ORDINAL
          MX0    -9 
          BX2    -X0*X2 
          LX2    38-8 
          BX6    X2+X6
          MX0    -3          GET EQUIPMENT (CONTROLLER) NUMBER
          LX0    11-2 
          BX2    -X0*X1 
          LX2    29-11
          BX6    X2+X6       SET EQUIPMENT (CONTROLLER) NUMBER
          MX0    -2          GET *MSA* NUMBER ON COUPLER
          LX0    4-1
          BX2    -X0*X1 
          LX2    22-4 
          BX6    X2+X6       SET *MSA* NUMBER IN *UDT* ENTRY
          MX0    -3          GET UNIT NUMBER ON *MSA* 
          BX2    -X0*X1 
          LX2    20-2 
          BX6    X2+X6       SET UNIT NUMBER IN *UDT* ENTRY 
          SA6    X5+B4       SET UP *UDT* ENTRY IN THE BUFFER 
          EQ     BDT1        PROCESS NEXT EST ENTRY 
  
 ESTB     BSS    ESMX*ESTE   EST BUFFER 
 ESTN     BSS    1           NUMBER OF EST ENTRIES RETURNED 
 UDTA     BSS    1           ADDRESS OF BUFFER TO HOLD *UDT*
  
          END 
          IDENT  CALLSS 
          ENTRY  CALLSS 
          SYSCOM B1 
          TITLE  CALLSS - ISSUE A CALLSS REQUEST TO A SUBSYSTEM.
*COMMENT   ISSUES A CALLSS REQUEST TO A SUBSYSTEM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
 CALLSS   SPACE  4,15 
***       CALLSS - ISSUES A CALLSS REQUEST TO A SUBSYSTEM.
* 
*         CALLSS(SS,PADDR,R);     (*SYMPL* CALL)
* 
*         ENTRY  (SS)    = SUBSYSTEM QUEUE PRIORITY.
*                (PADDR) = PARAMETER BLOCK. 
*                (R)     = RECALL, IF .NE. 0, RECALL IS REQUESTED.
* 
*         USES   A - 1, 3, 4, 5.
*                B - 1. 
*                X - 1, 3, 4, 5.
* 
*         MACROS CALLSS, RECALL.
  
 CALLSS   SUBR               ENTRY/EXIT 
          SB1    1
          SA3    A1+B1       GET ADDRESS OF *PADDR* 
          SA4    A3+B1       GET ADDRESS OF *R* 
          SA1    X1          GET *SS* 
          SA5    X4          GET *R*
          CALLSS X1,X3
          ZR     X5,CALLSSX  IF RECALL NOT REQUESTED
          RECALL X3 
          EQ     CALLSSX     RETURN 
  
          END 
          IDENT  CINTLK 
          ENTRY  CINTLK 
          SYSCOM B1 
          TITLE  CINTLK - GET/RELEASE CATALOG INTERLOCK.
*COMMENT  GET/RELEASE CATALOG INTERLOCK.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
*CALL COMSPFU 
 CINTLK   SPACE  4,20 
***       CINTLK - GET/RELEASE CATALOG INTERLOCK. 
* 
*         CINTLK(FUNC,FAM,DM);  (*SYMPL* CALL)
* 
*         ENTRY  (FUNC) = 3/AT,3/F. 
*                            AT = ALTERNATE STORAGE TYPE -
*                               = 0 (ATNO), DEAFAULT (*MSS*). 
*                               = 1 (ATMS), *MSS*.
*                               = 2 (ATAS), *MSE*.
* 
*                            F  = FUNCTION -
*                               = 0, GET LOCK.
*                               = 1, RELEASE LOCK.
* 
*                (FAM)  = FAMILY NAME, LEFT JUSTIFIED,
*                         SEVEN CHARACTERS MAXIMUM. 
*                (DM)   = DEVICE MASK, RIGHT JUSTIFIED (6 BITS).
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 3, 6.
*                B - 1. 
* 
*         MACROS CALLPFU. 
  
  
 CINTLK   SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET ADDRESS OF *FAM* 
          SA3    A2+B1       GET ADDRESS OF *DM*
          SA1    X1          GET *FUNC* (3/AT,3/F)
          MX0    -2          BUILD FUNCTION CONTROL WORD
          LX0    3
          BX6    -X0*X1      GET ALTERNATE STORAGE TYPE 
          LX6    3
          SX6    X6+B1       ADD COMPLETION BIT 
          LX2    59-17       SET FAMILY ADDRESS 
          BX6    X6+X2
          LX3    41-17       SET DEVICE MASK ADDRESS
          BX6    X6+X3
          SA6    CTCW        STORE CONTROL WORD 
          LX1    59-0        (FUNCTION TO SIGN BIT) 
          NG     X1,CIN1     IF RELEASE LOCK REQUEST
          CALLPFU  CTCW,CTGE,R   GET LOCK 
          EQ     CINTLKX     RETURN 
  
 CIN1     CALLPFU  CTCW,CTRE,R   RELEASE LOCK 
          EQ     CINTLKX     RETURN 
  
*         CONTROL WORD FORMAT - 
*         18/FAM,18/DM,12/,6/AT,5/,1/C. 
  
 CTCW     VFD    59/0,1/1    *CALLPFU* CONTROL WORD 
  
*CALL COMCPFU 
*CALL     COMSPFU 
  
          END 
          IDENT  EESET
          ENTRY  EESET
          SYSCOM B1 
          TITLE  EESET - SET EVENT TABLE. 
*COMMENT  SET EVENT TABLE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
 EESET    SPACE  4,15 
***       EESET - SET EVENT TABLE.
* 
*         EESET(EVENT);   (*SYMPL* CALL)
* 
*         ENTRY  (EVENT) = EVENT DESCRIPTOR.
*T EVENT  39/, 9/ EQ, 12/ CONDITION 
* 
*                            EQ = EST ORDINAL OF THE EQUIPMENT ON 
*                               WHICH THE SYSTEM IS WAITING FOR THE 
*                               CONDITION TO OCCUR. 
*                          CONDITION = EVENT VARIABLE.
* 
*         USES   A - 1. 
*                B - 1. 
*                X - 1. 
* 
*         MACROS EESET. 
  
  
 EESET    SUBR               ENTRY/EXIT 
          SB1    1
          SA1    X1          GET *EVENT*
          EESET  X1 
          EQ     EESETX      RETURN 
  
          END 
          IDENT  GETACT 
          ENTRY  GETACT 
          SYSCOM B1 
          TITLE  GETACT - GET CURRENT JOB ACTIVITY COUNTS.
*COMMENT GET CURRENT JOB ACTIVITY COUNTS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL     COMCMAC 
*CALL     COMCCMD 
 GETACT   SPACE  4,30 
***       GETACT - GET CURRENT JOB ACTIVITY COUNTS. 
* 
*         GETACT(ADDR);   (*SYMPL* CALL)
* 
*         ENTRY  ADDR = ADDRESS FOR RESPONSE. 
* 
*         EXIT   (ADDR) = JOB ACTIVITY INFORMATION IN THE 
*                         FOLLOWING FORMAT. 
*         12/SHORT,1/L,23/0,12/INS,11/0,1/C 
* 
*         SHORT  SHORT TERM ACTIVITY COUNTS, INCREMENTED BY 
*                ONE FOR EACH OF THE FOLLOWING. 
*                PPU ACTIVITY.
*                PPU IN RECALL. 
*                TAPE ACTIVITY. 
*                ROLLOUT REQUESTED. 
*                SCP WAIT RESPONSE INDICATORS.
*                TERMINAL OUTPUT FET ADDRESS PRESENT. 
*         L      LONG TERM ACTIVITY COUNTS.  FIELD IS ONE 
*                IF ANY OF THE FOLLOWING CONDITIONS ARE MET.
*                *K* OR *L* DISPLAY INTERFACE ACTIVE. 
*                *CFO* ENTRY ENABLED. 
*                SCP LONG TERM CONNECTION ESTABLISHED.
*         INS    RESERVED FOR INSTALLATIONS.
*         C      COMPLETE BIT, ALWAYS ONE UPON COMPLETION.
* 
*         USES   B - 1. 
* 
*         MACROS GETACT.
  
  
 GETACT   SUBR               ENTRY/EXIT 
          SB1    1
          GETACT X1 
          EQ     GETACTX     RETURN 
  
          END 
          IDENT  GETDI
          ENTRY  GETDI
          SYSCOM B1 
          TITLE  GETDI - GET DEVICE INHIBIT DATE AND TIME.
*COMMENT  GET DEVICE INHIBIT DATE AND TIME. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSMMF 
*CALL     COMSSFM 
 GETDI    SPACE  4,15 
***       GETDI - GET DEVICE INHIBIT DATE AND TIME. 
* 
*         GETDI(EQ,INDT);  (*SYMPL* CALL) 
* 
*         ENTRY  (EQ) = EST ORDINAL.
* 
*         EXIT   (INDT) = DEVICE INHIBIT DATE AND TIME. 
*                (CEQN) = CURRENT EST ORDINAL.
*                (CIDT) = CURRENT DEVICE INHIBIT DATE AND TIME. 
*                (INIT) = 1.
* 
*         USES   A - 1, 2, 3, 5, 6, 7.
*                B - 1. 
*                X - 1, 2, 3, 5, 6, 7.
* 
*         MACROS GETDI. 
  
  
 GETDI    SUBR                ENTRY/EXIT
          SB1    1
          SA5    A1+B1       SAVE ADDRESS OF *INDT* 
          SA1    X1 
          SA2    INIT 
          ZR     X2,GTD1     IF FIRST CALL
          SA2    CEQN        COMPARE EST ORDINALS 
          BX3    X2-X1
          NZ     X3,GTD2     IF DIFFERENT FROM LAST CALL
          SA1    CIDT 
          EQ     GTD3        RETURN DEVICE INHIBIT DATE AND TIME
  
 GTD1     SX7    B1+
          SA7    A2+
 GTD2     BX6    X1 
          SA6    CEQN        SAVE EST ORDINAL 
          GETDI  SFET,X1
          SA1    BUF+MDIT    RETURN DEVICE INHIBIT DATE AND TIME
 GTD3     BX6    X1 
          SA6    CIDT        SAVE CURRENT DEVICE INHIBIT DATE AND TIME
          SA6    X5 
          EQ     GETDIX      RETURN 
  
*CALL     COMCSFM 
  
 SFET     FILEB  BUF,BUFL,(FET=10D)  FET FOR *SFM* CALL 
 BUFL     EQU    101B 
 BUF      BSS    BUFL 
 CEQN     CON    0           CURRENT EST ORDINAL
 CIDT     BSS    1           CURRENT DEVICE INHIBIT DATE AND TIME 
 INIT     CON    0           INITIAL CALL INDICATOR 
  
          END 
          IDENT  GETFAM 
          ENTRY  GETFAM 
          SST 
          EXT    RDESTC 
          SYSCOM B1 
          TITLE  GETFAM - SET FAMILY TABLE AND SUBSYSTEM ID.
*COMMENT  SET FAMILY TABLE AND SUBSYSTEM ID.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
  
 MSTN     EQU    DULL-TDGL+1 NUMBER OF MST ENTRY WORDS TO READ
 GETFAM   SPACE  4,25 
***       GETFAM - SET FAMILY TABLE AND SUBSYSTEM ID. 
* 
*         GETFAM(FMT,NUM,LNK,DEF,SS);   (*SYMPL* CALL)
* 
*         ENTRY  (SS) = ALTERNATE STORAGE TYPE -
*                     = 0, DEFAULT (*MSS*). 
*                     = 1, *MSS*. 
*                     = 2, *MSE*. 
* 
*         EXIT   (FMT) = FAMILY TABLE.
*                        42/FM,18/MSTA
*                        FM   = FAMILY NAME.
*                        MSTA = ADDRESS OF MST ENTRY. 
* 
*                (NUM) = NUMBER OF ENTRIES IN FAMILY TABLE. 
*                (LNK) = LINK INFORMATION.
*                        12/DT,12/0,36/LNKO 
*                        DT   = LINK DEVICE TYPE. 
*                        LNKO = ORDINAL OF ENTRY IN FAMILY TABLE
*                               CONTAINING FAMILY NAME OF LINK DEVICE.
*                (DEF) = ORDINAL OF ENTRY CONTAINING DEFAULT
*                        FAMILY NAME. 
*                (SS)   = SUBSYSTEM IDENTIFIER. 
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                X - ALL. 
* 
*         CALLS  RDESTC.
* 
*         MACROS SYSTEM.
* 
*         NOTES  ARRAY *FMT* MUST BE 24 CM WORDS LONG.
  
  
 GETFAM   SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET ADDRESS OF *NUM* 
          SA3    A2+B1       GET ADDRESS OF *LNK* 
          SA4    A3+B1       GET ADDRESS OF *DEF* 
          BX7    X1          SAVE ADDRESS OF *FMT*
          SA7    FMTA 
          BX7    X2          SAVE ADDRESS OF *NUM*
          SA7    NUMA 
          BX6    X3          SAVE ADDRESS OF *LNK*
          BX7    X4          SAVE ADDRESS OF *DEF*
          SA6    LNKA 
          MX6    1
          SA7    DEFA 
          SA5    A4+B1       GET ADDRESS OF *SS*
          MX7    -2 
          SA1    X5          GET ALTERNATE STORAGE TYPE 
          BX1    -X7*X1 
          SA1    X1+ASID     SUBSYSTEM ID 
          BX7    X1 
          SA7    X5          RETURN SUBSYSTEM ID
  
*         READ WORD *PFNL* IN *CMR*.
  
          SA1    PFNA 
          SA6    PFNB 
          SYSTEM RSB,R,A1 
  
*         READ WORD *MMFL* IN *CMR*.
  
          MX7    1
          SA1    MMFA 
          SA7    MMFB 
          SYSTEM RSB,R,A1 
  
  
          SB2    ESTB        BUFFER TO RECEIVE EST ENTRIES
          SB3    ESTN 
          SB4    -B1         READ MASS STORAGE ENTRIES
          RJ     =XRDESTC    READ EST INTO *ESTB* 
          MX0    -12
          SA1    PFNB        GET DEFAULT FAMILY EST ORDINAL 
          LX1    -12
          BX6    -X0*X1 
          SB2    X6 
          SA1    MMFB        GET EST ORDINAL OF LINK FAMILY 
          LX1    -36
          MX0    -9 
          SA5    ESTN 
          BX6    -X0*X1 
          SB3    X6+
          SB6    X5          SET LAST MASS STORAGE ORDINAL + 1
          SA5    FMTA        GET ADDRESS OF FAMILY TABLE
          SX5    X5-1 
          SB4    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SB5    B1          INITIALIZE ORDINAL OF FAMILY TABLE 
  
*         SEARCH EST FOR MASS STORAGE DEVICES.
  
 GTF1     SB4    B4+B1
          EQ     B4,B6,GTF3  IF END OF MASS STORAGE DEVICES 
          SX1    B4          CALCULATE *ESTB* OFFSET
          R=     X6,ESTE
          IX1    X1*X6
          SA1    ESTB+X1+EQDE  GET NEXT EST ENTRY 
          PL     X1,GTF1     IF NOT MASS STORAGE DEVICE 
          BX6    X1 
          LX6    59-54
          NG     X6,GTF1     IF DEVICE UNAVAILABLE FOR ACCESS 
          RJ     RDM         READ WORDS *TDGL* TO *DULL* OF MST 
          SA2    MSTB+ACGL-TDGL 
          LX2    59-4 
          NG     X2,GTF1     IF ERROR IDLE SET ON DEVICE
          SA2    MSTB+MDGL-TDGL 
          LX2    59-58
          NG     X2,GTF1     IF AUXILIARY DEVICE
          SA2    MSTB+DULL-TDGL 
          LX2    59-11
          NG     X2,GTF1     IF FAMILY IDLE DOWN FLAG IS SET
          SA2    MSTB+PFGL-TDGL 
          MX0    42 
          BX1    X0*X2
  
*         CHECK FAMILY TABLE FOR A MATCHING FAMILY NAME.
  
          RJ     SFT
          EQ     B7,B5,GTF2  IF NO MATCHING FAMILY NAME 
          EQ     GTF1        PROCESS NEXT EST ENTRY 
  
 GTF2     BX6    X1+X3       SET ENTRY IN FAMILY TABLE
          SA6    X5+B5
          SB5    B5+B1
          EQ     GTF1        PROCESS NEXT EST ENTRY 
  
*         SET ORDINAL OF DEFAULT FAMILY.
  
 GTF3     SX1    B2          CALCULATE *ESTB* OFFSET
          R=     X6,ESTE
          IX1    X1*X6
          SA1    ESTB+X1+EQDE  GET EST ENTRY FOR DEFAULT FAMILY 
          RJ     RDM
          SA2    MSTB+PFGL-TDGL 
          MX0    42 
          BX1    X0*X2
          RJ     SFT         SEARCH FAMILY TABLE FOR DEFAULT FAMILY 
          NE     B7,B5,GTF4  IF MATCHING FAMILY FOUND 
          SB7    B0+
 GTF4     SX6    B7          SET DEFAULT FAMILY ORDINAL 
          SA2    DEFA 
          SA6    X2 
  
*         SET LINK ORDINAL AND DEVICE TYPE. 
  
          SB7    B0+
          ZR     B3,GTF5     IF NO LINK FAMILY
          SX1    B3          CALCULATE *ESTB* OFFSET
          R=     X6,ESTE
          IX1    X1*X6
          SA1    ESTB+X1+EQDE  GET EST ENTRY FOR LINK EQUIPMENT 
          MX0    -11         GET LINK DEVICE TYPE 
          BX6    X1 
          LX6    -12
          BX6    -X0*X6 
          SB3    X6 
          RJ     RDM
          SA2    MSTB+PFGL-TDGL 
          MX0    42 
          BX1    X0*X2
          RJ     SFT         SEARCH FAMILY TABLE FOR LINKED FAMILY
          NE     B7,B5,GTF5  IF MATCHING FAMILY FOUND 
          SB7    B0+
 GTF5     SX5    B3          SET LINK ORDINAL AND DEVICE TYPE 
          SA2    LNKA 
          SX6    B7 
          LX5    48 
          BX6    X5+X6
          SA6    X2 
          SX6    B5-B1       SET NUMBER OF ENTRIES IN FAMILY TABLE
          SA1    NUMA 
          SA6    X1 
          EQ     GETFAMX     RETURN 
 RDM      SPACE  4,15 
**        RDM - READ WORDS *TDGL* TO *DULL* OF MST ENTRY. 
* 
*         ENTRY  (X1) = EST ENTRY.
* 
*         EXIT   (X3) = MST ADDRESS.
*                (MSTA) = MST POINTER PARAMETER.
*                (MSTB) = *MSTN* CONTIGUOUS WORDS STARTING AT *TDGL*
*                         OF THE MST ENTRY. 
* 
*         USES   A - 6, 7.
*                X - 0, 2, 3, 6, 7. 
* 
*         MACROS SYSTEM.
  
  
 RDM      SUBR               ENTRY/EXIT 
          MX0    -12
          BX3    -X0*X1      GET ADDRESS OF MST ENTRY 
          LX3    3
          SX2    X3+TDGL     READ WORD *TDGL* OF MST
          LX2    35-17
          MX7    1
          SA7    MSTB 
          SX7    MSTN        NUMBER OF MST ENTRY WORDS TO READ
          LX7    59-23
          BX6    X7+X2
          SX2    MSTB 
          BX6    X2+X6
          SA6    MSTA 
          SYSTEM RSB,R,A6 
          EQ     RDMX        RETURN 
 SFT      SPACE  4,15 
**        SFT - SEARCH FAMILY TABLE FOR A GIVEN FAMILY NAME.
* 
*         ENTRY  (X1) = FAMILY NAME (UPPER 42 BITS) TO
*                       BE MATCHED. 
*                (X5) = FWA - 1 OF FAMILY TABLE.
*                (B5) = ORDINAL OF LAST ENTRY IN FAMILY TABLE + 1.
* 
*         EXIT   (B7) = ORDINAL OF MATCHING ENTRY IN FAMILY TABLE.
*                NOTE - (B7) = (B5), IF MATCHING ENTRY IS NOT FOUND.
* 
*         USES   A - 2. 
*                B - 5, 7.
*                X - 2, 4, 6. 
  
  
 SFT      SUBR               ENTRY/EXIT 
          MX0    42 
          SB7    B0 
 SFT1     SB7    B7+B1
          EQ     B7,B5,SFTX  IF NO MATCHING FAMILY NAME 
          SA2    X5+B7       GET NEXT ENTRY IN FAMILY TABLE 
          BX4    X0*X2
          BX6    X4-X1
          ZR     X6,SFTX     IF MATCHING FAMILY FOUND 
          EQ     SFT1        CHECK NEXT ENTRY 
  
*CALL     COMSSSD 
  
          SPACE  4,15 
 MMFA     VFD    24/1,18/MMFL,18/MMFB  *MMFL* POINTER PARAMETER 
 PFNA     VFD    24/1,18/PFNL,18/PFNB  *PFNL* POINTER PARAMETER 
  
 DEFA     BSS    1           ADDRESS OF DEFAULT FAMILY ORDINAL
 ESTB     BSS    ESMX*ESTE   EST BUFFER 
 ESTN     BSS    1           LAST MASS STORAGE ORDINAL + 1
 FMTA     BSS    1           ADDRESS OF FAMILY TABLE
 LNKA     BSS    1           ADDRESS OF LINK FAMILY ORDINAL 
 MMFB     BSS    1           *MMFL* WORD IN *CMR* 
 MSTA     BSS    1           MST POINTER PARAMETER WORD 
 MSTB     BSS    MSTN        MST ENTRY BUFFER 
 NUMA     BSS    1           ADDRESS OF NUMBER OF FAMILY TABLE ENTRIES
 PFNB     BSS    1           *PFNL* WORD IN *CMR* 
  
*         TABLE OF ALTERNATE STORAGE SUBSYSTEM IDENTIFIERS. 
  
 ASID     EQU    *           ALTERNATE STORAGE SUBSYSTEM IDENTIFIERS
          CON    MFSI        AT=0, DEFAULT (*MSS*)
          CON    MFSI        AT=1, *MSS*
          CON    ASSI        AT=2, *MSE*
  
          END 
          IDENT  GETMI
          ENTRY  GETMI
          SST 
          SYSCOM B1 
          TITLE  GETMI - GET MACHINE INFORMATION. 
*COMMENT   GET MACHINE INFORMATION. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
*CALL     COMSMMF 
 GETMI    SPACE  4,20 
***       GETMI - GET MACHINE INFORMATION.
* 
*         GETMI(STATUS,EVENT);  (*SYMPL* CALL)
* 
*         EXIT   (STATUS) = MACHINE INFORMATION.
*                           1/MSX,1/MFI,1/ASX,3/,12/ MID,39/,3/MFID 
*                            MSX = 0, *MSS* MASTER MODE EXECUTIVE 
*                                = 1, *MSS* SLAVE MODE EXECUTIVE
*                            ASX = 0, *MSE* MASTER MODE EXECUTIVE 
*                                = 1, *MSE* SLAVE MODE EXECUTIVE
*                           MFI  = 0, SINGLE MAIN FRAME MODE. 
*                                = 1, MULTI MAIN FRAME MODE.
*                            MID = MACHINE ID 
*                            MFID = MAINFRAME INDEX 
*                (EVENT) = EVENT DESCRIPTORS -
*                            18/,9/,12/ *ASXE*,9/,12/ *MSXE*
*                            *ASXE* = *MSE* EVENT 
*                            *MSXE* = *MSS* EVENT 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 1. 
*                X - 0, 1, 2, 6, 7. 
* 
*         MACROS SYSTEM.
  
  
 GETMI    SUBR               ENTRY/EXIT 
          SB1    1
          BX6    X1 
          SA6    STATW       SAVE ADDRESS OF *STATUS* 
          SA2    A1+B1       RETURN EVENT DESCRIPTOR
          SA1    GMIA 
          BX6    X1 
          SA6    X2          STORE EVENT DESCPITORS 
          MX7    1
          SA1    SSTA        READ WORD *SSTL* IN *CMR*
          SA7    SSTB 
          SYSTEM RSB,R,A1 
          MX7    1
          SA1    MMFA        READ WORD *MMFL* IN *CMR*
          SA7    MMFB 
          SYSTEM RSB,R,A1 
          SA1    SSTB        SET MASTER/SLAVE EXEC MODE 
          MX6    -1 
          LX6    49 
          BX6    -X6*X1      GET *MSE* MASTER/SLAVE BIT 
          LX6    57-49
          MX7    1
          LX1    59-55
          BX1    X7*X1       GET *MSS* MASTER/SLAVE BIT 
          BX6    X6+X1       (X6= 1/MSX,1/0,1/ASX,57/0) 
          SA1    MMFB        GET MULTI/SINGLE MF MODE 
          MX0    12 
          LX0    47-59
          BX2    X0*X1
          NZ     X2,GMI1     IF MULTI MAIN FRAME MODE 
          BX7    X7-X7
 GMI1     LX7    59          SET MULTI/SINGLE MF MODE 
          BX6    X6+X7
          MX0    -3 
          ERRNG  7-MXMF      CODE DEPENDS ON VALUE OF TAG 
          BX7    -X0*X1      SET MF-ID
          BX6    X6+X7
          MX0    12 
          BX7    X0*X1
          LX7    53-59
          BX6    X6+X7
          SA2    STATW
          SA6    X2 
          EQ     GETMIX      RETURN 
  
*CALL     COMSEVT 
  
 GMIA     VFD    18/0,9/0,12/ASXE,9/0,12/MSXE  *MSE*/*MSS* EVENT
 MMFA     VFD    24/1,18/MMFL,18/MMFB  *SSTL* POINTER PARAMETER 
 SSTA     VFD    24/1,18/SSTL,18/SSTB  *MMFL* POINTER PARAMETER 
  
 MMFB     BSS    1           *MMFL* WORD IN *CMR* 
 SSTB     BSS    1           *SSTL* WORD IN *CMR* 
 STATW    BSS    1           ADDRESS OF RETURN STATUS WORD
  
          END 
          IDENT  GETPFP 
          ENTRY  GETPFP 
          SYSCOM B1 
          TITLE  GETPFP - GET PERMANENT FILE PARAMETERS.
*COMMENT  GET PERMANENT FILE PARAMETERS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL     COMCMAC 
 GETPFP   SPACE  4,15 
***       GETPFP - GET PERMANENT FILE PARAMETERS. 
* 
*         GETPFP(ADDR);   (*SYMPL* CALL)
* 
*         ENTRY  ADDR = ADDRESS OF A 3 WORD BLOCK FOR RESPONSE. 
* 
*         EXIT   (ADDR) = CURRENT CONTROL POINT PARAMETERS RETURNED 
*                         IN FORMAT-
*                         42/FAMILY NAME,18/0 
*                         42/PACKNAME,18/0
*                         42/USER NUMBER,18/USER INDEX
* 
*         USES   B - 1. 
* 
*         MACROS GETPFP.
  
  
 GETPFP   SUBR               ENTRY/EXIT 
          SB1    1
          GETPFP X1 
          EQ     GETPFPX     RETURN 
  
          END 
          IDENT  GETSPS 
          ENTRY  GETSPS 
          SYSCOM B1 
          TITLE  GETSPS - RETURN SYSTEM ORIGIN PRIVILEGES STATUS. 
*COMMENT  RETURN SYSTEM ORIGIN PRIVILEGES STATUS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
 GETSPS   SPACE  4,15 
***       GETSPS - RETURN SYSTEM ORIGIN PRIVILEGES STATUS.
* 
*         GETSPS (ADDR);     (*SYMPL* CALL) 
* 
*         ENTRY  ADDR = ADDRESS OF THE RETURN STATUS WORD.
* 
*         EXIT   STATUS HAS BEEN RETURNED TO *ADDR*.
*                48/ ,12/STATUS 
*                STATUS .EQ. 0 IF USER HAS SYSTEM ORIGIN PRIVILEGES.
*                       .NE. 0 IF USER DOES NOT HAVE SYSTEM ORIGIN
*                         PRIVILEGES. 
* 
*         USES   B - 1. 
* 
*         MACROS  GETSPS. 
  
  
 GETSPS   SUBR
          SB1    1
          GETSPS X1 
          EQ     GETSPSX     RETURN 
  
          END 
          IDENT  RDEST
          ENTRY  RDEST
          SYSCOM B1 
          TITLE  RDEST - READ EST TO BUFFER.
*COMMENT  READ EST TO BUFFER. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
 RDEST    SPACE  4,20 
***       RDEST - READ EST TO BUFFER. 
* 
*         RDEST(ESTB,ESTN,ESTO);   (*SYMPL* CALL) 
* 
*         ENTRY  (ESTN) = NUMBER OF EST ENTRIES TO BE READ. 
*                (ESTO) = ORDINAL OF EST ENTRY TO BE RETURNED 
*                       = 0, TO TRANSFER ENTIRE EST.
*                       = -1, TO TRANSFER MASS STORAGE ENTRIES ONLY.
* 
*         EXIT   (ESTB) = EST.
*                (ESTN) = NUMBER OF EST ENTRIES RETURNED. 
*                       .LE. ZERO, IF REQUESTED ORDINAL(S)
*                            OUTSIDE OF EST.
* 
*         USES   A - 2, 3, 4. 
*                B - 1, 2, 3, 4.
*                X - 2, 3, 4. 
* 
*         CALLS  RDESTC.
  
  
 RDEST    SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET ADDRESS OF *ESTN*
          SA3    A2+B1       GET ADDRESS OF *ESTO*
          SB2    X1 
          SB3    X2 
          SA4    X3          GET EST ORDINAL
          SB4    X4 
          LE     B4,B0,RDE1  IF TRANSFER OF ENTIRE OR MASS STORAGE EST
          SB4    X3+         SET ADDRESS OF EST ORDINAL 
 RDE1     RJ     =XRDESTC    READ EST INTO *ESTB* 
          EQ     RDESTX      RETURN 
  
          END 
          IDENT  RDESTC 
          ENTRY  RDESTC 
          SST 
          SYSCOM B1 
          TITLE  RDESTC - READ EST INTO BUFFER. 
*COMMENT  READ EST INTO BUFFER. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
 RDESTC   SPACE  4,25 
***       RDESTC - READ EST INTO BUFFER.
*         *RDESTC* CAN BE CALLED ONLY FROM A *COMPASS* ROUTINE. 
* 
*         ENTRY  (B2) = ADDRESS OF EST BUFFER.  IF THE ENTIRE EST 
*                       EST IS TO BE RETURNED, BUFFER MUST BE AT
*                       LEAST ESMX*ESTE WORDS IN LENGTH.
*                (B3) = ADDRESS OF LOCATION CONTAINING NUMBER OF EST
*                       ENTRIES TO BE RETURNED. 
*                (B4) = ADDRESS OF LOCATION CONTAINING EST ORDINAL TO 
*                       BE RETURNED.
*                     = 0, TO RETURN ENTIRE EST.
*                     = -1, TO RETURN ONLY MASS STORAGE EST ENTRIES.
* 
*         EXIT   BUFFER CONTAINS REQUEST EST ENTRY/ENTRIES. 
*                ((B3)) = NUMBER OF EST ENTRIES RETURNED. 
* 
*         USES   A - 1, 2, 3, 4, 5, 6, 7. 
*                X - ALL. 
* 
*         MACROS SYSTEM.
* 
*         CALLS  RSB=.
  
  
 RDESTC   SUBR               ENTRY/EXIT 
          SA1    CMRA        READ EST POINTERS
          MX7    1
          SA7    CMRW 
          SYSTEM RSB,R,A1 
          SA1    CMRW 
          MX0    -12         SET *COMCRSB* ENTRY CONDITIONS 
          LX1    24 
          SX2    X1          SET (X2) = FWA OF EST
          LX1    12 
          BX3    -X0*X1      SET LAST EST ORDINAL + 1 
          LX1    12 
          BX4    -X0*X1      SET LAST MASS STORAGE ORDINAL + 1
          SX5    X4          PRESET NUMBER OF MASS STORAGE ENTRIES
          NZ     B4,RDE1     IF SPECIFIC OR MS ENTRIES REQUIRED 
          SX5    X3          SET NUMBER OF EST ENTRIES
          EQ     RDE3        CONTINUE 
  
 RDE1     PL     B4,RDE2     IF SPECIFIC EST ENTRIES REQUIRED 
          EQ     RDE3        CONTINUE 
  
 RDE2     SA1    B4          READ SPECIFIC EST ENTRIES
          SX4    X1          SAVE EST ORDINAL 
          SX6    ESTE 
          IX1    X1*X6       OFFSET OF REQUIRED EST ENTRY 
          IX2    X2+X1       FWA OF REQUIRED EST ENTRY
          SA5    B3          NUMBER OF EST ENTRIES REQUIRED 
          IX4    X4+X5       CHECK FOR RANGE WITHIN EST 
          IX4    X3-X4
          PL     X4,RDE4     IF EST ENTRIES WITHIN RANGE
          IX5    X4+X5       NUMBER OF EST ENTRIES ACTUALLY READ
 RDE3     BX6    X5          RETURN NUMBER OF EST ENTRIES 
          SA6    B3 
          ZR     X6,RDESTCX  IF ORDINAL OUTSIDE OF EST
          NG     X6,RDESTCX  IF ORDINAL OUTSIDE OF EST
  
*         READ EST ENTRIES. 
  
 RDE4     SX6    ESTE        CALCULATE WORD COUNT 
          IX3    X5*X6       SET (X3) = WORD COUNT TO READ
          SX1    B2          SET (X1) = *ESTB*
          SX4    B0          SET (X4) = SUBSYSTEM (= *CMR*) 
          SA7    B2 
          RJ     RSB=        READ EST 
          EQ     RDESTCX     RETURN 
  
 CMRA     VFD    24/1,18/ESTP,18/CMRW  *CMR* POINTER PARAMETER
 CMRW     BSS    1           WORD *ESTP* IN *CMR* 
  
*CALL     COMCRSB 
  
          END 
          IDENT  RDPFC
          ENTRY  RDPFC
          SST 
          SYSCOM B1 
          TITLE RDPFC - READ PERMANENT FILE CATALOG.
*COMMENT   READ PERMANENT FILE CATALOG. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
*CALL     COMCCMD 
*CALL COMSPFM 
*CALL COMSPFS 
*CALL COMSPFU 
*CALL COMSSSJ 
          TITLE  ASSEMBLY CONSTANTS 
**        ASSEMBLY CONSTANTS. 
* 
  
 NWPS     EQU    100B        NUMBER OF WORDS/SECTOR 
 NWPC     EQU    NWPS+2      NUMBER OF WORDS/SECTOR + CONTROL WORDS 
 CBUFL    EQU    NWPC*10+1   CATALOG BUFFER LENGTH
 MSTN     EQU    MDGL-TDGL+1 NUMBER OF MST WORDS TO READ
 MSTTL    EQU    ESMX*2+1    MST TABLE LENGTH 
 SECL     EQU    NWPS+1      NUMBER OF WORDS/SECTOR + TRAILING
                             CONTROL WORD 
          TITLE  MAIN LOOP
          SPACE  4,15 
***       *RDPFC* IS A *SYMPL* CALLABLE *COMPASS* ROUTINE 
*         THAT READS THE PERMANENT FILE CATALOG.
* 
*         RDPFC(FM,SBM,PFCB,WDCN,FLAG);   *SYMPL* CALL. 
* 
*         NOTE   *RDPFC* DOES A SEQUENTIAL READ OF THE PERMANENT
*                FILE CATALOG ON ALL THE DEVICES IN A GIVEN 
*                FAMILY.  IF THE SUB FAMILY OPTION IS SELECTED, 
*                ONLY THE DEVICES WITH THE SELECTED SUBFAMILY 
*                ARE READ.  ON EACH CALL TO *RDPFC* A SECTOR
*                OF PFC ENTRIES ALONG WITH THE CONTROL WORD 
*                IS RETURNED TO THE CALLING PROCEDURE.  *PFU* 
*                FUNCTIONS ARE USED TO OPEN THE CATALOG TRACK,
*                TO ADVANCE TO THE NEXT TRACK AND TO READ THE 
*                CATALOG TRACK.  THE DEVICES WITH ERROR IDLE
*                SET OR PF UTILITY ACTIVE ARE EXCLUDED FROM 
*                THE MASS STORAGE TABLE BUILT.  THE ERROR STATUS
*                IS RETURNED TO THE CALLING ROUTINE.  THE CALLING 
*                ROUTINE MAY THEN ABORT OR CALL *RDPFC* AGAIN TO
*                READ THE REMAINING DEVICE IN THE MASS STORAGE TABLE. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * RDPFC - ERROR IDLE, DN XX.* - *RDPFC* SKIPPED 
*         DEVICE X ON ACCOUNT OF ERROR IDLE ON THE DEVICE.
* 
*         * RDPFC - PF UTILITY ACTIVE, DN XX.* - *RDPFC*
*         SKIPPED DEVICE X ON ACCOUNT OF PF UTILITY 
*         ACTIVE ON THE DEVICE. 
 RDPFC    SPACE  4,20 
***       RDPDC - READ PERMANENT FILE CATALOG.
* 
*         ENTRY  (FAM)  = FAMILY NAME, LEFT JUSTIFIED,
*                         SEVEN CHARACTERS MAXIMUM. 
*                (SBM)  = SUB FAMILY MASK, IF SUB FAMILY
*                         OPTION IS SELECTED. 
*                       = 0, OTHERWISE. 
*                (MORD) = -1, ON FIRST CALL OR IF AN ERROR IDLE OR
*                             PF UTILITY ACTIVE WAS ENCOUNTERED ON
*                             THE PREVIOUS CALL.
*                       = ORDINAL OF CURRENT *MSTT* ENTRY ON
*                         SUBSEQUENT CALLS. 
*                (DVFL) = 0, READ THE NEXT PERMANENT FILE CATALOG 
*                            SECTOR.
*                       = 1, READ THE DEVICES IN THE FAMILY BESIDES 
*                            THE ONES WITH ERROR IDLE SET OR PF UTILITY 
*                            ACTIVE.
* 
*         EXIT   (PFCB) = SECTOR OF PFC ENTRIES ALONG WITH
*                         THE TRAILING CONTROL WORD.
*                NOTE - BUFFER LENGTH MUST BE 101B. 
*                CONTROL WORD FORMAT IS 
*                6/DN,18/,12/EQ,12/TRACK,12/SECTOR
*                (WDCN) = NUMBER OF WORDS OF DATA IN SECTOR.
*                (FLAG) = 0, MORE PFC ENTRIES TO GO.
*                         1, END OF PFC.
*                         2, NO DEVICES IN THE FAMILY.
*                         3, BAD CATALOG SECTOR.
*                         4, ERROR IDLE OR PF UTILITY ACTIVE ON ONE 
*                            OR MORE DEVICES IN THE FAMILY. 
*                (DVFL) = 0, ALL DEVICES ARE OK TO BE READ. 
*                         1, ERROR IDLE OR PF UTILITY ACTIVE ON 
*                            ONE OR MORE DEVICES IN THE FAMILY. 
*                (MORD) = -1, ON THE FIRST CALL WHEN AN ERROR IDLE
*                             OF PF UTILITY ACTIVE WAS FOUND. 
*                       = ORDINAL OF CURRENT *MSTT* ENTRY OTHERWISE.
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 1. 
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  AVC, BMT, CAC, RCT.
  
  
 RDPFC    SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET SUB FAMILY MASK
          SA3    X2 
          BX6    X3 
          SA6    SMSK 
          SA3    A2+B1       SAVE ADDRESS OF *PFCB* 
          BX6    X3 
          SA6    PFC
          SA2    A3+B1       SAVE ADDRESS OF *WDCN* 
          BX6    X2 
          SA6    WCNA 
          SA3    A2+B1       SAVE ADDRESS OF *FLAG* 
          BX6    X3 
          SA6    FG 
          SA2    MORD        CHECK FOR FIRST CALL 
          PL     X2,RDP3     IF NOT FIRST CALL
          SA3    DVFL        CHECK ERROR IDLE/PF UTILITY FLAG 
          ZR     X3,RDP1     IF FIRST CALL
          BX6    X6-X6       CLEAR ERROR FLAG SET IN PREVIOUS CALL
          SA6    DVFL 
          EQ     RDP2        INITIALIZE FIRST DEVICE
  
 RDP1     SA1    X1          GET FAMILY NAME
          BX6    X1 
          SA6    FM 
          RJ     BMT         BUILD *MSTT* TABLE 
          SA3    DVFL        CHECK ERROR IDLE/PF UTILITY ACTIVE FLAG
          ZR     X3,RDP2     IF ALL DEVICES OK TO BE READ 
          SX2    4           FLAG *ERROR IDLE/PF UTILITY ACTIVE*
          EQ     RDP4        RETURN DEVICE STATUS 
  
 RDP2     RJ     AVC         INITIALIZE FIRST DEVICE
          SA2    EOP
          ZR     X2,RDP3     IF FIRST DEVICE INITIALIZED
          SX2    2           FLAG *NO DEVICES IN THE FAMILY*
          EQ     RDP4        RETURN STATUS
  
 RDP3     RJ     RCT         READ CATALOG TRACK 
          SA2    EOP
          ZR     X2,RDP4     IF MORE PFC ENTRIES TO GO
          RJ     CAC         CLEAR PF ACTIVITY COUNT
          SA2    EOP
 RDP4     BX7    X2 
          SA2    FG 
          SA7    X2 
          SA2    WCNT        RETURN WORD COUNT
          BX6    X2 
          SA3    WCNA 
          SA6    X3 
          EQ     RDPFCX      RETURN 
          TITLE  SUBROUTINES
 AVC      SPACE  4,25 
**        AVC - ADVANCE CATALOG TRACK.
* 
*         THE CATALOG TRACK IS ADVANCED TO THE NEXT TRACK 
*         ON THE DEVICE.  IF END OF CATALOG TRACKS IS ENCOU-
*         NTERED ON THE DEVICE, IT SWITCHES TO THE NEXT 
*         DEVICE IN THE FAMILY AND OPENS THE FIRST CATALOG
*         TRACK ON THE DEVICE.
* 
*         ENTRY  (NCTR) = CURRENT NUMBER OF CATALOG TRACKS. 
*                (SMSK) = DEVICE MASK FOR SELECTED SUB FAMILIES.
*                (MORD) = ORDINAL OF CURRENT *MSTT* ENTRY.
* 
*         EXIT   (NCTR) = UPDATED NUMBER OF CATALOG TRACKS. 
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
*                (MORD) = UPDATED ORDINAL OF CURRENT *MSTT* ENTRY.
*                (EOP)  = 0, IF MORE PFC ENTRIES TO GO. 
*                       = 1, IF END OF PFC IS REACHED.
*                CATALOG TRACK ADVANCED.
*                DEVICE SWITCH MADE IF NECESSARY. 
* 
*         USES   A - 1, 2, 4, 6, 7. 
*                B - 3. 
*                X - 0, 1, 2, 4, 5, 6, 7. 
* 
*         CALLS  CAC, SAC.
* 
*         MACROS CALLPFU, READCW, RETURN. 
  
  
 AVC      SUBR               ENTRY/EXIT 
          SA1    NCTR 
          ZR     X1,AVC1     SWITCH TO THE NEXT DEVICE
          CALLPFU  CATS,CTAC,R  ADVANCE TO NEXT CATALOG TRACK 
          EQ     AVC7        CONTINUE 
  
*         ADVANCE TO THE NEXT DEVICE. 
  
 AVC1     RJ     CAC         CLEAR PF ACTIVITY COUNT
 AVC1.1   SA2    MORD        INCREMENT *MSTT* ORDINAL 
          SX6    X2+B1
          SX7    B1 
          SA6    MORD 
          SA4    MSTT+X6     GET THE NEXT *MSTT* ENTRY
          NZ     X4,AVC2     IF NOT END OF TABLE
          SA7    EOP         SET END OF PFC FLAG
          EQ     AVCX        RETURN 
  
*         CHECK TO SEE IF A SPECIFIED SUB FAMILY RESIDES ON THIS DEVICE.
  
 AVC2     SA1    SMSK        CHECK SUB FAMILY MASK
          MX0    -20         SELECT THE MATCHING DEVICE 
          BX5    -X0*X4      GET THE DEVICE MASK
          AX5    12 
          ZR     X1,AVC4     IF SUBFAMILY OPTION NOT SELECTED 
          BX7    X1*X5
          ZR     X7,AVC1.1   IF SUB FAMILY NOT ON DEVICE
  
*         DETERMINE DEVICE PARAMETERS.
  
 AVC4     MX0    -12         SET NUMBER OF CATALOG TRACKS 
          BX6    -X0*X4 
          ZR     X6,AVC1.1   IF NO CATALOG TRACKS 
          SA6    NCTR 
          LX4    59-53       SET MASTER DEVICE EST ORDINAL
          MX0    12 
          BX6    X0*X4
          LX6    12 
          SA6    PDWD        SET UP PF DESCRIPTION WORD 
          SA6    MAEQ        SAVE MASTER DEVICE EST ORDINAL 
          LX5    59-7 
          RJ     SAC         SET PF ACTIVITY COUNT
  
*         DETERMINE STARTING USER INDEX ON THE DEVICE.
  
          SX1    PDWD        SET ADDRESS OF PF DESCRIPTION WORD 
          SB3    7           DEVICE MASK BIT COUNT - 1
 AVC5     NG     X5,AVC6     IF DEVICE MASK BIT SET 
          LX5    1           POSITION NEXT MASK BIT 
          SB3    B3-B1
          PL     B3,AVC5     IF MORE BITS TO CHECK
 AVC6     SX6    B3          SET STARTING USER INDEX
          SA6    CUI
          SX2    A6          SET ADDRESS OF USER INDEX WORD 
          LX1    35-17
          BX6    X1+X2
          SA6    CATS+FTPM
          CALLPFU  CATS,CTCT,R  GET CATALOG TRACK PARAMETERS
  
*         SET UP CATALOG *FST* ENTRY. 
  
          SA1    CATS+FTPM   GET CATALOG TRACK PARAMETERS 
          SA2    FIST        SET FILE ID AND STATUS 
          MX0    -21
          BX1    -X0*X1      SET *EQ* AND FIRST TRACK 
          MX0    -12
          BX6    -X0*X1      SET CURRENT TRACK
          LX1    59-23       POSITION EST ORDINAL AND FIRST TRACK 
          BX2    X2+X1       BUILD CATALOG TRACK *FST* ENTRY
          LX6    35-11
          BX7    X2+X6
          LX6    11-35
          SA6    CCTR 
          SA7    A1 
  
*         OPEN CATALOG FILE.
  
          RETURN CATS        RETURN EXISTING FILE 
          CALLPFU  CATS,CTOP,R  OPEN CATS FILE
 AVC7     SA1    NCTR        UPDATE NUMBER OF CATALOG TRACKS
          SX6    X1-1 
          SA6    NCTR 
          READCW CATS,17B,R  READ CATALOG TRACK 
          EQ     AVCX        RETURN 
 BMT      SPACE  4,20 
**        BMT - BUILD MASS STORAGE TABLE. 
* 
*         ENTRY  (FM) = FAMILY NAME.
* 
*         EXIT   MASS STORAGE TABLE BUILT.
*                (DVFL) = 0, IF NO ERROR IDLE OR PF UTILITY 
*                            ACTIVE ON ANY DEVICE.
*                         1, IF ERROR IDLE OR PF UTILITY ACTIVE 
*                            ON ONE OR MORE DEVICES.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 6, 7. 
*                B - 2, 3, 4, 5.
* 
*         CALLS  COD, RSB=, SNM.
* 
*         MACROS MESSAGE, SYSTEM. 
* 
*         NOTES  DEVICES THAT DO NOT BELONG TO THE GIVEN
*                FAMILY, OR ARE UNAVAILABLE OR ARE LOCALLY
*                UNLOADED, ARE IGNORED.  A DEVICE IS ALSO 
*                IGNORED, IF AN ERROR IDLE IS SET ON THE
*                DEVICE OR IF A PF UTILITY IS ACTIVE ON 
*                IT.  SEE DOCUMENTATION OF *MSTT* FOR FORMAT. 
  
  
*         READ EST INTO *ESTB*. 
  
 BMT      SUBR               ENTRY/EXIT 
          SA1    BMTA        READ EST POINTERS
          MX7    1
          SA7    ESTB 
          SYSTEM RSB,R,A1 
          SA2    ESTB        SET *COMCRSB* ENTRY CONDITIONS 
          MX3    -12
          SX1    A2          (X1) = ADDRESS TO TRANSFER TO
          AX2    12 
          BX7    -X3*X2 
          SA7    BMTB        SAVE LAST MASS STORAGE ORDINAL + 1 
          AX2    24          (X2) = ADDRESS TO TRANSFER FROM
          R=     X6,ESTE
          IX3    X7*X6       (X3) = WORD COUNT
          SX4    B0          (X4) = SUBSYSTEM (= *CMR*) 
          MX6    1
          SA6    X1 
          RJ     RSB=        READ EST 
          SB2    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA2    BMTB        SET LAST MASS STORAGE ORDINAL + 1
          SB3    X2 
          SB4    B0          SET INITIAL MASS STORAGE TABLE INDEX 
  
*         READ NEXT MST ENTRY.
  
 BMT1     SB2    B2+B1       ADVANCE TO NEXT EST ENTRY
          EQ     B2,B3,BMT4  IF END OF EST
          SX1    B2          CALCULATE *ESTB* OFFSET
          R=     X6,ESTE
          IX1    X1*X6
          SA1    ESTB+X1+EQDE 
          PL     X1,BMT1     IF NOT MASS STORAGE EQUIPMENT
          MX2    -12         SET MST ADDRESS
          BX6    -X2*X1 
          LX1    59-54
          LX6    17-14
          SX6    X6+TDGL
          LX6    35-17
          NG     X1,BMT1     IF DEVICE UNAVAILABLE
          SX2    MSTN        NUMBER OF MST WORDS NEEDED 
          SX7    MSTB 
          LX2    59-23
          BX1    X6+X7
          MX7    1           SET ABSOLUTE MEMORY FLAG 
          BX6    X1+X2
          SA7    MSTB 
          SA6    MSTA 
          SYSTEM RSB,R,A6    READ MST ENTRY 
  
*         CHECK FOR USABLE MST ENTRY. 
  
          SA2    MSTB+PFGL-TDGL  CHECK FAMILY NAME
          MX0    42 
          SA3    FM 
          BX6    X2-X3
          BX2    X0*X6
          NZ     X2,BMT1     IF NOT CORRECT FAMILY NAME 
          SA2    MSTB+ACGL-TDGL  CHECK FOR ERROR IDLE 
          LX2    59-4 
          SB5    MSGA        * RDPFC - ERROR IDLE, DN XX. 
          NG     X2,BMT2     IF DEVICE ERROR IDLE 
          SA3    MSTB        CHECK FOR PF UTILITY ACTIVE
          LX3    59-42
          SB5    MSGB        * RDPFC - PF UTILITY ACTIVE, DN XX.* 
          NG     X3,BMT2     IF PF UTILITY ACTIVE ON DEVICE 
  
*         BULID MASS STORAGE TABLE *MSTT* INFORMATION.
  
          SA1    MSTB+ALGL-TDGL  SET NUMBER OF CATALOG TRACKS 
          MX3    -12
          AX1    12 
          BX6    -X3*X1 
          SA1    MSTB+PFGL-TDGL  SET DEVICE NUMBER
          MX3    6
          LX1    59-17
          BX7    X3*X1
          BX6    X6+X7
          SX1    B2          SET EST ORDINAL
          LX1    53-11
          BX6    X6+X1
          SA1    MSTB+PUGL-TDGL  SET DEVICE MASK
          MX3    -8 
          BX7    -X3*X1 
          LX7    19-7 
          BX6    X6+X7
          SA6    MSTT+B4     SET *MSTT* ENTRY 
          SB4    B4+B1       ADVANCE TABLE INDEX
          EQ     BMT1        GET NEXT EST ENTRY 
  
*         DISPLAY DAYFILE MESSAGES. 
  
 BMT2     SX5    B2          SAVE CURRENT EST ORDINAL 
          SX6    B1          SET ERROR IDLE FLAG
          SA6    DVFL 
          SA2    MSTB+PFGL-TDGL  GET DEVICE NUMBER
          MX0    -6 
          LX2    -12
          BX1    -X0*X2 
          RJ     COD         CONVERT DEVICE NUMBER TO DISPLAY CODE
          MX0    -12
          BX1    -X0*X6 
          LX1    59-11
          SB2    1R/
          RJ     SNM         SET DEVICE NUMBER IN MESSAGE 
          MESSAGE  B5,3,R 
          SB2    X5          RESTORE EST ORDINALS 
          SA2    BMTB 
          SB3    X2 
          EQ     BMT1        GET NEXT EST ENTRY 
  
*         TERMINATE MASS STORAGE TABLE. 
  
 BMT4     BX6    X6-X6       TERMINATE BY A WORD OF ZEROES
          SA6    MSTT+B4
          EQ     BMTX        RETURN 
  
 BMTA     VFD    24/1,18/ESTP,18/ESTB  EST POINTER PARAMETER
 BMTB     BSS    1           LAST MASS STORAGE ORDINAL + 1
 CAC      SPACE  4,15 
**        CAC - CLEAR PF ACTIVITY COUNT.
* 
*         ENTRY  (ACFL) = 1, IF ACTIVITY COUNT SET. 
*                         0, IF ACTIVITY COUNT ALREADY CLEAR. 
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
* 
*         EXIT   (ACFL) = 0.
*                PFU CALLED TO CLEAR PF ACTIVITY COUNT IF 
*                NOT ALREADY CLEAR. 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
* 
*         MACROS CALLPFU. 
  
  
 CAC      SUBR               ENTRY/EXIT 
          SA1    ACFL        CHECK ACTIVITY COUNT FLAG
          ZR     X1,CACX     IF ACTIVITY COUNT ALREADY CLEAR
          SA1    MAEQ        GET MASTER DEVICE EST ORDINAL
          SX6    ACFL        SET ACTIVITY COUNT FLAG ADDRESS
          LX1    59-11
          BX6    X1+X6       MERGE EST ORDINAL
          SA6    ACFT+FTPM
          CALLPFU ACFT,CTDA,R  DECREMENT PF ACTIVITY COUNT
          EQ     CACX        RETURN 
 RCT      SPACE  4,20 
**        RCT - READ CATALOG TRACK. 
* 
*         ENTRY  (CATS) = FWA OF FET FOR CATALOG FILE.
*                (EOP)  = 0, MIDDLE OF PFC(CATALOG) TRACK.
*                         3, BAD PREVIOUS PFC(CATALOG) SECTOR.
* 
*         EXIT   (PFCB) = A SECTOR OF PFC ENTRIES ALONG 
*                         WITH THE TRAILING CONTROL WORD. 
*                (EOP)  = 0, MIDDLE OF PFC(CATALOG) TRACK.
*                         1, END OF PFC(CATALOG) TRACK. 
*                         3, BAD PFC(CATALOG) SECTOR. 
* 
*         USES   A - 1, 2, 3, 6, 7. 
*                B - 2. 
*                X - 0, 1, 2, 3, 6, 7.
* 
*         CALLS  AVC. 
* 
*         MACROS READO, READW.
  
  
 RCT      SUBR               ENTRY/EXIT 
          SA1    EOP
          ZR     X1,RCT1     IF IN THE MIDDLE OF TRACK
  
*         CLEAN UP ERROR FIELDS FOR PREVIOUS BAD SECTOR.
  
          SA2    CATS 
          SX6    36000B      CLEAR FET ERROR STATUS 
          BX6    -X6*X2 
          SA6    A2 
          BX6    X6-X6
          SA6    A2+6        CLEAR FET DETAILED ERROR STATUS
          SA6    EOP         CLEAR ERROR FLAG 
 RCT1     READO  CATS        READ *CIO* HEADER CONTROL WORD 
          NZ     X1,RCT3     IF END OF CATALOG TRACK
          PL     X6,RCT2     IF ERROR INDICATOR CLEAR 
          SX7    3           FLAG *BAD SECTOR*
          SA7    EOP
 RCT2     SX5    5           DETERMINE WORD COUNT 
          MX0    -24
          BX6    -X0*X6 
          ZR     X6,RCT3     IF END OF TRACK
          IX7    X6/X5
          SA7    WCNT 
          SX7    X7+1 
          SA1    PFC
          READW  CATS,X1,X7  READ CATALOG SECTOR+CONTROL WORD 
  
*         SET DEVICE NUMBER IN TRAILING CONTROL WORD. 
  
          SA1    MORD        GET *MSTT* ENTRY 
          SA2    MSTT+X1
          MX0    6
          BX6    X0*X2
          SA1    PFC
          SA4    WCNT 
          SB2    X4 
          SA3    X1+B2
          MX0    24 
          BX7    -X0*X3 
          BX6    X6+X7
          SA6    A3 
          EQ     RCTX        RETURN 
  
 RCT3     RJ     AVC         ADVANCE TO NEXT TRACK
          SA1    EOP
          ZR     X1,RCT1     IF NOT END OF PFC
          EQ     RCTX        RETURN 
 SAC      SPACE  4,10 
**        SAC - SET PF ACTIVITY COUNT.
* 
*         ENTRY  (ACFL) = 0, IF PF ACTIVITY COUNT NOT SET.
*                         1, IF PF ACTIVITY COUNT ALREADY SET.
*                (MAEQ) = MASTER DEVICE EST ORDINAL.
* 
*         EXIT   (ACFL) = 1.
*                PFU CALLED TO SET PF ACTIVITY COUNT IF NOT 
*                ALREADY SET. 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
* 
*         MACROS CALLPFU, REPRIEVE. 
  
  
 SAC      SUBR               ENTRY/EXIT 
          SA1    ACFL 
          NZ     X1,SACX     IF PF ACTIVITY COUNT ALREADY SET 
          SA1    MAEQ        GET MASTER DEVICE EST ORDINAL
          SX6    ACFL        SET ACTIVITY COUNT FLAG ADDRESS
          LX1    59-11
          BX6    X1+X6       MERGE EST ORDINAL
          SA6    ACFT+FTPM
          REPRIEVE  /ERR/RPVB,SET,277B  SET REPRIEVE
          CALLPFU ACFT,CTIA,R  INCREMENT PF ACTIVITY COUNT
          EQ     SACX        RETURN 
  
*CALL     COMCCOD 
*CALL COMCPFU 
*CALL COMCRDO 
*CALL COMCRDW 
*CALL     COMCRSB 
          TITLE  WORKING STORAGE AND BUFFERS. 
*CALL     COMCSNM 
**        RESERVED LOCATIONS. 
* 
*T PDWD   42/0,6/0,12/ESTO
*         ESTO = EST ORDINAL OF A FAMILY DEVICE.
*         EQ = EST ORDINAL OF A FAMILY DEVICE.
  
 PDWD     BSS    1           PF DESCRIPTION WORD
 ACFL     CON    0           PF ACTIVITY FLAG 
 CCTR     BSS    1           CURRENT CATALOG TRACK
 CUI      BSS    1           CURRENT USER INDEX 
 DVFL     CON    0           ERROR IDLE/PF UTILITY ACTIVE FLAG
 EOP      CON    0           END OF PFC FLAG
 ESTA     BSS    1           RSB PARAMETER WORD FOR EST 
 FG       BSS    1           ADDRESS OF RETURN STATUS WORD
 FIST     VFD    60/5        FILE STATUS
 FM       BSS    1           FAMILY NAME
 MAEQ     BSS    1           MASTER DEVICE EST ORDINAL
 MORD     DATA   -1          CURRENT *MSTT* TABLE ENTRY ORDINAL 
 MSTA     BSS    1           RSB PARAMETER WORD FOR MST 
 NCTR     CON    0           NUMBER OF CATALOG TRACKS IN CURRENT DEVICE 
 PFC      BSS    1           ADDRESS OF BUFFER TO HOLD PFC ENTRIES
 SMSK     BSS    1           SUBFAMILY MASK 
 WCNT     BSS    1           WORD COUNT 
 WCNA     BSS    1           ADDRESS OF WORD TO RETURN WORD COUNT 
  
*         MSTT - TABLE OF MST INFORMATION.
* 
*         6/DN,12/EQ,22/,8/DM,12/NCTR 
* 
*         DN   = DEVICE NUMBER. 
*         EQ   = EST ORDINAL. 
*         DM   = DEVICE MASK. 
*         NCTR = NUMBER OF CATALOG TRACKS.
  
 MSTT     BSS    MSTTL       MST INFORMATION TABLE
  
*         FETS. 
  
 ACFT     FILEB  0,0,(FET=10)  FET TO CONTROL PF ACTIVITY COUNT 
 CATS     FILEB  CBUF,CBUFL,FET=10D 
  
*         BUFFERS.
  
 CBUF     BSS    CBUFL       CATALOG BUFFER 
 ESTB     BSS    ESMX*ESTE   EST BUFFER 
 MSTB     BSS    MSTN        MST BUFFER 
  
*         DISPLAYED MESSAGE CONSTANTS.
  
 MSGA     DATA   40C RDPFC - ERROR IDLE, DN //. 
 MSGB     DATA   40C RDPFC - PF UTILITY ACTIVE, DN //.
  
          QUAL   ERR
 ERR      SPACE  4,10 
**        ERR - ERROR INTERRUPT HANDLER.
* 
*         ENTRY  REPRIEVE SET.
*                PF ACTIVITY COUNT FLAG SET OR CLEAR. 
* 
*         EXIT   PF ACTIVITY COUNT FLAG CLEAR.
* 
*         CALLS  CAC. 
* 
*         MACROS REPRIEVE.
  
  
 ERR      BSS    0
          RJ     CAC         CLEAR PF ACTIVITY COUNT
 ERR1     REPRIEVE  RPVB,RESET,0
  
 QUAL$    SET    0
*CALL     COMCPFU 
*CALL     COMCSYS 
  
 RPVA     EQU    *-1         LWA TO CHECKSUM
  
*         REPRIEVE PARAMETER BLOCK. 
  
 RPVB     BSS    0
          VFD    36/0,12/RPVL,12/0
          VFD    30/RPVA,30/ERR 
          BSSZ   23 
 RPVL     EQU    *-RPVB      LENGTH OF REPRIEVE PARAMETER BLOCK 
          QUAL   *
  
          END 
          IDENT  SETPFP 
          ENTRY  SETPFP 
          SYSCOM B1 
          TITLE  SETPFP - SET PERMANENT FILE PARAMETERS.
*COMMENT   SET PERMANENT FILE PARAMETERS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL COMCMAC 
 SETPFP   SPACE  4,30 
***       SETPFP - SET PERMANENT FILE PARAMETERS. 
* 
*         SETPFP(ADDR);     (*SYMPL* CALL)
* 
*         ENTRY  (ADDR) = PARAMETER BLOCK WHICH HAS THE 
*                         FOLLOWING FORMAT -
*                         42/FAMILY NAME,14/,4/FG 
*                         42/PACKNAME,18/ 
*                         42/USER NUMBER,18/USER INDEX
*                         FG = FLAG BITS DENOTING WHICH FIELDS TO SET.
*                              BIT 3 - FAMILY NAME. 
*                              BIT 2 - PACKNAME.
*                              BIT 1 - USER NUMBER. 
*                              BIT 0 - USER INDEX.
* 
*         EXIT   PARAMETERS SET IN CONTROL POINT AREA IF FLAGGED. 
*                STATUS OF SPECIFIED FAMILY RETURNED AS FOLLOWS - 
*                42/FAMILY NAME,6/ST,8/0,4/FG 
*                ST = 0, IF FAMILY NAME SET IN CONTROL POINT AREA.
*                   = 1, IF SPECIFIED FAMILY WAS NOT FOUND (CURRENT 
*                        FAMILY REMAINS UNCHANGED). 
* 
*         USES   B - 1. 
* 
*         MACROS SETPFP.
  
  
 SETPFP   SUBR               ENTRY/EXIT 
          SB1    1
          SETPFP X1 
          EQ     SETPFPX     RETURN 
  
          END 
          IDENT  SFCALL 
          ENTRY  SFCALL 
          SYSCOM B1 
          TITLE  SFCALL - PRIVILEGED SYSTEM CALL FROM SUBSYSTEM.
*COMMENT PRIVILEGED SYSTEM CALL FROM SUBSYSTEM. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
  
*CALL     COMCMAC 
 SFCALL   SPACE  4,25 
***       SFCALL - PRIVILEGED SYSTEM CALL FROM SUBSYSTEM. 
* 
*         SFCALL(ADDR,R);   (*SYMPL* CALL)
* 
*         ENTRY  (ADDR) = ADDRESS OF TWO WORD PARAMETER BLOCK 
*                         WITH THE FOLLOWING FORMAT - 
*                         6/RC,12/FP,18/UCPA,18/SCPA,6/FC 
*                         36/SEQN,12/0,12/FSTA
*                         RC   = REPLY CODE.
*                         FP   = NUMBER OF ENTRIES IN THE LIST. 
*                         UCPA = ADDRESS WITHIN UCP.
*                         SCPA = FWA OF CONTIGUOUS PARAMETER LIST.
*                         FC   = FUNCTION CODE. 
*                (R)    = IF .NE. 0, RECALL IS REQUESTED. 
* 
*         EXIT   SFCALL ISSUED AND THE RESPONSE CODE
*                RETURNED IN THE *RC* FIELD OF THE
*                PARAMETER BLOCK. 
* 
*         USES   A - 2, 4.
*                B - 1. 
*                X - 2, 4.
* 
*         MACROS SFCALL.
  
  
 SFCALL   SUBR               ENTRY/EXIT 
          SB1    1
          SA2    A1+B1       GET RECALL PARAMETER 
          SA2    X2 
          SA4    X1          GET ADDRESS OF PARAMETER BLOCK 
          ZR     X2,SFC1     IF RECALL NOT REQUESTED
          SFCALL X4,R 
          EQ     SFCALLX     RETURN 
  
 SFC1     SFCALL X4 
          EQ     SFCALLX     RETURN 
  
          END 
