         SYSTEM   SIG7
*
*        ALL THE DEFS IN BACKUP FOLLOW
*
         DEF      BACKUP,BACKUPD,NOTAPFG
         DEF      NXACCT,MAIL:AC,ADJ:ACCT
         DEF      NMPG,BUFSZ,BUF
         DEF      KEYLOC,RELEASE,BACKXT
         DEF      CURRENT,REELTMP,LASTREELX
         DEF      SLP:FPT,BLABL,DO:TIME
         DEF      BSR1,BB1,DO:REGS4
         DEF      BCK:ERR,BCK:ABN,PURGEXIT
         DEF      FPAR,TAP:ABN,BREC:ERR
         DEF      USR:ABN,USR:ERR,BREC:ABN
         DEF      ENVIR,MTIME,DEFAULT
         DEF      AUTOBACK,ERR49,ERR55
         DEF      DUMMY,GETBUF,LASTRUN
         DEF      LOCCODE,LOCCODE1,MOVEVLP
         DEF      TAPETYP,TAP:ERR,TVLPTBL
         DEF      VLPTBL,LASTREEL,LASTACCT
         DEF      USERBKUP,SQMOUNT,BLDMAIL
         DEF      PURGTAP,OCDISP,ZAPTAPE
         DEF      SAVEALL,INCRMNTL,SQUIRREL
         DEF      QUIT,SUSPEND,RESTART
         DEF      ENDTAPE,WRT:SAV,SUSPACCT
         DEF      SUSPNDED,TRAPPER,SNAPPER
         DEF      DATACCT,EOACCT,VLPTSIZ
         DEF      TVLPTSZ,PGINCRM
*
*        ALL THE REFS IN BACKUP FOLLOW
*
         REF      DATEAD,DATE1AD,TIMEAD
         REF      F:SEL,F:EI,F:BACKUP
         REF      F:BREC,F:EO,NO:FILL
         REF      F:1,FMAILBX,PURADJFID
         REF      SELFILL,SELKEY,BADCOM
         REF      MAILBOX,INT,PURGEFLAGAD
         REF      JULIAN,DEBUG,DOPURLIST
         REF      KEYIN,PURADJ,DOPURDEL
         REF      PURGE,TRUNC,TYPE
         REF      TAPETYPE,FILL,BINTODEC
         REF      EI:DESC,M:LL,NOPRINT
         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
KEYMAX   EQU      20
VPT:SIZ  EQU      112
SUPER:CLOSE EQU   6
BLABSZ   EQU      64
         PAGE
MOVE:FLD CNAME
         PROC
         LOCAL    P,LUP,LI,LW
LI       SET     X'22'
LW       SET      X'32'
P        DO       2
         GEN,8,4,20  LI*(AFA(P)=0)+LW*(AFA(P)),3+P,AF(P)  DOES LW/LI FOR
*                 R4/R5 WITH/WITHOUT ASTERISK
         FIN
LUP      LB,3    *4,3               NAW
         LB,2    *4,1               LEI
         AI,3     1
         STB,3    5                 SET BYTE COUNT
         SLD,4    2                 R4,R5 TO BA
         MBS,4    0
         SLD,4    -2                BACK TO WA
         LI,3     3                 RESTORE CONSTANT
         CI,2     0                 CHECK FOR LEI
         BE       LUP               GO DO ANOTHER VLP
         LI,2     2                 RESTORE CONSTANT
         PEND
         TITLE    '  **  DATA  **  '
         USECT    DATA
BACKUPD  RES      0
ENVIR    DATA     %+1
         GEN,16,16  16,0
         RES      16
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
GET:DB   GEN,1,7,24   1,X'04',R6
FREE:DB  GEN,1,7,24   1,X'05',R6
DEFAULT  PZE      1
PGINCRM  PZE      40                20K 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     RES      1                 ADDRESS OF FIRST DYNAMIC PAGE
PAGES    RES      1                 NUMBER OF DYNAMIC PAGES OBTAINED
NUACT    DATA     0                 1=NEW ACCT IN :BREC,WRITE IT
NTBL     DATA     0                 NUMBER OF LOCKED FILES
TABLE    RES      50                TABLE FOR LOCKED FILES
TABLOC   DATA     BA(TABLE)         POINTER TO CURRENT POSITION IN TABLE
TABFIX   DATA     BA(TABLE)
COUNT    RES      1
MAIL:AC  RES      2
MAILPAR  PZE      MAILBUF
         PZE      MAIL:AC           RECIPIENT ACCOUNT
MAILERR  PZE      ERRBUF
         PZE      MAIL:AC
PBUFINIT GEN,8,24 23*4-1,BA(PBUFFER)+1
PBUFFER  RES      23
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'
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     '    '
         TEXT     ' CON'
         TEXT     ' KEY'
         TEXT     ' RAN'
KEYLOC   RES      KEYMAX
         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)
FIDMBS   DATA     BA(F:EI+23)
         DATA     BA(PBUFFER)+12
ACCTMBS  DATA     BA(NXACCT)
         GEN,8,24 8,BA(PBUFFER)+2
UACCTMBS DATA     BA(NXFILACT+1)
         GEN,8,24 8,BA(PBUFFER)+2
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
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.
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
PURGEXIT  DATA    0
FTAPX    DATA     0
ABNEXIT  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'
*                     DESC:MASK IS MASKS FOR CHANGING DYNAM DESC
BSR1     B        *SR1
SAVKEY   TEXTC    'SAV'
** DATA FOR READING BACKUP SCHEDULE -READ:SCH
SC:TYPE  RES,1    48                TYPE TO MATCH ENTRY IN SCHED
SCHED    PZE
         RES      48
TYPES    TEXTC    'ANQR'            SECOND LETTER OF TYPE
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  **  '
         USECT    DATA
**
** INPUT USERS FILE
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
*
*  FPT FOR THE M:MOVE CAL
*
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
         SPACE    2
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'C74C023A'
         DATA     TAP:ERR
         DATA     TAP:ABN
EO:ORG   DATA     1
         DATA     1,2,2             SEQUEN,OUT,SAVE
KEYMX    PZE      3
EOTYPE   DATA     0                 DEVICE TYPE
         DATA     X'02000202'
EOACCT   TEXT     ':SYS    '
VPT:EO   RES      50
         PAGE
*                 TEST FILE-INPUT   CHECK IF NEEDS BACKUP
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    3
**                FIND NEXT ACCOUNT
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    3
*                 TEST FILE TO GET DESC FOR SELECTIVE B.U.
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    DATA     X'01000008',X'00000000',0,0,0,0,0,0,0  FID VLP
NXFILACT DATA     X'02000002',0,0
         DATA     X'03000002',0,0   PASS VLP
         DATA     X'00010001',0     DUMMY VLP FOR DELETE FLAG
         SPACE    2
CHK:SEL  GEN,8,7,17  X'14',4,F:SEL    TEST FILE FOR F:SEL
         DATA     X'C0000000',NOSELF,NOSELF
BREC:ADJ GEN,8,7,17  X'14',0,F:BREC    ADJ DCB
         DATA     X'00002000',X'C1000000'
         DATA     BREC:ERR,BREC:ABN,4
SAVCONT  DATA     X'15'**24+F:EO,X'80000040',2  CLOSE FPT-NO LABELS
OPENDAT  GEN,8,24 X'14',F:EO
         DATA     X'C744000A'
         DATA     TAP:ERR
         DATA     TAP:ABN
         DATA     1,1,2,2
DATTYPE  DATA     0
         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
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
OPNBREC1 GEN,8,24 X'14',F:BREC
         DATA     X'C1400000'
         DATA     BREC:ERR
         DATA     BREC:ABN
         DATA     4,2
         SPACE    2
RDBREC1  GEN,8,24 X'10',F:BREC
         DATA     X'F8000000'
         DATA     BSR1
         DATA     BSR1
         DATA     SAVEBUF
         DATA     SAVESIZ*4
         DATA     SAVKEY
         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
WRTBACK1 GEN,8,24 X'11',F:BACKUP
         DATA     X'F8000040'
         DATA     BCK:ERR
         DATA     BCK:ABN
         DATA     TABLE
         PZE      *R6
         DATA     BCK:KEY
         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'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,0
         SPACE    2
PRINT    DATA     1**24
         PZE      *0
         DATA     PBUFFER
         TITLE    '**  MAIN PROGRAM  **'
         USECT    PURE
** AUTOMATIC BACKUP
BACKUP   EQU      %
         LI,R7    HEADATE
         CAL1,8   TIME              PUT CURRENT TIME INTO HEADER
         CAL1,1   PRNTHEAD          OUTPUT HEADING
         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
         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      %
         CAL1,1   OPNBREC1
*                 ERR,ABN=BREC:ERR; INOUT; SAVE
         CAL1,1   RDBREC1
*                    ERR/ABN=BSR1,BUF=SAVBUF,KEY=SAVKEY
         LI,R7    F:BREC
         CAL1,1   TRUNC
         LW,R7    NSCHED
         BEZ      NOSCHD
         LW,R6    LASTRUN
         BEZ      FIND:NXT
*
*        THE SYSTEM CRASHED OR A SUSPENDED OPERATION WAS RESTARTED.
*         BUILD THE APPROPRIATE RESTART MESSAGE AND RESUME THE
*          BACKUP OR PURGE THAT WAS INTERRUPTED.
*
         LI,R7    1                 RESTARTED MESSAGE CODE
         BAL,SR4  OPSMSG
         STB,R6   SC:TYPE,R1
         LW,R5    LASTREEL
         BAL,SR3  SET:EO:SN
         MTW,1    EO:VOL
         CAL1,1   EO:VOL:ADJ
         LW,R6    LASTACCT
         LW,R7    LASTACCT+1
         STW,R6   NXACCT
         STW,R7   NXACCT+1
         LW,R8    TAPETYP           GET THE DEFAULT TAPE TYPE
         STW,R8   EOTYPE
         STW,R8   DATTYPE
         B        OPX
         PAGE
SAVEALL  EQU      %
         LI,D4    1
         B        STRTBKUP
INCRMNTL EQU      %
         LI,D4    2
         B        STRTBKUP
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.
         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
         LW,R6    NXACCT
         LW,R7    NXACCT+1
         STW,R6   LASTACCT
         STW,R7   LASTACCT+1
         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
         SPACE    2
         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      %
         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
         STW,R0   *PURGEFLAGAD      SET PURGE BUSY
         B        BACKUP
**
CKCEQ    LW,R4    SCHED,R7          ARE THERE TWO ENTRIES WHICH
         AI,R4      15
         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
         SPACE    5
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
SET:EO:SN EQU     %
         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        *SR3
         SPACE    5
WRT:SAV  EQU      %   ****          WRITES SAV RECORD IN :BACKUP
         CAL1,1   WRTBREC
*                 ERR,ABN=BSR1; BUF=LASTSAV; KEY=SAVKEY; ONEWKEY
         LI,R7    F:BREC
         CAL1,1   TRUNC
         B        *R5
         SPACE    5
ESSENCE  STW,SR4  BACKXT   ****
ESSENCE1 EQU      %
         BAL,SR4  DO:TIME           SET CURRENT
         BAL,SR4  DO:SCH            BUILD SCHED TABLES
         B        DO:REGS
         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
         SPACE    2
DO:REGS4 EQU      %
         STW,SR4  BACKXT
DO:REGS  EQU      %   **
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         B        *BACKXT
         SPACE 3
SAVE:NAME EQU     %   ****
*                 SAVES NAME VLP,ETC, IF ROOM IN TABLE
         LW,R5    TABLOC
         CI,R5    BA(TABLOC)-56
         BGE      *SR2
         SLS,R5   -2                ADJUST TO WA
         LW,D2    R5
         MOVE:FLD *BUF,*D2
*                 IF A BACKUP-PURGE, ADD GRANS TO NINPROGRAN
         AI,R5    -2
         LW,R7    *R5
         AI,R5    2
         SLS,R5   2                 BACK TO BA
         STW,R5   TABLOC            SAVE FOR NEXT TIME
         AWM,R1   NTBL
         B        *SR2
         SPACE 3
SAVREELNO EQU     %   ****          FIND & SAVE CURRENT REEL NO
         LB,R4    F:EO+11           PICK UP VOLUME NUMBER
         LW,R4    F:EO+X'44',R4     GET CORRESPONDING REEL #
         STW,R4   LASTREEL
         XW,R4    LASTREELX
         CW,R4    LASTREELX
         BE       *SR3              IF CHANGED, SAVE
         LW,R5    SR3
         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'FF'
         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      %
         LW,R6    LASTRUN
         BEZ      BADCOM
         CI,R6    6
         BG       BADCOM
         LI,R7    4                 TERMINATION CODE
         BAL,SR4  OPSMSG
*
         LH,R8    F:EO
         CI,R8    X'200'
         BAZ      %+2
         CAL1,1   CLSEOPTL
         BAL,SR4  ZAPTAPE           CLOSE OUT TAPE ABNORMALLY
         LH,R8    F:EI
         CI,R8    X'200'
         BAZ      %+2               ALREADY CLOSED
         CAL1,1   CLSEISAV
         STW,R0   LASTRUN
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         BAL,R5   WRT:SAV
         B        NO:FILL
         PAGE
SUSPEND  EQU      %
         LW,R5    LASTRUN
         BEZ      BADCOM
         CI,R5    4
         BG       BADCOM
         STW,R5   SUSPNDED
         LCI      2
         LM,R4    LASTACCT
         STM,R4   SUSPACCT
         STW,R0   LASTRUN
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         BAL,R5   WRT:SAV
         B        NO:FILL
         PAGE
RESTART  EQU      %
         LW,D4    SUSPNDED
         BEZ      BADCOM
         CI,D4    4
         BG       BADCOM
         STW,D4   LASTRUN
         LCI      2
         LM,R4    SUSPACCT
         STM,R4   LASTACCT
         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
*
*        THESE ROUTINES ARE INCLUDED TO PROVIDE INFORMATION
*         WHICH WILL AID IN DEBUGGING WHEN A PROBLEM OCCURS.
*
TRAPPER  EQU      %
         BAL,R3   SNAPPER           GET A DUMP
         CAL1,9   3                  AND ABORT
*
SNAPPER  EQU      %
         CAL1,3   SNAP
SRETURN  EQU      %
         CAL1,9   SUPER:CLOSE
         B        0,R3
*
*
SNAP     DATA     0
         DATA     X'A000'
         DATA     FILL
         TEXT     'FILLDATA'
         NOP
         B        SRETURN
         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
         MTW,0    DEBUG
         BNEZ     FREEDB            DELTA'S PRESENCE OBNOXIOUS
         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
*
FREEDB   RES      0
         LW,R6    BUF
         CAL1,8   FREE:DB           RELEASE N VIRTUAL PAGES
         AI,R6    X'200'
         BDR,R5   %-2
         STW,R6   BUF               NEW BOTTOM OF BUFFER
         MTW,1    BIGBUF            MORE INFORMATION
         B        EXIT
*
GETSOME  RES      0
         MTW,0    DEBUG
         BNEZ     GETDB
         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
*
GETDB    RES      0
         LI,R6    X'1C000'
         MTH,0    NMPG              ARE THERE ANY CURRENT PAGES?
         BEZ      %+2               NO
         LW,R6    BUF               YES, START FROM WHERE WE ARE
PGELOOP  AI,R6    -X'200'           STEP TO NEXT LOWER AVAIL PAGE
         CI,R6    X'D000'           APPROX BOTTOM AVAILABLE TO GET
         BE       LOOPEND
         CAL1,8   GET:DB
         BCS,8    PGELOOP           DIDN'T GET, TRY AGAIN
         STW,R6   BUF               NEW BOTTOM OF BUFFER
         MTH,1    NMPG              BUMP PAGE SIZE OF BUFFER
         BDR,R5   PGELOOP           GET ANOTHER
LOOPEND  MTH,0    NMPG
         BEZ      X'2000'           DIDN'T GET ANY AT ALL
         LH,R7    NMPG              R7 <= TOTAL BUFFER SIZE IN PGS
         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     'W'
         BE       GOODCHAR
         CI,2     'S'
         BE       GOODCHAR
         CI,2     'I'
         BNE      DELR              ILLEGAL ENTRY -DELETE THE RECORD
GOODCHAR EQU      %
         BAL,11   GETCHAR
         LI,3     4
         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
         CI,3     4                 WRAPUP
         BE       RDLOOP
         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  **'
**
**                                  SUBROUTINE ENTRY FOR AUTOMATIC
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        MVENT
         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
         LW,R6    F:BACKUP+RWS      NUMBER BYTES READ
         BEZ      REC:MPTY          RECORD IS EMPTY
         MOVE:FLD *BUF,NXFIL        MOVE ENTRY
         STW,R4   BUF:OUT
         SW,R4    BUF               BYTE COUNT MOVED
         SLS,R4   2
         CW,R4    R6                BYTES MOVED : BYTES READ
         BL       BCK:WRT
         CAL1,1   DELRECB
         B        BCK:CL
BCK:WRT  EQU      %
         SW,R6    R4
         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    SQMOUNT           ARE SQUIRREL TAPES LEFT MOUNTED?
         BNEZ     MVENT             YES.
*
*        GET THE SQUIRREL SERIAL NUMBER TO REMOUNT.
*
         LW,R6    SQREEL            GET LAST TAPE USED FOR USER BACKUP
         BEZ      MVENT             ISN'T ANY, PROCEED NORMALLY
         STW,R6   SQREELX           SAVE CURRENT NUMBER
         XW,R6    LASTREEL
         STW,R6   SQREEL
         LW,R6    SQREELX           GET SQ TAPE NUMBER AGAIN
         AI,R6    -X'1F0'           OFFSET ADDITION IN DO:EO:SN
         STW,R6   LASTREEL
         BAL,SR3  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
         PAGE
MVENT    EQU      %   *****         COMMON WRITE TAPE ROUTINE
         LI,R0    X'40'
         LW,R1    PBUFINIT
         MBS,R0   3                 BLANK FILL THE BUFFER
         LI,R0    0
         LI,R1    1                 RESTORE THE CONSTANTS
         LD,R4    FIDMBS            FPAR => PBUFFER
         LB,R6    F:EI+23
         STB,R6   R5
         MBS,R4   1                 MOVE IT
*
         LD,R4    ACCTMBS
         MTW,0    USRFLG
         BEZ      %+2
         LD,R4    UACCTMBS          NXFIL => PBUFFER
         MBS,R4   0                 MOVE ACCOUNT INTO BUFFER
         AI,R4    -8                BACK UP TO ACCOUNT AGAIN
         SLS,R4   -2                WORD ADDRESS
         LCI      2
         LM,R12   *R4
         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,D1    X'D'              FILE SIZE VLP
         BAL,R5   LOCCODE
         NOP                        MUST BE THERE
         LW,SR1   *D4,R1            GET THE SIZE
         BAL,SR3  BINTODEC
         LD,R4    SIZMBS
         MBS,R4   0                 PUT SIZE IN BUFFER
*                     TEMPORARY---CHK FOR PO TAPE FILES
         LI,D1    X'E'              CHK FOR CREATION TIME=2400
         BAL,R5   LOCCODE
         B        WHOOPS            NO VLP--NOT POSSIBLE
         LW,D1    *D4,R2
         LH,D1    D1                HOURS PART OF DATE
         CI,D1    X'FF2F4'
         BE       WHOOPS
*                 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    3                 SQUIRREL TYPE IF USER BACKUP
         STB,R4   LBLORG,R1         SET INTO THE FILE LABEL
         LW,R5    *DATE1AD
         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  STB,R6   LBLORG
         LW,D3    ORGTBL,R6
         LD,R4    ORGMBS
         MBS,R4   0
         LI,D3    LBLVLPS           DESTINATION ADDRESS FOR MOVEVLP
         LI,D1    X'0B'
         BAL,R5   LOCCODE           LOOK FOR SYNON VLP
         B        %+2               NOT THERE, DON'T USE
         BAL,R5   MOVEVLP
         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'
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'
         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
         B        OPN:TAP
NORAND   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,SR3  NOTAPE            FIX SN'S
         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      %
         LW,R8    TAPETYP           GET THE DEFAULT TAPE TYPE
         STW,R8   EOTYPE            PUT DEVICE TYPE IN FPT'S
         STW,R8   DATTYPE
*
         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
         CAL1,1   OPENDAT           OPEN THE FILE.  SERIAL NUMBERS
*                                    WILL BE MERGED INTO DCB
         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
         STW,SR4  NOTAPFG
         MTW,1    TAP:FILCNT
         LB,R5    F:EO+11           OUTSN NO.
         LW,R6    F:EO+X'44',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
*
         PAGE
*                 BACKUP RECORD NOW EMPTY
REC:MPTY EQU      %
         CAL1,1   OPENBACK
*                 ERR,ABN=BCK:ERR,BCK:ABN; INOUT
CHK:NTBL EQU      %
         LW,R4    NTBL
         BEZ      CLS:B
** MOVE TABLE OF LOCKED FILES INTO FILE :BACKUP ;SLEEPHALF HOUR
         LW,R6    TABLOC
         SW,R6    TABFIX
         LI,R5    HLFHR
         STH,R5   SLP:FPT,R1
         CAL1,1   WRTBACK1
*                 ERR,ABN=BCK:ERR,BCK:ABN; BUF=TABLE; SIZE=*R6
*                 KEY=BCK:KEY; ONEWKEY
         STW,R0   NTBL
         LI,R5    BA(TABLE)
         STW,R5   TABLOC
CLS:B    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'
**
** :BACKUP FILE
*                 OPEN & R/W ERROR HANDLER FOR !BACKUP LIST
         BOUND    8
BCK:ERR  EQU      %
         LB,R4    SR3
         CI,R4    X'46'
         BE       RELEASE
         CI,R4    X'55'
         BE       BCK:ABN:WT
         B        CLS:B
**
*                 DITTO ABNORMALS
**
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       CHK:NTBL
         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       REC:MPTY
         CI,R4    6
         BE       REC:MPTY          END OF FILE
         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
*F:BREC
*                 ABN/ERR FOR BACKUP RECOVERY FILE
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
         CI,R4    X'4A'
         BE       NDUSR
         CI,R4    X'55'
         BE       ERR55
*
         CI,R4    X'75'
         BE       ERR75
*
NDUSR    EQU      %
         STW,R0   RELF
         BAL,SR2  SEND:ERR          MAILBOX MESSAGE
         CAL1,1   CLSEOPTL
*                 PTL; SAVE
WHOOPS   EQU      %
         CAL1,1   CLSEI
         B        OPN:BCK
**
         SPACE   3
*F:EI
*                 DCB/DATA ABN
USR:ABN  EQU      %
         LB,R4     SR3             GET ABN CODE
         CI,R4     X'1A'           ABN COND.
         BNE       NO1A            NO
         LI,R4    1
         LB,R4    SR3,R4
         SLS,R4   -1                RIGHT JUSTIFY SUB CODE
         AI,R4    0                 GET CC
         BEZ       NOERAB          NO ERR ORABN IN FPT
         CI,R4     1               IS DCB2 PRESENT
         BE       GETDCB2           NO
         CI,R4    2
         BE        MOV:ERR         DCB'S NOT OPEN -- SHOULD NEVER HAPPEN
         CI,R4     3
         BE        MOV:ERR         DCB1 & DCB2 NOT OPEN IN RIGHT MODE
*
*
NO1A     EQU       %
         LB,R4    SR3
         CI,R4    3                 FILE DOES NOT EXIST
         BE       RST:JIT           RESTORE JIT
         CI,R4    X'0A'             CLOSE ALREADY CLOSED
         BE       *SR1
         CI,R4    X'14'             CANT OPEN
         BNE      AB1
         LB,R5    SR3,R1            NEXT 7 BITS FLAG BUSY IF CODE=14
         AND,R5   R2
         BEZ      RST:JIT
BUSY:FID EQU      %
         BAL,SR2  SAVE:NAME         SAVE NAME IN TABLE FOR LATER TRY
RST:JIT  EQU      %
         LW,SR2   USRFLG            SKIP MAILBOX IF NOT !BACKUP
         BEZ      OPN:BCK               REQUEST
         BAL,SR2  SEND:ERR          MAILBOX
         B        OPN:BCK
AB1      EQU      %
         CI,R4    X'2E'
         BNE      NDUSR
         CAL1,1   CLSEI
         B        BUSY:FID
*
*   GET ERROR & ABNORMAL RETURNS
*
NOERAB   EQU       %
         LI,R4    FPTERR
          STW,R4          MOV:FPT+2
          LI,R4           FPTABN
          STW,R4          MOV:FPT+3
          B               RDUSR
*
*  GET OUTPUT  DCB
*
GETDCB2   EQU             %
          LI,R4           F:EO
          STW,R4          MOV:FPT+4
          B               RDUSR
*
*  ABORT COND. 2 & 3 SHOULD NEVER HAPPEN
*
MOV:ERR   EQU             %
         B        TRAPPER           SHOULDN'T HAPPEN
*
*   M:MOVE CALL
*                                  FPT ABN RET
FPTABN   EQU       %
         LB,R4     SR3
         CI,R4     X'1C'           END OF TAPE
         BNE       AB2
         AI,8     -1
         STW,8    ABNEXIT
         CAL1,1   CLSEOPTL          MOVE BACK TO :BOF
         CAL1,1   FPT:EO            OPEN TAPE FILE AGAIN
         CAL1,1   CVOL              GET THE NEXT TAPE UP
         CAL1,1   PFILBOF           MOVE BACK TO BEGINNING OF FILE
         B        *ABNEXIT
AB2      EQU      %
         CI,R4    5                 END OF DATA
         BE       END:FILE
         CI,R4    6                 END OF FILE
         BNE      TST1
END:FILE EQU      %
         BAL,SR3  SAVREELNO         SAVE REEL NO FOR RECOV
         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
         LW,D4    USRFLG
         BEZ      %+2               AUTO BACK - NO MAILBOX
         LW,D4    BLDMAIL
         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    D4                MAILBOX ENTRY FOR USER?
         BEZ      OPN:BCK           NO.
         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   R4
         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
         B        OPN:BCK
TST1     CI,R4    7                 LOST DATA
         BNE      NDUSR
         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
*F*EO
*                 DCB/DATA ERR
** ERRORS IN BACKUP TAPE WRITE
TAP:ERR  EQU      %
*
*    M:MOVE  CALL
*                                  FPT DATA ERR
FPTERR   EQU      TAP:ERR
         LB,R4    SR3
         CI,R4    X'57'             NEVER HAPPEN - END REEL
         BE       TERM:VOL
         CI,R4    X'45'             WRITE ERROR
         BNE      CONT2
TERM:VOL EQU      %                 TERMINATE VOL AND MOUNT NEXT
         CAL1,1   CLSEOPTL
         CAL1,1   FPT:EO            OPEN AGAIN FOR CVOL
         CAL1,1   CVOL
         CAL1,1   PFILBOF
         B        OPN:TAP
CONT2    CI,R4    X'49'             NO TAPE UNIT
         BNE      CONT3
         B        ERR49
CONT7    EQU      %
         CAL1,1   CLSEI
         CAL1,1   SAVCONT
CONT4    EQU      %                 SAVE REQUEST IF USR:BCK
         LW,SR4   USRFLG
         BEZ      SKPT              AUTOBCK
         BAL,SR2  SAVE:NAME
SKPT     EQU       %
         BAL,SR2  SEND:ERR          MAILBOX
         B        REC:MPTY
CONT3    EQU      %
         CI,R4    X'55'
         BE       ERR55
         CI,R4    X'56'
         BE       TERM:VOL
         CI,R4    X'75'
         BE       NDUSR
         CI,R4    X'42'
         BNE      CONT4
*
*        ERR 42 MIGHT JUST BE END OF RANDOM FILE
*
         LI,R11   X'1FFFF'
         CS,SR3   MOV:FPT           IS ERR ON INPUT DCB?
         BNE      NDUSR              NO, MUST BE ERR
         LB,R4    LBLORG            IS FILE RANDOM
         CI,R4    3
         BNE      NDUSR             NO
         B        END:FILE          CLOSE IT OUT
         B        CONT4
         SPACE    3
*F:EO
*                 DCB/DATA ABN
**
TAP:ABN  EQU      %
         LB,R4    SR3
         CI,R4    X'0A'             ALREADY CLOSED
         BE       *SR1
         STW,SR1  ABNEXIT
         CI,R4    X'2E'
         BNE      CONT5
         CAL1,1   CLSEOSAV
         BAL,SR3  SAVREELNO
TAP:ABN:AGN EQU   %
         MTW,-1   ABNEXIT
         B        *ABNEXIT          TRY OPEN AGAIN
CONT5    CI,R4    X'14'             ACCESS OR BUSY IS FATAL
         BNE       CONT7
         LB,R4    R10,R1            GET SUBCODE
         SLS,R4   -1
         CI,R4    3                 BRK OR CONTROL-Y
         BNE      CONT6
         MTW,0    INT
         BEZ      TAP:ABN:AGN       NOT A BREAK, TRY AGAIN
         BAL,SR4  PURGE
         B        TAP:ABN:AGN       RETRY THE OPEN (DEVICE TYPE CHANGE)
CONT6    EQU      %
         BAL,R3   SNAPPER
         LI,R3    3                 RESET 3
         LI,R5    TROUBL
         CAL1,2   TYPE
         BAL,SR4  ZAPTAPE
         CAL1,9   SUPER:CLOSE
         B        RIP
         SPACE    3
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    OPNFLAG
         BEZ      %+3
         MTW,-1   OPNFLAG
         CAL1,1   OPENEI
         MTW,-1   SR1               RE-EXECUTE CAL1
         B        *SR1
*
ERR75    LW,R4    SR1               SAVE REGS 8
         LW,R5    SR3                AND 9
         BAL,SR2  SEND:ERR
         LB,R6    R5,R1             GET SUBCODE
         SLS,R6   -1
         CI,R6    4
         BL       %+3               ONLY FILE IS BAD
         STW,R0   DYPAGES           ACCOUNT IS BAD; DONT USE
         B        CLEANUP1           FILE LIST THAT MAY EXIST.
         AI,R4    -1
         B        0,R4              SHOULD BE OK THIS TIME.
         PAGE
*F:EI
**
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
         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
         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
         BNEZ     SPOPEN
         BAL,SR3  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,SR3  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
         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
         BAL,SR4  MAILBOX
         STW,R0   NOPRINT           TURN NOPRINT OFF
         B        *SR2              RETURN
         END

