ENQUIRE 
          IDENT  ENQUIRE,STR,ENQUIRE
          ABS 
          SST 
          SYSCOM B1 
          ENTRY  ENQUIRE
          ENTRY  LENGTH 
          ENTRY  STATUS 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          ENTRY  SSM= 
          TITLE  ENQUIRE - ENQUIRE PROCESSOR. 
          SPACE  4,10 
*COMMENT  ENQUIRE - ENQUIRE ABOUT JOB STATUS. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
****      ENQUIRE - PROVIDE JOB STATUS. 
*         L. CLINTON         74/01/23.
*         D. D. SADLER       75/02/18.
          SPACE  4,10 
***       COMMAND FORMATS.
* 
*         ENQUIRE(O=LFN1,FN=LFN2,OP=X)
*         ENQUIRE(JSN=AAAA,O=LFN1)
*         ENQUIRE(JSN,O=LFN1) 
*         ENQUIRE(UJN=BBBBBBB,O=LFN1) 
*         ENQUIRE(UJN,O=LFN1) 
*         ENQUIRE.  -  SAME AS ENQUIRE(OP=A). 
* 
*         LENGTH(LFN2)  -  SAME AS ENQUIRE(FN=LFN2).
* 
*         STATUS(...)  -  SAME AS ENQUIRE(...). 
*         STATUS.  -  SAME AS ENQUIRE.
* 
*         PARAMETERS ARE ORDER-INDEPENDENT, AND ABSENCE OF
*         A KEYWORD IMPLIES *OP*. 
* 
*         LFN1 = OUTPUT FILE NAME. DEFAULT IS *OUTPUT*. 
* 
*         LFN2 = USER-S FILE NAME TO SEARCH FOR.
* 
*         AAAA = JOB SEQUENCE NUMBER (JSN) TO SEARCH FOR. 
* 
*         BBBBBBB = USER JOB NAME (UJN) TO SEARCH FOR.
* 
*         FOR THE *FN*, *JSN*, AND *UJN* PARAMETERS, WHEN THE 
*         SPECIFIED FILE OR JOB IS NOT FOUND, AN INFORMATIVE
*         MESSAGE IS WRITTEN TO THE OUTPUT FILE IF IT IS
*         ASSIGNED TO A TERMINAL.  OTHERWISE THE MESSAGE IS 
*         WRITTEN TO THE USER-S DAYFILE.
* 
*         X = STRING OF CONCATENATED OPTION LETTERS SPECIFYING OPTIONS
*             TO BE EXECUTED.  THE MAXIMUM NUMBER OF LETTERS IN THE 
*             STRING IS 7.  ENQUIRY INFORMATION IS RETURNED TO THE
*             OUTPUT FILE.
* 
*         THE POSSIBLE OPTION LETTERS ARE-
*         A = SELECTION OF ALL OPTIONS. 
*         B = ENQUIRY INFORMATION GIVES USER IDENTIFICATION 
*             AND HIS PRIORITIES. 
*         D = ENQUIRY INFORMATION GIVES RESOURCE DEMAND AND 
*             ASSIGNED COUNTS.
*         F = ENQUIRY INFORMATION IS IN SAME FORMAT AS THAT GIVEN 
*             BY *FN* PARAMETER, BUT FOR ALL USER-S WORKING FILES.
*             NOTE - LENGTH VALUE DISPLAYED FOR EACH FILE 
*             IS RELEVANT ONLY FOR MASS STORAGE FILES.
*         J = ENQUIRY INFORMATION GIVES CONTENTS OF USER-S
*             CONTROL REGISTERS AND ERROR FLAG REGISTER.
*         L = ENQUIRY INFORMATION GIVES LOADER INFORMATION, 
*             AND CONSISTS OF USER-S MAP OPTIONS AND GLOBAL 
*             LIBRARY SET.
*         R = ENQUIRY INFORMATION GIVES AMOUNT OF RESOURCES 
*             USER HAS USED.
*         S = ENQUIRY INFORMATION GIVES USER-S CURRENT SRU VALUE. 
*         T = ENQUIRY INFORMATION GIVES USER-S CURRENT CP TIME VALUE. 
*         U = ENQUIRY INFORMATION GIVES RESOURCE USAGE ALLOWED
*             USER, AND CONSISTS OF NUMBER OF DAYFILE MESSAGES, 
*             JOB STEP TIME AND SRU LIMITS, ACCOUNT BLOCK SRU LIMIT,
*             COMMANDS, DISPOSED FILES, AND MASS STORAGE
*             SPACE ALLOWED.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * ARGUMENT ERRORS.* = *ENQUIRE* CALL WAS NOT VALID. 
* 
*         * ENQUIRE ABORTED.* = *ENQUIRE* HAS BEEN ABORTED AS A RESULT
*         OF A SYSTEM ERROR.
* 
*         * ENQUIRY COMPLETE.* = INFORMATIVE MESSAGE INDICATING THAT
*         THE ENQUIRY HAS COMPLETED.
* 
*         * FILE NOT FOUND.* = REQUESTED FILE COULD NOT BE FOUND. 
* 
*         * INCORRECT OPTION  X.* = OPTION *X* IS NOT DEFINED IN
*         *ENQUIRE*.
* 
*         * INCORRECT QUEUE TYPE.* = *ENQUIRE* WAS ABORTED DUE TO AN
*         INCORRECT QUEUE TYPE ERROR CODE RETURNED BY *QAC* ON A
*         PEEK REQUEST. 
* 
*         * NO JOBS FOUND.* = NO JOBS WERE FOUND FOR THE USER.
* 
*         * NNNNNNN NOT FOUND.* = THE SPECIFIED JSN (JSN=NNNN)
*         OR UJN (UJN=NNNNNNN) WAS NOT FOUND. 
* 
*         * QAC ERROR ENCOUNTERED.* = *ENQUIRE* WAS ABORTED DUE TO AN 
*         UNEXPECTED ERROR CODE RETURNED BY *QAC*.
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCMD 
*CALL     COMCMAC 
*CALL     COMSEJT 
*CALL     COMSJIO 
*CALL     COMSLFD 
*CALL     COMSMLS 
*CALL     COMSPFM 
*CALL     COMSQAC 
*CALL     COMSREM 
*CALL     COMSRSX 
*CALL     COMSSCD 
*CALL     COMSSFM 
*CALL     COMSSSJ 
          TITLE  MACRO DEFINITION.
          SPACE  4,15 
**        INDEX - INDEX TABLE ENTRY GENERATION. 
* 
*         INDEX GENERATES TABLES WHICH ARE TO BE INDEXED BY VALUES
*         WHICH MAY CHANGE DUE TO ASSEMBLY MODES OR OPTIONS.
* 
*         INDEX  NAME,IND,ADD 
* 
*         ENTRY  *NAME* = NAME OF TABLE ENTRY.
*                *IND* = INDEX AT WHICH ENTRY IS TO BE PLACED.
*                *ADD* = ADDRESS FIELD OF ENTRY GENERATION INSTRUCTION. 
  
  
          PURGMAC  INDEX
  
          MACRO  INDEX,NAME,IND,ADD 
          IFC    NE,*NAME** 
 NAME     CON    0
 .1       SET    NAME 
          BSSZ   IND-1
          ELSE
          ORG    .1+IND 
          IFC    NE,*ADD**,2
          LOC    IND
          CON    ADD
          BSS    0
          ENDIF 
 INDEX    ENDM
          SPACE  4,10 
**        LDEF - LINE DEFINITION ENTRY GENERATION.
* 
*         LDEF   WO,CL
* 
*         ENTRY  WO = WORD OFFSET INTO STRING BUFFER. 
*                CL = NUMBER OF CHARACTERS TO ENTER INTO STRING BUFFER. 
* 
*T        24/0, 18/WO, 18/CL
  
  
          PURGMAC  LDEF 
  
 LDEF     MACRO  WO,CL
          VFD    24/0,18/WO,18/CL 
 LDEF     ENDM
          SPACE  4,10 
**        TABLE - GENERATE TABLE ENTRY. 
* 
*         TABLE  A,B
* 
*         ENTRY  A = NUMERIC VALUE. 
*                B = NUMERIC VALUE. 
* 
*T        18/A, 24/0, 18/B
  
  
          PURGMAC  TABLE
  
 TABLE    MACRO  A,B
          VFD    18/A,24/0,18/B 
 TABLE    ENDM
          TITLE  PROGRAM CONSTANTS. 
          SPACE  4,10 
**        PROGRAM CONSTANTS.
  
  
          ORG    110B 
 STR      BSS    0
  
*         SSJ CONTROL.
  
 SSJ=     EQU    SSJD        SSJ= PRIVILEGES ONLY AND DROP FILES
  
*         BUFFER PARAMETERS.
  
 FBUFL    EQU    1+2*MXLF+1  *GETFNT*/COMMAND BUFFER LENGTH 
 OBUFL    EQU    201B        OUTPUT BUFFER LENGTH 
 LBUFL    EQU    25          LIBRARY BUFFER LENGTH
 RBUFL    EQU    300B        REPLY BUFFER LENGTH
 USBBL    EQU    92          UNPACK STRING BUFFER LENGTH
 USBL$    EQU    1           VARIABLE LENGTH OPTION FOR UNPACK BUFFER 
 WBUFL    EQU    10B         WORKING BUFFER LENGTH
 NCST     EQU    10B         COMMAND COUNT
 NUMQ     EQU    6           NUMBER OF QUEUE TYPES
  
 TBUFL    MAX    LBUFL,RBUFL,WBUFL  SCRATCH BUFFER LENGTH 
  
*         PRINTER CONTROL CHARACTERS. 
  
 PAGE     DATA   1L1         PAGE EJECT 
 TRPL     DATA   1L-         TRIPLE SPACE 
          SPACE  4,10 
*         STATUS MESSAGES.
  
 INQM     DATA   L*INPUT QUEUE  * 
 PRQM     DATA   L*PRINT QUEUE  * 
 PHQM     DATA   L*PUNCH QUEUE  * 
 PLQM     DATA   L*PLOT QUEUE   * 
 WTQM     DATA   L*WAIT QUEUE   * 
 PRSM     DATA   L*ROLLED       * 
 EXSM     DATA   L*EXECUTING    * 
 ROSM     DATA   L*ROLLED       * 
 SISM     DATA   L*SCP ROLLIN   * 
 SOSM     DATA   L*SCP ROLLOUT  * 
 TOSM     DATA   L*T/E ROLLOUT  * 
 IOSM     DATA   L*ROLLED       * 
 DOSM     DATA   L*IDLE         * 
 SUSM     DATA   L*SUSP  XXX MIN* 
 PCSM     DATA   L*PCP ROLLOUT  * 
 ERSM     DATA   L*ROLLOUT ERROR* 
 SWSM     DATA   L*SERVICE WAIT * 
          SPACE  4,10 
*         ERROR MESSAGES. 
  
 EMSA     DATA   L* ENQUIRE ABORTED.* 
 EMSB     DATA   L* INCORRECT QUEUE TYPE. * 
 EMSC     DATA   L* NO JOBS FOUND.* 
 EMSD     DATA   L*         NOT FOUND.  * 
 EMSE     DATA   L* QAC ERROR ENCOUNTERED.* 
 EMSF     DATA   L* ENQUIRY COMPLETE.*
 FETS     SPACE  4,10 
*         FETS. 
  
 O        BSS    0
 OUTPUT   FILEB  OBUF,OBUFL,FET=9   OUTPUT
  
 F        BSS    0
 FILEFET  RFILEB FBUF,FBUFL,FET=9  *GETFNT*/COMMAND FILE
          SPACE  4,10 
**        *QAC* PARAMETER BLOCK.
  
 BQAC     VFD    50/0,9/PKFC,1/0   REQUEST PREFIX PORTION 
          VFD    36/0,6/11,18/RBUF
          VFD    42/0,18/RBUF 
          VFD    42/0,18/RBUF 
          VFD    42/0,18/RBUF+RBUFL 
 BQSC     VFD    60/0              SELECTION CRITERIA PORTION 
          VFD    60/0 
          VFD    24/0,24/DLSF,12/ZPSF 
          VFD    12/77B,48/0
          VFD    18/0,18/3R***,24/0 
          VFD    60/0 
          VFD    60/0 
 BQPF     VFD    60/-0             PEEK FUNCTION PORTION
          VFD    12/-0,48/0 
          VFD    60/0 
          VFD    60/0 
  
*         PEEK INFORMATION BITS.
  
 PIUJ     BSS    0           UJN PARAMETERS 
          VFD    36/0 
          VFD    12/LDPB+M2PB+M1PB+ESPB 
          VFD    12/UJPB+FUPB+OTPB+JSPB 
 PIJS     BSS    0           JSN PARAMETERS 
          VFD    36/0 
          VFD    12/LDPB+ESPB 
          VFD    12/FUPB+OTPB+JSPB
 PIEJ     BSS    0           EQUIVALENCED JSN PARAMETERS
          VFD    24/0 
          VFD    12/ALPB
          VFD    12/LDPB+CSPB+DYPB+ASPB+SLPB+M2PB+M1PB+ESPB+FLPB
          VFD    12/UJPB+FUPB+UNPB+PRPB+OTPB+JSPB 
          SPACE  4,10 
**        RSB CONTROL WORDS.
  
  
*         CALL BLOCK TO READ CONTROL POINT AREA.
  
 STAT1    VFD    12/0,12/100B,18/0,18/BUFF
          VFD    24/0,18/1,18/0 
  
 STAT2    VFD    12/0,12/100B,18/0,18/BUFF+100B 
          VFD    24/0,18/1,18/100B
          SPACE  4,10 
**        MISCELLANEOUS CONTROL WORDS.
  
  
*         GETFNT CONTROL WORD.
  
 GFNT     VFD    12/MXLF,6/0,18/0,2/0,1/1,1/1,1/1,1/0,18/FBUF 
  
*         GETGLS CONTROL WORD.
  
 GGLS     VFD    6/0,18/LBUF+3,36/0 
  
*         GET PRIMARY FILE CONTROL. 
  
 PRIM     DECMIC PTFT 
 GPRM     VFD    12/1,24/1S"PRIM",2/0,1/1,3/5,18/FBUF 
          SPACE  4,10 
**        CONSTANTS.
  
  
 ACAT     CON    0           ACCESS CATEGORIES
 ALVL     CON    0           ACCESS LEVEL 
 FT       CON    1           FILE TYPE (PRESET AS NON-TERMINAL TYPE)
 FCT      CON    0           FILE COUNT 
 JSNM     CON    0           JOB SEQUENCE NUMBER
 LCT      CON    0           LINE COUNT 
 LLM      CON    0           LINE LIMIT 
 JPPW     BSS    2           JOB PAGE PARAMETER WORD
 MXLC     EQU    10          MAXIMUM LINE COUNT 
 MXLL     EQU    92          MAXIMUM LINE LENGTH (CHARACTERS) 
 OPAL     CON    0           EXECUTION FLAG WORD
 MLPY     CON    0.0001P48+1 SRU CONSTANT (=.0001)
 NASV     VFD    6/77B,54/0  NEGATIVE (INCORRECT) ASSUMED VALUE 
 SSFL     CON    0           SECURE SYSTEM FLAG 
 CSFP     BSSZ   1           COMMAND FILE POSITION
 UESC     VFD    1/1,59/0    USER EM SHIFT COUNT
  
*         MULTIPLIER TO CONVERT QUARTER-NANOSECONDS TO MILLISECONDS.
  
 OPA      DATA   0.25E-6
  
*         PARAMETER ENTRY TABLE.
  
 TAGS     CON    0           OPTION 
          CON    0           OUTPUT FILE NAME 
          CON    0           FILE NAME TO SEARCH FOR
          CON    0           JSN PARAMETER VALUE
          CON    0           UJN PARAMETER VALUE
  
*         OPTION TABLE. 
  
 OPNS     VFD    6/0LA,36/0,18/0
          VFD    6/0LB,36/0,18/OPB
          VFD    6/0LD,36/0,18/OPD
          VFD    6/0LR,36/0,18/OPR
          VFD    6/0LU,36/0,18/OPU
          VFD    6/0LJ,36/0,18/OPJ
          VFD    6/0LL,36/0,18/OPL
          VFD    6/0LF,36/0,18/OPF
          VFD    6/0LT,36/0,18/OPT
          VFD    6/0LS,36/0,18/OPS
          VFD    60/0 
  
*         EXECUTION BIT MASK FOR OPTION TABLE.
  
 EBIT     DATA   00000000000077000000B
          SPACE  4,10 
**        SUB-SYSTEM TABLE. 
  
  
 SSTB     INDEX  MSYS 
          INDEX  NULS,(0L"NULS".) 
          INDEX  BASS,(0L"BASS".) 
          INDEX  FORS,(0L"FORS".) 
          INDEX  FTNS,(0L"FTNS".) 
          INDEX  EXES,(0L"EXES".) 
          INDEX  BATS,(0L"BATS".) 
          INDEX  ACCS,(0L"ACCS".) 
          INDEX  MSYS 
          SPACE  4,10 
**        EXTERNAL CHARACTERISTICS TABLES.
  
  
*         EXTERNAL CHARACTERISTICS QUEUE TYPE TABLE.
  
 QTEC     BSS    0
          TABLE  PRQQ,PREC
          TABLE  PHQQ,PHEC
          TABLE  PLQQ,PLEC
          CON    0
  
*         PRINT QUEUE EXTERNAL CHARACTERISTICS EQUIVALENCES TABLE.
  
 PREC     INDEX  7
          INDEX  DFEX,(5L     ) 
          INDEX  A4EX,(5LA4   ) 
          INDEX  B4EX,(5LB4   ) 
          INDEX  B6EX,(5LB6   ) 
          INDEX  A6EX,(5LA6   ) 
          INDEX  A9EX,(5LA9   ) 
          INDEX  7
  
*         PUNCH QUEUE EXTERNAL CHARACTERISTICS EQUIVALENCES TABLE.
  
 PHEC     INDEX  7
          INDEX  DFFR,(5L     ) 
          INDEX  PBFR,(5LSB   ) 
          INDEX  P8FR,(5L80COL) 
          INDEX  PHFR,(5LO26  ) 
          INDEX  P9FR,(5LO29  ) 
          INDEX  ASFR,(5LASCII) 
          INDEX  7
  
*         PLOT QUEUE EXTERNAL CHARACTERISTICS EQUIVALENCES TABLE. 
  
 PLEC     INDEX  3
          INDEX  T6EX,(5LT6   ) 
          INDEX  T8EX,(5LT8   ) 
          INDEX  3
 FLST     SPACE  4,10 
**        STATUS TABLE (LAST OPERATION IS PRESET AS *READ*).
  
  
 FLST     BSS    0
          DATA   H* I/C      *
          DATA   H* EOR      *
          DATA   H* EOF      *
          DATA   H* EOI      *
          DATA   H* BOI      *
 FLTY     SPACE  4,10 
**        FILE TYPE TABLE.
* 
*T,FLTY   VFD    12/DCFT,42/ADDR
*         DCFT = DISPLAY CODED FILE TYPE. 
*         ADDR = MESSAGE ADDRESS. 
  
  
 FLTY     INDEX  MXFT 
          INDEX  INFT,(3LIN.)      INPUT
          INDEX  ROFT,(3LRO.)      ROLLOUT
          INDEX  QFFT,(3LQF.)      QUEUED 
          INDEX  SYFT,(3LSY.)      SYSTEM 
          INDEX  LOFT,(3LLO.)      LOCAL
          INDEX  LIFT,(3LLI.)      LIBRARY
          INDEX  PTFT,(3LPT.)      PRIMARY TERMINAL 
          INDEX  PMFT,(3LPM.)      DIRECT ACCES PERMANENT 
          INDEX  FAFT,(3LFA.)      FAST ATTACH
          INDEX  MXFT 
 FSTT     SPACE  4,10 
**        FILE STATUS TABLE.
* 
*T,FSTT   24/DCFS,36/0
*         DCFS = DISPLAY CODED FILE STATUS. 
  
  
 FSTT     INDEX  MXST 
          INDEX  0,(4L    ) 
          INDEX  UPST,(4L UP )
          INDEX  SSST,(4L SS )
          INDEX  CBST,(4L CB )
          INDEX  CKST,(4L CK )
          INDEX  SOST,(4L SO )
          INDEX  AAST,(4L AA )
          INDEX  NDST,(4L NAD)
          INDEX  MXST 
 QTST     SPACE  4,10 
**        QUEUE TYPE STATUS TABLE.
  
QTST      BSS    0
          TABLE  INQQ,INQM
          TABLE  EXQQ,0 
          TABLE  PRQQ,PRQM
          TABLE  PHQQ,PHQM
          TABLE  PLQQ,PLQM
          TABLE  WTQQ,WTQM
          CON    0
 CNST     SPACE  4,10 
**        EXECUTING JOB CONNECTION STATUS.
  
 CNST     INDEX  MXCS 
          INDEX  NICS,(2LNI) NOT INTERACTIVE
          INDEX  DTCS,(2LDT) DETACHED 
          INDEX  OLCS,(2LON) ON-LINE
          INDEX  MXCS 
 EJST     SPACE  4,10 
**        EJT STATUS TABLE. 
  
 EJST     INDEX  MXJS 
          INDEX  PRJS,PRSM
          INDEX  EXJS,EXSM
          INDEX  ROJS,ROSM
          INDEX  SIJS,SISM
          INDEX  SOJS,SOSM
          INDEX  TOJS,TOSM
          INDEX  IOJS,IOSM
          INDEX  DOJS,DOSM
          INDEX  SUJS,SUSM
          INDEX  PCJS,PCSM
          INDEX  ERJS,ERSM
          INDEX  SWJS,SWSM
          INDEX  MXJS 
          SPACE  4,10 
**        LINE DEFINITION TABLES. 
* 
*         THE LINE DEFINITION TABLES DEFINE THE WORD OFFSET INTO
*         A STRING BUFFER AND THE NUMBER OF CHARACTERS TO ENTER 
*         INTO THE BUFFER FOR DATA TO BE WRITTEN TO THE OUTPUT
*         FILE.  THIS DEFINES THE FORMAT OF THE OUTPUT LINES. 
  
  
*         UJN OUTPUT LINE.
  
 L1UL     LDEF   00,70       LINE 1 SKELETON
 JSUL     LDEF   01,04       JSN
 SCUL     LDEF   06,01       SERVICE CLASS
 CNUL     LDEF   08,02       CONNECTION STATUS
 DSUL     LDEF   11,02       DESTINATION ROUTING
 LIUL     LDEF   14,03       LID
 UJUL     LDEF   18,07       UJN
 STUL     LDEF   27,13       STATUS 
 EMUL     LDEF   42,30       EXECUTING MESSAGE
  
*         JSN OUTPUT LINES. 
* 
*         *JSJL*, *SCJL* AND *STJL* ARE USED TO DEFINE THE FORMAT 
*         OF OUTPUT LINES WHEN INFORMATION ABOUT A SPECIFIC JOB 
*         IS REQUESTED (JSN PARAMETER EQUIVALENCED), AND ALSO WHEN
*         INFORMATION ABOUT ALL JOBS OWNED BY A USER IS REQUESTED 
*         (JSN PARAMETER UNEQUIVALENCED). 
  
 L1JL     LDEF   00,69       LINE 1 SKELETON
 JSJL     LDEF   01,04       JSN, COLUMN 1
          LDEF   40,04       JSN, COLUMN 2
 SCJL     LDEF   06,01       SERVICE CLASS, COLUMN 1
          LDEF   45,01       SERVICE CLASS, COLUMN 2
 CNJL     LDEF   08,02       CONNECTION STATUS, COLUMN 1
          LDEF   47,02       CONNECTION STATUS, COLUMN 2
 DSJL     LDEF   11,02       DESTINATION ROUTING, COLUMN 1
          LDEF   50,02       DESTINATION ROUTING, COLUMN 2
 LIJL     LDEF   14,03       LID, COLUMN 1
          LDEF   53,03       LID, COLUMN 2
 STJL     LDEF   18,13       STATUS, COLUMN 1 
          LDEF   57,13       STATUS, COLUMN 2 
 UJJL     LDEF   46,07       UJN
 ALJL     LDEF   62,07       ACCESS LEVEL 
  
 L2JL     LDEF   00,70       LINE 2 SKELETON
 SUJL     LDEF   06,10       SRU ACCUMULATOR
 SLJL     LDEF   29,08       SRU LIMIT
 CFJL     LDEF   46,06       CM FL
 EFJL     LDEF   62,07       EXTENDED MEMORY FL 
  
 L3JL     LDEF   00,56       LINE 3 SKELETON
 PLJL     LDEF   12,08       PRU LENGTH 
 DCJL     LDEF   26,02       DISPOSITION CODE 
 FCJL     LDEF   34,02       FORMS CODE 
 IDJL     LDEF   42,02       DESTINATION BATCH DEVICE ID
 ECJL     LDEF   50,05       EXTERNAL CHARACTERISTICS 
          TITLE  MAIN LOOP. 
**        MAIN PROGRAM. 
  
  
 MAIN     BSS    0
          SYSTEM RSB,R,STAT1 READ FIRST  100B WORDS OF CPA
          SYSTEM RSB,R,STAT2 READ SECOND 100B WORDS OF CPA
  
 MAIN1    SA5    OPNS+1      OPTION TABLE 
          SA4    EBIT        EXECUTION BIT MASK 
 MAIN2    ZR     X5,MAIN5    IF END OF OPTION TABLE 
          BX6    X4*X5       CHECK FOR EXECUTION BIT
          NZ     X6,MAIN3    IF OPTION TO BE EXECUTED 
          SA5    A5+1        CHECK NEXT OPTION
          EQ     MAIN2
  
 MAIN3    SA2    FT          FILE TYPE
          ZR     X2,MAIN4    IF TERMINAL FILE 
          SB3    X5 
          SA1    OPF
          SB2    A1 
          SB3    B3-B2
          ZR     B3,MAIN4    IF OP=F OPTION TO BE EXECUTED
          WRITEW OUTPUT,PAGE,B1  PAGE EJECT 
          SA2    TRPL        TRIPLE SPACE 
          BX6    X2 
          SA6    PAGE        SET TRIPLE SPACE 
          SA4    EBIT        RESET MASK FOR NEXT OPTION 
 MAIN4    SB2    X5          PICK UP PROCESSOR ADDRESS
          BX6    -X4*X5      CLEAR EXECUTION BIT
          SA6    A5 
          JP     B2 
  
*         PROCESS JSN.
  
 MAIN5    SA5    TAGS+3 
          ZR     X5,MAIN5.2  IF JSN NOT SPECIFIED 
          MX0    24 
          BX5    X0*X5
          ZR     X5,MAIN5.1  IF UNEQUIVALENCED JSN PARAMETER SPECIFIED
          MX0    -42
          BX1    -X0*X5 
          NZ     X1,MAIN5.0  IF FOUR-CHARACTER JSN
          SX0    1R          APPEND SPACE 
          LX0    36-0 
          BX5    X5+X0
 MAIN5.0  RJ     PEJ         LIST STATUS OF SPECIFIED JSN 
          EQ     MAIN7       COMPLETE ENQUIRY 
  
 MAIN5.1  RJ     PJS         LIST STATUS OF ALL JSN-S 
          EQ     MAIN7       COMPLETE ENQUIRY 
  
*         PROCESS UJN.
  
 MAIN5.2  SA5    TAGS+4 
          ZR     X5,MAIN6    IF UJN NOT SPECIFIED 
          RJ     PUJ         LIST STATUS OF JOBS BY UJN 
          EQ     MAIN7       COMPLETE ENQUIRY 
  
*         PROCESS FILENAME. 
  
 MAIN6    SA1    TAGS+2      CHECK FILENAME 
          ZR     X1,MAIN7    IF NO FILENAME 
          JP     FNA
  
 MAIN7    SA1    O+2         CHECK FOR NO OUTPUT
          SA2    A1+B1
          BX6    X1-X2
          ZR     X6,MAIN8    IF NO OUTPUT 
          WRITER OUTPUT 
 MAIN8    SA1    FT 
          ZR     X1,MAIN9    IF TERMINAL FILE 
          MESSAGE  EMSF,3    * ENQUIRY COMPLETE.* 
 MAIN9    ENDRUN
 FNA      TITLE  FN OPTION. 
**        THE *FN=FILENAME* FUNCTION RETURNS THE STATUS OF THE
*         FILE SPECIFIED BY THE USER. THE *FN=FILENAME* FUNCTION IS 
*         EXECUTED ONLY IF THE *OP=F* OPTION IS NOT SPECIFIED.
*         THE FOLLOWING INFORMATION IS GIVEN FOR THE SPECIFIED FILE 
*         *FILENAME* *LENGTH/PRUS* *TYPE* *STATUS* *FS* *LEVEL*.
  
  
 FNA      MX0    42 
          MX7    0           CLEAR FIRST WORD OF BUFFER 
          SA7    FBUF 
 FNA0     SA2    GFNT        STATUS WORD TO RETURN FILES
          BX6    X2 
          SA6    FILEFET+8
          GETFNT FILEFET
          SA5    FBUF-1      INITIALIZE FILE NAME SEARCH
          SA1    TAGS+2      FILE NAME
 FNA1     SA5    A5+2 
          ZR     X5,FNA3     IF END OF FNTS 
          BX3    X0*X5
          BX3    X3-X1
          NZ     X3,FNA1     IF NO MATCH
          SA1    FT          TERMINAL FILE CONSTANT 
          ZR     X1,FNA2     IF TERMINAL FILE 
          WRITEW OUTPUT,PAGE,B1  CARRIAGE CONTROL 
 FNA2     WRITEW OUTPUT,FOP,FOPA
          RJ     LST         LIST FILE
          EQ     MAIN7       RETURN 
  
 FNA3     SA4    FBUF        BUFFER CONTROL WORD
          NZ     X4,FNA0     IF MORE FILES TO GET 
          SA2    =L* FILE NOT FOUND.* 
          SX1    B0+
          RJ     ISM         ISSUE MESSAGE
          EQ     MAIN7       RETURN 
 OPB      TITLE  B OPTION.
**        THE *OP=B* OPTION RETURNS TO THE USER INFORMATION THAT IS 
*         READ FROM HIS CONTROL POINT AREA. INFORMATION SUCH AS 
*         USER NAME, USER INDEX, USER PRIORITIES IS RETURNED TO 
*         THE CALLER. THE USER PRIMARY FILENAME IS RETURNED IF
*         HE HAS ONE AND THE SUBSYSTEM HE IS USING.INFORMATION
*         ABOUT THE USER FIELD LENGTH, FAMILY AND PACK NAME IS
*         GIVEN.  IF SECURE SYSTEM, INFORMATION ABOUT SECURITY
*         ACCESS LEVELS AND ACCESS CATEGORIES IS ALSO GIVEN.
  
  
  
*         PROCESS PRIORITIES. 
  
 OPB      BSS    0           ENTRY
          SA5    BUFF+CWQW   GET CPU PRIORITY 
          AX5    51 
          MX3    -7 
          BX1    -X3*X5      CPU PRIORITY 
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          MX0    12 
          BX6    X0*X4
          SA6    BOCP+2 
  
*         PROCESS FAMILY NAME AND PACK NAME, IF ANY.
  
          GETPFP WBUF        GET PERMANENT FILE INFORMATION 
          SA1    WBUF 
          MX0    42 
          BX6    X0*X1
          ZR     X6,OPB1     IF NO FAMILY NAME
          SA6    BOFM+2 
 OPB1     SA1    A1+B1
          BX6    X0*X1
          ZR     X6,OPB1.1   IF NO PACK NAME IN CPA 
          SA6    BOPN+2      SET PACK NAME
          BX6    -X0*X1 
          LX6    42 
          SA6    BOPN+5      SET PACK TYPE
          NZ     X6,OPB2     IF PACK TYPE SPECIFIED IN CPA
 OPB1.1   SYSTEM RSB,R,OPBC  READ PFNL WORD 
          SA1    OPBD        GET SYSTEM DEFAULT PACK TYPE 
          MX6    18 
          BX6    X6*X1
          SA6    BOPN+5      SET PACK TYPE
  
*         PROCESS USER NAME AND USER INDEX. 
  
 OPB2     SA5    BUFF+UIDW   USER NAME
          MX4    -18
          BX6    X4*X5
          SA6    BOUN+2 
  
*         PROCESS HASH CODE AND JOB SEQUENCE NAME.
  
          MX4    -17
          BX7    -X4*X5 
          RJ     CIH         COMPUTE USER INDEX HASH
          SA7    BOUH+2 
          GETJN  BOJS+2      GET JSN
  
*         PROCESS CHARGE AND PROJECT NUMBER.
  
          GETCN  WBUF        GET CHARGE NUMBER INFORMATION
          SA1    WBUF        SET CHARGE NUMBER
          ZR     X1,OPB2.1   IF NO CHARGE NUMBER
          RJ     SFN         SPACE FILL NAME
          SA6    BOCN+2 
          SA1    WBUF+1      SET PROJECT NUMBER 
          ZR     X1,OPB2.1   IF NO PROJECT NUMBER 
          RJ     SFN         SPACE FILL NAME
          SA6    BOPJ+2 
          SA1    WBUF+2 
          RJ     SFN         SPACE FILL NAME
          SA6    BOPJ+3 
  
*         PROCESS PRIMARY FILE. 
  
 OPB2.1   SA1    GPRM        SET OPTIONS FOR GETFNT 
          BX6    X1 
          MX7    0           CLEAR BUFFER CONTROL WORD
          SA7    FBUF 
          SA6    FILEFET+8   GETFNT STATUS WORD 
          GETFNT FILEFET     GET PRIMARY FILE NAME
          MX6    0           CLEAR STATUS WORD
          SA6    FILEFET+8
          SA2    FBUF+1 
          MX0    42 
          BX1    X0*X2
          ZR     X1,OPB3     IF NO PRIMARY FILE 
          RJ     SFN         SPACE FILL NAME
          SA6    BOPF+2 
          SA2    A2+1 
          LX2    59-8 
          PL     X2,OPB3     IF FILE ACCESSIBLE 
          SA2    OPBB 
          BX6    X2 
          SA6    BOPF+3 
  
*         PROCESS SUBSYSTEM.
  
 OPB3     SA2    BUFF+TXSW   TELEX SUBSYSTEM WORD 
          MX0    -6 
          LX2    6
          BX1    -X0*X2      SUB-SYSTEM TABLE INDEX 
          SB3    X1-MSYS
          PL     B3,OPB4     IF INCORRECT SUB-SYSTEM
          SA1    SSTB+X1     SUB-SYSTEM TABLE 
          BX6    X1 
          SA6    BOSU+2 
  
*         PROCESS FIELD LENGTH. 
  
 OPB4     SA3    UESC        GET USER EM SHIFT COUNT
          SA5    BUFF+ELCW   EXTENDED MEMORY STATUS WORD
          MX0    -12
          SB5    X3+9 
          LX5    12          CONVERT EXTENDED MEMORY MFL
          BX1    -X0*X5 
          LX1    B5 
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          BX6    X0*X4
          SA6    BOME+2 
          LX5    12          CONVERT LAST EXTENDED MEMORY FIELD LENGTH
          BX1    -X0*X5 
          LX1    B5 
          RJ     COD
          BX6    X0*X4
          SA6    BOLE+2 
          SA5    BUFF+FLCW   CM MEMORY CONTROL WORD 
          LX5    12          CONVERT CM MFL 
          BX1    -X0*X5 
          LX1    6           BLOCKS * 100 
          RJ     COD
          BX6    X0*X4
          SA6    BOMF+2 
          LX5    12          CONVERT CM LAST FIELD LENGTH 
          BX1    -X0*X5 
          LX1    6           BLOCKS * 100 
          RJ     COD
          BX6    X0*X4
          SA6    BOLF+2 
  
*         PROCESS JOB ACCESS LEVELS IF SECURE SYSTEM. 
  
          SA1    SSFL 
          ZR     X1,OPB8     IF NON-SECURE SYSTEM 
          GETJAL ALVL        GET JOB ACCESS LEVELS
          SA1    ALVL        GET CURRENT JOB ACCESS LEVEL 
          MX0    -3 
          BX2    -X0*X1 
          SA2    TALV+X2
          MX3    42 
          BX6    X2*X3
          SA6    BOAL+2 
          AX1    6           GET JOB ACCESS LEVEL UPPER LIMIT 
          BX2    -X0*X1 
          SA2    TALV+X2
          BX6    X2*X3
          SA6    BOUL+2 
          AX1    6           GET JOB ACCESS LEVEL LOWER LIMIT 
          BX2    -X0*X1 
          SA2    TALV+X2
          BX6    X2*X3
          SA6    BOLL+2 
  
*         PROCESS JOB ACCESS CATEGORIES IF SECURE SYSTEM. 
  
          GETUSV ACAT        GET JOB ACCESS CATEGORIES
          SA4    ACAT 
          SB3    32          NUMBER OF CATEGORIES TO CHECK
          SB4    B0          INDEX INTO TABLE OF CATEGORY NAMES 
          SB5    B1          POINTER FOR STORING CATEGORY NAME
          SB6    6           COUNT OF WORDS TO BE SPACE FILLED
 OPB5     LX4    -1 
          PL     X4,OPB7     IF CATEGORY NOT SET
          SA2    TACT+B4     GET CATEGORY NAME
          MX0    42 
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          LX6    -18
          SA6    BOAC+B5     SAVE CATEGORY NAME 
          SB6    B6-B1
          SA1    OPBA        INCREMENT PRINTED LINE COUNT 
          SX6    X1+B1
          SA6    A1 
          PL     B6,OPB6     IF COUNT NOT TO BE RESET 
          SB6    6
          SB5    B5+B1       WRITE END-OF-LINE
          BX6    X6-X6
          SA6    BOAC+B5
          SA1    OPBA        INCREMENT PRINTED LINE COUNT 
          SX6    X1+B1
          SA6    A1 
 OPB6     SB5    B5+B1
 OPB7     SB4    B4+B1
          SB3    B3-B1
          NZ     B3,OPB5     IF MORE CATEGORIES TO CHECK
          SA1    OPBA        GET LINE COUNT 
          WRITEW OUTPUT,BOP,X1
          EQ     MAIN1       RETURN 
  
 OPB8     WRITEW OUTPUT,BOP,BOPL
          EQ     MAIN1       RETURN 
  
 OPBA     CON    BLLL        PRINTED LINE COUNT 
 OPBB     DATA   10L*INACCESS*  FILE NOT ACCESSIBLE STATUS
 OPBC     VFD    12/0,12/1,18/PFNL,18/OPBD  PFNL READ CONTROL 
 OPBD     VFD    1/1,59/0    PFNL CODE
  
  
  
*         *OUTPUT FORMAT FOR B-OPTION*
  
 BOP      DATA   0
          DATA   L* SYSTEM ACTIVITY.* 
          DATA   0
 BOUN     DATA   20H   USER NAME
          DATA   0
 BOUH     DATA   20H   USER INDEX HASH
          DATA   0
 BOJS     DATA   20H   JOB SEQ. NAME
          DATA   0
 BOFM     DATA   20H   FAMILY 
          DATA   8L*NONE*.
 BOCN     DATA   20H   CHARGE NUMBER
          DATA   10H*NONE*. 
          DATA   0
 BOPJ     DATA   20H   PROJECT NUMBER 
          DATA   20H*NONE*. 
          DATA   0
 BOPN     DATA   20H   PACK NAME
          DATA   8L*NONE*.
          DATA   20H   PACK TYPE
          VFD    18/DFPT,42/0 
 BOPF     DATA   20H   PRIMARY FILE 
          DATA   10L*NONE*. 
          DATA   10L
          DATA   0
 BOSU     DATA   20H   SUBSYSTEM
          DATA   0
 BOCP     DATA   20H   CPU PRIORITY 
          DATA   0
 BOMF     DATA   20H   MAX FL (CM)
          DATA   0
 BOME     DATA   20H   MAX FL (EM)
          DATA   0
 BOLF     DATA   20H   LAST FL (CM) 
          DATA   0
 BOLE     DATA   20H   LAST FL (EM) 
          DATA   0
 BOPL     EQU    *-BOP
          DATA   0
          DATA   C*   JOB SECURITY ACCESS LEVELS* 
          DATA   0
 BOAL     DATA   20H   CURRENT
          DATA   0
 BOLL     DATA   20H   LOWER LIMIT
          DATA   0
 BOUL     DATA   20H   UPPER LIMIT
          DATA   0
          DATA   0
          DATA   C*   JOB SECURITY ACCESS CATEGORIES* 
 BOAC     DATA   0
          DATA   10H   *NONE*.
          DATA   0
 BLLL     EQU    *-BOP       INITIAL OUTPUT LENGTH
          DUP    39,1 
          DATA   0
 OPD      TITLE  D OPTION.
**        THE OP = D OPTION RETURNS TO THE USER THE RESOURCE
*         DEMAND AND ASSIGNED COUNTS FROM THE USER DEMAND FILE
*         ENTRY.
  
  
 OPD      WRITEW OUTPUT,FOD,FODA  HEADER
  
*         SET CORRECT DEMAND FILE NAME. 
  
          SA1    BUFF+RFCW
          MX0    -18
          BX6    -X0*X1 
          ZR     X6,OPD7     IF NO DEMAND FILE ENTRY
          SYSTEM RSB,R,OPDA  READ MMFL WORD 
          SA1    OPDC        SET CORRECT DEMAND FILE NAME 
          MX0    12 
          BX3    X0*X1
          SA2    OPDB 
          LX0    -24
          BX2    -X0*X2 
          LX3    -24
          BX6    X3+X2
          SA6    A2+
          ATTACH FILEFET,OPDB,,,RM,,,DF,FA
          SA1    BUFF+RFCW  CHECK DEMAND FILE INDEX 
          MX0    -18
          BX6    -X0*X1 
          SA6    FILEFET+6
          READ   X2,R        READ DEMAND FILE ENTRY 
          SA5    FBUF+RVAL   CHECK FOR TOTAL DEMAND = TOTAL ASSIGN = 0
          MX2    -24
          BX2    -X2*X5 
          ZR     X2,OPD7     IF NO ASSIGNS/DEMANDS
          SA5    FBUF+RMTP   GET FIRST MAGNETIC TAPE ENTRY WORD 
  
*         FORMAT LINE.
  
 OPD1     MX2    12          GET RESOURCE IDENTIFIER
          BX1    X2*X5
          SX3    A5-FBUF-RRPP 
          NG     X3,OPD2     IF MAGNETIC TAPE ENTRY 
          SX2    1R1         ENTER REMOVABLE PACK UNIT COUNT
          LX2    -18
          BX1    X1+X2
 OPD2     RJ     SFN         BLANK FILL RESOURCE IDENTIFIER 
          LX6    -24
          SA6    FODB 
          LX5    12 
          SX3    A5-FBUF-RRPP 
          PL     X3,OPD3     IF REMOVABLE PACK ENTRY
  
*         ADD THE ASSIGNED AND DEMAND COUNTS FOR ALL ACCESS LEVELS
*         OF MAGNETIC TAPE RESOURCE ENTRY.  PRINT NON-ZERO COUNTS.
  
          BX1    X1-X1       INITIALIZE TOTAL ASSIGNED COUNT
          BX3    X3-X3       INITIALIZE TOTAL DEMAND COUNT
          SB2    B1+         INITIALIZE ENTRY WORD COUNT
 OPD2.1   SB3    3           INITIALIZE BYTE COUNT
 OPD2.2   MX2    -6          GET ASSIGNED COUNT 
          LX5    6
          BX0    -X2*X5 
          IX1    X0+X1       ADD COUNT TO TOTAL COUNT 
          LX5    6           GET DEMAND COUNT 
          BX2    -X2*X5 
          IX3    X2+X3       ADD COUNT TO TOTAL COUNT 
          SB3    B3-B1
          PL     B3,OPD2.2   IF NOT END OF ENTRY WORD 
          SB2    B2-B1
          NG     B2,OPD2.3   IF END OF SECOND ENTRY WORD
          SA5    A5+B1       READ SECOND ENTRY WORD 
          LX5    12 
          EQ     OPD2.1      RESET BYTE COUNT 
  
 OPD2.3   BX0    X1+X3
          BX5    X3 
          ZR     X0,OPD6     IF NO ASSIGNED/DEMAND COUNTS 
          EQ     OPD3.1      CONVERT ASSIGNED COUNT 
  
*         GET ASSIGNED/DEMAND COUNTS FOR REMOVABLE PACK ENTRIES.
  
 OPD3     MX2    -6          GET ASSIGNED COUNT 
          LX5    6
          BX1    -X2*X5 
          MX3    -12         CHECK FOR ZERO ASSIGNED AND DEMAND COUNTS
          LX5    6
          BX3    -X3*X5 
          ZR     X3,OPD4     IF NO ASSIGNED/DEMAND COUNTS 
 OPD3.1   RJ     CDD         CONVERT ASSIGNED COUNT 
          LX6    18 
          MX2    -6 
          SA6    FODB+2 
          BX1    -X2*X5      GET DEMAND COUNT 
          RJ     CDD         CONVERT DEMAND COUNT 
          LX6    18 
          SA6    A6-B1
          WRITEW OUTPUT,FODB,FODL 
 OPD4     SX3    A5-FBUF-RRPP 
          NG     X3,OPD6     IF MAGNETIC TAPE ENTRY 
          SX2    B1          INCREMENT REMOVABLE PACK UNIT COUNT
          SA1    FODB 
          LX2    18 
          SB2    X0+B1
          IX6    X1+X2
          SB3    X0-RPEW
          SB2    A0-B2
          SA6    A1 
          NZ     B3,OPD5     IF NOT END OF FIRST ENTRY WORD 
          SA5    A5+B1
          LX5    12 
 OPD5     SX0    X0+1 
          PL     B2,OPD3     IF MORE COUNTS TO PROCESS IN ENTRY 
          PL     B3,OPD6     IF SECOND ENTRY WORD PROCESSED 
          SA5    A5+1 
 OPD6     SA5    A5+1 
          SX2    A5-FBUF-RREQ 
          SX3    A5-FBUF-RRPP 
          ZR     X2,OPD8     IF END OF RESOURCE ENTRIES 
          NG     X3,OPD1     IF MAGNETIC TAPE ENTRY 
          ZR     X5,OPD8     IF END OF RESOURCE ENTRIES 
          SA1    A5+B1       GET MAXIMUM UNIT COUNT 
          UX1    X1,B2
          SA0    B2 
          SX0    B1          RESET UNIT COUNT 
          EQ     OPD1        CONTINUE PROCESSING ENTRIES
  
 OPD7     WRITEW OUTPUT,FODC,FODD 
  
 OPD8     RETURN FILEFET,R
          EQ     MAIN1       RETURN 
  
 OPDA     VFD    12/0,12/1,18/MMFL,18/OPDC  MMFL READ CONTROL 
 OPDB     VFD    60/0LRSXD   DEMAND FILE NAME 
 OPDC     VFD    1/1,59/0    MMFL CODE
  
  
*         OUTPUT FORMAT FOR OP = D. 
  
  
 FOD      DATA   0
          DATA   L* RESOURCE DEMAND INFORMATION.   *
          DATA   0
          DATA   L*  RESOURCE   DEMAND   ASSIGNED  *
          DATA   0
 FODA     EQU    *-FOD
 FODB     DATA   C*                               * 
 FODL     EQU    *-FODB 
 FODC     DATA   C*  NONE.* 
 FODD     EQU    *-FODC 
 OPF      TITLE  F OPTION.
**        THE *OP=F* OPTION RETURNS TO THE USER THE FOLLOWING 
*         INFORMATION ABOUT EACH OF HIS FILES- *FILENAME* 
*         *LENGTH/PRUS* *TYPE* *STATUS* *FS* *LEVEL*. 
  
  
 OPF      BSS    0           ENTRY
          BX6    X6-X6       PRECLUDE FN PARAMETER PROCESSING 
          SA6    TAGS+2 
          MX7    0           CLEAR BUFFER CONTROL WORD
          SA7    FBUF 
          SA1    GFNT        SET GETFNT CONTROL WORD IN FET+8 
          BX6    X1 
          SA6    FILEFET+8
          GETFNT FILEFET     GET FILES
          BX6    X6-X6       CLEAR STATUS WORD
          SA6    FILEFET+8
  
*         SORT FNT ENTRIES INTO ASCENDING ORDER.
  
          SX7    B0          COUNT NUMBER OF ENTRIES TO SORT
          SA1    FBUF+1 
 OPF1     SX7    X7+B1
          SA1    A1+2 
          NZ     X1,OPF1     IF MORE ENTRIES TO COUNT 
          SA7    FCT         SAVE FILE COUNT
          SB2    B0          SORT FNT ENTRIES 
          SB3    B0 
          SB4    B1 
          SB5    B1+B1
          SB6    X7 
          SB7    FBUF+1 
          MX0    42 
          RJ     GMS
          SA5    FBUF+1      SET ADDRESS OF FIRST ENTRY TO LIST 
  
*         OUTPUT PAGE EJECT AND/OR PAGE HEADER. 
  
 OPF2     SA1    FT 
          ZR     X1,OPF3     IF OUTPUT ASSIGNED TO TERMINAL 
          WRITEW OUTPUT,PAGE,B1  PAGE EJECT 
 OPF3     WRITEW OUTPUT,FOP,FOPA  PAGE HEADER 
  
*         LIST FNT ENTRY. 
  
 OPF4     ZR     X5,OPF5     IF END OF BUFFER 
          RJ     LST         LIST FILE
  
*         CHECK FOR FULL PAGE.
  
          SA5    A5+1        NEXT FILE IN BUFFER
          SA1    LCT         LINE COUNT 
          SX6    X1+B1
          SA6    A1 
          SA2    LLM         GET LINE LIMIT 
          IX1    X1-X2
          SX7    X1+6 
          NZ     X7,OPF4     IF NOT END OF PAGE 
          SA7    A1          CLEAR LINE COUNT 
          EQ     OPF2        OUTPUT PAGE EJECT AND/OR PAGE HEADER 
  
*         WRITE FILE COUNT MESSAGE AND EXIT.
  
 OPF5     SA1    FCT         FILE COUNT 
          RJ     CDD         CONVERT TO DISPLAY 
          MX0    24 
          BX6    X0*X4
          SA6    FOPD+1      TOTAL FILE COUNT 
          WRITEW OUTPUT,FOPC,FOLL 
          EQ     MAIN1       RETURN 
  
  
*         OUTPUT FORMAT FOR OP = F. 
  
  
 FOP      DATA   0
          DATA   L* LOCAL FILE INFORMATION.*
          DATA   0
          DATA   L*  FILENAME  LENGTH/PRUS  TYPE  STATUS    FS  LEVEL*
          DATA   0
 FOPA     EQU    *-FOP
 FOPB     DATA   L*                                                    *
 FOPL     EQU    *-FOPB 
 FOPC     DATA   0
 FOPD     DATA   10H  TOTAL = 
          DATA   0
 FOLL     EQU    *-FOPC 
 OPJ      TITLE  J OPTION.
**        OP=*J* RETURNS TO THE USER THE CONTENTS OF HIS CONTROL
*         REGISTERS AND THE CONTENTS OF ERROR FLAG FIELD. 
*         THE NEXT COMMAND FROM THE BUFFER IS GIVEN ALSO. 
  
  
*         PROCESS PSEUDO REGISTERS. 
  
 OPJ      SA5    BUFF+JCRW   JOB CONTROL WORD 
          LX5    6
          MX0    -6          ERROR FLAG 
          BX1    -X0*X5 
          RJ     COD         CONVERT TO DISPLAY CODE
          MX0    42 
          BX6    X0*X4
          SA6    JOPE+1 
          LX5    18          R3 
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO SIGNED DISPLAY CODE 
          SA6    JOPD+1 
          LX5    18          R2 
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO SIGNED DISPLAY CODE 
          SA6    JOPC+1 
          LX5    18          R1 
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO SIGNED DISPLAY CODE 
          SA6    JOPB+1 
          SA5    BUFF+JCDW   *CCL* JOB CONTROL WORD 
          LX5    6           GLOBAL ERROR FLAG
          MX0    -6 
          BX1    -X0*X5 
          RJ     COD         CONVERT TO DISPLAY CODE
          MX0    42 
          BX6    X0*X4
          SA6    JOPF+1 
          LX5    18          R1G
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO SIGNED DISPLAY CODE 
          SA6    JOPG+1 
          SA5    JPPW        GET JOB PAGE PARAMETERS
          MX0    -8 
          AX5    12          POSITION FOR *PW*
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO DISPLAY 
          SA6    JOPH+1      PAGE WIDTH 
          AX5    8           POSITION FOR *PS*
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO DISPLAY 
          SA6    JOPI+1      PAGE SIZE
          MX0    -4 
          AX5    8           POSITION FOR *PD*
          BX1    -X0*X5 
          RJ     CSD         CONVERT TO DISPLAY CODE
          SA6    JOPJ+1      PAGE DENSITY 
          WRITEW O,JOP,JOPL 
  
*         PROCESSING NEXT COMMAND.
  
          SA3    F+1         SET FET EMPTY
          MX0    -30
          SX6    X3 
          SA6    A3+B1
          SX5    NCST        NUMBER OF COMMANDS 
          SA6    A6+B1
          ACCSF  F,CSFP,L    ATTACH COMMAND FILE
          SA4    CSFP 
          BX7    -X0*X4 
          AX7    6
          SA7    F+6         RANDOM ADDRESS 
          READ   F,R
          MX0    -6 
          BX6    -X0*X4 
          SA3    F+3         UPDATE *OUT* POINTER 
          IX6    X3+X6
          SA6    A3 
 OPJ1     READC  F,WBUF,WBUFL 
          NZ     X1,OPJ2     IF *EOR* 
          SB2    WBUF 
          SB6    USBBL
          RJ     USB         UNSTRING COMMAND 
          SB7    B7-WBUF2+1 
          WRITES O,WBUF2,B7 
          SX5    X5-1        DECREMENT COUNTER
          NZ     X5,OPJ1     IF NOT END OF COMMANDS 
          EQ     OPJ3        RETURN FILE AND EXIT 
  
 OPJ2     WRITEC O,OPJB      WRITE *EOR* LINE 
 OPJ3     RETURN F
          EQ     MAIN1       RETURN 
  
  
 OPJA     CON    0           COMMAND COUNT
  
 OPJB     DATA   C/   *EOR*/
  
  
*         OUTPUT FORMAT FOR OP = J. 
  
 JOP      DATA   0
 JOPA     DATA   L* JOB CONTROL REGISTERS.* 
          DATA   0
 JOPB     DATA   C*   R1 =    * 
 JOPC     DATA   C*   R2 =    * 
 JOPD     DATA   C*   R3 =    * 
 JOPE     DATA   C*   EF =    * 
 JOPF     DATA   C*  EFG =    * 
 JOPG     DATA   C*  R1G =    * 
          DATA   0
          DATA   C* JOB PAGE PARAMETERS.* 
          DATA   0
 JOPH     DATA   C*   PW =    * 
 JOPI     DATA   C*   PS =    * 
 JOPJ     DATA   C*   PD =    * 
          DATA   0
 JOPK     DATA   L* PENDING COMMANDS.*
          DATA   0
 JOPL     EQU    *-JOP
 OPL      TITLE  L OPTION.
**        *OP=L* GIVES THE USER LOADER INFORMATION THAT CONSISTS OF 
*         MAP OPTIONS, DEBUG MODE AND GLOBAL LIBRARY SET
*         CURRENTLY IN EFFECT.
  
  
 OPL      SA1    BUFF+LB1W   MAP OPTIONS IN EFFECT
          PL     X1,OPL2.1   IF SYSTEM DEFAULT
          LX1    59-57       POSITION MAP OPTION FIELD TO LEFT
          MX0    4           MAP OPTION FIELD WIDTH 
          BX1    X0*X1
          ZR     X1,OPL8     IF MAP *OFF* 
          BX2    -X0+X1 
          ZR     X2,OPL3     IF *FULL* MAP
          SA2    OPLA 
          BX2    X1-X2
          ZR     X2,OPL4     IF MAP *ON*
          SA2    OPLB 
          BX2    X1-X2
          ZR     X2,OPL5     IF *PARTIAL* MAP 
  
          SA2    =L*XEBS*    FETCH POSSIBLE MAP OPTIONS 
          SB2    4           INITIALIZE MAP OPTIONS COUNTER 
          BX6    X6-X6       PRESET RESULT REGISTER 
          MX0    6
 OPL1     PL     X1,OPL2     IF OPTION NOT SET
          BX3    X0*X2       ADD CHARACTER TO RESULT REGISTER 
          LX6    -6 
          BX6    X3+X6
 OPL2     SB2    B2-B1       DECREMENT MAP OPTIONS COUNTER
          ZR     B2,OPL7     IF NO MORE MAP OPTIONS TO CONSIDER 
          LX1    1
          LX2    6
          EQ     OPL1        LOOP 
  
 OPL2.1   SA1    =L*DEFAULT*
          EQ     OPL6        SET DEFAULT MAP OPTION 
  
 OPL3     SA1    =L*FULL* 
          EQ     OPL6 
  
 OPL4     SA1    =L*ON* 
          EQ     OPL6 
  
 OPL5     SA1    =L*PARTIAL*
  
 OPL6     BX6    X1 
 OPL7     SA6    OPLD        UPDATE MAP OPTIONS ASSEMBLY AREA 
 OPL8     WRITEW OUTPUT,OPLC,OPLE 
  
*         PROCESS INTERACTIVE DEBUG.
  
          SA1    BUFF+LB1W   CHECK DEBUG STATUS 
          SB6    OPLH        *DEBUG = OFF*
          LX1    59-35
          PL     X1,OPL8.1   IF DEBUG = OFF 
          SB6    OPLI        *DEBUG = ON* 
 OPL8.1   WRITEC O,B6        WRITE DEBUG STATUS 
  
*         PROCESS GLOBAL LIBRARY SET. 
  
          MOVE   4,OPLG,LBUF HEADER (PRESET EMPTY)
          GETGLS GGLS        GET GLOBAL LIBRARY SET 
          SB3    4           PRESET NUMBER OF WORDS TO WRITE
          SA1    GGLS        LWA OF LIST + 1
          AX1    36 
          SB2    X1-LBUF-3
          ZR     B2,OPL11    IF EMPTY LIST
          SB3    B3-B1
          SB4    X1 
          SB5    B3          INITIALIZE NAMES PER LINE COUNTER
          MX0    48 
          MX5    42 
          SA1    LBUF+3 
 OPL9     BX1    X1*X5
          RJ     SFN         SPACE FILL NAME
          LX6    -6 
          SB5    B5-B1       DECREMENT NAMES PER LINE COUNTER 
          NZ     B5,OPL10    IF NOT THIRD NAME ON LINE
          SB5    3           RE-INITIALIZE NAMES PER LINE COUNTER 
          BX6    X0*X6       SET END-OF-LINE
 OPL10    SA6    A1 
          SA1    A1+B1
          SB3    B3+B1       INCREMENT NUMBER OF WORD TO WRITE
          SB2    A1-B4
          NZ     B2,OPL9     IF NOT END OF LIST 
          BX6    X0*X6       SET END-OF-LINE
          SA6    A6 
 OPL11    WRITEW OUTPUT,LBUF,B3 
          JP     MAIN1       RETURN 
  
 OPLA     VFD    4/7,56/0    MAP *ON* MASK
 OPLB     VFD    4/3,56/0    *PARTIAL* MAP MASK 
  
*         MAP OPTIONS ASSEMBLY AREA.
  
 OPLC     DATA   0           BLANK LINE 
          DATA   L* LOADER INFORMATION. * 
          DATA   H*    MAP OPTIONS  = * 
 OPLD     DATA   L*OFF*      PRESET AS *OFF*
 OPLE     EQU    *-OPLC      LENGTH OF MAP OPTIONS ASSEMBLY AREA
  
 OPLG     DATA   L*    GLOBAL LIBRARY SET IS - *
          DATA   L* EMPTY.* 
  
 OPLH     DATA   L*    DEBUG = OFF* 
 OPLI     DATA   L*    DEBUG = ON*
 OPR      TITLE  R OPTION.
**        THE *OP=R* OPTION RETURNS TO THE USER HIS ACCUMULATED 
*         RESOURCES.  THESE INCLUDE SRU UNITS, CP, IO AND 
*         ADDER ACCUMULATORS. 
  
  
 OPR      SA1    BUFF+CPTW   CPU TIME 
          PX1    X1          CONVERT TO MILLISECONDS
          SA2    OPA
          NX1    X1 
          RX2    X2*X1
          UX1,B4 X2 
          LX1    B4 
          RJ     CFD         CONVERT TO F10.3 FORMAT
          SA6    ROPB+2 
          SA5    BUFF+IOAW   IO ACCUMULATORS
          MX0    -20
          LX5    20          MS ACCUMULATOR 
          BX1    -X0*X5 
          RJ     CFD
          SA6    ROPC+2 
          LX5    20          MT ACCUMULATOR 
          BX1    -X0*X5 
          RJ     CFD
          SA6    ROPD+2 
          LX5    20          PF ACCUMULATOR 
          BX1    -X0*X5 
          RJ     CFD
          SA6    ROPE+2 
          SA2    BUFF+ADAW   ADDER ACCUMULATOR
          BX1    -X0*X2      ADDER ACCUMULATOR
          RJ     CFD
          SA6    ROPF+2 
          SA2    BUFF+AUCW   AUC ACCUMULATOR
          MX0    -29
          BX1    -X0*X2 
          RJ     CFD
          SA6    ROPG+2 
          SA2    BUFF+SRUW   SRU ACCUMULATOR
          RJ     CSR         CONVERT SRU ACCUMULATOR
          SA6    ROPH+2 
          WRITEW OUTPUT,ROP,ROPL
          EQ     MAIN1       RETURN 
  
  
*         OUTPUT FORMAT FOR OP = R. 
  
 ROP      DATA   0
 ROPA     DATA   L* RESOURCES USED.*
          DATA   0
 ROPB     DATA   30H   CPU TIME 
          DATA   6L SECS. 
 ROPC     DATA   30H   MS ACTIVITY
          DATA   6L KUNS. 
 ROPD     DATA   30H   MT ACTIVITY
          DATA   6L KUNS. 
 ROPE     DATA   30H   PF ACTIVITY
          DATA   6L KUNS. 
 ROPF     DATA   30H   ADDER
          DATA   6L KUNS. 
 ROPG     DATA   30H   AUC ACTIVITY 
          DATA   6L UNTS. 
 ROPH     DATA   30H   SRU
          DATA   6L UNTS. 
 ROPL     EQU    *-ROP
 OPS      TITLE  S OPTION.
**        THE *OP=S* OPTION RETURNS TO THE USER HIS SRU UNIT. 
*         THIS UNIT REPRESENTS THE TOTAL USAGE OF THE SYSTEM
*         BY THE USER.
  
  
 OPS      BSS    0           ENTRY
          SA2    BUFF+SRUW   SRU ACCUMULATOR
          RJ     CSR         CONVERT SRU ACCUMULATOR
          SA6    SOPB+1 
          WRITEW OUTPUT,SOP,SOPL
          EQ     MAIN1       RETURN 
  
  
*         OUTPUT FORMAT FOR OP = S. 
  
 SOP      DATA   0
 SOPA     DATA   L* SRU ACCUMULATOR.* 
          DATA   0
 SOPB     DATA   20H   SRU
          DATA   6L UNTS. 
 SOPL     EQU    *-SOP
 OPT      TITLE  T OPTION.
**        OP=*T* RETURNS TO THE USER HIS CP TIME. 
* 
  
  
  
 OPT      SA1    BUFF+CPTW   CP TIME
          PX1    X1          CONVERT TO MILLISECONDS
          SA2    OPA
          NX1    X1 
          RX2    X2*X1
          UX1,B4 X2 
          LX1    B4 
          RJ     CFD         CONVERT TO F10.3 FORMAT
          SA6    TOPA+1      STORE CP TIME
          WRITEW OUTPUT,TOP,TOPL
          EQ     MAIN1       RETURN 
  
  
*         OUTPUT FORMAT FOR OP = T. 
  
 TOP      DATA   0
          DATA   L* CPU ACCUMULATOR.* 
          DATA   0
 TOPA     DATA   20H  CPU TIME
          DATA   6L SECS. 
 TOPL     EQU    *-TOP
 OPU      TITLE  U OPTION.
**        OP = *U* GIVES THE USER THE AMOUNT OF RESOURCE USAGE
*         ALLOWED TO HIS JOB.  THESE RESOURCES INCLUDE SYSTEM 
*         RESOURCE UNITS ALLOWED FOR EACH JOB STEP AND ACCOUNT
*         BLOCK, JOB STEP TIME LIMIT, AND MAXIMUM NUMBER OF DISPOSE 
*         FILES, MASS STORAGE PRUS, DAYFILE MESSAGES AND CONTROL
*         COMMANDS. 
  
  
 OPU      SA5    BUFF+CPJW   JOB STEP TIME LIMIT
          MX0    -15
          LX0    17-14
          LX5    30 
          RJ     CLM         CONVERT
          SA7    UOPF+2 
          SA5    BUFF+SRJW   JOB STEP SRU LIMIT 
          LX5    30 
          RJ     CLM         CONVERT
          SA7    UOPG+2 
          SA5    BUFF+STLW   ACCOUNT BLOCK SRU LIMIT
          LX5    18 
          RJ     CLM         CONVERT
          SA7    UOPH+2 
          SA5    BUFF+ACLW   PICK UP ACCOUNTING LIMITS WORD 
          MX0    -12
          LX5    24          DAYFILE MESSAGES COUNT 
          RJ     CLM         CONVERT
          SA7    UOPB+2 
          LX5    12          COMMAND COUNT
          RJ     CLM         CONVERT
          SA7    UOPC+2 
          MX0    -15
          LX0    17-14
          LX5    24          MASS STORAGE PRUS
          RJ     CLM
          SA7    UOPE+2 
          WRITEW OUTPUT,UOP,UOPL
          EQ     MAIN1
  
  
*         OUTPUT FORMAT FOR OP = U. 
  
 UOP      DATA   0
 UOPA     DATA   L* RESOURCE USAGE ALLOWED.*
          DATA   0
 UOPF     DATA   20H   SECONDS
          DATA   0
 UOPG     DATA   20H   JOB STEP SRU 
          DATA   0
 UOPH     DATA   20H   ACCOUNT BLK SRU
          DATA   0
 UOPB     DATA   20H   DAYFILE MESSAGES 
          DATA   0
 UOPC     DATA   20H   COMMANDS 
          DATA   0
 UOPE     DATA   20H   MASS STORAGE 
          DATA   0
 UOPL     EQU    *-UOP
          TITLE  JSN= OPTION. 
 PEJ      SPACE  4,10 
**        PEJ - PROCESS EQUIVALENCED JSN PARAMETER. 
* 
*         ENTRY  (X5) = JSN PARAMETER VALUE.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 4, 6, 7.
* 
*         CALLS  CDD, COD, CSR, ESB, GCS, GDR, GJS, GSC, IPR, SFN,
*                WCL, WML.
* 
*         MACROS WRITES, WRITEW.
* 
*         EXAMPLE OF EXECUTING JOB -
* 
*         1         2         3         4         5         6         7 
* 234567890123456789012345678901234567890123456789012345678901234567890 
* 
* ABFB.T.ON.BC.M90.T/E ROLLOUT             UJN=MYJOBAA   LEVEL=LVL0 
* SRUS=    22.057.  SRU LIMIT=NO LIMIT.  CM FL= 47500.  ECS FL=   1000. 
* LABEL,TAPE,VSN=TEROLL,D=PE.  (MS1W MESSAGE) 
* WAITING FOR TAPE/PACK MOUNT.  (MS2W MESSAGE)
* 
* DAYFILE=
*  (MAXIMUM OF 10 LINES OF DAYFILE) 
* 
* NEXT COMMANDS=
*  (MAXIMUM OF 10 LINES OF COMMANDS)
* 
*         EXAMPLE OF JOBS IN THE INPUT, PRINT, PLOT, PUNCH
*         OR WAIT QUEUE - 
* 
*         1         2         3         4         5         6         7 
* 234567890123456789012345678901234567890123456789012345678901234567890 
* 
* ADAE.B.  .BC.M90.PRINT QUEUE             UJN=MYJOBAA   LEVEL=LVL0 
* PRU LENGTH=      47.  DC=LT.  FC=  .  ID=05.  EC=A9   . 
  
  
 PEJ      SUBR               ENTRY/EXIT 
          SA3    PIEJ        SET PEEK INFORMATION BITS
          BX7    X3 
          BX6    X5          SAVE JSN 
          SA6    JSNM 
          SA7    BQPF+2 
          SA1    BQSC+2      SET JSN SELECTION CRITERIA 
          SX2    JSSF        SET JSN SELECTION BIT
          BX1    X1+X5       SET JSN
          BX6    X1+X2
          SA6    A1+
          RJ     IPR         ISSUE *QAC* PEEK REQUEST 
          NZ     X1,PEJX     IF JOB NOT FOUND 
  
*         FORMAT LINE 1.
  
          SA1    PEJF        WRITE SKELETON LINE
          SB7    L1JL 
          BX6    X1 
          RJ     ESB
          SA1    RBUF        GET REPLY ENTRY FWA
          MX0    24          SET JSN
          BX1    X0*X1
          RJ     SFN
          SB6    A1+
          SB7    JSJL 
          RJ     ESB
          RJ     GSC         SET SERVICE CLASS
          SB7    SCJL 
          RJ     ESB
          SA1    B6+7 
          RJ     GCS         GET CONNECTION STATUS
          SB7    CNJL 
          RJ     ESB
          SA1    B6+4        GET DESTINATION ROUTING
          RJ     GDR
          SB7    DSJL 
          RJ     ESB
          SA1    BQPF+1      GET LID
          MX0    -12
          BX1    -X0*X1 
          SB3    X1-2 
          SA1    B6+B3       SET LID
          MX0    18 
          LX1    6
          BX1    X0*X1
          RJ     SFN
          SB7    LIJL 
          RJ     ESB
          SB4    7           SET JOB STATUS 
          RJ     GJS
          SB7    STJL 
          RJ     ESB
          SA1    B6+5        SET UJN
          MX0    42 
          BX1    X0*X1
          RJ     SFN
          SB7    UJJL 
          RJ     ESB
          SA1    SSFL 
          NZ     X1,PEJ0.1   IF SECURE SYSTEM 
          SA1    L1JL        DO NOT DISPLAY ACCESS LEVEL
          SX6    X1-16
          SA6    A1 
          EQ     PEJ0.2      OUTPUT DATA
  
 PEJ0.1   SA1    BQPF+1      GET ACCESS LEVEL 
          MX0    -12
          BX1    -X0*X1 
          SB3    X1-1 
          SA1    B6+B3
          AX1    12 
          MX0    -3 
          BX1    -X0*X1 
          SA1    TALV+X1     SET ACCESS LEVEL 
          MX0    42 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SB7    ALJL 
          RJ     ESB
 PEJ0.2   WRITEW OUTPUT,PAGE,B1 
          SA1    L1JL        GET CHARACTER COUNT
          SB7    X1+
          WRITES OUTPUT,USBB,B7 
          SA1    RBUF        CHECK QUEUE TYPE 
          MX0    -12
          LX1    -12
          BX6    -X0*X1 
          SX2    X6-EXQQ
          SA6    PEJA        SAVE QUEUE TYPE
          NZ     X2,PEJ1     IF NOT EXECUTING QUEUE 
  
*         FORMAT OUTPUT LINES FOR EXECUTING JOB.
  
          SB6    RBUF        RESET REPLY ENTRY FWA
          SA1    PEJB        WRITE SKELETON LINE
          BX6    X1 
          SB7    L2JL 
          RJ     ESB
          SA2    B6+19
          LX2    -18
          RJ     CSR         CONVERT SRU ACCUMULATOR
          SB7    SUJL 
          RJ     ESB
          SA2    B6+18       SET SRU LIMIT
          LX2    -18
          RJ     CSR         CONVERT SRU LIMIT
          SB7    SLJL 
          RJ     ESB
          SA5    B6+2        GET CM FL/100B 
          LX5    0-24 
          MX0    -12
          BX1    -X0*X5 
          LX1    6           MULTIPLY BY 100B 
          RJ     COD
          SB7    CFJL        SET CM FL
          LX6    24          USE LOWER 6 CHARACTERS 
          RJ     ESB
          LX5    0-36-0+24   GET EXTENDED MEMORY FL/1000B 
          MX0    -12
          BX1    -X0*X5 
          LX1    9           MULTIPLY BY 1000B
          RJ     COD
          LX6    18          USE LOWER 7 CHARACTERS 
          SB7    EFJL        SET EXTENDED MEMORY FL 
          RJ     ESB
          SA1    L2JL        GET CHARACTER COUNT
          SB7    X1+
          WRITES OUTPUT,USBB,B7 
          SA2    RBUF+8      WRITE *MS1W* 
          RJ     WML
          SA2    RBUF+14     WRITE *MS2W* 
          RJ     WML
          SA1    RBUF+20     WRITE DAYFILE BUFFER 
          MX7    -12
          LX1    -12
          SX0    A1+1        FWA OF DATA
          BX2    -X7*X1      REPLY UNIT WORD COUNT - 1
          LX1    -12
          BX5    -X7*X1      DATA WORD COUNT
          IX6    X0+X2       SAVE LWA+1 OF REPLY UNIT 
          SA6    PEJG 
          ZR     X5,PEJ0     IF NO DATA 
          WRITEW OUTPUT,PEJC,PEJCL  WRITE DAYFILE TITLE LINE
          SB6    X0 
          SB7    B0          WRITE LAST 10 DAYFILE MESSAGES 
          RJ     WCL
 PEJ0     SA2    PEJG        WRITE COMMAND BUFFER 
          SA1    X2 
          MX7    -12
          SX0    A1+1        FWA OF DATA
          LX1    -24
          BX5    -X7*X1      DATA WORD COUNT
          ZR     X5,PEJX     IF NO DATA 
          WRITEW OUTPUT,PEJD,PEJDL  WRITE COMMAND TITLE LINE
          SB6    X0 
          SB7    B1          WRITE FIRST 10 COMMANDS
          RJ     WCL
          EQ     PEJX        RETURN 
  
*         FORMAT OUTPUT LINE FOR JOB IN THE INPUT, PRINT, PLOT, 
*         PUNCH OR WAIT QUEUE.
  
 PEJ1     SA1    PEJE        WRITE SKELETON LINE
          SB7    L3JL 
          BX6    X1 
          RJ     ESB
          SB6    RBUF 
          SA1    B6+6        SET FILE LENGTH
          MX0    -24
          LX1    24 
          SB7    PLJL 
          BX1    -X0*X1 
          RJ     CDD
          LX6    12          USE LOWER 8 CHARACTERS 
          RJ     ESB
          SA5    B6+B1       SET FORMS CODE 
          MX0    12 
          LX5    59-47
          BX6    X0*X5
          ZR     X6,PEJ2     IF FORMS CODE NOT SPECIFIED
          SB7    FCJL 
          RJ     ESB
 PEJ2     LX5    59-35-59+47 SET DISPOSITION CODE 
          MX0    12 
          BX6    X0*X5
          ZR     X6,PEJ3     IF DISPOSITION CODE NOT SPECIFIED
          SB7    DCJL 
          RJ     ESB
 PEJ3     SA1    PEJA        GET QUEUE TYPE 
          MX0    18 
          SA2    QTEC        SEARCH FOR MATCHING QUEUE TYPE 
 PEJ4     ZR     X2,PEJ5     IF END OF TABLE
          BX3    X0*X2
          LX3    18 
          IX3    X1-X3
          SB2    X2          ADDRESS OF EXTERNAL CHARACTERISTICS TABLE
          SA2    A2+B1
          NZ     X3,PEJ4     IF NOT MATCH 
          LX5    0-21-59+35  GET EXTERNAL CHARACTERISTICS 
          MX0    -3 
          BX1    -X0*X5 
          SB7    ECJL        SET EXTERNAL CHARACTERISTICS 
          SA2    X1+B2       INDEX INTO TABLE 
          BX6    X2 
          RJ     ESB
 PEJ5     SA1    B6+3        SET DESTINATION BATCH DEVICE ID
          MX0    -6 
          LX1    -12
          BX1    -X0*X1 
          RJ     COD
          LX6    -12         USE LOWER 2 CHARACTERS 
          SB7    IDJL 
          RJ     ESB
          SA1    L3JL        GET CHARACTER COUNT
          SB7    X1+
          WRITES OUTPUT,USBB,B7 
          EQ     PEJX        RETURN 
  
  
 PEJA     CON    0           QUEUE TYPE 
  
 PEJB     DATA   L* SRUS=          .  SRU LIMIT=        .  CM FL=      .
,   EM FL=       .* 
  
 PEJC     DATA   0
          DATA   L* DAYFILE=  * 
 PEJCL    EQU    *-PEJC     LENGTH OF DAYFILE HEADER LINE 
  
 PEJD     DATA   0
          DATA   C* PENDING COMMANDS =* 
 PEJDL    EQU    *-PEJD     LENGTH OF COMMAND HEADER LINE 
  
 PEJE     DATA   L* PRU LENGTH=        .  DC=  .  FC=  .  ID=  .  EC= 
,  .* 
  
 PEJF     DATA   L*     . .  .  .   .                        UJN= 
,   LEVEL=       *
  
 PEJG     CON    0           LWA+1 OF REPLY UNIT
          TITLE  JSN OPTION.
 PJS      SPACE  4,10 
**        PJS - PROCESS JSN PARAMETER.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
*                B - 4, 6, 7. 
* 
*         CALLS  BFB, CFP, ESB, GCS, GDR, GJS, GSC, IPR, RRB, SFN.
* 
*         MACROS WRITES.
* 
*         DEFINE (X5) = INCOMPLETE LINE FLAG. 
*                       .EQ. 1, PARTIAL LINE WRITTEN. 
*                       .NE. 1, COMPLETE LINE WRITTEN.
* 
*         EXAMPLE - 
* 
*         1         2         3         4         5         6         7 
* 234567890123456789012345678901234567890123456789012345678901234567890 
* 
* JSN SC CS DS LID STATUS                JSN SC CS DS LID STATUS
* 
* ABFB.D.  .RB.M90.PRINT QUEUE           ABAB.T.ON.BC.M90.EXECUTING 
  
  
 PJS      SUBR               ENTRY/EXIT 
          SA1    PIJS        SET PEEK INFORMATION BITS
          SX6    99999       FORCE EJECT
          BX5    X5-X5       SET LINE COMPLETE
          SA6    LCT
          BX7    X1 
          SA7    BQPF+2 
 PJS1     RJ     IPR         ISSUE PEEK REQUEST 
          NZ     X1,PJS5     IF NO JOBS FOUND 
          NZ     X5,PJS3     IF INCOMPLETE LINE 
 PJS2     SB6    PJSA        CHECK FOR PAGE LIMIT 
          RJ     BFB         INITIALIZE BUFFER
          SB7    PJSAL
          RJ     CFP
 PJS3     SA1    BQAC+3      GET NEXT ENTRY 
          SB6    X1          GET *OUT* POINTER
          MX0    24 
          SA1    B6          GET JSN
          BX1    X0*X1
          RJ     SFN
          SB7    JSJL+X5     SET JSN IN BUFFER
          RJ     ESB
          SX6    1R.
          SA6    B7+
          RJ     GSC         GET SERVICE CLASS
          SB7    SCJL+X5     SET SERVICE CLASS IN BUFFER
          RJ     ESB
          SX6    1R.
          SA6    B7 
          SA1    B6+3 
          RJ     GCS         GET CONNECTION STATUS
          SB7    CNJL+X5
          RJ     ESB
          SX6    1R.
          SA6    B7 
          SA1    B6+2 
          RJ     GDR         GET DESTINATION ROUTING
          SB7    DSJL+X5
          RJ     ESB
          SX6    1R.
          SA6    B7+
          SA1    B6+4        GET LID
          MX0    18 
          LX1    6
          BX1    X0*X1
          RJ     SFN
          SB7    LIJL+X5     SET LID IN BUFFER
          RJ     ESB
          SX6    1R.
          SB4    3
          SA6    B7 
          RJ     GJS         GET JOB STATUS 
          SB7    STJL+X5     SET JOB STATUS IN BUFFER 
          RJ     ESB
          MX0    -12
          SA1    BQPF+1      ADVANCE *OUT* POINTER
          BX1    -X0*X1      PEEK REPLY ENTRY LENGTH
          SA2    BQAC+3 
          SA3    A2-B1       GET *IN* POINTER 
          IX6    X1+X2
          IX3    X6-X3       CALCULATE *OUT* - *IN* 
          SX5    X5+B1
          ZR     X3,PJS4     IF REPLY BUFFER EMPTY
          SA6    A2 
          SB7    X5 
          EQ     B7,B1,PJS3  IF INCOMPLETE LINE 
          WRITES OUTPUT,USBB,MXLL 
          BX5    X5-X5
          EQ     PJS2        PROCESS NEXT ENTRY 
  
 PJS4     RJ     RRB         RESET *QAC* REQUEST BUFFER 
          NZ     X1,PJS6     IF MORE QUEUES TO SCAN 
 PJS5     ZR     X5,PJSX     IF LINE ALREADY WRITTEN
          WRITES OUTPUT,USBB,MXLL 
          EQ     PJSX        RETURN 
  
 PJS6     ZR     X5,PJS1     IF LINE ALREADY WRITTEN
          WRITES OUTPUT,USBB,MXLL 
          SX5    B0+
          EQ     PJS1        PROCESS NEXT BUFFER
  
  
 PJSA     DATA   L* JSN SC CS DS LID STATUS                JSN SC CS *
          DATA   L*DS LID STATUS* 
          DATA   0
 PJSAL    EQU    *-PJSA      LENGTH OF PAGE HEADER
          TITLE  UJN OPTION.
 PUJ      SPACE  4,10 
**        PUJ - PROCESS UJN PARAMETER.
* 
*         ENTRY  (X5) = UJN PARAMETER WORD. 
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7. 
*                B - 4, 6, 7. 
* 
*         CALLS  BFB, CFP, ESB, GCS, GDR, GJS, GSC, IPR, ISM, RRB,
*                SFN. 
* 
*         MACROS WRITES.
* 
*         EXAMPLE - 
* 
*         1         2         3         4         5         6         7 
* 234567890123456789012345678901234567890123456789012345678901234567890 
* 
* JSN SC CS DS LID UJN      STATUS          EXECUTING MESSAGE 
* 
* ABFB.D.DT.BC.M90.MYJOBAA  EXECUTING        ASSEMBLING LFM 
  
  
 PUJ      SUBR               ENTRY/EXIT 
          MX0    42          SAVE UJN 
          BX6    X0*X5
          SA6    PUJB 
          SA6    PUJC 
          SA1    PIUJ        SET PEEK INFORMATION BITS
          SX6    99999       FORCE EJECT
          SA6    LCT
          BX7    X1 
          SA7    BQPF+2 
 PUJ1     RJ     IPR         ISSUE PEEK REQUEST 
          NZ     X1,PUJX     IF NO JOBS FOUND 
 PUJ2     SB6    PUJA        CHECK FOR PAGE LIMIT 
          SB7    PUJAL
          RJ     CFP
          RJ     BFB         BLANK FILL STRING BUFFER 
          SA1    BQAC+3      GET NEXT ENTRY 
          SB6    X1+         GET *OUT* POINTER
          MX0    42          GET UJN
          SA1    B6+3 
          BX1    X0*X1
          SA2    PUJB 
          ZR     X2,PUJ3     IF NOT SEARCHING FOR SPECIFIC UJN
          BX2    X1-X2
          NZ     X2,PUJ7     IF NOT MATCH 
          BX6    X6-X6       SPECIFIC UJN FOUND 
          SA6    PUJC 
 PUJ3     RJ     SFN         SPACE FILL UJN 
          SB7    UJUL 
          RJ     ESB
          MX0    24 
          SA1    B6+         GET JSN
          BX1    X0*X1
          RJ     SFN
          SB7    JSUL        SET JSN
          RJ     ESB
          SX6    1R.
          SA6    B7+
          RJ     GSC         GET SERVICE CLASS
          SB7    SCUL        SET SERVICE CLASS
          RJ     ESB
          SX6    1R.
          SA6    B7+
          SA1    B6+4 
          RJ     GCS         GET CONNECTION STATUS
          SB7    CNUL        SET CONNECTION STATUS
          RJ     ESB
          SX6    1R.
          SA6    B7+
          SA1    B6+2 
          RJ     GDR         GET DESTINATION ROUTING
          SB7    DSUL 
          RJ     ESB
          SX6    1R.
          SA6    B7 
          SA1    B6+15       GET LID
          MX0    18 
          LX1    6
          BX1    X0*X1
          RJ     SFN
          SB7    LIUL        SET LID IN BUFFER
          RJ     ESB
          SX6    1R.
          SA6    B7 
          SB4    4           GET JOB STATUS 
          RJ     GJS
          SB7    STUL        SET JOB STATUS 
          RJ     ESB
          SB7    EMUL 
          SA1    B6+12       CHECK *MS2W* 
          NZ     X1,PUJ4     IF MESSAGE PRESENT 
          SA1    B6+6        USE MESSAGE IN *MS1W*
 PUJ4     BX6    X1 
          RJ     ESB
          SA1    L1UL 
          SB7    X1+
          SA2    USBB+B7     CHANGE TRAILING ZEROES TO BLANKS 
          SX6    1R 
 PUJ5     SA2    A2-B1
          NZ     X2,PUJ6     IF NONZERO CHARACTER 
          SA6    A2 
          EQ     PUJ5        CHECK NEXT CHARACTER 
  
 PUJ6     WRITES OUTPUT,USBB,B7 
 PUJ7     SA2    BQPF+1      GET PEEK REPLY ENTRY LENGTH
          MX0    -12
          BX2    -X0*X2 
          SA1    BQAC+3      ADVANCE *OUT* POINTER
          SA3    A1-B1
          IX6    X2+X1
          IX3    X6-X3       CALCULATE *OUT* - *IN* 
          SA6    A1 
          NZ     X3,PUJ2     IF MORE ENTRIES IN REPLY BUFFER
          RJ     RRB         RESET REQUEST BUFFER 
          NZ     X1,PUJ1     IF MORE QUEUES TO SCAN 
          SA1    PUJC 
          ZR     X1,PUJX     IF NOT SEARCHING FOR UJN 
          SA1    PUJB        GET UJN
          RJ     SFN
          SB7    UJUL        SET UJN
          RJ     ESB
          SA1    PUJD 
          BX6    X1 
          SB7    STUL        SET JOB STATUS 
          RJ     ESB
          SA1    L1UL 
          SB7    X1 
          WRITES OUTPUT,USBB,B7 
          SA1    PUJB 
          SA2    EMSD        * UJN NOT FOUND.*
          RJ     ISM         ISSUE ERROR MESSAGE
          EQ     PUJX        RETURN 
  
  
 PUJA     DATA   L* JSN SC CS DS LID UJN      STATUS           EXECUT*
          DATA   L*ING MESSAGE* 
          DATA   0
 PUJAL    EQU    *-PUJA      LENGTH OF PAGE HEADER
  
 PUJB     CON    0           UJN TO SEARCH FOR
 PUJC     CON    0           SEARCHING FOR UJN FLAG 
 PUJD     DATA   L*NOT FOUND    * 
          TITLE  SUBROUTINES. 
 BFB      SPACE  4,10 
**        BFB - BLANK FILL STRING BUFFER. 
* 
*         EXIT   (USBB) = STRING BUFFER BLANK FILLED. 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 2. 
  
  
 BFB      SUBR               ENTRY/EXIT 
          SA1    USBB 
          SB2    USBBL
          SX6    1R 
 BFB1     SA6    A1 
          SB2    B2-B1
          SA1    A1+1 
          NZ     B2,BFB1     IF NOT END OF BUFFER 
          EQ     BFBX        RETURN 
 CFP      SPACE  4,15 
**        CFP - CHECK FOR END OF PAGE.
* 
*         ENTRY  (B6) = FWA OF PAGE HEADER. 
*                (B7) = LENGTH OF PAGE HEADER (WORDS).
*                (LCT) = CURRENT LINE COUNT.
*                (LLM) = CURRENT PAGE SIZE. 
* 
*         EXIT   LINE COUNT UPDATED.
*                NEW PAGE HEADER WRITTEN IF END OF PAGE.
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
* 
*         MACROS WRITEW.
  
  
 CFP      SUBR               ENTRY/EXIT 
          SA1    LCT         INCREMENT LINE COUNT 
          SX6    X1+B1
          SA6    A1 
          SA2    LLM         GET LINE LIMIT 
          IX1    X1-X2
          SX7    X1+4 
          NG     X7,CFPX     IF NOT END OF PAGE 
          MX7    0
          SA7    A1          RESET LINE COUNT 
          SA1    PUJB 
          ZR     X1,CFP1     IF NOT SEARCHING FOR SPECIFIC UJN
          SA1    CFPA 
          NZ     X1,CFPX     IF FWA OF PAGE HEADER ALREADY SET
 CFP1     SX6    B6          SAVE FWA OF PAGE HEADER
          SA6    CFPA 
          SX7    B7+         SAVE LENGTH OF PAGE HEADER 
          SA7    CFPC 
          WRITEW OUTPUT,PAGE,B1  WRITE NEW PAGE HEADER
          SA1    CFPA 
          SA2    CFPC 
          WRITEW OUTPUT,X1,X2 
          EQ     CFPX        RETURN 
  
  
 CFPA     CON    0           FWA OF PAGE HEADER 
 CFPC     CON    0           LENGTH OF PAGE HEADER
 CIH      SPACE  4,10 
**        CIH - COMPUTE USER INDEX HASH.
* 
*         ENTRY  (X7) = 18 BIT USER INDEX (RIGHT JUSTIFIED).
* 
*         EXIT   (X7) = 4 CHARACTER USER INDEX HASH (LEFT JUSTIFIED 
*                       WITH ZERO FILL).
* 
*         USES   X - 0, 1, 2, 3, 7. 
*                B - 2, 3.
  
  
 CIH      SUBR               ENTRY/EXIT 
          SB2    59-11       INITIAL SHIFT COUNT
          SB3    5
          MX0    -5 
          LX3    B2,X7       BITS 12-16 OF USER INDEX 
          BX2    -X0*X3      FIRST CHARACTER OF HASH
          SX2    X2+B1
          LX2    6
          SB2    B2+B3       SHIFT COUNT FOR SECOND CHARACTER 
          LX3    B2,X7       BITS 7-11 OF USER INDEX
          BX1    -X0*X3      SECOND CHARACTER OF HASH 
          SX1    X1+B1
          BX2    X2+X1
          LX2    6
          SB2    B2+B3       SHIFT COUNT FOR THIRD CHARACTER
          LX3    B2,X7       BITS 2-6 OF USER INDEX 
          BX1    -X0*X3      THIRD CHARACTER OF HASH
          SX1    X1+B1
          BX2    X2+X1
          LX2    6
          MX0    -2          FOURTH CHARACTER OF HASH 
          BX1    -X0*X7      BITS 1-0 OF USER INDEX 
          LX1    3
          SX1    X1+B1
          BX7    X2+X1
          LX7    59-23       LEFT JUSTIFY USER INDEX HASH 
          EQ     CIHX        EXIT 
 CLM      SPACE  4,15 
**        CLM - CHECK AND CONVERT LIMIT.
* 
*         ENTRY  (X5) = VALUE TO CONVERT. 
*                (X0) = MASK. 
* 
*         EXIT   (X6) = CONVERTED VALUE, RIGHT JUSTIFIED. 
*                (X7) = CONVERTED VALUE, LEFT JUSTIFIED.
* 
*         USES   A - 2. 
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  CDD. 
  
  
 CLM      SUBR               ENTRY/EXIT 
          SA2    =L*NO LIMIT* 
          BX1    -X0*X5 
          BX3    X0+X1
          BX7    X2 
          LX2    -12
          BX6    X2 
          ZR     X3,CLMX     IF NO LIMIT
          MX3    57          COMPLETE MASK (ADD BITS 2-0) 
          BX3    X3*X0
          BX1    -X3*X5 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          MX3    42          INSURE END OF LINE 
          BX7    X3*X4
          EQ     CLMX        RETURN 
 CSD      SPACE  4,15 
**        CSD - CONVERT TO SIGNED DISPLAY CODE. 
* 
*         ENTRY  (X1) = 18-BIT VALUE TO BE CONVERTED, RIGHT JUSTIFIED.
* 
*         EXIT   (X6) = SIGNED VALUE, MAXIMUM OF 6 CHARACTERS 
*                     PLUS SIGN CHARACTER.
* 
*         USES   B - 5. 
*                X - 1, 2, 3, 4, 6. 
* 
*         CALLS  CDD. 
  
  
 CSD      SUBR               ENTRY/EXIT 
          SB5    B0 
          BX2    X1 
          LX2    59-17
          BX3    -X2         GET COMPLEMENT 
          PL     X2,CSD1     IF NOT NEGATIVE VALUE
          AX3    59-17       FIND POSITIVE VALUE
          BX1    X3 
          SB5    1R-         SET NEGATIVE SIGN
 CSD1     RJ     CDD         CONVERT TO DISPLAY CODE
          ZR     B5,CSD2     IF NOT A NEGATIVE VALUE
          SX3    B5          ADD SIGN TO VALUE
          AX4    6
          MX2    6           CLEAR UPPER 6 BITS 
          BX4    -X2*X4 
          LX3    54 
          BX4    X4+X3
 CSD2     MX1    48 
          BX6    X1*X4
          EQ     CSDX        RETURN 
 CSR      SPACE  4,10 
**        CSR - CONVERT SRU-S.
* 
*         ENTRY  (X2) = SRU VALUE (MICRO-UNITS*10). 
* 
*         EXIT   (X6) = F10.3 FORMAT VALUE. 
*                     = *NO LIMIT*, IF SRU VALUE .EQ. -0. 
* 
*         USES   X - 0, 1, 3, 6.
*                A - 3. 
* 
*         CALLS  CFD. 
  
  
 CSR1     SA3    =L*NO LIMIT* 
          BX6    X3 
  
 CSR      SUBR               ENTRY/EXIT 
          MX0    -42
          BX1    -X0*X2 
          BX3    X0+X1
          ZR     X3,CSR1     IF NO LIMIT
          SA3    MLPY        SRU CONSTANT (=.0001)
          PX1    X1 
          FX1    X3*X1       SRU/10000
          RJ     CFD         CONVERT TO F10.3 FORMAT
          EQ     CSRX        RETURN 
 DTT      SPACE  4,10 
**        DTT - DETERMINE TIME UNTIL TIMEOUT. 
* 
*         ENTRY  (X1) = SCHEDULING FIELD FROM *QAC* BLOCK,
*                       RIGHT-JUSTIFIED.
* 
*         EXIT   (SUSM) = UPDATED WITH NEW TIME.
* 
*         USES   X - 1, 2, 4, 6.
*                A - 1, 6.
* 
*         CALLS  CDD. 
* 
*         MACROS RTIME. 
  
  
 DTT      SUBR               ENTRY/EXIT 
          MX2    -24
          BX4    -X2*X1 
          RTIME  DTTA 
          SA1    DTTA        GET SECONDS
          LX1    24 
          BX1    -X2*X1 
          IX4    X4-X1       SECONDS REMAINING UNTIL TIMEOUT
          SX1    X4+30
          SX4    60 
          IX1    X1/X4       CONVERT SECONDS TO MINUTES 
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          SA1    SUSM 
          MX2    -18
          BX6    -X2*X6 
          LX2    23-17
          BX1    X2*X1       REMOVE TIME
          LX6    23-17
          BX6    X1+X6
          SA6    A1          REPLACE MINUTES REMAINING
          EQ     DTTX        RETURN 
  
  
 DTTA     DATA   0           REAL TIME
 ESB      SPACE  4,15 
**        ESB - ENTER DATA INTO STRING BUFFER.
* 
*         ENTRY  (B7) = ADDRESS OF LINE DESCRIPTOR ENTRY. 
*                (X6) = FIRST WORD OF DATA TO TRANSFER. 
*                (A1) = ADDRESS OF DATA TO TRANSFER, IF MORE THAN 
*                       ONE WORD. 
* 
*         EXIT   (B7) = CURRENT STRING BUFFER ADDRESS.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 7. 
*                B - 2, 3, 7. 
  
  
 ESB      SUBR               ENTRY/EXIT 
          SA2    B7+         GET NUMBER OF CHARACTERS TO TRANSFER 
          SB2    X2 
          LX2    -18
          SX3    X2          GET CHARACTER INDEX
          SB7    USBB+X3     SET STARTING ADDRESS IN STRING BUFFER
          MX0    -6 
 ESB1     SB3    10          SET CHARACTERS PER WORD
 ESB2     LX6    6
          SB2    B2-B1
          BX7    -X0*X6 
          SB3    B3-B1
          SA7    B7 
          SB7    B7+B1
          ZR     B2,ESBX     IF ALL CHARACTERS TRANSFERRED
          NZ     B3,ESB2     IF NOT END OF WORD 
          SA1    A1+B1
          BX6    X1 
          EQ     ESB1        TRANSFER NEXT CHARACTER
 GCS      SPACE  4,10 
**        GCS - GET CONNECTION STATUS.
* 
*         ENTRY  (B6) = PEEK REPLY ENTRY ADDRESS. 
*                (X1) = PEEK REPLY ENTRY WORD CONTAINING CONNECTION 
*                       STATUS. 
* 
*         EXIT   (X6) = CONNECTION STATUS, LEFT JUSTIFIED.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2.
  
  
 GCS      SUBR               ENTRY/EXIT 
          SA2    B6          GET QUEUE TYPE 
          MX0    -12
          LX2    11-23
          BX2    -X0*X2 
          SX2    X2-EXQQ
          ZR     X2,GCS1     IF EXECUTING JOB 
          SA1    GCSA        CLEAR CONNECTION STATUS
          BX6    X1 
          EQ     GCSX        RETURN 
  
 GCS1     MX0    -4          GET CONNECTION STATUS FROM REPLY ENTRY 
          LX1    0-55 
          BX1    -X0*X1 
          SA1    CNST+X1     GET CONNECTION STATUS TO DISPLAY 
          BX6    X1 
          EQ     GCSX        RETURN 
  
 GCSA     DATA   2C          CONNECTION STATUS FOR QUEUED FILES 
 GDR      SPACE  4,10 
**        GDR - GET DESTINATION ROUTING.
* 
*         ENTRY  (X1) = PEEK REPLY ENTRY WORD CONTAINING THE
*                DESTINATION *FO-UI*. 
* 
*         EXIT   (X6) = DESTINATION ROUTING, LEFT JUSTIFIED.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1. 
  
  
 GDR      SUBR               ENTRY/EXIT 
          MX0    6
          BX2    X0*X1
          NZ     X2,GDR1     IF ROUTED TO REMOTE BATCH
          SA1    GDRA 
          EQ     GDR2        DISPLAY ROUTED TO LOCAL BATCH
  
 GDR1     SA1    GDRB        DISPLAY ROUTED TO REMOTE BATCH 
 GDR2     BX6    X1 
          EQ     GDRX        RETURN 
  
 GDRA     DATA   2CBC        ROUTED TO LOCAL BATCH
 GDRB     DATA   2CRB        ROUTED TO REMOTE BATCH 
 GJS      SPACE  4,15 
**        GJS - GET JOB STATUS. 
* 
*         ENTRY  (B4) = EJT STATUS WORD OFFSET. 
*                (B6) = PEEK REPLY ENTRY ADDRESS. 
* 
*         EXIT   (A1) = ADDRESS OF STATUS DESCRIPTOR. 
*                (X6) = FIRST WORD OF STATUS DESCRIPTOR.
* 
*         ERROR  TO *PSE*, IF INCORRECT QUEUE TYPE. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2, 3. 
* 
*         CALLS  DTT. 
  
  
 GJS      SUBR               ENTRY/EXIT 
          SA1    B6+         GET QUEUE TYPE 
          MX0    -12
          LX1    -12
          BX1    -X0*X1 
          SA2    QTST        SEARCH FOR MATCHING QUEUE TYPE 
          MX0    18 
 GJS1     ZR     X2,GJS3     IF END OF TABLE
          BX3    X0*X2
          LX3    18 
          IX4    X1-X3
          SX3    X2          ADDRESS OF STATUS DESCRIPTOR 
          SA2    A2+1 
          NZ     X4,GJS1     IF NO MATCH
          NZ     X3,GJS2     IF NOT EXECUTING JOB 
          SA1    B6+B4       GET EJT STATUS 
          MX0    -5 
          LX1    11 
          BX6    -X0*X1 
          SA3    X6+EJST
          SX6    X6-SUJS
          NZ     X6,GJS2     IF NOT SUSPENDED JOB 
          LX1    -11-12 
          RJ     DTT         DETERMINE MINUTES UNTIL TIMEOUT
          SA3    EJST+SUJS   RESET MESSAGE
 GJS2     SA1    X3 
          BX6    X1 
          EQ     GJSX        RETURN 
  
 GJS3     SX1    EMSB        * INCORRECT QUEUE TYPE.* 
          EQ     PSE         ISSUE ERROR MESSAGE AND ABORT
 GSC      SPACE  4,10 
**        GSC - GET SERVICE CLASS.
* 
*         ENTRY  (B6) = PEEK REPLY ENTRY ADDRESS. 
* 
*         EXIT   (X6) = SERVICE CLASS CHARACTER, LEFT JUSTIFIED.
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2.
*                B - 2. 
  
  
 GSC      SUBR               ENTRY/EXIT 
          MX0    6           GET SERVICE CLASS
          SA1    B6+B1
          SX3    10          CALCULATE WORD ORDINAL 
          BX1    X0*X1
          LX1    6
          BX4    X1 
          SX6    X3 
          IX3    X1/X3
          SA2    GSCA+X3
          IX3    X3*X6
          IX4    X4-X3
          SX3    6           CALCULATE SHIFT COUNT
          IX4    X3*X4
          SB2    X4 
          LX2    X2,B2
          BX6    X0*X2       SERVICE CLASS CHARACTER
          EQ     GSCX        RETURN 
  
  
 GSCA     DATA   L+"NMDS"+   SERVICE CLASS CHARACTER STRING 
 IPR      SPACE  4,15 
**        IPR - ISSUE PEEK REQUEST. 
* 
*         ENTRY  (BQAC) = *QAC* PEEK REQUEST. 
* 
*         EXIT   (X1) = 0, IF REQUEST SUCCESSFUL. 
*                     = 1, IF NO JOBS FOUND.
* 
*         ERROR  TO *PSE*, IF *QAC* ERROR ENCOUNTERED.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  ISM. 
* 
*         MACROS SYSTEM.
  
  
 IPR      SUBR               ENTRY/EXIT 
          SYSTEM QAC,R,BQAC  ISSUE PEEK REQUEST 
          SA1    BQAC        CHECK ERROR STATUS 
          MX0    -8 
          LX1    -10
          BX1    -X0*X1 
          ZR     X1,IPR3     IF NO ERRORS 
          SX2    X1-ER07
          ZR     X2,IPR1     IF NO JOBS FOUND 
          SX1    EMSE        * QAC ERROR ENCOUNTERED.*
          EQ     PSE         ISSUE ERROR MESSAGE AND ABORT
  
*         PROCESS NO JOBS FOUND.
  
 IPR1     SA1    JSNM        GET JSN
          SA2    EMSD 
          NZ     X1,IPR2     IF JSN SPECIFIED 
          SA1    IPRA 
          NZ     X1,IPRX     IF NOT FIRST REQUEST 
          SA2    EMSC 
 IPR2     RJ     ISM
          SX1    B1+         SET NO JOBS FOUND FLAG 
 IPR3     SX6    B1+         FIRST REQUEST ISSUED 
          SA6    IPRA 
          EQ     IPRX        RETURN 
  
  
 IPRA     CON    0           FIRST REQUEST FLAG 
 ISM      SPACE  4,20 
**        ISM - ISSUE MESSAGE.
* 
*         ENTRY  (X1) = JSN OR UJN. 
*                     = 0, IF JSN OR UJN NOT TO BE ADDED TO MESSAGE.
*                (X2) = FIRST WORD OF MESSAGE.
*                (A2) = BEGINNING ADDRESS OF MESSAGE. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 3, 6.
* 
*         CALLS  SFN. 
* 
*         MACROS MESSAGE, WRITEC. 
* 
*         NOTES  *ISM* ISSUES A SPECIFIED MESSAGE TO THE
*                OUTPUT FILE IF IT IS A TERMINAL FILE, OR TO
*                THE USER-S DAYFILE IF IT IS NOT.  IF A JSN OR
*                UJN IS SPECIFIED, IT IS ADDED TO THE MESSAGE.
  
  
 ISM      SUBR               ENTRY/EXIT 
          ZR     X1,ISM1     IF NO JSN/UJN
          RJ     SFN         SPACE FILL JSN/UJN 
          MX3    42          ADD JSN/UJN TO MESSAGE 
          LX3    -6          PUT JSN/UJN IN CHARACTER POSITIONS 2-8 
          BX2    -X3*X2 
          LX6    -6 
          BX1    X3*X6
          BX6    X2+X1
          SA6    A2+
 ISM1     SA3    FT 
          ZR     X3,ISM2     IF TERMINAL FILE 
          MESSAGE A2,3
          EQ     ISMX        EXIT 
  
 ISM2     WRITEC O,A2 
          EQ     ISMX        EXIT 
 LST      SPACE  4,20 
**        LST - PROCESS FILE LENGTH, STATUS AND TYPE. 
* 
*         ENTRY  (A5)= FNT ENTRY ADDRESS. 
*                (X5)= FNT ENTRY. 
* 
*         EXIT   (A5) = FST WORD ADDRESS. 
*                FILE LENGTH IN FOPB+1. 
*                FILE TYPE IN FOPB+2. 
*                FILE STATUS IN FOPB+3. 
*                FILE ACCESS LEVEL IN FOPB+4, FOPB+5. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 2, 5.
* 
*         CALLS  CDD, SFN.
* 
*         MACROS  WRITEW. 
* 
  
  
 LST      SUBR
          MX0    42          PROCESS NAME 
          BX1    X0*X5
          RJ     SFN         SPACE FILL NAME
          LX6    42          RIGHT JUSTIFY NAME 
          SA6    FOPB 
          MX0    -6          SET FILE STATUS
          BX1    -X0*X5 
          SA1    FSTT+X1     FILE STATUS
          RJ     SFN         SPACE FILL NAME
          SB2    15          SET FILE ACCESS LEVEL
          AX3    X5,B2
          MX0    -3 
          BX3    -X0*X3 
          NZ     X3,LST1     IF NOT LEVEL 0 
          SA2    SSFL 
          NZ     X2,LST1     IF SECURE SYSTEM 
          SA6    FOPB+4      STORE FILE STATUS
          SX6    B0+
          SA6    FOPB+5 
          EQ     LST2        GET FILE TYPE
  
 LST1     MX0    30 
          BX4    X0*X6       SAVE FILE STATUS 
          SA1    TALV+X3     FILE ACCESS LEVEL
          RJ     SFN         SPACE FILL ACCESS LEVEL
          LX6    -30
          BX7    -X0*X6 
          BX7    X4+X7
          SA7    FOPB+4      SET FILE STATUS AND ACCESS LEVEL 
          MX0    12 
          BX6    X0*X6       SET LAST TWO CHARACTERS OF ACCESS LEVEL
          SA6    FOPB+5 
 LST2     MX0    -6 
          AX5    6           FILE TYPE
          BX2    -X0*X5 
          SA1    FLTY+X2     FILE TYPE
          MX0    18 
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    24 
          LX5    6+59-12     CHECK WRITE LOCKOUT BIT
          PL     X5,LST3     IF NOT WRITE LOCKOUT 
          SA1    =1R*        DISPLAY * AFTER FILE TYPE
          MX0    -6 
          BX6    X0*X6
          BX6    X1+X6
 LST3     LX6    6
          SA6    FOPB+2 
          MX0    -2          GET FILE TYPE
          BX5    -X0*X5 
          SB5    X5 
          SX2    X2-LOFT
          NZ     X2,LST3.2   IF NOT LOCAL FILE
          SA2    LSTA        SET *TP* 
          EQ     B5,B1,LST3.1  IF TAPE FILE 
          SA2    A2+B1       SET *TT* 
          SB2    B5-B1
          NE     B2,B1,LST3.2  IF NOT TERMINAL FILE 
 LST3.1   MX0    48          REPLACE *LO* IN FILE TYPE FIELD
          LX0    18 
          LX2    30 
          BX6    X0*X6
          BX6    X2+X6       INSERT NEW FILE TYPE 
          SA6    A6+
  
*         PROCESSING FST ENTRY. 
  
 LST3.2   SA5    A5+1        FST ENTRY
          SA2    =10H 
          NE     B5,B1,LST3.3  IF NOT TAPE FILE 
          LX5    24 
 LST3.3   MX0    24 
          BX1    X0*X5       FILE LENGTH
          LX1    24 
          BX6    X2 
          ZR     X1,LST4     IF ZERO LENGTH 
          RJ     CDD         CONVERT TO DECIMAL 
 LST4     SA6    FOPB+1 
          LE     B5,B1,LST5  IF MS OR TAPE FILE 
          SA1    =10H            SET BLANKS FOR STATUS
          EQ     LST6        STORE STATUS 
  
 LST5     MX0    -3          SET STATUS FIELD 
          SA5    A5          FST ENTRY
          SA1    OPBB 
          LX5    59-8 
          NG     X5,LST6     IF FILE ON INACCESSIBLE DEVICE 
          LX5    59-0-59+8
          BX2    -X0*X5 
          SA1    FLST+X2
          PL     X5,LST6     IF LAST OPERATION READ 
          MX0    30          UPDATE LAST OPERATION WITH *WRITE* 
          BX1    X0*X1
          SA2    =R*WRITE*
          BX1    X1+X2
 LST6     BX6    X1 
          SA6    FOPB+3 
          WRITEW OUTPUT,FOPB,FOPL 
          EQ     LSTX        EXIT 
  
  
 LSTA     DATA   2LTP 
          DATA   2LTT 
 PSE      SPACE  4,10 
**        PSE - PROCESS SYSTEM ERROR. 
* 
*         ENTRY  (X1) = FWA OF ERROR MESSAGE. 
* 
*         EXIT   JOB ABORTED. 
* 
*         MACROS ABORT, MESSAGE.
  
  
 PSE      BSS    0           ENTRY
          MESSAGE  X1        ISSUE DESCRIPTIVE MESSAGE
          MESSAGE  EMSA      * ENQUIRE ABORTED.*
          ABORT 
 RRB      SPACE  4,10 
**        RRB - RESET *QAC* REQUEST BUFFER. 
* 
*         EXIT   (X1) .EQ. 0, IF QUEUE SCAN IS COMPLETE.
*                     .NE. 0, IF REQUEST IS TO BE REISSUED. 
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 3, 6.
*                B - 2, 3.
  
  
 RRB      SUBR               ENTRY/EXIT 
          SA1    BQAC+4      CHECK QUEUE SELECTION BITS 
          MX0    -12
          LX1    -24
          BX1    -X0*X1 
          ZR     X1,RRBX     IF QUEUE SEARCH COMPLETE 
          MX0    -1          CLEAR COMPLETION BIT 
          SA3    BQAC 
          BX6    X0*X3
          SA6    A3 
          SA2    A3+B1       RESET BUFFER POINTERS
          SX6    X2 
          SA6    A2+1        SET *IN* = *FIRST* 
          SB3    NUMQ 
          SA2    RRBA 
          SA6    A6+B1       SET *OUT* = *FIRST*
          SB2    5           NUMBER OF QUEUE COUNTS PER WORD
          BX6    X6-X6
          SA3    BQPF 
 RRB1     ZR     B3,RRB3     IF END OF QUEUES 
          NZ     B2,RRB2     IF NOT END OF WORD 
          SA6    A3 
          SB2    4           ADVANCE TO NEXT WORD 
          SA3    A3+B1
          SX6    B0+
 RRB2     LX1    -1 
          SB2    B2-B1
          LX2    -12
          SB3    B3-B1
          PL     X1,RRB1     IF QUEUE SCANNED 
          BX6    X2+X6
          EQ     RRB1        CHECK NEXT QUEUE 
  
 RRB3     SA6    A3+
          EQ     RRBX        RETURN 
  
  
 RRBA     CON    7777B       MAXIMUM QUEUE COUNT
 WCL      SPACE  4,15 
**        WCL - WRITE DISPLAY CODED LINES.
* 
*         ENTRY  (B6) = FWA OF DATA IN *QAC* REPLY UNIT BUFFER. 
*                (B7) = SEARCH FLAG.
*                       .EQ. 0, SEARCH FROM LWA TO FWA. 
*                       .NE. 0, SEARCH FROM FWA TO LWA. 
*                (X5) = DATA WORD COUNT.
* 
*         USES   X - 1, 5, 6, 7.
*                A - 1, 6.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  USB. 
* 
*         MACROS WRITES.
* 
*         NOTES  *WCL* SEARCHES A *QAC* REPLY UNIT BUFFER 
*                CHECKING FOR THE FWA OF DATA TO WRITE. 
*                IF LESS THAN *MXLC* LINES ARE IN THE REPLY UNIT
*                BUFFER, ALL DATA WILL BE WRITTEN.  OTHERWISE 
*                THE FIRST ((B7) .NE. 0) OR LAST ((B7) .EQ. 0) *MXLC* 
*                LINES WILL BE WRITTEN.  LINES ARE TRUNCATED TO *MXLL*
*                CHARACTERS.
  
  
 WCL      SUBR               ENTRY/EXIT 
          ZR     X5,WCLX     IF NO DATA 
          SB5    MXLC        SET MAXIMUM NUMBER OF LINES TO WRITE 
          MX7    -12
          SB2    B6+X5       (B2) = LWA+1 OF DATA 
          NZ     B7,WCL5     IF SEARCH FROM FWA TO LWA
          SB4    B0          INITIALIZE LINE COUNT
 WCL1     EQ     B2,B6,WCL2  IF BEGINNING OF BUFFER 
          SB2    B2-B1       GET PREVIOUS WORD
          SA1    B2 
          BX1    -X7*X1 
          NZ     X1,WCL1     IF NO ZERO BYTE TERMINATOR 
          SB4    B4+B1       INCREMENT LINE COUNT 
          LE     B4,B5,WCL1  IF LINE LIMIT NOT REACHED
          SB2    B2+B1       SET FWA OF PREVIOUS LINE 
          SB4    B4-B1
 WCL2     SX6    B4+         SAVE LINE COUNT
          SA6    WCLA 
 WCL3     SB6    USBBL
          RJ     USB
          SB7    B7-WBUF2+1 
          SB6    MXLL 
          SX5    A1+B1       SAVE POSITION IN PACKED BUFFER 
          LE     B7,B6,WCL4  IF LINE NOT TOO LONG 
          SB7    B6 
 WCL4     WRITES OUTPUT,WBUF2,B7
          SA1    WCLA        DECREMENT LINE COUNT 
          SX6    X1-1 
          SA6    A1 
          SB2    X5          ADDRESS OF NEXT LINE 
          NZ     X6,WCL3     IF MAXIMUM LINES NOT WRITTEN 
          EQ     WCLX        RETURN 
  
 WCL5     SB3    B6+
          SB4    1           INITIALIZE LINE COUNT
 WCL6     SA1    B3 
          SB3    B3+1 
          BX1    -X7*X1 
          EQ     B2,B3,WCL7  IF END OF BUFFER 
          NZ     X1,WCL6     IF NO ZERO BYTE TERMINATOR 
          SB4    B4+1 
          LT     B4,B5,WCL6  IF LINE LIMIT NOT REACHED
 WCL7     SB2    B6          SET FWA OF FIRST LINE
          EQ     WCL2        WRITE LINES TO OUTPUT
  
  
 WCLA     CON    0           LINE COUNT 
 WML      SPACE  4,10 
**        WML - WRITE MESSAGE LINE. 
* 
*         ENTRY  (A2) = FWA OF *QAC* REPLY UNIT CONTAINING MESSAGE. 
*                (X2) = FIRST WORD OF *QAC* REPLY UNIT. 
* 
*         USES   X - 0, 1, 2, 3.
*                A - 3. 
*                B - 2, 6, 7. 
* 
*         CALLS  USB. 
* 
*         MACROS WRITES.
  
  
 WML      SUBR               ENTRY/EXIT 
          SA3    A2+1 
          ZR     X3,WMLX     IF NO MESSAGE PRESENT
          LX2    -12         GET MESSAGE LENGTH 
          MX0    -12
          BX2    -X0*X2 
          SB2    A3 
          SX1    10 
          IX2    X1*X2       MESSAGE LENGTH (CHARACTERS)
          SB6    X2 
          RJ     USB
          SB7    B7-WBUF2 
          WRITES OUTPUT,WBUF2+1,B7
          EQ     WMLX        RETURN 
          SPACE  4,10 
**        COMMON DECK CONTROL.
  
  
*         CONTROL FOR COMCUSB.
  
 WBUF2    DATA   1R 
          DATA   1R 
 USBB     BSS    USBBL       STRING BUFFER
  
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCFD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
 GMS$     EQU    1           FORCE USE OF MASK DURING SORT
*CALL     COMCGMS 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCPFM 
*CALL     COMCRDC 
*CALL     COMCRDW 
*CALL     COMCSFN 
*CALL     COMCSYS 
*CALL     COMCUSB 
*CALL     COMCVLC 
*CALL     COMCWTC 
*CALL     COMCWTH 
*CALL     COMCWTS 
*CALL     COMCWTW 
          TITLE  BUFFER.
*         BUFFERS.
* 
*         NOTE   *LBUF*, *RBUF*, AND *WBUF* ARE OVERLAPPING BUFFERS.
  
          USE    BUFFERS
  
 FBUF     BSS    0           GETFNT BUFFER
 OBUF     EQU    FBUF+FBUFL  OUTPUT BUFFER
 BUFF     EQU    OBUF+OBUFL  CONTROL POINT AREA / FNT BUFFER
 LBUF     EQU    BUFF+200B   LIBRARY LIST BUFFER
 RBUF     EQU    LBUF        REPLY BUFFER 
 WBUF     EQU    LBUF        WORKING BUFFER 
 RFL=     EQU    LBUF+TBUFL+5  FIELD LENGTH REQUIRED
 SSM=     EQU    0           DECLARE *SSM=* ENTRY POINT 
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        ENTRY POINTS. 
 ENQUIRE  SPACE  4,10 
**        ENQUIRE.
  
  
 ENQUIRE  BSS    0           ENTRY
          EQ     STATUS 
 LENGTH   SPACE  4,10 
**        LENGTH. 
  
  
 LENGTH   BSS    0           ENTRY
          SA1    ACTR        ARGUMENT COUNT 
          SX1    X1-1 
          NZ     X1,PRS2     IF NOT 1 ARGUMENT
          SA1    ARGR        CONSTRUCT *FN* KEYWORD FOR ARGUMENT
          SA2    DOFN 
          BX6    X1 
          SA6    A1+1 
          BX7    X2 
          SA7    A1 
          SB4    2           SET ARGUMENT COUNT 
          EQ     PRS1 
 STATUS   SPACE  4,10 
**        STATUS. 
  
  
 STATUS   BSS    0           ENTRY
          SA2    =0LA        DEFAULT OPTION 
*         EQ     PRS
 PRS      SPACE  4,25 
**        PRS -  PRESET SUBROUTINE. 
* 
*         EXIT   (OPAL) = .LT. 0, IF ALL OPTIONS TO BE EXECUTED.
*                (BUFF) = CONTROL POINT ADDRESS TO BE READ
*                       FOR FIRST *RSB* READ (FIRST 100B OF CPA). 
*                (BUFF+100B) = CONTROL POINT ADDRESS TO BE READ 
*                       FOR SECOND *RSB* READ (SECOND 100B OF CPA). 
*                (FT) = FILE TYPE.
*                     = 0, IF TERMINAL FILE.
*         (SSFL) .NE. 0, IF SECURE SYSTEM.
*                =0, IF NON-SECURE SYSTEM.
*         (ACAT) = JOB ACCESS CATEGORIES IF SECURE SYSTEM.
*         (ALVL) = JOB ACCESS LEVELS IF SECURE SYSTEM.
*         (UESC) = USER EM SHIFT COUNT FROM CMR.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 6. 
*                B - 1, 4, 5. 
* 
*         CALLS  ARG, SAL, STF. 
* 
*         MACROS ABORT, MESSAGE, SYSTEM.
  
  
 PRS      SA1    ACTR        ARGUMENT COUNT 
          BX6    X2 
          SB4    X1 
          SA6    DFOP 
  
*         PROCESS ARGUMENTS.
  
 PRS1     SB1    1
          ZR     B4,PRS3     IF NO ARGUMENTS
          SB5    ARGT        PROCESS ARGUMENTS
          SA4    ARGR 
          RJ     ARG
          SA2    TAGS        CHECK FOR ARGUMENTS NOT EQUIVALENCED 
          LX2    6
          SB4    X2-1R9 
          GT     B4,PRS2     IF *OP* USED BUT NOT EQUIVALENCED
          SA2    A2+B1
          LX2    6
          SB4    X2-1R9 
          GT     B4,PRS2     IF *O* USED BUT NOT EQUIVALENCED 
          SA2    A2+B1
          LX2    6
          SB4    X2-1R9 
          GT     B4,PRS2     IF *FN* USED BUT NOT EQUIVALENCED
          ZR     X1,PRS3     IF NO ARGUMENT ERRORS
          SA1    ACTR 
          SB4    X1-1 
          NZ     B4,PRS2     IF MORE THAN ONE ARGUMENT
          SA4    ARGR 
          MX0    -6 
          BX6    -X0*X4 
          SX6    X6-1R= 
          ZR     X6,PRS2     IF SEPARATOR IS *=*
          BX6    X0*X4
          SA6    TAGS 
          EQ     PRS3        NO ARGUMENT ERRORS 
  
 PRS2     MESSAGE MSGB       * ARGUMENT ERRORS.*
          ABORT 
  
 PRS3     SA2    TAGS+3 
          ZR     X2,PRS3.0   IF NO JSN
          SA1    ACTR 
          MX0    54          ELIMINATE OPTION SELECTION CHARACTER 
          BX2    X0*X2
          ZR     X2,PRS3.1   IF JSN SPECIFIED BUT NOT EQUIVALENCED
          SX1    X1-1 
          LX2    -18
          MX0    -18
          BX6    -X0*X2 
          NZ     X6,PRS2     IF JSN .GT. 4 CHARACTERS LONG
          EQ     PRS3.1      CHECK ARGUMENT COUNT 
  
 PRS3.0   SA2    A2+1 
          ZR     X2,PRS3.2   IF NO UJN
          SA1    ACTR 
          MX0    54          ELIMINATE OPTION SELECTION CHARACTER 
          BX2    X0*X2
          ZR     X2,PRS3.1   IF UJN SPECIFIED BUT NOT EQUIVALENCED
          SX1    X1-1 
 PRS3.1   SB4    X1-1 
  
*         CHECK FOR *O* SPECIFIED WITH UJN OR JSN.  ANY OTHER PARAMETER 
*         IS INCORRECT. 
  
          ZR     B4,PRS3.3   IF NO MORE PARAMETERS
          SB4    B4-2 
          NZ     B4,PRS2     IF TOO MANY PARAMETERS 
          SA1    TAGS+B1
          ZR     X1,PRS2     IF *O* NOT SPECIFIED 
          EQ     PRS3.3      CLEAR DEFAULT OPTION 
  
 PRS3.2   SA1    TAGS+2 
          ZR     X1,PRS3.4   IF FILENAME NOT SPECIFIED
 PRS3.3   BX6    X6-X6       CLEAR DEFAULT OPTION 
          SA6    DFOP 
 PRS3.4   SA1    TAGS+B1     CHANGE OUTPUT FILE NAME
          ZR     X1,PRS3.5   IF *O* NOT SPECIFIED 
          SA2    OUTPUT 
          MX0    -18
          BX6    -X0*X2 
          BX6    X6+X1
          SA6    A2 
 PRS3.5   GETPP  JPPW,LLM,PRSA
          SX2    OUTPUT 
          RJ     STF
          SA6    FT 
          NZ     X6,PRS3.6   IF NOT TERMINAL
          SA2    =1L         CLEAR PAGE EJECT 
          BX6    X2 
          SA6    PAGE 
          MESSAGE ZERO,1     CLEAR LINE 1 OF CPA
 PRS3.6   SA1    FT 
          WRITEW O,PRSA,X1   CONDITIONALLY WRITE FORMAT EFFECTOR
  
*         PRESET OPTIONS TO BE EXECUTED.
  
 PRS4     SA1    TAGS        CHECK OPTIONS
          NZ     X1,PRS5     IF NOT DEFAULT OPTION
          SA2    DFOP 
          BX6    X2 
          SA6    A1 
          BX1    X2 
 PRS5     MX0    6
          BX2    X0*X1
          ZR     X2,PRS10    IF THRU ALL SPECIFIED OPTIONS
          LX1    6           SHIFT OPTION TO BOTTON OF WORD 
          BX6    X1          RESET OPTION WORD
          SA6    A1+
  
*         CHECK FOR LEGAL OPTION. 
  
          SA4    OPNS 
 PRS6     BX3    X0*X4       CHECK OPTION 
          IX3    X3-X2
          ZR     X3,PRS8     IF LEGAL OPTION
          SA4    A4+B1
          NZ     X4,PRS6     IF MORE OPTIONS TO CHECK 
  
*         SEND ERROR MESSAGE AND ABORT JOB. 
  
          SA1    MSGA+1      PLACE OPTION IN MESSAGE
          LX0    12 
          LX2    12 
          BX1    -X0*X1 
          BX6    X1+X2
          SA6    A1 
          MESSAGE MSGA       * INCORRECT OPTION X.* 
          ABORT 
  
*         SET EXECUTION BITS IN OPTION TABLE. 
  
 PRS8     SX6    B1 
          LX6    18 
          BX6    X6+X4
          SA6    A4 
          LX2    6           RIGHT JUSTIFY OPTION 
          SX6    X2-1RA 
          NZ     X6,PRS4     IF NOT *A* OPTION
          SX6    B1+         SET EXECUTION FLAG WORD FOR ALL OPTIONS
          SA6    OPAL 
          EQ     PRS4        CHECK REMAINING OPTIONS
  
*         SET RSB BUFFER WORDS TO READ CONTROL POINT AREA.
  
 PRS10    SA2    STAT1+1
          BX6    X2 
          SA6    BUFF 
          SA2    STAT2+1
          BX6    X2 
          SA6    BUFF+100B
          SA1    OPAL 
          ZR     X1,PRS11    IF NOT ALL OPTIONS TO BE EXECUTED
          RJ     SAL         ASSURE ALL OPTIONS ARE SET 
  
*         CHECK IF SECURE SYSTEM. 
  
 PRS11    GETSSL SSFL        GET SYSTEM SECURITY MODE 
          SA1    SSFL 
          LX1    12 
          MX0    -3 
          BX6    -X0*X1 
          SA6    SSFL        SET SECURE SYSTEM FLAG 
  
*         GET USER EXTENDED MEMORY SHIFT COUNT FROM CMR.
  
          SYSTEM RSB,R,PRSB 
          SA1    UESC 
          LX1    0-33 
          MX0    -3 
          BX6    -X0*X1 
          SA6    A1 
          EQ     MAIN 
  
  
 PRSA     BSS    1           PRINT DENSITY
 PRSB     VFD    24/1,18/MEFL,18/UESC 
 SAL      SPACE  4,10 
**        SAL - SET ALL OPTIONS.
* 
*         EXIT   ALL OPTION BITS SET FOR EXECUTION. 
* 
*         USES   X - 3, 4, 5, 6.
*                A - 4, 5, 6. 
  
  
 SAL      SUBR               ENTRY/EXIT 
          SA4    OPNS+1      OPTION TABLE - SKIP *A* OPTION 
          SA5    EBIT        EXECUTION BIT MASK 
 SAL1     ZR     X4,SAL3     IF END OF OPTION TABLE 
          BX3    X5*X4       CLEAR OPTION FROM OPTION TABLE 
          NZ     X3,SAL2     IF EXECUTION BIT SET 
          SX6    1           SET EXECUTION BIT
          LX6    18 
          BX6    X6+X4
          SA6    A4+
 SAL2     SA4    A4+1        CHECK NEXT OPTION
          EQ     SAL1 
  
 SAL3     BX6    X6-X6       RESET END OF OPTION TABLE - SINCE *S*
          SA6    A4-2             AND *T* OPTIONS ARE REDUNDANT 
          EQ     SALX 
          SPACE  4,10 
**        PRESET COMMON DECKS.
  
  
*CALL     COMCARG 
*CALL     COMCSTF 
          SPACE  4,10 
**        PRESET CONSTANTS. 
  
  
*         ARGUMENT TABLE. 
  
 ARGT     BSS    0
 OP       ARG    NASV,TAGS+0 OPTIONS
 O        ARG    NASV,TAGS+1 OUTPUT FILE
 FN       ARG    NASV,TAGS+2 FILE NAME
 JSN      ARG    =1,TAGS+3   JSN
 UJN      ARG    =1,TAGS+4   UJN
          ARG 
  
 ZERO     CON    0
  
*         MESSAGES. 
  
 MSGA     DATA   C* INCORRECT OPTION X.*
 MSGB     DATA   L* ARGUMENT ERRORS.* 
  
*         DEFAULT OPTIONS.
  
 DOFN     VFD    42/0LFN,18/1R= 
 DFOP     CON    0
          SPACE  4,10 
          END 
