IDENT DFTERM1,OVLA,DFTERM,01,00
ABS
SST
SYSCOM B1
*COMMENT DFTERM - DAYFILE TERMINATION PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE DFTERM - DAYFILE TERMINATION PROCESSOR.
SPACE 4
*** DFTERM - DAYFILE TERMINATION PROCESSOR.
* A. J. BEEKMAN. 75/03/07.
* R. J. THIELEN. 75/03/07.
SPACE 4
*** *DFTERM* IS A UTILITY PROGRAM THAT TERMINATES INACTIVE OR
* ACTIVE DAYFILES AND MAKES THEM PERMANENT ON THE DEVICE ON
* WHICH THEY CURRENTLY RESIDE AND/OR PROVIDES A LIST OF ALL
* PERMANENT DAYFILES WITH INFORMATION RELATIVE TO EACH.
SPACE 4
*** *DFTERM* MAY BE CALLED FROM THE CONSOLE BY THE QUEUED FILE
* SUPERVISOR PROGRAM (X.QFSP.) OR BY CONTROL CARD FROM SYSTEM
* ORIGIN. *DFTERM* WILL ALSO BE CALLED BY A CONTROL CARD CALL
* TO *DFLIST*. THE CONTROL CARD FORMATS ARE -
* DFLIST.
* DFTERM(P1=A1,P2=A2,...,PN=AN,PO=N)
* WHERE *PO=N* IS A PARAMETER THAT DISALLOWS *K* DISPLAY INPUT,
* AND P1 - PN ARE ANY OF THE FOLLOWING VALID PARAMETERS -
*
* FT = FILE TYPE TO TERMINATE (DEFAULT IS DAYFILE).
* DAYFILE = SYSTEM DAYFILE.
* ACCOUNT = SYSTEM ACCOUNT FILE.
* ERRLOG = SYSTEM ERROR LOG FILE.
* MAINLOG = SYSTEM MAINTENANCE LOG FILE.
* I = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A CONTROL
* STATEMENT PARAMETER SPECIFYING WHAT FILE SHOULD
* BE READ FOR INPUT DIRECTIVES. THESE DIRECTIVES
* CONSIST OF ANY LEGAL K-DISPLAY INPUT OR COMMANDS.
* THESE DIRECTIVES WILL BE PROCESSED AFTER THE
* CONTROL STATEMENT DIRECTIVES BUT BEFORE ANY
* K-DISPLAY INPUT IS ACCEPTED.
* FM = FAMILY/PACK NAME (DEFAULT IS SYSTEM DAYFILE FAMILY/PACK).
* DN = DEVICE NUMBER (DEFAULT IS SYSTEM DAYFILE DEVICE).
* THE FM AND DN PARAMETERS ARE USED TO DEFINE ON WHICH
* DEVICE THE FILE RESIDES WHEN TERMINATING AN INACTIVE
* DAYFILE OR ON WHICH DEVICE THE NEW DAYFILE WILL RESIDE
* WHEN TERMINATING AN ACTIVE DAYFILE. IF FM OR DN IS
* NOT DEFINED WHEN TERMINATING AN ACTIVE DAYFILE, THE
* NEW DAYFILE WILL RESIDE ON THE SAME FAMILY/PACK AND
* SAME DEVICE AS THE OLD ONE.
* OP = FILE MODE OPTION (DEFAULT IS A).
* A = TERMINATE ACTIVE DAYFILE.
* I = TERMINATE INACTIVE DAYFILE.
* NM = NAME OF PERMANENT FILE (1 - 5 CHARACTERS).
* THE CHARACTERS SPECIFIED BY NM WILL BE ADDED TO ONE
* OF THE PREFIXES DF, AC, OR ER ACCORDING TO THE TYPE
* OF DAYFILE SPECIFIED. IF NM IS NOT SPECIFIED, OR THE
* SPECIFIED NAME IS A DUPLICATE NAME, *DFTERM* WILL
* AUTOMATICALLY ASSIGN A NAME FOR THE FILE. THE
* ASSIGNED NAME WILL CONSIST OF ONE OF THE PREVIOUSLY
* MENTIONED PREFIXES ACCORDING TO DAYFILE TYPE FOLLOWED
* BY A ONE CHARACTER SEQUENCE CHARACTER (A - 9) AND
* A FOUR DIGIT DATE (MONTH AND DAY) OF CREATION.
* *DFTERM* WILL SEARCH THE CATALOG FOR ALL PERMANENT
* DAYFILE NAMES OF THIS TYPE, THEN ASSIGN THE SEQUENCE
* CHARACTER ONE HIGHER THAN THE HIGHEST CHARACTER
* FOUND. IF THE HIGHEST CHARACTER (9) IS NOT AVAILABLE,
* *DFTERM* WILL SEARCH FOR THE LOWEST CHARACTER
* AVAILABLE AND ASSIGN THAT CHARACTER.
* L = FILE NAME TO RECEIVE OUTPUT (DEFAULT IS OUTPUT).
*
* THE *USRN* MICRO CAN BE DEFINED AS ANY SEVEN CHARACTER OR
* LESS USER NUMBER WHICH SHOULD BE PERMITTED IN WRITE MODE TO
* ALL TERMINATED DAYFILES. IF *USRN* IS NULL, NO PERMITS WILL
* BE ISSUED. IF USING A PRIVATE PACK, *USRN* MUST BE SPECIFIED
* AND MUST BE THE SAME USER NUMBER AS THAT OF THE PRIVATE PACK
* IF NEW ACTIVE DAYFILES ARE TO BE STARTED ON THE PACK.
* WITHOUT THIS CONDITION SATISFIED, CURRENT DAYFILES MAY BE
* TERMINATED ON THE PACK, BUT NO NEW DAYFILES ACTIVATED ON
* IT. THE TAG *PDUI* CAN BE SET TO THE USER INDEX ON WHICH
* PERMANENT DAYFILES SHOULD BE DEFINED (MUST BE GREATER THAN
* 377700B). *USRN* AND *PDUI* ARE FOUND IN *COMSIOQ*.
SPACE 4
** ENTRY CONDITIONS.
*
* DFTERM IS ENTERED VIA RETURN JUMP FROM *QFSP*.
*
* *TARA* = FWA OF THE PARAMETER TABLE.
* *TEQA* = FWA OF THE MASS STORAGE EQUIPMENT TABLE.
* *TSDA* = FWA OF THE SECONDARY DEVICE MASK TABLE.
SPACE 4
*** DAYFILE MESSAGES.
*
* THE FOLLOWING MESSAGES ARE ISSUED BOTH TO THE DAYFILE AND
* THE *K* DISPLAY. SPECIAL CASES FOR ISSUANCE OF THE MESSAGE
* ARE IN PARENTHESES.
*
*
* * AUTOMATIC NAME ASSIGNMENT IMPOSSIBLE.* = *DFTERM* WAS
* UNABLE TO DETERMINE AN AVAILABLE NAME FOR THE TERMINATED
* DAYFILE. ENTER A VALID NAME FOR THE FILE VIA THE *K*
* DISPLAY.
*
* * CANNOT CATLIST FAMILY/PACK - FAMPCK.* = *DFTERM* WAS UNABLE
* TO CATLIST THE FAMILY/PACK. CHECK THAT CATALOGS EXIST ON THE
* FAMILY/PACK AND RETRY OPERATION. (*DFLIST*).
*
* * DAYFILE BUSY.* = DAYFILE TO BE TERMINATED WAS FOUND TO
* BE ATTACHED TO ANOTHER JOB. RETRY OPERATION.
*
* * DAYFILE STATUS INDEFINITE.* = AN ERROR EXIT HAS OCCURED
* CAUSING *DFTERM* TO ABORT WHILE IN THE PROCESS OF
* TERMINATING A DAYFILE. THE STATUS OF THE DAYFILE IS
* QUESTIONABLE. CONTACT AN ANALYST IMMEDIATELY. (DAYFILE
* ONLY).
*
* * DFTERM ABORTED.* = AN ERROR EXIT HAS CAUSED *DFTERM*
* TO ABORT. CHECK THE DAYFILE FOR MORE INFORMATION.
* (DAYFILE ONLY).
*
* * ERROR - TERMINATED DAYFILE ON LOCAL FILE ZZZDAYF.* = AN
* ERROR OCCURRED WHILE DEFINING THE PERMANENT FILE FOR THE
* TERMINATED DAYFILE WHICH REMAINS ON LOCAL FILE *ZZZDAYF*.
* SEE DAYFILE FOR *PFM* ERROR MESSAGE.
*
* * INACTIVE DAYFILE NOT FOUND ON DEVICE.* = NO INACTIVE
* DAYFILE OF THE SPECIFIED TYPE WAS FOUND ON THE SPECIFIED
* DEVICE. ENTER THE CORRECT FAMILY AND DEVICE NUMBER VIA THE
* *K* DISPLAY.
*
* * INACTIVE DAYFILE ON DEVICE.* = INACTIVE DAYFILE ALREADY
* EXISTS ON DEVICE ON WHICH NEW ACTIVE DAYFILE IS TO BE
* CREATED. ENTER ANOTHER DEVICE VIA *K* DISPLAY PARAMETERS.
*
* * INVALID DEVICE SPECIFIED.* = THE DEVICE SPECIFIED BY THE
* CONTROL PARAMETERS IS NOT A VALID DAYFILE DEVICE.
*
* * NO ACTIVE DAYFILE FOUND.* = NO ACTIVE DAYFILE OF SPECIFIED
* TYPE FOUND IN *QFSP* EQUIPMENT TABLE. STOP THIS *DFTERM*
* RUN, START UP ANOTHER *DFTERM*, AND RETRY OPERATION. IF
* ERROR STILL EXISTS, CHECK SYSTEM FOR LOSS OF DAYFILE.
*
* * NO PERMANENT DAYFILES.* = NO PERMANENT DAYFILES EXIST ON
* ANY PERMANENT FILE DEVICE.
*
* * NOT ENOUGH MASS STORAGE.* = NOT ENOUGH MASS STORAGE
* EXISTS ON SPECIFIED DEVICE TO ENABLE CREATION OF NEW
* ACTIVE DAYFILE. ENTER NEW DEVICE VIA *K* DISPLAY.
*
* * PERMANENT DAYFILE DEFINED AS XXXXXXX.* = DAYFILE HAS BEEN
* TERMINATED AND DEFINED UNDER NAME XXXXXXX.
*
* * PRIVATE PACK/PERMIT UN CONFLICT.* = USER NUMBER OF
* PRIVATE PACK IS NOT THE SAME AS THE USER NUMBER SPECIFIED
* FOR PERMITS. NO NEW ACTIVE DAYFILES MAY BE STARTED ON THIS
* PRIVATE PACK IN THIS CASE.
*
* * REMOVABLE DEVICE/NO ACTIVE DAYFILES.* = DEVICE SPECIFIED
* BY *K* DISPLAY PARAMETERS IS A REMOVABLE DEVICE, AND OPTION
* IS TO TERMINATE AN ACTIVE DAYFILE. NO ACTIVE DAYFILES ARE
* ALLOWED TO RESIDE ON REMOVABLE DEVICES. ENTER NEW DEVICE
* VIA *K* DISPLAY PARAMETERS.
*
* * UNCORRECTABLE RMS ERROR.* = ERROR WAS DETECTED READING
* THE EOI. RETRY OPERATION.
*
* * WAITING FOR PF UTILITY.* = PF UTILITY IN OPERATION WHEN
* *PFM* CALLED. *DFTERM* WILL RETRY OPERATION UNTIL
* UTILITY IS COMPLETED. (CONTROL POINT AREA MESSAGE ONLY).
SPACE 4
*** *K* DISPLAY OPERATOR MESSAGES.
*
* *NO OUTPUT FILE EXISTING.* = NO OUTPUT FILE HAS BEEN
* CREATED PREVIOUS TO ENTERING *OUT* COMMAND.
*
* *OUTPUT FILE RELEASED.* = OUTPUT FILE RELEASED TO PRINTER.
*
* *PERMANENT DAYFILE LIST COMPLETE.* = PERMANENT DAYFILE LIST
* WRITTEN TO OUTPUT FOR *DFLIST* OR TO *K* DISPLAY BUFFER
* FOR *DFTERM*.
SPACE 4
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSPFM
*CALL COMSSFM
LIST X
*CALL COMSIOQ
*CALL COMSQFS
LIST -X
TITLE PROGRAM CONSTANTS.
* CONSTANTS.
CBUFL EQU 101B CATALOG BUFFER LENGTH
DBUFL EQU 1 DAYFILE BUFFER LENGTH
KBUFL EQU 300B *K* DISPLAY BUFFER LENGTH
OBUFL EQU 1001B OUTPUT BUFFER LENGTH
PDCBL EQU MSMX+2 PERMANENT DAYFILE CONTROL BUFFER LENGTH
PDLBL EQU 7 PERMANENT DAYFILE LIST LINE BUFFER LENGTH
DSPBL EQU 7 *DSP* PARAMETER BLOCK LENGTH
PPOS EQU TPPA+PPLN PAGE POSITION (LINE NUMBER)
PDFE EQU TPPA+PPPD PRINT DENSITY FORMAT EFFECTOR
KDLC EQU KMLL-6 *K* DISPLAY LINE COUNT
FRDC EQU 20B *DSP* DISPOSITION CODE FLAG
TITLE RESERVED LOCATIONS AND FETS.
* RESERVED LOCATIONS.
ORG OVLA
DNUM CON 0 DAYFILE NUMBER
PNUM CON 0 PAGE NUMBER
LIST CON 0 RECORD COUNT ON OUTPUT
ANAM CON 0 AUTOMATICALLY ASSIGNED DAYFILE NAME
SNAM CON 0 SPECIFIED DAYFILE NAME
FMPC CON 0 FAMILY/PACK NAME OF TERMINATION DEVICE
APIN CON 0 AUXILIARY PACK INFORMATION
CFAM CON 0 CURRENT USER FAMILY NAME
CPCK CON 0 CURRENT USER PACK NAME
DFSF CON 0 DAYFILE STATUS FLAG
SPACE 4
* FETS.
C BSS 0 CATALOG READ FILE
CATALOG FILEB CBUF,CBUFL,EPR,(FET=15)
D BSS 0 DAYFILE TERMINATION FILE
ZZZDAYF FILEB DBUF,DBUFL,EPR,(FET=20B)
O BSS 0 OUTPUT FILE
OUTPUT FILEB OBUF,OBUFL,(FET=7)
DFTERM TITLE MAIN ROUTINE.
** DFTERM - MAIN ROUTINE.
*
* ENTRY PARAMETER TABLE FWA - *TARA*.
* MASS STORAGE TABLE FWA - *TEQA*.
* SECONDARY DEVICE MASK TABLE FWA - *TSDA*.
*
* EXIT (X5) = *K* DISPLAY MESSAGE ADDRESS.
* (X2) = *K* DISPLAY BUFFER ADDRESS.
DFTERM SUBR ENTRY/EXIT
SB1 1
MEMORY CM,,R,BUFFL
SX6 MPER SET *PFM* ERROR RETURN ADDRESS
SA6 D+10
SA1 TARA+ARFC CLEAR FORCE *K* DISPLAY FLAG
MX0 -1
LX0 55-0
BX6 X1*X0
SA6 A1
* INITIALIZE FAMILY AND PACK NAMES.
SX6 B1 CLEAR FAMILY/PACK NAME
LX6 18
SA6 SFDA+1
BX7 X7-X7 CLEAR USER INDEX
SA7 A6+B1
RJ GCF GET CURRENT FAMILY AND PACK
* SET PROCESSOR ADDRESS.
SA2 TARA+ARFC SET FUNCTION PROCESSOR ADDRESS
SA3 TFCN+X2
SB7 X3
SX2 X2
ZR X2,DFT2 IF *GO* COMMAND
* SET OUTPUT FILE NAME.
RECALL O
SA1 O GET CURRENT FILE NAME
SA3 TARA+ARLL
MX0 42
BX4 X1-X3
BX2 X0*X4
BX6 X6-X6 INITIALIZE LIST FLAG
ZR X2,DFT1 IF NO FILE NAME CHANGE
SA6 LIST
DFT1 SX1 3
BX6 X3+X1
SA6 A1
* CALL FUNCTION PROCESSOR.
DFT2 RETURN D,R
RJ SPR JUMP TO PROCESSOR
SA2 TARA+ARFC CHECK FOR HIDDEN ERROR
SX3 X2+
NZ X3,DFT3 IF NOT *GO* COMMAND
SA1 GOPC
NZ X1,DFT3 IF TERMINATION COMPLETE
MESSAGE X5
SA1 TARA+ARFC SET FORCE *K* DISPLAY FLAG
MX0 1
LX0 55-59
BX6 X0+X1
SA6 A1
SA2 DFSF GET DAYFILE STATUS FLAG
NG X2,DFT3 IF TERMINATED DAYFILE PERMANENT
ZR X2,DFT3 IF DAYFILE NOT TERMINATED
SETFS D,0 INSURE LOCAL FILE IS RETAINED
EQ DFT4 SET RETURN PARAMETERS
* SET PARAMETERS FOR RETURN TO *QFSP*.
DFT3 RETURN D,R
DFT4 RETURN C,R
PACKNAM CPCK SET USER PACK
ENFAM CFAM SET USER FAMILY
EREXIT 0 CLEAR ERROR EXIT
SX2 B7 SET *K* DISPLAY BUFFER ADDRESS
EQ DFTERMX
SPACE 4
** FUNCTION TABLE.
*
* INDEX INTO TABLE IS FUNCTION CODE FROM *QFSP*.
TFCN BSS 0 FUNCTION PROCESSOR ADDRESS TABLE
LOC 0
CON GOP TERMINATE DAYFILES PROCESSOR (*GO*)
CON 0
CON LSP LIST DAYFILES PROCESSOR (*LIST*)
CON OTP DISPOSE OUTPUT FILE PROCESSOR (*OUT*)
LOC *O
GOP TITLE COMMAND PROCESSOR SUBROUTINES.
*** GO.
* TERMINATE ACTIVE OR INACTIVE DAYFILE AND DEFINE AS
* A DIRECT ACCESS PERMANENT FILE ON THE DEVICE ON
* WHICH IT CURRENTLY RESIDES. IF ACTIVE DAYFILE
* TERMINATION, CREATE NEW ACTIVE DAYFILE ON DEVICE
* SPECIFIED BY *K* DISPLAY PARAMETERS. DEFINE
* TERMINATED DAYFILE AS PRIVATE FILE WITH READ MODE
* PERMISSION. ALSO, PERMIT AN ASSEMBLY-TIME DEFINED
* USER NUMBER IN WRITE MODE.
** GOP - TERMINATE DAYFILES PROCESSOR.
*
* EXIT (X5) = *K* DISPLAY MESSAGE ADDRESS.
* (B7) = 0 (NO *K* DISPLAY BUFFER).
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* B - 7.
* X - ALL.
*
* CALLS ADN, DTD, PUN, TOD, VED.
*
* MACROS EREXIT, SYSTEM.
GOP SUBR ENTRY/EXIT
SA3 TARA+ARFT DAYFILE TYPE
SA4 TARA+ARDN GET EST ORDINAL
BX6 X6-X6 CLEAR ACTIVE DAYFILE EQUIPMENT AND FLAG
SA6 GOPB
SA6 A6+B1
MX0 -12
BX4 -X0*X4
SA2 TARA+AROP OPTION
BX3 -X0*X3
BX2 -X0*X2
* VALIDATE DAYFILE TERMINATION.
RJ VED VALIDATE EXISTENCE OF DAYFILE ON DEVICE
NZ X5,GOPX IF ERROR
LX3 12
LX4 48 SAVE EQUIPMENT AND DAYFILE TYPE
BX7 X4+X3
SA7 GOPA
SA7 D+7
EREXIT ERR1 SET MINOR ERROR EXIT ADDRESS
* ASSIGN NAME TO DAYFILE.
RJ ADN ASSIGN DAYFILE NAME
NZ X5,GOPX IF ERROR
BX6 X2 INSERT NAME IN FET
SA6 D+CFPN
EREXIT ERR SET MAJOR ERROR EXIT ADDRESS
* TERMINATE DAYFILE.
RJ TOD TERMINATE OLD DAYFILES
NZ X5,GOPX IF ERROR
* FINISH DAYFILE TERMINATION.
SA5 TARA+AROP OPTION
MX0 -12
BX5 -X0*X5
SA1 GOPB
ZR X5,GOP1 IF INACTIVE DAYFILE TERMINATION
ZR X1,GOP1 IF NO EQUIPMENT SWITCH
MX0 12 SET ACTIVE DAYFILE EST ORDINAL
SA2 GOPA
BX2 -X0*X2
BX1 X0*X1
BX6 X1+X2
SA6 A2+
* CLEAR FIRST TRACK BYTE IN SECTOR OF LOCAL AREAS.
GOP1 SA2 A1-B1 SET EQUIPMENT AND DAYFILE TYPE IN FET
BX7 X2
SA7 D+7
SYSTEM SFM,R,D,CDBF*100B
ZR X5,GOP2 IF INACTIVE DAYFILE TERMINATION
* PROTECT ACTIVE DAYFILE.
SA2 GOPA SET DAYFILE TYPE IN FET
MX0 12
BX7 -X0*X2
SA7 D+7
SYSTEM SFM,R,D,PADF*100B
* DEFINE TERMINATED DAYFILE.
GOP2 EREXIT ERR1 SET MINOR ERROR EXIT ADDRESS
SX6 B1 SET DAYFILE STATUS FLAG
SA6 DFSF
BX6 X6-X6 CLEAR EST ORDINAL
SA6 D+7
RJ DTD DEFINE TERMINATED DAYFILE
NZ X5,GOPX IF ERROR
* PERMIT USER NUMBER.
SX6 B0+ CLEAR DAYFILE STATUS FLAG
SA6 DFSF
RJ PUN PERMIT SPECIFIED USER NUMBER
NZ X5,GOPX IF ERROR
SX5 DTDA SET *K* DISPLAY MESSAGE
SB7 B0
SX6 B1 SET COMPLETION FLAG
SA6 GOPC
EQ GOPX
GOPA CON 0 EQUIPMENT AND DAYFILE TYPE
GOPB CON 0 ACTIVE DAYFILE EST ORDINAL
GOPC CON 0 TERMINATION COMPLETE FLAG
LSP EJECT
*** LIST.
* PRODUCE LISTING OF PERTINENT INFORMATION FOR ALL
* PERMANENT DAYFILES ON THE SYSTEM. SET OUTPUT FOR
* RELEASE IF *DFLIST* CALL. ADD LIST TO CURRENT OUTPUT
* FILE AND BUILD *K* DISPLAY BUFFER FROM THE LIST IF
* *DFTERM* CALL.
** LSP - LIST PERMANENT DAYFILES PROCESSOR.
*
* ENTRY (LIST) = RECORD COUNT ON OUTPUT FILE.
*
* EXIT (B7) = ADDRESS OF *K* DISPLAY BUFFER IF *DFTERM* CALL.
* = 0 IF *DFLIST* OR IF ERROR.
* (X5) = *K* DISPLAY MESSAGE ADDRESS.
* (LIST) INCREASED IF PERMANENT DAYFILES EXIST.
*
* USES A - 1, 5, 6.
* B - 7.
* X - 1, 5, 6.
*
* CALLS BOF, CFT, GKD, IPH.
*
* MACROS BKSP, EREXIT, READEI, SETFS.
LSP SUBR ENTRY/EXIT
* BUILD OUTPUT.
RJ CFT CREATE FAMILY NAME TABLE
RJ IPH INITIALIZE PAGE HEADER AND PAGE CONTROL
EREXIT ERR1 SET MINOR ERROR EXIT ADDRESS
RJ BOF BUILD OUTPUT FILE
NZ X5,LSPX IF ERROR
SA1 TARA+ARFC
PL X1,LSP1 IF NOT DFLIST CALL
* SET OUTPUT FOR DFLIST CALL.
SETFS O,0
SX5 =C*PERMANENT DAYFILE LIST COMPLETE.*
SB7 B0+ SET NO *K* DISPLAY
EQ LSPX
* CREATE *K* DISPLAY BUFFER.
LSP1 SA5 LIST INCREASE RECORD COUNT
SX6 X5+B1
SA6 A5
BKSP O SET BEGINNING OF CURRENT RECORD
READEI X2
RJ GKD GENERATE *K* DISPLAY
EQ LSPX
OTP EJECT
*** OUT.
* RELEASE OUTPUT FILE TO PRINTER IF ONE HAS BEEN
* WRITTEN.
** OTP - DISPOSE OUTPUT FILE PROCESSOR.
*
* ENTRY (LIST) .NE. 0 IF OUTPUT FILE WRITTEN.
*
* EXIT (LIST) = 0 (OUTPUT FLAG).
* (X5) = *K* DISPLAY MESSAGE ADDRESS.
* (B7) = 0 (NO *K* DISPLAY BUFFER).
*
* USES A - 2, 6.
* B - 7.
* X - 2, 5, 6.
*
* MACROS ROUTE.
OTP SUBR ENTRY/EXIT
SA2 LIST CHECK IF OUTPUT EXISTS
ZR X2,OTP1 IF NO OUTPUT FILE
BX6 X6-X6 CLEAR OUTPUT FLAG AND RECORD COUNT
SA6 A2
* RELEASE OUTPUT FILE.
SX6 B0+ CLEAR *DSP* PARAMETER BLOCK
SB7 DSPBL-1
OTP0 SA6 DSPB+B7
SB7 B7-1
PL B7,OTP0 IF NOT END OF BLOCK
SA2 O GET FILE NAME
MX6 42
BX6 X6*X2
SA6 DSPB *DSP* PARAMETER BLOCK
SA2 OTPA
BX6 X2
SA6 A6+B1
ROUTE DSPB,RECALL
SX5 =C*OUTPUT FILE RELEASED. *
SB7 B0+
EQ OTPX
OTP1 SX5 =C*NO OUTPUT FILE EXISTING. *
SB7 B0+
EQ OTPX
OTPA VFD 24/0,12/2HPR,6/0,18/FRDC
SPR EJECT
** SPR - SET PROCESSOR RETURN JUMP.
*
* ENTRY (B7) = ADDRESS OF PROCESSOR.
* (SPR) = RETURN JUMP ADDRESS.
*
* EXIT RETURN JUMP ADDRESS SET IN PROCESSOR.
* JUMPS TO COMMAND PROCESSOR.
*
* USES A - 1, 6.
* X - 1, 6.
SPR SUBR ENTRY/EXIT
SA1 SPRX SET RETURN ADDRESS
BX6 X1
SA6 B7
JP B7+1 JUMP TO SUBROUTINE
ADN TITLE PRIMARY SUBROUTINES.
** ADN - ASSIGN AUTOMATIC DAYFILE NAME.
*
* ENTRY (FMPC) = FAMILY OR PACK NAME.
*
* EXIT (X2) = SPECIFIED DAYFILE NAME IF NOT A DUPLICATE,
* AUTOMATICALLY ASSIGNED NAME OTHERWISE.
* (X5) = 0 IF NAME ASSIGNED.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 1, 2, 3, 6, 7.
* B - 7.
* X - 0, 1, 2, 3, 5, 6, 7.
*
* CALLS CAN.
ADN SUBR ENTRY/EXIT
SX6 B0+ CLEAR SPECIFIED NAME FLAG
SA6 SNAM
* FORM SPECIFIED NAME FROM KEYWORD AND SPECIFIED CHARACTERS.
SA2 TARA+ARFT GET DAYFILE TYPE CODE
MX0 -12
BX2 -X0*X2
SA3 TDNK+X2 SET DAYFILE NAME KEYWORD
SA1 TARA+ARNM CHECK IF CHARACTERS SPECIFIED
ZR X1,ADN1 IF NONE SPECIFIED
MX0 30 COMBINE NAME KEY AND SPECIFIED CHARACTERS
BX1 X0*X1
LX1 -12
BX6 X3+X1
SA6 SNAM
* FORM AUTOMATIC DAYFILE NAME SKELETON.
ADN1 DATE ANAM
SA2 ANAM FORM LAST FOUR CHARACTERS OF NAME
LX2 6
MX0 12
LX0 -18
BX1 X0*X2 MONTH
LX2 6
LX0 -12
BX2 X0*X2 DAY
BX6 X1+X2
BX7 X3+X6
SA7 A2
* SET INFORMATION IN FET.
SA2 FMPC SET FAMILY/PACK AND USER INDEX
MX0 42
SX3 X2 MASK IN AUXILIARY PACK FLAG
BX2 X0*X2
LX3 17
SX1 PDUI
BX2 X2+X3
BX6 X1+X2
SA6 C+14
* CHECK FOR AVAILABLE NAME.
RJ CAN CHECK CATALOG FOR AVAILABLE NAME
NZ X5,ADNX IF ERROR
SA2 SNAM
ZR X2,ADN2 IF NO SPECIFIED NAME
SX6 X2
BX5 X5-X5
NZ X6,ADN2 IF DUPLICATE FILE NAME
EQ ADNX
* FIND NEXT SEQUENCE CHARACTER IF AUTOMATIC ASSIGNMENT.
ADN2 SA1 CANB CHECK FOR NEXT SEQUENCE CHARACTER
SX6 1R9
LX1 59-35
NG X1,ADN4 IF MAXIMUM CHARACTER USED
ADN3 LX1 1
NG X1,ADN6 IF LATEST SEQUENCE CHARACTER FOUND
SX6 X6-1 DECREMENT SEQUENCE CHARACTER
SX7 X6-1
NZ X7,ADN3 IF NOT ALL CHARACTERS CHECKED
EQ ADN6
* CHECK FOR LOWEST AVAILABLE SEQUENCE CHARACTER.
ADN4 SX6 1RA CHECK FOR LOWEST CHARACTER
LX1 59-24-0
ADN5 PL X1,ADN6 IF CHARACTER AVAILABLE
LX1 59
SX6 X6+B1 INCREMENT CHARACTER
SX7 X6-1R9
NZ X7,ADN5 IF NOT AT MAXIMUM CHARACTER
SB7 B0+
SX5 =C* AUTOMATIC NAME ASSIGNMENT IMPOSSIBLE.*
EQ ADNX
ADN6 SA1 ANAM ADD SEQUENCE CHARACTER TO SKELETON NAME
LX6 42
BX2 X6+X1
SX5 B0
EQ ADNX
BOF SPACE 4,15
** BOF - BUILD OUTPUT FILE.
*
* ENTRY (PPOS) = PAGE POSITION (SET TO END OF PAGE).
* (PNUM) = PAGE NUMBER (SET TO 1).
* (DNUM) = DAYFILE NUMBER (SET TO 1).
* (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
* NOT YET WRITTEN.
*
* EXIT (X5) = 0 IF DAYFILES EXIST.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 1, 6, 7.
* B - 7.
* X - 0, 1, 2, 5, 6, 7.
*
* CALLS BDL, CDD.
*
* MACROS MESSAGE, WRITEC, WRITER.
BOF SUBR ENTRY/EXIT
* BUILD LIST LINES.
BOF1 SX1 PDCB PERMANENT DAYFILE LIST CONTROL BLOCK
SX2 PDLB AREA TO RECEIVE LIST LINE
RJ BDL BUILD DAYFILE LIST LINE
NZ X5,BOFX IF ERROR
NZ X6,BOF3 IF END OF DAYFILE LIST
SA1 DNUM INCREMENT DAYFILE NUMBER
SX6 X1+B1
SA6 A1
RJ CDD CONVERT TO DISPLAY CODE
LX6 30 PUT IN LIST LINE
MX0 -24
SA1 PDLB
BX1 -X0*X1
BX6 X0*X6
BX7 X1+X6
SA7 A1
SA1 PPOS CHECK PAGE POSITION
SA2 A1+B1
IX2 X1-X2
NG X2,BOF2 IF NOT END OF PAGE
* WRITE PAGE HEADER.
SA1 PNUM INCREMENT PAGE NUMBER
SX6 X1+B1
SA6 A1
RJ CDD CONVERT TO DISPLAY CODE
MX1 -18 PUT PAGE NUMBER IN PAGE HEADER
BX6 -X1*X6
SA1 =5LPAGE
LX6 12
BX6 X1+X6
SA6 BOFA+6
SA1 PDFE+1 GET PRINT DENSITY FORMAT CONTROL FLAG
BX7 X7-X7
SA7 A1
WRITEW O,A1-B1,X1 CONDITIONALLY WRITE FORMAT EFFECTOR
WRITEC O,BOFA WRITE PAGE HEADING
WRITEC O,BOFB WRITE SECOND HEADING LINE
WRITEC O,(=C* *) WRITE BLANK LINE
SX1 4 SET PAGE HEADING LINE COUNT
* WRITE LIST LINE.
BOF2 SX6 X1+1 COUNT OUTPUT LINE
SA6 PPOS
WRITEC O,PDLB,PDLBL WRITE DAYFILE LINE
EQ BOF1 GET NEXT LINE
* END DAYFILE LIST.
BOF3 SA1 DNUM CHECK DAYFILE COUNT
SX1 X1-2
NG X1,BOF4 IF NO DAYFILES LISTED
WRITER O,R
BX5 X5-X5 SET NO MESSAGE
EQ BOFX
BOF4 SX5 =C* NO PERMANENT DAYFILES. *
SB7 B0
MESSAGE X5
EQ BOFX
BOFA DATA C*1CATALOG OF PERMANENT DAYFILES (000000). 00/00/00 00
,.00.00 PAGE 000* FIRST DAYFILE PAGE HEADER
BOFB DATA C*0 NUM TYPE FM/PN DN PFNAME DATE TIME L
,ENGTH*
CFT SPACE 4,7
** CFT - CREATE FAMILY/PACK NAME TABLE.
*
* EXIT (PDCB) = FIRST WORD OF FAMILY/PACK NAME TABLE.
*
* USES A - 1, 2, 6.
* B - 2, 3, 4, 5, 6.
* X - 0, 1, 2, 6, 7.
CFT SUBR ENTRY/EXIT
SX6 C SET FET ADDRESS
SA6 PDCB
SB2 PDCB+2 SET ADDRESS FOR FAMILY/PACK NAME TABLE
SB3 B0 SET OUTPUT TABLE EMPTY
SB5 B0 INITIALIZE TO EQUIPMENT ZERO
SX2 PDUI SET SHIFT COUNT FOR MASK TEST
MX6 -3
BX2 -X6*X2
SB6 X2-59
* SEARCH EQUIPMENT TABLE FOR MASS STORAGE FAMILIES/PACKS.
CFT1 SA1 TEQA+B5 GET AN EQUIPMENT ENTRY
ZR X1,CFT4 IF END OF EQUIPMENT TABLE
SB5 B5+1 ADVANCE EQUIPMENT
SX2 B1
IX2 X1+X2
ZR X2,CFT1 IF NOT MASS STORAGE EQUIPMENT
SA2 TMSA+B5-1 GET DEVICE MASK FOR EQUIPMENT
AX6 X2,B6
PL X6,CFT1 IF USER INDEX NOT ON THIS DEVICE
MX6 42 GET FAMILY/PACK NAME
BX6 X6*X1
LX1 59-2
SB4 B0+ INITIALIZE AT START OF OUTPUT TABLE
PL X1,CFT2 IF NOT AUXILIARY DEVICE
SX1 B1+ SET AUXILIARY PACK FLAG
LX1 17
BX6 X6+X1
SX7 B5-B1 ADD EST ORDINAL
BX6 X6+X7
* CHECK IF FAMILY/PACK ALREADY IN TABLE.
CFT2 GE B4,B3,CFT3 IF END OF OUTPUT TABLE
SA1 B2+B4 GET A NAME FROM OUTPUT TABLE
BX2 X1-X6
ZR X2,CFT1 IF NAMES MATCH (ALREADY IN TABLE)
SB4 B4+1 ADVANCE OUTPUT TABLE INDEX
EQ CFT2 LOOP TO CHECK NEXT NAME
CFT3 SA6 B2+B3 PUT NAME IN OUTPUT TABLE
SB3 B3+B1 COUNT TABLE ENTRY
EQ CFT1 LOOP TO CHECK MORE EQUIPMENT
CFT4 SX6 B3+ FAMILY/PACK NAME COUNT
LX6 18
SA6 B2-B1
* ADD USER INDEX TO TABLE FOR FAMILY ENTRIES.
MX0 -18
SB4 B0
SX2 PDUI PERMANENT DAYFILE USER INDEX
CFT5 GE B4,B3,CFTX IF END OF FAMILY/PACK NAME TABLE
SA1 B2+B4 GET FAMILY/PACK NAME
SB4 B4+B1 ADVANCE INDEX
BX7 -X0*X1
NZ X7,CFT5 IF AUXILIARY PACK
BX6 X1+X2 ADD USER INDEX
SA6 A1
EQ CFT5 PROCESS NEXT FAMILY/PACK
DTD SPACE 4,11
** DTD - DEFINE TERMINATED DAYFILE.
*
* EXIT (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 1, 2, 7.
* B - 7.
* X - 0, 1, 2, 3, 5, 6, 7.
*
* CALLS ERP, SFN.
*
* MACROS DEFINE, MESSAGE.
DTD SUBR ENTRY/EXIT
* DEFINE DAYFILE AS PERMANENT.
DTD1 DEFINE D,,,,,,R,,,,,,IE,,,Y
SA2 D CHECK FOR ERROR
MX0 8
LX0 18
BX6 X0*X2
NZ X6,DTD2 IF *PFM* ERROR
* SET UP PERMANENT DAYFILE MESSAGE.
MX0 42 SET PERMANENT FILE NAME IN MESSAGE
SA2 D+8
BX1 X0*X2
RJ SFN SPACE FILL NAME
SA1 DTDA+3
BX6 X0*X6
BX3 -X0*X1
BX7 X3+X6
SA7 A1
MESSAGE DTDA
BX5 X5-X5 SET NO ERROR
EQ DTDX
* PROCESS ERROR.
DTD2 BX7 -X0*X2 CLEAR ERROR BITS
SA7 A2
RJ ERP ERROR PROCESSOR
ZR X5,DTD1 IF RETRY OPERATION
MESSAGE X5 ISSUE *PFM* ERROR MESSAGE
SX5 DTDB * ERROR - TERMINATED DAYFILE ON LOCAL...*
SB7 B0+
EQ DTDX
DTDA DATA C* PERMANENT DAYFILE DEFINED AS .*
DTDB DATA C* ERROR - TERMINATED DAYFILE ON LOCAL FILE ZZZDAYF.*
GCF SPACE 4,7
** GCF - GET CURRENT FAMILY AND PACK NAMES.
*
* EXIT (CPCK) = CURRENT PACK NAME.
* (CFAM) = CURRENT FAMILY NAME.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 6, 7.
*
* MACROS SYSTEM.
GCF SUBR ENTRY/EXIT
SX6 PFCW INITIALIZE *RSB* REQUEST BLOCK
SX7 PKNW
SA6 GCFB
SA7 A6+B1
SYSTEM RSB,R,GCFA
SA1 GCFB SET FAMILY EST ORDINAL
LX1 -12
MX2 -9
BX6 -X2*X1
SA1 TEQA+X6 SET FAMILY FROM TABLE
MX0 42
BX6 X0*X1
SA6 CFAM
SA1 GCFB+1 SAVE CURRENT PACK AND TYPE
BX6 X1
SA6 CPCK
EQ GCFX
GCFA VFD 12/0,12/2,18/0,18/GCFB *RSB* STATUS WORD
GCFB CON PFCW
CON PKNW
GKD SPACE 4,10
** GKD - GENERATE *K* DISPLAY BUFFER.
*
* ENTRY FORMATTED DAYFILE INFORMATION IN OUTPUT BUFFER.
*
* EXIT (B7) = ADDRESS OF *K* DISPLAY BUFFER.
* (X5) = *K* DISPLAY MESSAGE ADDRESS.
*
* USES A - 3, 4, 5, 6, 7.
* B - 7.
* X - 0, 1, 3, 4, 5, 6, 7.
*
* MACROS MOVE, READC.
GKD SUBR ENTRY/EXIT
* SET HEADER FOR *K* DISPLAY.
READC O,KBUF+1 SKIP HEADER ON OUTPUT FILE
MOVE GKDCL,GKDC,KBUF+1
SX6 KBUF+1+GKDCL SET LINE NUMBER
SA6 GKDA
SX7 KDLC SET LINE COUNT FOR *K* DISPLAY
SA7 GKDB
* MOVE CODED LINES TO *K* DISPLAY BUFFER.
GKD1 READC O,CENB READ ONE LINE
NG X1,GKD2 IF EOF/EOI
SA3 CENB MASK OFF CARRIAGE CONTROL CHARACTERS
MX0 6
BX7 -X0*X3
SA4 =1L
BX6 X4+X7
SA6 A3
SX1 B6-CENB CALCULATE NUMBER OF WORDS
SA3 GKDA RESET LINE NUMBER
IX6 X3+X1
SA6 A3
MOVE X1,CENB,X3
SA3 GKDB DECREMENT LINE COUNT
SX6 X3-1
SA6 A3+
NZ X6,GKD1 IF NOT MAXIMUM NUMBER LINES TRANSFERRED
SA5 GKDA *MORE DAYFILES, ENTER OUT FOR LIST*
MOVE GKDDL,GKDD,X5
SX7 X5+GKDDL UPDATE LINE NUMBER
SA7 A5+
* SET END OF BUFFER.
GKD2 SA3 GKDA SET ZERO WORD TO END BUFFER
BX6 X6-X6
SA6 X3
SB7 KBUF SET *K* DISPLAY BUFFER ADDRESS
SX5 =C*PERMANENT DAYFILE LIST COMPLETE.*
EQ GKDX
GKDA CON KBUF *K* DISPLAY BUFFER LINE ADDRESS
GKDB CON 0 *K* DISPLAY LINE COUNT
GKDC DATA C* *
DATA C* PERMANENT DAYFILE CATALOG*
GKDD DATA C* *
GKDCL EQU *-GKDC
DATA C* MORE PERMANENT DAYFILES. *
DATA C/ ENTER *OUT* FOR A FULL LIST./
CON 0 END OF *K* DISPLAY
GKDDL EQU *-GKDD
IPH SPACE 4,15
** IPH - INITIALIZE PAGE HEADER AND PAGE CONTROL.
*
* EXIT (PPOS) SET TO END OF PAGE.
* (PNUM) SET TO PAGE 1.
* (DNUM) SET TO DAYFILE NUMBER 1.
* (PDFE+1) SET TO 1 (FORMAT EFFECTOR NOT YET OUTPUT).
*
* USES A - 1, 6, 7.
* X - 1, 2, 6, 7.
*
* CALLS COD.
*
* MACROS CLOCK, DATE.
IPH SUBR ENTRY/EXIT
* SET DATE AND TIME IN PAGE HEADER.
DATE BOFA+4 PUT DATE IN PAGE HEADING
SA1 BOFA+4
SX2 1R.&1R CLEAR PERIOD AT RIGHT OF DATE
BX6 X1-X2
SA6 A1
CLOCK BOFA+5 PUT TIME IN PAGE HEADING
SA1 BOFA+5
SX2 1R.&1R CLEAR PERIOD AT RIGHT OF TIME
BX6 X1-X2
SA6 A1
* SET USER INDEX IN PAGE HEADER.
SX1 PDUI PUT PERMANENT DAYFILE USER INDEX IN HEADER
RJ COD
LX6 12
SA1 BOFA+3
MX2 36
LX2 -12
BX6 X2*X6
BX1 -X2*X1
BX6 X1+X6
SA6 A1
* SET PAGE POSITION, PAGE NUMBER AND DAYFILE NUMBER.
SX7 99999 FORCE END OF PAGE
SX6 B1
SA7 PPOS
SA6 PNUM SET TO PAGE 1
SA6 PDFE+1 SET PRINT DENSITY FORMAT CONTROL FLAG
SA6 DNUM SET TO DAYFILE 1
EQ IPHX
PUN SPACE 4,11
** PUN - PERMIT SPECIFIED USER NUMBER WITH WRITE PERMISSION.
*
* EXIT (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 1, 2, 7.
* B - 7.
* X - 0, 1, 2, 5, 6, 7.
*
* CALLS ERP.
*
* MACROS PERMIT.
PUN SUBR ENTRY/EXIT
SA1 PUNA CHECK IF USER NUMBER SPECIFIED
SX5 B0+ SET NO ERROR
ZR X1,PUNX IF NO USER NUMBER
* CHECK FOR PRIVATE PACK.
SA2 FMPC CHECK AUXILIARY DEVICE FLAG
SX6 X2+
ZR X6,PUN1 IF FAMILY
SA2 APIN
MX0 42
BX6 X0*X2
NZ X6,PUNX IF PRIVATE PACK
* PERMIT SPECIFIED USER NUMBER.
PUN1 PERMIT D,,PUNA,0,,,,IE
BX7 X7-X7 CLEAR USER NUMBER FROM FET
SA2 D CHECK FOR ERROR
MX0 8
SA7 D+CFOU
LX0 18
BX6 X0*X2
ZR X6,PUNX IF NO ERROR
BX7 -X0*X2 CLEAR ERROR BITS
SA7 A2
* PROCESS ERROR.
RJ ERP ERROR PROCESSOR
ZR X5,PUN1 IF RETRY OPERATION
SB7 B0+
EQ PUNX
PUNA VFD 42/0L"USRN",18/0 USER NUMBER TO PERMIT
TOD SPACE 4,11
** TOD - TERMINATE OLD DAYFILES.
*
* EXIT (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 2, 4, 5.
* B - 2, 3, 7.
* X - 0, 2, 4, 5, 6.
*
* MACROS MESSAGE, SYSTEM, WAIT.
TOD SUBR ENTRY/EXIT
TOD0 SX5 B0+ SET NO ERROR
SA4 TARA+AROP OPTION
MX0 -12
BX4 -X0*X4
ZR X4,TOD1 IF INACTIVE DAYFILE TERMINATION
* TERMINATE ACTIVE DAYFILE.
SYSTEM SFM,R,D,TAFF*100B
EQ TOD2
* TERMINATE INACTIVE DAYFILE.
TOD1 SYSTEM SFM,R,D,ATDF*100B
TOD2 SA2 D CHECK FOR ERROR
MX0 4
LX0 14
BX6 X0*X2
SB7 B0
ZR X6,TODX IF NO ERROR
* PROCESS DAYFILE TERMINATION ERRORS.
LX6 -10
SA5 TSEP+X6 GET *SFM* ERROR MESSAGE ADDRESS
SB3 X6
EQ B1,B3,TOD4 IF DAYFILE BUSY
SB2 3
EQ B2,B3,TOD3 IF INACTIVE DAYFILE NOT FOUND
MESSAGE X5 ISSUE *SFM* ERROR MESSAGE
SX5 TODA * DAYFILE STATUS INDEFINITE.*
TOD3 EQ TODX RETURN
* PROCESS DAYFILE BUSY ERROR.
TOD4 MESSAGE (=C* WAITING FOR BUSY DAYFILE.*),2,R
WAIT 100 DELAY
EQ TOD0 RETRY
TODA DATA C* DAYFILE STATUS INDEFINITE. *
VED SPACE 4,21
** VED - VALIDATE EXISTENCE OF DAYFILE ON DEVICE.
*
* ENTRY (X2) = OPTION.
* (X3) = DAYFILE TYPE.
* (X4) = EST ORDINAL.
*
* EXIT (X3) = DAYFILE TYPE.
* (X4) = EST ORDINAL.
* (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
* (FMPC) = FAMILY/PACK NAME FOR PERMANENT DAYFILE.
* (APIN) = AUXILIARY PACK INFORMATION.
* (GOPB) = EST ORDINAL OF ACTIVE DAYFILE IF
* ACTIVE TERMINATION.
*
* USES A - 1, 6.
* B - 7.
* X - 0, 1, 2, 5, 6.
*
* CALLS SAD, VVD.
VED SUBR ENTRY/EXIT
* VERIFY THAT DAYFILE MAY BE TERMINATED AS SPECIFIED.
ZR X4,VED4 IF AN INVALID EST ORDINAL
RJ VVD VERIFY VALID DEVICE FOR DAYFILE
SB7 B0+ SET NO *K* DISPLAY BUFFER
NZ X5,VEDX IF VALIDITY ERROR
SA6 FMPC SAVE FAMILY/PACK NAME
ZR X2,VED2 IF INACTIVE DAYFILE TERMINATION
* FIND ACTIVE DAYFILE FAMILY/PACK AND EQUIPMENT.
SX6 X7-3
ZR X6,VEDX IF ACTIVE DAYFILE CURRENTLY ON DEVICE
RJ SAD SEARCH FOR ACTIVE DAYFILE
NZ B4,VED3 IF NO ACTIVE DAYFILE FOUND
SX6 B2 SAVE ACTIVE DAYFILE EST ORDINAL
LX6 48
SX2 B1
BX6 X2+X6
SA6 GOPB
* SET FAMILY/PACK INFORMATION.
MX0 42 SAVE FAMILY/PACK NAME OF ACTIVE DAYFILE
BX6 X0*X1
LX1 -2 ADD AUXILIARY PACK FLAG
BX2 X2*X1
BX6 X6+X2
SA6 FMPC
BX5 X5-X5 SET NO ERROR
ZR X2,VED1 IF NOT AUXILIARY PACK
SA1 TMSA+B2 SET AUXILIARY PACK INFORMATION
MX0 48
BX1 X0*X1
SX6 B2
BX6 X1+X6
SA6 APIN
VED1 ZR X7,VEDX IF NO INACTIVE DAYFILE ON DEVICE
SX5 =C* INACTIVE DAYFILE ON DEVICE. *
EQ VEDX
* CHECK FOR INACTIVE DAYFILE ON SPECIFIED DEVICE.
VED2 SX6 X7-1
ZR X6,VEDX IF INACTIVE DAYFILE ON DEVICE
SX5 =C* INACTIVE DAYFILE NOT FOUND ON DEVICE.*
EQ VEDX
VED3 SX5 =C* NO ACTIVE DAYFILE FOUND. *
EQ VEDX
VED4 SX5 =C* INVALID DEVICE SPECIFIED. *
EQ VEDX RETURN
BDL TITLE SECONDARY SUBROUTINES.
** BDL - BUILD DAYFILE LINE.
*
* ENTRY (X1) = ADDRESS OF LIST CONTROL BLOCK.
* (X2) = ADDRESS OF AREA TO RECEIVE LIST LINE.
*
* EXIT (X6) = 0 IF LIST LINE AVAILABLE.
* = 1 IF END OF LIST.
* (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 0, 1, 2, 5, 6, 7.
* B - 2, 3, 6, 7.
* X - 1, 2, 3, 5, 6, 7.
*
* CALLS DDD, EDI, FDE, GCD, RCE.
BDL SUBR ENTRY/EXIT
SA0 X1+B1 SET ADDRESS OF CATALOG LIST INDEX
SX6 X2 SAVE ADDRESS OF OUTPUT AREA
SA6 BDLA
SA2 A0 GET CATALOG LIST INDEX
SX1 X2
NZ X1,BDL2 IF NOT INITIALIZE CALL
* INITIALIZE POINTERS FOR READING OF CATALOG.
BDL1 SA1 A0 GET CATALOG LIST INDEX
SX6 B1
IX7 X1+X6 ADVANCE INDEX
SB2 X7
AX1 18 GET LIST LENGTH
SB3 X1+
BX5 X5-X5 CLEAR ERROR FLAG
GT B2,B3,BDLX IF END OF CATALOG LIST
SA7 A1+ SAVE CATALOG LIST INDEX
RJ GCD GET CATALOG DESCRIPTION
MX2 43 SAVE FAMILY/PACK NAME
BX6 X2*X1
SA6 BDLB+2
BX2 -X2*X1 USER INDEX
LX1 X6 FAMILY/PACK NAME
RJ DDD DETERMINE DEFAULT DEVICE
SA5 A0+ CATALOG LIST INDEX
LX6 36
MX1 -36 CLEAR OLD DEFAULT DEVICE NUMBER
BX5 -X1*X5
BX6 X6+X5
SA6 A5
BX1 X1-X1 SET INITIAL CATALOG READ
* OBTAIN CATALOG INFORMATION.
BDL2 SA2 A0-1 GET FET ADDRESS
SB6 CENB ADDRESS OF AREA TO RECEIVE CATALOG ENTRY
RJ RCE READ A CATALOG ENTRY
NZ X5,BDLX IF ERROR DURING CATALOG
NZ X1,BDL1 IF CATALOG ENTRY NOT READ
SA1 CENB EXTRACT DAYFILE INFORMATION FROM CATALOG
SB2 BDLB
RJ EDI
SX1 B1+ SET FOR NON-INITIAL CATALOG READ
ZR X6,BDL2 IF NOT A DAYFILE
SA1 B2 CHECK DEVICE NUMBER
MX3 6
LX3 -42
BX6 X3*X1
NZ X6,BDL3 IF NON-ZERO DEVICE NUMBER
SA2 A0 SUBSTITUTE DEFAULT DEVICE NUMBER
LX2 -24
BX2 X3*X2
BX6 X1+X2
SA6 A1+
* FORMAT DAYFILE ENTRY.
BDL3 SB6 B2 DAYFILE INFORMATION
SA1 BDLA OUTPUT ADDRESS
SB7 X1
RJ FDE FORMAT DAYFILE ENTRY
BX6 X6-X6 SET LINE AVAILABLE STATUS
BX5 X5-X5 CLEAR ERROR FLAG
EQ BDLX EXIT
BDLA CON 0 OUTPUT STRING ADDRESS
BDLB BSS 3 DAYFILE ENTRY BUFFER
CAN SPACE 4,16
** CAN - CHECK CATALOG FOR AVAILABLE NAME.
*
* ENTRY (SNAM) = USER SPECIFIED NAME.
* (ANAM) = SKELETON OF AUTOMATIC ASSIGNMENT NAME.
*
* EXIT (CANB) = AUTOMATIC ASSIGNMENT SEQUENCE CHARACTER MASK.
* (SNAM) = 1 IF DUPLICATE SPECIFIED NAME.
* (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
*
* USES A - 2, 3, 4, 6.
* B - 3, 6.
* X - ALL.
*
* CALLS RCE.
CAN SUBR ENTRY/EXIT
BX6 X6-X6 CLEAR MASK
SA6 CANB
* READ CATALOG ENTRIES.
BX1 X1-X1 SET INITIAL CALL FOR CATALOG READ
CAN1 SX2 C READ CATALOG ENTRY
SB6 CENB
RJ RCE
NZ X5,CANX IF ERROR ON INITIAL CATALOG
NZ X1,CANX IF END OF CATALOG ENTRIES
SA3 CENB CHECK NAME
* CHECK FOR DUPLICATE SPECIFIED NAME.
SA4 SNAM CHECK SPECIFIED NAME
ZR X4,CAN2 IF NONE SPECIFIED
MX0 42
BX6 X3-X4
BX7 X0*X6
SX6 B1 SET FLAG
NZ X7,CAN2 IF NOT A DUPLICATE
SA6 A4+
* BUILD AUTOMATIC SEQUENCE CHARACTER MASK.
CAN2 SA4 CANA CHECK FOR PERMANENT DAYFILES
SA2 ANAM
BX4 X4*X3
BX1 X4-X2
NZ X1,CAN1 IF NOT PERMANENT DAYFILE
AX3 42 SET UP MASK FOR SEQUENCE LETTER
MX0 -6
BX5 -X0*X3
SB3 X5
MX4 1
LX1 X4,B3
SA3 A4+B1 PREVIOUS SEQUENCE CHARACTER MASK
BX6 X3+X1 ADD SEQUENCE CHARACTER TO MASK
SA6 A3
EQ CAN1 LOOP FOR NEXT CATALOG
CANA CON 77770077777777000000B
CANB CON 0 SEQUENCE CHARACTER MASK
CDN SPACE 4,10
** CDN - CATAGORIZE DAYFILE NAME.
*
* ENTRY (X1) = 42/DAYFILE NAME, 18/
*
* EXIT (X1) = UNCHANGED.
* (X6) = DAYFILE TYPE CODE.
* = 0 IF NOT A DAYFILE NAME.
*
* USES A - 2, 7.
* X - 2, 3, 6, 7.
CDN SUBR ENTRY/EXIT
SX6 TDNKL SET TO END OF KEY TABLE
SX3 B1+
MX2 12 SAVE KEY PART OF DAYFILE NAME
BX7 X2*X1
SA7 TDNK
* FIND NAME KEY IN TABLE.
CDN1 IX6 X6-X3 DECREMENT TABLE INDEX
SA2 TDNK+X6 GET KEY FROM TABLE
BX2 X2-X7 COMPARE FILE NAME KEY WITH TABLE KEY
NZ X2,CDN1 IF NO MATCH
EQ CDNX
DDD SPACE 4,11
** DDD - DETERMINE DEFAULT DEVICE.
*
* ENTRY (X1) = FAMILY/PACK NAME.
* (X2) = USER INDEX.
*
* EXIT (X6) = DEFAULT DEVICE NUMBER.
* = 0 IF NONE FOUND OR IF AUXILIARY PACK.
*
* USES A - 2, 3.
* B - 2, 3.
* X - 2, 3, 6.
DDD SUBR ENTRY/EXIT
BX6 X6-X6 INITIALIZE DEFAULT DEVICE NUMBER
SX3 X1
NZ X3,DDDX IF AUXILIARY DEVICE
* GET USER INDEX MASK BITS.
MX6 -3
BX2 -X6*X2
SB2 X2-59 MASK TEST SHIFT COUNT
SB3 B0+ EST ORDINAL
* CHECK FOR CORRECT FAMILY NAME.
DDD1 SA2 TEQA+B3 GET ENTRY FOR EQUIPMENT B3
ZR X2,DDDX IF END OF TABLE
SB3 B3+B1 ADVANCE EST ORDINAL
SX3 -B1
IX3 X2-X3
MX6 42
ZR X3,DDD1 IF NOT MASS STORAGE EQUIPMENT
BX3 X6*X2
IX6 X1-X3
NZ X6,DDD1 IF NOT CORRECT FAMILY
* CHECK FOR USER INDEX ON DEVICE.
SA3 TMSA+B3-1 GET DEVICE MASK FOR EQUIPMENT B3-1
AX6 X3,B2
AX2 12 GET DEVICE NUMBER
PL X6,DDD1 IF USER INDEX NOT ON THIS DEVICE
MX3 -6
BX6 -X3*X2
EQ DDDX
EDI SPACE 4,24
** EDI - EXTRACT DAYFILE INFORMATION.
*
* ENTRY (A1) = ADDRESS OF CATALOG ENTRY TO EXTRACT INFORMATION
* FROM.
* (X1) = FIRST WORD OF CATALOG ENTRY.
* (B2) = ADDRESS OF 2 WORD BLOCK TO RECEIVE DAYFILE
* INFORMATION.
*
* EXIT (B2) = UNCHANGED.
* (X6) = DAYFILE TYPE CODE.
* = 0 IF NOT A DAYFILE CATALOG ENTRY.
* DATA BLOCK SET UP AS FOLLOWS AT ADDRESS (B2).
* 42/DAYFILE NAME, 6/DN, 12/DC
* 24/LF, 18/CD, 18/CT
* DN = DEVICE NUMBER OF DAYFILE.
* DC = DAYFILE TYPE CODE.
* LF = LENGTH OF DAYFILE.
* CD = PACKED CREATION DATE.
* CT = PACKED CREATION TIME.
*
* USES A - 2, 3, 6, 7.
* X - 1, 2, 3, 6, 7.
*
* CALLS CDN.
EDI SUBR ENTRY/EXIT
* PACK NAME AND DEVICE NUMBER.
MX6 42 GET FILE NAME
BX1 X6*X1
SA2 A1+4 GET DEVICE NUMBER
MX6 6
LX6 -18
BX2 X6*X2
LX2 -24 PACK FILE NAME AND DEVICE NUMBER
BX1 X1+X2
* PACK LENGTH, DATE, AND TIME.
SA2 A1+B1 GET FILE LENGTH
SA3 A2+B1 GET CREATION DATE AND TIME
MX6 24
BX3 -X6*X3
BX6 X6*X2
BX6 X6+X3 SAVE FILE LENGTH, DATE AND TIME
SA6 B2+B1
LX2 59-11
NG X2,EDI1 IF A DIRECT ACCESS FILE
* SET NON-DAYFILE TYPE.
BX6 X1 SAVE FILE NAME, DEVICE, AND 0 DAYFILE CODE
SA6 B2
BX6 X6-X6 SET NON-DAYFILE TYPE CODE
EQ EDIX
* SET DAYFILE TYPE.
EDI1 RJ CDN CATAGORIZE DAYFILE NAME
BX7 X1+X6 SAVE FILE NAME, DEVICE, AND DAYFILE CODE
SA7 B2
EQ EDIX
ERP SPACE 4,17
** ERP - ERROR PROCESSOR FOR *PFM* CALLS.
*
* ENTRY (X6) = *PFM* ERROR CODE.
*
* EXIT (X5) = *K* DISPLAY ERROR MESSAGE ADDRESS.
* = 0 IF RETRY OPERATION.
*
* USES A - 6.
* X - 1, 5, 6.
*
* CALLS ADN.
*
* MACROS MESSAGE, RECALL.
ERP SUBR ENTRY/EXIT
LX6 -10
SX1 X6-/ERRMSG/FAP
ZR X1,ERP1 IF FILE ALREADY PERMANENT ERROR
SX1 X6-/ERRMSG/PFA
ZR X1,ERP2 IF PF UTILITY ACTIVE ERROR
SX5 MPER SET ERROR MESSAGE ADDRESS
EQ ERPX RETURN
* PROCESS FILE ALREADY PERMANENT ERROR.
ERP1 RJ ADN ASSIGN DAYFILE NAME
NZ X5,ERPX IF AUTOMATIC ASSIGNMENT IMPOSSIBLE
BX6 X2 INSERT NEW NAME IN FET
SA6 D+CFPN
EQ ERPX
* PROCESS PF UTILITY ACTIVITY ERROR.
ERP2 RECALL WAIT FOR END OF PF UTILITY
MESSAGE (=C* WAITING FOR PF UTILITY.*),2,R
BX5 X5-X5
EQ ERPX
ERR SPACE 4,3
** ERR - PROCESS ERROR EXIT.
*
* ENTRY TO *ERR1* IF STATUS OF DAYFILE IS NOT INDEFINITE.
*
* MACROS ABORT, ENFAM, MESSAGE, PACKNAM.
ERR MESSAGE TODA *DAYFILE STATUS INDEFINITE.*
ERR1 MESSAGE (=C* DFTERM ABORTED.*)
PACKNAM CPCK SET USER PACK
ENFAM CFAM SET USER FAMILY
ABORT
FDE SPACE 4,20
** FDE - FORMAT DAYFILE ENTRY.
*
* ENTRY (B6) = ADDRESS OF DAYFILE INFORMATION.
* 42/FILE NAME, 6/DN, 12/DC
* 24/LF, 18/CD, 18/CT
* 42/FAMILY OR PACK NAME, 1/F, 17/0
* DN = DEVICE NUMBER FOR FILE.
* DC = DAYFILE TYPE CODE.
* LF = LENGTH OF DAYFILE.
* CD = CREATION DATE OF FILE.
* CT = CREATION TIME OF FILE.
* F = AUXILIARY PACK FLAG
* (B7) = ADDRESS OF AREA TO RECEIVE FORMATTED OUTPUT.
*
* EXIT (B7) = ADDRESS OF FORMATTED DAYFILE INFORMATION.
*
* USES A - 1, 2, 6, 7.
* X - 0, 1, 2, 3, 6, 7.
*
* CALLS COD, SFN.
*
* MACROS EDATE, ETIME.
FDE SUBR ENTRY/EXIT
* FORMAT FAMILY/PACK NAME.
SA1 B6+2 GET FAMILY/PACK NAME
MX0 42
BX1 X0*X1
RJ SFN SPACE FILL NAME
LX6 30 SAVE NAME
SA6 B7+2
* FORMAT DAYFILE TYPE AND DEVICE NUMBER.
SA1 B6 GET DAYFILE TYPE
MX2 -3
BX2 -X2*X1
SA2 TDFT+X2
MX3 -30
BX6 -X3*X6
LX2 18
BX7 X3*X2
BX6 X7+X6 SAVE LOWER PART OF DAYFILE TYPE
SA6 B7+B1
BX6 X2 SAVE UPPER PART OF DAYFILE TYPE
LX1 -12 GET DEVICE NUMBER
SA6 B7+
MX0 -6
BX1 -X0*X1
SX1 X1+100B FORCE TWO DIGITS
RJ COD CONVERT TO OCTAL
SA1 B7+2 MERGE WITH FAMILY/PACK NAME
MX3 -12
BX6 -X3*X6
LX3 30
LX6 30
BX1 X3*X1
BX6 X1+X6
SA6 A1 PUT DEVICE NUMBER IN OUTPUT STRING
* FORMAT FILE NAME.
SA1 B6 GET FILE NAME
MX6 42
BX1 X6*X1
RJ SFN SPACE FILL FILE NAME
LX6 24
SA6 B7+3 PUT LOWER PART OF FILE NAME IN OUTPUT
MX0 30
BX6 -X0*X6
SA1 A6-B1 SAVE UPPER PART OF FILE NAME
BX1 X0*X1
BX7 X1+X6
SA7 A1
* FORMAT DATE AND TIME.
MX6 -18 GET CREATION DATE
SA1 B6+B1
LX1 -18
BX1 -X6*X1
EDATE X1 EDIT DATE
LX6 42
SA6 B7+4 SAVE LOWER PART OF DATE IN OUTPUT
SA1 A6-B1 SAVE UPPER PART OF DATE IN OUTPUT
MX2 24
BX1 X2*X1
BX6 -X2*X6
BX6 X1+X6
SA6 A1
SA1 B6+B1 GET CREATION TIME
MX6 -18
BX1 -X6*X1
ETIME X1 EDIT TIME
LX6 48 SAVE LOWER PART OF TIME IN OUTPUT
SA6 B7+5
SA1 A6-B1 SAVE UPPER PART OF TIME IN OUTPUT
MX2 12
BX1 X2*X1
BX6 -X2*X6
BX6 X1+X6
SA6 A1
* FORMAT FILE LENGTH.
SA1 B6+B1 GET FILE LENGTH
LX1 -36
MX6 -24
BX1 -X6*X1
RJ COD CONVERT FILE LENGTH TO OCTAL
MX2 -42 SAVE FILE LENGTH
BX7 -X2*X6
LX7 12
MX2 6
SA1 B7+5
BX1 X2*X1
BX6 X1+X7
SA6 A1
EQ FDEX
GCD SPACE 4,14
** GCD - GET CATALOG DESCRIPTION.
*
* ENTRY (A0) = CATALOG LIST INDEX.
* (B2) = TABLE INDEX.
*
* EXIT (X1) = TABLE ENTRY.
* (A0) = CATALOG LIST INDEX.
* (B2) = TABLE INDEX.
* (APIN) = AUXILIARY PACK INFORMATION.
* (FET+14) = 42/FAMILY OR PACK, 1/F, 17/USER INDEX.
* F = AUXILIARY PACK FLAG.
*
* USES A - 1, 2, 6, 7.
* X - 1, 2, 3, 6, 7.
GCD SUBR ENTRY/EXIT
SA1 A0+B2 GET CATALOG DESCRIPTION
MX3 1 CHECK AUXILIARY DEVICE FLAG
LX3 18
BX7 X3*X1
ZR X7,GCD1 IF FAMILY
* GET AUXILIARY PACK INFORMATION.
MX3 -17 GET EST ORDINAL
BX7 -X3*X1
BX3 X3*X1 SET USER INDEX IN ENTRY
SX2 PDUI
BX1 X3+X2
SA2 TMSA+X7 SET AUXILIARY PACK INFORMATION
MX3 48
BX6 X3*X2
BX7 X7+X6
SA7 APIN
* PUT DESCRIPTION IN FET.
GCD1 BX6 X1
SA2 A0-B1 GET FET ADDRESS
SA6 X2+14 PUT CATALOG DESCRIPTION IN FET
EQ GCDX
RCE SPACE 4,23
** RCE - READ CATALOG ENTRY.
*
* ENTRY (X1) = 0 FOR INITIALIZATION CALL.
* .NE. 0 FOR CONTINUATION CALL.
* (X2) = FET ADDRESS.
* (B6) = ADDRESS OF AREA TO RECEIVE CATALOG ENTRY.
* (FET+14) = 42/FAMILY OR PACK NAME, 1/F, 17/USER INDEX.
* F = AUXILIARY PACK FLAG.
*
* EXIT (X2) = FET ADDRESS.
* (X1) = 0 IF CATALOG ENTRY AVAILABLE.
* .NE. 0 IF END OF CATALOG.
* (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (B7) = 0 IF ERROR.
* FAMILY/PACK NAME AND USER INDEX MAY BE CHANGED IN
* CONTROL POINT AREA.
*
* USES A - 1, 6.
* B - 7.
* X - 1, 2, 5, 6.
*
* CALLS SFD, SFN.
*
* MACROS CATLIST, MESSAGE, READW.
RCE SUBR ENTRY/EXIT
NZ X1,RCE2 IF NOT INITIALIZATION CALL
SX6 B0+
SA6 X2+CFCN
* READ CATALOG ENTRIES INTO BUFFER.
RCE1 SA1 X2+B1 REWIND BUFFER POINTERS
SX6 X1
SA6 A1+B1
SA6 A6+B1
SB7 X2+ SAVE FET ADDRESS
SA1 X2+14 SET FAMILY/PACK DESCRIPTION
RJ SFD
SX2 B7 RESTORE FET ADDRESS
CATLIST X2,,,,,,,IE
SA1 C CHECK FOR ERROR
MX6 8
LX6 18
BX1 X6*X1
ZR X1,RCE2 IF NO ERROR
* ISSUE ERROR MESSAGE.
MX5 42 SET FAMILY/PACK NAME IN MESSAGE
SA1 X2+14
BX1 X5*X1
SB7 B0
RJ SFN SPACE FILL NAME
BX6 X5*X6
SA1 RCEA+3
BX1 -X5*X1
BX6 X1+X6
SA6 A1
SX5 RCEA SET MESSAGE ADDRESS
SA1 TARA+ARFC ISSUE DAYFILE MESSAGE ON *DFLIST*
PL X1,RCEX IF NO *PO=N* PARAMETER
SX6 X1-2
NZ X6,RCEX IF NOT LIST
MESSAGE X5
EQ RCEX
* READ ONE CATALOG ENTRY.
RCE2 READW X2,B6,NWCE READ A CATALOG ENTRY
BX5 X5-X5 CLEAR ERROR FLAG
ZR X1,RCEX IF CATALOG ENTRY TRANSFERRED
SX1 X1+B1
ZR X1,RCE1 IF NOT END OF CATALOG
EQ RCEX
RCEA DATA C* CANNOT CATLIST FAMILY/PACK - .*
SAD SPACE 4,12
** SAD - SEARCH FOR ACTIVE DAYFILE.
*
* ENTRY (B3) = SHIFT COUNT FOR DAYFILE BITS IN TABLE *TEQA*.
*
* EXIT (B2) = EST ORDINAL OF ACTIVE DAYFILE.
* (B4) = 0 IF ACTIVE DAYFILE FOUND.
* = 1 IF NOT FOUND.
* (X1) = FAMILY/PACK NAME WORD FOR ACTIVE DAYFILE.
*
* USES A - 1.
* B - 2, 4.
* X - 1, 5, 6.
SAD SUBR ENTRY/EXIT
SB2 B0+ SET EST ORDINAL
SB4 B1+ SET NO ACTIVE DAYFILE FLAG
* SEARCH TABLE FOR ACTIVE DAYFILE OF SPECIFIED TYPE.
SAD1 SA1 TEQA+B2 SEARCH TABLE
ZR X1,SADX IF END OF TABLE
SB2 B2+B1 ADVANCE EQUIPMENT
SX5 B1+
IX5 X5+X1
ZR X5,SAD1 IF NOT MASS STORAGE
AX6 B3,X1 CHECK FOR ACTIVE DAYFILE
SX5 B1+B1
BX6 X5*X6
ZR X6,SAD1 IF ACTIVE DAYFILE NOT ON DEVICE
* SET EST ORDINAL AND FAMILY/PACK NAME WORD.
SB2 B2-B1 SET EST ORDINAL
SB4 B0 CLEAR FLAG
EQ SADX
SAI SPACE 4,10
** SAI - SET AUXILIARY PACK INFORMATION IN FETS.
*
* ENTRY (APIN) = 42/USER NUMBER, 6/UNITS, 12/EQUIPMENT.
*
* EXIT CATALOG (C) AND DAYFILE (D) FETS SET UP WITH DEVICE
* TYPE IN WORD 1, USER NUMBER, IF ANY, FOR PRIVATE PACK
* IN WORD 9, AND NUMBER OF PHYSICAL UNITS IN WORD 12.
*
* USES A - 1, 2, 6, 7.
* X - 0, 1, 2, 6, 7.
*
* MACROS RDVT.
SAI SUBR ENTRY/EXIT
* SET USER NUMBER FOR PACK IN FETS.
SA1 APIN SET USER NUMBER
MX0 42
BX7 X0*X1
SA7 C+CFOU
SA7 D+CFOU
* SET NUMBER OF PHYSICAL UNITS IN FETS.
AX1 12 GET NUMBER UNITS - 1
MX0 -6
BX7 -X0*X1
SX6 X7+B1 SET UNITS
SA6 C+CFPK
SA6 D+CFPK
* GET DEVICE TYPE.
SA2 A1 SET EQUIPMENT
MX0 -12
BX2 -X0*X2
RDVT D,X2
SA2 D+1 SET DEVICE TYPE IN CATALOG FET
SA1 C+1
MX0 12
BX6 X0*X2
BX1 -X0*X1
BX7 X1+X6
SA7 A1
EQ SAIX
SFD SPACE 4,16
** SFD - SET FAMILY DESCRIPTION.
*
* ENTRY (X1) = 42/FAMILY OR PACK NAME, 1/F, 17/USER INDEX.
* F = AUXILIARY PACK FLAG.
*
* EXIT FAMILY/PACK NAME AND/OR USER INDEX SET IN CONTROL
* POINT AREA IF REQUESTED VALUE WAS DIFFERENT THAN THE
* CURRENT VALUE STORED INTERNALLY TO *SFD*. ILLEGAL
* VALUES FOR CURRENT FAMILY NAME AND CURRENT USER INDEX
* ARE STORED INITIALLY TO FORCE A CALL TO *CPM* ON THE
* FIRST CALL TO *SFD*.
* AUXILIARY PACK INFORMATION IS SET IN THE FETS IF
* NECESSARY.
*
* USES A - 2, 6.
* X - 0, 2, 3, 5, 6, 7.
*
* CALLS SAI.
*
* MACROS ENFAM, PACKNAM, SETUI.
SFD SUBR ENTRY/EXIT
* COMPARE CURRENT AND REQUESTED FAMILY AND USER INDEX.
MX3 -17 REQUESTED USER INDEX
BX6 -X3*X1
SA2 SFDA+2 CURRENT USER INDEX
BX5 X3*X1 REQUESTED FAMILY/PACK NAME
IX7 X2-X6
ZR X7,SFD1 IF REQUESTED USER INDEX ALREADY SET
SA6 A2 SET NEW USER INDEX
SETUI X6
* CHECK IF FAMILY OR PACK REQUESTED.
SFD1 SX6 X5+ CHECK AUXILIARY DEVICE FLAG
SA2 SFDA+B1 CURRENT FAMILY/PACK
NZ X6,SFD2 IF AUXILIARY PACK
* SET FAMILY NAME IF NECESSARY.
BX7 X5-X2
BX6 X5 SET NEW FAMILY NAME
ZR X7,SFDX IF REQUESTED FAMILY ALREADY SET
SA6 A2
SA6 A6-B1
BX6 X6-X6 CLEAR ALTERNATE USER NUMBER IN FET
SA6 C+CFOU
PACKNAM 0 CLEAR PACK NAME
ENFAM SFDA
EQ SFDX RETURN
* SET PACK NAME IF NECESSARY.
SFD2 SX6 B1 SET AUXILIARY PACK FLAG
MX0 42
BX5 X0*X5
BX6 X5+X6
BX7 X6-X2
ZR X7,SFDX IF REQUESTED PACK ALREADY SET
SA6 A2
BX6 X5 SET PACK NAME IN CONTROL POINT AREA
SA6 A6-B1
PACKNAM SFDA
RJ SAI SET AUXILIARY PACK INFORMATION
EQ SFDX RETURN
SFDA BSS 1 SCRATCH AREA FOR ENFAM MACRO
VFD 42/1,18/0 CURRENT FAMILY/PACK NAME
VFD 42/0,18/0 CURRENT USER INDEX
VVD SPACE 4,26
** VVD - VERIFY VALID DEVICE FOR DAYFILE EXISTENCE.
*
* CHECK FOR AUXILIARY OR REMOVABLE DEVICES. ACTIVE
* DAYFILES MAY NOT EXIST ON REMOVABLE DEVICES. ALSO,
* NEW ACTIVE DAYFILES MAY NOT BE STARTED ON PRIVATE
* PACKS UNLESS THE USER NUMBER SPECIFIED FOR PERMITS
* MATCHES THE USER NUMBER OF THE PRIVATE PACK.
*
* ENTRY (X2) = OPTION.
* (X3) = DAYFILE TYPE.
* (X4) = EST ORDINAL.
*
* EXIT (X2) = OPTION.
* (X3) = DAYFILE TYPE.
* (X4) = EST ORDINAL.
* (X5) = 0 IF NO ERROR.
* = *K* DISPLAY MESSAGE ADDRESS IF ERROR.
* (X6) = FAMILY/PACK NAME FOR EQUIPMENT.
* (X7) = DAYFILE EXISTENCE BITS FOR SPECIFIED TYPE.
* (B3) = SHIFT COUNT FOR DAYFILE BITS.
* (APIN) = AUXILIARY PACK INFORMATION.
* 42/USER NUMBER, 6/UNITS, 12/EST ORDINAL.
*
* USES A - 1, 5, 6.
* B - 2, 3.
* X - 0, 1, 5, 6, 7.
VVD SUBR ENTRY/EXIT
* CHECK IF LEGAL DEVICE FOR TERMINATION.
SA1 TEQA+X4 GET EQUIPMENT ENTRY
BX7 X7-X7 CHECK IF AUXILIARY DEVICE
LX1 59-2
PL X1,VVD1 IF NOT AUXILIARY DEVICE
SA5 TMSA+X4 SET AUXILIARY PACK INFORMATION
MX0 48
BX5 X0*X5
BX6 X5+X4
SX7 B1 SET AUXILIARY DEVICE FLAG
SA6 APIN
MX0 42 GET USER NUMBER
BX6 X0*X6
ZR X6,VVD1 IF NOT PRIVATE PACK
SA5 PUNA CHECK IF LEGAL PACK FOR TERMINATION
BX6 X5-X6
ZR X6,VVD1 IF PRIVATE PACK UN SAME AS PERMIT
SX5 =C* PRIVATE PACK/PERMIT UN CONFLICT.*
EQ VVDX
VVD1 LX1 2-1
PL X1,VVD2 IF NOT REMOVABLE DEVICE
NZ X2,VVD3 IF ACTIVE DAYFILE TERMINATION
* GET FAMILY/PACK NAME AND DAYFILE EXISTENCE BITS.
VVD2 SA1 A1 GET FAMILY/PACK NAME
MX0 42
BX6 X0*X1
BX6 X6+X7 ADD AUXILIARY DEVICE FLAG
SX5 X3-1 SET SHIFT COUNT FOR DAYFILE RESIDENCE BITS
SB2 10
LX5 X5,B1
SB3 X5+
MX0 -2 GET DAYFILE TYPE BITS FOR DEVICE
SB3 B2-B3
AX1 B3
BX7 -X0*X1
BX5 X5-X5 SET NO ERROR
EQ VVDX
VVD3 SX5 =C* REMOVABLE DEVICE/NO ACTIVE DAYFILES.*
EQ VVDX
TITLE DAYFILE NAME TABLES.
** TDNK - TABLE OF DAYFILE NAME KEYS.
*
* INDEX INTO TABLE IS DAYFILE TYPE CODE (ZERO IF NOT A DAYFILE
* NAME).
TDNK BSS 0 TABLE OF DAYFILE NAME KEYS
LOC 0
BSS 1 INPUT KEY (USED BY SEARCH ALGORITHM)
DATA 2LDF MASTER DAYFILE TYPE
DATA 2LAC ACCOUNT DAYFILE TYPE
DATA 2LER ERROR LOG DAYFILE TYPE
DATA 2LML MAINTENANCE LOG DAYFILE TYPE
TDNKL BSS 0 TABLE LENGTH
LOC *O
SPACE 4,3
** TDFT - TABLE OF DAYFILE TYPE NAMES.
*
* INDEX INTO TABLE IS DAYFILE TYPE CODE (ZERO IF NOT A DAYFILE).
TDFT BSS 0 TABLE OF DAYFILE TYPES
LOC 0
DATA 10LNONE NOT DAYFILE
DATA 10LDAYFILE MASTER DAYFILE
DATA 10LACCOUNT ACCOUNT DAYFILE
DATA 10LERRLOG ERROR LOG DAYFILE
DATA 10LMAINLOG MAINTENANCE LOG DAYFILE
LOC *O
TITLE ERROR PROCESSING TABLES.
** TSEP - TABLE OF *SFM* ERROR PROCESSING.
*
* INDEX INTO TABLE IS *SFM* ERROR CODE.
* QUANTITY REPRESENTS ERROR MESSAGE ADDRESS.
TSEP BSS 0 TABLE OF *SFM* ERROR PROCESSING
LOC 0
BSS 1
CON MS01 FILE BUSY
CON MS02 NOT ENOUGH MASS STORAGE
CON MS03 FILE NOT FOUND
CON MS04 UNCORRECTABLE RMS ERROR
LOC *O
TITLE ERROR PROCESSING MESSAGES.
** *SFM* ERROR MESSAGES.
MS01 DATA C* DAYFILE BUSY. *
MS02 DATA C* NOT ENOUGH MASS STORAGE. *
MS03 DATA C* INACTIVE DAYFILE NOT FOUND ON DEVICE. *
MS04 DATA C* UNCORRECTABLE RMS ERROR. *
** *PFM* ERROR MESSAGES.
MPER BSS 4 *PFM* ERROR MESSAGE RETURN BLOCK
TITLE COMMON DECKS.
COMMON SPACE 4,10
** COMMON DECKS.
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCCPM
*CALL COMCEDT
*CALL COMCLFM
*CALL COMCMVE
*CALL COMCPFM
*CALL COMCRDC
*CALL COMCRDW
*CALL COMCSFM
*CALL COMCSFN
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTW
TITLE BUFFERS.
USE LITERALS
* BUFFERS.
CENB BSS NWCE CATALOG ENTRY BUFFER
PDCB BSS PDCBL PERMANENT DAYFILE LIST CONTROL BUFFER
PDLB BSS PDLBL PERMANENT DAYFILE LIST LINE BUFFER
KBUF VFD 11/0,1/1,1/1,5/0,18/KTIA,24/0 K-DISPLAY BUFFER
DBUF EQU *+KBUFL TERMINATED DAYFILE BUFFER
CBUF EQU DBUF+DBUFL CATALOG BUFFER
OBUF EQU CBUF+CBUFL OUTPUT BUFFER
DSPB EQU OBUF+OBUFL *DSP* PARAMETER BLOCK
BUFFL EQU DSPB+DSPBL END OF BUFFERS
SPACE 4,10
ERRPL *-RFL IF DEFAULT FIELD LENGTH TOO SMALL
SPACE 4
END DFTERM