BACKLST
* /--- FILE TYPE = E
* /--- BLOCK BLIST 00 000 81/05/07 06.52
BACKLST
IDENT BACKLST,BEGIN,BACKLST
ENTRY BACKLST
SYSCOM B1 DEFINE (B1) = 1
*COMMENT PRODUCE BACKUP LIBRARY PRINTOUT
COMMENT COPYRIGHT CONTROL DATA CORP. 1980.
TITLE PRODUCE BACKUP LIBRARY PRINTOUT
SPACE 4
*** BACKLST - PRODUCE BACKUP LIBRARY PRINTOUT
* J. J. BUCHMANN. 80/11/15.
*
*FUNCTION;
* THIS PROGRAM EXTRACTS DATA FROM THE DUMP DIRECTORY.
* THIS IS INTENDED MOSTLY WHEN A FILE NEEDS TO BE
* RECOVERED BUT ITS ACCOUNT IS UNKNOWN, BUT OTHER
* INFORMATION CAN BE EXTRACTED ALSO.
*
*PARAMETERS;
* Z EXTENDED PARAMETER FLAG(PARAMETERS LONGER
* THAN 7 CHARACTERS PASSED BEHIND TRAILING
* DELIMITER
* FN=FFFF LIST FILENAMES WITH *FFFF* ONLY
* AN=AAAA LIST FILENAMES UNDER ACCOUNT *AAAA* ONLY
* TY=T LIST FILES OF TYPE *T* ONLY(ONE CHARACTER
* FILE TYPE)
* SL SHORT LISTING(60 CHARACTER MAXIMUM OUTPUT
* LINE SUITABLE TO BEING DISPLAYED ON PLATO
* SCREEN)
*
*ERROR MESSAGES;
* ERROR IN PARAMETERS
*
*INTERNAL ERROR MESSAGES; NONE
*
*INFORMATION PASSED INTO THE OUTPUT FILE;
* ACCOUNT NAME, FILE NAME, FILE SIZE/TYPE OF SELECTED
* ENTRIES.
SPACE 4
*CALL COMCMAC
*CALL COMCCMD
SPACE 4
**** ASSEMBLY CONSTANTS.
BLDD EQU 10 DUMP DIRECTORY LENGTH
DBUFL EQU 2001B DFILE BUFFER LENGTH
OUTBUFL EQU 2001B OUTPUT BUFFER LENGTH
****
TITLE COMMON DATA
BEGIN BSS 0
FETS BSS 0
D BSS 0
BACKDIR RFILEB DBUF,DBUFL,(FET=13D),EPR
OUT BSS 0
OUTPUT RFILEB OUTBUF,OUTBUFL,(FET=8D)
SPACE 4
* PERMANENT FILE PARAMETERS
*
PACK DATA 0 PACK NAME FOR ATTACHES
DPER DATA 7LBACKDIR PERMANENT FILE FOR DUMP DIRECT.
FILEN DATA 0 FILE NAME
ACCTN DATA 0 ACCOUNT NAME
TYPE DATA 0 TYPE
Z DATA 0 Z FLAG
SL DATA 0 SHORT LISTING FLAG
ONE DATA 1 CONSTANT ONE
USERI EQU 377773B USER INDEX FOR FILES
TIMEL EQU 7777B TIME LIMIT
PRIOR EQU 41B PRIORITY
* /--- BLOCK BLIST 00 000 80/11/24 07.53
TITLE MAIN PROGRAM.
*** BACKLST
BACKLST SB1 1 (B1) = 1
RJ INIT INITIALIZE AND GET ARGS
WRITEC OUT,PAGEJ PAGE EJECT
RJ READDMP READ DUMP DIRECTORY
RJ WRITEO OUTPUT LAST LINE IF ANY
WRITER OUT,R EOR ON OUTPUT
ENDRUN
TITLE SUBROUTINES
BUILDO SPACE 4
** BUILDO - BUILD OUTPUT LINE
BUILDO DATA 0 ENTRY/EXIT
SA1 OLDACC
SA2 BUFD
IX6 X1-X2 COMPARE OLD AND NEW ACCOUNTS
ZR X6,BUI1 IF THE SAME
BX6 X2 SAVE THIS NAME
SA6 A1
RJ WRITEO WRITE CURRENT LINE
BUI1 SA1 BUILDP GET POINTER
SB7 X1+
NZ B7,BUI2 IF LINE ALREADY STARTED
SA1 BUFD ACCOUNT NAME
RJ SFN
LX6 54
SA6 B7+BUILD
SB7 B1
BUI2 SA1 BUFD+1
RJ SFN
SA6 B7+BUILD
SA1 BUFD+2 SIZE
MX6 -6
LX1 12
BX1 -X6*X1
RJ CDD
SA1 BUFD+2
LX6 42
MX7 6
BX1 X7*X1
LX1 6
SA1 X1+FTYPE-1
MX7 24
BX6 X7*X6
BX6 X6+X1 ADD IN TYPE
SA6 B7+BUILD+1
SA1 SL
SB6 X1+ LINE LIMIT
SB7 B7+2
SX7 B7
SA7 BUILDP
LT B7,B6,BUILDO
RJ WRITEO WRITE OUTPUT LINE
EQ BUILDO
* /--- BLOCK BLIST 00 000 80/11/19 13.17
CKSTATS SPACE 4
** CKSTATS - CHECK FILE STATUS FOR BUSY
* ROLLOUT FOR 64 SECONDS IF BUSY
* ABORT IF ERROR
*
* ENTRY X1-FET STATUS WORD
*
* EXIT X2=0, NOT BUSY
CKSTATS DATA 0 ENTRY/EXIT
AX1 10
MX7 -8
BX2 -X7*X1 ISOLATE STATUS
ZR X2,CKSTATS IF NOT BUSY AND NO ERROR
SX2 X2-1
NZ X2,ABORT ATTACH ERROR
ROLLOUT CKSW
SX2 1 BUSY STATUS
EQ CKSTATS
CKSW DATA 7700000100B
CLREPR SPACE 4
** CLREPR - CLEAR ERROR PROCESSING BIT IN THE FET
*
* ENTRY A1/X1=FET+1 AND CONTENTS
CLREPR DATA 0 ENTRY/EXIT
SX6 B1 MASK FOR EPR
LX6 44
BX6 -X6*X1
SA6 A1
EQ CLREPR
GTW SPACE 4
** GTW - GET WORD
*
* THIS ROUTINE EXTRACTS UP TO TEN CHARACTERS FROM
* A CONTROL CARD AREA. 'ALL WORDS ARE SEPARATED
* BY DELIMITERS (ANY CHARACTER .GT. 9).
*
* ENTRY B1 = 1
* A4/X4 = CHARACTERS TO BE EXTRACTED FROM
* B6 = SHIFT COUNT (INITIALLY 0)
*
* EXIT X1 = WORD THAT WAS EXTRACTED
* X2 = DELIMITER
* IF X2 .LT. 0 - MORE THAN 10 CHARS IN WORD
* IF X2 .EQ. 0 - END OF CARD
* B5 = 60-(N*6) WHERE N IS THE NUMBER OF
* CHARACTERS FOUND IN THE WORD
* A4/X4/B6 SET FOR NEXT WORD
*
* USES A-4
* X-1,2,3,4
* B-5,6,7
GTW DATA 0 ENTRY/EXIT
MX1 0 INITIAL SETTINGS
SB5 60
SB7 B5
GTW1 SB6 B6+6 NEXT CHARACTER
GT B6,B7,GTW2 IF NEW WORD NEEDED
MX2 -6 CHARACTER MASK
LX4 6 SHIFT TO NEXT CHARACTER
BX2 -X2*X4
ZR X2,GTW END OF CARD
SX3 X2-1R9-1
PL X3,GTW IF DELIMITER
SB5 B5-6 DECREASE CHARACTER SHIFT COUNT
NG B5,GTW3 IF MORE THAN 10 CHARS.
LX2 X2,B5 SHIFT TO PROPER LOCATION
BX1 X1+X2 MERGE
EQ GTW1 GET NEXT CHARACTER
GTW2 SA4 A4+B1 GET NEXT WORD
SB6 B0
EQ GTW1
GTW3 BX2 -X2 ERROR FLAG
EQ GTW EXIT
* /--- BLOCK BLIST 00 000 80/11/25 06.48
INIT SPACE 4
** INIT - INITIALIZE
INIT DATA 0 ENTRY/EXIT
SETTL TIMEL SET TIME LIMIT
SETPR PRIOR SET PRIORITY
*
* GET ARGUMENTS
*
SA1 ACTR ARGUMENT COUNT
SB4 X1
SA4 ARGR FIRST ARGUMENT
SB5 ARGTBL ARGUMENT TABLE
RJ ARG
NZ X1,INITERR ERROR IN ARGUMENTS
SA1 INITM MODIFY COMCARG FOR 10 CHARS
BX6 X1
SA6 ARG5
SA1 Z SEE IF EXTENDED PARAMETERS
ZR X1,INIT1
SX5 CCDR CONTROL CARD AREA
RJ PRA EXTRACT EXTENDED PARAMETERS
NZ X6,INITERR IF ERROR IN CARD
SB5 ARGTBL ARG TABLE ADDRESS
RJ ARG
NZ X1,INITERR ERROR IN ARGUMENTS
*
* ATTACH PERMANENT FILES
*
INIT1 SETUI USERI USER INDEX
PACKNAM PACK SET PACKNAME
INIT2 ATTACH D,DPER,,,R
SA1 D
RJ CKSTATS
NZ X2,INIT2 IF FILE WAS BUSY
SA1 D+1
RJ CLREPR CLEAR EPR
SX6 13 DEFAULT LISTING LENGTH
SA1 SL
ZR X1,INIT3
SX6 5
INIT3 SA6 A1
MX7 0
SA7 X6+LINE1
EQ INIT
INITM BX7 X3+X6 INSTRUCTIONS MODIFIED AT ARG5
SA7 B2+
SB3 B2-B3
INITERR MESSAGE INMSG
EQ ABORT
PRA SPACE 4
** PRA - EXTRACT PARAMETERS BEYOND PERIOD
*
* EXTRACT PARAMETERS FROM CONTROL CARD AREA
*
* ENTRY B1 = 1
* X5 = ADDRESS OF CONTROL CARD
*
* EXIT X6 = 0 ALL OK, -1 IF ERROR
* ARGUMENTS AT ARGR
* A4/X4 = FIRST ARGUMENT
* B4 = NUMBER OF ARGUMENTS
*
* USES A-4
* X-1,2,3,4,6,7
* B-3,4,5,6,7
*
* CALLS GTW
PRA DATA 0 ENTRY/EXIT
SA4 X5 CONTROL CARD AREA
SB6 0 INITIAL SHIFT COUNT
PRA1 RJ GTW GET NEXT WORD
NG X2,PRAX ERROR - MORE THAN 10 CHARS.
ZR X2,PRAX ERROR - NULL WORD
SX7 X2-1R.
ZR X7,PRA2 IF PERIOD
SX7 X2-1R)
NZ X7,PRA1 IF NOT )
* /--- BLOCK BLIST 00 000 80/11/25 06.49
PRA2 SB3 ARGR LOCATION TO STORE ARGS
PRA3 RJ GTW GET NEXT WORD
NG X2,PRAX ERROR - MORE THAN 10 CHARS
ZR X1,PRA5 IF END OF CARD
SX7 X2-1R= SEE IF = IS DELIMITER
SX6 0
NZ X7,PRA4 IF NOT =
SB4 48
LT B5,B4,PRA4 IF NOT 1 OR 2 CHARACTERS
SX6 1R= ADD = CHARACTER TO WORD
PRA4 BX6 X6+X1 MERGE
SA6 B3 STORE ARGUMENT
SB3 B3+B1 ADVANCE ARG POINTER
NZ X2,PRA3 IF NOT END OF CARD
PRA5 SB4 B3-ARGR NUMBER OF ARGUMENTS
SA4 ARGR FIRST ARGUMENT
MX6 0 OK EXIT
EQ PRA
PRAX MX6 59 ERROR EXIT
EQ PRA
READDMP SPACE 4
** READDMP - READ DUMP DIRECTORY
*
* READS DUMP DIRECTORY - BUILDS OUTPUT
READDMP DATA 0 ENTRY/EXIT
RECALL D
REWIND D,R
READ D,R
WRITEC OUT,LINE1
WRITEC OUT,SPACE
RDD1 READW D,BUFD,BLDD READ ONE ENTRY
NZ X1,READDMP IF EOR, EOF
SA1 FILEN SEE IF FILE NAME SPECIFIED
ZR X1,RDD2 IF NONE
SA2 BUFD+1 GET THIS FILE NAME
IX6 X1-X2
NZ X6,RDD1 NOT PROPER FILE NAME
RDD2 SA1 ACCTN SEE IF ACCOUNT NAME SPECIFIED
ZR X1,RDD3 IF NONE
SA2 BUFD
MX6 36
BX1 X6*X1
IX6 X1-X2
NZ X6,RDD1 NOT PROPER ACCOUNT NAME
RDD3 SA1 TYPE SEE IF TYPE SPECIFIED
ZR X1,RDD4
SA2 BUFD+2
MX6 6
BX2 X6*X2
IX6 X1-X2
NZ X6,RDD1 IF WRONG TYPE
RDD4 RJ BUILDO BUILD OUTPUT LINE
EQ RDD1
WRITEO SPACE 4
** WRITEO - WRITE OUTPUT
*
* WRITE OUTPUT LINE IF ANY
* ZERO BUFFER
WRITEO DATA 0 ENTRY/EXIT
SA1 BUILD
ZR X1,WRITEO EXIT IF NOTHING TO WRITE
WRITEC OUT,BUILD WRITE OUTPUT LINE
SB6 BUILD
SB7 13
RJ ZERO ZERO BUILD BUFFER
SA7 BUILDP AND POINTER
EQ WRITEO
* /--- BLOCK BLIST 00 000 80/11/25 06.50
ZERO SPACE 4
** ZERO - ZERO BUFFER
*
* ENTRY B1=1
* B6=FWA
* B7=NUMBER OF WORDS TO ZERO
*
* EXIT X7=0
* BUFFER ZEROED
*
* USES A-7
* X-7
* B-6,7
ZERO DATA 0 EMTRY/EXIT
MX7 0
SB7 B7-B1
NG B7,ZERO
ZRO1 SA7 B6+B7
SB7 B7-B1
PL B7,ZRO1
EQ ZERO
ABORT MESSAGE (=C* RUN ABORTED.*)
ABORT
PAGEJ DIS ,*1* PAGE EJECT
SPACE DIS ,* * BLANK LINE
LINE1 DATA 30H ACCOUNT FILE NAME SZ TYPE
DATA 20HFILE NAME SZ TYPE
DATA 20HFILE NAME SZ TYPE
DATA 20HFILE NAME SZ TYPE
DATA 20HFILE NAME SZ TYPE
DATA 20HFILE NAME SZ TYPE
DATA 0
OLDACC DATA 0 OLD ACCOUNT NAME
BUILDP DATA 0 POINTER TO BUILD BUFFER
BUILD DATA 0,0,0,0,0,0 OUTPUT LINE BUILD AREA
DATA 0,0,0,0,0,0,0,0
FTYPE DATA 6RTUTOR FILE TYPES
DATA 6RBINAR
DATA 6RCURRI
DATA 6RDATA
DATA 6RCOMPA
DATA 6RGROUP
DATA 6RDATAS
DATA 6RPLMC
DATA 6RGNOTE
DATA 6RU(10)
DATA 6RNAMES
DATA 6RACCOU
DATA 6RCATAL
DATA 6RU(14)
DATA 6RMODUL
DATA 6RPNOTE
DATA 6RDOCUM
DATA 6RU(18)
DATA 6RU(19)
DATA 6RU(20)
DATA 6RU(21)
DATA 6RU(22)
DATA 6RU(23)
DATA 6RU(24)
DATA 6RU(25)
DATA 6RU(26)
DATA 6RU(27)
DATA 6RU(28)
DATA 6RU(29)
DATA 6RU(30)
DATA 6RU(31)
DATA 6RU(32)
DATA 6RU(33)
DATA 6RU(34)
DATA 6RU(35)
DATA 6RU(36)
DATA 6RU(37)
DATA 6RU(38)
DATA 6RU(39)
DATA 6RU(40)
DATA 6RU(41)
DATA 6RU(42)
DATA 6RU(43)
DATA 6RU(44)
DATA 6RU(45)
DATA 6RU(46)
DATA 6RU(47)
DATA 6RU(48)
DATA 6RU(49)
DATA 6RU(50)
DATA 6RU(51)
DATA 6RU(52)
DATA 6RU(53)
DATA 6RU(54)
DATA 6RU(55)
DATA 6RU(56)
DATA 6RU(57)
DATA 6RU(58)
DATA 6RU(59)
DATA 6RU(60)
DATA 6RU(61)
DATA 6RU(62)
DATA 6RU(63)
* /--- BLOCK BLIST 00 000 81/04/29 08.45
*
* ARGUMENT TABLE
*
INMSG DIS ,* ERROR IN PARAMETERS.*
ARGTBL BSS 0
* VFD 12/2LSP,18/PACK,30/PACK
* VFD 12/2LDP,18/DPER,30/DPER
VFD 12/1LZ,18/ONE,30/Z
VFD 12/2LSL,18/ONE,30/SL
VFD 12/2LFN,18/FILEN,30/FILEN
VFD 12/2LAN,18/ONE,30/ACCTN
VFD 12/2LTY,18/TYPE,30/TYPE
ARGTBLE DATA 0 END OF TABLE
****
CDDX DATA 0
RJ CDD
SA6 DBUG
MESSAGE DBUG
EQ CDDX
SHOW DATA 0
BX6 X1
SA6 DBUG
RJ WOD
SA6 OCT
SA7 OCT+B1
MESSAGE OCT
EQ SHOW
OCT DATA 0
DATA 0
DBUG DATA 0
DATA 0
****
SPACE 4
* COMMON DECKS.
*CALL COMCCIO
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCSYS
*CALL COMCWTS
*CALL COMCWTW
*CALL COMCCDD
*CALL COMCSFN
*CALL COMCWTC
*CALL PLACARG
*CALL COMCWOD
*CALL COMCCPM
*CALL COMCPFM
SPACE 4
** BUFFERS.
BUFFERS BSS 0
BSS 1
BUFD BSS BLDD
DBUF BSS DBUFL
OUTBUF BSS OUTBUFL
END BACKLST