Retro1.org codex

          IDENT  LISTLID,FWA 
          TITLE  LISTLID - LIST LID TABLE.
          ABS
          SST
          ENTRY  LISTLID
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
*COMMENT  LISTLID - LIST LID TABLE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE 4,10
***       LISTLID - LIST LID TABLE.
*
*         K. A. KRIEG        83/10/04.
          SPACE 4,10
***       *LISTLID* IS A UTILITY TO LIST THE CONFIGURATION OF
*         THE LID TABLE (LDT).
          SPACE 4,10
***       COMMAND FORMAT.
*
*         LISTLID,P1,P2...PN.
*
*         PARAMETERS ARE ORDER-INDEPENDENT.  P1 THROUGH PN
*         ARE THE PARAMETERS AS FOLLOWS:
*
*         LID=XXX     PRINT OUT THE ATTRIBUTES OF PIDS IN
*           OR        WHICH LID XXX EXISTS, IS ENABLED AND
*         ST=XXX      LISTABLE.  IF THE LID OR ST KEYWORD IS
*           OR        SPECIFIED, A LID VALUE XXX MUST ALSO BE
*         OMITTED     SPECIFIED.  IF THE LID OR ST KEYWORD IS
*                     OMITTED, THE DEFAULT IS TO PRINT OUT ALL
*                     LISTABLE LIDS.  EITHER LID OR ST MAY BE
*                     SPECIFIED, BUT NOT BOTH.
*
*         L=LFN       OUTPUT IS TO BE WRITTEN TO FILE LFN.
*           OR        IF OMITTED, THE DEFAULT IS *OUTPUT*.
*         OMITTED
*
*         PID=YYY     PRINT OUT THE ATTRIBUTES OF ALL LIDS
*           OR        UNDER THE SPECIFIED PID YYY.  IF LID=XXX
*         PID         IS ALSO SPECIFIED, ONLY LID XXX UNDER YYY
*           OR        WILL BE PRINTED.  IF YYY IS OMITTED,
*         OMITTED     THE DEFAULT IS TO PRINT ALL PIDS.  IF
*                     PID IS OMITTED, THE LID KEYWORD VALUE
*                     DETERMINES WHAT IS PRINTED.
          SPACE 4,10
***       DAYFILE MESSAGES.
*
*
*         * LID TABLE EMPTY.*
*                THE LID TABLE READ FROM CMR WAS EMPTY.
*
*         * LID - XXX DOES NOT EXIST IN THE LID TABLE.*
*                THE LID SPECIFIED COULD NOT BE FOUND
*                IN THE LID TABLE OR THE NLIST BIT
*                IS SET (LISTING OF THE SPECIFIED
*                LID NOT ALLOWED) OR THE LID WAS A
*                STORE AND FORWARD HOST LID (LISTING
*                OF THIS TYPE OF LID NOT ALLOWED).
*
*         * LID=XXX OR ST=XXX IS REQUIRED.*
*                THE LID OR ST PARAMETER WAS SPECIFIED
*                WITH NO VALUE.
*
*         * LISTLID COMMAND ERROR.*
*                AN INCORRECT ARGUMENT WAS DETECTED ON THE
*                COMMAND.
*
*         * NO LIDS FOUND.*
*                EITHER THE LID SPECIFIED WAS NOT LISTABLE OR THERE
*                WERE NO LISTABLE LIDS FOUND FOR A GIVEN PID.
*
*         * PID - YYY DOES NOT EXIST IN THE LID TABLE.*
*                THE PID SPECIFIED COULD NOT BE FOUND IN
*                THE LID TABLE.
*
*         * SPECIFY EXACTLY 3 CHARACTERS ON PID KEYWORD.*
*                EXACTLY THREE CHARACTERS ARE ALLOWED ON
*                THE PID KEYWORD.
*
*         * SPECIFY EXACTLY 3 CHARACTERS ON LID KEYWORD.*
*                EXACTLY THREE CHARACTERS ARE ALLOWED ON
*                THE LID OR ST KEYWORD.
          SPACE 4,10
*         COMMON DECKS.
 
*CALL     COMCCMD
*CALL     COMCMAC
*CALL     COMSSFM
*CALL     COMSSSJ
          TITLE  DEFINITIONS.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 HDLN     EQU    2           NUMBER OF PRINTED LINES IN HEADER
 OBUFL    EQU    101B        LENGTH OF OUTPUT BUFFER
 WBUFL    EQU    5           LENGTH OF WORKING BUFFER
 TRLN     EQU    6           NUMBER OF PRINTED LINES IN TRAILER
 
****
          SPACE 4,10
          ORG    110B
 FWA      BSS    0
          SPACE  4,10
*         SSJ= PARAMETER BLOCK.
 
 SSJ=     BSS    0
          BSSZ   SSJL
 
          SPACE  4,10
*         FET DEFINITIONS.
 
 LIDF     FILEB  LIDTAB,MXLDT,FET=5   LID TABLE
 
 O        BSS    0
 OUTPUT   FILEB  OBUF,OBUFL,FET=10  OUTPUT FILE
          SPACE  4,10
*         HEADERS AND TRAILERS FOR OUTPUT LISTINGS.  IF EITHER THE
*         HEADER OR TRAILER INFORMATION IS CHANGED IN THE FUTURE SO
*         MORE OR FEWER LINES ARE REQUIRED, ENSURE THAT *HDLN* AND/OR
*         *TRLN* ARE UPDATED APPROPRIATELY SO THE CORRECT PAGE LENGTH
*         CAN BE CALCULATED.
 
 HDR1     DATA   8L1
          DATA   8L
 HDR1L    EQU    *-HDR1
 HDR2     DATA   47L   LID    MAINFRAME  ATTRIBUTE          NETWORK
          DATA   8L
 HDR2L    EQU    *-HDR2
 HDR3     DATA   50H       PID   LID    MAINFRAME   TYPE    ATTRIBUTE
          DATA   25L  RHF       NAM       SSF
          DATA   8L
 HDR3L    EQU    *-HDR3
 HDR4     DATA   8L
          DATA   8L
          DATA   50H   ATTRIBUTES:  H - HOST,  L - LINKED,  V - VALIDA
          DATA   14LTION REQUIRED,
          DATA   50H                S - STORE FORWARD,      B - LOOPBA
          DATA   8LCK.
          DATA   50H                IN - PATH IN SERVICE,   OUT - PATH
          DATA   16L OUT OF SERVICE,
          DATA   35L                NA - NOT AVAILABLE.
 HDR4L    EQU    *-HDR4
          SPACE 4,10
*         CONSTANT DATA.
 
 BLKS     DATA   10H            WORD OF BLANKS
          DATA   8L          WORD OF BLANKS WITH ZERO BYTE
          SPACE 4,10
*         STORAGE LOCATIONS.
 
 CLLC     CON    0           LINES AVAILABLE TO PRINT LIDS
 JPRD     CON    0           JOB PRINT DENSITY
 LFST     CON    0           LIST FILE STATUS OF OUTPUT
 LIDV     CON    0           LID VALUE
 LLFD     CON    0           INDICATES IF LISTABLE LID FOUND
 NLIP     CON    0           NUMBER OF LID SLOTS IN PID
 PAGL     CON    0           JOB PAGE LENGTH
 PDFD     CON    0           PID FOUND FLAG
 PIDA     CON    0           FIRST WORD OF PID DATA
 PIDB     CON    0           SECOND WORD OF PID DATA
 PIDV     CON    0           PID VALUE
 PDPF     CON    0           PID LINE PRINTED FLAG
 STVL     CON    0           ST VALUE
 WBUF     BSSZ   8           WORKING BUFFER
          SPACE 4,10
*         DAYFILE MESSAGES.
 
 MSG2     DATA   C* LID TABLE EMPTY.*
 MSG3     DATA   C* NO LIDS FOUND.*
 MSG4     DATA   C* PID -     DOES NOT EXIST IN THE LID TABLE.*
 MSG5     DATA   C* LID -     DOES NOT EXIST IN THE LID TABLE.*
          TITLE  MAIN PROGRAM.
 LISTLID  SPACE  4,10
**        LISTLID - LIST LID TABLE.
*
*         EXIT   LID TABLE LISTED IF SUCCESSFUL.
*
*         USES   X - 0, 1, 7.
*                A - 1.
*
*         CALLS  PLD, PPD, PRS.
*
*         MACROS ENDRUN, GETLIDT, MESSAGE, WRITEC, WRITEW.
 
 
 LISTLID  RJ     PRS         PRESET
          GETLIDT  LIDF      GET LID TABLE INTO FWA OF PRESET
          SA1    LIDTAB      GET NUMBER OF PIDS IN TABLE
          MX0    -12
          BX7    -X0*X1
          NZ     X7,LST1     IF TABLE NOT EMPTY
          MESSAGE  MSG2      * LID TABLE EMPTY.*
          EQ     LST4        EXIT
 
 LST1     SA1    LFST
          ZR     X1,LST2     IF TERMINAL FILE
          WRITEC O,JPRD      WRITE PRINT DENSITY
          WRITEW O,HDR1,HDR1L  WRITE INITIAL PAGE EJECT
 LST2     SA1    PIDV
          ZR     X1,LST3     IF *PID* KEYWORD NOT SPECIFIED
          RJ     PPD         PRINT LID TABLE (FORMAT 2)
          EQ     LST4        EXIT
 
 LST3     RJ     PLD         PRINT LID TABLE (FORMAT 1)
 LST4     ENDRUN
          TITLE  SUBROUTINES.
 FPL      SPACE  4,15
**        FPL - FORMAT AND PRINT LID LINE (FORMAT 2).
*
*         ENTRY  (X5) = LID WORD LEFT JUSTIFIED TO NLIST BIT.
*                (X1) = LID.
*
*         EXIT   LID LINE WRITTEN TO OUTPUT FILE.
*
*         USES   X - 3, 6, 7.
*                A - 3, 6, 7.
*                B - 7.
*
*         CALLS  PLA, SFN.
*
*         MACROS WRITEH, WRITEW.
 
 
 FPL      SUBR               ENTRY/EXIT
          RJ     SFN         SPACE FILL LID
          LX6    -18
          SA3    BLKS
          LX5    59-34-59+31 POSITION LID ATTRIBUTES FOR *PLA*
          BX7    X3
          SA7    WBUF        STORE BLANK WORD
          SA6    A7+B1       STORE BLANK-FILLED LID
          SA7    A6+B1       STORE BLANK WORD
          SA7    A7+B1       STORE BLANK WORD
          RJ     PLA         PROCESS LID ATTRIBUTES
          SA3    LFST
          ZR     X3,FPL1     IF TERMINAL FILE
          SA3    CLLC
          SX7    X3-1
          SB7    X3
          LE     B7,B0,FPL2  IF NO ROOM TO PRINT LID LINE
          SA7    A3
 FPL1     WRITEH O,WBUF,5
          SX7    B1+         INDICATE AT LEAST ONE LID PROCESSED
          SA7    LLFD
          EQ     FPLX        RETURN
 
 FPL2     WRITEW O,HDR4,HDR4L  WRITE PID TRAILER
          WRITEW O,HDR1,HDR1L
          WRITEW O,HDR3,HDR3L
          SA3    PAGL        SAVE NUMBER OF LINES LEFT ON PAGE
          SX7    X3-1
          SA7    CLLC
          EQ     FPL1        PRINT LID LINE
 LDP      SPACE  4,15
**        LDP - PROCESS LID(S) FOR PIDS (FORMAT 2).
*
*         ENTRY  (A5) = ADDRESS OF PID CURRENTLY BEING PROCESSED.
*                (WBUF) = PID LINE TO BE PRINTED WHEN THE FIRST
*                         LISTABLE LID IS ENCOUNTERED.
*
*         EXIT   ALL APPROPRIATE LIDS PROCESSED FOR GIVEN PID.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 2, 5, 6, 7.
*                B - 7.
*
*         CALLS  FPL.
*
*         MACROS WRITEH, WRITEW.
 
 
 LDP      SUBR               ENTRY/EXIT
          SA2    A5+2        OFFSET TO NUMBER OF LID SLOTS
          MX0    -12
          BX6    -X0*X2
          SA6    NLIP
          SA0    A5          SAVE ADDRESS OF CURRENT PID
          SA5    A2          FWA-1 OF LID ENTRIES
          BX6    X6-X6       CLEAR PID LINE PRINTED FLAG
          SA6    PDPF
 
*         PROCESS NEXT LID ENTRY.
 
 LDP1     SA5    A5+B1       READ NEXT LID ENTRY
          MX0    18
          BX7    X0*X5
          ZR     X7,LDP6     IF EMPTY LID SLOT
          SA2    LIDV
          ZR     X2,LDP2     IF NO LID SPECIFIED
          BX7    X2-X7
          NZ     X7,LDP6     IF LID DOES NOT MATCH
 LDP2     LX5    59-31
          NG     X5,LDP6     IF LID NOT LISTABLE
 
*         PRINT THE PID LINE WHEN THE FIRST LISTABLE LID IS
*         ENCOUNTERED.
 
          SA1    PDPF
          NZ     X1,LDP5     IF PID LINE ALREADY PRINTED
          SX7    B1          INDICATE PID LINE PRINTED
          SA7    A1
          SA1    LFST
          ZR     X1,LDP4     IF TERMINAL FILE
          SA1    CLLC
          SX7    X1-2
          NG     X7,LDP3     IF NO ROOM TO PRINT PID AND ONE LID
          SX7    X1-1        DECREMENT NUMBER OF PAGE LINES REMAINING
          SA7    A1+
          EQ     LDP4        WRITE PID LINE
 
 LDP3     WRITEW O,HDR4,HDR4L  WRITE ATTRIBUTE TRAILER
          WRITEW O,HDR1,HDR1L
          WRITEW O,HDR3,HDR3L  WRITE HEADER
          SA1    PAGL        SAVE LINES REMAINING ON PAGE
          SX7    X1-1
          SA7    CLLC
 LDP4     WRITEH O,WBUF,8    WRITE PID LINE
 
*         FORMAT AND PRINT THE LID.
 
 LDP5     SA1    A5          GET LID
          MX0    18
          BX1    X0*X1
          RJ     FPL         FORMAT AND PRINT LID LINE
          SA1    LIDV
          NZ     X1,LDP7     IF LID SPECIFIED
 
*         DECREMENT LID SLOT COUNT AND PROCESS NEXT LID.
 
 LDP6     SA1    NLIP        DECREMENT LID SLOT COUNT
          SX7    X1-1
          SB7    X7
          LE     B7,B0,LDP7  IF ALL LID SLOTS PROCESSED
          SA7    A1
          EQ     LDP1        PROCESS NEXT LID ENTRY
 
 LDP7     SA5    A0+         RESTORE ADDRESS OF PID
          EQ     LDPX        RETURN
 PLA      SPACE  4,10
**        PLA - PROCESS LID ATTRIBUTES (FORMAT 2).
*
*         ENTRY  (X5) = LID ATTRIBUTES (LEFT JUSTIFIED).
*                (A7) = WORKING BUFFER - 1 FOR LID ATTRIBUTES.
*
*         EXIT   (A6) = LID ATTRIBUTES STORED IN WORKING BUFFER.
*
*         USES   X - 0, 3, 6.
*                A - 3, 6.
*                B - 2, 7.
 
 
 PLA      SUBR               ENTRY/EXIT
          MX0    3
          BX3    X0*X5       GET LID ATTRIBUTES
          LX3    3
          SB7    X3
          SA3    BLKS+1
          ZR     B7,PLA1     IF NO ATTRIBUTES
          SA3    PLAA
          EQ     B7,B1,PLA1  IF LOOPBACK BIT SET
          SB2    4
          SA3    PLAB
          EQ     B7,B2,PLA1  IF ONLY STORE AND FORWARD BIT SET
          SA3    PLAC
 PLA1     BX6    X3          STORE LID ATTRIBUTES
          SA6    A7+B1
          EQ     PLAX        RETURN
 
 
 PLAA     VFD    60/8L   B
 PLAB     VFD    60/8L   S
 PLAC     VFD    60/8L   SV
 PLD      SPACE  4,15
**        PLD - PRINT LID TABLE DESCRIPTION.
*
*         ENTRY  (LIDTAB) = LID TABLE.
*
*         EXIT   LID TABLE WRITTEN TO OUTPUT FILE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 6.
*
*         CALLS  PLL.
*
*         MACROS MESSAGE, WRITER, WRITEW.
 
 
 PLD      SUBR               ENTRY/EXIT
          WRITEW O,HDR2,HDR2L
          SA1    LIDTAB+1    READ FIRST PID ENTRY
 
*         PROCESS NEXT PID.
 
 PLD1     SA2    LIDV        GET LID TO MATCH
          BX7    X1          SAVE PID DATA
          SA7    PIDA
          SA1    A1+B1
          BX7    X1
          SA7    PIDB
          SA5    A1+B1       GET NUMBER OF LID SLOTS
          MX4    -12
          BX7    -X4*X5
          SB6    X7
 
*         PROCESS NEXT LID.
 
 PLD2     SA5    A5+B1       GET NEXT LID ENTRY
          MX4    18
          BX7    X4*X5
          ZR     X7,PLD5     IF HOLE IN LID TABLE
          BX7    X7-X2
          ZR     X2,PLD3     IF LISTING ALL LIDS
          NZ     X7,PLD5     IF LID DOES NOT MATCH
 
*         EITHER ALL LIDS ARE TO BE PROCESSED BY DEFAULT OR THE
*         SPECIFIED LID MATCHED AN LDT ENTRY.
 
 PLD3     BX3    X5
          LX3    59-31
          NG     X3,PLD4     IF LID NOT LISTABLE
          LX3    59-34-59+31
          PL     X3,PLD3.1   IF LID IS NOT STORE AND FORWARD
          SA3    PIDA
          LX3    59-41
          NG     X3,PLD4     IF LID IS HOST AND STORE AND FORWARD
 PLD3.1   SX7    B6
          SA7    NLIP
          RJ     PLL         LIST LID LINE
          SX7    B1+         INDICATE LID FOUND
          SA7    LLFD
          SA2    NLIP        RESTORE NUMBER OF LID SLOTS
          SB6    X2
          SA2    LIDV
 PLD4     NZ     X2,PLD6     IF NOT PROCESSING ALL LIDS
 PLD5     SB6    B6-B1
          GT     B6,PLD2     IF MORE LIDS FOR PID
          SB6    B1          SET INDEX FOR NEXT PID ENTRY
 PLD6     SA3    PIDB
          MX4    -12
          BX7    -X4*X3
          ZR     X7,PLD7     IF LAST PID
          SA1    A5+B6
          EQ     PLD1        PROCESS NEXT PID ENTRY
 
 PLD7     SA3    LLFD
          ZR     X3,PLD8     IF NO LISTABLE LIDS FOUND
          WRITER O
          EQ     PLDX        RETURN
 
 PLD8     ZR     X2,PLD9     IF PROCESSING ALL LIDS
          SA3    MSG5        ADD NON-MATCHING LID TO MESSAGE
          LX2    18
          MX0    42
          BX3    X0*X3
          BX6    X3+X2
          SA6    A3+
          MESSAGE  MSG5      * LID - XXX DOES NOT EXIST IN LID TABLE.*
          EQ     PLDX        RETURN
 
 PLD9     MESSAGE  MSG3      * NO LIDS FOUND.*
          EQ     PLDX        RETURN
 PLL      SPACE  4,15
**        PLL - PROCESS LID LINE (FORMAT 1).
*
*         ENTRY  (X5) = LID WORD.
*                (PIDA) = PID FIRST WORD (FROM LDT).
*                (PIDB) = PID SECOND WORD (FROM LDT).
*
*         EXIT   LID LINE WRITTEN TO OUTPUT FILE.
*
*         USES   X - 0, 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 6, 7.
*
*         CALLS  PNS, SFN.
*
*         MACROS WRITEH, WRITEW.
 
 
 PLL      SUBR               ENTRY/EXIT
          MX0    18          STORE LID IN WORKING BUFFER
          BX1    X0*X5
          RJ     SFN
          LX6    -18
          SA6    WBUF
          SA1    PIDB        STORE MAINFRAME DESCRIPTOR
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          LX6    -6
          SA6    A6+B1
          SA3    PLLB        PRESET DISABLED
          LX5    59-35
          PL     X5,PLL1     IF LID DISABLED
          SA4    PIDA
          LX4    59-40
          PL     X4,PLL1     IF PID DISABLED
          SA3    PLLD        PRESET STORE AND FORWARD
          LX5    59-34-59+35
          NG     X5,PLL1     IF STORE AND FORWARD BIT SET
          SA3    PLLE        PRESET LOOPBACK
          LX5    59-32-59+34
          NG     X5,PLL1     IF LOOPBACK BIT SET
          SA3    PLLA        PRESET HOST
          SA1    PIDA
          LX1    59-41
          NG     X1,PLL1     IF HOST PID
          SA3    PLLC        SET LINKED
 PLL1     BX6    X3
          SA6    A6+B1       STORE FIRST WORD
          SA4    A3+B1
          BX6    X4
          SA6    A6+B1       STORE SECOND WORD
          RJ     PNS         PROCESS NETWORK STATUS
          SX7    WBUFL
          ZR     X4,PLL1.1   IF SECOND NETWORK STATUS WORD IS ZERO
          SX7    WBUFL+1
 PLL1.1   SA7    WBUF+7      SAVE BUFFER LENGTH
          SA3    LFST
          ZR     X3,PLL3     IF TERMINAL FILE
          SA3    CLLC
          SX7    X3-1
          NZ     X7,PLL2     IF NO ROOM LEFT ON PAGE
          WRITEW O,HDR1,HDR1L   PRINT OUTPUT FILE HEADERS
          WRITEW O,HDR2,HDR2L
          SA3    PAGL        SAVE LINES REMAINING ON PAGE
          SX7    X3-1
 PLL2     SA7    CLLC
 PLL3     SA1    WBUF+7      RESTORE BUFFER LENGTH
          WRITEH O,WBUF,X1   WRITE LID LINE
          EQ     PLLX        RETURN
 
 
 PLLA     DATA   20H HOST
 PLLB     DATA   20H DISABLED
 PLLC     DATA   20H LINKED
 PLLD     DATA   20H STORE FORWARD
 PLLE     DATA   20H LOOPBACK
 PNS      SPACE  4,10
**        PNS - PROCESS NETWORK STATUS (FORMATS 1 AND 2).
*
*         ENTRY  (A6+1) = ADDRESS TO STORE NETWORK STATUS.
*                (PIDA) = PID WORD, IF FORMAT 1.
*                (X5) = PID WORD, IF FORMAT 2.
*
*         EXIT   (X4) = SECOND NETWORK STATUS WORD, IF FORMAT 1.
*
*         USES   X - 0, 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 6.
*                B - 2, 3, 5, 6, 7.
 
 
 PNS      SUBR               ENTRY/EXIT
          SA1    PIDV
          MX0    -4
          NZ     X1,PNS4     IF PROCESSING FORMAT 2
          SA3    PIDA        GET PID WORD
 
*         PROCESS NETWORK STATUS FOR FORMAT 1.
 
          SB2    B0
          BX7    -X0*X3
          SB3    X7
          NE     B3,B1,PNS1  IF NAM NOT IN SERVICE
          SB2    B2+1        SET NAM IN SERVICE
 PNS1     LX3    -4
          BX7    -X0*X3
          SB3    X7
          NE     B3,B1,PNS2  IF RHF NOT IN SERVICE
          SB2    B2+2        SET RHF IN SERVICE
 PNS2     LX3    -4
          BX7    -X0*X3
          SB3    X7
          NE     B3,B1,PNS3  IF SSF NOT IN SERVICE
          SB2    B2+4        SET SSF IN SERVICE
 PNS3     SX3    B2
          LX3    1
          SA3    PNSA+X3     STORE NETWORK STATUS
          BX6    X3
          SA6    A6+B1
          SA4    A3+B1
          BX6    X4
          SA6    A6+B1
          EQ     PNSX        RETURN
 
*         PROCESS NETWORK STATUS FOR FORMAT 2.
 
 PNS4     BX2    X5
          LX2    59-40
          PL     X2,PNS8     IF PID DISABLED
 
*         PROCESS *NAM* STATUS.
 
          BX2    -X0*X5      NAM STATUS
          SB6    X2+
          LX2    59-3
          LE     B6,B1,PNS5  IF NOT AVAILABLE OR IN SERVICE
          ERRNZ  /NTS/NAV    ADJUST CODE IF VALUE CHANGES
          ERRNZ  /NTS/ISV-1  ADJUST CODE IF VALUE CHANGES
          SB6    3
          NG     X2,PNS5     IF DISABLED
          ERRNZ  /NTS/DAB-10B  ADJUST CODE IF VALUE CHANGES
          SB6    2           SET OUT
 
*         PROCESS *RHF* STATUS.
 
 PNS5     LX5    -4
          BX2    -X0*X5      RHF STATUS
          SB5    X2
          LX2    59-3
          LE     B5,B1,PNS6  IF NOT AVAILABLE OR IN SERVICE
          SB5    3
          NG     X2,PNS6     IF DISABLED
          SB5    2           SET OUT
 
*         PROCESS *SSF* STATUS.
 
 PNS6     LX5    -4
          BX2    -X0*X5      SSF STATUS
          SB7    X2
          LX2    59-3
          LE     B7,B1,PNS7  IF NOT AVAILABLE OR IN SERVICE
          SB7    3
          NG     X2,PNS7     IF DISABLED
          SB7    2           SET OUT
 
*         WRITE STATUS OF NETWORKS TO WORKING BUFFER.
 
 PNS7     SA1    PNSB+B5     SET RHF STATUS
          BX6    X1
          SA6    A6+B1
          SA1    PNSB+B6     SET NAM STATUS
          BX6    X1
          SA6    A6+B1
          SA1    PNSB+B7     SET SSF STATUS
          BX6    X1
          SA6    A6+B1
          EQ     PNS9        SET END OF LINE
 
 PNS8     SA1    PNSC        SET --- FOR NETWORK STATUS
          BX6    X1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
 PNS9     MX0    48
          BX6    X0*X1
          SA6    A6          INSURE END OF LINE
          EQ     PNSX        RETURN
 
*         THIS TABLE MUST REMAIN IN THIS ORDER.
*         NETWORK STATUS FOR FORMAT 1.
 
 PNSA     BSS    0
          DATA   14LNONE AVAILABLE
          DATA   3LNAM
          DATA   0
          DATA   3LRHF
          DATA   0
          DATA   8LNAM, RHF
          DATA   0
          DATA   3LSSF
          DATA   0
          DATA   8LNAM, SSF
          DATA   0
          DATA   8LRHF, SSF
          DATA   0
          DATA   13LNAM, RHF, SSF
 
*         NETWORK STATUS FOR FORMAT 2.
 
 PNSB     BSS    0
          DATA   10H  NA
          DATA   10H  IN
          DATA   10H  OUT
          DATA   10HDISABLED
 PNSC     DATA   10H  ---
 PPD      SPACE  4,15
**        PPD - PRINT PID TABLE DESCRIPTION.
*
*         ENTRY  (LIDTAB) = LID TABLE.
*                PID SPECIFIED ON COMMAND.
*
*         EXIT   LID TABLE WRITTEN TO OUTPUT FILE.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2.
*
*         CALLS  LDP, PPL.
*
*         MACROS MESSAGE, WRITER, WRITEW.
 
 
 PPD      SUBR               ENTRY/EXIT
          WRITEW O,HDR3,HDR3L
          SA5    LIDTAB+1
 
*         PROCESS NEXT PID.
 
 PPD1     SA2    PIDV        USER-SPECIFIED PID VALUE
          MX0    18
          BX2    X0*X2
          ZR     X2,PPD2     IF ALL PIDS TO BE PROCESSED
          BX1    X0*X5
          BX7    X1-X2
          SA7    PDFD        SAVE PID FOUND FLAG
          NZ     X7,PPD3     IF PID DOES NOT MATCH
 
*         EITHER ALL PIDS ARE TO BE PROCESSED BY DEFAULT OR
*         THE SPECIFIED PID MATCHED AN LDT ENTRY.
 
 PPD2     RJ     PPL         PROCESS PID LINE
          RJ     LDP         PROCESS LID(S) FOR PID
          SA1    PIDV
          MX0    18
          BX1    X0*X1
          NZ     X1,PPD5     IF PID WAS SPECIFIED
 
*         DETERMINE IF THERE ARE MORE PIDS TO PROCESS.
 
 PPD3     SA2    A5+B1       GET OFFSET TO NEXT PID
          MX0    -12
          BX2    -X0*X2
          ZR     X2,PPD4     IF NO MORE PIDS
          SB2    X2
          SA5    A5+B2       NEXT PID ADDRESS
          EQ     PPD1        PROCESS NEXT PID ENTRY
 
*         ALL APPROPRIATE PID PROCESSING COMPLETE.
 
 PPD4     SA1    PIDV
          MX0    18
          BX1    X0*X1
          ZR     X1,PPD5     IF PID WAS NOT SPECIFIED
          SA2    PDFD
          ZR     X2,PPD5     IF SPECIFIED PID FOUND IN LDT
          SA3    MSG4
          LX1    18          POSITION PID
          MX0    42
          BX3    X0*X3
          BX6    X1+X3       MERGE PID IN MESSAGE
          SA6    A3+
          MESSAGE  MSG4      * PID - XXX DOES NOT EXIST IN LDT.*
          EQ     PPDX        RETURN
 
 PPD5     SA1    LLFD
          NZ     X1,PPD6     IF LISTABLE LID WAS FOUND
          MESSAGE  MSG3      * NO LIDS FOUND.*
          EQ     PPDX        RETURN
 
 PPD6     WRITEW O,HDR4,HDR4L  WRITE PID TRAILER INFORMATION
          WRITER O
          EQ     PPDX        RETURN
 PPL      SPACE  4,15
**        PPL - PROCESS PID LINE (FORMAT 2).
*
*         ENTRY  (A5) = ADDRESS OF PID WORD.
*                (X5) = PID WORD.
*
*         EXIT   PID LINE WRITTEN TO *WBUF*.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 5, 6.
*
*         CALLS  PNS, SFN.
 
 
 PPL      SUBR               ENTRY/EXIT
 
*         PROCESS PID NAME AND MAINFRAME DESCRIPTOR.
 
          MX0    18
          BX1    X0*X5       PID NAME
          RJ     SFN         SPACE FILL NAME
          LX6    18
          LX5    59-38
          PL     X5,PPL1     IF LISTABLE
          SA1    PPLH
          BX6    X1
 PPL1     SA6    WBUF        STORE PID IN WORKING BUFFER
          SA3    BLKS        STORE BLANK WORD
          BX6    X3
          SA6    A6+B1
          SA2    A5+B1       GET MAINFRAME DESCRIPTOR
          MX0    42
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          LX6    -6
          SA6    A6+B1       STORE MAINFRAME DESCRIPTOR
 
*         PROCESS MAINFRAME TYPE AND PID ATTRIBUTES.
 
          LX5    59-41-59+38
          PL     X5,PPL2     IF LINKED PID
          SA3    PPLB
          BX6    X3
          SA6    A6+B1       STORE *HOST* MAINFRAME TYPE
          SA3    A3+B1
          ERRNZ  PPLC-PPLB-1 ADJUST IF WORDS NOT CONTIGUOUS
          LX5    59-39-59+41
          NG     X5,PPL3     IF PRE-VALIDATION REQUIRED
          SA3    PPLD        ATTRIBUTE IS *H*
          EQ     PPL3        STORE PID ATTRIBUTES
 
 PPL2     SA3    PPLE
          BX6    X3
          SA6    A6+B1       STORE *LINK* MAINFRAME TYPE
          SA3    PPLF
          LX5    59-39-59+41
          NG     X5,PPL3     IF PRE-VALIDATION REQUIRED
          SA3    PPLG        ATTRIBUTE IS *L*
 PPL3     BX6    X3
          SA6    A6+B1       STORE PID ATTRIBUTE
          SA5    A5+         RESTORE PID WORD
          RJ     PNS         PROCESS NETWORK STATUS
          EQ     PPLX        RETURN
 
 PPLB     VFD    60/10L  HOST
 PPLC     VFD    60/10L  HV
 PPLD     VFD    60/10L  H
 PPLE     VFD    60/10L  LINKED
 PPLF     VFD    60/10L  LV
 PPLG     VFD    60/10L  L
 PPLH     VFD    60/10L       ---
          SPACE  4,10
*         COMMON DECKS.
 
*CALL     COMCARG
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCSFM
*CALL     COMCSFN
*CALL     COMCSTF
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTH
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFERS.
          SPACE  4,10
*         BUFFERS.
 
 OBUF     BSS    OBUFL       OUTPUT BUFFER
 LIDTAB   EQU    *           LID TABLE
          TITLE  PRESET.
 PRS      SPACE  4,15
**        PRS - PRESET.
*
*         EXIT   ABORT IF ERROR ON COMMAND.
*                (LFST) = 0, IF OUTPUT BEING SENT TO TERMINAL.
*                       .NE. 0, OTHERWISE.
*                (PAGL) = (CLLC) = NUMBER OF LINES TO BE PRINTED
*                       ON EACH PAGE (EXCLUDING TRAILER FOR FORMAT 2).
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 4, 5, 6, 7.
*                B - 1, 4, 5.
*
*         CALLS  ARG, STF.
*
*         MACROS ABORT, GETPP, MESSAGE, SETFS.
*
*         NOTE   PRESET WILL BE OVERLAYED BY THE LID TABLE.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
          SA1    ACTR        GET NUMBER OF ARGUMENTS IN COMMAND
          MX0    -18
          BX1    -X0*X1
          ZR     X1,PRS3     IF NO ARGUMENTS
          SB4    X1
          SA4    ARGR        GET FIRST ARGUMENT
          SB5    TARG        SET ARGUMENT TABLE ADDRESS
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS5     IF ARGUMENT ERROR
          SA1    LIDV
          SA2    STVL
          NZ     X1,PRS1     IF LID SPECIFIED
          ZR     X2,PRS2     IF NEITHER LID NOT ST SPECIFIED
          BX1    X2
          BX2    X2-X2
 PRS1     NZ     X2,PRS5     IF BOTH LID AND ST SPECIFIED
          MX0    42
          BX6    X0*X1
          ZR     X6,PRS8     IF KEYWORD SPECIFIED BUT NOT EQUIVALENCED
          SA6    A1
          LX6    18
          BX7    X0*X6
          NZ     X7,PRS7     IF MORE THAN 3 CHARACTERS
          LX6    -6
          BX7    X0*X6
          ZR     X7,PRS7     IF LESS THAN 3 CHARACTERS
 PRS2     SA1    PIDV
          ZR     X1,PRS3     IF PID NOT SPECIFIED
          BX6    X0*X1
          ZR     X6,PRS3     IF PID SPECIFIED, BUT NOT EQUIVALENCED
          LX6    18
          BX7    X0*X6
          NZ     X7,PRS6     IF MORE THAN 3 CHARACTERS
          LX6    -6
          BX7    X0*X6
          ZR     X7,PRS6     IF LESS THAN 3 CHARACTERS
 PRS3     SX2    O           DETERMINE OUTPUT FILE STATUS
          RJ     STF
          SA6    LFST
          ZR     X6,PRSX     IF OUTPUT ASSIGNED TO TERMINAL
          GETPP  PAGC,PAGL,JPRD  GET LINE COUNT
          SA5    PAGL
          SX7    X5-HDLN     ENSURE SPACE FOR HEADERS
          SA1    PIDV
          ZR     X1,PRS4     IF PID NOT SPECIFIED
          SX7    X7-TRLN     ENSURE SPACE FOR TRAILERS
 PRS4     SA7    PAGL
          SA7    CLLC
          SETFS  O,0         PRESERVE OUTPUT FILE
          EQ     PRSX        RETURN
 
 PRS5     MESSAGE  PRSA      * LISTLID COMMAND ERROR.*
          ABORT
 
 PRS6     MESSAGE  PRSD      * SPECIFY EXACTLY 3 CHARACTERS ON PID.*
          EQ     PRS9        ABORT
 
 PRS7     MESSAGE  PRSE      * SPECIFY EXACTLY 3 CHARACTERS ON LID.*
          EQ     PRS9        ABORT
 
 PRS8     MESSAGE  PRSF      * LID=XXX OR ST=XXX IS REQUIRED.*
 PRS9     ABORT
 
*         PRESET ERROR MESSAGES.
 
 PRSA     DATA   C* LISTLID COMMAND ERROR.*
 PRSD     DATA   C* SPECIFY EXACTLY 3 CHARACTERS ON PID KEYWORD.*
 PRSE     DATA   C* SPECIFY EXACTLY 3 CHARACTERS ON LID KEYWORD.*
 PRSF     DATA   C* LID=XXX OR ST=XXX IS REQUIRED.*
          SPACE  4,10
*         PRESET STORAGE LOCATIONS.
 
 LID1     CON    1           ASSUMED LID, ST, OR PID VALUE
 PAGC     BSS    2           PARAMETER BLOCK FOR *GETPAGE*
          SPACE  4,10
*         ARGUMENT TABLE.
 
 TARG     BSS    0
 LID      ARG    LID1,LIDV,400B
 ST       ARG    LID1,STVL,400B
 L        ARG    O,O
 PID      ARG    LID1,PIDV,400B
          ARG
          SPACE  4,10
*         RESERVE SUFFICIENT SPACE TO HOLD THE MAXIMUM SIZE OF THE LDT.
 
 LENGTH   EQU    *-PRS       PRESET LENGTH
 MAXLTH   EQU    MXLDT-LENGTH  MAX LDT SIZE - PRESET LENGTH
          BSSZ   MAXLTH      ADDITIONAL CM WORDS REQUIRED TO HOLD LDT
 RFL=     EQU    *
          SPACE  4,10
          END