plato:source:plaopl:backlst
Table of Contents
BACKLST
Table Of Contents
- [00010] PRODUCE BACKUP LIBRARY PRINTOUT
- [00012] PRODUCE BACKUP LIBRARY PRINTOUT
- [00054] COMMON DATA
- [00081] MAIN PROGRAM.
- [00092] SUBROUTINES
- [00094] BUILDO - BUILD OUTPUT LINE
- [00141] CKSTATS - CHECK FILE STATUS FOR BUSY
- [00163] CLREPR - CLEAR ERROR PROCESSING BIT IN THE FET
- [00175] GTW - GET WORD
- [00224] INIT - INITIALIZE
- [00277] PRA - EXTRACT PARAMETERS BEYOND PERIOD
- [00329] READDMP - READ DUMP DIRECTORY
- [00365] WRITEO - WRITE OUTPUT
- [00382] ZERO - ZERO BUFFER
Source Code
- BACKLST.txt
- 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
plato/source/plaopl/backlst.txt ยท Last modified: 2023/08/05 18:54 by Site Administrator