*CREATED 01/15/71 PC #3121
*UPDATED 01/22/71 PC #3935
         SYSTEM   SIG7
* CREATED 2/4/71 P.CRISMAN FOR A01
*        UPDATED MAY 71, J.SLAYBAUGH  FILE DATES PHASE 2 (P2)
SIM      SET      0
         SYSTEM   BPM
         DEF      BACKUP
         TITLE    'ENVIRONMENT--EQU, REF/DEF, PROC'
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
**  DISPLACEMENT VALUES FOR DCB
KBUF     EQU      10
RWS      EQU      13                ACTUAL NUMBER OF BYTES READ
ORG      EQU      5                 FILE ORGANIZATION LEFT BYTE 3
KEYM     EQU      12
         SPACE    3
KEYMAX   EQU      20
VPT:SIZ  EQU      112
SUPER:CLOSE EQU   6
*                                   FINISH TAPE
BLABSZ   EQU      250
         PAGE
         DEF      BCK:KEY
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
         BOUND    8
ENVIR    DATA     %+1
         GEN,16,16  16,0
         RES      16
DATE:TIME RES     4
LTIME    DATA     0                 HHMM LAST BLABL M:TIME
MTIME    DATA     0                 HHMM LAST MAILBX M:TIME
         DEF      LTIME,MTIME,RELF
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,8,24 X'0C',1           GET 1 COMMON PAGE
FREI:CMN GEN,8,7,17      X'0D',,0
GET:DY   GEN,8,24 X'08',0
REL:DY   GEN,8,24 X'09',0
MAGICWRD EQU      X'56'             END OF RECORD
MAGIC    DATA     X'76767676'       END OF FILE ON TAPE
MGICLNG  EQU      4                 4 BYTES IN MAGIC
         BOUND    8                 PUT BLABL+1 ON BOUND 8
MGCKEY   DATA     X'01FFFFFF'
         DO1      16
         DATA     X'FFFFFFFF'
BLABL    RES      BLABSZ
BCK:KEY  TEXTC    'BACKUP'
DYPAGES  DATA     -1
PAGE     RES      1                 ADDRESS OF FIRST DYNAMIC PAGE
PAGES    RES      1                 NUMBER OF DYNAMIC PAGES OBTAINED
SPECFLG  TEXT     'CRISMNSOSKNS'
         DEF      SPECFLG
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)
         BOUND    8
COUNT    RES      1
REALSIZ  RES      1
MAIL:AC  RES      2
MAILPAR  PZE      ERRMSG            LOCATION OF MESSAGE TO SEND
         PZE      MAIL:AC           RECIPIENT ACCOUNT
         BOUND    8
         DATA     0
BGNMSG   TEXTC    'BEGIN BACKUP SAVEAL TIME           '
         BOUND    8
OPERMSG  TEXTC    'COMPLETED BACKUP SAVEAL    TIME        '
TYPMSG   TEXT     'P SAVEALP INCRMNP SQUIRL'
CRASH    TEXTC    'CRASHED DURING BCKUP        -QUIT OR CONTINUE(Q/C)'
ERRMSG   TEXTC    'ERROR      DID NOT BACKUP FILE                '
         RES      10
OKMSG    TEXTC    ' ON SN DDLD BACKED UP FILE                 '
         RES      10
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'
FRSTKEY  GEN,16,16 X'0100',0        FIRST RECORD KEY
KEYLOC   RES      KEYMAX
P5MASK   GEN,8,24 X'08',0
P5OFF    DATA     X'F7FFFFFF'
         BOUND    8
FID:MBS  GEN,32,8,24  BA(F:EI)+88,48,BA(FPAR)   FID & ACCT VLPS
ADJ:MBS  GEN,32,8,24  BA(FPAR)+4,32,BA(ADJ:FID)   FID DATA ONLY
1SAV     PZE
CREATION PZE                        CREATION DATE OF USR FILE
CURRENT  PZE
         SPACE  3
***   NEXT 9 WORDS FROM FILE IN SEQUENCE
LASTSAV  PZE
LASTINC  PZE
LASTSQ   PZE
LASTRUN  PZE
NOTAPFG  PZE                        IS A TAPE MOUNTED OR NOT
         DEF      NOTAPFG
LASTACCT DATA     0,0
LASTREEL DATA     0
LASTFIL  PZE
         SPACE    3
LASTREELX DATA     0              LAST REEL NO. SAVED IN 'SAV'
SAV:ACC  DATA     0,0               SAVE JIT ACCT
SAVE:TYPE DATA    0                 TPY STOR SC:TYPE DURING USR:BLK RUN
NINPROGRAN DATA   0                 GRANULES OF DEFERRED BACKUPUP
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
ECB      DATA     0
YES       DATA     0
         DEF      GET:CM
         DEF      NMPG,BUFSZ,BUF
         DEF      KEYLOC
         DEF      RELEASE
         DEF      BACKXT,ESSENCE,CURRENT,LASTFIL
         DEF      LASTREELX,LASTREEL,REELTMP
         DEF      SAV:ACC
         DEF      MAGICWRD
         DEF      MAGIC
         DEF      SLP:FPT
         DEF      BLABL,FREI:CMN
         REF      DATEAD,DATE1AD,TIMEAD   IND ADDR DATE,DATE+1,TIME
         DEF      LOCCODE1
         DEF      ENVIR
         DEF      DO:TIME,DO:REGS4
         DO       SIM
         SPACE    5                 **************
*        ****************************************
*        FOR SIMULATION
         REF      F%SEL,F%BACKUP,F%BREC,F%EI,F%EO,F%TI
F:SEL    EQU      F%SEL
F:BACKUP EQU      F%BACKUP
F:BREC   EQU      F%BREC
F:EI     EQU      F%EI
F:EO     EQU      F%EO
F:TI     EQU      F%TI
*        ********************************************
         SPACE    5                 *******************
         ELSE
         REF      F:SEL,F:BACKUP,F:BREC,F:EI,F:EO,F:TI
         FIN
         REF      SELFILL
         REF      SELKEY
         REF      INPROGRAN,INT
         REF      PURGEFLAGAD
         DEF      BSR1
         DEF      PURGEXIT,BB1
         DEF      BCK:ERR,BCK:ABN,BREC:ERR,BREC:ABN
         DEF      FPAR,TAP:ERR,TAP:ABN
         DEF      USR:ABN,USR:ERR
         REF      MAILBOX
         REF      JULIAN
         DEF      LB3
         DEF      SETSQ
         TITLE    '  **  DCB  **  '
EI:DESC  EQU      F:EI+X'2B'
         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      20
FPAR     RES      VPT:SIZ
         SPACE    3
**
         BOUND    8
RD:EI    GEN,8,7,17      X'10',,F:EI
         GEN,8,24 X'F1',0           ERR,ABN,BUF,SZ,BLOCK
         DATA     USR:ERR
         DATA     USR:ABN
         PZE      *BUF              BUF
BUF:RDZ  PZE                        BUF SIZE
         PZE      *RANGRCT
RANGRCT  DATA     0                 RANDOM FILE BLOCK COUNT
         SPACE    3
CLOSEI   GEN,8,24 X'15',F:EI
         GEN,1,31 1,0
         DATA     2
OPENEI   GEN,8,24 X'14',F:EI
         DATA     0
OPNFLAG  DATA     0
MY002    DATA     X'200000'
** OUTPUT BACKUP TAPE
FPT:EO   GEN,8,7,17      X'14',0,F:EO
         DATA     X'C74800C2'       TAPE
         DATA     TAP:ERR
         DATA     TAP:ABN
EO:ORG   DATA     1                 ORG -P6
         DATA     1                 ACCESS -P7
         DATA     2                 P8 -OUT
         DATA     2                 SAVE -P10
KEYMX    DATA     3
SN:EO    DATA,1   7,0,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'
VPT:EO   RES      15                NAME OF FILE
         BOUND    8
WT:EO    GEN,8,7,17      X'11',,F:EO
         GEN,8,24 X'F8',X'40'
         DATA     TAP:ERR
         DATA     TAP:ABN
BUF:WT   PZE      *BUF              BUF LOC
BUF:WTSZ DATA     0                 BUFFER SIZ -P4
WT:KEY   DATA     KEYLOC
         SPACE    3
*                 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
         DATA     X'02000002',0,0   ACCT VLP
         DATA     X'03000002',0,0   PASS VLP
         DATA     X'00010001',0     DUMMY VLP FOR DELETE FLAG
         SPACE    3
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
EO:VOL:ADJ EQU    %                 ADJ DCB FOR F:EO VOL
         DATA     X'14'**24+F:EO,X'2000',X'10000'
EO:VOL   DATA     0
         TITLE    '**  MAIN PROGRAM  **'
         USECT    PURE
** AUTOMATIC BACKUP
BACKUP   EQU      %
         BAL,SR4  DO:TIME
         BAL,SR4  DO:REGS4
*                 DO PURGE IF NEEDED
         BAL,SR4  PURGE
         REF      PURGE
*                 IF SEL:FIL EXISTS OR SEL:FIL KEY IN :BREC
*                   FILE, GO TO SELFILL
         CAL1,1   CHK:SEL
         B        GO:SELFILL        BRANCHES IF SEL:FIL EXISTS
*                 INSTANT SQUIRREL ENTRY POINT   *****
         SPACE    4
SETSQ    EQU      %    SET UP SQUIRREL TO SAVE FILES
         BAL,SR4  ESSENCE              AFTER AN IMPOSSIBLE RECOVERY.
         STW,R1   NSCHED            ONE SCHED
         STB,R3   SC:TYPE,R1        SQ TYPE
         LW,R7    CURRENT
         STW,R7   SCHED,R1
         B        BB1A
**
NOSELF   EQU      %                 ABB/ERR FOR CHK:SEL
         M:OPEN   F:BREC,(ABN,BB1C),(ERR,BB1C)
         M:READ   F:BREC,(BUF,DATE:TIME),(SIZE,0),;
                    (KEY,SELKEY),(ABN,BB1C),(ERR,BB1C)
GO:SEL1  EQU      %
         M:CLOSE  F:BREC,(SAVE)
GO:SELFILL EQU    %
         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
         M:CLOSE  F:BREC,(SAVE)
*
BB1      EQU      %
         BAL,SR4  ESSENCE
BB1A     EQU      %
         LI,R5    9*4          # WORDS TO READ
         LW,R6    LASTFIL
         BEZ      %+2
         LI,R5    8*4
         M:OPEN   F:BREC,(ERR,BREC:ERR),(ABN,BREC:ABN),(INOUT),(SAVE)
         M:READ   F:BREC,(BUF,LASTSAV),(SIZE,*R5),(KEY,SAVKEY),;
                  (ERR,BSR1),(ABN,BSR1)
         M:TRUNC  F:BREC
         LW,R7    NSCHED
        BEZ     NOSCHD
         LW,R4    LASTRUN           WAS THERE A CRASH
         BEZ      FIND:NXT
         CI,R4    3
         BG       FIND:NXT          NO
*                 THERE WAS A CRASH.  IF OPERATOR SAYS 'C'
*                   RESUME THE INTERRUPTED BACKUP.  IF HE
*                   SAYS 'Q' DO THE NORMAL THING AT THIS
*                   POINT IN TIME.
CANTUND  M:KEYIN  (MESS,CRASH),(REPLY,YES),(SIZE,1),(ECB,ECB)
         LW,R6    ECB
         BLZ      %-1               WAIT FOR INPUT
         LB,R6    YES,R1
         CI,R6    'C'
         BE       CONTBCK
         CI,R6    'Q'
         BNE      CANTUND           CANT UNDERSTAND THE ANSWER
         STW,R0   LASTACCT
         STW,R0   LASTACCT+1
         STW,R0   NOTAPFG
         STW,R0   LASTRUN
         LW,R7    NSCHED
         BAL,R5   WRT:SAV
         B        FIND:NXT
CONTBCK  EQU      %
         STB,R4   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
         B        OPX
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
FIND:NXT:NXT EQU  %
         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
         BE       NOSCHD            WRAPUP
         BG       GRAVE
         STW,R6   LASTRUN
         B        %,R6
         B        SAVEALL
         B        INCRM
**
SQUIRREL EQU      %
         LW,R6    LASTSQ
         BEZ      SQ1               NO PREVIOUS SQ
         AI,R6    15
         CW,R6    CURRENT
         BGE      FIND:NXT:NXT      SQUIR HAS RUN WITHIN LAST 15 MIN
SQ1      EQU      %
         LW,R7    LASTINC           TIME OF LAST INCREM
         LW,R6    LASTSQ
         CW,R7    R6                GET LATEST TIME IN R7
         BGE      %+2
         STW,R6   R7
         B        LATEST            FIND LATEST TIME FOR COMPARE
INCRM    EQU      %                 INCREMENTAL DUMP
         LW,R6    LASTINC
         AI,R6    20
         CW,R6    CURRENT
         BGE      FIND:NXT:NXT      INCRM HAS RUN WITHIN LAST 20 MIN
         LW,R7    LASTINC
LATEST   EQU      %
         B        SQ2
SAVEALL  EQU      %
         LW,R6    LASTSAV
         AI,R6    30
         CW,R6    CURRENT
         BGE      FIND:NXT:NXT      SAVALL HAS RUN IN LAST 30 MIN
SQ2      EQU      %
SQTAPE   EQU      %                 ENTRY IF EXIST SQ TAPE
         M:TIME   BGNMSG+5
         LW,R7    SCHED:PT
         LB,R7    SC:TYPE,R7
         LD,R4    TYPMSG-2,R7
         STD,R4   BGNMSG+3
         M:TYPE   (MESS,BGNMSG)
         LW,R4    CURRENT
         STW,R4   LASTSAV-1,R7      SAVE START TIME OF
*                                    CORRECT TYPE
         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
         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
         M:TYPE   (MESS,ACCTMSG)
         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
         LD,R6    FID:MBS           MOVE FID INTO FPAR F/DCB
         MBS,R6   0
         LD,R6    ADJ:MBS
         MBS,R6   0
         LI,R7    X'10000'          SET PLIST END
         STW,R7   FPAR+13
         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
         LB,R6    EI:DESC+1
         CI,R6    1
         BG       OPNNXF            DONT BACKUP IF OPEN OUT,OI,IO
         BAL,SR4  AUTOBACK          BACKUP FILE--AUTO MODE
         B        OPNNXF
         PAGE
*                 BACKUP  WRAPUP         **
**
NOMORE   EQU      %                 NOMORE ACCOUNTS, CLEAN UP
         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
         LW,R7    CURRENT
         STW,R7   LASTSAV-1,R6      LAST RUN WAS COMPLETED AT CURRENT
         STW,R7   LASTRUN
         LD,R4    TYPMSG-2,R6       TYPE FOR OPER MSG
         STD,R4   OPERMSG+4
         M:TIME   OPERMSG+6
         M:TYPE   (MESS,OPERMSG)
NORUN    EQU      %
         LW,R7    NOTAPFG
         BEZ      GIVUP
*                 END RUN--DISMOUNT BACKUP TAPE
         BAL,SR4  FINI:TAP
GIVUP    EQU      %                 USER BACKUP OR NOTHING TO DO
GRAVE    EQU      GIVUP
         BAL,R5   WRT:SAV
         M:CLOSE  F:BREC,(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
         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    LASTREEL
         CH,R5    REELTMP
         BE       DO:EO:SN
         LW,R5    LASTREELX         FILL SET
         STW,R5   LASTREEL
         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
FIND:SN  EQU      %   ****
*                 FINDS THE SN VLP IN THE LIST POINTED TO BY
*                   D4, RETURNS VIA SR4 WITH D4 POINTING TO
*                   THE SN VLP
         LB,R4    *D4
         CI,R4    7
         BE       *SR4              EXIT IF FOUND
         LB,R4    *D4,R3            FIND SIZE, STEP TO NXT VLP
         AW,D4    R4
         AI,D4    1
         B        FIND:SN
*
         SPACE 5
WRT:SAV  EQU      %   ****          WRITES SAV RECORD IN :BACKUP
         M:WRITE  F:BREC,(BUF,LASTSAV),(SIZE,9*4),(KEY,SAVKEY),;
                  (ONEWKEY),(ABN,BSR1),(ERR,BSR1)
         M:TRUNC  F:BREC
         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
,LB3     M:TIME   DATE: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
         CW,R7    L(X'1F010101')    PURGE VLP
         BNE      %+3
         LW,R7    1,R5
         AWM,R7   NINPROGRAN
         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
         LW,D4    F:EO+6            FLP
         BAL,SR4  FIND:SN
         LB,R4    F:EO+11
         LW,R4    *D4,R4            CURRENT 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
         SPACE    5
FINI:TAP EQU      %   ****
         LW,D4    NOTAPFG
         BEZ      *SR4
         STW,SR4  FTAPX
         LW,D4    MAGIC
         STB,D4   BLABL
         STW,D4   BLABL+1           SET END TAPE FLAG
         M:OPEN   F:EO,(LABEL,'BACKEND'),(OUT),(SAVE),;
                  (KEYED),(ERR,BSR1),(ABN,BSR1)
         M:WRITE  F:EO,(BUF,MAGIC),(SIZE,MGICLNG),(KEY,MGCKEY),;
                  (ONEWKEY),(ERR,BSR1),(ABN,BSR1)
         M:CLOSE  F:EO,(REM)
         CAL1,9   SUPER:CLOSE
         STW,R0   TAP:FILCNT
         STW,R0   NOTAPFG
         B        *FTAPX
         SPACE    5
* FILE NAME OBTAINED AND SAVED HERE: R15 CONTAINS BUFFER ADDRESS, R7
*      CONTAINS DISPLACEMENT, R11 CONTAINS LINKAGE
*
SAV:NAM  EQU      %   ****
         LI,R4    0
         LB,R5    FPAR,R4
         CI,R5    1                 IS IT A FILE NAME
         BNE      GRAVE             NO
         AI,R4    4
SAVNAM10 EQU      %
         LB,R5    FPAR,R4
         CW,15    PAGE
         BNE      %+4               IF A SPECIAL FILE
         LW,R6    R5                INCREMENT COUNT
         AI,R6    1
         AWM,R6   COUNT
         LB,R6    FPAR,R4
         STB,R6   *15,7
         AI,R4    1
         AI,R7    1
         BDR,R5   %-4
         LB,R6    FPAR,R4
         STB,R6   *15,7
         B        *11               RETURN
         SPACE    3
*                    SBR TO ADJUST COMMON TO 10-20 PAGES
CHKCM    EQU      %
         LH,R5    NMPG
         AI,R5    -10
         BLE      GETSOM            LESS THAN 10 PAGES-GET SOME
         CI,R5    10
         BL       SETSIZ1
         STH,R5   FREI:CMN,R1       MORE THAN 20, RELEASE EXCESS 10
         SLS,R5   9
         AWM,R5   BUF               ADJUST BUFFER ADDRESS
         LI,R5    10
         CAL1,8   FREI:CMN
         B        SETSIZ            GO FIX SIZE ITEMS
GETSOM   EQU      %
         BE       *SR4              EXACTLY 10 IS OK
         LI,R5    10                REALLY NONE, SO GET 10
         STH,R5   GET:CM,R1
         CAL1,8   GET:CM
         STW,SR2  BUF               SET NEW BUFFER ADDRESS
         AH,R5    NMPG              NEW NUMBER OF PAGES
SETSIZ   EQU      %
         STH,R5   NMPG
         MI,R5    512*4             CONVERT TO NUMBER OF BYTES
         AI,R5    -4
         STW,R5   BUFSZ
SETSIZ1  LW,R5    BUFSZ
         STW,R5   BUF:RDZ
         B        *SR4
         TITLE    '**  READ:SCH--READ BACKUP SCHEDULE  **'
** SUBROUTINE TO CONVERT THE BACK:SCHED FILE TO TABLE OF SORTED TIMES
         REF      F:1
**
READ:SCH EQU      %
         STW,11   SVX11
         LI,3     0
         STW,3    NSCHED
         STW,3    NULTYPS
         M:OPEN   F:1,(FILE,'BACK:SCHED'),(KEYED),(SEQUEN),;
                  (INOUT),(SAVE),(ERR,SCERR),(ABN,SCERR)
RDLOOP   EQU      %
         M:READ   F:1,(BUF,NTRY),(SIZE,20*4),(ERR,SCERR),(ABN,SCERR)
         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
         M:DELREC F:1
         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
         M:TYPE   (MESS,SCHED:OVF)
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      %
         M:CLOSE  F:1,(SAVE)
         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
         BAL,SR4  CHKCM             ADJUST COMMON TO 10-20 PAGES
         LW,15    BUF
         AI,15    1
         LI,7     0
         BAL,11   SAV:NAM
         SLS,R4   -2
         STB,R1   *BUF,R0
         STB,R0   *BUF,R1
         STB,R4   *BUF,R2
         STB,R4   *BUF,R3
         AI,R4    1
         LW,R5    =X'02010202'      ACCOUNT INDICATOR
         STW,R5   *BUF,R4
         LW,R5    NXACCT            MOVE ACCT TO BUF
         AI,R4    1
         STW,R5   *BUF,R4
         AI,R4    1
         LW,R5    NXACCT+1
         STW,R5   *BUF,R4
         B        MVENT
         PAGE
**
USR:BCK  EQU      %   *****         USER INITIATED BACKUP
         DEF      USR:BCK
         STW,SR4  BACKXT
         STW,SR4  USRFLG
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         STW,R0   NINPROGRAN
         LW,R5    SCHED:PT
         LB,R6    SC:TYPE,R5
         STB,R6   SAVE:TYPE
         STB,R3   SC:TYPE,R5        LOOK LIKE SQ
OPN:BCK  EQU      %
         LW,R5    USRFLG
         BEZ      *BACKXT
         BAL,SR4  CHKCM
         LW,R5    BUFSZ
         STW,R5   BUF:RDZ           READ BUF SIZE
         LI,R6    FOREVER           PRESET SLEEP TIME
         STH,R6   SLP:FPT,R1
         M:OPEN   F:BACKUP,(INOUT),(ERR,BCK:ERR),(ABN,BCK:ABN)
         M:READ   F:BACKUP,(SIZE,*BUF:RDZ),(ABN,ABN:BCK),;
                      (ERR,ERR:BCK),;
                  (KEY,BCK:KEY),(BUF,*BUF)
         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
         M:DELREC F:BACKUP
         B        BCK:CL
BCK:WRT  EQU      %
         SW,R6    R4
         M:WRITE  F:BACKUP,;
                  (SIZE,*R6),;
                   (BUF,*BUF:OUT),;
                  (ERR,ERR:BCK),(ABN,ABN:BCK),;
                   (KEY,BCK:KEY)
BCK:CL   EQU      %
         M:CLOSE  F:BACKUP,(SAVE)
         PAGE
MVENT    EQU      %   *****         COMMON WRITE TAPE ROUTINE
         LI,R6    9
         LW,R5    =C'    '
         STW,R5   ERRMSG+7,R6       PRESET TO BLANKS
         BDR,R6   %-1
         LI,R5    4
         LB,R6    *BUF,R5           BYTE COUNT OF FILE NAME
         CI,R6    31                MAX FILENAME
         BG       OPN:BCK
         AI,R5    1
         LB,R4    *BUF,R5           MOVE FILE NAME TO MSG
         STB,R4   ERRMSG+7,R5       FOR MAILBOX
         BDR,R6   %-3
         LI,R5    4                 SET LENGTH OF MSG
         LB,R6    *BUF,R5               BYTE CNT OF FILE NAME
         AI,R6    28
         STB,R6   OKMSG
         AI,R6    4
         STB,R6   ERRMSG
**  MOVE ACCOUNT NUMBER FOR MAILBOX
         LB,R4    *BUF,R3           N WORDS OF FILE NAME
         AW,R4    BUF               START LOC OF ACCN
         AI,R4    1
         LW,R6    *R4,R1
         STW,R6   MAIL:AC
         LW,R6    *R4,R2
         STW,R6   MAIL:AC+1
         LW,5     USRFLG
         BEZ      OPEN:EI1          SKIP TEST FILE SINCE ALREADY DONE
         LW,R5    DESC:MASK+3       SQ
         STW,R5   DESC:MASK
OPEN:EI  CAL1,1   GDESC:EI          TEST FILE   USR FILE
         LW,R5    EI:DESC+1
         CW,R5    L(X'80000')
         BAZ      OPN:BCK           NOT MOD SINCE LAST SQ
OPEN:EI1 EQU      %
         MOVE:FLD *BUF,VPT:EI
*                 SET DESCRIPTORS
         LW,SR3   L(X'14020000')
         LB,R5    EI:DESC+1         FILE STATUS
         CI,R5    1
         BG       BUSY:FID          CON'T OPEN RIGHT NOW
         LW,R5    DESC:MASK
         AND,R5   EI:DESC+1         CLR BITS IN DYNAM DESC
         STW,R5   DESC:FPT+1
         SPACE    2
*                 OPEN USER         **
         CAL1,1   FPT:EI            OPEN USER FILE
*                     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
         LW,R5    *DATE1AD
         LH,R4    *TIMEAD
         STH,R4   R5
         LW,R4    *DATEAD
         STW,R4   *D4,R1
         STW,R5   *D4,R2
         STB,R2   *D4,R2            NDW=2
         LW,SR4   *TIMEAD
         XW,SR4   LTIME
         CW,SR4   LTIME
         BE       BTIMOK            TIME HASNT CHANGED, SKIP
         M:TIME   BLABL+1
         LI,SR3   BLABL+1
         LCI      12                SAVE REGISTERS FOR JULIAN
         PSM,D1   ENVIR
         BAL,SR4  JULIAN
         STD,SR1  BLABL+1
         LCI      12
         PLM,D1   ENVIR
BTIMOK   EQU      %
         LI,D2    FPAR+10           SKIP FID IF NOT SYNON
         LI,SR1   X'4000'           CHK SYNON
         CW,SR1   DESC:FPT+1
         BAZ      OPEN:EI2
         LI,D2    FPAR
         LI,R4    X'B'              MAKE REAL FID=SYNON
         STB,R4   *D2
OPEN:EI2 EQU      %
         MOVE:FLD *D2,BLABL+4       FPARAM VARIABLES TO TAPE LABEL
** R5 CONTAINS NEXT DESTINATION IN BLABL
         STW,R5   D2
         MOVE:FLD *BUF,*D2
         SLS,R5   2                 MAKE BA
         STW,R5   D2
         AI,R5    -BA(BLABL)
         CI,R5    X'FF'
         BLE      SIZOK
         STW,R5   REALSIZ
         LI,5     0
SIZOK    EQU      %
         STB,R5   BLABL
** IS THE USERS FILE KEYED
         LI,R5    X'30'             BYTE 3 IS ORG AND ACC
         LS,R5    F:EI+ORG
         CI,R5    X'20'
         BE       %+3
         STW,R0   D3                D3 IS KEYED FLAG
         B        NO:KEY
         STW,R5   D3
         LB,R5    F:EI+KEYM
         BNEZ     %+2
         LI,R5    X'B'
         STB,R5   MGCKEY
         STB,R5   KEYMX,R3
         LW,R5    WT:EO+1
         OR,R5    P5MASK            TURN KEYED P5 ON
         STW,R5   WT:EO+1
         B        CONT1
NO:KEY   EQU      %
         LW,R5    P5OFF             TURN KEYED OFF
         AND,R5   WT:EO+1
         STW,R5   WT:EO+1
CONT1    EQU      %
         LW,R6    *BUF
         STW,R6   VPT:EO
         STB,R1   VPT:EO,R1         END INDICATOR
         LB,R5    *BUF,R3           ORIGINAL FILE NAME SIZE
         LW,R6    *BUF,R5               TO OPEN FILE ON
         STW,R6   VPT:EO,R5         BACKUP TAPE
         BDR,R5   %-2
         LB,R5    F:EI+ORG,R3       GET FILE MODE
         SLS,R5   -4                    TO OPEN BACKUP
         CI,R5    2
         BLE      NORAND
         LI,R5    1
         LI,R6    2048
         STW,R6   BUF:RDZ           BLK SIZ FOR RAND =2048
NORAND   EQU      %
         STW,R0   RANGRCT           INITIALIZE AND PREVENT OVERFLOW
         STW,R5   EO:ORG                TAPE FILE
** OPEN BACKUP TAPE FILE
OPN:TAP  EQU      %
         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
TAP:OPN  EQU      %
         CAL1,1   FPT:EO
         STW,SR4  NOTAPFG
         MTW,1    TAP:FILCNT
         LB,R5    F:EO+11           OUTSN NO.
         LW,R6    F:EO+X'28',R5
         STW,R6   OKMSG+2
* CHANGE IN DESIGN - WRITE LABEL AS FIRST RECORD, NOT AS LABEL
         LW,R4    FRSTKEY
         STW,R4   KEYLOC
         LI,R4    BLABL
         LB,R5    BLABL
         BNEZ     RDUSRP
         LW,R5    REALSIZ
         XW,R4    BUF:WT
         XW,R5    BUF:WTSZ
         CAL1,1   WT:EO
RDUSRP   EQU      %
         LW,R4    L(1**31+BUF)
         STW,R4   BUF:WT
         PAGE
** READ USER FILE
RDUSR    EQU      %   ****          READ DISK-WRITE TAPE
         CAL1,1   RD:EI
**                                  PRESET FOR TAPE WRITE
         LW,R4    BUF                   BUF LOC
         LW,R5    F:EI+RWS
         LI,R6    MAGICWRD
         DO       4
         STB,R6   *R4,R5            STORE MAGIC WORD
         AI,R5    1                 INCREMENT BYTE COUNT
         FIN
         MTW,1    RANGRCT           STEP BLOCK NBR IN CASE RANDOM
         STW,R5   BUF:WTSZ
         LW,R4    D3                IS FILE KEYED
         BEZ      NOT
         LB,R4    *F:EI+KBUF        MOVE KEY FROM DCB TO KEYLOC
         STB,R4   KEYLOC
         LB,R5    *F:EI+KBUF,R4
         STB,R5   KEYLOC,R4
         BDR,R4   %-2
NOT      EQU      %
** WRITE TAPE RECORD
         CAL1,1   WT:EO
         MTW,0    RELF
         BEZ      RDUSR             NO SHORT BUFFER ON LAST READ
         STW,R0   RELF              CLR FLAG
         LW,R4    F:EI+RWS          CHK IF RECORD WAS SMALLER THAN
         AI,R4    X'2FFF'            BUFFER BY 5 PAGES
         SLS,R4   -11               MAKE INTO NUMBER OF PAGES
         CH,R4    NMPG
         BGE      RDUSR             NOT ENUF DIFFERENCE TO BOTHER
         LH,R5    NMPG              RELEASE EXCESS PAGES OVER 1
         SW,R5    R4
         AI,R5    4
         STH,R5   FREI:CMN,R1
         CAL1,8   FREI:CMN
         LCW,R4   R5                NOW ADJUST CONTROL ITEMS
         AH,R4    NMPG
         STH,R4   NMPG
         SLS,R5   9
         AWM,R5   BUF               NEW BUFFER ADDRESS
         SLS,R5   2
         LW,R4    BUFSZ             ADJ READ FPT
         SW,R4    R5
         STW,R4   BUFSZ
         STW,R4   BUF:RDZ
         B        RDUSR
         SPACE    5
*                 BACKUP RECORD NOW EMPTY
REC:MPTY EQU      %
         M:OPEN   F:BACKUP,(INOUT),(ERR,BCK:ERR),(ABN,BCK:ABN)
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
         M:WRITE  F:BACKUP,(KEY,BCK:KEY),(ONEWKEY),;
                    (SIZE,*R6),(BUF,TABLE),;
                    (ERR,BCK:ERR),(ABN,BCK:ABN)
         STW,R0   NTBL
         LI,R5    BA(TABLE)
         STW,R5   TABLOC
CLS:B    M:CLOSE  F:BACKUP,(SAVE)
         LW,R5    NINPROGRAN
         STW,R5   INPROGRAN         ADJUST GRANS IN PROG
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      %
         LH,R4    NMPG              RELEASE BUFFER SPACE
         BEZ      %+3
         STH,R4   FREI:CMN,R1       COMMON
         CAL1,8   FREI:CMN
         STW,R0   NMPG
         B        *BACKXT
         TITLE   'ABNORMAL AND ERROR ROUTINES FOR BACKUP'
**
** :BACKUP FILE
*                 OPEN & R/W ERROR HANDLER FOR !BACKUP LIST
         BOUND    8
ERR:BCK  EQU      %
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
**
ABN:BCK  EQU      %
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
         M:DELREC F:BACKUP          LOST DATA
         B        CLS:B               IS HARD TO BELIEVE
         CI,R4    X'0A'             ALREADY CLOSED
         BE       *SR1
         B        CLS:B
BLD:BACKUP EQU    %
         M:OPEN   F:BACKUP,;
                    (ABN,BSR1),(ERR,BSR1)
         M:CLOSE  F:BACKUP,(SAVE)
*                    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
         M:OPEN   F:BREC,(OUT),(ERR,BSR1),(ABN,BSR1),(SAVE)
         M:CLOSE  F:BREC,(SAVE)
         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
*
RAND42   EQU      %                 IF ABN 42 & RANDOM DO EOF
         CI,R4    X'42'
         BNE      NDUSR
         LB,R4    F:EI+ORG,R3
         SLS,R4   -4
         CI,R4    3
         BNE      NDUSR
         B        END:FILE
NDUSR    EQU      %
         STW,R0   RELF
         BAL,SR2  SEND:ERR          MAILBOX MESSAGE
         M:CLOSE  F:EO,(PTL),(SAVE) BAD FID: SHOULD MAILBOX :CLOSE TAPE
WHOOPS   EQU      %
         M:CLOSE  F:EI              CLOSE FID
         B        OPN:BCK
**
         SPACE   3
*F:EI
*                 DCB/DATA ABN
USR:ABN  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      AB2
         M:CLOSE  F:EI
         B        BUSY:FID
AB2      EQU      %
         CI,R4    5                 END OF DATA
         BE       END:FILE
         CI,R4    6                 END OF FILE
         BNE      TST1
END:FILE M:WRITE  F:EO,(BUF,MAGIC),(SIZE,MGICLNG),(KEY,MGCKEY),(ONEWKEY)
         BAL,SR3  SAVREELNO         SAVE REEL NO FOR RECOV
         CAL1,1   SAVCONT
         M:CLOSE  F:EI,(SAVE)
         LW,D4    USRFLG
         BEZ      TST2              NOT USR:BCK ENTRY
         LI,D4    NXFIL
         LI,D1    X'1F'             PURGE VLP CODE
         BAL,R5   LOCCODE1
         B        TST2              NOT PRESENT
         MOVE:FLD NXFIL,PURADJFID
         REF      PURADJFID,PURADJ
         CAL1,1   PURADJ            SET VLPS INTO DCB
         BAL,SR3  DOPURDEL          DELETE FILE & LOG NAME
         REF      DOPURDEL
TST2     EQU      %
         LI,R6    9
         LW,R5    ERRMSG+7,R6
         STW,R5   OKMSG+6,R6
         BDR,R6   %-2
         LI,R5    OKMSG
         STW,R5   MAILPAR
         LI,SR3   MAILPAR
         LW,D4    USRFLG
         BEZ      %+2               AUTO BACK - NO MAILBOX
         LI,D4    7                 USER BACK - YES MAILBOX
         REF      FMAILBX
         LW,R5    *TIMEAD
         XW,R5    MTIME
         CW,R5    MTIME
         BNE      %+3
         BAL,SR4  FMAILBX           TIME HASNT CHANGED
         B        OPN:BCK
         BAL,SR4  MAILBOX
         B        OPN:BCK
TST1     CI,R4    7                 LOST DATA
         BNE      NDUSR
         LH,R5    NMPG              INCREMENT NO. PAGES
         LI,R6    32
         CI,R5    32+10             GET 32 PAGES FIRST TIME
         BL       %+2
         LI,R6    128               SECOND TIME, REST OF WORLD
         STH,R6   GET:CM,R1
         CAL1,8   GET:CM            R7=1, COMMON ALLOC
         BCS,8    ANY:PAGES
SOMEPAGES EQU     %
         STW,SR2  BUF
         AW,R5    R6
         STH,R5   NMPG
         LI,R5    512*4
         MW,R5    R6
         AWM,R5   BUFSZ
         AWM,R5   BUF:RDZ
         M:PRECORD F:EI,(REV)       BACKSPACE 1 RECORD
         MTW,1    RELF              SET ADDED CORE FLAG
         B        RDUSR
ANY:PAGES EQU     %
         LW,R6    SR1
         BEZ      NDUSR             NO PAGES ACQUIRED--GIVE UP
         B        SOMEPAGES
         PAGE
*F*EO
*                 DCB/DATA ERR
** ERRORS IN BACKUP TAPE WRITE
TAP:ERR  EQU      %
         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
         M:CLOSE  F:EO,(PTL),(SAVE)
         M:OPEN   F:EO,(FILE,'BACKEND'),(OUT),(SAVE),(KEYED),(DIRECT)
         M:CVOL   F:EO
         M:WRITE  F:EO,(BUF,MAGIC),(SIZE,MGICLNG),(KEY,MGCKEY),(ONEWKEY)
         M:CLOSE  F:EO,(SAVE)
         M:PFIL   F:EI,(BOF)        START OVER AGAIN ON INPUT FILE
         B        OPN:TAP
CONT2    CI,R4    X'49'             NO TAPE UNIT
         BNE      CONT3
         B        ERR49
CONT7    EQU      %
         M:CLOSE  F:EI
         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'42'
         BE       NDUSR
         CI,R4    X'55'
         BE       ERR55
         CI,R4    X'56'
         BE       TERM:VOL
         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
         M:CLOSE  F:EO,(SAVE)
         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      CONT6
         M:TYPE   (MESS,TROUBL)
         BAL,SR4  FINI:TAP
         CAL1,9   SUPER:CLOSE
         B        RIP
CONT6    CI,R4    X'1C'             SHOULDNT HAPPEN
         BNE      CONT7
         MTW,1    LASTREEL          STEP REEL NBR IN 'SAV'
         B        TAP:ABN:AGN       RETRY WRITE
         SPACE    3
ERR49    EQU      %
         M:TYPE   (MESS,NOTAPMSG)
*FOR ERROR 49, FIRST TYPE NO TAPES MESSAGE
ERR55    EQU      %
         DEF      ERR49,ERR55
*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
         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
         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      %
         M:CLOSE  F:EI
         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
         LW,R5    SCHED:PT
         LB,R5    SC:TYPE,R5
         CI,R5    2
         BNE      SPDONE10
         M:TIME   BLABL+1
         LI,SR3   BLABL+1
         LCI      12                SAVE REGISTERS FOR JULIAN
         PSM,D1   ENVIR
         BAL,SR4  JULIAN
         STD,SR1  BLABL+1           PUT TIME IN BLABL OF SPECIAL FILE
         LCI      12                ALSO
         PLM,D1   ENVIR
         LW,5     COUNT
         STW,5    BLABL+3
         LI,5     3
         LW,9     SPECFLG-1,5       PUT SPECIAL INDICATOR IN LABEL
         STW,9    BLABL+5,5          -SPECIAL FLAG
         BDR,5    %-2               3 WORDS OF NAME FOR SPECIAL
         LW,R5    PAGES
         STB,5    BLABL,R3
         LW,R4    ADJ:ACCT
         LW,R5    ADJ:ACCT+1
         STW,R4   BLABL+4
         STW,R5   BLABL+5
         LW,R5    *DATE1AD          SET MOD DATE FORMAT DATE IN LABEL
         LH,R4    *TIMEAD
         STH,R4   R5
         STW,R5   BLABL+10
         LW,R5    *DATEAD
         STW,R5   BLABL+9
         LW,R5    *TIMEAD
         STW,R5   BLABL+11
         LI,R5    48                BYTE COUNT OF BLABL IN FIRST BYTE
         STB,R5   BLABL
         LW,R5    DYPAGES           -1 OR 0
         AI,R5    1
         STB,R5   BLABL,R2          0 OR 1--1 SAYS TRUNCATED LIST
         LW,R5    NOTAPFG
         BNEZ     SPMOP             TAPE ALREADY OPEN
         BAL,SR3  NOTAPE            FIX SN'S AND FORCE INTO DCB
         LW,R5    L(X'01010101')
         STH,R5   VPT:EO+1          FNAME=X'01'
         STW,R5   VPT:EO
         CAL1,1   FPT:EO
         M:CLOSE  F:EO,(PTL),(SAVE)  GETS TAPE AND ELIMINATES DMY FILE
         STW,R3   NOTAPFG
SPMOP    EQU      %
         M:OPEN   F:EO,(ERR,SPOPN),(ABN,SPOPN)
         MTB,0    BLABL,R2
         BNEZ     SPDONE            NO INDEX TO WRITE
         M:WRITE  F:EO,(BUF,*PAGE),(SIZE,*COUNT),(ERR,SPWRT),;
                  (ABN,SPWRT)
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,R7    7
         LB,SR1   SR3,R1
         SLS,SR1  15
         LB,SR4   SR3
         STB,SR4  SR1                  CODE,SUB-CODE IN 0-15
SEND:ERR1 EQU     %
         STB,R0   SR1,R3
         SCS,SR1  4
         AI,SR1   C'0'
         LB,SR4   SR1,R3
         CI,SR4   C'9'
         BLE      %+2
         AI,SR4   -X'39'            FA-39=C1, ETC
         STB,SR4  ERRMSG,R7
         AI,R7    1
         CI,R7    11
         BL       SEND:ERR1
         LI,SR1   ERRMSG
         STW,SR1  MAILPAR
         LI,SR3   MAILPAR
         LI,D4    1                 PUT FAIL TO BACKUP MSG IN MAILBOX
         BAL,SR4  MAILBOX
         B         *SR2
         END

