Retro1.org codex

          IDENT  SUBSYST,SUB 
          ABS
          SST
          ENTRY  SUBSYST
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
          TITLE SUBSYST - SUBSYSTEM DISPLAY.
*COMMENT  SUBSYST - SUBSYSTEM DISPLAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       SUBSYST - SUBSYSTEM DISPLAY.
*
*         B. J. OLIPHANT     81/04/18.
*         R. C. SCHMITTER    83/09/15.
*         J. M. MAREK        84/05/16.
          SPACE  4,10
***       *SUBSYST* IS A CPU UTILITY USED BY THE OPERATOR TO DISPLAY
*         THE STATUS OF THE SUBSYSTEMS SUPPORTED BY THE OPERATING
*         SYSTEM.  THIS INFORMATION CAN BE DISPLAYED ON A PRINTER
*         LISTING OR THE *L* DISPLAY.  THE STATUS OF A SUBSYSTEM
*         CAN BE CHANGED BY OPERATOR *L* DISPLAY COMMANDS.
          SPACE  4,15
***       COMMAND FORMAT.
*
*
*         SUBSYST(LFN,OP)    ORDER DEPENDENT PARAMETERS.
*          OR
*         SUBSYST(L=LFN,LO=OP)  ORDER INDEPENDENT (KEYWORD = PARAMETER)
*
*          WHERE
*
*         OP = *L*           FORMAT DATA FOR A LINE PRINTER.
*
*         OP = *D*           FORMAT DATA FOR THE *L* DISPLAY (DEFAULT).
*
*         OP = *DL* OR *LD*  FORMAT DATA FOR THE *L* DISPLAY AND FORMAT
*                            IT FOR A LINE PRINTER WHEN *L.END* IS
*                            ENTERED.
*
*         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,15
***       DAYFILE MESSAGES.
*
*         THESE MESSAGES ARE ISSUED TO THE JOB AND SYSTEM DAYFILES.
*
*         *ARGUMENT ERROR.*
*                AN INCORRECT PARAMETER WAS ENTERED. (FATAL ERROR)
*
*         *USER ACCESS NOT VALID.*
*                CALLING JOB WAS NOT SYSTEM ORIGIN. (FATAL ERROR)
*
*         *SUBSYST UTILITY COMPLETE.*
*                INDICATES NORMAL COMPLETION OF PROGRAM.
          SPACE  4,10
***       *L* DISPLAY MESSAGES.
*
*         *COMMAND PROCESSED.*
*                INDICATES COMMAND IS VALID AND CHANGE HAS BEEN MADE.
*
*         *CONTROL POINT NOT ALLOWED.*
*                THE SPECIFIED SUBSYSTEM DOES NOT ALLOW THE CONTROL
*                POINT FOR ITS EXECUTION TO BE CHANGED.
*
*         *INCORRECT COMMAND.*
*                THE ENTERED COMMAND IS NOT ONE OF THE DEFINED
*                *SUBSYST* COMMANDS - (ENABLE, DISABLE, OUT, END).
*
*         *INCORRECT COMMAND FORMAT.*
*                AN ILLEGAL SEPARATOR OR EXTRA PARAMETERS WERE
*                ENTERED FOR THE COMMAND.
*
*         *INCORRECT CONTROL POINT.*
*                THE ENTERED CONTROL POINT NUMBER IS NOT VALID.  IT
*                MUST BE AN OCTAL NUMBER LESS THAN THE NUMBER OF
*                CONTROL POINTS DEFINED IN THE SYSTEM.
*
*         *SECURITY UNLOCK REQUIRED.*
*                IN A SECURED SYSTEM, SECURITY UNLOCK STATUS IS
*                REQUIRED TO ENABLE RDF.
*
*         *UNKNOWN SUBSYSTEM.*
*                THE ENTERED SUBSYSTEM NAME IS NOT ONE DEFINED IN
*                *COMSSSD*.
*
*         *UTILITY COMPLETE.*
*                INFORMATIVE MESSAGE ISSUED AFTER *END*.
          SPACE  4,25
***       AVAILABLE *L* DISPLAY COMMANDS.
*
*         L.END              TERMINATES THE UTILITY.  IF *OP=L* WAS
*                            SPECIFIED, A LISTING WILL BE ROUTED TO
*                            A PRINTER.
*
*         L.OUT              ROUTES A LISTING OF THE DISPLAY TO A
*                            PRINTER.
*
*         L.ENABLE,SUB.      SETS STATUS OF SUBSYSTEM *SUB* TO ENABLED.
*         L.ENABLE,SUB,CP.   ADDITIONALLY SETS THE CONTROL POINT WHERE
*                            THE SUBSYSTEM MUST EXECUTE.
*
*         L.DISABLE,SUB.     SETS STATUS OF SUBSYSTEM *SUB* TO DISABLED
*         L.DISABLE,SUB,CP.  ADDITONALLY SETS THE CONTROL POINT WHERE
*                            THE SUBSYSTEM MUST EXECUTE.
*
*         L.+                DISPLAY THE NEXT PAGE OF SUBSYSTEMS.  WHEN
*                            THE CURRENT PAGE IS THE LAST PAGE, THE
*                            NEXT PAGE IS THE FIRST PAGE.
*
*         L.-                DISPLAY THE FIRST PAGE OF SUBSYSTEMS.
          SPACE  4,15
***       OUTPUT FORMAT.
*
*          SUBSYST - SUBSYSTEM STATUS.   84/05/16. 15.04.37.
*
*                         SUBSYSTEMS
*
*                     REQUIRED       EJT
*           NAME   CONTROL POINT   ORDINAL   STATUS
*
*           IAF          1            10    ENABLED
*           RHF                             DISABLED
*
*
*         NOTE - THE FIRST TWO LINES ONLY APPEAR WHEN THE DATA IS
*         FORMATTED FOR A LISTING.
          SPACE  4,10
***       DEFINITION COMMON DECKS.
*
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMCDCM
*CALL     COMSDSP
*CALL     COMSEVT
*CALL     COMSSFM
*CALL     COMSSSD
*CALL     COMSSSJ
          SPACE  4,10
*         MACROS.
 SUBSYST  SPACE  4,10
**        SUBSYST - GENERATE SUBSYSTEM TABLE.
*
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT
*
*         ENTRY  *NAME* = THREE CHARACTER SUBSYSTEM NAME.
*                *ID* = SUBSYSTEM ID.
*                *CP* = *YES* IF CONTROL POINT ALLOWED ON *ENABLE*
*                       AND *DISABLE*.
*
*T        42/ NAME (LEFT JUSTIFIED), 18/ FLAG
*
*         FLAG = 1, IF CONTROL POINT ALLOWED ON *ENABLE/DISABLE*.
*              = 0, IF CONTROL POINT NOT ALLOWED.
 
 
          PURGMAC  SUBSYST
 
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB
 .SUB     RMT
 .1       SET    TSSN
          ORG    .1+MXSI-ID
          LOC    MXSI-ID
          VFD    42/3L_NM
 .A       IFC    EQ,$CP$YES$
          VFD    18/1
 .A       ELSE
          VFD    18/0
 .A       ENDIF
 .SUB     RMT
 SUBSYST  ENDM
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS.
 
 CBUFL    EQU    5           COMMAND BUFFER LENGTH
 HLIN     EQU    5           NUMBER OF LINES IN HEADER
 INPC     EQU    0           *L* DISPLAY INPUT COMPLETE STATUS
 LBIL     EQU    LCOM/2      *L* DISPLAY INPUT BUFFER LENGTH
 LBUFL    EQU    LDSY        *L* DISPLAY OUTPUT BUFFER LENGTH
 LLIN     EQU    22D         NUMBER OF LINES ON *L* DISPLAY
 LDAT     EQU    LLIN-HLIN-3 NUMBER OF DATA LINES ON THE *L* DISPLAY
 MBUFL    EQU    3           MESSAGE BUFFER LENGTH
.NSS      SET    MXSI-LSSI   MAXIMUM NUMBER OF SUBSYSTEMS SUPPORTED
 OBUFL    EQU    101B        OUTPUT BUFFER LENGTH
 XCDT     EQU    9           X - COORDINATE FOR *L* DISPLAY
 YCDT     EQU    2           Y - COORDINATE FOR *L* DISPLAY
 
****
          TITLE  TABLES AND BUFFER DEFINITIONS.
          ORG    111B
 SUB      BSS    0
          SPACE  4,10
*         DAYFILE MESSAGES.
 
 DASC     DATA   C* SUBSYST UTILITY COMPLETE.*
 ERAR     DATA   C* ARGUMENT ERROR.*
 ERIU     DATA   C* USER ACCESS NOT VALID.*
          SPACE  4,10
*         *L* DISPLAY MESSAGES.
 
 MESA     DATA   28CINCORRECT COMMAND.
 MESB     DATA   28CUNKNOWN SUBSYSTEM.
 MESC     DATA   28CINCORRECT CONTROL POINT.
 MESD     DATA   28CINCORRECT COMMAND FORMAT.
 MESE     DATA   28CCONTROL POINT NOT ALLOWED.
 MESF     DATA   28CCOMMAND PROCESSED.
 MESG     DATA   28CUTILITY COMPLETE.
 MESH     DATA   28C
 MESI     DATA   28CSECURITY UNLOCK REQUIRED.
          SPACE  4,10
*         FLAG DEFINITIONS.
 
 LFLG     CON    0           *L* DISPLAY FLAG
 OSSM     CON    0           OPERATING SYSTEM SECURITY MODE
 PFLG     CON    0           PRINTER OUTPUT FLAG
 SYOF     CON    0           SYSTEM ORIGIN FLAG
          SPACE  4,10
*         *L* DISPLAY BUFFER FIRST WORD.
*
*         T,     12/ N ,1/ S ,1/ F ,46/
*
*         N      SIZE OF DISPLAY BUFFER.
*         S      CHARACTER SIZE.
*         F      DATA FORMAT BIT.
 
 
 LDIW     VFD    12/LBIL,48/0   INPUT BUFFER FIRST WORD
 LDSW     VFD    12/LBUFL,48/0  OUTPUT BUFFER FIRST WORD
 ROLL     SPACE  4,10
*         ROLLOUT PARAMETER BLOCK.
 
 ROLL     VFD    30/0,18/LINE,12/10
 ROTB     SPACE  4,10
*         ROUTE PARAMETER BLOCK.
 
 ROTB     DATA   6LOUTPUT
          BSSZ   DPBL-1
          SPACE  4,10
*         *SFM* PARAMETER BLOCK.
 
 
 SFMB     VFD    12/RSSF,12/0,12/.NSS,6/0,18/WBUFA
          CON    0           END OF *SFM* PARAMETER BLOCK
          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,OBUFL,(FET=6)
          SPACE  4,10
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO CALLS
*CALL     COMSSSD
 SUBSYST  TITLE  MAIN PROGRAM.
**        SUBSYST - MAIN PROGRAM.
*
*         USES   X - 1, 5.
*                A - 1.
*                B - 7.
*
*         CALLS  FDB, PKB, PRS, RSD.
*
*         MACROS DSDINP, ENDRUN, MESSAGE, ROUTE, WRITER.
 
 
 SUBSYST  BSS    0           ENTRY
          RJ     PRS         PRESET ROUTINE
          RJ     RSD         READ SUBSYSTEM DATA
          SA1    LFLG
          ZR     X1,SUB1     IF ONLY PRINTER OUTPUT SELECTED
          SX5    B0+
          SX6    MESH        BLANK MESSAGE
          RJ     FDB         FORMAT DISPLAY
          RJ     PKB         PROCESS KEYBOARD
          DSDINP LBFI,C      DROP *L* DISPLAY
          EQ     SUB2        COMPLETE
 
 SUB1     SX5    O
          RJ     FDB         FORMAT LISTING
          WRITER O,R
          ROUTE  ROTB,R
 SUB2     MESSAGE  DASC,0,R  * SUBSYST UTILITY COMPLETE.*
          ENDRUN
          TITLE  SUBROUTINES.
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         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,10
**        FDB - FORMAT DISPLAY BUFFER.
*
*         ENTRY  (X5) = 0, IF FORMATTING FOR *L* DISPLAY.
*                      .EQ. FET ADDRESS OF OUTPUT FILE IF FOR PRINTER.
*                (X6) = ADDRESS OF DISPLAY MESSAGE.
*                (HBUF) = FWA OF FORMATTED SUBSYSTEM DATA.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 4, 7.
*                B - 2, 3, 4, 6.
*
*         CALLS  FLB, WSB.
*
*         MACROS DSDOUT.
 
 
 FDB      SUBR               ENTRY/EXIT
          RJ     WSB         WRITE SUBSYSTEM INFORMATION BUFFER
 
*         SET UP PARAMETERS FOR *FLD*.
 
          SB2    LBUF+1      FWA OF BUFFER TO RECEIVE CONVERTED DATA
          SB6    LBUF+LBUFL  LWA+1 OF BUFFER TO RECEIVE CONVERTED DATA
          SX1    HBUF        FWA OF UNCONVERTED DATA FOR PRINTER
          SX6    A0-1        LWA OF UNCONVERTED DATA
          NZ     X5,FDB1     IF FORMATTING FOR PRINTER
          SA4    LDSW        INITIALIZE *L* DISPLAY BUFFER
          SX1    HBUF1       FWA OF BUFFER FOR *L* DISPLAY
          BX7    X4
          SA7    B2-B1
          SB3    XCDT        SET X-COORDINATE FOR *L* DISPLAY
          SB4    YCDT        SET Y-COORDINATE FOR *L* DISPLAY
 FDB1     SX3    B1          *C* DISPLAY FORMAT
          BX2    X5
          RJ     FLB         FORMAT DATA FOR *L* DISPLAY
          NZ     X5,FDBX     IF FORMATTING FOR PRINTER
          DSDOUT LBUF        DISPLAY *L* DISPLAY BUFFER
          EQ     FDBX        RETURN
 PKB      SPACE  4,10
**        PKB - PROCESS KEYBOARD.
*
*         PROCESSES INPUT FROM OPERATOR UNTIL *L.END* IS ENTERED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 7.
*
*         CALLS  DXB, FDB, POP, RSD, USB.
*
*         MACROS DSDINP, ROLLOUT, ROUTE, SYSTEM, WRITER.
 
 
 PKB      SUBR               ENTRY/EXIT
          SA1    LDIW        INITIALIZE THE INPUT BUFFER CONTROL WORD
          MX6    0           ENSURE AN END OF LINE IN COMMAND BUFFER
          SA6    LBFI+LBIL+1
          BX6    X1
          SA6    LBFI
          SB7    B0          CLEAR REFRESH REQUIRED
 PKB1     DSDINP LBFI        REQUEST *L* DISPLAY INPUT
          SA2    LBFI        CHECK FOR INPUT
          MX0    -12
          BX6    -X0*X2
          AX6    1           IGNORE COMPLETION BIT
          ZR     X6,PKB3     IF INPUT
          ERRNZ  INPC        CODE DEPENDS ON VALUE
          ZR     B7,PKB2     IF REFRESH IS NOT REQUIRED
          RJ     RSD         READ SUBSYSTEM DATA
          SA1    WSBE        GET LAST ERROR MESSAGE
          SX6    X1+
          RJ     FDB         FORMAT DISPLAY BUFFER
 PKB2     ROLLOUT  ROLL      WAIT FOR INPUT
          SB7    B1          SET REFRESH REQUIRED
          EQ     PKB1        INPUT COMMAND
 
 PKB3     SX6    B0+         CLEAR STRING BUFFER
          SB2    80
 PKB4     SA6    USBB+B2
          SB2    B2-1
          PL     B2,PKB4     IF MORE TO CLEAR
 
*         DETERMINE COMMAND.
 
          SB2    LBFI+1      UNPACK COMMAND
          RJ     USB
          RJ     POP         GET FIRST PARAMETER
          ZR     X6,PKB19    IF NO COMMAND VERB
          SB2    B0          INITIALIZE TABLE INDEX
          MX0    42
 PKB5     SA3    TLDC+B2
          ZR     X3,PKB24    IF END OF TABLE
          BX2    X3-X6
          BX2    X0*X2
          SB2    B2+1        ADVANCE INDEX
          NZ     X2,PKB5     IF NO MATCH
          SB3    X3+
          JP     B3          PROCESS COMMAND
 
*         PROCESS *ENABLE*.
 
 PKB6     SX7    B0+         SET ENABLE STATUS
          EQ     PKB8        CONTINUE
 
*         PROCESS *DISABLE*.
 
 PKB7     SX7    1           SET DISABLE STATUS
 PKB8     SA7    PKBB
          SX2    X1-1R,
          NZ     X2,PKB21    IF SEPARATOR NOT *,*
 
*         DETERMINE SUBSYSTEM.
 
          RJ     POP         GET SUBSYSTEM NAME
          SB2    MXSI-LSSI-1 INITIALIZE TABLE INDEX
          MX0    18
 PKB9     NG     B2,PKB22    IF END OF TABLE
          SA3    TSSN+B2
          BX4    X0*X3
          BX2    X4-X6
          SB2    B2-B1
          NZ     X2,PKB9     IF NO MATCH
          SX7    MXSI-1      SAVE SUBSYSTEM ID
          SX2    B2
          IX7    X7-X2
          SA7    PKBA
          SX6    B0+
          SX4    X1-1R,
          ZR     X4,PKB10    IF SEPARATOR IS A *,*
          SX4    X1-1R.
          ZR     X4,PKB13    IF END OF COMMAND
          ZR     X1,PKB13    IF END OF COMMAND
          EQ     PKB21       PROCESS ERROR
 
*         PROCESS CONTROL POINT.
 
 PKB10    BX2    -X0*X3
          ZR     X2,PKB25    IF CONTROL POINT NOT ALLOWED
          RJ     POP         GET CONTROL POINT NUMBER
          SX4    X1-1R.
          MX0    6
          ZR     X4,PKB11    IF END OF COMMAND
          NZ     X1,PKB21    IF ERROR
 PKB11    SX3    1RB         APPEND *B* TO CONTROL POINT
          LX3    -12
          LX0    -12
          BX7    X0*X6
          NZ     X7,PKB23    IF THREE DIGIT CONTROL POINT
          LX0    6
          BX7    X0*X6
          ZR     X7,PKB12    IF ONE DIGIT CONTROL POINT
          LX3    -6
 PKB12    BX5    X6+X3
          SB7    B0          SET OCTAL CONVERSION
          RJ     DXB         CONVERT TO OCTAL
          NZ     X4,PKB23    IF ERROR
          SA2    NCPT        CHECK FOR VALID CONTROL POINT NUMBER
          IX3    X6-X2
          PL     X3,PKB23    IF CONTROL POINT TOO LARGE
          SX6    X6+40B
          LX6    12          POSITION CONTROL POINT NUMBER
 
*         CALL *SFM* TO CHANGE SUBSYSTEM STATUS.
 
 PKB13    SA1    PKBA        ADD SUBSYSTEM ID
          BX6    X1+X6
          SA1    PKBB        ADD ENABLE/DISABLE FLAG
          LX1    18
          BX6    X1+X6
          SA6    PKBC        SAVE *SFM* PARAMETER WORD
          SX1    RDSI
          BX1    X1-X6
          NZ     X1,PKB13.1  IF NOT *ENABLE,RDF.*
          SA1    OSSM
          ZR     X1,PKB13.1  IF SYSTEM NOT SECURED
          MX6    1
          SA6    PKBE
          SYSTEM RSB,R,PKBD  DETERMINE SECURITY UNLOCK STATUS
          SA1    PKBE
          LX1    59-57
          PL     X1,PKB26    IF NOT SECURITY UNLOCK
 PKB13.1  SYSTEM SFM,R,PKBC,SUSF*100B
          RJ     RSD         READ SUBSYSTEM DATA
          SX6    MESF        *COMMAND PROCESSED.*
          EQ     PKB20       WAIT FOR NEXT INPUT
 
*         PROCESS *OUT*.
 
 PKB14    SX3    X1-1R.
          ZR     X3,PKB15    IF END OF COMMAND
          NZ     X1,PKB21    IF ERROR
 PKB15    SX5    O           FORMAT LISTING
          RJ     FDB
          WRITER O,R
          SA1    ROTB        CLEAR COMPLETE BIT
          MX0    42
          BX6    X0*X1
          SA6    A1
          ROUTE  ROTB,R
          SX6    MESF        *COMMAND PROCESSED.*
          EQ     PKB20       WAIT FOR NEXT INPUT
 
*         PROCESS *END*.
 
 PKB16    SX3    X1-1R.
          ZR     X3,PKB17    IF END OF COMMAND
          NZ     X1,PKB21    IF ERROR
 PKB17    SA1    PFLG
          ZR     X1,PKB18    IF NO PRINTER OUTPUT REQUESTED
          SX5    O
          RJ     FDB         FORMAT LISTING
          WRITER O,R
          SA1    ROTB        CLEAR COMPLETE BIT
          MX0    42
          BX6    X0*X1
          SA6    A1
          ROUTE  ROTB,R
 PKB18    SX5    B0+
          SX6    MESG        *UTILITY COMPLETE.*
          RJ     FDB
          EQ     PKBX        RETURN
 
*         PROCESS PAGING COMMANDS.
 
 PKB19    SB3    X1-1R+
          NG     B3,PKB24    IF NEITHER *+* NOR *-*
          GT     B3,B1,PKB24 IF NEITHER *+* NOR *-*
          SA2    WSBC        ALTER PAGING CONTROL WORD
          LX1    59          FORM MASK TO USE OR IGNORE *NEXT* ORDINAL
          AX1    29
          UX2,B3 X2          SAVE MAXIMUM LINE COUNT
          BX2    X2*X1
          AX2    30
          PX6    X2,B3       RESTORE MAXIMUM LINE COUNT
          SA6    A2+
          SX6    MESH        CLEAR MESSAGE LINE
*         EQ     PKB20       WAIT FOR NEXT INPUT
 
*         ROLLOUT UNTIL NEXT *L* DISPLAY INPUT.
 
 PKB20    SX5    B0          FORMAT DISPLAY
          RJ     FDB
          SB7    B0          CLEAR REFRESH REQUIRED
          EQ     PKB1        CHECK FOR INPUT
 
 PKB21    SX6    MESD        *INCORRECT COMMAND FORMAT.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 PKB22    SX6    MESB        *UNKNOWN SUBSYSTEM.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 PKB23    SX6    MESC        *INCORRECT CONTROL POINT.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 PKB24    SX6    MESA        *INCORRECT COMMAND.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 PKB25    SX6    MESE        *CONTROL POINT NOT ALLOWED.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 PKB26    SX6    MESI        *SECURITY UNLOCK REQUIRED.*
          EQ     PKB20       DISPLAY ERROR AND WAIT FOR INPUT
 
 
 PKBA     CON    0           SUBSYSTEM ID
 PKBB     CON    0           ENABLE/DISABLE FLAG
 PKBC     CON    0           *SFM* PARAMETER WORD
 PKBD     VFD    12/,12/1,18/SSTL,18/PKBE
 PKBE     VFD    1/1,59/0    SECURITY UNLOCK STATUS
 NCPT     VFD    1/1,59/0    NUMBER OF CONTROL POINTS
 TLDC     SPACE  4,10
**        TABLE OF *L* DISPLAY COMMANDS.
*
*T        42/ COMMAND, 18/ ADDRESS
 
 TLDC     BSS    0
          VFD    42/6LENABLE,18/PKB6
          VFD    42/7LDISABLE,18/PKB7
          VFD    42/3LOUT,18/PKB14
          VFD    42/3LEND,18/PKB16
          CON    0           END OF TABLE
 TSSN     SPACE  4,10
**        TABLE OF SUBSYSTEM NAMES.
*
*T        42/ NAME (LEFT JUSTIFIED), 18/ FLAG
*
*         FLAG = 1, IF CONTROL POINT ALLOWED ON *ENABLE/DISABLE*.
*              = 0, IF CONTROL POINT NOT ALLOWED.
 
 
 TSSN     BSS    0           TABLE OF SUBSYSTEM NAMES
          LIST   D
 .SUB     HERE
          LIST   *
          ORG    TSSN+MXSI-LSSI
 RSD      SPACE  4,15
**        RSD - RETURN SUBSYSTEM DATA.
*
*         ENTRY  (SFMB) = *SFM* PARAMETER BLOCK SET UP
*                         FOR *RSSF* SUBFUNCTION.
*
*         EXIT   (HTIM) = THE TIME AT WHICH THE DATA WAS READ.
*                (WBUFA - WBUFA+.NSS-1) = SUBSYSTEM INFORMATION.
*
*         MACROS CLOCK, DATE, SYSTEM.
 
 
 RSD      SUBR               ENTRY/EXIT
          SYSTEM SFM,R,SFMB,RSDF*100B  RETURN SYSTEM DATA
          DATE   HDAT
          CLOCK  HTIM        SET TIME IN BUFFER FOR PRINTER OUTPUT
          EQ     RSDX        RETURN
 WSB      SPACE  4,15
**        WSB - WRITE SUBSYSTEM INFORMATION BUFFER.
*
*         ENTRY  (X5) = PRINTER/*L* DISPLAY FLAG.
*                       0 = *L* DISPLAY FORMAT.
*                (X6) = ADDRESS OF DISPLAY MESSAGE.
*                (SFMB) = 24/, 12/NUMBER OF SUBSYSTEMS, 24/.
*                (WBUFA - WBUFA+.NSS-1) = SUBSYSTEM DATA FROM *SFM*.
*
*         EXIT   (A0) = LWA+1 OF DATA IN *WBUF*.
*                (WBUF - (A0)-1) = FORMATTED SUBSYSTEM DATA.
*
*         USES   X - 0, 1, 2, 4, 6.
*                A - 0, 1, 2, 4, 6.
*                B - 5, 6, 7.
*
*         CALLS  COD, SFN.
*
*         MACROS MOVE.
 
 
 WSB      SUBR               ENTRY/EXIT
          SA4    WSBC        GET *L* DISPLAY PAGING CONTROL WORD
          SA1    SFMB        GET NUMBER OF WORDS RETURNED
          ZR     X5,WSB1     IF *L* DISPLAY FORMAT
          SA4    A4+1        GET PRINTER PAGING CONTROL WORD
 WSB1     SA6    WSBE        SAVE ERROR MESSAGE ADDRESS
          SA0    WBUF        FWA TO RETURN REFORMATTED BUFFER
          MX0    -12
          LX1    11-35
          UX4,B7 X4          SET MAXIMUM NUMBER OF LINES - 1 TO FORMAT
          BX1    -X0*X1
          SB6    X4+         SUBSYSTEM DATA BUFFER INDEX
          SB5    X1+         NUMBER OF SUBSYSTEMS
 WSB2     SA2    TSSN+B6     GET SUBSYSTEM NAME
          MX0    18
          BX1    X0*X2
          ZR     X1,WSB6     IF NO SUBSYSTEM NAME
          NG     B7,WSB7     IF NO ROOM TO DISPLAY SUBSYSTEM DATA
          RJ     SFN
          LX6    -12
          SA6    A0+
          SA0    A0+B1       INCREMENT RETURN BUFFER
          SA4    WBUFA+B6    GET REQUIRED CONTROL POINT
          SA2    WSBA        PRESET CONTROL POINT TO BLANKS
          MX0    -6
          LX4    -12
          BX6    X2
          BX1    -X0*X4      CONTROL POINT
          ZR     X1,WSB3     IF NO CONTROL POINT
          RJ     COD
 WSB3     SA4    WBUFA+B6    GET EJTO
          SA2    WSBA        PRESET EJTO TO BLANKS
          LX6    24
          SA6    A0          STORE REQUIRED CONTROL POINT
          SA0    A0+B1       INCREMENT RETURN BUFFER
          MX0    -12
          BX1    -X0*X4      EJT ORDINAL
          BX6    X2
          ZR     X1,WSB4     IF NO EJT ORDINAL
          RJ     COD
 WSB4     SA4    WBUFA+B6    GET ENABLE/DISABLE STATUS
          SA6    A0          STORE EJTO
          SA0    A0+B1
          SA1    WSBB        PRESET STATUS TO *DISABLED*
          LX4    59-18
          SA2    A1+B1
          NG     X4,WSB5     IF SUBSYSTEM DISABLED
          SA1    A2+B1       SET STATUS TO *ENABLED*
          SA2    A1+B1
 WSB5     BX6    X1
          SA6    A0
          SA0    A0+B1       INCREMENT RETURN BUFFER
          BX6    X2
          SA6    A0
          SA0    A0+B1       INCREMENT RETURN BUFFER
          SB7    B7-1        DECREMENT LINE LIMIT
 WSB6     SB6    B6+B1       INCREMENT BUFFER INDEX
          LT     B6,B5,WSB2  IF MORE SUBSYSTEMS TO PROCESS
          SB6    B0          FIRST SUBSYSTEM FOR NEXT PAGE
 WSB7     NZ     X5,WSBX     IF FORMATTING FOR PRINTER
          SB4    B7+1        CLEAR UNUSED LINES AND *MORE* LINE
 WSB8     MOVE   5,WSBD,A0
          SB4    B4-1        DECREMENT LINE COUNT
          SA0    A0+5        INCREMENT RETURN BUFFER
          PL     B4,WSB8     IF ALL DISPLAY LINES ARE NOT FILLED
          SA2    WSBC        GET *L* DISPLAY PAGING CONTROL WORD
          SA1    =4AMORE
          SX6    B6
          MX0    42
          LX2    -30
          BX2    X0*X2
          BX6    X2+X6       SET *NEXT* ORDINAL
          LX6    30
          SA6    A2
          BX6    X1
          ZR     B6,WSB9     IF LAST PAGE
          SA6    A0-5        SET *MORE* IN BUFFER
 WSB9     SA2    WSBE        SET ERROR MESSAGE IN BUFFER
          MOVE   MBUFL,X2,A0
          SA1    LBFI+1      SET COMMAND IN BUFFER
          SA0    A0+MBUFL
 WSB10    MX2    -12
          BX6    X1
          BX2    -X2*X1
          SA1    A1+B1
          SA6    A0
          SA0    A0+B1       LWA+1 OF BUFFER FOR *L* DISPLAY
          NZ     X2,WSB10    IF NOT END OF COMMAND
          EQ     WSBX        RETURN
 
 
 WSBA     CON    10H
 WSBB     DATA   C*    DISABLED*
          DATA   C*    ENABLED*
 WSBC     SPACE  4,10
**        WSBC - PAGING CONTROL WORDS.
*
*T        VFD    12/   LC   ,18/  NEXT ORDINAL,30/    CURRENT ORDINAL
*
*                LC = LINE COUNT - 1 + 2000B.
 
 
 WSBC     VFD    12/1777B+LDAT,18/0,30/0   *L* DISPLAY PAGING WORD
          VFD    12/1777B+2000B,18/0,30/0  PRINTER PAGING WORD
 
 
 WSBD     DATA   48C
 WSBE     CON    MESH        TEMPORARY FOR ERROR MESSAGE ADDRESS
          SPACE  4,5
*         COMMON DECKS.
 
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
*CALL     COMCDXB
          LIST   X
*CALL     COMCFLD
          LIST   *
*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
 
*         BUFFER AREA.
 
 HBUF     BSS    0           HEADER FOR *SUBSYST* DISPLAY
 
          DATA   40H SUBSYST - SUBSYSTEM STATUS.
 HDAT     BSSZ   1
 HTIM     BSSZ   1
          CON    0
          DATA   C* *
 HBUF1    DATA   C*                SUBSYSTEMS*
          DATA   C* *
          DATA   C*            REQUIRED       EJT*
          DATA   C*  NAME   CONTROL POINT   ORDINAL   STATUS*
          DATA   C* *
 
 WBUF     BSS    .NSS*5      WORKING BUFFER
 .1       MAX    *,WBUF+LDAT*5+5+MBUFL+CBUFL
 WBUFA    EQU    .1          *SFM* RETURNS DATA HERE
 LBUF     EQU    WBUFA+.NSS  *L* DISPLAY OUTPUT BUFFER
 LBFI     EQU    LBUF+LBUFL  *L* DISPLAY INPUT BUFFER
 OBUF     EQU    LBFI+LBIL+2 OUTPUT FILE BUFFER
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE.
*
*         ENTRY  COMMAND 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 USER ACCESS NOT VALID.
*                (X2) = FWA ERROR MESSAGE.
 
 
 PRS9     SYSTEM RSB,R,PRSC  SET NUMBER OF CONTROL POINTS
          SA1    NCPT
          MX0    -12
          LX1    -36
          BX6    -X0*X1
          SX6    X6+B1
          SA6    A1
          GETSSM OSSM        GET SYSTEM SECURITY MODE
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           B1 = 1.
          GETSPS SYOF        CHECK FOR SYSTEM ORIGIN PRIVILEGES
          SA1    SYOF
          ZR     X1,PRS1     IF SYSTEM ORIGIN PRIVILEGES
          SX2    ERIU        *USER ACCESS NOT VALID.*
          EQ     ERR         ABORT
 
*         PROCESS ARGUMENT LIST.
 
 PRS1     SB2    CCDR        UNPACK COMMAND
          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    PRS8        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,PRS8     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,PRS8     IF ERROR
          SA1    O           SET FILE NAME IN ROUTE BLOCK
          MX0    42
          BX6    X0*X1
          SA6    ROTB
 
*         DETERMINE LIST OPTIONS.
 
 PRS6     SA1    LO          GET 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,PRS9     IF ALL OPTIONS PROCESSED
 PRS7.1   SA2    A2+B1       SEARCH ARGUMENT TABLE
          ZR     X2,PRS8     IF LIST OPTION NOT DEFINED IN TABLE
          BX4    X0*X2
          BX4    X4-X3
          NZ     X4,PRS7.1   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        *USER ACCESS NOT VALID.*
          EQ     ERR         ABORT
 
 PRS8     SX2    ERAR        *ARGUMENT ERROR.*
          EQ     ERR         ABORT
 
 PRSA     BSS    100
 
 PRSB     CON    40000000000033127777B  SEPARATOR MASK
 PRSC     VFD    12/,12/1,18/NCPL,18/NCPT
 
 
**        ASSUMED VALUES FOR LIST OPTIONS.
 
 
 LO       CON    0LD         SELECTED LIST OPTION (DEFAULT = *D*)
          SPACE  4,10
**        ARGUMENT EQUIVALENCE TABLE.
*
*         THIS TABLE IS REQUIRED BY ARGUMENT PROCESSOR *COMCARM*.
 
 
 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 BY 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 - 5, 6.
 
 
 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
 SUBSYE   EQU    *           END OF PROGRAM
 .RFL=    MAX    SUBSYE,OBUF+OBUFL
 RFL=     EQU    .RFL=
          SPACE  4,5
          END