Retro1.org codex

          IDENT  SCTD,FWA
          ABS
          SST
          ENTRY  SCTD
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
          TITLE  SCTD - SERVICE CLASS CONTROL TABLE DISPLAY.
*COMMENT  SCTD - SERVICE CLASS CONTROL TABLE DISPLAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       SCTD - SERVICE CLASS CONTROL TABLE DISPLAY.
*
*         W. T. COLEMAN      82/09/16.
          SPACE  4,10
***       *SCTD* IS A CPU UTILITY USED BY THE OPERATOR TO DISPLAY
*         THE SERVICE CLASS CONTROL TABLE AND THE PRIORITY ORDERED
*         SERVICE CLASSES ON THE *L* DISPLAY OR TO FORMAT IT FOR
*         A PRINTER.
          SPACE  4,20
***       CONTROL STATEMENT CALL.
*
*
*         SCTD(LFN,OP)       ORDER DEPENDENT PARAMETERS.
*          OR
*         SCTD(L=LFN,LO=OP)  ORDER INDEPENDENT (KEYWORD = PARAMETER).
*
*          WHERE
*
*         OP = *L*           FORMAT DATA FOR A LINE PRINTER.
*
*         OP = *D*           FORMAT DATA FOR *L* DISPLAY (DEFAULT).
*
*         LFN                LIST OUTPUT FILE NAME (DEFAULT = OUTPUT).
*                            THIS PARAMETER VALID ONLY WITH (LO=L).
*
*         NOTES  SPECIAL PRIVILEGES REQUIRED.
*                1. USER MUST BE *SYOT* TO USE *L* DISPLAY (LO=D).
*                2. USER MUST BE *SYOT* OR HAVE SYSTEM ORIGIN
*                   PRIVILEGES TO GENERATE A LISTING (LO=L).
          SPACE  4,20
***       DAYFILE MESSAGES.
*
*         THESE MESSAGES ARE ISSUED TO THE JOB AND SYSTEM DAYFILES.
*
*         *ARGUMENT ERROR.*
*                AN INCORRECT PARAMETER WAS ENTERED. (FATAL ERROR)
*
*         *INCORRECT USER ACCESS.*
*                CALLING JOB WAS NOT SYSTEM ORIGIN. (FATAL ERROR)
*
*         *SCTD UTILITY COMPLETE.*
*                INDICATES NORMAL COMPLETION OF PROGRAM.
*
*         *CANNOT ACCESS L-DISPLAY.*
*                *DSD* DETECTED AN ERROR CONDITION WHEN INPUT WAS
*                ENTERED VIA THE *L* DISPLAY.
          SPACE  4,15
***       OPERATOR MESSAGES.
*
*         *END PROCESSED.*
*                AN INFORMATIVE MESSAGE INDICATING THAT AN END COMMAND
*                WAS ENTERED VIA THE *L* DISPLAY.  THE UTILITY HAS
*                BEEN TERMINATED.
*
*         *UNRECOGNIZABLE DIRECTIVE.*
*                AN ERROR MESSAGE INDICATING THAT THE DIRECTIVE
*                ENTERED VIA THE *L* DISPLAY WAS NOT ONE OF THE VALID
*                DIRECTIVES.
          SPACE  4,10
***       *L* DISPLAY COMMANDS.
*
*         THE FOLLOWING ARE LEGAL COMMANDS TO BE ENTERED BY THE
*         OPERATOR THROUGH THE *L* DISPLAY.
*
*         L.END.             TERMINATE THE UTILITY.
*
*         L.+.               ADVANCE TO THE NEXT SCREEN.
*
*         L.-.               REVERSE TO THE PREVIOUS SCREEN.
          SPACE  4,15
***       DEFINITION COMMON DECKS.
*
*CALL     COMCCMD
*CALL     COMCDCM
*CALL     COMCDCP
*CALL     COMCMAC
*CALL     COMSEVT
*CALL     COMSSFM
*CALL     COMSSSJ
 SCLASS   SPACE  4,15
**        SCLASS - DEFINE SERVICE CLASS TABLE.
*
*         SCLASS NM,MN,DF,ST,TX
*
*         ENTRY  *NM* = SERVICE CLASS NAME.
*                *MN* = TWO CHARACTER MNEMONIC.
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*.
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE.
*
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
 
 
          PURGMAC SCLASS
 
 SCLASS   MACRO  NM,MN,DF,ST,TX
 .SCL     RMT
 .A       IFLT   NM,12D
          VFD    12/0L_MN,48/MN_MK  TX
 .A       ELSE
          VFD    12/0L_MN,36/MN_MK,12/0  TX
 .A       ENDIF
 .SCL     RMT
 SCLASS   ENDM
 
 
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS.
 
 CNCI     EQU    4           NO COMMAND INPUT (*CPM* RETURN STATUS)
 LBUFL    EQU    LDSY        *L* DISPLAY BUFFER LENGTH
 LCOMU    EQU    LCOM/2+1    INPUT BUFFER PACKED
 NPXW     EQU    5           PRIORITY ORDERED SERVICE CLASSES PER WORD
 NSPL     EQU    10          NUMBER OF SERVICE CLASSES PER LINE
 NUMPX    EQU    10B         NUMBER OF PRIORITY ORDERED SERVICE CLASSES
 SCTL     EQU    SCTE        LENGTH OF OF *SCT*
 XCDT     EQU    4           X - COORDINATE FOR *L* DISPLAY
 YCDT     EQU    2           Y - COORDINATE FOR *L* DISPLAY
 
****
          TITLE  TABLES AND BUFFER DEFINITIONS.
          ORG    111B
 FWA      BSS    0
          SPACE  4,10
*         DAYFILE MESSAGES.
 
 DAFC     DATA   C* SCTD UTILITY COMPLETE.*
 ERAR     DATA   C* ARGUMENT ERROR.*
 ERCA     DATA   C* CANNOT ACCESS L-DISPLAY.*
 ERIU     DATA   C* INCORRECT USER ACCESS.*
          SPACE  4,10
*         FLAG DEFINITIONS.
 
 LFLG     CON    0           *L* DISPLAY FLAG
 PFLG     CON    0           PRINTER OUTPUT FLAG
 SYOF     CON    0           SYSTEM ORIGIN FLAG
          SPACE  4,5
*         GLOBAL STORAGE DEFINITIONS.
 
 CPAG     DATA   1           INDEX OF SCREEN TO DISPLAY
          SPACE  4,10
**        *SETJOB* PARAMETER BLOCK.
 
 SETB     VFD    60/0
          VFD    48/0,12/2LDF
          SPACE  4,10
**        *SFM* PARAMETER BLOCK.
 
 
 SFMB     VFD    12/RSCF,12/0,12/SCTL,6/0,18/WBUF
          CON    0           END OF *SFM* PARAMETER BLOCK
 ROLB     SPACE  4,5
**        ROLB - ROLLOUT PARAMETER BLOCK.
 
 ROLB     VFD    30/0,18/LINE,12/60
 TMLD     SPACE  4,10
**        TMLD - TABLE OF MESSAGES TO *L* DISPLAY.
 
 TMLD     BSS    0
          LOC    0
          DATA   C*                           *
 ENDM     DATA   C*END PROCESSED.             *
 EUND     DATA   C*UNRECOGNIZABLE DIRECTIVE.  *
          LOC    *O
 EMOR     CON    0           ERROR MESSAGE ORDINAL
 LDPT     SPACE  4,5
**        LDPT - *L* DISPLAY PAGE TABLE.
 
 
 LDPT     PAGT   SDTA,SDTA+SDMP,SDTA+SDIP  LEFT SCREEN PAGE 1
          PAGT   SDTB,SDTB+SDMP,SDTB+SDIP  LEFT SCREEN PAGE 2
          PAGT   *
          SPACE  4,5
*         SSJ= PARAMETER BLOCK.
 
 
 SSJ=     BSS    0           SSJ= ENTRY POINT
          BSSZ   SSJL        SSJ= PARAMETER BLOCK
 FETS     SPACE  4,10
*         FET DEFINITIONS.
 
 O        BSS    0           PRINTER OUTPUT FILE BUFFER
 OUTPUT   FILEB  OBUF,SDTAE-SDTH,(FET=6)
 TSCT     SPACE  4,10
**        TSCT - SERVICE CLASS TABLE.
*
*T        12/CLASS, 48/VALUE
*
*         CLASS - TWO CHARACTER SERVICE CLASS MNEMONIC.
*         VALUE - CORRESPONDING SERVICE CLASS MASK VALUE.
 
 
 TSCT     BSS    0
          LIST   G
 .SCL     HERE
          LIST   *
 TSCTL    EQU    *-TSCT
          ERRNZ  TSCTL-MXJC+1  ENSURE ALL SERVICE CLASSES PRESENT
          CON    0           END OF TABLE
 SCTD     TITLE  MAIN PROGRAM.
**        SCTD - MAIN PROGRAM.
*
*         EXIT   *SCTD* PROGRAM COMPLETED.
*
*         CALLS  PRS, LOP.
*
*         MACROS ENDRUN, MESSAGE.
 
 
 SCTD     BSS    0           ENTRY
          RJ     PRS         PRESET ROUTINE
          RJ     LOP         PROCESS LIST OPTIONS
          MESSAGE  DAFC,0,R  * SCTD UTILITY COMPLETE.*
          ENDRUN
 LOP      TITLE  LIST OPTION PROCESSOR.
 LOP      SPACE  4,25
**        LOP - LIST OPTION PROCESSOR.
*
*         *LOP* FORMATS THE *SCT* DATA TO A LOCAL FILE FOR PRINTING,
*         IF THE PRINT OPTION IS SPECIFIED.  IF THE *L* DISPLAY IS
*         SELECTED *LOP* WILL DISPLAY THE APPROPRIATE DATA ON THE
*         *L* DISPLAY UNTIL AN *L.END.* COMMAND IS ENTERED.
*
*         ENTRY  USER HAS BEEN VALIDATED (EITHER SYSTEM ORIGIN
*                OR SYSTEM ORIGIN PRIVILEGES).
*
*                (SFMB) = *SFM* PARAMETER BLOCK SET UP
*                         FOR *RSCF* SUBFUNCTION.
*                (PFLG) = 1, IF PRINT FILE REQUESTED.
*                (LFLG) = 1, IF *L* DISPLAY REQUESTED.
*
*         EXIT   PRINT FILE, IF REQUESTED, LOCAL TO USER JOB.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5.
*
*         CALLS  CMP, EFP, FDB, GSD, ILD, OLD.
*
*         MACROS SETFS, SETJOB, WRITER.
 
 
 LOP      SUBR               ENTRY/EXIT
          RJ     GSD         GET *SCT* DATA
          SA2    PFLG
          ZR     X2,LOP1     IF NOT TO BE PRINTED
          SX2    O           SET OUTPUT FET ADDRESS
          SX1    SDTH        FWA PAGE 1 WITH PRINTER HEADER
          SX6    SDTAE       LWA PAGE 1
          RJ     FDB         BUILD PRINT FILE
          WRITER O           FLUSH OUTPUT BUFFER
          SX1    SDTB        FWA PAGE 2
          SX6    SDTBE       LWA PAGE 2
          RJ     FDB         BUILD PRINT FILE
          WRITER O           FLUSH OUTPUT BUFFER
          SETFS  O,0         SAVE OUTPUT AS LOCAL FILE
          SETJOB SETB        CHANGE JOB DISPOSITION TO *DF*
          SX2    B0+         SET FORMATTING FOR *L* DISPLAY
 LOP1     SA1    LFLG
          ZR     X1,LOPX     IF *L* DISPLAY NOT SELECTED
 LOP2     RJ     OLD         OUTPUT *L* DISPLAY DATA
          RJ     ILD         INPUT *L* DISPLAY DATA
          RJ     CMP         COMMAND PROCESSOR
          SA1    EMOR        CHECK FOR ERROR MESSAGE
          NZ     X1,LOP2     IF ERROR IN COMMAND
          RJ     EFP         EXECUTE FUNCTION PROCESSOR
          EQ     LOP2        LOOP
          TITLE  FUNCTION PROCESSORS.
 END      SPACE  4,15
**        END - *END* FUNCTION PROCESSOR.
*
*         *END* TERMINATES THE UTILITY.
*
*         USES   X - 6.
*                A - 6.
*
*         CALLS  OLD.
*
*         MACROS DSDINP, ENDRUN, MESSAGE.
 
 
 END      SUBR               ENTRY/EXIT
          SX6    ENDM        *END PROCESSED.*
          SA6    EMOR        SET MESSAGE ORDINAL
          RJ     OLD         OUTPUT *L* DISPLAY
          DSDINP IPW,C       CLEAR *L* DISPLAY INPUT BUFFER
          MESSAGE  DAFC,0,R  * SCTD UTILITY COMPLETE.*
          ENDRUN
          TITLE  SUBROUTINES.
 CMP      SPACE  4,20
**        CMP - COMMAND FUNCTION PROCESSOR.
*
*         *CMP* VALIDATES THE COMMAND ENTERED VIA THE *L* DISPLAY AND
*         SETS THE PROCESSOR ADDRESS FOR THE COMMAND ENTERED.  PAGING
*         IS PROCESSED DIRECTLY BY *CMP*.
*
*         ENTRY  (IBUF) = *L* DISPLAY INPUT DIRECTIVE.
*
*         EXIT   (B5) = ADDRESS OF FUNCTION PROCESSOR, IF NO ERROR.
*                (B5) = 0, IF PAGING COMMAND.
*                (EMOR) = 0, IF NO ERROR IN DIRECTIVE INPUT.
*                (EMOR) = ERROR MESSAGE ADDRESS, IF ERROR.
*                (X3) = COMMAND, LEFT JUSTIFIED, ZERO FILLED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 3, 6, 7.
*                B - 2, 3, 5, 6.
*
*         CALLS  PGD, POP, USB.
 
 
 CMP2     SB5    X1+         SET PROCESSOR ADDRESS
 CMP3     SX6    B0+         SET NO ERROR
          SA6    EMOR        SET MESSAGE ORDINAL
 
 CMP      SUBR               ENTRY/EXIT
 
*         CHECK FOR PAGING COMMAND.
 
          SX1    CMPA        *L* DISPLAY BUFFER FWA
          SX2    LDPT        PAGE TABLE FWA
          SA3    IBUF        GET PAGING CHARACTER
          MX0    6           PAGING CHARACTER MASK
          BX3    X0*X3
          SX4    B1+         INDICATE *L* DISPLAY
          RJ     PGD         PAGE *L* DISPLAY
          SB5    B0          INDICATE PAGING COMMAND
          MX0    -18         SCREEN INDEX MASK
          SA1    LDPT        PAGE TABLE FWA
          LX1    30
          BX6    -X0*X1      GET LEFT SCREEN INDEX
          SA6    CPAG        SAVE LEFT SCREEN INDEX
          ZR     X4,CMP3     IF LEGAL PAGING
 
*         CHECK FOR VALID NON PAGING COMMAND.
 
          SB2    IBUF        FWA OF PACKED COMMAND BUFFER
          SB3    B0+         INDICATE DISPLAY CODE
          RJ     USB         UNPACK STRING BUFFER
          SB6    USBB        FWA UNPACKED STRING BUFFER
          RJ     POP         PICK OUT PARAMETER
          SX7    EUND        *UNRECOGNIZABLE DIRECTIVE.*
          SA7    EMOR        SET MESSAGE ORDINAL
          SA1    TCOM        TABLE OF COMMANDS
          MX0    42          COMMAND MASK
 CMP1     ZR     X1,CMPX     IF END OF TABLE (INCORRECT COMMAND)
          BX3    X0*X1       GET COMMAND
          BX2    X3-X6       CHECK IF CURRENT ENTRY IN TABLE
          ZR     X2,CMP2     IF A MATCH
          SA1    A1+1        NEXT ENTRY IN TABLE
          EQ     CMP1        CHECK NEXT COMMAND IN TABLE
 
 
 CMPA     BSS    1           *L* DISPLAY BUFFER FWA REQUIRED BY *PGD*
 PGD      HERE               REMOTE BLOCK FROM *COMCDCP*
 TCOM     SPACE  4,10
**        TCOM - TABLE OF COMMANDS.
*
*T        36/COMMAND,6/0,18/ADDR
*
*         COMMAND = DISPLAY CODE COMMAND VALUE.
*
*         ADDR = PROCESSING ROUTINE ADDRESS.
 
 
 TCOM     BSS    0
          VFD    42/0LEND,18/END
          CON    0
 EFP      SPACE  4,15
**        EFP - EXECUTE FUNCTION PROCESSOR.
*
*         *EFP* JUMPS TO THE CORRECT FUNCTION PROCESSOR, BASED UPON
*         THE COMMAND ENTERED VIA THE *L* DISPLAY.  THE FUNCTION
*         PROCESSING ROUTINE IS SET UP SO THAT IT RETURNS TO THE
*         ADDRESS *EFP* WOULD HAVE RETURNED TO.
*
*         ENTRY  (B5) = ADDRESS OF FUNCTION PROCESSOR.
*                (B5) = 0, IF PAGING COMMAND.
*
*         EXIT   TO FUNCTION PROCESSOR WITH RETURN ADDRESS SET.
*
*         USES   X - 2, 7.
*                A - 2, 7.
 
 
 EFP      SUBR               ENTRY/EXIT
          ZR     B5,EFPX     IF PAGING COMMAND
          SA2    EFPX        SET RETURN ADDRESS
          BX7    X2
          SA7    B5
          JP     B5+1        JUMP TO SUBROUTINE
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         *ERR* ISSUES AN ERROR MESSAGE TO THE USER AND SYSTEM
*         DAYFILE AND THEN ABORTS THE UTILITY.
*
*         ENTRY  (X2) = ADDRESS OF ERROR MESSAGE.
*
*         EXIT   MESSAGE ISSUED IN SYSTEM AND USER DAYFILE.
*
*         MACROS ABORT, MESSAGE.
 
 
 ERR      BSS    0           ENTRY
          MESSAGE X2,0,R
          ABORT
 FDB      SPACE  4,20
**        FDB - FORMAT DISPLAY BUFFER.
*
*         ENTRY  (X1) = FWA BUFFER TO FORMAT.
*                (X2) = 0, IF FORMATTING FOR *L* DISPLAY.
*                     = FET ADDRESS OF OUTPUT FILE IF FOR PRINTER.
*                (X5) = (PADT) ENTRY FOR PAGE TO REFORMAT.
*                (X6) = LWA BUFFER TO FORMAT.
*                (B2) = *L* DISPLAY MESSAGE INDEX.
*
*         EXIT   (LBUF) = FWA FORMATTED *L* DISPLAY BUFFER.
*
*         USES   X - 3.
*                B - 2, 3, 4, 6.
*
*         CALLS  FLB.
 
 
 FDB      SUBR               ENTRY/EXIT
 
*         SET UP PARAMETERS FOR *FLB*.
 
          SX3    B1+         *C* DISPLAY FORMAT
          SB2    LBUF        FWA TO PLACE FORMATTED DATA
          SB6    LBUF+LBUFL  LWA+1 OF BUFFER TO RECEIVE CONVERTED DATA
          NZ     X2,FDB1     IF FORMATTING FOR PRINTER
          SB3    XCDT        SET X-COORDINATE FOR *L* DISPLAY
          SB4    YCDT        SET Y-COORDINATE FOR *L* DISPLAY
 FDB1     RJ     FLB         FORMAT DATA TO BE OUTPUT
          EQ     FDBX        RETURN
 GSD      SPACE  4,10
**        GSD - GET *SCT* DATA.
*
*         *GSD* UPDATES THE SERVICE CLASS CONTROL TABLE TEMPLATES.
*
*         ENTRY  (WBUF) = ADDRESS OF FIRST *SCT* ENTRY.
*
*         CALLS  WOS, WPO.
*
*         MACROS SYSTEM.
 
 
 GSD      SUBR               ENTRY/EXIT
          SYSTEM SFM,R,SFMB,RSDF*100B  RETURN SYSTEM DATA
          RJ     WOS         WRITE ORIGIN-S SERVICE CLASSES
          RJ     WPO         WRITE PRIORITY ORDERED SERICE CLASSES
          EQ     GSDX        RETURN
 IDT      SPACE  4,15
**        IDT - INITIALIZE DISPLAY TEMPLATES.
*
*         *IDT* BLANK FILLS THE SERVICE CLASS DATA AREAS OF THE *L*
*         DISPLAY TEMPLATES.
*
*         EXIT   SERVICE CLASS DATA AREAS REINITIALIZED.
*
*         USES   X - 5.
*                A - 5.
*
*         MACROS MOVE.
 
 
 IDT      SUBR               ENTRY/EXIT
          SA5    TJOS-1      TABLE OF JOB ORIGIN SERVICE CLASSES
 IDT1     SA5    A5+1        GET NEXT ENTRY FROM TABLE
          ZR     X5,IDTX     IF END OF TABLE
          MOVE   23,IDTA,X5  RESET TEMPLATE DATA AREA
          EQ     IDT1        RESET NEXT SERVICE CLASS AREA
 
 
 IDTA     BSS    0           TO RESET SERVICE CLASS DATA AREAS
          DATA   50H
          DATA   60H
          DATA   60H
          DATA   60H
 ILD      SPACE  4,15
**        ILD - INPUT *L* DISPLAY.
*
*         *ILD* WILL ROLLOUT UNTIL A COMMAND IS ENTERED VIA THE *L*
*         DISPLAY.  IF NO COMMAND HAS BEEN ENTERED AFTER THE
*         SPECIFIED ROLLOUT TIME, THE DISPLAY IS REBUILT TO REFLECT
*         THE CURRENT STATE OF THE SYSTEM.
*
*         USES   X - 0, 1, 2.
*                A - 1.
*                B - 2, 3.
*
*         CALLS  GSD, OLD.
*
*         MACROS DSDINP, ROLLOUT.
 
 
 ILD      SUBR               ENTRY/EXIT
 ILD1     DSDINP IPW         REQUEST INPUT FROM OPERATOR
          SA1    IPW
          MX0    -12
          BX1    -X0*X1
          AX1    1           IGNORE COMPLETION BIT
          SX2    X1-CNCI
          SB3    X1
          NZ     X2,ILDX     IF COMMAND ENTERED
          ROLLOUT  ROLB      WAIT FOR *L* DISPLAY INPUT
          RJ     OLD         OUTPUT *L* DISPLAY
          EQ     ILD1        CHECK *L* DISPLAY INPUT
 OLD      SPACE  4,15
**        OLD - OUTPUT *L* DISPLAY DATA.
*
*         *OLD* OUTPUTS THE DATA IN THE *L* DISPLAY BUFFER, THE
*         OPERATOR INPUT AND THE ERROR MESSAGE, IF ANY, TO THE
*         OPERATOR CONSOLE *L* DISPLAY.
*
*         ENTRY  (EMOR) = *L* DISPLAY MESSAGE INDEX.
*                (CMPB) = INDEX INTO *PADT*.
*
*         USES   X - 1, 2, 3, 5, 6.
*                A - 1, 5.
*
*         CALLS  FDB, GSD, IDT, ZTB.
*
*         MACROS DSDOUT, MOVE.
 
 
 OLD      SUBR               ENTRY/EXIT
          RJ     IDT         INITIALIZE DISPLAY TEMPLATES
          RJ     GSD         GET *SCT* DATA
 
*         SET OPERATOR INPUT AND ERROR MESSAGE IN BUFFER.
 
          SA1    CPAG        GET INDEX OF PAGE TO DISPLAY
          SA5    X1+LDPT
          SA3    EMOR        GET MESSAGE ORDINAL
          SX3    TMLD+X3     GET MESSAGE FOR *L* DISPLAY
          LX5    -18         RIGHT JUSTIFY MESSAGE BUFFER ADDRESS
          MOVE   3,X3,X5     SET MESSAGE IN BUFFER
          SB2    LCOMU-1     OPERATOR INPUT LINE LENGTH
          SA1    IBUF        FIRST WORD OF OPERATOR INPUT
 OLD1     ZR     B2,OLD2     IF ALL WORDS CONVERTED
          RJ     ZTB         CONVERT ALL ZERO BYTES TO BLANKS
          SA6    A1          REPLACE IN *IBUF*
          SB2    B2-B1       DECREMENT NUMBER OF WORDS TO CONVERT
          SA1    A1+1        NEXT WORD IN *IBUF*
          EQ     OLD1        CONVERT NEXT WORD
 
 OLD2     SX3    IBUF        GET OPERATOR INPUT
          LX5    -18         RIGHT JUSTIFY INPUT BUFFER ADDRESS
          MOVE   6,X3,X5     SET OPERATOR INPUT IN BUFFER
 
*         FORMAT AND OUTPUT *L* DISPLAY BUFFER.
 
          SX2    B0+         INDICATE *L* DISPLAY FOR *FDB*
          SA1    CPAG        GET FWA BUFFER TO FORMAT
          SA1    X1+LDPT
          SX6    X1+SDTAL-1  LWA BUFFER TO FORMAT
          RJ     FDB         FORMAT *L* DISPLAY BUFFER
          DSDOUT LFWA        DISPLAY *L* DISPLAY BUFFER
          EQ     OLDX        RETURN
 WOS      SPACE  4,15
**        WOS - WRITE ORIGINS-S SERVICE CLASS(ES).
*
*         *WOS* WRITES THE ORIGIN-S SERVICE CLASSES TO THE
*         APPROPRIATE AREAS IN THE *L* DISPLAY TEMPLATES.
*
*         ENTRY  (WBUF) = ADDRESS OF FIRST *SCT* ENTRY.
*
*         EXIT   SERVICE CLASS DATA SET IN TEMPLATES.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 4, 5.
 
 
 WOS      SUBR               ENTRY/EXIT
 
*         INITIALIZE FOR PROCESSING LOOP.
 
          SB2    TJOS        FWA OF WORD TO FILL IN TEMPLATE
          SB3    NSPL        NUMBER OF SERVICE CLASSES PER LINE
          SA1    TSCT-1      FWA-1 OF SERVICE CLASS TABLE
          SA2    B2
          SA2    X2          GET FIRST TEMPLATE WORD
          SA3    WBUF        FWA OF *SCT* DATA BUFFER
          MX0    -36
          BX3    -X0*X3
          SX6    B1+         USED TO TOGGLE WRITE WORD FLAG
          SX5    B0+         CLEAR WRITE WORD FLAG
 
*         MAIN PROCESSING LOOP.
 
 WOS1     SA1    A1+B1       GET NEXT ENTRY IN SERVICE CLASS TABLE
          ZR     X1,WOS2     IF END OF TABLE
 
*         CHECK FOR MATCH WITH TABLE ENTRY.
 
          BX4    -X0*X1      GET SERVICE CLASS MASK
          BX4    X3*X4
          ZR     X4,WOS1     IF NOT A MATCH, CHECK NEXT ENTRY IN TABLE
 
*         PROCESS SERVICE CLASS MATCH.
 
          MX0    12          GET SERVICE CLASS MNEMONIC
          BX4    X0*X1
          BX2    -X0*X2      CLEAR TWO CHARACTERS FOR SERVICE CLASS
          MX0    -36
          BX2    X4+X2       SET SERVICE CLASS INTO WORD
          LX2    30
          BX5    X6-X5       TOGGLE WRITE WORD FLAG
          SB3    B3-1
          NZ     X5,WOS3     IF WRITE WORD FLAG IS SET
          ZR     B3,WOS3     IF END OF LINE
          EQ     WOS1        LOOP FOR NEXT SERVICE CLASS
 
*         PROCESS END OF SERVICE CLASS TABLE.
 
 WOS2     SX5    B1+         SET WRITE WORD FLAG
 
*         WRITE WORD IN TEMPLATE.
 
 WOS3     SB5    B3-NSPL+1
          ZR     B5,WOS4     IF ONLY ONE SERVICE CLASS THIS LINE
          SX4    B3
          BX4    X5*X4
          NZ     X4,WOS4     IF JUSTIFICATION NOT NEEDED
          LX2    30
 WOS4     BX7    X2
          SA7    A2          SET WORD IN TEMPLATE
          ZR     X1,WOS6     IF END OF THIS ORIGIN TYPE
 
*         CHECK NEXT SERVICE CLASS FOR THIS ORIGIN TYPE.
 
          ZR     B3,WOS5     IF END OF LINE
          SA2    A2+1        SET NEXT WORD IN TEMPLATE
          EQ     WOS1        LOOP FOR NEXT SERVICE CLASS
 
*         RESET FOR NEXT LINE IN TEMPLATE.
 
 WOS5     SA2    A2+1        GET FIRST WORD NEXT LINE IN TEMPLATE
          SB3    NSPL
          EQ     WOS1        LOOP FOR NEXT SERVICE CLASS
 
*         PROCESS END OF THIS ORIGIN TYPE.
 
 WOS6     SB2    B2+B1       GET FWA OF NEXT LINE IN TEMPLATE
          SA2    B2
          ZR     X2,WOS7     IF END OF DATA
          SA2    X2          GET FIRST WORD NEXT LINE IN TEMPLATE
          BX5    X5-X5       CLEAR WRITE FLAG
          SB3    NSPL
          SA1    TSCT-1
          SA3    A3+1        GET NEXT WORD IN *SCT* BUFFER
          EQ     WOS1        LOOP FOR NEXT SERVICE CLASS
 
*         ADD LINE TERMINATORS TO ALL SERVICE CLASS DATA LINES.
 
 WOS7     MX0    48          MASK FOR ZERO BYTE TERMINATOR
          SB3    TJOS-1      INITIALIZE AREAS TO PROCESS
 WOS8     SB3    B3+B1       GET FWA OF AREA TO PROCESS
          SA2    B3
          ZR     X2,WOSX     IF ALL AREAS PROCESSED
          SA2    X2-1
          SB4    4           NUMBER OF DATA LINES PER AREA
 WOS9     SA2    A2+6        LAST WORD IN LINE
          BX6    X0*X2       ADD IN ZERO BYTE TERMINATOR
          SA6    A2          REPLACE IN BUFFER
          SB4    B4-1        COUNT ONE LINE
          NZ     B4,WOS9     IF MORE LINES IN THIS AREA
          EQ     WOS8        PROCESS NEXT SERVICE CLASS AREA
 TJOS     SPACE  4,10
**        TJOS - TABLE OF JOB ORIGIN SERVICE CLASS LIST.
*
*T        42/0,18/SCOA
*
*         (SCOA) = FWA OF SERVICE CLASS OUTPUT AREA.
 
 
 TJOS     BSS    0
          VFD    42/0,18/SDSO
          VFD    42/0,18/SDBO
          VFD    42/0,18/SDRB
          VFD    42/0,18/SDIO
          CON    0           END OF TABLE
 WPO      SPACE  4,20
**        WPO - WRITE PRIORITY ORDERED SERVICE CLASSES.
*
*         *WPO* WRITES THE PRIORITY ORDERED SERVICE CLASSES TO THE
*         APPROPRIATE AREAS IN THE *L* DISPLAY TEMPLATES.
*
*         ENTRY  TPOS = TABLE OF PRIORITY ORDERED SERVICE CLASSES IN
*                       TEMPLATES.
*                (WBUF) = ADDRESS OF FIRST *SCT* ENTRY.
*
*         EXIT   PRIORITY ORDERED SERVICE CLASSES SET IN TEMPLATES.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                A - 1, 3, 5, 7.
*                B - 2, 3.
*
*         MACROS MOVE.
 
 
 WPO      SUBR               ENTRY/EXIT
          MOVE   PBUFL,WPOA,PBUF  RE-INITIALIZE *PBUF*
          SB2    NPXW        NUMBER OF SERVCE CLASSES PER WORD
          SB3    NUMPX       NUMBER OF PRIORITY ORDERED SERVICE CLASSES
          SA1    PBUF        FWA OF TEMPORARY BUILD BUFFER
          SA3    WBUF+PLSC   FWA OF PRIORITY ORDERED SERVICE CLASS DATA
          MX0    12          MASK FOR SERVICE CLASSES
          SX6    B1          USED TO TOGGLE WRITE FLAG
          SX5    B0+         CLEAR WRITE FLAG
 
*         PROCESS ALL PRIORITY ORDERED SERVICE CLASSES.
 
 WPO1     BX4    X0*X3       GET NEXT SERVICE CLASS
          SB3    B3-B1       COUNT ONE SERVICE CLASS
          SB2    B2-1        COUNT ONE SERVICE CLASS THIS LINE
          LX3    12
          BX5    X6-X5       TOGGLE WRITE FLAG
          ZR     X4,WPO2     IF NO SERVICE CLASS PRESENT
          BX1    -X0*X1      CLEAR 2 CHARACTERS
          BX1    X1+X4       SET SERVICE CLASS
 WPO2     LX1    30
          NZ     B2,WPO3     IF MORE SERVCE CLASSES THIS LINE
          SB2    NPXW
          SA3    A3+1        GET MORE SERVCE CLASSES FROM SYSTEM BUFFER
 WPO3     NZ     X5,WPO4     IF WRITE FLAG SET
          NZ     B3,WPO1     IF MORE SERVICE CLASSES
 
*         WRITE CURRENT WORD TO BUILD BUFFER.
 
 WPO4     NZ     B3,WPO5     IF NOT END OF SERVICE CLASSES
          LX1    30
          BX7    X1          WRITE LAST SERVICE CLASS ENTRY
          SA7    A1+
          EQ     WPO6        SET SERVICE CLASSES IN TEMPLATES
 
 WPO5     BX7    X1          WRITE CURRENT WORD TO BUILD BUFFER
          SA7    A1+
          SA1    A1+B1       NEXT WORD IN BUILD BUFFER
          EQ     WPO1        LOOP FOR NEXT SERVICE CLASS
 
*         SET PRIORITY ORDERED SERVICE CLASSES INTO TEMPLATES.
 
 WPO6     SA5    TPOS        TABLE OF TEMPLATE ADDRESSES
 WPO7     ZR     X5,WPOX     IF NO MORE PAGES IN TEMPLATE
          MOVE   PBUFL,PBUF,X5  PUT DATA INTO TEMPLATE
          SA5    A5+B1       NEXT TEMPLATE ADDRESS
          EQ     WPO7        LOOP FOR NEXT TEMPLATE PAGE
 
 
 WPOA     DATA   50H
 TPOS     SPACE  4,10
**        TPOS - TABLE OF PRIORITY ORDERED SERVICE CLASS ORIGINS.
*
*T        42/0,18/ADDR
*
*         (ADDR) = ADDRESS OF DATA OUTPUT AREA ON TEMPLATE PAGE.
 
 TPOS     BSS    0
          VFD    42/0,18/SDPA
          VFD    42/0,18/SDPB
          CON    0           END OF TABLE
          SPACE  4,20
*         COMMON DECKS.
 
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCFLD
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCPOP
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCUSB
*CALL     COMCWOD
*CALL     COMCWTC
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFER AREA.
          USE    BUFFERS
 
 SDTA     SPACE  4,5
**        SERVICE CLASS DISPLAY TEMPLATES.
 
 SDTH     BSS    0           HEADER FOR PRINT OPTION
          DATA   50HSCTD - SERVICE CLASS CONTROL TABLE DISPLAY
 SDAT     BSSZ   1           DATE STAMP
 STIM     BSSZ   1           TIME STAMP
          CON    0
 
 SDTA     BSS    0           PAGE 1 DATA
          DATA   50HSERVICE CLASS CONTROL TABLE DISPLAY            PAG
          DATA   8CE 1 OF 2
          DATA   C* *
          DATA   58C   SYSTEM ORIGIN SERVICE CLASSES
          DATA   C* *
 SDSO     DATA   60H
          DATA   60H
          DATA   60H
          DATA   60H
          DATA   C* *
          DATA   58C   LOCAL BATCH ORIGIN SERVICE CLASSES
          DATA   C* *
 SDBO     DATA   60H
          DATA   60H
          DATA   60H
          DATA   60H
          DATA   C* *
          DATA   58C   PRIORITY ORDERED SERVICE CLASSES
          DATA   C* *
          DATA   58C     P0   P1   P2   P3   P4   P5   P6   P7
 SDPA     DATA   50C
 SDMP     EQU    *-SDTA      MESSAGE LINE POSITION IN TEMPLATE
          DATA   28C
 SDIP     EQU    *-SDTA      INPUT LINE POSITION IN TEMPLATE
          DATA   50C
 SDTAL    EQU    *-SDTA      LENGTH OF HEADER BUFFER
 SDTAE    EQU    *-1         END OF PAGE 1
 SDTB     BSS    0           PAGE 2 DATA
          DATA   50HSERVICE CLASS CONTROL TABLE DISPLAY            PAG
          DATA   8CE 2 OF 2
          DATA   C* *
          DATA   58C   REMOTE BATCH ORIGIN TYPE SERVICE CLASSES
          DATA   C* *
 SDRB     DATA   60H
          DATA   60H
          DATA   60H
          DATA   60H
          DATA   C* *
          DATA   58C   INTERACTIVE ORIGIN SERVICE CLASSES
          DATA   C* *
 SDIO     DATA   60H
          DATA   60H
          DATA   60H
          DATA   60H
          DATA   C* *
          DATA   58C   PRIORITY ORDERED SERVICE CLASSES
          DATA   C* *
          DATA   58C     P0   P1   P2   P3   P4   P5   P6   P7
 SDPB     DATA   50C
          DATA   28C
          DATA   50C
 SDTBL    EQU    *-SDTB      LENGTH OF PAGE 2 TEMPLATE
 SDTBE    EQU    *-1         END OF PAGE 2
          ERRNZ  SDTBL-SDTAL TEMPLATES NOT SAME LENGTH
 
 IPW      BSS    0           INPUT BUFFER FOR *L* DISPLAY
          VFD    12/6,1/0,1/0,46/0
 IBUF     BSS    LCOMU       INPUT BUFFER
 
*         SCRATCH BUFFER.
 
 PBUF     DATA   50H
 PBUFL    EQU    *-PBUF      *PBUF* LENGTH
 
*         *L* DISPLAY BUFFER.
 
 LFWA     VFD    12/LBUFL,1/0,1/0,46/0  *L* DISPLAY CONTROL WORD
 LBUF     EQU    *           *L* DISPLAY BUFFER STARTS HERE
 LBUFE    EQU    LBUF+LBUFL  END OF *L* DISPLAY BUFFER
          ERRNG  LFWA-SDTBE  TEMPLATE OVERFLOWS *L* DISPLAY BUFFER
          ERRNG  LBUFL-SDTAL TEMPLATE IS LARGER THAN *LBUF*
 
*         OUTPUT FILE BUFFER.
 
 OBUF     EQU    LBUF        OUTPUT BUFFER OVERLAYS *L* DISPLAY BUFFER
 OBUFE    EQU    OBUF+SDTAE-SDTH  END OF OUTPUT BUFFER
 
*         *SFM* WORKING BUFFER.
 
 .WBUF    MAX    LBUFE,OBUFE
 WBUF     EQU    .WBUF       *WBUF* FOLLOWS *OBUF* AND *LBUF*
 WBUFE    EQU    WBUF+SCTL   END OF *WBUF*
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE.
*
*         ENTRY  CONTROL STATEMENT ARGUMENT LIST AT RA+2 (ARGR)
*                IN OPERATING SYSTEM FORMAT.
*
*         EXIT   (B1) = 1.
*                (PFLG) = 1, IF PRINT FILE REQUESTED.
*                (LFLG) = 1, IF *L* DISPLAY REQUESTED.
*
*         ERROR  TO *ERR*, IF ARGUMENT ERROR OR INCORRECT USER ACCESS.
*                (X2) = FWA ERROR MESSAGE.
*
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2, 3, 6.
*                B - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ARM, CPA, FNB, USB.
*
*         MACROS ARG, CLOCK, DATE, GETSPS, SUBR.
 
 
*         SET DATE AND TIME IN HEADER.
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           SYSTEM COMMUNICATION (B1)=1
          DATE   SDAT
          CLOCK  STIM
          GETSPS SYOF        CHECK FOR SYSTEM ORIGIN PRIVILEGES
          SA1    SYOF
          ZR     X1,PRS1     IF SYSTEM ORIGIN PRIVILEGES
          SX2    ERIU        *INCORRECT USER ACCESS.*
          EQ     ERR         ABORT
 
*         PROCESS ARGUMENT LIST.
 
 PRS1     SB2    CCDR        UNPACK CONTROL CARD
          RJ     USB
          SA1    A6          ASSURE TERMINATOR CHARACTER
          SX6    1R.
          SA6    X1+B1
          SA2    PRSB        SET SEPARATOR MASK
          SB2    60          SET MAXIMUM NON-DELIMITER DISPLAY CODE
          SB7    PRS9        SET EXIT FOR TERMINATOR CHARACTER
          RJ     FNB         FIND NON-BLANK CHARACTER
 
*         SKIP PROGRAM NAME.
 
          SB7    PRS6        SET EXIT FOR TERMINATOR CHARACTER
 PRS4     RJ     FNB         FIND NON-BLANK CHARACTER
          SB4    B5-B2
          LX4    X2,B5
          PL     B4,PRS5     IF SEPARATOR CHARACTER
          PL     X4,PRS4     IF NOT SEPARATOR CHARACTER
 PRS5     SB3    TARG        FWA ARGUMENT EQUIVALENCE TABLE
          SB2    TARGL       LENGTH ARGUMENT TABLE
          SB4    PRSA        ADDRESS TO PLACE DATA
          RJ     CPA         CONVERT POSITIONAL ARGUMENTS
          NG     B5,PRS9     IF ARGUMENT ERROR
          PL     X1,PRS6     IF NO ARGUMENTS PROCESSED
          SX6    B5+         SET LWA OF ARGUMENTS
          SA6    USBC
          SB6    PRSA        FWA OF ARGUMENTS
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,PRS9     IF ERROR
 
*         DETERMINE LIST OPTIONS.
 
 PRS6     SA1    LO          GET CHARACTER FROM LIST OPTION
          SA2    TLOP-1
          MX0    6
          SB4    A2+         SAVE ADDRESS OF ARGUMENT TABLE
 PRS7     BX3    X0*X1       PROCESS NEXT CHARACTER FROM LIST OPTION
          ZR     X3,PRSX     IF ALL OPTIONS PROCESSED
 PRS8     SA2    A2+B1       SEARCH ARGUMENT TABLE
          ZR     X2,PRS9     IF LIST OPTION NOT DEFINED IN TABLE
          BX4    X0*X2
          BX4    X4-X3
          NZ     X4,PRS8     IF MATCH NOT FOUND
          SX6    B1          SET FLAG FOR THIS OPTION
          SA6    X2
          SX3    A2-TLOP
          LX1    6
          SA2    B4          INITIALIZE TABLE ADDRESS
          NZ     X3,PRS7     IF NOT LO=D
          MX4    -12
          SA3    JOPR        CHECK FOR SYSTEM ORIGIN
          LX3    0-24
          BX3    -X4*X3
          SX3    X3-SYOT
          ZR     X3,PRS7     IF SYSTEM ORIGIN JOB
          SX2    ERIU        *INCORRECT USER ACCESS.*
          EQ     ERR         ABORT
 
 PRS9     SX2    ERAR        *ARGUMENT ERROR.*
          EQ     ERR         ABORT
 
 PRSA     BSS    100
 
 PRSB     CON    40000000000033127777B  SEPARATOR MASK
 
**        ASSUMED VALUES FOR LIST OPTIONS.
 
 
 LO       CON    0LD         SELECTED LIST OPTION (DEFAULT = *D*)
          SPACE  4,10
**        ARGUMENT EQUIVALENCE TABLE.
 
 
 TARG     BSS    0
 L        ARG    O,O,0,0     OUTPUT FILE NAME
 LO       ARG    LO,LO,0,0   LIST OPTIONS
          ARG                END OF ARGUMENT TABLE
 TARGL    EQU    *-TARG-1    LENGTH OF ARGUMENT TABLE
 TLOP     SPACE  4,15
**        TLOP - TABLE OF LIST OPTIONS.
*
*T,       42/ OPTION,18/ ADDR
*
*         (ADDR) WILL BE SET NON-ZERO IN PRS IF OPTION IS SELECTED.
 
 
 TLOP     BSS    0
          VFD    42/0LD,18/LFLG  SELECT *L* DISPLAY
          VFD    42/0LL,18/PFLG  SELECT LINE PRINTER
          CON    0           END OF TABLE
 FNB      SPACE  4,15
**        FNB - FIND NON-BLANK CHARACTER.
*
*         ENTRY  (B6) = NEXT CHARACTER ADDRESS.
*                (B7) = EXIT ADDRESS, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   (X1) = (B5) = NEXT NON-BLANK CHARACTER.
*                (B6) = NEXT CHARACTER ADDRESS (UPDATED).
*                EXIT IS MADE TO (B7), IF TERMINATOR ENCOUNTERED.
*
*         USES   X - 1, 4.
*                A - 1.
*                B - 1, 5, 6, 7.
*
*         CALLS  ARM, CPA, FNB, USB.
*
*         MACROS CLOCK, DATE, GETSPS, SUBR.
 
 
 FNB      SUBR               ENTRY/EXIT
 FNB1     SA1    B6          GET NEXT CHARACTER
          SB6    B6+B1
          SX4    X1-1R
          ZR     X4,FNB1     IF BLANK CHARACTER
          SB5    X1+
          SX4    X1-1R.
          ZR     X4,FNB2     IF TERMINATOR CHARACTER
          SX4    X1-1R)
          NZ     X4,FNBX     IF NOT TERMINATOR CHARACTER, RETURN
 FNB2     JP     B7          TERMINATOR CHARACTER
          TITLE  PRESET COMMON DECKS.
*CALL     COMCARM
*CALL     COMCCPA
          SPACE  4,5
 SCTDE    EQU    *           END OF PROGRAM
 .RFL=    MAX    SCTDE,WBUFE
 RFL=     EQU    .RFL=
          SPACE  4,5
          END