IDENT CATLIST,I,PRS
*COMMENT CATLIST - CATALOG PERMANENT FILES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
ABS
ENTRY CATLIST
ENTRY RFL=
ENTRY SSM=
SYSCOM B1
SST
TITLE CATLIST - CATALOG PERMANENT FILES.
SPACE 4,10
*** CATLIST - CATALOG PERMANENT FILE.
* J. L. WARDELL. 71/01/25.
* W. B. CHAPIN. 79/01/31.
* P. C. SMITH. 88/01/22.
SPACE 4,10
* CATLIST IS A UTILITY WHICH ENABLES A USER TO INTERROGATE
* THE PERMANENT FILE SYSTEM.
SPACE 4,10
*** CATLIST (DN,EF,FN,L,LO,NA,PN,R,RS,TY,UN,WB)
*
* KEYWORD OPTION DESCRIPTION
*
* DN DEVICE LIST FILES THAT RESIDE ON THIS DEVICE
* NUMBER NUMBER.
*
* EF FILENAME/FILENAME/.../FILENAME
* EXCLUDED PERMANENT FILE NAME. THIS
* PARAMETER EXCLUDES FROM LISTING THESE
* PERMANENT FILES.
*
* AN ASTERISK (*) PRESENT IN A FILE NAME
* INDICATES THAT A SET OF FILES IS TO BE
* EXCLUDED. FOR EXAMPLE, EF=***OPL WILL
* EXCLUDE ALL THE FILES WITH SIX CHARACTER
* FILE NAMES THAT END IN *OPL*; EF=M******
* WILL EXCLUDE ALL THE FILES WITH FILE
* NAMES THAT START WITH THE LETTER *M*.
*
* MULTIPLE FILE NAMES MAY BE SPECIFIED,
* SEPARATED BY SLASHES; FOR EXAMPLE,
* EF=A******/B******/C****** WILL EXCLUDE
* ALL THE FILES WITH NAMES THAT BEGIN WITH
* THE LETTERS *A*, *B* OR *C*.
*
* THE *EF* PARAMETER MAY BE SPECIFIED
* TOGETHER WITH THE *FN* PARAMETER; FOR
* EXAMPLE, FN=AB*****,EF=ABC**** WILL LIST
* INFORMATION ABOUT ALL FILES WITH NAMES
* THAT START WITH THE LETTERS *AB*, EXCEPT
* FOR THOSE FILES WITH NAMES THAT START
* WITH THE LETTERS *ABC*.
*
* THIS PARAMETER IS NOT ALLOWED WHEN
* LISTING PERMIT INFORMATION (LO=FP,
* LO=P), NOR WHEN LISTING SECURITY ACCESS
* CATEGORIES (LO=X).
*
* FN FILENAME/FILENAME/.../FILENAME
* PERMANENT FILE NAME. THIS PARAMETER
* SPECIFIES THAT CATALOG INFORMATION IS
* DESIRED ONLY FOR THESE PERMANENT FILES.
*
* AN ASTERISK (*) PRESENT IN A FILE NAME
* INDICATES THAT A SET OF FILES IS TO BE
* LISTED. FOR EXAMPLE, FN=***OPL WILL
* LIST ALL THE FILES WITH SIX CHARACTER
* FILE NAMES THAT END IN *OPL*; FN=M******
* WILL LIST ALL THE FILES WITH FILE NAMES
* THAT START WITH THE LETTER *M*.
*
* MULTIPLE FILE NAMES MAY BE SPECIFIED,
* SEPARATED BY SLASHES; FOR EXAMPLE,
* FN=A******/B******/C****** WILL LIST ALL
* THE FILES WITH NAMES THAT BEGIN WITH THE
* LETTERS *A*, *B* OR *C*.
*
* THE *FN* PARAMETER MAY BE SPECIFIED
* TOGETHER WITH THE *EF* PARAMETER; FOR
* EXAMPLE, FN=AB*****,EF=ABC**** WILL LIST
* INFORMATION ABOUT ALL FILES WITH NAMES
* THAT START WITH THE LETTERS *AB*, EXCEPT
* FOR THOSE FILES WITH NAMES THAT START
* WITH THE LETTERS *ABC*.
*
* IF A SINGLE FILE NAME WITH NO ASTERISK
* (*) CHARACTERS IS SPECIFIED TOGETHER
* WITH *LO=0*, A MESSAGE (*FN FOUND.*)
* INDICATES WHETHER OR NOT THE SPECIFIED
* FILE IS FOUND IN THE SPECIFIED CATALOG.
* IF A SUCH A FILE NAME IS SPECIFIED
* TOGETHER WITH *LO=P* AND *UN=USERNAME*,
* A MESSAGE (*USERNAME FOUND.*) INDICATES
* WHETHER OR NOT PERMISSION TO ACCESS THAT
* FILE HAS BEEN GRANTED TO THAT USER NAME.
*
* THIS PARAMETER IS REQUIRED WHEN LISTING
* PERMIT INFORMATION (*LO=FP*, *LO=P*),
* AND WHEN LISTING SECURITY ACCESS
* CATEGORIES (*LO=X*). WHEN *LO=FP*,
* *LO=P* OR *LO=X* IS SPECIFIED, ONLY A
* SINGLE FILE NAME MAY BE SPECIFIED, AND
* NO ASTERISK (*) CHARACTERS MAY BE
* SPECIFIED.
*
* L LFN OUTPUT FILE NAME. THIS IS THE NAME
* OF THE FILE TO WHICH THE CATLIST
* INFORMATION IS WRITTEN.
*
* LO LIST OPTION
* F SELECT FULL LISTING OF CATALOG ENTRY.
* IF THE FILES BEING CATALOGED RESIDE IN
* AN ALTERNATE CATALOG, ONLY PERTINENT
* ACCESS INFORMATION IS LISTED.
*
* FP SELECT FULL LISTING OF FILES PERMIT ENTRIES
* THIS OPTION REQUIRES THAT A FILE NAME
* BE SPECIFIED (FN PARAMETER). ALL PERTINENT
* PERMISSION INFORMATION IS LISTED. IF
* THE USER NAME IS SPECIFIED (UN
* PARAMETER), ONLY PERMISSION DATA
* FOR THAT USER AND THE SPECIFIED
* FILE IS LISTED.
* THE USER NAMES LISTED HERE WILL
* INCLUDE:
* THOSE THAT HAVE BEEN GRANTED
* EXPLICIT PERMISSION.
* THOSE THAT HAVE ACCESSED THE
* FILE BECAUSE OF IMPLICIT
* PERMISSION (SEMI-PRIVATE FILES
* ONLY).
*
* P SELECT SHORT LIST OF PERMIT ENTRIES.
* THIS OPTION IS SIMILAR TO THE *FP*
* OPTION EXCEPT THAT ONLY USER
* NUMBERS ARE LISTED FOR THE PERMIT
* ENTRIES.
*
* X SELECT FULL LISTING OF CATALOG ENTRY,
* INCLUDING THE FILE ACCESS CATEGORY SET.
* THIS OPTION REQUIRES THAT A FILE NAME
* BE SPECIFIED (FN PARAMETER). THIS OPTION
* IS NOT VALID FOR USE ON ALTERNATE USER
* CATALOGS.
*
* FOR SECURITY REASONS, THE SECURITY
* ACCESS CATEGORIES ASSOCIATED WITH A FILE
* WILL NOT BE LISTED UNLESS YOUR CURRENT
* JOB SECURITY ACCESS LEVEL IS AT LEAST AS
* HIGH AS THE CURRENT PERMANENT FILE
* SECURITY ACCESS LEVEL OF THE FILE.
*
* 0 SELECT SHORT LIST OF CATALOG ENTRIES.
* THIS LISTS ONLY THE FILE NAMES FOR THE
* SPECIFIED CATALOG ENTRIES.
*
* NA NO ABORT IF SET, JOB WILL NOT BE ABORTED IF AN
* ERROR IS ENCOUNTERED. *NA* CANNOT BE
* SPECIFIED TOGETHER WITH *WB*.
*
* PN PACKNAM REMOVABLE PACK NAME. THIS PARAMETER
* SPECIFIES THE CATALOG OF THIS DEVICE
* IS DESIRED INSTEAD OF THE USERS
* NORMAL CATALOG. THIS WILL OVERRIDE
* ANY PACK NAME SPECIFIED BY THE PACKNAM
* COMMAND. IF OMITTED THE DEVICE
* CATALOGED IS EITHER THAT SPECIFIED BY
* THE LAST PACKNAM COMMAND OR THE
* USER MASTER CATALOG IF NO PACKNAM
* REQUEST WAS ISSUED.
*
* R RESIDENCE DEVICE TYPE REQUESTED.
*
* RS RESIDENCE OF PERMANENT FILES TO BE
* INCLUDED. SPECIFY ONE OR MORE OR THE
* FOLLOWING CHARACTERS-
*
* C SELECT LISTING OF PERMANENT FILES WHICH
* RESIDE ON CARTRIDGE. THESE FILES MAY
* ALSO RESIDE ON OTHER MEDIA (DISK AND/OR
* TAPE).
*
* D SELECT LISTING OF PERMANENT FILES WHICH
* RESIDE ON DISK. THESE FILES MAY ALSO
* RESIDE ON OTHER MEDIA (CARTRIDGE AND/OR
* TAPE).
*
* T SELECT LISTING OF PERMANENT FILES WHICH
* RESIDE ON TAPE. THESE FILES MAY ALSO
* RESIDE ON OTHER MEDIA (DISK AND/OR
* CARTRIDGE).
*
* TY FILE TYPE. SPECIFY ONE OR MORE OF THE
* FOLLOWING CHARACTERS-
* A SELECT LISTING OF ALL FILE TYPES.
*
* D SELECT LISTING OF DIRECT ACCESS FILES.
*
* I SELECT LISTING OF INDIRECT ACCESS FILES.
*
* UN USERNUM USER NAME. THIS PARAMETER HAS
* TWO PURPOSES:
* 1. FOR L0=F AND L0=0:
* INDICATES THE ALTERNATE
* CATALOG FOR WHICH THE USER
* DESIRES INFORMATION.
* FILE WILL BE LISTED IF
* A. USER IS EXPLICITLY PERMITTED
* TO FILE.
* B. FILE IS A SEMI-PRIVATE OR
* LIBRARY TYPE FILE AND NO
* NO PASSWORD EXISTS FOR FILE.
* 2. FOR L0=FP AND L0=P:
* INDICATES THE SPECIFIC USER
* FOR WHICH PERMIT INFORMATION
* IS DESIRED.
*
* WB WAIT BUSY IF SET, JOB WILL WAIT FOR A PACK MOUNT,
* BUT WILL ABORT ON ALL OTHER ERRORS. *WB*
* CANNOT BE SPECIFIED TOGETHER WITH *NA*.
SPACE 4,10
*** ASSUMED PARAMETERS.
* DN=0
* EF=0
* FN=*******
* L=OUTPUT
* LO=0
* NA=0
* PN=0
* R=0
* RS=0
* RSM=7
* TY=0
* UN=0
* WB=0
SPACE 4,15
*** DAYFILE MESSAGES.
*
* *CATLIST COMPLETE.* = NORMAL TERMINATION WITHOUT ERRORS.
*
* *EMPTY CATALOG.* = NO ENTRIES EXIST FOR OPTIONS SELECTED.
*
* *FILE NAME MISSING.* = *LO=P*, *LO=FP* OR *LO=X* OPTION WAS
* SELECTED BUT NO FILE NAME WAS SPECIFIED.
*
* *INCORRECT LIST OPTION.* = THE OPTION SELECTED IS NOT ALLOWED.
*
* *INCORRECT PARAMETER.* = INCORRECT PARAMETER OR COMBINATION
* OF PARAMETERS WAS SPECIFIED.
*
* *NO FILES FOUND.* = NO FILES EXIST WHICH MATCH THE VALUES
* SPECIFIED FOR THE *FN* AND/OR THE *EF* PARAMETERS.
*
* *NO PERMITS.* = NO PERMIT ENTRIES EXIST FOR THE
* SPECIFIED FILE.
SPACE 4,10
** COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSMLS
*CALL COMSPFM
*CALL COMSPRD
*CALL COMSSFM
SPACE 4,10
** ASSEMBLY CONSTANTS.
OBFL EQU 1001B OUTPUT BUFFER LENGTH
IBFL EQU 701B INPUT BUFFER LENGTH
SBFL EQU 300B INITIAL SORT BUFFER LENGTH
FLIN EQU 1000B FL INCREMENT FOR SORT BUFFER
LMDL EQU 99999 TERMINAL - LINE MODE DEFAULT SCREEN SIZE
MSBL EQU SBFL+5*FLIN MAXIMUM SORT BUFFER LENGTH
SMDL EQU 24 TERMINAL - SCREEN MODE DEFAULT SCREEN SIZE
SSM= EQU 0 SECURE SYSTEM MEMORY
TITLE DATA LOCATIONS.
ORG 110B
SPACE 4,10
** FETS.
I BSS 0
INPUT FILEB IBUF,IBFL,FET=CFLM
.I BSS 0
ORG I+1 SUPPRESS ADDRESS ON *PFM* ERRORS
VFD 13/0,1/1,22/0,6/CFLM-5,18/IBUF
ORG .I
O BSS 0
OUTPUT FILEB OBUF,OBFL,EPR,FET=10B
** DATA LOCATIONS.
BL CON 0 BUFFER LENGTH
BLK CON 1L BLANK LINE
BO CON 0,0 BUFFER OFFSETS FOR THIS PAGE AND NEXT PAGE
BOVF CON 0 BUFFER OVERFLOW FLAG
DN CON 0 DEVICE NUMBER
DT CON 0 DEVICE TYPE
ERRF CON 0 *PFM* ERROR FLAG
FILENAM CON 0 FILE NAME (ONLY ONE FILE SPECIFIED)
FLNM BSS 0 SELECTION FILE NAME LIST
CON 7L******* DEFAULT FILE NAME SELECTION MASK
BSSZ 35
EFNM BSS 0 EXCLUSION FILE NAME LIST
BSSZ 36
FCDD CON 0 FILE COUNT (DIRECT ACCESS DISK FILES)
FCID CON 0 FILE COUNT (INDIRECT ACCESS DISK FILES)
FCDA CON 0 FILE COUNT (DAPF-S ON ALTERNATE STORAGE)
FCIA CON 0 FILE COUNT (IAPF-S ON ALTERNATE STORAGE)
FLN CON 0 ENTRY NUMBER (DISPLAY)
FSDD CON 0 FILE SIZE (DIRECT ACCESS DISK FILES)
FSID CON 0 FILE SIZE (INDIRECT ACCESS DISK FILES)
FSDA CON 0 FILE SIZE (DAPF-S ON ALTERNATE STORAGE)
FSIA CON 0 FILE SIZE (IAPF-S ON ALTERNATE STORAGE)
JT CON 0 JOB TYPE
LL CON 0 LINE LIMIT-1 (NUMBER OF LINES ON A PAGE)
LN CON 99999 LINE NUMBER
LO CON 0 LIST OPTION
MODE CON 0 LIST MODE
NABT CON 0 NO ABORT FLAG
NO CON 0 ENTRY NUMBER
NZ CON 1 NONZERO VALUE
PACK CON 0 PACKNAME
PD CON 0 JOB PRINT DENSITY
PG CON 0 PAGE NUMBER
RES CON 0 RESIDENCE
RS CON 0 RESIDENCE OF FILE SELECTION
RSM CON 7 RESIDENCE SELECTION MASK
SSM CON 0 SYSTEM SECURITY MODE
TP CON 0 TITLE PAGE FLAG FOR TERMINAL
TY CON 0 FILE TYPE SELECTION
TYM CON 0 FILE TYPE SELECTION MASK
USER CON 0 USER NAME OF CALLER
USERNUM CON 0 SELECTED USER NAME
WBSY CON 0 WAIT BUSY FLAG
** SORT BUFFER CONTROL WORDS.
MBS CON MSBL MAXIMUM SORT BUFFER SIZE
CBS CON SBFL CURRENT SORT BUFFER SIZE
CFL CON RFL= CURRENT FL
TITLE MAIN PROGRAM.
CTL SPACE 4,10
** MAIN ROUTINE.
CTL BSS 0 ENTRY
RJ FCB FILL CATALOG BUFFER
NG X6,CTL5 IF ERROR RETURN STATUS
SA1 CTLA
NZ X1,CTL9 IF SELECTED FILE LIST
ZR X6,CTL7 IF NO CATALOGS
RJ CSU CHECK FOR SPECIAL USER
CTL1 SA2 MODE PROCESS LIST OPTION
SA2 X2+TLOT
SB2 X2
JP B2 CALL PROCESSOR
* RETURN HERE ON NORMAL COMPLETION.
CTL3 SA1 DT
ZR X1,CTL4 IF TERMINAL FILE
MESSAGE (=C* CATLIST COMPLETE.*),3
EQ CTL5
CTL4 MESSAGE (=C**),1 CLEAR MESSAGE BUFFER
* RETURN HERE ON ERRORS.
CTL5 WRITER O FLUSH OUTPUT
EQ END ENDRUN/ABORT
* NO CATALOG/PERMIT ENTRIES FOUND. ISSUE APPROPRIATE MESSAGE
* TO DAYFILE OR (IF TERMINAL OUTPUT FILE) TO OUTPUT FILE.
CTL7 SA2 CTLB MESSAGE ADDRESS
SA1 DT
ZR X1,CTL8 IF TERMINAL FILE
MESSAGE X2,3 ISSUE MESSAGE TO DAYFILE
EQ END ENDRUN/ABORT
CTL8 WRITEH O,X2,2 WRITE MESSAGE TO OUTPUT
EQ CTL4 FLUSH OUTPUT AND END
CTL9 RJ SFN SPACE FILL ENTRY
LX6 54
SA6 A1
SA1 DT
ZR X1,CTL10 IF TERMINAL FILE
MESSAGE CTLA,3 *(ENTRY) FOUND.*
EQ END ENDRUN
CTL10 WRITEC O,CTLA *(ENTRY) FOUND*
EQ CTL4 FLUSH OUTPUT AND END
CTLA CON 0 SELECTED ENTRY
CON 6LFOUND.
CTLB CON CTLC
CTLC DATA C* EMPTY CATALOG.*
CTLD DATA C* NO PERMITS.*
CTLE DATA C* NO FILES FOUND.*
TLOT BSS 0 TABLE OF LIST OPTIONS
LOC 0
CON SSL SHORT SORTED FILE LIST
CON FFL FULL FILE LIST
CON FLC FILE LIST AND CATEGORY SET
CON SSL SHORT SORTED ALTERNATE FILE LIST
CON FAC FULL ALTERNATE FILE LIST
CON SPD SHORT PERMIT DATA LIST
CON FPD FULL LIST OF PERMIT DATA
LOC *O
END SPACE 4,10
** END - END PROCESSING.
*
* USES X - 1.
* A - 1.
*
* MACROS ABORT, ENDRUN.
END BSS 0 ENTRY
SA1 ERRF
ZR X1,END1 IF NO *PFM* ERROR OCCURRED
SA1 NABT
NZ X1,END1 IF *NA* SPECIFIED RATHER THAN *WB*
ABORT
END1 ENDRUN
TITLE PROCESSING ROUTINES.
FAC SPACE 4,10
** FAC - FULL ALTERNATE CATALOG LIST.
FAC BSS 0 ENTRY
FAC1 READW I,CBUF,NWCE READ NEXT CATALOG ENTRY
NG X1,FAC2 IF END OF BUFFER
RJ CRS CHECK FILE RESIDENCE AND TYPE
ZR X1,FAC1 IF FILE NOT TO BE LISTED
SA3 CBUF GET FILENAME
SB2 FLNM CHECK INCLUSION LIST
RJ CFN
NZ X6,FAC1 IF FILE NOT IN INCLUSION LIST
SB2 EFNM CHECK EXCLUSION LIST
RJ CFN
ZR X6,FAC1 IF FILE IN EXCLUSION LIST
RJ AEN ADVANCE ENTRY NUMBER
RJ AFS ACCUMULATE FILE STATISTICS
SB2 /COMCFCE/CHDRN+1 ADVANCE LINE COUNT
RJ ALN
SA1 NO
SA3 SSM
EDCAT CBUF,LBUF,X1,1,,X3,1
WRITEH O,LBUF,FCELL FIRST LINE
WRITEH O,LBUF+FCELL,FCELL SECOND LINE
WRITEH O,LBUF+2*FCELL,FCELA THIRD LINE
WRITEH O,LBUF+3*FCELL,FCELB FOURTH LINE
WRITEC O,BLK
EQ FAC1 LOOP FOR NEXT CATALOG ENTRY
FAC2 RJ FCB FILL CATALOG BUFFER
NG X6,CTL5 IF ERROR RETURN STATUS
NZ X6,FAC1 IF MORE CATALOGS
SA1 NO NUMBER OF ENTRIES
ZR X1,CTL7 IF NO CATALOGS
RJ PAS PRINT ACCUMULATED STATISTICS
EQ CTL3 COMPLETE PROCESSING
FFL SPACE 4,10
** FFL - FULL LISTING.
FFL BSS 0 ENTRY
FFL1 READW I,CBUF,NWCE READ NEXT CATALOG ENTRY
NG X1,FFL2 IF END OF BUFFER
RJ CRS CHECK FILE RESIDENCE AND TYPE
ZR X1,FFL1 IF FILE NOT TO BE LISTED
SA3 CBUF GET FILENAME
SB2 FLNM CHECK INCLUSION LIST
RJ CFN
NZ X6,FFL1 IF FILE NOT IN INCLUSION LIST
SB2 EFNM CHECK EXCLUSION LIST
RJ CFN
ZR X6,FFL1 IF FILE IN EXCLUSION LIST
RJ AEN ADVANCE ENTRY NUMBER
RJ AFS ACCUMULATE FILE STATISTICS
SB2 /COMCFCE/CHDRN+1 ADVANCE LINE COUNT
RJ ALN
SA1 NO
SA3 SSM
EDCAT CBUF,LBUF,X1,1,,X3
WRITEH O,LBUF,FCELL FIRST LINE
WRITEH O,LBUF+FCELL,FCELL SECOND LINE
WRITEH O,LBUF+2*FCELL,FCELA THIRD LINE
WRITEH O,LBUF+3*FCELL,FCELB FOURTH LINE
WRITEC O,BLK
EQ FFL1 PROCESS NEXT CATALOG ENTRY
FFL2 RJ FCB FILL CATALOG BUFFER
NG X6,CTL5 IF ERROR RETURN STATUS
NZ X6,FFL1 IF MORE CATALOGS
SA1 NO NUMBER OF ENTRIES
ZR X1,CTL7 IF NO CATALOGS
RJ PAS PRINT ACCUMULATED STATISTICS
EQ CTL3 COMPLETE PROCESSING
FLC SPACE 4,10
** FLC - FILE LIST AND CATEGORY SET.
FLC BSS 0 ENTRY
READW I,CBUF,NWCE
RJ AEN ADVANCE ENTRY NUMBER
SB2 /COMCFCE/CHDRN+1 ADVANCE LINE COUNT
RJ ALN
SA1 NO
SA3 SSM
EDCAT CBUF,LBUF,X1,1,,X3
WRITEH O,LBUF,FCELL FIRST LINE
WRITEH O,LBUF+FCELL,FCELL SECOND LINE
WRITEH O,LBUF+2*FCELL,FCELA THIRD LINE
WRITEH O,LBUF+3*FCELL,FCELB FOURTH LINE
WRITEC O,BLK
RJ LCS LIST CATEGORY SET FOR FILE
EQ CTL3 COMPLETE PROCESSING
FPD SPACE 4,10
** FPD - FULL LIST OF PERMIT DATA.
FPD BSS 0 ENTRY
FPD1 READW I,CBUF,NWPE READ NEXT PERMIT ENTRY
NG X1,FPD4 IF END OF BUFFER
RJ AEN ADVANCE ENTRY NUMBER
SB2 B1 ADVANCE LINE NUMBER BY 1
RJ ALN
MX0 42 PICK USER NAME
SA5 CBUF
BX1 X0*X5
RJ SFN SPACE FILL NAME
SA1 FLN SET USER NAME COUNT
MX0 30
LX1 30
BX1 X0*X1 PICK FIRST PART OF USER NAME
LX6 24
BX7 -X0*X6
BX7 X7+X1
SA7 LBUF
SA5 CBUF+1 SET USER PERMISSION
MX0 4
LX0 40
BX1 X0*X5
LX1 24
SA1 /COMCFCE/MDTB+X1
LX1 35-59
MX0 18
BX6 X0*X6 PICK LAST 3 CHARACTERS OF USER NAME
BX1 -X0*X1 MERGE WITH PERMISSION
BX6 X6+X1
SA6 LBUF+1
MX0 18 CONVERT ACCESS COUNT
BX1 X0*X5
LX1 18
RJ CDD CONVERT TO DECIMAL
MX0 1 CHECK PERMIT TYPE
LX0 41
BX1 X0*X5
NZ X1,FPD2 IF ACCOUNTING PERMIT
SX1 1R*&1R SET EXPLICIT PERMIT FLAG
LX1 54
BX6 X1-X6
FPD2 SA2 FPDA
SA6 A2+B1 SAVE ACCESS COUNT
ERRNZ FPDB-FPDA-1 CODE DEPENDS ON VALUE
BX6 X2
MX0 1 CHECK IF EXPIRATION DATE IS PRESENT
LX0 42
BX1 X0*X5
ZR X1,FPD3 IF NO EXPIRATION DATE
SA1 CBUF
MX0 -18
BX1 -X0*X1 PICK UP EXPIRATION DATE
ZR X1,FPD3 IF NONEXPIRING PERMIT
EDATE X1 CONVERT DATE
LX6 -6
FPD3 MX0 6 SWITCH AROUND FIRST CHARACTERS
SA4 FPDB
BX2 X0*X6
BX3 X0*X4
BX6 -X0*X6
BX7 -X0*X4
BX6 X3+X6
BX7 X2+X7
SA6 LBUF+2 SET PERMIT TYPE/EXPIRATION DATE
SA7 LBUF+3 SET ACCESS COUNT
BX3 X5 CONVERT DATE AND TIME
RJ /COMCFCE/CDT CONVERT TIME AND DATE
SA6 LBUF+4
BX7 X5
SA7 LBUF+5
WRITEC O,LBUF
EQ FPD1 LIST NEXT PERMIT
* READ NEXT BUFFER OF PERMITS.
FPD4 RJ FCB FILL BUFFER
NG X6,CTL5 IF ERROR
ZR X6,CTL3 IF END OF PERMITS
EQ FPD1 LIST NEXT PERMIT
FPDA DATA 10H BLANK LINE
FPDB CON 0
SPD SPACE 4,10
** SPD - SHORT LIST OF PERMIT DATA.
SPD BSS 0 ENTRY
SPD1 READW I,CBUF,NWPE READ NEXT PERMIT ENTRY
NG X1,SPD2 IF BUFFER EMPTY
RJ GSL GENERATE ENTRY FOR SHORT LIST
EQ SPD1 PROCESS NEXT PERMIT ENTRY
SPD2 RJ FCB FILL BUFFER
NG X6,CTL5 IF ERROR
NZ X6,SPD1 IF NOT END OF DATA
WRITEC O,LBUF
SA1 NO SET NUMBER OF USERS
SX6 X1-1
NZ X6,SPD3 IF MORE THAN ONE USER FOUND
SA2 SPDB CHANGE SYNTAX OF MESSAGE
BX7 X2
SA7 SPDA+1
SPD3 RJ CDD CONVERT TO DECIMAL
SA6 SPDA
WRITEC O,BLK
WRITEC O,SPDA
EQ CTL3 COMPLETE PROCESSING
SPDA CON 0 NUMBER OF USERS
DATA C* USERS*
SPDB DATA C* USER*
SSL SPACE 4,15
** SSL - SHORT SORTED LIST.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 0, 1, 2, 3, 6, 7.
* B - 2, 3, 7.
*
* CALLS AFS, ALN, CFN, DSB, FCB, GNI, GSL, PAS, RQS, SNP,
* SST=.
*
* MACROS READW, WRITEC, WRITEH.
SSL BSS 0 ENTRY
SSL1 SA0 B0 INITIALIZE BUFFER POINTER
SSL2 READW I,CBUF,NWCE
PL X1,SSL4 IF DATA READ
RJ FCB FILL CATALOG BUFFER
NG X6,SSL3 IF ERROR RETURN STATUS
NZ X6,SSL2 IF BUFFER NOT EMPTY
SSL3 BX6 X6-X6 CLEAR BUFFER OVERFLOW FLAG
SA6 BOVF
EQ SSL7 PROCESS SORT OF BUFFER
SSL4 RJ CRS CHECK FILE RESIDENCE AND TYPE
ZR X1,SSL2 IF FILE NOT TO BE LISTED
SA3 CBUF GET FILENAME
SB2 FLNM CHECK INCLUSION LIST
RJ CFN
NZ X6,SSL2 IF FILE NOT IN INCLUSION LIST
SB2 EFNM CHECK EXCLUSION LIST
RJ CFN
ZR X6,SSL2 IF FILE IN EXCLUSION LIST
RJ AFS ACCUMULATE STATISTICS (GET TYPE/RESIDENCE)
SA2 CBUF GET FILE NAME
SA3 CBUF+FCEC GET ERROR CODE
MX0 42
LX3 18
MX6 -3
BX2 X0*X2
LX1 57-0 POSITION FILE TYPE FLAG (NONZERO IF DAPF)
BX6 -X6*X3 ERROR CODE
LX2 -6 POSITION FILE NAME
BX6 X6+X1 MERGE IN PF TYPE
ZR B2,SSL6 IF FILE DISK RESIDENT
SX1 10B SET *FILE NOT DISK RESIDENT* FLAG
BX6 X6+X1
SSL6 BX6 X6+X2 MERGE IN FILE NAME
SA6 A0+SBUF
SA1 CBS GET CURRENT BUFFER MAXIMUM
SA0 A0+B1
SX3 A0+B1
IX2 X1-X3
PL X2,SSL2 IF BUFFER NOT FULL
RJ RQS REQUEST MORE BUFFER SPACE
PL X1,SSL2 IF MORE AVAILABLE
SA3 BOVF CHECK IF MESSAGE NEEDED
NZ X3,SSL7 IF MESSAGE PREVIOUSLY OUTPUT
MX6 1 SET BUFFER OVERFLOW FLAG
SB2 B1
SA6 BOVF
RJ ALN ADVANCE LINE NUMBER
WRITEC O,SSLD OUTPUT WARNING MESSAGE
WRITEC O,BLK
* SORT DIRECT AND INDIRECT FILES ALPHABETICALLY.
SSL7 SX1 A0 NUMBER OF ENTRIES
ZR X1,CTL7 IF NO CATALOGS
SB2 B1
RJ ALN ADVANCE LINE NUMBER
SX1 A0
SB7 SBUF ADDRESS OF BUFFER
RJ SST= SORT ENTRIES
SB2 B0 DETERMINE COUNT OF EACH TYPE
SSL8 SA1 SBUF+B2
LX1 59-57
NG X1,SSL9 IF DIRECT ACCESS FILE
SB2 B2+B1
SB3 A0-B2
NZ B3,SSL8 IF NOT END OF BUFFER
SSL9 SX6 B2 NUMBER OF INDIRECT ACCESS FILES
SA6 SSLA
SX7 A0-B2 NUMBER OF DIRECT ACCESS FILES
SA6 SSLC
SA7 SSLB
* LIST INDIRECT ACCESS FILES.
SA1 SSLA GET COUNT OF INDIRECT ACCESS FILES
ZR X1,SSL12 IF NO INDIRECT ACCESS FILES
WRITEC O,BLK
WRITEH O,SSLE,SSLEL
WRITEC O,BLK
SB2 B1+B1
RJ ALN ADVANCE LINE NUMBER
SX7 8 SET LINE POSITION
SA7 GSLA
SB2 B1+
RJ ALN
SA1 SSLA GET NUMBER OF INDIRECT FILES
RJ SNP SET NEXT PAGE
SSL10 SA3 BL
SX6 X3-1
SA6 A3+
NG X6,SSL11 IF END OF ENTRIES
RJ GNI GET NEXT ENTRY
SA3 BO CURRENT BUFFER OFFSET
IX1 X1+X3
SA1 X1+SBUF GET ACTUAL ENTRY
LX1 6
BX6 X1
SA6 CBUF
RJ GSL GENERATE ENTRY FOR SHORT LIST
EQ SSL10 GET NEXT ENTRY
SSL11 WRITEC O,LBUF LAST LINE OF INDIRECT ACCESS FILES
SA1 SSLA
RJ DSB DISPLAY SORT BREAK
SA1 SSLA
RJ SNP SET NEXT PAGE
NZ X1,SSL10 IF MORE FILES TO LIST
* LIST DIRECT ACCESS FILES.
SSL12 SA1 SSLB
ZR X1,SSL17 IF NO DIRECT ACCESS FILES
SA1 SSLA CHECK IF ANY INDIRECT ACCESS FILES
ZR X1,SSL13 IF NO INDIRECT ACCESS FILES
WRITEC O,BLK
SB2 B1
RJ ALN ADVANCE LINE NUMBER
SSL13 WRITEH O,SSLF,SSLFL
SB2 B1
RJ ALN ADVANCE LINE NUMBER
SA1 LN CHECK IF HEADER JUST PRINTED
SX2 3
IX1 X2-X1
ZR X1,SSL14 IF HEADER JUST PRINTED
WRITEC O,BLK
SB2 B1
RJ ALN ADVANCE LINE NUMBER
SSL14 SX7 8 RESET LINE POSITION
SA7 GSLA
SA1 SSLB
RJ SNP SET UP NEXT PAGE
SSL15 SA3 BL DECREMENT NUMBER OF DIRECT FILES
SX6 X3-1
SA6 A3+
NG X6,SSL16 IF END OF ENTRIES
RJ GNI GET NEXT ENTRY
SA2 SSLC DETERMINE POSITION IN BUFFER
SA3 BO GET CURRENT BUFFER OFFSET
IX2 X2+X3
SB2 SBUF+X2
SA1 X1+B2 GET ACTUAL ENTRY
LX1 6
BX6 X1
SA6 CBUF
RJ GSL GENERATE ENTRY FOR SHORT LIST
EQ SSL15 GET NEXT ENTRY
SSL16 WRITEC O,LBUF LAST LINE
SA1 SSLB
RJ DSB DISPLAY SORT BREAK
SA1 SSLB
RJ SNP SET NEXT PAGE
NZ X1,SSL15 IF MORE FILE NAMES TO LIST
SB2 B1+
RJ ALN
SSL17 SA2 ERRF CHECK ERROR FLAG
NZ X2,SSL18 IF *PFM* ERROR
SA2 BOVF CHECK OVERFLOW FLAG
NZ X2,SSL1 IF OVERFLOW OCCURRED (MORE FILES TO LIST)
SSL18 WRITEC O,BLK
RJ PAS PRINT ACCUMULATED STATISTICS
EQ CTL3 CONTINUE PROCESSING
SSLA CON 0 NUMBER OF INDIRECT ACCESS FILES
SSLB CON 0 NUMBER OF DIRECT ACCESS FILES
SSLC CON 0 COUNT OF ENTRIES BEFORE DIRECT ACCESS FILE
SSLD DATA C* BUFFER OVERFLOW - ALL FILES LISTED BUT NOT SORTED.*
SSLE DATA C* INDIRECT ACCESS FILES*
SSLEL EQU *-SSLE
SSLF DATA C* DIRECT ACCESS FILES*
SSLFL EQU *-SSLF
TITLE GENERAL SUBROUTINES.
AEN SPACE 4,15
** AEN - ADVANCE ENTRY NUMBER.
*
* ENTRY (NO) = NUMBER OF FILES.
*
* EXIT (NO) ADVANCED.
* (FLN) = ADVANCED FILE NUMBER IN DISPLAY CODE.
*
* USES X - 0, 1, 6.
* A - 1, 6.
*
* CALLS CDD.
AEN SUBR ENTRY/EXIT
SA1 NO ADVANCE FILE NUMBER
SX1 X1+B1
BX6 X1
SA6 A1
RJ CDD
SX1 1R. SET PERIOD
MX0 54
LX6 6
BX6 X0*X6
BX6 X1+X6
SA6 FLN
EQ AENX RETURN
AFS SPACE 4,20
** AFS - ACCUMULATE FILE STATISTICS.
*
* INCREMENT THE FILE COUNT AND TOTAL PRU-S FOR -
* INDIRECT ACCESS FILES ON DISK.
* DIRECT ACCESS FILES ON DISK.
* IAPF-S ON ALTERNATE STORAGE.
* DAPF-S ON ALTERNATE STORAGE.
*
* ENTRY (CBUF) = CATALOG ENTRY.
*
* EXIT COUNTERS UPDATED.
* (X1) = 1 IF DIRECT ACCESS FILE.
* = 0 IF INDIRECT ACCESS FILE.
* (B2) = 0 IF FILE ON DISK.
* = 1 IF FILE ON ALTERNATE STORAGE.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 2.
AFS SUBR ENTRY/EXIT
SA1 CBUF+FCLF GET LENGTH OF FILE
MX2 -24
BX3 -X2*X1 GET TRACK POINTER
AX3 12
LX1 24
BX6 -X2*X1
LX1 0-11-24+60 CHECK FILE TYPE
MX2 -1
BX1 -X2*X1 (X1)=1 IF DIRECT, 0 IF INDIRECT
ZR X3,AFS2 IF FILE NOT ON DISK
SB2 B0+ SET RESIDENCE TO DISK
SA2 FSID SET COUNTERS FOR INDIRECT ACCESS DISK FILE
SA3 FCID
ZR X1,AFS1 IF INDIRECT ACCESS FILE
SA2 FSDD SET COUNTERS FOR DIRECT ACCESS DISK FILE
SA3 FCDD
AFS1 IX6 X6+X2 INCREMENT ACCUMULATED SIZE
SA6 A2
SX6 X3+B1 INCREMENT FILE COUNT
SA6 A3
EQ AFSX RETURN
* FILE ON ALTERNATE STORAGE.
AFS2 SB2 B1+ SET RESIDENCE TO ALTERNATE STORAGE
SA2 FSIA SET COUNTERS FOR IAPF ON ALTERNATE STORAGE
SA3 FCIA
ZR X1,AFS1 IF INDIRECT ACCESS FILE
SA2 FSDA SET COUNTERS FOR DAPF ON ALTERNATE STORAGE
SA3 FCDA
EQ AFS1 UPDATE COUNTERS
ALN SPACE 4,15
** ALN - ADVANCE LINE NUMBER.
*
* ENTRY (LN) = CURRENT PAGE LINE NUMBER.
* (B2) = NUMBER OF LINES TO ADVANCE.
*
* EXIT FILE NUMBER UPDATED IN OUTPUT LINE.
* LINE BUFFER CLEARED.
*
* USES X - 1, 6.
* A - 1, 6.
* B - 2.
*
* CALLS HDR, PTP.
ALN SUBR ENTRY/EXIT
SA1 LN ADVANCE LINE NUMBER
SX6 X1+B2
SA6 A1
SA1 LL GET LINE LIMIT
IX1 X1-X6
PL X1,ALN2 IF NOT END OF PAGE
SX6 B2
SA6 A6 RESET LINE NUMBER
SA1 DT CHECK DEVICE TYPE
NZ X1,ALN1 IF FILE NOT ASSIGNED TO A TERMINAL
SA1 TP CHECK IF TITLE PAGE ALREADY PRINTED
NZ X1,ALN2 IF TITLE ALREADY PRINTED
ALN1 RJ PTP PRINT TITLE PAGE
SX6 B1 SET TITLE PAGE FLAG FOR TERMINAL
SA6 TP
RJ HDR PRINT HEADER
ALN2 SB2 7 CLEAR LINE BUFFER
SX6 B0
ALN3 ZR B2,ALNX IF END OF LINE BUFFER
SA6 LBUF+B2
SB2 B2-B1
EQ ALN3 CLEAR NEXT WORD
CFN SPACE 4,15
** CFN - CHECK FILENAME IN LIST.
*
* *CFN* CHECKS A FILE NAME FOR INCLUSION IN A LIST,
* WITH WILDCARD MATCHING.
*
* ENTRY (X3) = FILENAME.
* (B2) = FWA OF LIST.
*
* EXIT (X6) = 0 IF FILE IN LIST.
*
* USES X - 1, 3, 4, 5, 6, 7.
* A - 1, 4, 5.
* B - 2.
CFN2 SX6 B1+
CFN SUBR ENTRY/EXIT
MX7 42
BX3 X7*X3
CFN1 SA4 B2
SB2 B2+B1
ZR X4,CFN2 IF END OF LIST
SA1 CFNA CHARACTER MASK
SA5 CFNB ASTERISKS
BX5 X4-X5
BX6 X1*X5
BX7 -X1*X5
IX6 X1+X6
BX6 X6+X7
BX7 -X1*X6
BX6 X7
LX7 -5
IX7 X6-X7
BX7 X6+X7
BX6 X4-X3
BX6 X7*X6
ZR X6,CFNX IF IN LIST
EQ CFN1 CHECK NEXT ENTRY IN LIST
CFNA CON 37373737373737000000B
CFNB CON 7L*******
CRS SPACE 4,15
** CRS - CHECK RESIDENCE AND FILE TYPE.
*
* *CRS* CHECKS TO SEE IF THE FILE RESIDENCE AND TYPE SELECTED
* MATCH THE CURRENT FILE RESIDENCE AND TYPE, TO DETERMINE IF
* THE FILE IS TO BE LISTED.
*
* ENTRY (CBUF) = CATALOG ENTRY.
* (RSM) = FILE RESIDENCE SELECTION MASK.
* (TYM) = FILE TYPE SELECTION MASK.
*
* EXIT (X1) = 0 IF FILE IS NOT TO BE LISTED.
*
* USES X - 1, 3.
* A - 3.
* B - 3, 6.
CRS SUBR ENTRY/EXIT
SB6 CBUF
SB3 B0 INITIALIZE FILE RESIDENCE
SA3 B6+FCBT CHECK FOR DISK RESIDENCE
MX1 -24
BX3 -X1*X3
AX3 12 EXAMINE TRACK ONLY
ZR X3,CRS1 IF NOT DISK RESIDENT
SB3 B3+4 SET DISK RESIDENT INDICATOR
CRS1 SA3 B6+FCAA CHECK FOR CARTRIDGE RESIDENCE
MX1 -36
BX1 -X1*X3
ZR X1,CRS2 IF NOT CARTRIDGE RESIDENT
LX3 59-48 CHECK FOR OBSOLETE FLAG
NG X3,CRS2 IF CARTRIDGE COPY OBSOLETE
SB3 B3+B1 SET CARTRIDGE RESIDENCE INDICATOR
CRS2 SA3 B6+FCTV CHECK FOR TAPE VSN
MX1 -24
BX3 -X1*X3
ZR X3,CRS3 IF NO TAPE VSN
SB3 B3+2 SET TAPE RESIDENT INDICATOR
CRS3 SA3 RSM GET FILE RESIDENCE SELECTION MASK
SX1 B3 GET ACTUAL FILE RESIDENCE
BX1 X1*X3 COMPARE ACTUAL AND SELECTED RESIDENCE
ZR X1,CRSX IF FILE FAILED RESIDENCE CRITERIA
SA1 B6+FCBS CHECK FILE TYPE
MX3 -1
LX1 0-11
BX3 -X3*X1 01 = DIRECT, 00 = INDIRECT
SX1 X3+B1 10 = DIRECT, 01 = INDIRECT
SA3 TYM
ZR X3,CRSX IF FILE TYPE NOT SPECIFIED
BX1 X1*X3 CHECK FILE TYPE MATCH
EQ CRSX RETURN
CSU SPACE 4,15
** CSU - CHECK FOR SPECIAL USER.
*
* ENTRY (AUSER) = ALTERNATE USER.
* (USER) = USER NAME OF CALLER.
*
* EXIT (MODE) UPDATED TO NON-ALTERNATE CATALOG IF
* USER REQUESTING CATLIST HAS AUTOMATIC PERMISSION.
*
* USES X - 0, 1, 2, 3, 6, 7.
* A - 1, 2, 6.
* B - 2.
CSU SUBR ENTRY/EXIT
SA2 MODE
SX2 X2-PMTL
PL X2,CSUX IF PERMIT DATA REQUEST
SA2 AUSER
ZR X2,CSUX IF NO ALTERNATE USER
SA1 USER
MX0 -6
SB2 8
CSU1 LX1 6 POSITION NEXT CHARACTER
LX2 6
SB2 B2-B1
ZR B2,CSU2 IF USER NAMES MATCH
BX3 -X0*X1 USER
BX6 -X0*X2 AUSER
SX7 X3-1R*
ZR X7,CSU1 IF CHARACTER = *
IX6 X3-X6
ZR X6,CSU1 IF CHARACTERS COMPARE
EQ CSUX EXIT
CSU2 SA1 MODE PROCEED AS NON-ALTERNATE CATALOG
SX6 X1-ALTC
SA6 A1
EQ CSUX RETURN
DSB SPACE 4,15
** DSB - DISPLAY SORT BREAK.
*
* ENTRY (X1) = TOTAL NUMBER OF FILE NAMES.
* (BO) = CURRENT BUFFER OFFSET.
*
* EXIT SORT-BREAK LINE DISPLAYED.
*
* USES X - 2, 3.
* A - 2.
* B - 2.
*
* CALLS ALN.
*
* MACROS WRITEC.
DSB SUBR ENTRY/EXIT
SA2 BO+1 GET CURRENT BUFFER OFFSET
IX3 X2-X1
ZR X3,DSBX IF NO MORE FILES IN THIS GROUP
SA2 DT
NZ X2,DSBX IF NOT TERMINAL FILE
SB2 1
RJ ALN ADVANCE LINE NUMBER
WRITEC O,(=C* ...*)
EQ DSBX RETURN
FCB SPACE 4,10
** FCB - FILL CATALOG AND PERMIT BUFFER.
*
* EXIT (X6) = NUMBER OF WORDS READ.
* (X6) .LT. 0, IF ERROR DETECTED.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
*
* MACROS CATLIST.
FCB1 SA6 ERRF SET *PFM* ERROR FLAG
FCB SUBR ENTRY/EXIT
SA1 I CHECK FOR EOI ON LAST READ
LX1 59-9
SX6 B0
NG X1,FCBX IF EOI ENCOUNTERED
SA2 A1+B1 SET IN = OUT = FIRST
SX6 X2
SA6 A2+B1 SET IN
SA6 A6+B1 SET OUT
CATLIST A1,,,,,,,DN
SA1 X2+ CHECK ERROR STATUS
MX0 -8
AX1 10
BX2 -X0*X1
MX6 1 SET ERROR RETURN CONDITION
NZ X2,FCB1 IF ERROR RETURN STATUS SET
SA1 A1+2 SET NUMBER OF WORDS READ
SA2 A1+B1
IX6 X1-X2
EQ FCBX RETURN
GNI SPACE 4,15
** GNI - GET NEXT ENTRY INDEX.
*
* ENTRY MUST HAVE GONE TO *NIP* TO PRESET INDEX.
*
* EXIT (X1) = INDEX FOR NEXT ENTRY TO PROVIDE A SORTED
* LIST ORDERED BY COLUMNS.
*
* USES X - 1, 2, 3, 4, 6.
* A - 1, 2, 4, 6.
GNI3 IX6 X1+X4 ADD INCREMENT
SA6 GNIB
GNI SUBR ENTRY/EXIT
SA2 GNIA
SX3 7 CHECK LINE LENGTH
IX4 X2-X3
PL X4,GNI2 IF END OF LINE
SA1 A2+B1 GET ENTRY BIAS
GNI1 SX6 X2+B1 UPDATE COLUMN NUMBER
SA4 GNID GET REMAINDER
SA6 A2
IX3 X2-X4
SA4 A4-B1 GET INCREMENT
NG X3,GNI3 IF FULL INCREMENT TO BE USED
SX4 X4-1
EQ GNI3 USE INCREMENT-1
GNI2 SA1 GNIE GET LINE INDEX
SX6 X1+B1
MX2 0 CLEAR C0LUMN NUMBER
BX1 X6
SA6 A1
EQ GNI1 SET CELLS FOR NEW LINE
GNIA CON 0 COLUMN NUMBER
GNIB CON 0 ENTRY BIAS
GNIC CON 0 ROW INCREMENT
GNID CON 0 REMAINDER
GNIE CON 0 LINE INDEX
GSL SPACE 4,25
** GSL - GENERATE ENTRY FOR SHORT LIST.
*
* ENTRY (CBUF) = FILE/USER DESCRIPTOR.
* FOR *SSL* CALL -
* 42/PFN,8/0,1/N,3/EC,2/0,1/D,3/0.
* PFN = PERMANENT FILE NAME.
* N = 1 IF FILE NOT ON DISK.
* EC = ERROR CODE FROM PFC.
* D = 1 IF DIRECT ACCESS FILE.
* FOR *SPD* CALL -
* 42/USERNAME,18/0
*
* EXIT FILE NAME SET IN OUTPUT LINE.
* IF FILE ON ALTERNATE STORAGE, FILE NAME IN ( ).
* IF ERROR CODE PRESENT, LEADING ASTERISK ON FILE NAME.
*
* USES X - 0, 1, 2, 3, 4, 5, 6, 7.
* A - 1, 2, 3, 4, 5, 6.
* B - 2.
*
* CALLS AEN, ALN, MTP, SFN.
*
* MACROS WRITEC.
GSL SUBR ENTRY/EXIT
SA5 GSLA CHECK LINE FILE COUNT
SX2 7
IX2 X2-X5
NG X2,GSL1 IF FIRST ENTRY
NZ X2,GSL2 IF NOT END OF LINE
WRITEC O,LBUF
GSL1 SB2 B1 ADVANCE LINE NUMBER BY 1
RJ ALN
SX5 B0 RESET LINE COUNT
GSL2 RJ AEN ADVANCE ENTRY NUMBER
SA3 CBUF PICK ENTRY
SA4 MODE
SB2 B0 SET DEFAULT IMAGE PATTERN
MX0 42
BX1 X0*X3
MX6 -3
SX4 X4-MOSP
LX3 0-6
BX6 -X6*X3 EXTRACT ERROR CODE
LX3 59-9-0+6
ZR X4,GSL4 IF SHORT PERMIT MODE CATLIST
ZR X6,GSL3 IF NO ERROR CODE
SB2 B2+1 SET IMAGE PATTERN FOR ERROR
GSL3 PL X3,GSL4 IF FILE ON DISK
SB2 B2+2 SET IMAGE PATTERNS FOR ALTERNATE STORAGE
GSL4 SA2 GSLB+B2 LOAD IMAGE
SA4 GSLC =01010101010101010101B
SX6 B1
IX3 X1-X6 EXTEND RIGHTMOST BIT
BX3 X3-X1 REMOVE ALL UNCHANGED BITS
IX3 X3+X6 SET RIGHTMOST BIT OF FILE NAME
BX7 X3
LX7 -6
IX3 X3-X7 SHIFT 1 AND EXTEND 6 (RIGHTMOST BIT)
BX3 X4*X3 ISOLATE SINGLE BIT
LX3 -6 POSITION FOR CHARACTER TO RIGHT
BX3 X3+X6 ADD IN BOTTOM CHARACTER OF WORD
BX7 X3
LX3 6
IX3 X3-X7 PREPARE MASK OF SURROUNDING CHARACTERS
BX2 X3*X2 ISOLATE SURROUNDING CHARACTERS
LX6 6
IX6 X3-X6 EXTEND MASK OF REMAINING CHARACTERS
BX6 -X3*X6 FINALIZE MASK
SA4 GSLD
BX4 X6*X4 EXTRACT REQUIRED BLANKS
BX6 X1+X2 MERGE CHARACTERS INTO FINAL ASSEMBLY
BX6 X6+X4
LX6 48
SA6 LBUF+X5
SX6 X5+B1 ADVANCE LINE FILE COUNT
SA6 GSLA
EQ GSLX EXIT
GSLA CON 8 LINE POSITION
GSLB BSS 0 IMAGE MAPS
DATA 10H NO ERROR, FILE ON DISK
DATA 10H * ERROR, FILE ON DISK
DATA 10H)))))))) ( NO ERROR, FILE ON ALTERNATE STORAGE
DATA 10H)))))))) * ERROR, FILE ON ALTERNATE STORAGE
GSLC DATA 01010101010101010101B
GSLD EQU GSLB =10H
HDR SPACE 4,15
** HDR - HEADERS FOR LISTING CATALOGS AND PERMIT BUFFERS.
*
* ENTRY (MODE) = MODE OF LISTING.
*
* EXIT HEADER LINE PLACED IN OUTPUT BUFFER.
*
* USES X - 0, 1, 6.
* A - 1, 6.
*
* MACROS WRITEC.
HDR SUBR ENTRY/EXIT
SA1 HDRI
SX0 B0+ INITIALIZE LINE COUNT
ZR X1,HDR0 IF NO FILE NAMES SPECIFIED
SX0 B1+B1 INCREMENT LINE COUNT
WRITEC O,X1 PRINT FILE NAME SUBHEADER
WRITEC O,BLK
HDR0 SA1 MODE INDEX INTO HEADER POINTER TABLE
SA1 X1+HDRB
ZR X1,HDR2 IF NO HEADER MESSAGE DEFINED
BX6 X1
SA6 HDRA SET INDEX BASE OF HEADER MESSAGES FOR MODE
* LOOP PRINTING HEADER MESSAGE LINES.
HDR1 SA1 HDRA EXAMINE CURRENT MESSAGE POINTER
SA1 X1
ZR X1,HDR2 IF END OF HEADER MESSAGES
SX6 A1+B1 SET NEXT MESSAGE POINTER
SA6 HDRA
SX0 X0+B1 INCREMENT LINE COUNT
WRITEC O,X1
EQ HDR1 CONTINUE LOOP
* COMPLETE HEADER PROCESSING.
HDR2 WRITEC O,BLK
SA1 LN INCREMENT LINE COUNT
IX6 X1+X0
SX1 B1
IX6 X6+X1
SA6 A1
EQ HDRX RETURN
* HEADER MESSAGE BASE POINTERS.
HDRA CON 0
HDRB CON 0,HDRD,HDRD,0,HDRF,HDRG,HDRH
* HEADER MESSAGE POINTERS.
HDRD CON /COMCFCE/CHDR1 FULL FILE LIST
CON /COMCFCE/CHDR2
CON /COMCFCE/CHDR3
CON /COMCFCE/CHDR4
CON 0
HDRF CON /COMCFCE/CHDR1 FULL ALTERNATE CATALOG
CON HDR42
CON HDR43
CON HDR44
CON 0
HDRG CON HDR51 SHORT PERMIT ENTRIES
CON 0
HDRH CON HDR61 FULL PERMIT ENTRIES
CON 0
HDRI CON 0 SUBHEADER IF FILE NAMES SPECIFIED
* CON HDR71 (SINGLE FILE NAME TEMPLATE SPECIFIED)
* CON HDR72 (MULTIPLE FILE NAMES SPECIFIED)
CON 0
* HEADERS.
HDR42 DATA C* COUNT PERM. SUBSYS DATE/TIME DA
,TE/TIME DATE/TIME*
HDR43 DATA C* PR BR AC RS*
HDR44 DATA 40C
HDR51 DATA C* USER NAMES*
HDR61 DATA C* USER NAME PERM. EXPIRES ACCESSES DATE
,TIME*
HDR71 CON 1H
CON 10HFILE NAME
CON 0
HDR72 CON 1H
DATA C*SELECTED FILES*
LCS SPACE 4,15
** LCS - LIST CATEGORY SET FOR FILE.
*
* ENTRY (CBUF) = CATALOG ENTRY.
*
* EXIT FILE-S CATEGORY SET IS SORTED AND LISTED.
*
* USES X - 0, 1, 2, 6, 7.
* A - 0, 1, 2, 6, 7.
* B - 2, 7.
*
* CALLS ALN, GNI, GSL, NIP.
*
* MACROS WRITEC, WRITEH.
LCS SUBR ENTRY/EXIT
SA1 CBUF+FCFC CATEGORY SET WORD
MX0 -32
BX1 -X0*X1
SB2 32 NUMBER OF CATEGORIES POSSIBLE
SA0 B0 INITIALIZE CATEGORY SET COUNTER
MX0 42
LX1 59-32
LCS1 SB2 B2-B1
NG B2,LCS2 IF DONE ANALYZING CATEGORY WORD
LX1 1
PL X1,LCS1 IF CATEGORY NOT VALIDATED
SA2 TACT+B2 SET CATEGORY MNEMONIC IN BUFFER
BX6 X0*X2
SA6 SBUF+A0
SA0 A0+B1
EQ LCS1 CHECK NEXT CATEGORY
LCS2 SX1 A0
ZR X1,LCSX IF NO ACCESS CATEGORY SET ENTRIES
SB7 SBUF SORT CATEGORY ENTRIES
RJ SST=
SX1 A0
SX6 A0
SA6 LCSA
RJ NIP PRESET *GNI*
WRITEH O,LCSB,LCSBL
WRITEC O,BLK
SB2 B1+B1
RJ ALN ADVANCE LINE NUMBER
SX7 8
SA7 GSLA
LCS3 SA1 LCSA
SX6 X1-1
SA6 A1
NG X6,LCS4 IF END OF ENTRIES
RJ GNI GET NEXT ENTRY
SA1 X1+SBUF GET ACTUAL ENTRY
BX6 X1
SA6 CBUF
RJ GSL GENERATE SHORT LIST
EQ LCS3 GET NEXT CATEGORY ENTRY
LCS4 WRITEC O,LBUF LAST LINE OF CATEGORY SET
WRITEC O,BLK
EQ LCSX RETURN
LCSA CON 0 NUMBER OF VALIDATED CATEGORY SETS
LCSB DATA C* FILE ACCESS CATEGORY SET*
LCSBL EQU *-LCSB
NIP SPACE 4,10
** NIP - NEXT INDEX PRESET (PRESET *GNI*).
*
* ENTRY (X1) = ENTRY COUNT.
*
* EXIT TEMPORARY CELLS PRESET FOR *GNI*.
*
* USES X - 1, 3, 6, 7.
* A - 6, 7.
NIP SUBR ENTRY/EXIT
MX6 0
SX3 7 LINE LENGTH
SA6 GNIA
SA6 GNIB
SA6 GNIE
NIP1 IX1 X1-X3 DIVIDE BY 7
SX6 X6+B1
PL X1,NIP1 IF NOT POSITION IN ROW
IX7 X3+X1
SA6 GNIC
SA7 GNID
EQ NIPX RETURN
PAS SPACE 4,15
** PAS - PRINT ACCUMULATED STATISTICS.
*
* ENTRY (FCID, FSID) = INDIRECT ACCESS DISK FILE COUNT, SIZE.
* (FCDD, FSDD) = DIRECT ACCESS DISK FILE COUNT, SIZE.
* (FCIA, FSIS) = IAPF ON ALTERNATE STORAGE COUNT, SIZE.
* (FCDA, FSDA) = DAPF ON ALTERNATE STORAGE COUNT, SIZE.
*
* USES X - 1, 2.
* A - 1, 2.
* B - 2, 3, 5.
*
* CALLS ALN, CDD, SNM.
*
* MACROS WRITEC.
PAS SUBR ENTRY/EXIT
SB2 5 ADVANCE LINE COUNT BY 5
RJ ALN
* PRINT STATISTICS FOR INDIRECT ACCESS FILES ON DISK.
SB5 PASA SET MESSAGE TEMPLATE
SA1 FCID NUMBER OF INDIRECT ACCESS FILES ON DISK
SB3 X1
ZR B3,PAS2 IF NO INDIRECT ACCESS FILES ON DISK
NE B3,B1,PAS1 IF MORE THAN ONE FILE
SB5 PASB USE ALTERNATE MESSAGE TEMPLATE
PAS1 RJ CDD CONVERT FILE COUNT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R#
RJ SNM SET FILE COUNT INTO MESSAGE
SA1 FSID TOTAL SIZE OF INDIRECT ACCESS FILES
RJ CDD CONVERT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R$
RJ SNM SET TOTAL FILE SIZE INTO MESSAGE
WRITEC O,B5
* PRINT STATISTICS FOR DIRECT ACCESS FILES ON DISK.
PAS2 SB5 PASC SET MESSAGE TEMPLATE
SA1 FCDD NUMBER OF DIRECT ACCESS FILES ON DISK
SB3 X1
ZR B3,PAS4 IF NO DIRECT ACCESS FILES ON DISK
NE B3,B1,PAS3 IF MORE THAN ONE FILE
SB5 PASD USE ALTERNATE MESSAGE TEMPLATE
PAS3 RJ CDD CONVERT FILE COUNT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R#
RJ SNM SET FILE COUNT INTO MESSAGE
SA1 FSDD TOTAL SIZE OF DIRECT ACCESS FILES
RJ CDD CONVERT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R$
RJ SNM SET TOTAL FILE SIZE INTO MESSAGE
WRITEC O,B5
* PRINT STATISTICS FOR IAPF-S ON ALTERNATE STORAGE.
PAS4 SB5 PASE SET MESSAGE TEMPLATE
SA1 FCIA NUMBER OF IAPF-S ON ALTERNATE STORAGE
SB3 X1
ZR B3,PAS6 IF NO IAPF-S ON ALTERNATE STORAGE
NE B3,B1,PAS5 IF MORE THAN ONE FILE
SB5 PASF USE ALTERNATE MESSAGE TEMPLATE
PAS5 RJ CDD CONVERT FILE COUNT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R#
RJ SNM SET FILE COUNT INTO MESSAGE
SA1 FSIA TOTAL SIZE OF IAPF-S ON ALTERNATE STORAGE
RJ CDD CONVERT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R$
RJ SNM SET TOTAL FILE SIZE INTO MESSAGE
WRITEC O,B5
* PRINT STATISTICS FOR DAPF-S ON ALTERNATE STORAGE.
PAS6 SB5 PASG SET MESSAGE TEMPLATE
SA1 FCDA NUMBER OF DAPF-S ON ALTERNATE STORAGE
SB3 X1
ZR B3,PAS8 IF NO DAPF-S ON ALTERNATE STORAGE
NE B3,B1,PAS7 IF MORE THAN ONE FILE
SB5 PASH USE ALTERNATE MESSAGE TEMPLATE
PAS7 RJ CDD CONVERT FILE COUNT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R#
RJ SNM SET FILE COUNT INTO MESSAGE
SA1 FSDA TOTAL SIZE OF DAPF-S ON ALTERNATE STORAGE
RJ CDD CONVERT TO DECIMAL
MX1 -54 CLEAR LEADING BLANK
BX1 -X1*X6
LX1 6 LEFT JUSTIFY NINE-DIGIT INTEGER
SB2 1R$
RJ SNM SET TOTAL FILE SIZE INTO MESSAGE
WRITEC O,B5
PAS8 WRITEC O,BLK
EQ PASX RETURN
PASA DATA C* ######### INDIRECT ACCESS FILES ON DISK. TOTAL PRUS
, = $$$$$$$$$.*
PASB DATA C* ######### INDIRECT ACCESS FILE ON DISK. TOTAL PRUS
, = $$$$$$$$$.*
PASC DATA C* ######### DIRECT ACCESS FILES ON DISK. TOTAL PRUS
, = $$$$$$$$$.*
PASD DATA C* ######### DIRECT ACCESS FILE ON DISK. TOTAL PRUS
, = $$$$$$$$$.*
PASE DATA C* ######### INDIRECTS ON ALTERNATE STORAGE. TOTAL PRUS
, = $$$$$$$$$.*
PASF DATA C* ######### INDIRECT ON ALTERNATE STORAGE. TOTAL PRUS
, = $$$$$$$$$.*
PASG DATA C* ######### DIRECTS ON ALTERNATE STORAGE. TOTAL PRUS
, = $$$$$$$$$.*
PASH DATA C* ######### DIRECT ON ALTERNATE STORAGE. TOTAL PRUS
, = $$$$$$$$$.*
PTP SPACE 4,10
** PTP - PRINT TITLE PAGE.
*
* ENTRY (PG) = PAGE NUMBER.
*
* EXIT TITLE PAGE PRINTED.
* (LN) RESET TO 2.
*
* CALLS CDD.
PTP SUBR ENTRY/EXIT
SA1 PG ADVANCE TO NEXT PAGE
SX1 X1+B1
BX6 X1
SA6 A1
RJ CDD CONVERT TO DECIMAL
MX0 48
BX6 -X0*X6
SA1 PAGE
BX1 X0*X1
BX6 X1+X6
SA6 PAGE
DATE DATE
CLOCK TIME
SB2 6 FOR TELEX ORIGIN JOBS
SA1 DT
SX0 B0+ INITIALIZE LINE COUNTER
ZR X1,PTP1 IF TERMINAL FILE
SA1 PD
ZR X1,PTP0 IF *PD* ALREADY PROCESSED
WRITEC O,A1
SX6 B0+
SA6 PD INDICATE *PD* PROCESSED
PTP0 WRITEH O,PTPA,B1
SB2 7 FOR NON-TELEX ORIGIN JOBS
SX0 X0+B1 COUNT PAGE EJECT
PTP1 WRITEH O,PTPB,B2+ WRITE TITLE LINE
SX0 X0+B1 COUNT TITLE LINE
SA1 PTPC WRITE SUB TITLE
WRITEC O,X1
SX0 X0+B1 COUNT SUBTITLE LINE
SA1 LN
IX6 X1+X0 RESET LINE NUMBER
SA6 LN
EQ PTPX EXIT
PTPA CON 1H1
PTPB DATA 30H CATALOG OF
PKNM CON 10H
DATE CON 0
TIME CON 0
PAGE DATA 8L PAGE
PTPC CON BLK SUBTITLE FLAG
PTPD CON 1H
CON 10HFILE NAME
FILE CON 0
PTPE CON 1H
CON 10HALTERNATE
CON 10HCATALOG
AUSER CON 0
RQS SPACE 4,15
** RQS - REQUEST STORAGE.
*
* ENTRY (X1) = CURRENT BUFFER SIZE.
*
* EXIT (X1) = NEGATIVE IF NO MORE STORAGE AVAILABLE.
* (CFL) = NEW CURRENT FL.
* (CBS) = NEW CURRENT BUFFER SIZE.
*
* USES X - 1, 3, 6.
* A - 1, 3, 6.
*
* MACROS MEMORY.
RQS SUBR ENTRY/EXIT
SA3 MBS GET MAXIMUM BUFFER SIZE
SX6 X1+FLIN ADD POSSIBLE INCREMENT
IX1 X3-X6
NG X1,RQSX IF NO MORE SPACE
SA3 CFL SET POSSIBLE NEW FL
SX6 X3+FLIN
SA6 A3
LX6 30
SA6 RQSA
MEMORY CM,RQSA,R,,NA
SA3 RQSA
SA1 CFL
AX3 30
IX1 X3-X1
NG X1,RQSX IF NO MORE ALLOCATED
SA1 CBS UPDATE CURRENT SORT BUFFER SIZE
SX6 X1+FLIN
SA6 A1
EQ RQSX RETURN
RQSA CON 0 FL CONTROL WORD
SNP SPACE 4,15
** SNP - SET NEXT PAGE.
*
* ENTRY (X1) = TOTAL NUMBER OF FILES.
*
* EXIT (X1) = 0 IF NO MORE FILES TO PRINT.
* (BO) = BUFFER OFFSET FOR THIS PAGE.
* (BL) = BUFFER LENGTH FOR THIS PAGE.
*
* USES X - 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 2.
*
* CALLS ALN, NIP.
*
SNP4 MX6 0
SA6 A2 CLEAR BUFFER OFFSET
MX1 0 EXIT WITH NO MORE FILES
SA6 A6-B1
SNP5 SX7 8 RESET *GSL* LIST ROUTINE
SA7 GSLA
SNP SUBR ENTRY/EXIT
SA2 BO+1
IX3 X2-X1
BX6 X2
ZR X3,SNP4 IF NO MORE FILES TO LIST
BX7 X1
SA6 A2-B1 SET UP NEW OFFSET
SA7 SNPA SAVE (X1)
SNP1 SA3 LN
SX6 7 LINE LENGTH
SA4 LL
IX7 X4-X3
NG X7,SNP3 IF END OF PAGE
ZR X7,SNP3 IF END OF PAGE
IX6 X6*X7
SA2 BO+1
IX7 X6+X2 FORM NEW OFFSET
SA1 SNPA
IX4 X1-X7
PL X4,SNP2 IF MORE THAN ONE PAGE
IX7 X7+X4
IX6 X6+X4
SNP2 SA6 BL COUNT OF FILE NAMES ON PAGE
SA7 BO+1 OFFSET FOR NEXT PASS
BX1 X6
RJ NIP PRESET *GNI*
SA1 BL EXIT WITH FILE COUNT
EQ SNP5 RETURN
SNP3 SB2 B1
RJ ALN ADVANCE LINE
EQ SNP1 RETURN TO MAIN LINE
SNPA CON 0 TEMPORARY STORAGE (TOTAL NUMBER OF FILES)
SPACE 4,10
** COMMON DECKS.
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCEDT
*CALL COMCLFM
*CALL COMCPFM
*CALL COMCRDW
*CALL COMCSCB
*CALL COMCSFN
*CALL COMCSNM
*CALL COMCSST
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTW
*CALL COMCZTB
LIST X,F
*CALL COMCFCE
LIST *
SPACE 4,10
** EQUIVALENCES.
FCELL EQU /COMCFCE/FCELL OUTPUT BUFFER LINE LENGTH
FCELA EQU /COMCFCE/FCELA OUTPUT BUFFER THIRD LINE LENGTH
FCELB EQU /COMCFCE/FCELB OUTPUT BUFFER FOURTH LINE LENGTH
SPACE 4
** BUFFERS.
USE LITERALS
LBUF EQU * OUTPUT LINE BUFFER
CBUF EQU LBUF+/COMCFCE/CHDRN*FCELL CATALOG READ BUFFER
IBUF EQU CBUF+NWCE INPUT BUFFER
OBUF EQU IBUF+IBFL OUTPUT BUFFER
SBUF EQU OBUF+OBFL CATALOG SORT BUFFER
RFL= EQU SBUF+SBFL DEFAULT FL
PRS TITLE PRESET.
** PRS - PRESET ROUTINE.
*
* EXIT TO MAIN LOOP(CTL)
* FETS AND BUFFERS SET UP AND COMMAND
* ARGUMENTS PROCESSED.
* (MODE) = LIST OPTION.
* 0 = SHORT FILE LIST.
* 1 = FULL FILE LIST.
* 2 = FILE LIST AND CATEGORY SET.
* 3 = SHORT ALTERNATE CATALOG LIST.
* 4 = FULL ALTERNATE CATALOG LIST.
* 5 = SHORT PERMIT DATA LIST.
* 6 = FULL PERMIT DATA LIST.
* B1 = 1.
* DT = 0 IF OUTPUT TO TERMINAL FILE.
* JT = 0 IF TERMINAL ORIGIN JOB.
* TITLE LINES PRESET
* PFM CALL FET PRESET.
* (CTLA) SET IF SELECTED ENTRY DESIRED.
CATLIST BSS 0 ENTRY POINT
PRS BSS 0
SB1 1
GETSSM SSM GET SYSTEM SECURITY MODE
SA4 ACTR
ZR X4,PRS15 IF NO ARGUMENTS
SB4 X4 SET ARGUMENT COUNT
SA4 ARGR GET FIRST ARGUMENT
SB5 TARG SET ARGUMENT TABLE ADDRESS
RJ ARG PROCESS ARGUMENTS
ZR X1,PRS2 IF NO ARGUMENT ERROR
PRS1 MESSAGE (=C* INCORRECT PARAMETER.*)
ABORT
* PROCESS FILE NAME SELECTION PARAMETERS.
PRS2 SA1 EFNM
SX7 HDR72 SUBHEADER FOR MULTIPLE FILE NAME TEMPLATES
NZ X1,PRS2.1 IF *EF* SPECIFIED
SA1 FLNM+1
NZ X1,PRS2.1 IF MORE THAN ONE FILE SPECIFIED FOR *FN*
SA1 FLNM
SA3 =7L*******
BX6 X1-X3
ZR X6,PRS3 IF *FN* NOT SPECIFIED
BX7 X3-X1 CLEAR * FROM NAME
SA3 PRSA =37373737373737373737B
BX6 X3*X7
BX7 -X3*X7
IX6 X6+X3
BX6 X6+X7
BX7 -X3*X6
BX6 X7
LX7 -5
IX7 X6-X7
BX7 X6+X7
SA3 =777777B
IX4 X7+X3
MX0 42
BX6 X0*X1
ZR X4,PRS2.2 IF NO ASTERISKS IN FILE NAME
SA6 HDR71+2 SET FILE NAME IN HEADER
SX7 HDR71 SUBHEADER FOR SINGLE FILE NAME TEMPLATE
PRS2.1 SA7 HDRI SET SUBHEADER ADDRESS
SX6 CTLE SET ADDRESS FOR *NO FILES FOUND* MESSAGE
SA6 CTLB
EQ PRS3 SET UP OUTPUT FET
PRS2.2 SA6 FILENAM SET FILE NAME FOR PERMANENT FILE FET
* SET UP OUTPUT FET.
PRS3 SA1 O SET STATUS IN OUTPUT FET
MX0 42
SX6 B1
BX2 X0*X1
ZR X2,PRS1 IF NO FILE NAME
IX6 X6+X2
SA6 A1
SX2 A1 CHECK FOR TERMINAL FILE
RJ STF
SA6 DT SET DEVICE TYPE FLAG (0 FOR TYPE *TT*)
SA1 JOPR SET JOB ORIGIN
MX0 -12
LX1 36
BX1 -X0*X1
SX6 X1-TXOT
SA6 JT
* PROCESS FILE RESIDENCE PARAMETER
SA1 RS GET FILE RESIDENCE SELECTION PARAM
NZ X1,PRS3.1 IF FILE RESIDENCE SELECTION NOT 0
MX6 -3 SET PARAMETER SELECTION FOR 0
BX6 -X6
EQ PRS3.5 RESIDENCE SELECTION MASK SET
PRS3.1 MX0 -6
BX6 X6-X6 INITIALIZE RESIDENCE SELECTION MASK
PRS3.2 LX1 6 GET NEXT RESIDENCE SELECTION PARAM
BX2 -X0*X1
ZR X2,PRS3.5 IF END OF SELECTIONS
SA3 PRSE GET VALID RESIDENCE SELECTION OPTIONS
MX7 1
PRS3.3 LX3 6 GET NEXT RESIDENCE SELECTION OPTION
BX4 -X0*X3
BX5 X2-X4 COMPARE
ZR X4,PRS3.4 IF END OF VALID OPTIONS
LX7 1
NZ X5,PRS3.3 IF NO MATCH
BX6 X6+X7 ADD VALID SELECTION TO MASK
EQ PRS3.2 GET NEXT SELECTION
PRS3.4 MESSAGE (=C* ERROR IN FILE RESIDENCE SELECTION.*)
ABORT
PRS3.5 SA6 RSM SAVE RESIDENCE SELECTION MASK
* PROCESS FILE TYPE PARAMETER.
SA1 TY GET FILE TYPE SELECTION PARAM
BX6 X6-X6 INITIALIZE FILE TYPE SELECTION
ZR X1,PRS3.9 IF NO FILE TYPE SELECTION
MX0 -6
PRS3.6 LX1 6 GET NEXT FILE TYPE SELECTION PARAM
BX2 -X0*X1
ZR X2,PRS3.9 IF END OF SELECTIONS
SA3 PRSF GET VALID FILE TYPE OPTIONS
BX7 X7-X7
PRS3.7 LX3 6 GET NEXT FILE TYPE OPTION
BX4 -X0*X3
BX5 X2-X4 COMPARE
ZR X4,PRS3.8 IF END OF VALID OPTIONS
SX7 X7+B1
NZ X5,PRS3.7 IF NO MATCH
BX6 X6+X7 ADD VALID SELECTION TO MASK
EQ PRS3.6 GET NEXT SELECTION
PRS3.8 MESSAGE (=C* ERROR IN FILE TYPE SELECTION.*)
ABORT
PRS3.9 SA6 TYM SAVE FILE TYPE SELECTION MASK
* PROCESS LIST OPTION.
MX0 59 SET OPTION
SA2 LO
SA1 LOPT
SB2 B0
SB3 LOPTL
SX5 B0
PRS4 BX4 -X0*X1 PICK SHORT LIST FLAG
BX1 X0*X1
IX6 X1-X2
ZR X6,PRS5 IF OPTION FOUND
SA1 A1+B1
SB2 B2+B1
LE B2,B3,PRS4 IF NOT END OF TABLE
MESSAGE (=C* INCORRECT LIST OPTION.*)
ABORT
* CHECK FOR PARAMETER CONFLICT.
PRS5 SA1 USERNUM
SA2 FILENAM
BX3 X2 SET SELECTED ENTRY FLAG
SB3 PMTL SET PROPER MODE
SX6 B0
SX7 PTPE SUBTITLE FOR ALTERNATE USER
LT B2,B3,PRS6 IF NOT PERMIT DATA REQUEST
SX5 B1 SET PERMIT LIST FLAG
SX7 PTPD SUBTITLE FOR SPECIFIED FILE NAME
BX3 X1 SET SELECTED ENTRY FLAG
NZ X2,PRS7 IF FILE NAME SPECIFIED
PRS5.1 MESSAGE (=C* FILE NAME MISSING.*)
ABORT
PRS6 SB3 B2-MOLC
NZ B3,PRS6.1 IF *LO=X* OPTION NOT SPECIFIED
SA3 HDRI
NZ X1,PRS1 IF USER NAME SPECIFIED
NZ X3,PRS1 IF MULTIPLE FILE NAMES SPECIFIED
ZR X2,PRS5.1 IF FILE NAME NOT SPECIFIED
PRS6.1 ZR X1,PRS8 IF USER NAME NOT SPECIFIED
SX6 ALTC SET ALTERNATE CATALOG MODE
PRS7 SA7 PTPC SET SUBTITLE FLAG
PRS8 SX6 X6+B2
SA6 MODE
MX0 42
ZR X4,PRS9 IF NOT SHORT FILE LIST
BX6 X0*X3 SET SELECTIVE ENTRY FLAG
SA6 CTLA
* SET *PFM* FET PARAMETERS.
PRS9 BX6 X0*X2
SA6 FILE SET FILE NAME IN SUBTITLE LINE
BX6 X6+X5
SA6 I+CFPN
BX7 X0*X1 SET USER NAME
SA7 I+CFOU
SA7 AUSER
ZR X5,PRS10 IF NOT PERMIT DATA
SX6 CTLD SET PERMIT MESSAGE ADDRESS
SA6 CTLB
* SET USER NAME OR USER INDEX IN TITLE LINE.
PRS10 GETPFP PRSB
SA1 PRSB+2 SET USER NAME IN TITLE LINE
BX6 X0*X1
SA6 USER
NZ X6,PRS10.1 IF USER NAME FOUND
RJ COD SET USER INDEX IN TITLE LINE
MX7 42
BX4 X7*X4
SX6 3RUI/
BX6 X4+X6
LX6 -18
PRS10.1 BX1 X6 SPACE FILL NAME
RJ SFN
SB3 PRSC SET CHARACTERS IN BUFFER
SB7 PTPB
RJ SCB
* SET PACKNAME OR FAMILY NAME IN TITLE LINE.
SA1 PACK
ZR X1,PRS11 IF NO PACKNAME SPECIFIED
BX6 X1
SA6 I+CFPK SET PACKNAME IN FET
SX7 1R0
LX7 54
BX7 X6-X7
ZR X7,PRS11.1 IF *PN=0* SPECIFIED
PRS10.2 SX4 3RPN/
EQ PRS12 SET PACK NAME IN TITLE LINE
PRS11 SA1 PRSB+1
ZR X1,PRS11.1 IF NO PACKNAME SET IN CPA
BX6 X0*X1
EQ PRS10.2 SET PACKNAME IN TITLE LINE
PRS11.1 SA1 PRSB SET FAMILY NAME IN TITLE LINE
SX4 3RFM/
BX6 X1
PRS12 BX1 X6+X4 MERGE FAMILY/PACK NAME WITH DESIGNATOR
LX1 -18
RJ SFN SPACE FILL NAME
SA6 PKNM
* PROCESS *NO ABORT* AND *WAIT BUSY* PARAMETERS.
SA1 NABT CHECK NO ABORT OPTION
SA2 WBSY
IX1 X1+X2
ZR X1,PRS13 IF NEITHER *NA* NOR *WB* SELECTED
SX2 X1-2
ZR X2,PRS1 IF BOTH *NA* AND *WB* SPECIFIED
SA1 I+1 SET ERROR PROCESSING BIT
SX6 B1
LX6 44
BX6 X1+X6
SA6 A1
* PROCESS RESIDENCE.
PRS13 SA1 RES CHECK RESIDENCE OPTION
ZR X1,PRS14 IF RESIDENCE NOT SET
MX0 12
BX6 X0*X1 SET DEVICE TYPE IN FET+1
SA2 I+1
BX5 -X0*X2
BX6 X5+X6
SA6 A2
LX1 12
BX5 X0*X1
ZR X5,PRS14 IF NO UNIT NUMBER
SB7 B1
RJ DXB CONVERT TO OCTAL
NZ X4,PRS1 IF ERROR
SA2 I+CFPK SET UNIT COUNT IN FET+CFPK
MX0 -12
BX5 X0*X2
BX6 X6+X5
SA6 A2
* PROCESS DEVICE NUMBER.
PRS14 SA5 DN CHECK DEVICE NUMBER
ZR X5,PRS15 IF NOT SET
SB7 B0
RJ DXB
SX2 X6-100B
NZ X4,PRS1 IF ERROR
PL X2,PRS1 IF DEVICE NUMBER OUT OF RANGE
SA5 I+CFOU
BX1 X6
LX6 12
BX6 X6+X5
SA6 A5
RJ COD SET DEVICE NUMBER IN TITLE LINE
MX0 12
BX4 X0*X4
SX6 3RDN/
BX1 X6+X4
LX1 -18
RJ SFN
SB3 PRSD
SB7 PTPB
RJ SCB
PRS15 RJ IPP INITIALIZE PAGE PARAMETERS
JP CTL
PRSA DATA 37373737373737373737B
PRSB BSSZ 3 *GETPFP* PARAMETER BLOCK
PRSC CFORM 13,9 FIELD IN TITLE FOR USER NAME/USER INDEX
PRSD CFORM 24,5 FIELD IN TITLE FOR DEVICE NUMBER
PRSE CON 3LCTD VALID RESIDENCE SELECTION OPTIONS
PRSF CON 3LIDA VALID FILE TYPE SELECTION OPTIONS
LOPT SPACE 4,10
** LIST OPTIONS.
* BIT 0 SET IF SHORT LIST OPTION.
*
* ANY CHANGES MADE TO THIS TABLE WILL AFFECT THE
* DOCUMENTATION OF MODE VALUES IN THE *PRS* HEADER,
* TABLE *TLOT* IN THE MAIN ROUTINE, AND THE PROCESSING
* FOR HEADERS IN *HDR*.
LOPT BSS 0 LIST OPTIONS
LOC 0 CATALOG DATA LISTS
MOSF VFD 59/0,1/1 SHORT FILE LIST
MOFL CON 1LF FULL FILE LIST
MOLC CON 1LX LIST FILE AND CATEGORY SET
ALTC EQU * ALTERNATE CATALOG DATA LISTS
MOSA CON 0 SHORT ALTERNATE FILE LIST
MOFA CON 0 LONG ALTERNATE FILE LIST
PMTL EQU * PERMIT DATA LISTS
MOSP VFD 6/0LP,54/1 SHORT PERMIT LIST
MOFP CON 0LFP FULL PERMIT LIST
LOPTL EQU * TABLE LENGTH
LOC *O
* ARGUMENT TABLE.
TARG BSS 0
LO ARG =0,LO
UN ARG =0,USERNUM,400B
EF ARG EFNM,EFNM,200B
FN ARG FLNM,FLNM,200B
PN ARG =0,PACK,400B
L ARG =0LOUTPUT,O,400B
R ARG =0,RES
NA ARG -NZ,NABT
RS ARG =0,RS
WB ARG -NZ,WBSY
DN ARG =0,DN,400B
TY ARG =0,TY
ARG
IPP SPACE 4,15
** IPP - INITIALIZE PAGE PARAMETERS.
*
* ENTRY NONE.
*
* EXIT JOB DEFAULT PAGE PARAMETERS SET.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6.
* B - NONE.
*
* MACROS GETPP, SETSLM.
IPP1 SETSLM IPPC GET CURRENT SCREEN DEFINITION
SA1 IPPC
MX0 -6
BX2 -X0*X1 ISOLATE ORDINAL
LX1 59-6
SX6 LMDL ASSUME LINE MODE
PL X1,IPP3 IF LINE MODE
SA2 IPPB+X2 COMPUTE TABLE OFFSET BY ORDINAL
SX6 X2 GET LINE LIMIT
IPP3 SA6 LL INITIALIZE LINE LIMIT
IPP SUBR ENTRY/EXIT
SA1 DT
ZR X1,IPP1 IF TTY OUTPUT FILE
GETPP IPPA,LL,PD GET PAGE PARAMETERS
SA1 LL ADJUST LINE LIMIT
SX6 X1-1
EQ IPP3 RETURN
IPPA BSSZ 2 *GETPP* REPLY BUFFER
* SCREEN SIZE DEFINITIONS.
*
* THIS TABLE DEFINES THE NUMBER OF LINES TO OUTPUT TO
* FILL A SCREEN, BASED ON THE SCREEN TYPE. THIS IS
* USED IN TERMINAL MODE TO CONTROL OUTPUT OF THE SHORT
* SORTED LIST, SUCH THAT FILES WILL APPEAR IN
* ALPHABETICAL ORDER ON A FULL SCREEN.
*
*T 60/LC
*
* WHERE LC = TERMINAL MODE SCREEN LINE COUNT.
*
* NOTE : IF MORE RESIDENT TERMINAL TYPES ARE ADDED
* TO *COMCGTO*, MORE ENTRIES SHOULD BE ADDED TO THIS
* TABLE.
*
IPPB BSS 0
VFD 60/LMDL NO SCREEN DEFINED
VFD 60/SMDL USER DEFINED
VFD 60/SMDL+6 RESIDENT *721* DEFINED
CON 0 END OF TABLE
IPPC CON 0 SETSLM RESPONSE WORD
SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCARG
*CALL COMCSTF
*CALL COMCVLC
SPACE 4
END