         PCC      0
         SYSTEM   SIG7
*
*M*      BACKUP   FILE SAVING MODULE OF THE FILL PROCESSOR
*
*
*P*      NAME:    BACKUP
*P*
*P*      PURPOSE: TO SAVE PUBLIC FILES ON PERMANENT DISC STORAGE TO
*P*               SECONDARY TAPE STORAGE.  FILES ARE SAVED ON THE BASIS
*P*               OF WHETHER A CURRENT BACKUP ALREADY EXISTS OR NOT;
*P*               IT IS ALSO POSSIBLE TO SAVE THE ENTIRE FILE SYSTEM.
*P*               INDIVIDUAL USERS MAY ALSO INITIATE A SYSTEM BACKUP
*P*               OF INDIVIDUAL FILES.
*P*
*P*      DESCRIPTION:  THERE ARE THREE MODES OF BACKUP:  SAVEALL,
*P*               INCREMENTAL, AND SQUIRREL.
*P*
*P*               SAVEALL CAUSES THE ENTIRE FILE SYSTEM TO BE SAVED.
*P*
*P*               INCREMENTAL SEARCHES THE FILE SYSTEM AND CAUSES FILES
*P*               THAT HAVE BEEN CREATED OR MODIFIED SINCE THE LAST
*P*               SAVEALL OR INCREMENTAL WAS COMPLETED TO BE SAVED.
*P*               IN ADDIDTION, A RECORD OF ALL FILES CURRENTLY ON THE
*P*               SYSTEM IS MAINTAINED ON THE INCREMENTAL TAPES.
*P*
*P*               SQUIRREL CAUSES FILES THAT HAVE BEEN CREATED OR MODI-
*P*               FIED SINCE THE LAST SAVEALL, INCREMENTAL, OR SQUIRREL
*P*               WAS COMPLETED TO BE SAVED.
*P*
*P*               USER-INITIATED BACKUP IS A FORM OF A SQUIRREL OPER-
*P*               ATION.
*P*
*P*               EACH OF THESE FUNCTIONS MAY BE AUTOMATICALLY SCHED-
*P*               ULED BY CREATING THE BACK:SCHED FILE IN :SYS; IN
*P*               ADDITION, THE OPERATOR MAY BEGIN THE OPERATION WITH
*P*               THE APPROPRIATE COMMAND TO THE FILL PROCESSOR.
*P*
*P*               FILES ARE SELECTED FOR THE INCREMENTAL AND SQUIRREL
*P*               OPERATIONS BY USING THE TESTFILE OPEN AND EXAMINING
*P*               THE FILE DESCRIPTORS RETURNED BY THE CAL.  THE FILE
*P*               MANAGEMENT SYSTEM REMEMBERS THAT THE FILE HAS BEEN
*P*               MODIFIED AND AND WHETHER OR NOT IT HAS BEEN BACKED UP
*P*               IN ITS CURRENT FORM.  IF THE FILE HAS BEEN MODIFIED
*P*               AND NOT BACKED UP, IT WILL BE SAVED TO TAPE.
*P*
*P*               IF AN INCREMENTAL IS RUNNING AND THE FILE WAS SAVED
*P*               BY A PREVIOUS SQUIRREL, THE FILE WILL BE SAVED ON THE
*P*               INCREMENTAL WHETHER OR NOT IT HAS SINCE BEEN CHANGED.
*P*               THUS AN INCREMENTAL IS A SUPERSET OF THE SQUIRREL,
*P*               AND A SAVEALL IS A SUPERSET OF BOTH INCREMENTAL
*P*               AND SQUIRREL.  ONCE AN INCREMENTAL HAS BEEN TAKEN,
*P*               PREVIOUS SQUIRRELS ARE REDUNDANT.
         PAGE
*
*        ALL THE DEFS IN BACKUP FOLLOW
*
         DEF      AUTOBACK          SUBROUTINE THAT WRITES THE FILE
*,*                                 FROM DISC TO LABEL TAPE
         DEF      BACKUP            DEF FOR PATCHING BACKUP PROCEDURE
         DEF      BACKUPD           DEF FOR PATCHING BACKUP DATA
         DEF      BACKXT            WORD USED AS TEMPORARY STORAGE FOR
*,*                                 RETURN ADDRESS BY VARIOUS ROUTINES
         DEF      BB1               ENTRY POINT TO BACKUP PROCESSING
*,*                                 THAT BEGINS WITH READING THE
*,*                                 BACK:SCHED FILE
         DEF      BCK:ABN           ABN ROUTINE FOR THE F:BACKUP DCB
         DEF      BCK:ERR           ERR ROUTINE FOR THE F:BACKUP DCB
         DEF      BLABL             FIRST WORD OF THE USER LABEL WRITEN
*,*                                 ON A LABEL TAPE OPEN
         DEF      BLANKS            SUBROUTINE WHICH PERFORMS BLANK
*,*                                 FILLING OF SPECIFIED BUFFER
         DEF      BLDMAIL           WORD GOVERNING WHETHER OR NOT
*,*                                 MAILBOXES WILL BE BUILT
         DEF      BREC:ABN          ABN ROUTINE FOR THE F:BREC DCB
         DEF      BREC:ERR          ERR ROUTINE FOR THE F:BREC DCB
         DEF      BSR1              ERR/ABN ROUTINE THAT RETURNS TO
*,*                                 CAL + 1 (INDIRECT ON R8)
         DEF      BUF               WORD CONTAINING THE ADDRESS OF THE
*,*                                 FIRST WORD OF THE USER-DATA BUFFER
         DEF      BUFSZ             WORD CONTAINING THE CURRENT SIZE
*,*                                 OF THE USER-DATA BUFFER (IN BYTES)
         DEF      CLORGSIZ          INPUT WORD TO 'BLANKS' WHICH ZAPS
*,*                                 THE SIZE AND ORG FIELDS OF PRINTLIN
         DEF      CONACCT           LOCATION OF CURRENT ACCOUNT BEING
*,*                                 PROCESSED BY FILL, PURGE, OR BACKUP
         DEF      DATACCT           ACCOUNT NAME FOR DAT FILE ON TAPE
         DEF      DEFAULT           WORD CONTAINING THE INITIAL SIZE,
*,*                                 IN PAGES, OF THE USER-DATA BUFFER
         DEF      DENSITY           WORD CONTAINING THE DENSITY AT
*,*                                 WHICH BACKUP TAPES ARE TO BE WRIT-
*,*                                 TEN (800 BPI OR 1600 BPI)
         DEF      DO:REGS4          SUBROUTINE THAT INITIALIZES REG-
*,*                                 ISTERS 0 - 3 WITH THE CONSTANTS
*,*                                 0 - 3, RESPECITVELY; THIS REGISTER
*,*                                 CONVENTION IS OBSERVED IN THE FILL
*,*                                 MODULES BACKUP, FILL, AND PURGE
         DEF      DO:TIME           SUBROUTINE THAT FORMATS THE TIME
*,*                                 AS YDDDHHMM AND PUTS IN 'CURRENT'
         DEF      DUMMY             SUBROUTINE THAT PROVIDES A DUMMY
*,*                                 VLP FOR OPEN FPTS WHEN A REAL ONE
*,*                                 OF THE DESIRED FLAVOR IS MISSING
         DEF      ENDTAPE           ENTRY POINT TO THE ZAPTAPE ROUTINE
*,*                                 WHICH NORMALLY COMPLETES A BACKUP
*,*                                 TAPE SET
         DEF      ENVIR             35 WORD PUSH-DOWN STACK
         DEF      EOACCT            ACCOUNT NAME FOR USER FILE (TAPE)
         DEF      ERR49             ENTRY POINT TO PROCESS 49 ERRORS
         DEF      ERR55             ENTRY POINT TO PROCESS 55 ERRORS
         DEF      FPAR              FIRST WORD OF BUFFER USED TO RE-
*,*                                 CEIVE FPARAM INFORMATION ON OPEN
         DEF      GETBUF            SUBROUTINE WHICH HANDLES ACQUIRING
*,*                                 CORE FOR THE USER-DATA BUFFER
         DEF      INCRMNTL          ENTRY POINT TO BEGIN AN INCREMENTAL
         DEF      INITSTK           DOUBLEWORD CONTAINING THE INITIAL
*,*                                 SPD FOR THE 'ENVIR' STACK
         DEF      ITHRESH           INITIAL VALUE OF GRANULE THRESHOLD
*,*                                 WHICH IS MAINTAINED WHEN WORKING
*,*                                 THRESHOLD (THRESH) IS LOWERED
         DEF      LASTACCT          THE LAST ACCOUNT WHICH WAS SUCCESS-
*,*                                 FULLY BACKED UP
         DEF      LASTREEL          WORD CONTAINING THE SERIAL NUMBER
*,*                                 LAST USED BY THE BACKUP PROCESS
         DEF      LASTREELX         WORD CONTAINING THE LAST REEL NUM-
*,*                                 BER WRITTEN TO THE F:BREC FILE
         DEF      LASTRUN           WORD CONTAINING THE CODE FOR THE
*,*                                 CURRENTLY RUNNING FILL OPERATION
         DEF      LOCCODE           SUBROUTINE TO FIND DESIRED VLP FROM
*,*                                 THE FPAR BUFFER
         DEF      LOCCODE1          ENTRY POINT TO LOCCODE ROUTINE
*,*                                 WHICH LOCATES DESIRED VLP FROM A
*,*                                 SUPPPLIED BUFFER, IE NOT FPAR
         DEF      MAIL:AC           DOUBLEWORD CONTAINING THE ACCOUNT
*,*                                 TO BE USED BY THE MAILBOX ROUTINE
*,*                                 AS DESTINATION FOR MAILBOX FILE
         DEF      MOVEVLP           SUBROUTINE TO MOVE A VLP INTACT
*,*                                 FROM ONE PLACE TO ANOTHER
         DEF      MTIME             WORD CONTAINING THE TIME LAST USED
*,*                                 BY THE MAILBOX ROUTINE (HHMM)
         DEF      NMPG              HALFWORD CONTAING THE CURRENT SIZE
*,*                                 OF THE USER-DATA BUFFER (IN PAGES)
         DEF      NOTAPE            ENTRY POINT WHICH INITIALIZES THE
*,*                                 TAPE OPEN WHEN TAPE IS NOT MOUNTED
         DEF      NOTAPFG           WORD CONTAINING STATUS OF CURRENT
*,*                                 BACKUP TAPE (NON-ZERO => MOUNTED)
         DEF      OCDISP            WORD GOVERNING WHETHER OR NOT THE
*,*                                 CURRENT ACCOUNT IS DISPLAYED ON OC
         DEF      OPSMSG            SUBROUTINE TO WRITE MESSAGES ON THE
*,*                                 OPERATOR'S CONSOLE
         DEF      ORGMBS            DOUBLEWORD MBS PAIR TO MOVE 'ORG'
*,*                                 INTO PBUFFER
         DEF      ORGTBL            TABLE OF TEXT FOR THE VARIOUS
*,*                                 FILE ORGANIZATIONS
         DEF      PBUFFER           BUFFER USED TO CONTAIN MESSAGES
*,*                                 DESTINED FOR THE LINE PRINTER
         DEF      PGINCRM           WORD CONTAINING THE NUMBER OF PAGES
*,*                                 AS THE FIRST ADDITION THE THE USER-
*,*                                 DATA BUFFER (OVER AND ABOVE THAT
*,*                                 CONTAINED IN DEFAULT) IN THE CASE
*,*                                 OF A DATA OVERRUN ABNORMAL
         DEF      PRINT             FPT TO PRINT TEXTC FROM PBUFFER
         DEF      PRINTLIN          SUBROUTINE TO FORMAT PBUFFER TO
*,*                                 CONTAIN FILE NAME, ACCOUNT, SIZE,
*,*                                 ORGANIZATION, AND REEL NUMBER
         DEF      PBUFINIT          WORD USED BY BLANKS ROUTINE
*,*                                 TO BLANK FILL PRINT BUFFER
         DEF      PURGTAP           WORD CONTAINING THE DISPOSITION OF
*,*                                 FILES DELETED DURING PURGE
         DEF      QUIT              ENTRY POINT TO TERMINATE THE CUR-
*,*                                 RENT OPERATION
         DEF      REELTMP           WORD USED TO TEMPORARILY HOLD THE
*,*                                 CURRENT TAPE SERIAL NUMBER
         DEF      REGS              16 WORD BUFFER FOR REGISTER STOR-
*,*                                 AGE (USUALLY FOR SNAPPER)
         DEF      RELEASE           SUBROUTINE TO RELEASE THE DATA BUFFER
         DEF      RESTART           ENTRY POINT TO RESTART A SUSPENDED
*,*                                 OPERATION
         DEF      SAVEALL           ENTRY POINT TO BEGIN A SAVEALL
         DEF      SAVEBUF           BUFFER CONTAINING REMEMBERED FILL OPTIONS
         DEF      SAVESIZ           SIZE OF SAVEBUF IN WORDS
         DEF      SEND:ERR          SUBROUTINE TO PRINT FAILURE MESSAGES
*,*                                 FROM BACKUP AND FILL
         DEF      SETHEADR          SUBROUTINE TO INITIALIZE THE TITLE
*,*                                 LINE ON LINE PRINTER OUTPUT
         DEF      SLP:FPT           WORD CONTAINING THE FPT FOR SLEEP
         DEF      SNAPPER           SUBROUTINE WHICH SNAPS THE CURRENT
*,*                                 FILL DATA FOR DIAGNOSTIC USE
         DEF      SQMOUNT           WORD GOVERNING WHETHER OR NOT TAPES
*,*                                 FOR USER-BACKUP ARE LEFT MOUNTED
         DEF      SQUIRREL          ENTRY POINT TO BEGIN A SQUIRREL
         DEF      SUSPACCT          DOUBLEWORD CONTAINING THE ACCOUNT
*,*                                 WHICH WAS CURRENT AT THE TIME OF
*,*                                 THE SUSPENSION
         DEF      SUSPEND           ENTRY POINT TO SUSPEND THE CURRENT
*,*                                 OPERATION
         DEF      SUSPNDED          WORD CONTAINING THE CODE OF THE
*,*                                 SUSPENDED OPERATION
         DEF      TAP:ABN           ABN ROUTINE FOR THE F:EO DCB
         DEF      TAP:ERR           ERR ROUTINE FOR THE F:EO DCB
         DEF      TAPETYP           WORD CONTAINING THE CURRENT DEVICE
*,*                                 TYPE OF TAPES TO BE USED BY FILL
         DEF      THRESH            WORD CONTAINING THE CURRENT PUBLIC
*,*                                 FILE STORAGE GRANULE THRESHOLD
         DEF      TRAPPER           ENTRY POINT FOR ALL FILL TRAPS
         DEF      TVLPTBL           TABLE CONTAINING THE VLPS TO BE
*,*                                 USED AS PART OF THE TAPE OPEN
         DEF      TVLPTSZ           ABS VALUE OF THE NUMBER OF ENTRIES
*,*                                 IN THE TVLPTBL
         DEF      USERBKUP          WORD GOVERNING WHETHER OR NOT USER-
*,*                                 INITIATED BACKUP WILL BE ALLOWED
         DEF      USR:ABN           ABN ROUTINE FOR THE F:EI DCB
         DEF      USR:ERR           ERR ROUTINE FOR THE F:EI DCB
         DEF      VLPTBL            TABLE CONTAINING THE VLPS TO BE
*,*                                 USED IN THE USER LABEL OF TAPE OPEN
         DEF      VLPTSIZ           ABS VALUE OF THE NUMBER OF ENTRIES
*,*                                 IN THE VLPTBL
         DEF      WRT:SAV           SUBROUTINE WHICH SAVES THE CURRENT
*,*                                 INFORMATION IN THE SAVEREC BUFFER
*,*                                 BY WRITING IT TO THE F:BREC FILE
         DEF      ZAPTAPE           SUBROUTINE TO ABNORMALLY CLOSE
*,*                                 OUT A BACKUP TAPE SET
         PAGE
*
*        ALL THE REFS IN BACKUP FOLLOW
*
         REF      BADCOM            RETURN TO PURGE IF AN INCONSIS-
*,*                                 TENCY IN COMMAND IS DETECTED (IE,
*,*                                 'QUIT' WHEN NOTHING IS ACTIVE)
         REF      BINTODEC          CONVERTS HEX FILE SIZE TO DECIMAL
         REF      DATEAD            OBTAIN CURRENT DATE FOR INCLUSION
*,*                                 IN USER-LABEL ON TAPE
         REF      DEBUG             IF DEBUG WORD IS NON-ZERO, THE
*,*                                 BUFFER ACQUISITION ROUTINE (GETBUF)
*,*                                 ASSUMES PRESENCE OF DELTA SYMBOL
*,*                                 PAGE AND ACTS ACCORDINGLY.  ALSO,
*,*                                 DESCRIPTORS ARE NOT MODIFIED ON
*,*                                 DISC IF DEBUG IS NON-ZERO
         REF      DOPURLIST         WHEN BACKING UP A FILE FOR PURGE,
*,*                                 CALL THIS ROUTINE TO MAKE A LINE
*,*                                 PRINTER MESSAGE AND A MAILBOX
         REF      EI:DESC           VARIOUS BITS ARE CHECKED TO SEE IF
*,*                                 FILE IS ELIGIBLE FOR BACKUP
         REF      F:BACKUP          DCB USED TO READ F:BACKUP FILE
         REF      F:BREC            DCB USED TO READ F:BREC FILE
         REF      F:EI              DCB USED TO READ DISC FILE TO
*,*                                 BE SAVED TO TAPE
         REF      F:EO              DCB USED TO WRITE TAPE FILE WHICH
*,*                                 IS THE DISC FILE'S BACKUP
         REF      F:SEL             DCB USED TO READ SEL:FIL FILE
         REF      F:TI              DCB USED TO REMOVE A FILL TAPE
*,*                                 ON A QUIT COMMAND
         REF      F:USR             DCB USED TO PROVIDE INFORMATION
*,*                                 FOR FILE DELETED DURING A FILL
         REF      F:1               DCB USED TO READ BACK:SCHED FILE
         REF      FILL              ENTER FILL ROUTINE TO PROCESS A
*,*                                 'BEGIN FILL' COMMAND
         REF      FMAILBX           ENTRY POINT TO MAILBOX ROUTINE
*,*                                 WHICH BYPASSES THE M:TIME CAL
*,*                                 (IS, THEREFORE, FASTER)
         REF      GETCOM            GET NEW COMMAND IF NOTHING TO QUIT
         REF      INT               CHECKED FOR BEING NON-ZERO AT VAR-
*,*                                 IOUS POINTS TO DETERMINE IF THE
*,*                                 OPERATOR WANTS TO DISCUSS SOMETHING
         REF      J:JIT             ADDRESS OF FILL'S JIT FOR A SNAP
         REF      JULIAN            CONVERT M:TIME TIME TO JULIAN TIME
         REF      KEYIN             FPT USED TO REQUEST INPUT THRU OC
         REF      M:LL              DCB USED TO PRINT LINE PRINTER STUFF
         REF      MAILBOX           TELL THE USER THAT HIS FILE HAS
*,*                                 A.  BEEN BACKED UP PER REQUEST
*,*                                 B.  BEEN FILLED PER REQUEST
*,*                                 C.  NOT BEEN BACKED UP FOR SOME
*,*                                     SPECIFIED REASON
         REF      NO:FILL           ENTRY POINT TO FILL WHICH CLEANS
*,*                                 UP AND GOES TO SLEEP WHEN BACKUP IS
*,*                                 FINISHED
         REF      NOPRINT           WORD IS SET NON-ZERO TO SUPPRESS
*,*                                 MAILBOX DUPLICATING LINE PRINTER
*,*                                 INFORMATION DURING BACKUP
         REF      PURDYN            LOCATION OF FIRST WORD OF 'PURGE
*,*                                 UNTIL' BUFFER TO BE SNAPPED
         REF      PURGE             ROUTINE ENTERED TO CHECK FOR
*,*                                 THRESHOLD EVENTS OR TO RESPOND TO
*,*                                 AN OPERATOR INTERRUPT OF PROCESSING
         REF      PURGEFLAGAD       FLAG SET TO TELL ALLYCAT THAT
*,*                                 HE CAN REST EASY FOR A WHILE AS FAR
*,*                                 AS THRESHOLDS AND THAT SORT OF
*,*                                 THING ARE CONCERNED
         REF      SAVKEY            USED TO UPDATE F:BREC FILE
         REF      SEL:BUF           LOCATION OF THE FIRST WORD OF
*,*                                 SELFIL BUFFER TO BE SNAPPED
         REF      SEL:MT            ROUTINE ENTERED TO 'QUIT' A SEL-
*,*                                 ECTIVE FILL OPERATION
         REF      SELFILL           ENTRY POINT TO FILL FOLLOWING A
*,*                                 'BEGIN SELECTIVE FILL' COMMAND
         REF      SELKEY            PRESENCE OF RECORD WITH THIS KEY
*,*                                 IN F:BREC FILE => A SELECTIVE
*,*                                 FILL OPERATION IS TO BE DONE
         REF      SL:THRS           INITIAL THRESHOLD VALUE SUPPLIED
*,*                                 DURING PASS2 SYSTEM GENERATION
         REF      SLAVE             RETURN TO SLAVE MODE FROM MASTER
         REF      SYS               ENTER MASTER MODE TO SET DENSITY
*,*                                 BIT IN F:EO DCB
         REF      TAPETYPE          BASE OF TABLE CONTAINING DOUBLE-
*,*                                 WORD MBS INSTRUCTION PAIRS WHICH
*,*                                 FORMAT VARIOUS MESSAGES RELATIVE
*,*                                 TO THE CURRENT TYPE OF TAPE AND/OR
*,*                                 OPERATION (EG, FSAVE,SQUIRREL,ETC.)
         REF      TIMEAD            OBTAIN CURRENT TIME FOR INCLUSION
*,*                                 IN USER-LABEL ON TAPE
         REF      TRUNC             FPT USED TO TRUNCATE THE BUFFER
*,*                                 OF A DCB WHICH WON'T BE USED A WHILE
         REF      TYPE              FPT USED TO PRINT STUFF ON OC
         REF      USER:FPAR         FPARAM BUFFER TO PROVIDE LINE
*,*                                 PRINTER INFORMATION FOR A FILE
*,*                                 DELETED DURING FILL OF INCREMENTAL
         PAGE
DATA     CSECT    0
PURE     CSECT    1
**                DEFINE STANDARD REGISTERS AND CONDITION CODES
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
**  DISPLACEMENT VALUES FOR DCB
RWS      EQU      13                ACTUAL NUMBER OF BYTES READ
KEYM     EQU      12
VPT:SIZ  EQU      112
SUPER:CLOSE EQU   6
BLABSZ   EQU      64
         TITLE    '  **  DATA  **  '
         USECT    DATA
BACKUPD  RES      0
INITSTK  DATA     ENVIR+1           INITIAL STACK DOUBLEWORD
         GEN,16,16  35,0
ENVIR    DATA     %+1
         GEN,16,16  35,0
         RES      35
         TEXT     ' REGISTERS: '
REGS     RES      16                BUFFER FOR TRAP OR SNAP REGS
DATE:TIME RES     4
MTIME    DATA     0                 HHMM LAST MAILBX M:TIME
RELF     DATA     0                 RELEASE EXCESS PAGES FLAG
BREC:CT  DATA     10
BUFSZ    DATA     0                 BUFFER SIZE
BUF      DATA     0                 BUFFER LOC
NMPG     DATA     0                 NUMBER OF PAGES
BUF:OUT  DATA     0                 INDIRECT WORD FOR OUTPUT BUFFER
MINUTE   EQU      50
HLFHR    EQU      30*MINUTE
FOREVER  EQU      HLFHR
MAX:SLP  EQU      15*MINUTE         MAXIMUM SLEEP PERIOD(SEC0NDS)
SLP:FPT  GEN,8,24        X'F',0
GET:CM   GEN,1,7,24   1,X'0C',R5
FREE:CM  GEN,1,7,24   1,X'0D',R5
DEFAULT  EQU      %
         PZE      10                INITIAL 5K BUFFER
PGINCRM  EQU      %
         PZE      60                30K INCREMENT FOR BUFFER
BIGBUF   PZE      0
BUFCHG   PZE      0
GET:DY   GEN,8,24 X'08',0
REL:DY   GEN,8,24 X'09',0
         BOUND    8                 KEEP AN ODD WORD AHEAD OF
CURRENT  PZE                         BLABL TO DOUBLE WORD ALIGN
*                                     ACCOUNT AND DATE FILEDS.
BLABL    GEN,8,24 BLABSZ*4-1,0
         RES      BLABSZ-1
BCK:KEY  TEXTC    'BACKUP'
DYPAGES  DATA     -1
PAGE     PZE
PAGES    PZE
NUACT    DATA     0                 1=NEW ACCT IN :BREC,WRITE IT
COUNT    RES      1
MAIL:AC  RES      2
MAILPAR  PZE      MAILBUF
         PZE      MAIL:AC           RECIPIENT ACCOUNT
MAILERR  PZE      ERRBUF
         PZE      MAIL:AC
ACCTMBS  GEN,8,24 8,BA(PBUFFER)+2
CLORGSIZ GEN,8,24 13,BA(PBUFFER)+44
PBUFINIT GEN,8,24 25*4-1,BA(PBUFFER)+1
PBUFFER  RES      25
REELBUF  EQU      PBUFFER+15
FAILMSG  TEXT     '  *FAILED*  ERROR CODE:     '
ERRCODE  EQU      %-1
HEADER   DATA     X'534040C1'
         TEXT     'CCOUNT   FILE NAME  '
         TEXT     '                        '
         TEXT     'SIZE  ORG   REEL    '
HEADATE  RES      4                 SPACE FOR CURRENT TIME
MAILBUF  TEXTC    'BACKED UP  '
         RES      12
ERRBUF   TEXTC    'BACKUP OF  '
         RES      15
MAIL1    TEXTC    ' ON REEL '
TROUBL   TEXTC    'BACKUP TAPE INACCESSIBLE-BACKUP TERMINATED'
NOTAPMSG TEXTC  'FILL UNABLE TO OPERATE-NO TAPES AVAILABLE'
ACCTMSG  TEXTC    'ACCT =         '
CONACCT  EQU      %-2
SCHED:OVF EQU     %
  TEXTC 'BACK:SCHED CONTAINS MORE THAN 47 ENTRIES-EXCESS IGNORED'
UBKUPMSG TEXTC    'USER-INITIATED BACKUP REQUESTED'
FILLABRT TEXTC    'FILL GHOST ABORTING'
ERROR    TEXTC    'ERROR SNAP'
STARTXT  TEXTC    ' STARTED AT '
RESTRTXT TEXTC    ' RESTARTED AT '
SUSPTXT  TEXTC    ' SUSPENDED AT '
COMPLTXT TEXTC    ' COMPLETED AT '
TERMTXT  TEXTC    ' TERMINATED AT '
*
STARTBL  DATA     BA(STARTXT)
         DATA     BA(RESTRTXT)
         DATA     BA(SUSPTXT)
         DATA     BA(COMPLTXT)
         DATA     BA(TERMTXT)
*
ORGTBL   TEXT     ' SYN'
         TEXT     ' CON'
         TEXT     ' KEY'
         TEXT     ' RAN'
         BOUND    8
FID:MBS  DATA     BA(F:EI+22)
         GEN,8,24 (9+3+3)*4,BA(VPT:EI)
ADJ:MBS  DATA     BA(F:EI+23)
         GEN,8,24 8*4,BA(ADJ:FID)
SIZMBS   DATA     D3*4
         GEN,8,24 8,BA(PBUFFER)+44
ORGMBS   DATA     D3*4
         GEN,8,24 4,BA(PBUFFER)+53
ERRMBS   DATA     BA(FAILMSG)
         GEN,8,24 28,BA(PBUFFER)+64
         PAGE
*
*        SAVEBUF CONTAINS THE SAVED OPTIONAL PARAMETERS OF FILL.
*        THE DATA IS SAVED IN THE 'SAVREC' RECORD OF THE F:BREC
*        FILE. THIS RECORD IS UPDATED ANY TIME ANY OF THESE
*        ENTRIES CHANGES.  CHANGES ARE AFFECTED BY 'INT,FILL' WITH
*        FOLLOWING SET COMMANDS.
*
SAVEBUF  EQU      %
LASTRUN  PZE
LASTREEL PZE
LASTACCT DATA     0,0
TAPETYP  DATA     X'F9E3'           9T IS DEFAULT
DENSITY  PZE      1                 0 => 1600 BPI, 1 => 800 BPI
USERBKUP PZE      1                 !BACKUP BY USER WILL BE HONORED IF 1
SQMOUNT  PZE      1                 IF 1, LEAVE SQ TAPE MOUNTED.
BLDMAIL  PZE      1                 IF 1, BUILD MAILBOX FILES
OCDISP   PZE      1                 1 => DISP ACCT ON OC
PURGTAP  PZE      2                 0 => NONE, 1 => ONE, 2 => SELECT
SUSPNDED PZE                        LOCATION FOR SUSPENDED OP CODE
SUSPACCT DATA     0,0
SQREEL   PZE                        SERIAL NUMBER OF REMOUNTABLE
*                                    SQUIRREL TAPE FOR USER BACKUP.
THRESH   DATA     SL:THRS
ITHRESH  DATA     SL:THRS
         RES      5                 ADD A 5 WORD PATCH TO BUFFER
SAVESIZ  EQU      %-SAVEBUF
         PAGE
LASTREELX DATA     0              LAST REEL NO. SAVED IN 'SAV'
NOTAPFG  DATA     0
SQREELX  DATA     0
SAVE:TYPE DATA    0                 TPY STOR SC:TYPE DURING USR:BLK RUN
USRFLG   PZE
BACKXT   PZE
FTAPX    DATA     0
ABNEXIT  PZE
CVOLFLAG PZE
REELTMP  DATA     0                 TEMP STORE FOR DDD OF REEL NO
TAP:FILCNT DATA   0                 NBR FILES ON TAPE
DESC:MASK DATA    X'F7FEFF',X'F1FEFF',X'F3FEFF',X'F7FEFF'
** DATA FOR READING BACKUP SCHEDULE -READ:SCH
SC:TYPE  RES,1    48                TYPE TO MATCH ENTRY IN SCHED
SCHED    PZE
         RES      48
TYPES    TEXTC    'ANQ'             LEGAL SECOND CHARACTERS OF BACK:SCHED
SCHED:PT PZE      1                 CURRENT ENTRY IN SCHED
SVX11    PZE      0
NTRY     RES      20                BUFFER FOR SCHED INPUT
         TEXT     ',   '
TMPTYPE  RES,1    1                 TEMP STORAGE FOR TYPE
TMPCHR   RES,1    3                 CHARS OF TIME
NULTYPS  PZE
NSCHED   PZE                        NUMBER OF ENTRIES IN SCHED
MY002    DATA     X'00200000'
         TITLE    '  **  FPT  **  '
FPT:EI   GEN,8,7,17      X'14',0,F:EI
         DATA     X'C0200009'
         DATA     USR:ERR
         DATA     USR:ABN
         DATA     FPAR
DESC:FPT DATA     X'11000101',0     DESC VLP
VPT:EI   RES      9+3+3+3           NAME,ACCOUNT,PASSWORD,BACKUP DATE
FPAR     RES      VPT:SIZ
         SPACE    2
MOV:FPT  GEN,8,7,17    X'0E',,F:EI    FPT CODE & INPUT DCB
         DATA     X'F8000001'
         DATA     FPTERR            ERROR RETURN
         DATA     FPTABN            ABNORMAL RETURN
         DATA     F:EO              OUTPUT DCB
         PZE      *BUF
BUF:RDZ  DATA     0                 BUFFER SIZE
         SPACE    2
CLOSEI   GEN,8,24 X'15',F:EI
         GEN,1,31 1,0
         DATA     2
         SPACE    2
OPENEI   GEN,8,24 X'14',F:EI
         DATA     0
OPNFLAG  DATA     0
         PAGE
EO:VOL:ADJ EQU    %
         GEN,8,24 X'14',F:EO
         DATA     X'6000'
         DATA     X'10040'
EO:VOL   DATA     0
SN:EO    DATA,1   7,1,36,36
         DATA  '   0','   1','   2','   3','   4','   5','   6','   7'
         DATA  '   8','   9','   A','   B','   C','   D','   E','   F'
         DATA  '   G','   H','   I','   J','   K','   L','   M','   N'
         DATA  '   O','   P','   Q','   R','   S','   T','   U','   V'
         DATA  '   W','   X','   Y','   Z'
         SPACE    2
FPT:EO   GEN,8,24 X'14',F:EO
         DATA     X'C75C023A'
         DATA     TAP:ERR
         DATA     TAP:ABN
EO:ORG   DATA     1
         DATA     2,2,2             DIRECT,OUT,SAVE
         PZE      BLABL             USER TAPE LABEL BUFFER
KEYMX    PZE      3
         PZE      *TAPETYP
         DATA     X'02000202'
EOACCT   TEXT     ':SYS    '
VPT:EO   RES      50
         PAGE
DPT:EI   GEN,8,7,17  X'14',4,F:EI   TEST FILE FOR INPUT
         DATA     X'C0200400'       NXTF
         DATA     DT:ERR            ERR
         DATA     DT:ERR            ABN
         DATA     0                 FPARAM=0, NO FIT READ
         SPACE    2
NXA:EI   GEN,8,7,17  X'14',X'44',F:EI TEST FILE, NXTA
         DATA     X'C0200009'       RESET FPARAM, FID
         DATA     DT:ERR,DT:ERR,0   ERR,ABN,FPARAM
         DATA     X'01000001',X'01000000'   FID VLP
         DATA     X'2010202'
NXACCT   TEXT     '        '
         SPACE    3
*                 ADJUST F:EI DCB TO RESET FID & ACCT AFTER
*                   SELECTIVE BACKUP
ADJ:EI   GEN,8,7,17  X'14',0,F:EI
         DATA     X'6000',X'C0000000'
         DATA     BSR1,BSR1
ADJ:FID  EQU      %+1
         DATA     X'01000808',0,0,0,0,0,0,0,0  FID
ADJ:ACCT EQU      %+1
         DATA     X'02010202',0,0   ACCT
         SPACE    2
GDESC:EI GEN,8,7,17  X'14',4,F:EI
         DATA     X'C0200009'       FID SPECIFIED
         DATA     USR:ERR,USR:ABN,0   ERR,ABN,FPARAM
NXFIL    RES      4+3+3             NAME, ACCOUNT, PASSWORD
         SPACE    2
CHK:SEL  GEN,8,7,17  X'14',4,F:SEL    TEST FILE FOR F:SEL
         DATA     X'C0000000',NOSELF,NOSELF
         SPACE    2
BREC:ADJ GEN,8,7,17  X'14',0,F:BREC    ADJ DCB
         DATA     X'00002000',X'C1000000'
         DATA     BREC:ERR,BREC:ABN,4
         SPACE    2
SAVCONT  DATA     X'15'**24+F:EO,X'80000040',2  CLOSE FPT-NO LABELS
         SPACE    2
OPENDAT  GEN,8,24 X'14',F:EO
         DATA     X'C744000A'
         DATA     TAP:ERR
         DATA     TAP:ABN
         DATA     1,2,2,2           CONSEC,DIRECT,OUT,SAVE
         PZE      *TAPETYP
         DATA     X'01000101'
         TEXTC    'DAT'
         DATA     X'02010202'
DATACCT  TEXT     ':SYS     '
         SPACE    2
OPENBREC GEN,8,24 X'14',F:BREC
         DATA     X'C0000000'
         DATA     BB1C
         DATA     BB1C
         SPACE    2
OPNBREC  GEN,8,24 X'14',F:BREC
         DATA     X'C7000000'
         DATA     BSR1
         DATA     BSR1
         DATA     2,2,4             KEYED,DIRECT,INOUT
         SPACE    2
DESELKEY GEN,8,24 X'0D',F:BREC
         PZE      *0
         DATA     SELKEY
         SPACE    2
READBREC GEN,8,24 X'10',F:BREC
         DATA     X'F8000000'
         DATA     BB1C
         DATA     BB1C
         DATA     DATE:TIME
         DATA     0
         DATA     SELKEY
         SPACE    2
CLSBREC  GEN,8,24 X'15',F:BREC
         PZE      *0
         DATA     2
         SPACE    2
TIME     GEN,1,7,1,23   1,X'10',0,R7
         SPACE    2
WRTBREC  GEN,8,24 X'11',F:BREC
         DATA     X'F8000040'
         DATA     BSR1
         DATA     BSR1
         DATA     SAVEBUF
         DATA     SAVESIZ*4
         DATA     SAVKEY
         SPACE    2
CLSLAST  GEN,8,24 X'15',F:EO
         DATA     X'80000020'       CLOSE SAVE AND REMOVE
         DATA     2
         SPACE    2
OPNSCHED GEN,8,24 X'14',F:1
         DATA     X'C7400001'
         DATA     SCERR
         DATA     SCERR
         DATA     2,1,4,2
         DATA     X'01010303'
         TEXTC    'BACK:SCHED'
         SPACE    2
READSCHD GEN,8,24 X'10',F:1
         DATA     X'F0000000'
         DATA     SCERR
         DATA     SCERR
         DATA     NTRY
         DATA     80
         SPACE    2
DELREC1  GEN,8,24 X'0D',F:1
         DATA     0
         SPACE    2
CLSSCHED GEN,8,24 X'15',F:1
         PZE      *0
         DATA     2
         SPACE    2
OPENBACK GEN,8,24 X'14',F:BACKUP
         DATA     X'C1000000'
         DATA     BCK:ERR
         DATA     BCK:ABN
         DATA     4
         SPACE    2
READBACK GEN,8,24 X'10',F:BACKUP
         DATA     X'F8000000'
         DATA     BCK:ERR
         DATA     BCK:ABN
         PZE      *BUF
         PZE      *BUF:RDZ
         DATA     BCK:KEY
         SPACE    2
DELRECB  GEN,8,24 X'0D',F:BACKUP
         DATA     0
         SPACE    2
WRTBACK  GEN,8,24 X'11',F:BACKUP
         DATA     X'F8000040'
         DATA     BCK:ERR
         DATA     BCK:ABN
         PZE      *BUF:OUT
         PZE      *R6
         DATA     BCK:KEY
         SPACE    2
CLOSBACK GEN,8,24 X'15',F:BACKUP
         PZE      *0
         DATA     0
         SPACE    2
OPNBACK1 GEN,8,24 X'14',F:BACKUP
         DATA     X'C0000000'
         DATA     BSR1
         DATA     BSR1
         SPACE    2
OPNBREC2 GEN,8,24 X'14',F:BREC
         DATA     X'C1400000'
         DATA     BSR1
         DATA     BSR1
         DATA     2,2
         SPACE    2
CLSEOPTL GEN,8,24 X'15',F:EO
         PZE      *X'10'
         DATA     2
         SPACE    2
CLSEI    GEN,8,24 X'15',F:EI
         DATA     0
         SPACE    2
CLSEISAV GEN,8,24 X'15',F:EI
         PZE      *0
         DATA     2
         SPACE    2
PRECOREI GEN,8,24 X'1D',F:EI
         DATA     X'C0000010'
         PZE      1
         DATA     USR:ABN
         SPACE    2
WRITEO   GEN,8,24 X'11',F:EO
         DATA     X'F8000030'
         DATA     WHATNOW
         DATA     WHATNOW
         PZE      *BUF
         PZE      *F:EI+13
         PZE      *F:EI+10
         SPACE    2
PFILBOF  GEN,8,24 X'1C',F:EI
         DATA     X'10'
         SPACE    2
CLSEOSAV GEN,8,24 X'15',F:EO
         PZE      *0
         DATA     2
         SPACE    2
OPENSPEC GEN,8,24 X'14',F:EO
         DATA     X'C000000A'
         DATA     SPOPN
         DATA     SPOPN
         DATA     X'01010303'
         TEXTC    'FILELIST'
         SPACE    2
WRTSPEC  GEN,8,24 X'11',F:EO
         DATA     X'F0000000'
         DATA     SPWRT
         DATA     SPWRT
         PZE      *PAGE
         PZE      *COUNT
         SPACE    2
CVOL     GEN,8,24 X'03',F:EO
         DATA     0
         SPACE    2
OPENLAST GEN,8,24 X'14',F:EO
         DATA     X'C000000A'
         DATA     BSR1
         DATA     BSR1
         DATA     X'01010303'
         TEXTC    'LASTFILE'
         SPACE    2
WRITDAT  GEN,8,24 X'11',F:EO
         DATA     X'F0000000'
         DATA     TAP:ERR
         DATA     TAP:ABN
         DATA     FPAR
         DATA     24
         SPACE    2
PRNTHEAD GEN,8,24 X'26',M:LL
         GEN,2,30 3,0
         DATA     HEADER,1
         SPACE    2
PRINT    DATA     1**24
         PZE      *0
         DATA     PBUFFER
         SPACE    2
EOINOUT  GEN,8,24 X'14',F:EO
         DATA     X'C1000400'
         DATA     SQABN,SQABN
         DATA     4                 INOUT OPEN OF SQUIRREL TAPE
         SPACE    2
OPNDEVTP GEN,8,24 X'14',F:EO
         DATA     X'C0040003'
         DATA     BSR1,BSR1
         DATA     'MT'              'MT' DEVICE OPEN
         SPACE    2
OPNFILTP GEN,8,24 X'14',F:TI
         DATA     X'C0040003'
         DATA     BSR1
         DATA     BSR1
         PZE      *TAPETYP
         SPACE    2
TOPOFORM GEN,8,24 4,M:LL
         SPACE    2
CLSTPREM GEN,8,24 X'15',F:TI
         DATA     X'20'
         TITLE    '**  MAIN PROGRAM  **'
         USECT    PURE
** AUTOMATIC BACKUP
BACKUP   EQU      %
         BAL,SR4  DO:TIME
         BAL,SR4  DO:REGS4
         BAL,SR4  PURGE             LOOK TO SEE IF PURGE NECESSARY
*                 IF SEL:FIL EXISTS OR SEL:FIL KEY IN :BREC
*                   FILE, GO TO SELFILL
*
         CAL1,1   CHK:SEL           ERR/ABN ON OPEN GOES TO NOSELF
         B        SELFILL           THE SEL:FIL FILE EXISTS
NOSELF   EQU      %                 ABB/ERR FOR CHK:SEL
         LH,R9    F:BREC
         CI,R9    X'20'             CHECK TO SEE IF ALREADY OPEN
         BAZ      %+2
         CAL1,1   CLSBREC           IF OPEN, CLOSE IT
         CAL1,1   OPENBREC          ERR/ABN ON OPEN GOES TO BB1C
         CAL1,1   READBREC
*                 ERR,ABN=BB1C; BUF=DATE:TIME; SIZE=0; KEY=SELKEY
GO:SEL1  EQU      %
         CAL1,1   CLSBREC
         B        SELFILL           SEL:FIL RECORD EXISTS
BB1C     EQU      %
         LB,SR3   SR3
         CI,SR3   7
         BE       GO:SEL1           IF SHORT, RECORD MUST EXIST
         LCF      F:BREC,R1
         BCR,2    BB1               DCB NOT OPEN
         CAL1,1   CLSBREC
         PAGE
*
*        BUILD THE INTERNAL SCHEDULING TABLES FOR THE
*         SCHEDULE CONTAINED IN BACK:SCHED.
*
BB1      EQU      %
         BAL,SR4  ESSENCE
*
*        NOW READ THE SAVKEY RECORD OF F:BREC TO RESTORE THE
*         OPTIONAL FILL DIRECTIVES TO CORE.
*
BB2      EQU      %
         LW,R6    LASTRUN
         BNEZ     BB4
BB3      EQU      %
         LW,R7    NSCHED
         BEZ      NOSCHD
         B        FIND:NXT
BB4      EQU      %
         CI,R6    3                 IGNORE RESTART OF ANYTHING BUT BACKUPS.
         BLE      CRASH             CRASHED DURING BACKUP - CONTINUE
         STW,R0   LASTRUN
         BAL,R5   WRT:SAV
         B        BB3
         PAGE
*
*        THE SYSTEM CRASHED OR A SUSPENDED OPERATION WAS RESTARTED.
*         BUILD THE APPROPRIATE RESTART MESSAGE AND RESUME THE
*          BACKUP OR PURGE THAT WAS INTERRUPTED.
*
CRASH    EQU      %
         BAL,SR4  SETHEADR
         LI,R7    1                 RESTARTED MESSAGE CODE
         BAL,SR4  OPSMSG
         STB,R6   SC:TYPE,R1
         BAL,SR4  NOTAPE
         BAL,SR2  OPNFIRST
         STW,R1   NOTAPFG
         CW,R2    LASTRUN           IF AN INCREMENTAL IS RESTARTED,
         BE       INRESTRT           GO BACK TO BEGINNING OF ACCOUNTS
         LW,R6    LASTACCT
         LW,R7    LASTACCT+1
         STW,R6   NXACCT
         STW,R7   NXACCT+1
         B        OPX
         PAGE
*
*F*      NAME:    SAVEALL
*F*
*F*      PURPOSE: INITIATE THE SAVEALL OPERATION.
*F*
SAVEALL  EQU      %
         LI,D4    1
         B        STRTBKUP
*
*F*      NAME:    INCRMNTL
*F*
*F*      PURPOSE: INITIATE THE INCREMENTAL OPERATION.
*F*
INCRMNTL EQU      %
         LI,D4    2
         B        STRTBKUP
*
*F*      NAME:    SQUIRREL
*F*
*F*      PURPOSE: INITIATE THE SQUIRREL OPERATION.
*F*
SQUIRREL EQU      %
         LI,D4    3
STRTBKUP EQU      %
         STW,R0   INT               CLEAR THE INTERUPT FLAG
         STW,R1   NSCHED            ONE SCHEDULED BACKUP FAKEM OUT
         STB,D4   SC:TYPE,R1        TYPE REQUESTED (1,2, OR 3)
         LW,R7    CURRENT
         STW,R7   SCHED,R1
         B        BB2
FIND:NXT LW,R4    SCHED,R7
         AI,R4      15
         LW,R5    SCHED,R7
         AI,R5    -1                1 MIN AHEAD OF SCHED
         CLR,R4   CURRENT
         BCR,9    FOUND1
         BDR,R7   FIND:NXT
NOSCHD   EQU      %                 NONE
         BAL,SR4  USR:BCK
         LW,R7    NSCHED
         BEZ      GIVUP             NO SCHED-SO DON'T USE
         LW,R7    SCHED:PT
         BEZ      CHK:CNT
         LB,R5    SC:TYPE,R7
         CI,R5    4                 FINISH TAPE IF 'WRAPUP'
         BE       NORUN
CHK:CNT  EQU      %
         B        GIVUP
FOUND1   STW,R7   SCHED:PT
         BDR,R7   CKCEQ             CHECK FOR 2 EQU NTRS IN SCHED
EQRET    EQU       %
         AI,R7    1
         LB,R6    SC:TYPE,R7        GET TYPE
         BEZ      GRAVE             GRAVE ERROR
         CI,R6    4
         BG       GRAVE             NOT A KNOWN TYPE (ERROR)
         STW,R6   LASTRUN
*
*        BUILD AND TYPE THE APPROPRIATE START MESSAGE ON OC
*
         LI,R7    0                 CODE FOR START MESSAGE
         BAL,SR4  OPSMSG            TYPE START MESSAGE ON OC.
INRESTRT EQU      %
         LW,R6    LASTRUN           PICK UP OERATION FOR HEADER
         BAL,SR4  SETHEADR
         STW,R0   NXACCT            PRESET FOR SCAN
         STW,R0   NXACCT+1
         STB,R0   NXFIL+1
NXT:ACT  EQU      %
         BAL,SR4  PURGE             CHK IF PURGE IS NEEDED
         LCI      2
         LM,R6    NXACCT
         STM,R6   LASTACCT
         MTW,1    NUACT             SET NEW ACCT FLAG TO WRITE :BREC
OPX      EQU      %
         CAL1,1    NXA:EI           TEST FILE  TO FIND AC
*                 ERR,ABN=DT:ERR,DT:ABN
         LW,R5    SCHED:PT          CURRENT TYPE
         LB,R5    SC:TYPE,R5
         CI,R5    2                 IS THIS AN INCR
         BNE      NODIREC           DONT SAVE DIRECTORY
         STH,R1   GET:DY,R1         GET ONE DYNAMIC PAGE OF MEMORY
         STW,R1   PAGES
         CAL1,8   GET:DY
         BCR,8    %+3               PAGES ACQUIRED
NODIREC  STW,R0   PAGES             NO PAGES ACQUIRED
         STW,R0   DYPAGES
         STW,9    PAGE
         STW,R0   COUNT
         LCI      2
         LM,R6    F:EI+32           FETCH ACCT
         STM,R6   NXACCT
         STM,R6   ADJ:ACCT
         STM,R6   MAIL:AC
         STM,R6   CONACCT
         MTW,0    OCDISP
         BEZ      %+3               DON'T DISPLAY ACCOUNT ON OC
         LI,R5    ACCTMSG
         CAL1,2   TYPE
         LW,R6    L(X'01000000')
         STW,R6   ADJ:FID
OPNNXF   EQU      %                 OPEN NEXT FILE
*                 CHK IF SELECTIVE BACKUP RAN
         LW,R6    INT               CALL PURGE IF OPER INT
         BEZ      %+2
         BAL,SR4  PURGE
         LB,R6    NXFIL+1
         BEZ      OPPN05
         STB,R0   NXFIL+1           DCB CHANGED--RESET
         CAL1,1   ADJ:EI              AND FIX DCB
OPPN05   EQU      %
         LW,R5    DEFAULT           INITIALIZE THE BUFFER
         BAL,SR4  GETBUF             TO ITS STARTING SIZE
         LI,R6    4
         STB,R6   DPT:EI+1,R2       NXTF
         CAL1,1   DPT:EI
*                 ERR,ABN=DT:ERR,DT:ABN
         LD,R6    ADJ:MBS           SAVE FILE NAME IN CASE
         MBS,R6   0                  PURGE CHANGES DCB AROUND.
         LW,R7    DYPAGES
         BEZ      OPPN20            (IF THERE ARE PAGES)
         LW,R7    PAGES             CHECK TO SEE IF THERE IS ENOUGH ROOM
         SLS,R7   11                ON THIS PAGE FOR ANOTHER NAME - GET
         SW,R7    =32               BYTES ACQUIRED SO FAR, CHECK IF 32
         CW,R7    COUNT             LEFT
         BGE      OPPN10
         CI,R7    4**11-32          MAX 4 PAGES
         BGE      OPPN11
         STH,R1   GET:DY,R1         NO, GET NEW DYNAMIC PAGE
         CAL1,8   GET:DY
         BCR,8    %+3
OPPN11   EQU      %
         STW,R0   DYPAGES           NO MORE DYNAMIC PAGES AVAILABLE
         B        OPPN20
         AWM,R1   PAGES
OPPN10   EQU      %
         LW,7     COUNT              MENT FOR SAV:NAME ROUTINE
         LW,15    PAGE
         LI,4     OPNNXF
         STW,4    BACKXT
         BAL,11   SAV:NAM
OPPN20   EQU      %
         LW,R5    SCHED:PT          SET DYNAMIC DESC MASK
         LB,R5     SC:TYPE,R5
         LW,R6    DESC:MASK,R5
         STW,R6   DESC:MASK
         LW,R6    EI:DESC+1         DESCRIPTORS
         CI,R5    1                 SKIP TEST IF SAVEALL
         BE       CHK:NOBU
         LW,R7    L(X'0F0000')
         EOR,R7   DESC:MASK         SET IN R7 BITS TO TEST
         AND,R7   L(X'0F0000')
         CW,R7    R6
         BAZ      OPNNXF            NOT MODIFIED SINCE LAST BACKUP
CHK:NOBU EQU      %
         CI,R6    X'800'            CHECK 'NO BACKUP' FLAG
         BANZ     OPNNXF            SKIP FILE IF SET
         BAL,SR4  AUTOBACK          BACKUP FILE--AUTO MODE
         B        OPNNXF
         PAGE
*                 BACKUP  WRAPUP         **
**
NOMORE   EQU      %                 NOMORE ACCOUNTS, CLEAN UP
         BAL,SR4  ENDTAPE           END TAPE WITH NORMAL CODE
         LW,R7    SCHED:PT          ENTRY IN SCHED TABLE
         LB,R6    SC:TYPE,R7
         STW,R6   LASTRUN           LAST RUN TYPE
         BEZ      GRAVE
         BAL,SR4  DO:TIME           RESET CURRENT
         BAL,SR4  USR:BCK
         LW,R6    LASTRUN           TYPE IS 1,2,OR 3 - SEE TYPES
*
*        BUILD AND TYPE APPROPRIATE END MESSAGE ON OC
*
         LI,R7    3                 CODE FOR COMPLETED MESSAGE
         BAL,SR4  OPSMSG
NORUN    EQU      %
         STW,R0   LASTRUN
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         BAL,SR4  ENDTAPE
GIVUP    EQU      %                 USER BACKUP OR NOTHING TO DO
GRAVE    EQU      GIVUP
         BAL,R5   WRT:SAV
         CAL1,1   CLSBREC
*                 SAVE
         BAL,SR4  ESSENCE
         LW,R7    NSCHED            FIND NEXT SCHEDULE SO AS
         BEZ      COP:OUT
         LI,R5    1
SCHLOOP  LW,R4    SCHED,R5
         AI,R5    1
         CW,R4    CURRENT
         BG       SLEEPY
         BDR,R7   SCHLOOP
         LW,R4    SCHED+1           FIRST SCHED ENTRY FOR TOMORROR
         AI,R4    60*24             1DAY OF MINUTES
SLEEPY   SW,R4    CURRENT
         LH,R5    R4,R1
         MI,R5    MINUTE            SECONDS PER MINUTE
         STH,R5   SLP:FPT,R1
COP:OUT  EQU      %
         LH,R5    SLP:FPT,R1        CHK FOR MAX SLEEP VALUE
         BLEZ     %+3
         CI,R5    MAX:SLP
         BLE      %+2
         LI,R5    MAX:SLP
         B        %+2
RIP      EQU      %
         LI,R5    12*60*MINUTE      12 HR SLEEP
         STH,R5   SLP:FPT,R1
         LI,SR4   %+3
         STW,SR4  BACKXT
         B        RELEASE1          RELEASE COMMON, RETURN
         MTW,0    DEBUG
         BNEZ     %+2
         STW,R3   *PURGEFLAGAD      SET READY FLAG FOR BUFGRAN
         CAL1,8   SLP:FPT
         MTW,0    DEBUG
         BNEZ     BACKUP
         STW,R0   *PURGEFLAGAD      SET PURGE BUSY
         B        BACKUP
**
CKCEQ    LW,R4    SCHED,R7          ARE THERE TWO ENTRIES WHICH
         AI,R4    4                 MAKE A 5 MINUTE WINDOW
         LW,R5    SCHED,R7
         AI,R5    -1                MATCH CURRENT
         CLR,R4   CURRENT
         BCR,9     FOUND2           YES
         B        EQRET
FOUND2   LB,R6    SC:TYPE,R7        IS SECOND TYPE MORE IMPORTANT
         AI,R7    1                     THAN THE FIRST
         CB,R6    SC:TYPE,R7
         BG       LSSIMP
FND2     STW,R0   SCHED,R7
         STB,R0   SC:TYPE,R7
         AI,R7    -1
         B        FOUND1
LSSIMP   LB,R6    SC:TYPE,R7
         LW,R5    SCHED,R7
         AI,R7    -1
         STB,R6   SC:TYPE,R7
         STW,R5   SCHED,R7
         AI,R7    1
         B        FND2
         TITLE    '**  MISC SUBROUTINES  **'
LOCCODE  EQU      %   ****          SPEC ENTRY TO LOCCODE1,FOR FPAR
         LI,D4    FPAR
LOCCODE1 EQU      %
*                 FINDS VLP PER D1 CODE IN PLIST AT D4 ADDRESS
*                  RETURNS SKIPPING IF FOUND, W/D4 POINTING
*                  TO THE VLP
         LB,R4    *D4
         CW,R4    D1
         BE       1,R5              FOUND
         LB,R4    *D4,R1            CHK LEI
         BNE      *R5
         LB,R4    *D4,R3            FIND NEXT VLP
         AW,D4    R4
         AI,D4    1
         B        LOCCODE1
         PAGE
NOTAPE   EQU      %   ****          SETUP SN F/LASTREEL OR NEW DATE
         LH,R5    REELTMP
         CH,R5    LASTREEL          HAS DAY CHANGED IN SN?
         BE       DO:EO:SN          NO.
         CH,R5    LASTREELX         SPECIAL CASE FOR FILL OF
         BNE      %+4                OF TODAY'S TAPES
         LW,R5    LASTREELX
         STW,R5   LASTREEL
         B        DO:EO:SN
*
*        IT'S A NEW DAY.  REDO THE SNS IN DCB
*
         LW,R5    REELTMP
         AI,R5    X'C000'
         STW,R5   LASTREEL
         STW,R5   LASTREELX
         BAL,R5   WRT:SAV           PUT RIGHT NUMBER IN :BREC
         SPACE    2
DO:EO:SN EQU      %   ****          SBR SETS SN /1-8 FROM LASTREEL
         LW,R5    LASTREEL
         AND,R5   L(X'FFFFFF00')
         AI,R5    X'1F0'            INC 3RD DIGIT, 4TH=C'1'-1
         LB,R6    R5,R2             CHECK R+1 & I+1
         CI,R6    C'R'+1
         BNE      %+2
         LI,R6    C'S'
         CI,R6    C'I'+1
         BNE      %+2
         LI,R6    C'J'
         STB,R6   R5,R2             PUT LETTER IN SN
         LI,D4    SN:EO+37
         LW,R4    R5
         LI,R5    X'FFF00'
         LI,R6    -36
SET:SN   EQU      %
         STS,R4   *D4,R6            SET 3 HI ORDER SN CHARS
         CW,R4    *D4,R6
         BNE      %+2
         STW,R6   EO:VOL
         BIR,R6   SET:SN
         LI,R6    37                NOW RESET VOL IN DCB
         AWM,R6   EO:VOL
         CAL1,1   EO:VOL:ADJ
         STW,R4   LASTREEL          SAVE SN IF FOR BACKUP
         B        *SR4
         PAGE
*
*F*      NAME:    WRT:SAV
*F*
*F*      PURPOSE: SAVE THE OPTIONAL FILL PARAMETERS IN THE F:BREC FILE.
*F*      DESCRIPTION:  THE SAVEBUF RECORD IS WRITTEN TO F:BREC WITH THE
*F*               KEY 'SAV'; THIS IS DONE ANY TIME SAVEBUF CHANGES. SINCE
*F*               THIS FILE IS SAVED IF THE SYSTEM CRASHES, THE CHANGES
*F*               WILL BE REMEMBERED.  SAVEBUF CONTAINS THE FOLLOWING:
*F*               LASTRUN           LAST UNFINISHED BACKUP OPERATION
*F*               LASTREEL          LAST REEL NUMBER USED FOR BACKUP
*F*               LASTACCT          LAST ACCOUNT ACCESSED BY BACKUP
*F*               TAPETYP           DEVICE TYPE FOR TAPES USED
*F*               DENSITY           DENSITY TO USE ON OUTPUT TAPES
*F*               USRBKUP           IS USER BACKUP ALLOWED?
*F*               SQMOUNT           ARE USER BACKUP TAPES LEFT MOUNTED?
*F*               BLDMAIL           ARE MAILBOXES BUILT IN USER ACCOUNTS?
*F*               OCDISP            IS CURRENT ACCOUNT DISPLAYED ON OC?
*F*               PURGTAP           WHAT HAPPENS TO PURGED FILES?
*F*               SUSPNDED          LAST SUSPENDED OPERATION
*F*               SUSPACCT          ACCOUNT OF SUSPENDED OPERATION
*F*               SQREEL            SERIAL NUMBER FOR USER BACKUP TAPES
*F*               THRESH            CURRENT THRESHOLD VALUE
*F*
WRT:SAV  EQU      %   ****          WRITES SAV RECORD IN :BACKUP
         CAL1,1   WRTBREC
*                 ERR/ABN=BSR1; BUF=SAVEBUF; KEY='SAV' SIZE=SAVESIZ
         LI,R7    F:BREC
         CAL1,1   TRUNC
         B        *R5
         PAGE
ESSENCE  STW,SR4  BACKXT   ****
ESSENCE1 EQU      %
         BAL,SR4  DO:TIME           SET CURRENT
         BAL,SR4  DO:SCH            BUILD SCHED TABLES
         LW,SR4   BACKXT            PICK UP RETURN ADDRESS FROM DO:REGS4
         B        DO:REGS4
         SPACE    3
DO:TIME  EQU      %   ****
         PSW,SR4  ENVIR
         LI,R7    DATE:TIME
         CAL1,8   TIME
         LI,SR3   DATE:TIME
         BAL,SR4  JULIAN
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
*                 SETUP DD  PART OF REEL NUMBER
         STH,SR1  SR4
         SLS,SR4  8
         LI,R5    2                 READY TO PROCESS 2 DIGITS
         SLS,SR3  4
         SLD,SR3  4
         OR,SR3   L(X'F0')        FORM EBCDIC CHAR
         BDR,R5   %-3
         STH,SR3  REELTMP           SAVE DD00 PARTIAL REEL NO.
*              NOW DO DATE AND TIME FOR BACKUP-FILL USE
*               DATE IS 1/2WORD-0YYY YHHH TTTT UUUU
*               WHERE Y IS YEAR, H IS JULIAN HUNDRED DAYS
*               T IS JULIAN TENS DAYS, U IS JULIAN DAYS
*              RH WORD IS BINARY MINUTES SINCE MIDNIGHT
         SLD,SR1  -16
         AND,SR1  =X'F'
         SLS,SR2  5                 ELIMINATE THE SIGN BIT
         SLD,SR1  11                AND PACK  YEAR WITH DAY
         STH,SR1  CURRENT           LEFT HALF IS JULIAN  YDDD
         LB,R5    SR2               HH
         SLS,R5   -4
         MI,R5    10
         LB,R6    SR2
         AND,R6   =X'F'
         AW,R5    R6                HH IN HEX
         MI,R5    60
         STH,R5   CURRENT,R1
         LB,R5    SR2,R1
         SLS,R5   -4
         MI,R5    10
         AWM,R5   CURRENT           MM TO HEX
         LB,R5    SR2,R1
         AND,R5   =X'F'
         AWM,R5   CURRENT           MM TO CURRENT = YDDDHHMM
         PLW,SR4  ENVIR
         B        *SR4
         SPACE    3
DO:SCH   EQU      %   ****
         LI,4     FOREVER
         STH,4    SLP:FPT,R1
         B        READ:SCH          READ THE SCHED FILE,RET SR3
         PAGE
*
*F*      NAME:    DO:REGS4
*F*
*F*      PURPOSE: SET UP REGISTERS 0 THROUGH 3 TO CONTAIN THE
*F*               CONSTANTS 0, 1, 2, 3 RESPECTIVELY.  THESE REGISTERS
*F*               ARE ASSUMED TO CONTAIN THESE VALUES THROUGHOUT THE
*F*               FILL PROCESSOR.
*F*
DO:REGS4 EQU      %
DO:REGS  EQU      %   **
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         B        *SR4
         SPACE 3
         SPACE 3
SAVREELNO EQU     %   ****          FIND & SAVE CURRENT REEL NO
         LB,R4    F:EO+11           PICK UP VOLUME NUMBER
         LW,R4    F:EO+X'47',R4     GET CORRESPONDING REEL #
         STW,R4   LASTREEL
         XW,R4    LASTREELX
         CW,R4    LASTREELX
         BE       *SR4              IF CHANGED, UPDATE F:BREC
         LW,R5    SR4
         B        WRT:SAV           WRITE 'SAV' & RET *R5
         PAGE
ZAPTAPE  EQU      %
         LI,D4    X'FE'             FORCED TERMINATION CODE
         B        FINI:TAP
ENDTAPE  EQU      %
         LI,D4    X'FF'             NORMAL TERMINATION CODE
FINI:TAP EQU      %
         MTW,0    NOTAPFG
         BEZ      *SR4
         STW,SR4  FTAPX
         BAL,R6   DATELBL           INITIALIZE THE LABEL
         LCI      2
         LM,R4    ADJ:ACCT          PICK UP THE ACCOUNT NAME
         STM,R4   LBLACCT            AND PLACE INTO TAPE LABEL.
         LI,R4    X'F0'             SIGNAL END OF TAPE FILE
         STB,R4   LBLORG            THIS IS A SPECIAL FILE
         STB,D4   LBLORG,R3
         LI,R4    27
         STB,R4   LBLSIZE
         CAL1,1   OPENLAST
         CAL1,1   CLSLAST
         CAL1,9   SUPER:CLOSE
         STW,R0   TAP:FILCNT
         STW,R0   NOTAPFG
         B        *FTAPX
         PAGE
QUIT     EQU      %
         CAL1,9   SUPER:CLOSE
         LW,R6    LASTRUN
         BEZ      GETCOM
         CI,R6    6
         BG       BADCOM
         LI,R7    4                 TERMINATION CODE
         BAL,SR4  OPSMSG
         STW,R0   LASTRUN
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         BAL,R5   WRT:SAV
         LD,R4    INITSTK           PUT STACK BACK TO EMPTY
         STD,R4   ENVIR
*
*        LASTRUN = 1 - 4 => BACKUP TYPE OPERATION
*                           (SAVEALL,SQUIRREL,INCREMENTAL,PURGE)
*                = 5     => FILL
*                = 6     => SELECTIVE FILL
*
         CI,R6    5
         BGE      QUITFILL
QUIT1    EQU      %
         MTW,0    NOTAPFG           IS A TAPE MOUNTED?
         BEZ      QUITBKUP           NO, JUST CLOSE OUT DISK FILE
         LH,R8    F:EO
         CI,R8    X'20'             IS OUTPUT TAPE FILE NOW OPEN?
         BAZ      %+2                NO, IT ISN'T
         CAL1,1   CLSEOPTL          CLOSE THE TAPE FILE
         BAL,SR4  ZAPTAPE            AND SET ABNORMAL END FILE ON TAPE
QUITBKUP EQU      %
         BAL,SR4  CLRDESC           CLOSE USER FILE AS NOT SAVED
         B        NO:FILL            EXIT
QUITFILL EQU      %
         LH,R8    F:TI
         CI,R8    X'40'             EVER BEEN OPEN?
         BAZ      NO:TAPE            NO
         MTW,0    NOTAPFG
         BEZ      NO:TAPE           TAPE NOT MOUNTED AS FAR AS I KNOW
         CI,R8    X'20'
         BANZ     %+2
         CAL1,1   OPNFILTP
         CAL1,1   CLSTPREM
NO:TAPE  EQU      %
         STW,R0   NOTAPFG           CLEAR THE TAPE MOUNTED FLAG
         CI,R6    5                 IS THIS A SELECTIVE FILL
         BG       QSELFILL           YES
         B        NO:FILL
QSELFILL EQU      %
         LH,R8    F:BREC
         CI,R8    X'20'             IS F:BREC NOW OPEN?
         BANZ     SEL:MT            YES
         CAL1,1   OPNBREC           NO, OPEN IT FIRST
         B        SEL:MT
         PAGE
SUSPEND  EQU      %
         LW,R6    LASTRUN
         BEZ      BADCOM
         CI,R6    4                 IS OPERATION SUSPENDABLE?
         BG       BADCOM
         STW,R6   SUSPNDED
         LI,R7    2                 SUSPENDED CODE
         BAL,SR4  OPSMSG            TELL OPERATOR ABOUT IT
         CAL1,9   SUPER:CLOSE       AND PRINT WHATEVER IS THERE
         LCI      2
         LM,R4    LASTACCT
         STM,R4   SUSPACCT
         STW,R0   LASTRUN
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         BAL,R5   WRT:SAV
         B        QUIT1
         PAGE
RESTART  EQU      %
         LW,D4    SUSPNDED
         BEZ      BADCOM
         CI,D4    4
         BG       BADCOM
         STW,D4   LASTRUN
         LCI      2
         LM,R4    SUSPACCT
         STM,R4   LASTACCT
         STW,R0   SUSPNDED
         STW,R0   SUSPACCT
         STW,R0   SUSPACCT+1
         BAL,R5   WRT:SAV
         STW,R0   INT               CLEAR THE BREAK FOR  RESTART
         B        STRTBKUP          RESUME THE SUSPENDED OPERATION
         PAGE
* FILE NAME OBTAINED AND SAVED HERE: R15 CONTAINS BUFFER ADDRESS, R7
*      CONTAINS DISPLACEMENT, R11 CONTAINS LINKAGE
*
SAV:NAM  EQU      %   ****
         LI,R4    0
         LB,R5    F:EI+22,R4
         CI,R5    1                 IS IT A FILE NAME
         BNE      GRAVE             NO
         AI,R4    4
         LB,R5    F:EI+22,R4
         CW,15    PAGE
         BNE      %+4               IF A SPECIAL FILE
         LW,R6    R5                INCREMENT COUNT
         AI,R6    1
         AWM,R6   COUNT
         LB,R6    F:EI+22,R4
         STB,R6   *15,7
         AI,R4    1
         AI,R7    1
         BDR,R5   %-4
         LB,R6    F:EI+22,R4
         STB,R6   *15,7
         B        *11               RETURN
         PAGE
*
*        CLOSE F:EI DCB AFTER RESETTING THE FILL 'SAVED' BIT
*        IN THE FILES DESCRIPTOR SO SUBSEQUENT SAVE WILL CATCH IT
*
CLRDESC  EQU      %
         LH,R8    F:EI
         CI,R8    X'20'             IS FILE OPEN?
         BAZ      *SR4              NO, JUST EXIT
         LI,D4    F:EI+22           FIND THE 11 VLP IN THE DCB
         LI,D1    X'11'
         BAL,R5   LOCCODE1
         BAL,D3   WHATNOW           THIS SHOULDN'T HAPPEN
         AI,D4    1                 POINT TO THE DESCRIPTOR WORD
         LI,R6    X'FFEF'           MASK FOR CLEARING SET DESCRIPTOR BIT
         LH,R5    *D4               PICK UP LEFT HALF OF DESCRIPTORS
         AND,R5   R6                CLEAR THE BIT
         CAL1,6   SYS               GO MASTER TO SET IN DCB
         STH,R5   *D4
         BAL,R6   SLAVE
         CAL1,1   CLSEISAV          CLOSE THE FILE AND EXIT
         B        *SR4
         PAGE
*
*F*      NAME:    SETHEADR
*F*
*F*      PURPOSE: FORMAT THE LINE PRINTER TITLE LINE WITH THE
*F*               OPERATION PERFORMING THE PRINTING AND THE
*F*               CURRENT TIME OF DAY
*F*
*D*      NAME:    SETHEADR
*D*
*D*      REGISTERS:  R4,R5,R7,R8 CLOBBERED
*D*      CALL:    LW,R6    TYPECODE       TYPECODE FOR OPERATION
*D*                                         1 => SAVEALL
*D*                                         2 => INCREMENTAL
*D*                                         3 => SQUIRREL
*D*                                         4 => PURGE
*D*                                         5 => FILL
*D*                                         6 => SELECTIVE FILL
*D*               BAL,SR4  SETHEADR
*D*      OUTPUT:  HEADER  IS INITIALIZED WITH THE PROPER OPERATION
*D*               AND THE CURRENT TIME
*D*      DESCRIPTION:  AN M:TIME CAL IS USED TO INSERT THE CURRENT
*D*               TIME INTO HEADER;  THE TYPECODE IN R6 IS USED TO
*D*               INDEX THE TAPETYPE AND HEADTYPE TABLES TO FORM
*D*               AN MBS REGISTER PAIR TO INITIALIZE THE OPERATION
*D*
SETHEADR EQU      %
         LI,R7    HEADATE
         CAL1,8   TIME
         LW,R1    HEADTYPE
         BAL,R5   BLANKS            BLANK FILL THE OPERATION FIELD
         LD,R4    TAPETYPE,R6       GET THE CURRENT OPERATION
         LW,R5    HEADTYPE,R6       GET PROPER DESTINATION IN HEADER
         LI,R8    '*'
         STB,R8   0,R5
         AI,R5    1
         MBS,R4   0                 PUT OPERATION INTO HEADER
         STB,R8   0,R5
         CAL1,1   PRNTHEAD          SET THE TITLE
         B        *SR4               AND EXIT
*
HEADTYPE GEN,8,24 26,BA(HEADER)+22
         GEN,8,24 7,BA(HEADER)+30   SAVEALL
         GEN,8,24 11,BA(HEADER)+28  INCREMENTAL
         GEN,8,24 8,BA(HEADER)+30   SQUIRREL
         GEN,8,24 5,BA(HEADER)+31   PURGE
         GEN,8,24 4,BA(HEADER)+32   FILL
         GEN,8,24 14,BA(HEADER)+27  SELECTIVE FILL
         PAGE
*
*F*      NAME:    PRINTLIN
*F*
*F*      PURPOSE: SET UP THE LINE PRINTER OUTPUT LINE WITH THE
*F*               APPROPRIATE FILE NAME, ACCOUNT, SIZE, ORGANIZATION
*F*               AND REEL NUMBER FOR BACKUP, FILL AND PURGE
*F*
*D*      NAME:    PRINTLIN
*D*
*D*      REGISTERS:  R4,R5,R7,SR1,SR2,SR3,D1,D2,D3,D4 CLOBBERED
*D*      CALL:    LI,R6     SOURCE     SOURCE OF INFO FOR LINE
*D*                                      0 => BACKUP OR PURGE (F:EI)
*D*                                      1 => FILL OR SELECTIVE FILL (F:TI)
*D*                                      2 => FILL INCREMENTAL DELETETION
*D*                                           OF FILE (F:USR)
*D*               BAL,SR4   PRINTLIN
*D*      OUTPUT:  PBUFFER IS FILLED WITH THE APPROPRIATE INFORMATION
*D*               R12, R13 CONTAIN APPROPRIATE ACCOUNT FOR THE FILE
*D*
PRINTLIN EQU      %
         LW,R1    PBUFINIT
         BAL,R5   BLANKS
         LI,R5    BA(PBUFFER)+12
         LW,R4    FILETBL,R6
         LB,R8    0,R4              BYTE COUNT OF FILE NAME
         STB,R8   R5
         MBS,R4   1                 PUT FILE NAME IN PBUFFER
         LW,R5    ACCTMBS
         LW,R4    ACCTBL,R6
         MBS,R4   0                 PUT ACCOUNT NAME IN PBUFFER
         BAL,D2   SIZETBL,R6        PUT SIZE AND ORG IN PBUFFER
         LW,R5    REELTBL,R6
         LB,R4    *R5               PICK UP VOLUME NUMBER
         AI,R5    X'3C'             POINT TO SERIAL NUMBERS IN DCB
         LW,R4    *R5,R4            PICK UP THE SERIAL NUMBER
         STW,R4   REELBUF            AND PUT INTO PBUFFER
         LCI      2
         LM,R12   F:EI+32           (DOESN'T MATTER TO THOSE NOT INTERESTED)
         B        *SR4
*
TAPESIZ  EQU      %
         LW,SR1   LBLRSTO
         BAL,SR3  BINTODEC
         LD,R4    SIZMBS
         MBS,R4   0
         LB,R5    LBLORG
ORGPART  EQU      %
         LW,D3    ORGTBL,R5
         LD,R4    ORGMBS
         MBS,R4   0
         B        *D2
*
FPARSIZ  EQU      %
         LI,D4    FPAR
         B        FILESIZE
*
USERSIZ  EQU      %
         LI,D4    USER:FPAR
*
FILESIZE EQU      %
         LI,D1    X'D'              FILE SIZE VLP
         BAL,R5   LOCCODE1
         B        *D2               GET OUT, FPARAM IS TRASHED
         LW,SR1   *D4,R1
         LW,D1    D4                SAVE THE FPAR POINTER
         BAL,SR3  BINTODEC
         LD,R4    SIZMBS
         MBS,R4   0                 PUT SIZE IN THE PBUFFER
         LW,D4    D1                RESTORE FPAR POINTER
         LI,D1    X'9'              ORG FPT
         BAL,R5   LOCCODE1          ASSUMES 09 ALWAYS FOLLOWS 0D IN FPARAM
         NOP                        MUST BE THERE
         AI,D4    1                 POINT TO THE ORG WORD
         LB,R5    *D4                AND PICK IT UP
         B        ORGPART
*
FILETBL  EQU      %
         DATA     BA(F:EI+23)
         DATA     BA(F:TI+23)
         DATA     BA(F:USR+23)
ACCTBL   EQU      %
         DATA     BA(F:EI+32)
         DATA     BA(LBLACCT)
         DATA     BA(F:USR+32)
SIZETBL  EQU      %
         B        FPARSIZ
         B        TAPESIZ
         B        USERSIZ
REELTBL  EQU      %
         DATA     F:EO+11
         DATA     F:TI+11
         DATA     F:TI+11
         PAGE
*
*        BAL,R5   BLANKS
*
*        INPUT:   R1 CONTAINS MBS-FORMAT WORD TO BE BLANK FILLED
*        OUTPUT:  APPROPRIATE BUFFER IS BLANK-FILLED
*                 R0 <= 0
*                 R1 <= 1           FILL CONVENTION FOR THESE REGISTERS
*
BLANKS   EQU      %
         LI,R0    X'40'
         MBS,R0   3
         LI,R0    0                 RESTORE CONSTANT REGISTERS
         LI,R1    1
         B        0,R5
         PAGE
         USECT    DATA
*
*        THESE ROUTINES ARE INCLUDED TO PROVIDE INFORMATION
*         WHICH WILL AID IN DEBUGGING WHEN A PROBLEM OCCURS.
*
TRAPPER  EQU      %
         LCI      0                 SAVE REGS FOR SNAPPER
         STM,R0   REGS
         BAL,R3   SNAPPER           GET A DUMP
         LI,R5    FILLABRT
         CAL1,2   TYPE              SHOT DOWN IN FLAMES MESSAGE
         CAL1,9   SUPER:CLOSE       PRINT
         CAL1,9   1                 EXIT NORMALLY
*
*        BAL,R3   SNAPPER
*
*        INPUT:   ALL REGISTERS SHOULD BE STORED INTO 'REGS' BUFFER
*                 WITH A STM,R0 REGS INSTRUCTION.  SNAPPER WILL LOAD
*                 THOSE REGISTERS UPON EXIT.
*        OUTPUT:  A SNAP OF APPROPRIATE FILL DATA IS PRINTED
*        USES:    NONE
*
SNAPPER  EQU      %
         CAL1,1   TOPOFORM
         STW,R3   SNAPEXIT
         LW,D4    R3                HAVE CALLER IN REGISTERS
         LI,R4    X'A000'
         LI,R5    FILL
         LI,R6    FDATXT
         BAL,R3   SNAPSUB1
         LI,R4    J:JIT
         LI,R5    1
         LI,R6    JITXT
         BAL,R3   SNAPSUB
         LW,R4    PAGE
         LW,R5    PAGES
         BEZ      SNAPPER1
         LI,R6    INCTXT
         BAL,R3   SNAPSUB
SNAPPER1 EQU      %
         LW,R4    SEL:BUF
         BEZ      SNAPPER2
         LI,R5    1
         LI,R6    SELTXT
         BAL,R3   SNAPSUB
SNAPPER2 EQU      %
         LW,R4    PURDYN
         BEZ      SNAPPER3
         LI,R5    4
         LI,R6    PURTXT
         BAL,R3   SNAPSUB
SNAPPER3 EQU      %
         CAL1,1   TOPOFORM
         LI,R5    ERROR             TYPE ERROR MESSAGE ON OC
         CAL1,2   TYPE
         LCI      0
         LM,R0    REGS              RESTORE REGS TO POINT PRECEEDING CALL
         B        *SNAPEXIT
*
FDATXT   TEXT     'FILLDATA'
INCTXT   TEXT     'INC BUFF'
JITXT    TEXT     'FILL JIT'
SELTXT   TEXT     'SELFILL '
PURTXT   TEXT     'PURGBUFF'
*
SNAPSUB  EQU      %
         SLS,R5   9
         AW,R5    R4
         AI,R5    -1
SNAPSUB1 EQU      %
         LCI      2
         LM,R6    *R6
         STM,R6   SNAPTXT
         CAL1,3   SNAP
*
SNAP     PZE
         PZE      *R4
         PZE      *R5
SNAPTXT  RES      2
         NOP
         B        0,R3
*
SNAPEXIT RES      1
         USECT    PURE
         PAGE
*
*        BAL,SR4  GETBUF
*
*        INPUT:   R5 = # OF PAGES DESIRED FOR TOTAL BUFFER
*        OUTPUT:  R7 = # OF PAGES ACTUALLY IN TOTAL BUFFER
*                 NMPG     = SIZE IN PAGES OF BUFFER (ACTUAL)
*                 BUFSZ    = SIZE IN BYTES OF BUFFER (ACTUAL)
*                 BUF:RDZ   = SIZE IN BYTES OF BUFFER (ACTUAL)
*                 BUF       = FIRST WORD OF BUFFER
*
*        USES:    R5,R6,R7,SR1,SR2
*
GETBUF   RES      0
         LW,R7    R5                SAVE THE REQUESTED SIZE
         SH,R5    NMPG              HOW MANY MORE (OR LESS) NEEDED
         BLZ      FREESOME
         BGZ      GETSOME
         B        *SR4              JUST RIGHT, DON'T DO ANYTHING
*
FREESOME RES      0
         LCW,R5   R5                R5 <= NUMBER TO RELEASE
         CAL1,8   FREE:CM
         SLS,R5   9
         AWM,R5   BUF               ADJUST BUFFER START
*
EXIT     RES      0
         STH,R7   NMPG
         MI,R7    512*4
         STW,R7   BUFSZ
         STW,R7   BUF:RDZ
         MTW,1    BUFCHG            INFORMATION TO TUNE BUFFER SIZE
         LH,R7    NMPG
         B        *SR4
*
GETSOME  RES      0
         CAL1,8   GET:CM
         STW,R9   BUF
         SW,R5    R8
         LCW,R5   R5                R5 <= NUMBER STILL NEEDED
         AW,R7    R5                R7 <= ACTUAL PAGE SIZE
         B        EXIT
         PAGE
*
*        BAL,SR4  OPSMSG
*
*        INPUT:   R6 <= TYPE OF OPERATION CODE.
*                 (1=SAVEALL,2=INCREMENTAL,3=SQUIRREL,4=PURGE)
*                 R7 <= ACTION CODE OF OPERATION.
*                 (0=START,1=RESTART,2=SUSPEND,3=COMPLETED)
*        OUTPUT:  APPROPRIATE MESSAGE IS PRINTED ON THE OC.
*        USES:    R4,R5,R7,R8
*                 FPAR IS THE BUFFER USED
*
OPSMSG   EQU      %
         LD,R4    TAPETYPE,R6       GET MBS FOR APPROPRIATE TYPE
         MBS,R4   0                  AND PUT IN THE BUFFER
         LW,R4    STARTBL,R7        GET ADDRESS OF APPROPRIATE
         LB,R8    0,R4               ACTION AND THE COUNT.
         STB,R8   R5
         MBS,R4   1                 PUT IT INTO THE BUFFER
         LI,R7    DATE:TIME
         CAL1,8   TIME
         LI,R4    BA(DATE:TIME)
         LI,R8    16                COUNT OF THE TIME AND DATE
         STB,R8   R5
         MBS,R4   0
         AI,R5    -BA(FPAR)-1
         STB,R5   FPAR              FULL COUNT OF MESSAGE
         LI,R5    FPAR
         CAL1,2   TYPE
         B        *SR4
         TITLE    '**  READ:SCH--READ BACKUP SCHEDULE  **'
** SUBROUTINE TO CONVERT THE BACK:SCHED FILE TO TABLE OF SORTED TIMES
**
READ:SCH EQU      %
         STW,11   SVX11
         LI,3     0
         STW,3    NSCHED
         STW,3    NULTYPS
         CAL1,1   OPNSCHED
*                 ERR,ABN=SCERR; INOUT; FILE='BACK:SCHED'
RDLOOP   EQU      %
         CAL1,1   READSCHD
*                 ERR,ABN=SCERR; BUF=NTRY; SIZE=80
         LI,0     RDLOOP            RETURN FROM GETCHAR FOR NO MORE CH
         LI,1     0                 CHARACTER POSITION
         BAL,11   GETCHAR           GET A CHARACTER FROM NTRY TO REG 2
         CI,2     'S'
         BE       GOODCHAR
         CI,2     'I'
         BNE      DELR              ILLEGAL ENTRY -DELETE THE RECORD
GOODCHAR EQU      %
         BAL,11   GETCHAR
         LI,R3    3
         CB,2     TYPES,3
         BE       %+3
         BDR,3    %-2
         B        DELR              SECOND CHAR MUST BE CORRECT
         STB,3    TMPTYPE
         BAL,11   GETCHAR
         CI,2     '='
         BNE      %-2               LOOK FOR = TERMINATOR
TIMINIT  LI,3     0
         STW,R3   DATE:TIME
         STW,R3   DATE:TIME+1
         LI,3     1
TIMLOOP  BAL,11   GETCHAR
         CI,2     ':'
         BE       CVHR              CONVERT HOUR TO DEC, RESET REG3
         CI,2     ','
         BE       CVMN              CONVERT MINUTES TO DEC
         STB,2    TMPCHR,3
         AI,3     1
         CI,3     3
         BG       CKNUL             CHECK FOR NULL
         B        TIMLOOP
**
CVHR     EQU      %                 CONVERT HOUR TO HEX
         LI,7     1
         BAL,11   CVRT
         B        TIMLOOP-1
**
CVMN     EQU      %                 CONVERT MIN TO HEX AND PACK TIME
         LI,7     0
         BAL,11   CVRT
         LW,R5    DATE:TIME+1
         MI,5     60
         AWM,R5   DATE:TIME
         BEZ      TIMINIT           NO ZERO TIME
         LW,5     CURRENT           PUT JULIAN DATE IN LEFT HALF OF TIME
         SLS,5    -16
         STH,R5   DATE:TIME
         BAL,11   SORT
         B        TIMINIT
**
CVRT     LI,6     0
         AI,6     1
         CW,6     3
         BE       *11
         LB,5     TMPCHR,6
         SLS,5    -4
         CI,5     X'F'              DIGITS ONLY
         BNE      CKNUL             CHECK FOR NULL
         LW,R5    DATE:TIME,R7
         MI,5     10
         LB,4     TMPCHR,6
         AND,4    =X'F'
         AW,5     4
         STW,R5   DATE:TIME,R7
         B        CVRT+1
**
CKNUL    EQU      %                 IF TYPE IS NULL,DELETE ALL OF TYPE
         LI,4     1
         LB,5     TMPCHR,4
         CI,5     'N'
         BNE      DELR
         LB,3     TMPTYPE
         STB,3    NULTYPS,3
         B        RDLOOP
**
DELR     EQU      %                 DELETE AN INVALID RECORD
         CAL1,1   DELREC1
         B        RDLOOP
**
SZ       EQU      F:1+RWS
GETCHAR  EQU      %                 CHAR 80 IS PRESET TO ,
         LI,2     ','
         CW,1     SZ
         BE       GETXT
         BG       *0
NXTC     LB,2     NTRY,1            NEXT CHAR
GETXT    EQU      %
         AI,1     1
         CI,2     X'15'
         BE       GETCHAR
         CI,2     ' '
         BNE      *11
         CW,1     SZ
         BE       GETCHAR
         BL       NXTC
         B        *0
**                                  PLACE VALUE FROM  TIME INTO
**                                  WORD TABLE SCHED, AND TMPTYPE
SORT     EQU      %                 INTO SC:TYPE
         LW,3     NSCHED
         BEZ      SRTXT             FIRST ENTRY-PLUNK IN
         CI,R3    48
         BL       SRTLP
         LI,R5    SCHED:OVF
         CAL1,2   TYPE
SRTLP    LW,5     SCHED,3
         CW,R5    DATE:TIME
         BL       SRTXT
         LB,6     SC:TYPE,3
         AI,3     1
         STW,5    SCHED,3
         STB,6    SC:TYPE,3
         AI,3     -1
         BDR,3    SRTLP
SRTXT    LW,R5    DATE:TIME
         AI,3     1
         STW,5    SCHED,3
         LI,5     1
         AWM,5    NSCHED
         LB,5     TMPTYPE
         STB,5    SC:TYPE,3
         B        *11
**
SCERR    EQU      %
         LB,5     10
         CI,5     3                 NO SCHED FILE
         BNE      SC1
         LI,0     0
         STW,0    NSCHED
         B        *SVX11
SC1      CI,5     X'14'
         BNE      SC2
         LI,1     1
         LB,5     10,1
         SLS,5    -1
         CI,5     1                 IS SCHED BUSY
         BNE      *SVX11            NO
SLPMIN   LI,5     MINUTE            YES
         LI,1     1
         STH,5    SLP:FPT,1
         CAL1,8   SLP:FPT
         B        ESSENCE1
SC2      CI,5     6                 END OF FILE
         BNE      SC3
SC2A     EQU      %
         CAL1,1   CLSSCHED
         LW,5     NULTYPS
         BNEZ     SC4               A NULL TYPE HAS BEEN ESTABLISHD
         B        *SVX11
SC4      EQU      %
         LW,1     NSCHED
         BEZ      *SVX11
         LI,1     3
SCLP     EQU      %
         LB,5     NULTYPS,1
         BEZ      SCBDR
SCNSC    LI,4     1                 LOOK FOR TYPES IN SCHED WHICH HAVE
         LI,3     0                 BEEN SET NULL AND DELETE THEM
         LB,6     SC:TYPE,4
         LW,11    SCHED,4
         CW,6     5                 5 CONTAINS NULL TYPE
         BE       NDSCN
         AI,3     1
         STB,6    SC:TYPE,3
         STW,11   SCHED,3           PUT GOOD ENTRY ON TOP OF BAD
NDSCN    EQU      %
         AI,4     1
         CW,4     NSCHED
         BLE      SCNSC+2
         STW,3    NSCHED
SCBDR    BDR,1    SCLP
         B        *SVX11
SC3      CI,5     X'55'             TOO MANY OPEN FILES
         BE       SLPMIN            SLEEP A MINUTE
         CI,5     X'0A'
         BE       *8                ALREADY CLOSED
         CI,5     7                 SHORT BUFFER-IGNORE EXCESS
         BE       *SR1
         B        SC2A              CLOSE IF NOT CLOSED
**
         TITLE    '**  AUTOBACK/USR:BCK--WRITE TAPE FILE  **'
*
*F*      NAME:    AUTOBACK
*F*
*F*      PURPOSE: PERFORM THE BACKUP TO TAPE OF A DISC FILE FOR SCHEDULED
*F*               OR OPERATOR-INITIATED BACKUP OR PURGE.
*F*      DESCRIPTION:  THE AUTOBACK ROUTINE IS ENTERED VIA A CALL TO
*F*               AUTOBACK.  A DISC FILE HAS ALREADY BEEN SELECTED FOR
*F*               TAPE BACKUP AND THE ROUTINE PREPARES AN LP PRINT LINE
*F*               WHICH CONTAINS THE NAME OF THE FILE, ITS ACCOUNT, THE
*F*               SIZE IN GRANULES, THE ORGANIZATION AND THE TAPE THE
*F*               FILE WILL BE SAVED ON.  A USER LABEL FOR THE TAPE FILE
*F*               IS ALSO BUILT TO CONTAIN FILE-RELATED INFROMATION THAT
*F*               CANNOT BE CARRIED IN THE LABEL TAPE FILE INFORMATION.
*F*               WHEN THE DISC FILE IS CLOSED FOLLOWING BACKUP,
*F*               THE SAVE IS REMEMBERED AS WELL AS THE DATE IT OCCURRED
*F*               THE SAVE INFORMATION IS PRINTED TO THE LINE PRINTER,
*F*               ALONG WITH ANY ERROR THAT MAY HAVE OCCURRED.
AUTOBACK EQU      %   ****          BACKUP
         STW,R0   USRFLG
         STW,SR4  BACKXT
         LI,R5    0                 CHECK FOR :BREC TO BE WRITTEN
         XW,R5    NUACT                DUE TO ACCT CHANGE
         BEZ      %+2
         BAL,R5   WRT:SAV
         LW,R5    DEFAULT
         BAL,SR4  GETBUF
         B        MESSINIT
         PAGE
**
USR:BCK  EQU      %   *****         USER INITIATED BACKUP
         STW,SR4  BACKXT
         STW,SR4  USRFLG
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
OPN:BCK  EQU      %
         LW,R5    USRFLG
         BEZ      *BACKXT
         LW,R5    USERBKUP
         BEZ      *BACKXT           USER -INITIATED BACKUP NOT ALLOWED
         LW,R5    DEFAULT
         BAL,SR4  GETBUF
         LI,R6    FOREVER           PRESET SLEEP TIME
         STH,R6   SLP:FPT,R1
         CAL1,1   OPENBACK
*                 ERR,ABN=BCK:ERR,BCK:ABN; INOUT
         CAL1,1   READBACK
*                 ERR,ABN=BCK:ERR,BCK:ABN; BUF=*BUF; KEY=BCK:KEY
         LI,R6    3                 SET SQUIRREL AS OPERATION IN HEADER
         BAL,SR4  SETHEADR
         LW,R6    F:BACKUP+RWS      NUMBER BYTES READ
         BEZ      CLS:B
         LW,R5    BUF
         LCI      5
         LM,SR1   0,R5              PICK UP ENTRY AND
         STM,SR1  NXFIL              PUT INTO FPT
         LM,SR1   5,R5              ENTRY IS 10 WORDS LONG
         STM,SR1  NXFIL+5
         LCI      2
         STM,SR1  MAIL:AC           PUT CORRECT ACCOUNT INTO MAILBOX
         AI,R5    10
         STW,R5   BUF:OUT           WRITE RECORD AGAIN MINUS FIRST ENTRY
         AI,R6    -10**2            DECREMENT BY SIZE OF ENTRY
         BGZ      BCK:WRT           WRITE OUT REST OF RECORD
         CAL1,1   DELRECB
         B        BCK:CL
BCK:WRT  EQU      %
         CAL1,1   WRTBACK
*                 ERR,ABN=BCK:ERR,BCK:ABN; BUF=*BUF:OUT; KEY=BCK:KEY
BCK:CL   EQU      %
         CAL1,1   CLOSBACK
         LW,R5    DESC:MASK+3       SQ TYPE FOR USER BACKUP
         STW,R5   DESC:MASK
         CAL1,1   GDESC:EI          TEST FILE OPEN FOR DESCRIPTORS
         LH,R5    EI:DESC+1
         CI,R5    8
         BAZ      OPN:BCK           NOT MODIFIED SINCE LAST BACKUP
         MTW,0    NOTAPFG           IS A TAPE ALREADY MOUNTED?
         BNEZ     MESSINIT          YES, SKIP OPERATOR MESSAGE.
         LI,R5    UBKUPMSG
         CAL1,2   TYPE              TELL OPERATOR WHAT'S UP
         MTW,0    SQMOUNT           ARE USER BACKUP TAPES LEFT MOUNTED?
         BNEZ     MESSINIT          YES, PROCEED NORMALLY
*
*        GET THE SQUIRREL SERIAL NUMBER TO REMOUNT.
*
         LW,R6    LASTREEL
         XW,R6    SQREEL            SAVE CURRENT LASTREEL IN SQREEL
         BEZ      MESSINIT          THERE IS NO CURRENT SQREEL
         STW,R6   SQREELX
         AI,R6    -X'1F0'           OFFSET ADDITION IN DO:EO:SN
         STW,R6   LASTREEL
         BAL,SR4  DO:EO:SN          SET UP SERIAL #'S IN DCB
         LW,R6    SQREELX           SN TO USE FROM THIS SET
         LI,R7    -37
         CW,R6    SN:EO+37,R7
         BE       %+2
         BIR,R7   %-2
         AI,R7    37                GET VOLUME NUMBER WITHIN SET
         STW,R7   EO:VOL
         CAL1,1   EO:VOL:ADJ
OPENSQ   EQU      %
         CAL1,1   EOINOUT           OPEN SQ TAPE INOUT
         STW,R1   NOTAPFG
         LB,R5    LBLORG,R1         GET TYPE OF TAPE
         CI,R3    3                 IS IT A SQUIRREL TYPE?
         BE       OPENSQ1           YES, PROCEED.
         CAL1,1   CLSLAST           CLOSE AND REMOVE TAPEIF NOT SQ
         STW,R0   NOTAPFG           CLEAR THE TAPE MOUNTED FLAG
         B        MESSINIT          OPEN IT THE OTHER WAY.
OPENSQ1  EQU      %
         LB,R5    LBLORG
         CI,R5    X'F0'             LOOK FOR LAST FILE.
         BE       OPENSQ2           GOT IT
         CAL1,1   CLSEOSAV
         CAL1,1   EOINOUT           GET NEXT FILE
         B        OPENSQ1            AND CONTINUE LOOKING
OPENSQ2  EQU      %
         CAL1,1   CLSEOPTL          MOVE BACK OVER LAST FILE
         B        MESSINIT
         PAGE
MESSINIT EQU      %
         LCI      2
         LM,R12   F:EI+32           PICK UP THE ACCOUNT
         STM,R12  MAIL:AC
         STM,R12  LBLACCT
*                 SET DESCRIPTORS
         LI,R5    -1
         MTW,0    DEBUG
         BNEZ     %+2
         LW,R5    DESC:MASK
         AND,R5   EI:DESC+1         CLR BITS IN DYNAM DESC
         STW,R5   DESC:FPT+1
*
*        OPEN THE USER FILE FOR REAL THIS TIME
*
         LD,R6    FID:MBS           MOVE NAME,ACCOUNT AND PASSWORD
         MBS,R6   0                  FROM DCB TO OPEN PLIST (VPT:EI)
         BAL,R6   DATELBL           SET UP THE USER LABEL WITH DATES
         LW,R3    =X'10010202'      ADD THE BACKUP DATE TO THE
         LCI      3                  OPEN FPT SO THAT IT WILL CHANGE.
         STM,R3   VPT:EI+9+3+3
         LI,R3    3                 RESTORE THE CONSTANT
         CAL1,1   FPT:EI            OPEN USER FILE
         LI,R6    0
         BAL,SR4  PRINTLIN          BUILD THE INITIAL PRINTLINE
*                 HANDLE DESCRIPTORS FOR TAPE LABEL
         LI,D1    X'11'
         BAL,R5   LOCCODE
         B        %+2
         B        SET:DESC:VLP      FOUND, GO SET DATA
         STB,R0   *D4,R1            NOT FOUND,CLR LEI,BUILD VLP
         LB,R4    *D4,R3
         AW,D4    R4                STEP PAST LAST VLP
         AI,D4    1
         LW,R4    L(X'11010101')
         STW,R4   *D4
SET:DESC:VLP EQU  %
         LI,R4    1
         STB,R4   *D4,R2            SET NDW
         LW,R4    EI:DESC+1
         OR,R4    L(X'00000100')    SET STATIC FLAG
         AND,R4   L(X'FFFEFFFF')    CLR FILL FLAG
         STW,R4   *D4,R1
*                 NOW RESET BACKUP DATE FOR LABEL
         LI,D1    X'10'             FIND BACKUP VLP
         BAL,R5   LOCCODE
         NOP      0                 MUST BE THERE
         LCI      2
         LM,R4    LBLDATE
         STM,R4   *D4,R1            PUT BACKUP DATE IN FPAR SO
         B        BLDLABEL           BLDLABEL WILL CATCH IT.
         PAGE
*
*        BAL,R6   DATELBL
*
*        PUTS BLANKS IN FIRST WORD OV LABEL AND SETS UP
*        THE LBLDATE FIELD OF THE USER LABEL.
*        USES R4,R5,R6
*
DATELBL  LW,R4    =C'    '
         STW,R4   LBLSIZE
         STW,R0   LBLRSTO
         STW,R0   LBLORG
         LW,R4    LASTRUN
         BNEZ     %+2
         LI,R4    X'13'             OUT OF ORDER TYPE SQUIRREL
         STB,R4   LBLORG,R1         SET INTO THE FILE LABEL
         LW,R5    *DATEAD+1
         LH,R4    *TIMEAD
         STH,R4   R5
         LW,R4    *DATEAD
         LCI      2
         STM,R4   LBLDATE
         B        0,6
         PAGE
*
*        BUILD THE USER LABEL FOR TAPE FILES
*
*        FORMAT OF LABEL IS:
*
*   WORD    LABEL     CONTENTS
*                    -------------------------
*     0    LBLSIZE   : SIZE:X'40':X'40':X'40':
*                    -------------------------
*     1    LBLACCT   : THE ACCOUNT FOR THIS  :
*                    -------------------------
*     2              : FILE.                 :
*                    -------------------------
*     3    LBLORG    : ORG :TAPE :     :B=>DP:
*                    :     : TYPE:     :7=>DC:
*                    -------------------------
*     4    LBLRSTO   :  RSTORE IF RANDOM FILE:
*                    -------------------------
*     5    LBLDATE   :  M  :  M  :  D  :  D  :
*                    -------------------------
*     6              :  H  :  H  :  Y  :  Y  :
*                    -------------------------
*     7    LBLVLPS   : ALL OF THE REST OF THE:
*                    -------------------------
*     8              : VLPS ARE PUT HERE.    :
*                    -------------------------
*     9              : INCLUDED ARE THE 04,  :
*     .              -------------------------
*     .              < OF,10,0E,0A,11, AND OB<
*     .              > VLPS.                 >
*     .              -------------------------
*     N              :                       :
*                    -------------------------
         PAGE
*
LBLSIZE  EQU      BLABL
LBLACCT  EQU      BLABL+1
LBLORG   EQU      BLABL+3
LBLRSTO  EQU      BLABL+4
LBLDATE  EQU      BLABL+5
LBLVLPS  EQU      BLABL+7
*
BLDLABEL EQU      %
         LB,R6    F:EI+5,R3         GET ORG FROM DCB
         SLS,R6   -4
         CI,R6    3
         BNE      SETLORG
         LI,D1    X'09'             FIND THE DEVICE TYPE
         BAL,R5   LOCCODE            FOR RANDOM FILES (DC OR DP)
         NOP                        MUST BE THERE.
         LW,R5    *D4,R1
         LB,R5    R5,R1             KEYM HAS DEV TYPE FOR RANDOM
         STB,R5   LBLORG,R3
         INT,R5   F:EI+20           GET RSTORE FROM DCB
         STW,R5   LBLRSTO
SETLORG  EQU      %
         STB,R6   LBLORG
         CI,R6    3                 IS IT RANDOM
         BE       SETLORG0          YES, WE ALREADY HAVE THE SIZE
         LI,D1    X'D'              FILE SIZE VLP
         BAL,R5   LOCCODE
         NOP                        MUST BE THERE
         LW,R4    *D4,R1            PICK UP THE SIZE AND
         STW,R4   LBLRSTO            PUT INTO LABEL FOR FILL TO READ
SETLORG0 EQU      %
         LI,D3    X'4000'
         CW,D3    EI:DESC+1         CHECK FOR SYNONOMOUS FILE
         BAZ      SETLORG1          NOT SYNON
*
         LI,D3    X'0B'
         STB,D3   FPAR              CHANGE 01 TO 0B (PARENT NAME IN FPAR)
         LI,D4    FPAR
         LI,D3    LBLVLPS
         BAL,R5   MOVEVLP           MOVE SYNON VLP INTO LABEL
         STW,D3   REGS              SAVE THE LABEL VLP POINTER
         LI,D3    X'909'            FPAR VLP IS 9 WORDS FOR SOME REASON
         STH,D3   VPT:EI,R1          SO KEEP EVERYONE HAPPY.
         LI,D3    FPAR
         LI,D4    VPT:EI            PUT REAL FILE NAME IN FPAR(SYNON)
         BAL,R5   MOVEVLP
         LW,R1    CLORGSIZ          SIZE NOT MEANINGFUL FOR SYNON
         BAL,R5   BLANKS
         LW,D3    ORGTBL            STRAIGHTEN OUT ORG IN MESSAGE
         LD,R4    ORGMBS
         MBS,R4   0
         LW,D3    REGS              RESTORE D3
         B        SETLORG2
SETLORG1 EQU      %
         LI,D3    LBLVLPS
SETLORG2 EQU      %
         LI,R6    VLPTSIZ
NXTVLP   LB,D1    VLPTBL,R6
         BAL,R5   LOCCODE
         BAL,R7   DUMMY             NOT THERE, GET A DUMMY
         BAL,R5   MOVEVLP
         BDR,R6   NXTVLP            GET THE NEXT ONE
*
*        MOVEVLP HAS UPDATED THE POINTER IN D3 TO POINT
*         TO THE NEXT AVAILABLE LOCATION IN THE TAPE
*          LABEL BUFFER. IT NOW POINTS TO THE END.
*
         LI,R6    X'10000'
         STW,R6   *D3               INSERT AN ENDING VLP (DUMMY)
         AI,D3    1
         SLS,D3   2                 MAKE A BYTE ADDRESS
         AI,D3    -BA(LBLSIZE)-1
         STB,D3   LBLSIZE           USERLABEL SIZE
*
*        PUT ALL PARAMETERS THAT CAN BE PUT IN THE :BOF
*         FOR THE TAPE FILE IN THE OPEN FPT.  THIS INCLUDES
*          THE 03,05, AND 06 VLPS.
*
SETUPOPN EQU      %
         LI,R6    TVLPTSZ
         LI,D3    VPT:EO
         LB,D1    TVLPTBL,R6
         BAL,R5   LOCCODE
         BAL,R7   DUMMY
         BAL,R5   MOVEVLP
         BDR,R6   %-4
         LI,R6    X'10000'
         STW,R6   *D3
         B        CHKKEY
         PAGE
*
*        BAL,R5   MOVEVLP
*
*        THIS ROUTINE MOVES THE VLP POINTED TO BY D4 TO
*         THE LOCATION CONTAINED IN D3.  THE LEI FIELD OF
*          THE VLP IS RESET.
*
*
MOVEVLP  LB,R4    *D4,R3            GET SIZE OF ENTRY
         AI,R4    1
         CI,R4    6
         BG       BDRMOVE
         SLS,R4   28
         LC       R4
         LM,SR1   *D4
         STM,SR1  *D3
         SLS,R4   -28
MVEXIT   STB,R0   *D3,R1            ZAP THE LEI OF EACH VLP
         AW,D3    R4                STEP TO NEXT FREE SPOT
         B        0,R5
BDRMOVE  AI,R4    -1
         LW,SR1   *D4,R4
         STW,SR1  *D3,R4
         BDR,R4   %-2
         LW,SR1   *D4
         STW,SR1  *D3
         LB,R4    *D4,R3
         AI,R4    1
         B        MVEXIT
         PAGE
*
*        BAL,R7   DUMMY
*
*        INPUT:   D1 = CODE OF SOUGHT DUMMY VLP
*        OUTPUT:  D4 = LOCATION OF DUMMY VLP
*
DUMMY    LI,D4    DUMMYVLP
         BAL,R5   LOCCODE1
         NOP                        GOT ONE FOR EVERYBODY
         B        0,R7
         SPACE    3
*
*        TABLES USED BY BUILDLBL,SETUPOPN, DUMMY
*
VLPTBL   DATA     X'00110A0E'
         DATA     X'100F0414'
         DATA,1   X'15'
         DATA,1   X'09'
VLPTSIZ  EQU      BA(%)-BA(VLPTBL)-1
         BOUND    4
*
TVLPTBL  DATA     X'00060503'
         DATA,1   X'01'
TVLPTSZ  EQU      BA(%)-BA(TVLPTBL)-1
         BOUND    4
*
DUMMYVLP DATA     X'3000000'        PASSWORD
         DATA     X'4000000'        EXPIRATION DATE
         DATA     X'5000202'        READ ACCOUNTS
         TEXT     'ALL     '
         DATA     X'6000202'        WRITE ACCOUNTS
         TEXT     'NONE    '
         DATA     X'F000000'        ACCESS DATE
         DATA     X'10000000'       BACKUP DATE
         DATA     X'E000000'        CREATION DATE
         DATA     X'4000000'        MODIFICATION DATE
         DATA     X'11000000'       DESCRIPTORS
         DATA     X'14000202'       ACCESS ACCOUNTS
         TEXT     'ALL     '
         DATA     X'15000000'       EXECUTE VEHICLE
         DATA     X'09000000'       FILE INFORMATION
         DATA     X'10000'          END OF LIST
         PAGE
** IS THE USERS FILE KEYED
CHKKEY   RES      0
         LB,R5    LBLORG
         CI,R5    3
         BNE      NORAND
         LI,R5    1                 FORCE RANDOM TO CONSEC ON TAPE
         LI,R6    2048
         STW,R6   BUF:RDZ
         STB,R0   MOV:FPT+1,R3      DON'T FORCE BLOCK FOR RANDOM FILES
         B        OPN:TAP
NORAND   EQU      %
         STB,R1   MOV:FPT+1,R3      FORCE BLOCKING IN MOVE CAL
         CI,R5    2
         BL       OPN:TAP           CONSECUTIVE
         LB,R6    F:EI+KEYM
         BNEZ     %+2
         LI,R6    X'B'
         STW,R6   KEYMX
OPN:TAP  EQU      %
         STW,R5   EO:ORG
         LW,R5    NOTAPFG           IF NO TAPE MOUNTED...
         BEZ      NEEDSNT
         LH,SR3   SN:EO+1           CHK IF SN SET IN FPT
         CI,SR3   C'  '
         BNE      TAP:OPN
NEEDSNT  EQU      %
         BAL,SR4  NOTAPE
         LI,SR2   TAP:OPN
         PAGE
*
*        WRITE THE 'DAT' FILE ON THE FRONT OF
*        THE FIRST TAPE OF EACH VOLUME SET
*
*        THE DAT FILE CONTAINS THE CURRENT TIME AND THE
*        TYPE OF TAPE BEING WRITTEN, IE SAVEALL,INCREMENTAL, ETC
*
OPNFIRST EQU      %
         LCI      5
         LM,R11   BLABL             SAVE THE CURRENT LABEL
         LI,R5    4
         STW,R0   BLABL,R5          DAT LABEL IS ALL ZERO'S
         BDR,R5   %-1
         STW,R0   BLABL
         LI,R5    19
         STB,R5   BLABL
         LW,R4    DENSITY
         LI,R5    1                 STORE SELECTIVE MASK
         SLD,R4   26
         LCI      3
         STM,R8   REGS              SAVE REGS CLOBBERED BY SYS CAL
         CAL1,6   SYS
         STS,R4   F:EO+5
         BAL,R6   SLAVE             RETURN TO SLAVE MODE
         LCI      3
         LM,R8    REGS
         CAL1,1   OPENDAT           OPEN THE FILE.  SERIAL NUMBERS
*                                    WILL BE MERGED INTO DCB
         BAL,SR4  SAVREELNO
         LI,R7    FPAR
         CAL1,8   TIME              USE FPAR AS DATA BUFFER
         LW,R6    LASTRUN
         BNEZ     %+2
         LI,R6    3                 SET SQUIRREL TYPE FOR USER BACKUP
         STW,R6   FPAR+5
         CAL1,1   WRITDAT           WRITE THE DATA RECORD
         CAL1,1   SAVCONT
         LCI      5                 RESTORE THE USER FILE LABEL
         STM,R11  BLABL
         B        *SR2
         PAGE
TAP:OPN  EQU      %
         CAL1,1   FPT:EO
*                 ERR,ABN=TAP:ERR,TAP:ABN; OUT; SAVE
TAP:OPN1 EQU      %
         STW,SR4  NOTAPFG
         MTW,1    TAP:FILCNT
         LB,R5    F:EO+11           OUTSN NO.
         LW,R6    F:EO+X'47',R5
         STW,R6   REELBUF
RDUSR    EQU      %   ****          READ DISK-WRITE TAPE
         CAL1,1    MOV:FPT         M:MOVE CAL
*
*        RETURN FROM MOVE CAL IS TO
*           FPTERR  OR  FPTABN
*
         SPACE    3
*
*F*      NAME:    BSR1
*F*
*F*      PURPOSE: TO RETURN TO THE POINT FOLLOWING ANY CAL WHICH RESULTED
*F*               IN AN ERROR OR ABNORMAL CONDITION.
*F*      DESCRIPTION:  EXITS INDIRECT ON REGISTER 8;  REGISTER 8 HAS BEEN
*F*               SET UP BY THE MONITOR ERROR/ABNORMAL ROUTINES.
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*               (MONITOR ERROR MESSAGES)
*F*
BSR1     B        *SR1
         PAGE
*                 BACKUP RECORD NOW EMPTY
CLS:B    EQU      %
         CAL1,1   CLOSBACK
         LW,R5    SQMOUNT
         BNEZ     RELEASE           LEAVE SQ TAPE MOUNTED FOR USER BKUP
*
*        DISMOUNT AND SAVE THE TAPE AND THE SERIAL #.
*
         LW,R5    NOTAPFG
         BEZ      RELEASE           NO TAPE MOUNTED.
         LW,R6    LASTREEL
         XW,R6    SQREEL
         STW,R6   LASTREEL          RESTORE CURRENT REEL #
         BAL,R5   WRT:SAV
         BAL,SR4  ENDTAPE           CLOSE AND RELEASE THE TAPE DRIVE
RELEASE  EQU      %
         LW,R5    USRFLG
         BEZ      RELEASE1          SKIP IF AUTO ENTRY
         LW,R5    SCHED:PT          RESTORE SCHED TYPE
         LB,R4    SAVE:TYPE
         STB,R4   SC:TYPE,R5
RELEASE1 EQU      %
         LI,R5    0                 GIVE BACK EVERYTHING
         BAL,SR4  GETBUF
         B        *BACKXT
         TITLE   'ABNORMAL AND ERROR ROUTINES FOR BACKUP'
*
*F*      NAME:    BCK:ERR
*F*
*F*      PURPOSE: HANDLE ERROR RETURNS RESULTING FROM READS/WRITES OF
*F*               THE F:BACKUP FILE IN THE :SYS ACCOUNT.
*F*      DESCRIPTION:  THE CONTENTS OF REGISTER 10 DETERMINE ACTION TAKEN
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*               (MONITOR ERROR MESSAGES)
*F*
BCK:ERR  EQU      %
         LB,R4    SR3
         CI,R4    X'46'
         BE       RELEASE
         CI,R4    X'55'
         BE       BCK:ABN:WT
         B        CLS:B
*
*F*      NAME:    BCK:ABN
*F*
*F*      PURPOSE: HANDLE ABNORMAL RETURNS RESULTING FROM READS/WRITES OF
*F*               THE F:BACKUP FILE IN THE :SYS ACCOUNT.
*F*      DESCRIPTION:  THE CONTENTS OF REGISTER 10 DETERMINE ACTION TAKEN
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*               (MONITOR ERROR MESSAGES)
*F*
BCK:ABN  EQU      %
         LB,R4    SR3               ERROR CODES 3 AND 13
         CI,R4    3                     MEAN BACKUP RECORD
         BE       BLD:BACKUP
         CI,R4    X'13'
         BE       CLS:B
         CI,R4    X'14'             CANT OPEN
         BNE      BCKCNT
         LB,R5    SR3,R1
         AND,R5   R2
         BEZ      RELEASE           CANT OPEN
BCK:ABN:WT EQU    %
         LI,R5    MINUTE            JUST BUSY
         STH,R5   SLP:FPT,R1
         CAL1,8   SLP:FPT           SLEEP
         B        OPN:BCK           WAKE UP
BCKCNT   EQU      %
         LB,R4    SR3
         CI,R4    5                 END OF DATA
         BE       CLS:B
         CI,R4    6
         BE       CLS:B
         CI,R4    7                 LOST DATA
         BNE      %+3
         CAL1,1   DELRECB
         B        CLS:B               IS HARD TO BELIEVE
         CI,R4    X'0A'             ALREADY CLOSED
         BE       *SR1
         B        CLS:B
BLD:BACKUP EQU    %
         CAL1,1   OPNBACK1
*                 ERR,ABN=BSR1
         CAL1,1   CLOSBACK
*                    CREATES :BACKUP FILE
         B        RELEASE
         PAGE
*
*        ERROR/ABNORMAL ROUTINE FOR F:EO BEING OPENED INOUT
*         FOR A SPACE TO END OF TAPE, USER BACKUP COMBO.
*
SQABN    EQU      %
         LB,R6    R10
         CI,R6    X'14'
         BNE      SQABN1
         LB,R6    R10,R1
         SLS,R6   -1
         CI,R6    3                 INTERRUPT OF MOUNT CASE
         BNE      SQABN1
         AI,R8    -1
         LCI      0
         MTW,0    INT
         BEZ      *R8               CONTROL Y OR SOME SUCH
         STW,R8   ABNEXIT
         BAL,SR4  PURGE
         B        *ABNEXIT
SQABN1   EQU      %
         LCI      0
         STM,R0   REGS
         BAL,R3   SNAPPER           DON'T ANTICIPATE ANY ERRORS
         CAL1,1   OPNDEVTP          OPEN TAPE TO REMOVE IT
         CAL1,1   CLSLAST
         STW,R0   NOTAPFG           CLEAR TAPE MOUNTED FLAG
         B        MESSINIT          DO IT THE OLD WAY
         PAGE
*
*F*      NAME:    BREC:ABN
*F*      ENTRY:   BREC:ERR
*F*
*F*               F:BREC FILE IN THE :SYS ACCOUNT.
*F*      DESCRIPTION:  THE CONTENTS OF REGISTER 10 DETERMINE ACTION TAKEN
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*               (MONITOR ERROR MESSAGES)
*F*
BREC:ABN EQU      %
BREC:ERR EQU      %
         LB,R4    SR3
         CI,R4    3                 NOT EXISTING
         BNE      *SR1
         MTW,-1   BREC:CT
         BLZ      *SR1              DONT ABN LOOP FOREVER
*                 CREATE FILE
         LW,R4    SR1
         CAL1,1   OPNBREC2
*                 ERR,ABN=BSR1; OUT; SAVE
         CAL1,1   CLSBREC
         CAL1,1   BREC:ADJ          RESET ABN/ERR/INOUT
         B        -1,R4             RETRY
         PAGE
*F:EI
*                 DCB/DATA ERR ROUTINE
** ERRORS IN READING THE USER FILE
USR:ERR  EQU      %
         LB,R4    SR3
         LI,R6    #USRERRS
         CB,R4    USRERRS,R6
         BE       UERRVECT,R6       KNOW WHAT TO DO WITH THESE
         BDR,R6   %-2
         BAL,D3   WHATNOW           (DOESN'T RETURN - GOES TO NDUSR)
*
UERRVECT EQU      %
         PZE      UERRVECT
         B        ERR55             (ERR 55 - TOO MANY FILES OPEN NOW)
         B        ERR75             (ERR 75 - FILE INCONSISTENCY)
#USRERRS EQU      %-UERRVECT-1
         RES      4                 FOR EXPANSION
*
USRERRS  EQU      %
         DATA,1   0
         DATA,1   X'55'
         DATA,1   X'75'
         PZE                        FOR EXPANSION
         SPACE    2
NDUSR    EQU      %
         STW,R0   RELF
         BAL,SR2  SEND:ERR          TELL THE USER HIS PROBLEM
         MTW,0    CVOLFLAG          DOES THE FILE SPAN A TAPE?
         BEZ      NDUSR1            NO, IT'S SAVE TO PURGE TAPE FILE
         STW,R0   CVOLFLAG          CLEAR THE SPANNING FLAG
         CAL1,1   SAVCONT           AND CLOSE FILE NORMALLY.
*C* E00  NOTE THAT A PARTIAL FILE IS SAVED IN THIS CASE.  IT WILL CAUSE
*C*      PROBLEMS ON THE RESTORE SIDE, BUT PREVIOUS TAPE WILL NOT BE
*C*      REQUESTED TO PERFORM THE POSITION TO LABEL WHICH DELETES THE
*C*      TAPE FILE IN MOST CASES WHERE THE FILE IS NOT PROPERLY SAVED.
         B        NDUSR2
NDUSR1   EQU      %
         CAL1,1   CLSEOPTL          CLOSE THE TAPE FILE
NDUSR2   EQU      %
         BAL,SR4  CLRDESC           CLOSE F:EI DCB APPROPRIATELY
         B        OPN:BCK
         PAGE
USR:ABN  EQU      %
         LB,R4    SR3
         LI,R6    #USRABNS
         CB,R4    USRABNS,R6
         BE       UABNVECT,R6       WE KNOW HOW TO HANDLE THESE
         BDR,R6   %-2
         BAL,D3   WHATNOW           (DOESN'T RETURN - GOES TO NDUSR)
*
UABNVECT EQU      %
         PZE      UABNVECT
         B        NDUSR             (03 ABN - FILE DOES NOT EXIST)
         B        *SR1              (0A ABN - IGNORE CLOSE OF CLOSED)
         B        ABN14             (14 ABN - OPEN PROBLEM)
         B        *SR1              (04 ABN - IGNORE POSITION TO BOF)
#USRABNS EQU      %-UABNVECT-1
         RES      4                 FOR EXPANSION
*
USRABNS  EQU      %
         DATA,1   0
         DATA,1   X'03'
         DATA,1   X'0A'
         DATA,1   X'14'
         DATA,1   X'04'
         PZE                        FOR EXPANSION
         SPACE    3
ABN14    EQU      %
         LB,R5    SR3,R1
         SLS,R5   -1                GET SUBCODE FROM OPEN FAIL
         CI,R5    1                 IS IT A BUSY FILE?
         BNE      ABN14X            TAKE A DUMP IF NOT BUSY FILE
         PSW,R10  ENVIR             SAVE REGISTER 10 FOR SEND:ERR
         LI,R6    0                 BACKUP-TYPE PRINT LINE
         BAL,SR4  PRINTLIN          SET UP LP LINE WITH CURRENT FID
         LW,R1    CLORGSIZ          CLEAR ORG, SIZE AS NOT THERE
         BAL,R5   BLANKS
         PLW,R10  ENVIR
         B        NDUSR             AND THENCE TO SEND:ERR
*
ABN14X   EQU      %
         BAL,D3   WHATNOW           (DOESN'T RETURN - GOES TO NDUSR)
*
*   M:MOVE CALL
*                                  FPT ABN RET
FPTABN   EQU       %
         LB,R4     SR3
         LI,R6    #OFABNS
         CB,R4    ABNTABLE,R6
         BE       AVECTOR,R6
         BDR,R6   %-2
         BAL,D3   WHATNOW           (DOESN'T RETURN - GOES TO NDUSR)
*
AVECTOR  EQU      %
         PZE      AVECTOR
         B        NDUSR             (18 ABN - OUT OF ORDER KEYS)
         B        NDUSR             (16 ABN - NEWKEY FOR EXISTING KEY)
         B        ABN1C             (1C ABN - END OF TAPE)
         B        END:FILE          (05 ABN - END OF DATA)
         B        ABN07             (07 ABN - LOST DATA)
         B        END:FILE          (06 ABN - END OF FILE)
#OFABNS  EQU      %-AVECTOR-1
         RES      4                 FOR EXPANSION
*
ABNTABLE EQU      %
         DATA,1   0
         DATA,1   X'18'
         DATA,1   X'16'
         DATA,1   X'1C'
         DATA,1   X'05'
         DATA,1   X'07'
         DATA,1   X'06'
         PZE                        FOR EXPANSION
         PAGE
ABN1C    EQU      %
         AI,8     -1
         STW,8    ABNEXIT
         STW,R8   CVOLFLAG          SET TAPE SPANNED FLAG
         CAL1,1   CVOL              GET THE NEXT TAPE UP
         CAL1,1   WRITEO            WRITE OUT THE TAPE RECORD BEFORE
*                                    RESTARTING THE MOVE CAL
         B        *ABNEXIT
         SPACE    3
END:FILE EQU      %
         BAL,SR4  SAVREELNO
         STW,R0   CVOLFLAG          CLEAR THE TAPE SPANNED FLAG
         CAL1,1   SAVCONT
         CAL1,1   CLSEISAV
         LW,R6    LASTRUN
         CI,R6    4                 IS PURGE RUNNING
         BNE      %+3
         BAL,SR4  DOPURLIST         YES--PRINT PURGE MSG.
         B        OPN:BCK
         LI,R6    63
         STB,R6   PBUFFER           COUNT FOR NO ERROR
         LI,R7    HEADATE
         LW,R5    *TIMEAD
         XW,R5    MTIME
         CW,R5    MTIME
         BE       %+2
         CAL1,8   TIME              NEW TIME FOR HEADER
         CAL1,2   PRINT             LP OUTPUT OF SAVED FILE
         LW,D4    BLDMAIL           ARE WE BUILDING MAILBOXES?
         BEZ      OPN:BCK           NO.
         LW,D4    USRFLG            IF NOT A USER TYPE BACKUP
         BEZ      OPN:BCK            DON'T BUILD A MAILBOX.
         LI,R4    BA(F:EI+23)       GET FILE NAME IN MESSAGE
         LI,R5    BA(MAILBUF+3)
         LB,R6    0,R4              COUNT OF FID NAME
         STB,R6   R5
         MBS,R4   1                 MOVE FID NAME IN
*
         LI,R4    BA(MAIL1)         FILLER STUFF
         LB,R6    0,R4
         STB,R6   R5
         MBS,R4   1
*
         LI,R4    BA(REELBUF)
         LI,R6    4
         STB,R6   R5
         MBS,R4   0                 REEL NUMBER TO MESSAGE
*
         AI,R5    -BA(MAILBUF)-1
         STB,R5   MAILBUF           COUNT OF FULL MESSAGE
         STW,R1   NOPRINT           DISABLE LP PRINT IN MAILBOX
         LI,SR3   MAILPAR
         BAL,SR4  MAILBOX
         STW,R0   NOPRINT           TURN NOPRINT FLAG OFF
         B        OPN:BCK
         SPACE    3
ABN07    EQU      %
         LH,R12   NMPG
         LW,R5    R12
         CW,R5    DEFAULT           HAVE WE BEEN HERE BEFORE?
         BNE      %+3               IF UNEQUAL, GET BIG NUMBER
         AW,R5    PGINCRM
         B        %+2
         AI,R5    255               GET A WHOLE BUNCH MORE
         BAL,SR4  GETBUF
         CW,R12   R7
         BE       NDUSR             COULDN'T GET ANY MORE
         CAL1,1   PRECOREI
         MTW,1    RELF              SET ADDED CORE FLAG
         B        RDUSR
         PAGE
FPTERR   EQU      %
TAP:ERR  EQU      %
         LB,R4    SR3               GET ABNORMAL CODE
         LI,R6    #OFERRS
         CB,R4    ERRTABLE,R6       FIND MATCH IN
         BE       EVECTOR,R6         ERRORS WE KNOW HOW TO HANDLE
         BDR,R6   %-2
         BAL,D3   WHATNOW           (RETURNS TO NDUSR)
*
EVECTOR  EQU      %
         PZE      EVECTOR
         B        ERR57
         B        ERR56
         B        ERR55
         B        ERR49
         B        NDUSR             (ERR 41 - READ ERROR ON FILE)
         B        ERR45
         B        ERR75
         B        ERR42
#OFERRS  EQU      %-EVECTOR-1
         RES      4                 FOR ADDING NEW ERR HANDLERS
ERRTABLE EQU      %
         DATA,1   0
         DATA,1   X'57'
         DATA,1   X'56'
         DATA,1   X'55'
         DATA,1   X'49'
         DATA,1   X'41'
         DATA,1   X'45'
         DATA,1   X'75'
         DATA,1   X'42'
         PZE                        FOR EXPANSION PURPOSES
         PAGE
WHATNOW  EQU      %
         BAL,SR4  IGIVEUP           GET A SNAP OF THIS ONE
         B        NDUSR             TELL USER AND GO ON.
         SPACE    3
IGIVEUP  EQU      %
         LCI      0
         STM,R0   REGS
         LW,R3    SR4               FOR RETURN FROM SNAPPER
         B        SNAPPER
         SPACE    3
ERR56    EQU      %
         MTW,0    INT               CHECK FOR OPERATOR INTERRUPTION
         BEZ      WHATNOW
         AI,SR1   -1
         B        PURGCALL          RETURN IS BACK TO CAL FOR 56
         SPACE    3
ERR57    EQU      %
         BAL,SR4  IGIVEUP           THIS SHOULDN'T HAPPEN
ERR45    EQU      %
         STW,SR4  CVOLFLAG          SET THE VOLUME SWITCHED FLAG
         CAL1,1   CVOL
         CAL1,1   WRITEO            WRITE OUT THE CURRENT TAPE BLOCK
*                                    BEFORE RESTARTING MOVE CAL
         B        TAP:OPN1           AND PROCEED WITH COPY
*
*        ERR 42 MIGHT JUST BE END OF RANDOM FILE
*
ERR42    EQU      %
         LI,R11   X'1FFFF'
         CS,SR3   MOV:FPT           IS ERR ON INPUT DCB?
         BNE      WHATNOW            NO, MUST BE AN ERROR
         CB,R3    LBLORG            IS IT RANDOM FILE?
         BNE      WHATNOW           GET A SNAP..SHOULDN'T HAPPEN
         B        END:FILE          CLOSE IT OUT
         PAGE
TAP:ABN  EQU      %
         LB,R4    SR3
         LI,R6    #TAPABNS
         CB,R4    TAPABNS,R6
         BE       TABNVECT,R6
         BDR,R6   %-2
         BAL,D3   WHATNOW           (DOESN'T RETURN - GOES TO NDUSR)
*
TABNVECT EQU      %
         PZE      TABNVECT
         B        NDUSR             (16 ABN - NEWKEY FOR EXISTING KEY)
         B        TAPABN2E          (2E ABN - OPEN OF ALREADY OPENED)
         B        *SR1              (0A ABN - CLOSE OF ALREADY CLOSED)
         B        TAPABN14          (14 ABN - OPEN PROBLEM)
#TAPABNS EQU      %-TABNVECT-1
         RES      4                 FOR EXPANSION
*
TAPABNS  EQU      %
         DATA,1   0
         DATA,1   X'16'
         DATA,1   X'2E'
         DATA,1   X'0A'
         DATA,1   X'14'
         PZE                        FOR EXPANSION
         PAGE
TAPABN2E EQU      %
         STW,R8   ABNEXIT
         BAL,SR4  IGIVEUP           GET A SNAP, THIS SHOULDN'T HAPPEN
         CAL1,1   CLSEOSAV          CLOSE THE OFFENDING DCB
         BAL,SR4  SAVREELNO
         MTW,-1   ABNEXIT
         B        *ABNEXIT
         SPACE    3
TAPABN14 EQU      %
         LB,R4    R10,R1            GET SUBCODE
         SLS,R4   -1
         CI,R4    3                 BRK OR CONTROL-Y
         BNE      TAP1412           MAYBE THE DENSITY ABNORMAL
         AI,SR1   -1                POINT BACK TO THE CAL
         MTW,0    INT
         BEZ      *SR1              NOT A BREAK, TRY AGAIN
PURGCALL EQU      %
         LCI      0
         PSM,R0   ENVIR             SAVE THE REGISTERS
         BAL,SR4  PURGE
         LCI      0
         PLM,R0   ENVIR             RESTORE THE REGISTERS
         B        *SR1
         SPACE    1
TAP1412  EQU      %
         CI,R4    X'12'
         BNE      CONT6
         LI,R4    0
         LI,R5    1
         SLS,R5   26                RESET THE DSF FLAG IN DCB
         LCI      3
         STM,SR1  REGS              SAVE REGS CLOBBERED BY SYS CAL
         CAL1,6   SYS
         STS,R4   F:EO+5            RESET BIT 5, WORD 5
         BAL,R6   SLAVE
         LCI      3
         LM,SR1   REGS
         AI,SR1   -1
         B        *SR1              RETRY THE OPEN
CONT6    EQU      %
         LCI      0
         STM,R0   REGS
         BAL,R3   SNAPPER
         LI,R5    TROUBL
         CAL1,2   TYPE
         BAL,SR4  ZAPTAPE
         CAL1,9   SUPER:CLOSE
         B        RIP
         PAGE
ERR49    EQU      %
         LI,R5    NOTAPMSG
         CAL1,2   TYPE
*FOR ERROR 49, FIRST TYPE NO TAPES MESSAGE
ERR55    EQU      %
*FOR ERROR 49 OR 55, WAIT 2 MINUTES AND TRY AGAIN
         LW,10    F:EI
         CW,10    MY002
         BAZ      %+3
         CAL1,1   CLOSEI
         MTW,1    OPNFLAG
         LI,SR3   MINUTE+MINUTE     2 MINUTES
         STH,SR3  SLP:FPT,R1
         CAL1,8   SLP:FPT
         MTW,0    INT               OPERATOR INTERRUPT?
         BEZ      ERR491            NO, NORMAL WAKE UP
         LCI      0
         PSM,R0   ENVIR             SAVE THE REGISTERS
         BAL,SR4  PURGE             FIND OUT WHAT OPERATOR WANTS
         LCI      0
         PLM,R0   ENVIR
ERR491   EQU      %
         MTW,0    OPNFLAG
         BEZ      %+3
         MTW,-1   OPNFLAG
         CAL1,1   OPENEI
         MTW,-1   SR1               RE-EXECUTE CAL1
         B        *SR1
*
ERR75    EQU      %
         LCI      3
         PSM,SR1  ENVIR             SAVE VOLATILE REGS
         LI,R6    0                 BACKUP TYPE PRINT LINE
         BAL,SR4  PRINTLIN
         LW,R1    CLORGSIZ          CLEAR THE ATTRIBUTES AS THEY
         BAL,R5   BLANKS             ARE PROBABLY GARBAGE
         LW,SR3   *ENVIR            PICK UP THE ERROR CODE AGAIN
         BAL,SR2  SEND:ERR
         LI,R5    ERRBUF
         CAL1,2   TYPE
         CAL1,1   CLSEOPTL          CLOSE TAPE AND
         CAL1,1   CLSEISAV           FILE DCB'S IF OPEN
         LCI      3
         PLM,SR1  ENVIR             RECOVER THE REGS
         LB,R6    R10,R1            GET SUBCODE OF 75 ERROR
         SLS,R6   -1
         CI,R6    4
         BL       OPNNXF            ONLY FILE IS BAD
         STW,R0   DYPAGES           ACCOUNT IS BAD; DONT USE
         B        CLEANUP1           FILE LIST THAT MAY EXIST.
         PAGE
DT:ERR   EQU      %                 OPEN USER FILE
**
         LB,R5    SR3               ERR CODE
         CI,R5    2                 NO MORE FILE IN THIS ACCT
         BE       CLEANUP
         CI,R5    8
         BE       *SR1              SYNON OK
         CI,R5    X'A'
         BE       *SR1              ALREADY CLOSED
         CI,R5    X'75'
         BE       ERR75
         BAL,SR2  SEND:ERR
         LCI      0
         STM,R0   REGS
         BAL,R3   SNAPPER
         CI,R5    X'14'
         BE       OPNNXF            CANT OPEN
         CI,R5    X'55'
         BNE      DTCNT1            TOO MANY OPEN FILES
         B        ERR55
DTCNT1   EQU      %
         CAL1,1   CLSEI
         B        OPNNXF
*
*WRITE SPECIAL FILE, RELEASE DYNAMIC PAGES
*
CLEANUP  EQU      %
         CI,SR3   X'20000'          CHK NO MORE ACCTS
         BANZ     NOMORE
*                    DO FILE LIST ONLY FOR INCREMENTAL
CLEANUP1 RES      0
         LW,R5    SCHED:PT
         LB,R5    SC:TYPE,R5
         CI,R5    2
         BNE      SPDONE10
         MTW,0    COUNT
         BEZ      SPDONE10          NO ENTRIES FOR THIS ACCOUNT
         LCI      2
         LM,R4    ADJ:ACCT
         STM,R4   LBLACCT
         BAL,R6   DATELBL
         LW,R5    PAGES
         STB,R5   LBLORG,R2         PAGE SIZE OF FILE LIST
         LW,R5    DYPAGES
         AI,R5    1
         STB,R5   LBLORG,R3         0 => NORMAL FILE LIST
*                                   1 => TRUNCATED FILE LIST
         LI,R5    X'FF'
         STB,R5   LBLORG            FILE LIST IDENTIFIER
         LI,R5    27
         STB,R5   LBLSIZE
         LW,R5    NOTAPFG
         BEZ      CLEANUP2          TAPE NOT UP YET..SET UP SN'S
         LH,R5    SN:EO+1           DOUBLE CHECK TO SEE THAT SN'S
         CI,R5    X'4040'            ARE ACTUALLY IN THE FPT
         BNE      SPOPEN
CLEANUP2 EQU      %
         BAL,SR4  NOTAPE
         BAL,SR2  OPNFIRST
         STW,R3   NOTAPFG
SPOPEN   RES      0
         CAL1,1   OPENSPEC
         MTB,0    LBLORG,R3
         BNEZ     SPDONE            NO INDEX TO WRITE
         CAL1,1   WRTSPEC
SPDONE   EQU      %
         CAL1,1   SAVCONT
         BAL,SR4  SAVREELNO
SPDONE10 EQU      %
         LW,5     PAGES
         BEZ      %+3
         STH,5    REL:DY,R1         RELEASE DYNAMIC PAGES
         CAL1,8   REL:DY
         STW,R0   PAGES
         LI,R5    -1
         STW,R5   DYPAGES
         B        NXT:ACT           GO GET NEXT ACCOUNT
         PAGE
*F:EO
*                 OUTPUT FILE LIST ABN/ERR
SPOPN    EQU      %
SPWRT    EQU      %
         LB,R5    SR3
         CI,R5    X'A'
         BE       *SR1
         B        SPDONE
**
** SEND ERROR MESSAGE TO USER      I/O CODE IN SR3, BAL,SR2
SEND:ERR EQU      %
         LI,SR4   0
         SCD,SR3  8
         SLS,SR3  -1
         SCD,SR3  8
         SLS,SR4  16                CODE TO LEFT HALFWORD
         LI,SR3   0
         LI,D1    4
SEND:1   EQU      %
         SLS,SR3  4
         SLD,SR3  4
         AI,SR3   X'F0'
         LB,SR1   SR3,R3
         CI,SR1   X'F9'
         BLE      %+2
         AI,SR3   -X'39'            .FA-.39=.C1, ETC.
         BDR,D1   SEND:1
         STW,SR3  ERRCODE
         LD,R4    ERRMBS
         MBS,R4   0
         LI,R6    91
         STB,R6   PBUFFER           ERROR MESSAGE COUNT
*
*E*      ERROR
*E*      DESCRIPTION:  ANY AVAILABLE FILE INFORMATION (NAME, ACCOUNT,
*E*               SIZE, ORGANIZATION) IS DISPLAYED FOLLOWED BY THE TEXT
*E*               '*FAILED*  ERROR CODE: XXXX' (WHERE XXXX IS THE MONITOR-
*E*               SUPPLIED ERROR CODE) IS PRINTED ON THE LINE PRINTER
*E*
         CAL1,2   PRINT
         LW,D4    BLDMAIL           DO WE BUILD MAILBOXES?
         BEZ      *SR2              NO.
*
         LI,R4    BA(F:EI+23)
         LI,R5    BA(ERRBUF+3)
         LB,R6    0,R4
         STB,R6   R5
         MBS,R4   1                 FID NAME TO ERROR MSG
*
         LI,R4    BA(FAILMSG)
         LI,R6    28
         STB,R6   R5
         MBS,R4   0                 ERROR CODE TO MESSAGE
*
         AI,R5    -BA(ERRBUF)-1
         STB,R5   ERRBUF            FULL COUNT OF MESSAGE
         STW,R1   NOPRINT           DISABLE LP PRINT FROM MAILBOX
         LI,SR3   MAILERR
*
*E*      ERROR
*E*      DESCRIPTION:  A MESSAGE OF THE FORM 'BACKUP OF FID *FAILED* ERROR
*E*               CODE:  XXXX' IS BUILT IN A MAILBOX FILE IN THE AFFECTED
*E*               USER'S ACCOUNT.  THE MESSAGE ALSO CONTAINS THE DATE
*E*               AND THE ACCOUNT UNDER WHICH THE ATTEMPTED BACKUP WAS
*E*               RUN (USUALLY :SYS)
*E*
         BAL,SR4  MAILBOX
         STW,R0   NOPRINT           TURN NOPRINT OFF
         B        *SR2              RETURN
         END

