         PCC      0
*
*M*      FILL     FILE RESTORING MODULE FOR THE FILL PROCESSOR
*
*
*P*      NAME:    FILL
*P*
*P*      PURPOSE: TO RESTORE PREVIOUSLY SAVED BACKUP TAPES TO
*P*               THE PERMANENT FILE SYSTEM.  THE RESTORE MAY BE
*P*               COMPLETE OR SELECTIVE.
*P*      DESCRIPTION:  BACKUP TAPES, CREATED BY FILL
*P*               OR FSAVE, ARE REQUESTED, MOUNTED, AND OPENED;
*P*               IF THE DISC FILE CORRESPONDING TO THE TAPE FILE
*P*               DOES NOT EXIST, IT WILL BE COPIED FROM TAPE TO DISC;
*P*               IF THE CORRESPONDING DISC FILE EXISTS BUT IS OLDER THAN
*P*               THE TAPE FILE, THE FILE WILL BE COPIED FROM TAPE TO
*P*               DISC; OTHERWISE, THE TAPE WILL SKIP TO THE NEXT FILE.
*P*               THIS PREVENTS AN ACTIVE DISC FILE FROM BEING CLOBBERED
*P*               WITH AN OLDER TAPE FILE.
*P*      REFERENCE:  SYSTEM MANAGEMENT REFERENCE MANUAL
*P*                  OPERATIONS REFERENCE MANUAL
*P*
         PAGE
         SYSTEM   SIG7P
*
*        ALL DEFS IN FILL FOLLOW
*
         DEF      COMPDAT           COMPARES TWO DATES
         DEF      DEBUG             RUN IN A DEBUG MODE, I.E. UNDER
*,*                                 DELTA.  FILES ARE NOT DELETED NOR
*,*                                 ARE DESCRIPTORS MODIFIED IN THIS MODE
         DEF      ERR:RET           RETURN ADDRESS FOR ERROR CONDITIONS
*,*                                 IN THE FIND:STRG, DO:FID, DO:ACCT,
*,*                                 FIND:REEL, AND SK:BL SUBROUTINES
         DEF      ERR:RET1          TEMPORARY STORAGE FOR THE CONTENTS
*,*                                 OF ERR:RET WHEN FIND:STRG AND SK:BL
*,*                                 ARE USED BY THE PURGE MODULE
         DEF      FILL              DEF FOR PATCHING FILL PROCEDURE
         DEF      FILLD             DEF FOR PATCHING FILL DATA
         DEF      FIND:STRG         SEARCHES SEL:COM:BUF FOR A MATCH
*,*                                 WITH AN INPUT CHARACTER STRING
         DEF      HI                END OF TABLE TO CHECK UPPER LIMIT
*,*                                 VALIDITY OF TAPE SERIAL NUMBERS
         DEF      KEYIN             FPT FOR OPERATOR INPUT TO FILL
         DEF      LOW               END OF TABLE TO CHECK LOWER LIMIT
*,*                                 VALIDITY OF TAPE SERIAL NUMBERS
         DEF      NO:FILL           BUILD F:BACKUP FILE AND RELEASE
*,*                                 ACQUIRED MEMORY
         DEF      PATCH             200 LOCATION PATCH AREA
         DEF      SAVKEY            KEY OF THE OPTIONS RECORD IN F:BREC
         DEF      SEL:BUF           LOCATION OF A ONE-PAGE BUFFER
*,*                                 CONTAINING FILES TO BE SELECTIVELY
*,*                                 RESTORED
         DEF      SEL:COM           END OF THE SEL:COM:BUF BUFFER
*,*                                 (USED FOR NEGATIVE INDEXING)
         DEF      SEL:COM:BUF       80 BYTE GENERAL PURPOSE BUFFER
         DEF      SEL:MT            CLOSE OUT THE SELECTIVE FILL PROCESS
         DEF      SELFILL           BEGIN A SELECTIVE FILL PROCESS
         DEF      SELKEY            KEY FOR THE SELECTIVE FILL DATA
*,*                                 RECORD IN THE F:BREC FILE
         DEF      SK:BL             FIND THE NEXT NON-BLANK, NOT-TAB
*,*                                 CHARACTER IN SEL:COM:BUF
         DEF      SLAVE             RETURN TO SLAVE MODE FROM MASTER
         DEF      SYS               FPT USED TO ENTER MASTER MODE
         DEF      TAPETYPE          DOUBLEWORD TABLE OF MBS DOUBLEWORDS
*,*                                 TO BUILD MESSAGES CONCERNING THE
*,*                                 CURRENT OPERATION OR THE AUTHOR OF
*,*                                 A PARTICULAR TAPE SET
         DEF      TRUNC             FPT FOR DCB TRUNCATION
         DEF      TYPE              FPT FOR FILL MESSAGES TO OPERATOR
         DEF      USER:FPAR         BUFFER CONTAINING FPARAM INFO
*,*                                 FROM THE F:USR DCB
         DEF      USRABN            ABN RETURN ROUTINE FROM F:USR DCB
         DEF      USRERR            ERR RETURN ROUTINE FROM F:USR DCB
         DEF      YESFL             BEGIN A FILL PROCESS
         PAGE
*
*        ALL REFS IN FILL FOLLOW
*
         REF      BACKUP            MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      BACKUPD           MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      BACKXT            STORAGE FOR RETURN ADDRESS ON CALLS
*,*                                 TO CERTAIN BACKUP ROUTINES
         REF      BB1               EXIT TO SLEEP IF DYNAMIC PAGE NOT
*,*                                 AVAILABLE FOR SELFILL
         REF      BLABL             BUFFER TO HOLD USER LABEL INFORMATION
*,*                                 FROM A TAPE FILE OPEN
         REF      BLANKS            ZAP SIZE AND ORG WHICH WERE
*,*                                 INCORRECTLY SET UP BY PRINTLIN
         REF      BLDMAIL           CHECK TO SEE IF A USER'S MAILBOX IS
*,*                                 TO BE BUILT WITH FILL-RELATED MESSAGES
         REF      BREC:ABN          BUILD F:BREC IF NOT THERE
         REF      BREC:ERR          BUILD F:BREC IF NOT THERE
         REF      BSR1              IGNORE ERR/ABN RETURNS IN SOME CASES
         REF      BUF               LOCATION OF DATA BUFFER FOR READ
         REF      BUFSZ             SIZE OF DATA BUFFER FOR TAPE READ
         REF      CLORGSIZ          ZAP SIZE AND ORG WHICH WERE
*,*                                 INCORRECTLY SET UP BY PRINTLIN
         REF      DATACCT           IF IN DEBUG MODE, SET ACCOUNT OF TAPE
*,*                                 TO BE RUNNING ACCOUNT
         REF      DATEAD            CHECK IF INCOMING TAPE FILE HAS
*,*                                 EXPIRED
         REF      DEFAULT           INITIAL SIZE OF THE DATA BUFFER
         REF      DO:TABLES:ADS     INITIALIZATION:  SET UP WINDOW
*,*                                 ADDRESSES TO MONITOR DATA
         REF      DO:TIME           INITIALIZATION:  SET UP SERIAL #
         REF      DUMMY             TRANSFER DUMMY ATTRIBUTES TO DISC
*,*                                 FILE IF NOT IN TAPE FILE
         REF      ENVIR             TEMP STACK FOR REGISTER STORAGE
         REF      EOACCT            IN DEBUG MODE, SET ACCOUNT OF TAPE
*,*                                 TO BE RUNNING ACCOUNT
         REF      ERR49             SLEEP A BIT IF INPUT TAPE NOT THERE
         REF      ERR55             SLEEP A BIT IF TOO MANY FILES NOW OPEN
         REF      F:BACKUP          INITIALIZATION:  CREATE F:BACKUP
*,*                                 FILE IF IT DOES NOT ALREADY EXIST
         REF      F:BREC            CREATE THE F:BREC FILE IF IT DOES
*,*                                 NOT EXIST; READ F:BREC FILE FOR
*,*                                 SELKEY ENTRIES (SELFILL INFORMATION)
         REF      F:SEL             READ SEL:FIL FILE FOR SELFILL COMMANDS
         REF      F:TI              OPEN AND READ TAPE FILES
         REF      F:USR             CREATE AND WRITE DISC FILES
         REF      FMAILBX           FAST ENTRY POINT TO MAILBOX
         REF      FPAR              BUFFER TO BUILD MESSAGES IN; CHECK TO
*,*                                 SEE THAT TAPE FILE IS NEWER THAN DISC
         REF      FUSR:DESC         CHECK FOR LAST FILE IN ACCOUNT
         REF      GETBUF            ACQUIRE A BUFFER FOR USER'S TAPE DATA
         REF      GRANCYLAD         CHECK TO SEE IF 5700 ERROR WAS A RE-
*,*                                 SULT OF PHYSICAL RESOURCE EXHAUSTION
         REF      GRANMINAD         CHECK TO SEE IF 5700 ERROR WAS A RE-
*,*                                 SULT OF PHYSICAL RESOURCE EXHAUSTION
         REF      GRANPACKAD        CHECK TO SEE IF 5700 ERROR WAS A RE-
*,*                                 SULT OF PHYSICAL RESOURCE EXHAUSTION
         REF      GRANRADAD         CHECK TO SEE IF 5700 ERROR WAS A RE-
*,*                                 SULT OF PHYSICAL RESOURCE EXHAUSTION
         REF      INT               CHECK PERIODICALLY FOR OPERATOR KEYIN
         REF      J:JIT             PICK UP USER NUMBER
         REF      LASTACCT          STATUS DISPLAY OF CURRENT ACCOUNT;
*,*                                 REMEMBER ACCOUNT FOR CRASH CASES
         REF      LASTREELX         PREVENT FILLING THE BACKUP TAPE
*,*                                 CURRENTLY BEING WRITTEN
         REF      LASTRUN           STATUS DISPLAY OF CURRENT OPERATION;
*,*                                 REMEMBER OPERATION FOR CRASH CASES
         REF      LOCCODE           TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      LOCCODE1          TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      MAIL              MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      MAILBOX           INFORM USER OF SUCCESS/FAILURE OF
*,*                                 FILL OPERATIONS; PRINTS ON LP ALSO
         REF      MAILD             MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      MOVEVLP           TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      MTIME             IF IT HAS NOT CHANGED, USE FMAILBX
         REF      NEWQ              VERIFY THAT FILL WAS LOADED WITH
*,*                                 CORRECT MONITOR REFERENCES
         REF      NMPG              ACQUIRE A LARGER BUFFER, IF POSSIBLE,
*,*                                 FOLLOWING LOST DATA ABNORMALS
*,*                                 LINE PRINTER MESSAGE ALREADY DONE
         REF      NOPRINT           AVOID HAVING MAILBOX DUPLICATE
         REF      NOTAPFG           PREVENT FILLING THE BACKUP TAPE
*,*                                 CURRENTLY BEING WRITTEN
         REF      OPSMSG            PRINT RESTART MESSAGE ON OC
         REF      ORGMBS            PUT SYNON ORGANIZATION INTO
*,*                                 PRINTLIN BUFFER
         REF      ORGTBL            PUT SYNON ORGANIZATION INTO
*,*                                 PRINTLIN BUFFER
         REF      PBUFFER           LINE PRINTER MESSAGE BUFFER
         REF      PBUFINIT          INITIALIZE PBUFFER FOR SELECTIVE
*,*                                 FILL ERROR MESSAGES
         REF      PGINCRM           SIZE OF BUFFER INCREMENT TO ADD TO
*,*                                 INITIAL BUFFER IF IT WAS TOO SMALL
         REF      PRDCRM            BUMP JIT LIMITS FOR DISC STORAGE
         REF      PRDPRM            BUMP JIT LIMITS FOR DISC STORAGE
         REF      PRINT             PRINT FILL LINE PRINTER MESSAGES
         REF      PRINTLIN          FORMAT THE LINE PRINTER MESSAGES
         REF      PURGE             CHECK FOR THRESHOLD VIOLATIONS OR
*,*                                 RESPOND TO OPERATOR INTERRUPT
         REF      PURGED            MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      PURGEINT          INITIALIZATION:  SET UP BREAK CON-
*,*                                 TROL FOR THE FILL GHOST
         REF      PURGEP            MAKE START ADDRESS OF ALL MODULES
*,*                                 AND MODULE DATA PART OF SNAP BUFFER
         REF      QUEUE             VERIFY THAT FILL WAS LOADED WITH
*,*                                 CORRECT MONITOR REFERENCES
         REF      QUEUE1            VERIFY THAT FILL WAS LOADED WITH
*,*                                 CORRECT MONITOR REFERENCES
         REF      REELTMP           INITIALIZATION:  SET UP JULIAN DAY
*,*                                 PART OF TAPE SERIAL NUMBER
         REF      REGS              COMMON STORAGE FOR REGISTERS ON
*,*                                 A CALL TO SNAPPER
         REF      RELEASE           RELEASE ACQUIRED CORE AND THEN SLEEP
         REF      SAVEBUF           BUFFER TO READ FOR INITIAL OPTIONS
         REF      SAVESIZ           SIZE OF SAVEBUF IN WORDS
         REF      SEND:ERR          SUBROUTINE TO PUT ERROR CODE FOR
*,*                                 A FILL FAILURE INTO MESSAGE
         REF      SETHEADR          PUT FILL OR SELECTIVE FILL INTO
*,*                                 LINE PRINTER TITLE LINE
         REF      SL:GPRIO          BUMP BASE PRIORITY TO IMPROVE
*,*                                 PERFORMANCE RELATIVE TO OTHERS
         REF      SNAPPER           PROVIDE DIAGNOSTIC SNAPS IN UNUSUAL
*,*                                 OR UNEXPECTED SITUATIONS
         REF      TAPETYP           USE PROPER DEVICE TYPE FOR TAPE OPEN
         REF      THRESH            CHECK TO SEE IF 5700 ERROR WAS A RE-
*,*                                 SULT OF PHYSICAL RESOURCE EXHAUSTION
         REF      TIMEAD            CHECK IF INCOMING TAPE FILE HAS
*,*                                 EXPIRED
         REF      TRAPPER           INITIALIZATION:  SET UP TRAP CON-
*,*                                 TROL FOR THE FILL GHOST
         REF      TVLPTBL           TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      TVLPTSZ           TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      UB:PRIOB          BUMP FILL'S BASE PRIORITY FOR
*,*                                 BETTER AND FASTER SERVICE
         REF      VLPTBL            TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         REF      VLPTSIZ           TRANSFER TAPE FILE ATTRIBUTES TO
*,*                                 CORRESPONDING DISC FILE
         PAGE
         REF      GETCOM            GET ANOTHER COMMAND IF TOLD TO QUIT
*,*                                 WHEN FILL WASN'T DOING ANYTHING
**                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
VPT:SIZ  EQU      112
FL:TAPE  EQU      F:TI
FUSRACCT EQU      F:USR+32
LBLACCT  EQU      BLABL+1
LBLORG   EQU      BLABL+3
LBLRSTOR EQU      BLABL+4
LBLDATE  EQU      BLABL+5
LBLVLPS  EQU      BLABL+7
SUPCLOSE EQU      6
         TITLE    '**  DATA  **'
*                 THE FOLLOWING MUST BE CONTIGUOUS & IN ORDER
FILLD    EQU      %
         TEXT     'FILL LOCATIONS: DATA,PROCEDURE'
         DATA     FILLD,FILL
         TEXT     'BACKUP'
         DATA     BACKUPD,BACKUP
         TEXT     'PURGE'
         DATA     PURGED,PURGEP
         TEXT     'MAILBOX'
         DATA     MAILD,MAIL
FILL:TEXTC TEXTC  'FILL'
         TEXTC    '='
         TEXTC    '('
RTPAREN  TEXTC    ')'
         TEXTC    ','
         TEXTC    '('
         TEXTC    'REEL'
         TEXTC    '='
         TEXTC    ')'
*                 UP TO THIS POINT.
*
*                 THESE STRINGS ARE FOR LEGAL RANGES OF VALUES IN
*                  REEL NUMBERS (DDLD).  NEGATIVE INDEXING IS USED
SAVEREGS RES      16
         TEXT     '00AA'
LOW      EQU      %
         TEXT     '99Z9'
HI       EQU      %
SELKEY   TEXTC    'SEL:FIL'
FSAVE    TEXT     'FSAVE'
SQRL     TEXT     'SQUIRREL'
INCR     TEXT     'INCREMENTAL'
SAVALL   TEXT     'SAVEALL'
PURG     TEXT     'PURGE'
FILLTXT  TEXT     'FILL'
SELFILTX TEXT     'SELECTIVE FILL'
FILLER   TEXT     ' TAPE CREATED ON '
         BOUND    8
MBS:T:SB DATA     TACT0,16**22+1
CBS:ACT1 DATA     BA(LBLACCT),8**24+BA(FUSRACCT)
CBS:ACT2 DATA     BA(LBLACCT),8**24+BA(ZAPACCT)
SKIPMBS  DATA     BA(SKIPMSG)
         GEN,8,24 28,BA(PBUFFER)+64
DELEMBS  DATA     BA(DELEMSG)
         GEN,8,24 28,BA(PBUFFER)+64
COMPACCT DATA     D1**2             LOCATION OF ACCOUNT IN SELFIL ENTRY
         GEN,8,24 8,BA(LBLACCT)
FAILMBS  DATA     BA(FAILMSG)
         GEN,8,24 33,BA(PBUFFER)+64
AFAILMBS DATA     BA(ACCTMSG)
         GEN,8,24 8,BA(PBUFFER)+76
AFAIL1   DATA     BA(FAILMSG)+17
         GEN,8,24 17,BA(PBUFFER)+84
REELMBS  DATA     D4**2
         GEN,8,24 4,BA(PBUFFER)+93
SELACCT  DATA     D1**2
         GEN,8,24 8,BA(PBUFFER)+2
TAPETYPE DATA     BA(FSAVE)
         GEN,8,24 5,BA(FPAR)+1
         DATA     BA(SAVALL)
         GEN,8,24 7,BA(FPAR)+1
         DATA     BA(INCR)
         GEN,8,24 11,BA(FPAR)+1
         DATA     BA(SQRL)
         GEN,8,24 8,BA(FPAR)+1
         DATA     BA(PURG)
         GEN,8,24 5,BA(FPAR)+1
         DATA     BA(FILLTXT)
         GEN,8,24 4,BA(FPAR)+1
         DATA     BA(SELFILTX)
         GEN,8,24 14,BA(FPAR)+1
CUR:ACCT DATA     0,0
MAIL:AC  DATA     0,0               DONT MOVE FROM DOUBLE WORD
MLBXNM   TEXT     ' MAILBOX'
SELBINIT GEN,8,24 20*4,BA(SEL:COM:BUF)
TACT0    DATA     0
TACT1    DATA     0
TFIDPTR  DATA     0
TSN      DATA     0
*                 TPY ENTRY FOR FID FOR SELFIL
TFID     DATA     0,0,0,0,0,0,0,0
*                 BAD SELFIL COMMAND BUFFER
BAD:COM:MESS TEXTC  'BAD SEL:FIL INPUT  '
SEL:COM:BUF EQU   %
         RES      20
SEL:COM  EQU      %                 LABEL FOR PRECEEDING 20 WORD BUFFER
ERR:RET  PZE      BAD:SEL:COM
ERR:RET1 DATA     0
SEL:BUF  DATA     0
SELFID:PTR DATA   0
SELECT   DATA     0                 1=SELECTIVE FILL
SPBYCT   RES      1
SR1X     DATA     0
57ERR    PZE                        RETURN ADDRESS FOR A 57 ERR
DELEFLAG PZE                        NON-0 => IGNORE FILELIST ON FILL
R47      DATA     0,0,0,0
MAILPAR  PZE      NOMSG
         PZE      MAIL:AC
MAILSUC  PZE      SUCCESS
         PZE      MAIL:AC
DAYMONTH DATA,1   0,31,28,31,30,31,30,31,31,30,31,30,31,0
         BOUND    4
SUCCESS TEXTC     'FILLED                   '
         RES      9
NOMSG    TEXTC    'ERROR      FAILED TO RECOVER                  '
         RES      9
KADR     TEXTC    'BACKUP'
BADLMN   TEXTC    'FILL LOADED WITH WRONG MONSTK..MUST RELOAD'
FILLINIT TEXTC    'FILL GHOST INITIATED - ';
                  ,'USE ''INT,FILL.'' FOR COMMANDS'
OPERMSG  TEXTC    'ARE THERE MORE SETS OF BACKUP TAPES(Y/N)'
BADSEQ   TEXTC    'FILE OUT OF SEQUENCE-QUIT OR CONTINUE(Q/C)'
NTRREEL  TEXTC    'FILL REEL NUMBER='
STARTFILE TEXTC   'SKIP TO FILE '
DELMSG   TEXTC    'DELETE FILES AS PER INCREMENTAL FILELIST(Y/N)'
NOGRANS  TEXTC    'INSUFFICIENT PHYSICAL STORAGE TO COMPLETE FILL'
NOMSG:FAIL TEXT   'FAILED TO RECOVER'
NOMSG:FOLL TEXT   'FOLLOWING FILE   '
SKIPMSG  TEXT     '  *SKIPPED*  DISK FILE NEWER'
DELEMSG  TEXT     '  *DELETED*  NOT IN FILELIST'
FAILMSG  TEXT     '  *FAILED*  FILE NOT ON TAPE XXXX'
ACCTMSG  TEXT     'ACCOUNT'
SAVKEY   TEXTC    'SAV'
         BOUND    8
ZAPFLAG  EQU      %
YES      PZE                        DONT DISTURB ORDER FOR DW STUFF
FID:ACCT EQU      %                 INPUT BUFFER--FID & ACCT
         DO1      11
         DATA     0
START:ACCT  DATA  0,0               STARTING ACCT FOR FILL
TIME     RES      2
SYNFLAG  PZE                        SYNON FILE FLAG
         TITLE    '**  FPT  **'
USER:FIL GEN,8,7,17 X'14',,F:USR    PARAMETER LIST TO OPEN USR FILE
         DATA     X'C768DB39'
         PZE      USRERR
         PZE      USRABN
USER:ORG DATA     0
         DATA     1                 SEQUENTIAL ACCESS
USER:MOD DATA     2                 OUTPUT MODE
         DATA     2                 SAVE
         DATA     USER:FPAR
KEYMAX   DATA     0
SLIDES   DATA     0
SPARE    DATA     0
URSTORE  DATA     0
USER:VPT RES      VPT:SIZ
USER:FPAR RES     VPT:SIZ
         SPACE    2
TAPEREAD   GEN,8,7,17    X'0E',0,FL:TAPE
         DATA     X'F8000000'
         DATA     MOERR             ERR RET
         DATA     MOABN             ABN RET
         DATA     F:USR             OUTPUT DCB
         PZE      *BUF
         PZE      *BUFSZ
         SPACE    2
FL:TAPE:OPN EQU   %
         GEN,8,7,17 X'14',0,FL:TAPE ADJUST DCB  W/VLPS
         DATA     X'00006002'
         DATA     X'01010000'
         DATA     1                 IN
FL:VOL   DATA     0                 VOL
FL:TAPE:SN  DATA  X'07012424'
         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:SPEC GEN,8,7,17  X'14',4,F:USR  TEST FILE W/FPARAM
         DATA     X'C0200000'
         DATA     SPECERR
         DATA     SPECABN
         DATA     USER:FPAR
         SPACE    2
TF:SPEC  GEN,8,7,17  X'14',4,F:USR   TEST FILE W/O FPARAM
         DATA     X'C0200400'       NXTF
         DATA     SPECERR,SPECABN,0  ERR,ABN,FPARAM
         SPACE    2
INTPURGE GEN,8,24 X'0E',PURGEINT
         SPACE    2
KEYIN    GEN,8,24 4,0
         DATA     X'E0000000'
         PZE      *R5
         PZE      *R6
         PZE      *R7
         SPACE    2
1ST:OPEN GEN,8,24 X'14',F:BREC
         DATA     X'C1400000'
         DATA     BREC:ERR
         DATA     BREC:ABN
         DATA     4,2               INOUT,SAVE
         SPACE    2
1ST:READ GEN,8,24 X'10',F:BREC
         DATA     X'F8000000'
         DATA     BSR1
         DATA     BSR1
         DATA     SAVEBUF
         PZE      *R7               SIZE IN R7
         DATA     SAVKEY
OPENBREC GEN,8,24 X'14',F:BREC
         DATA     X'C3400000'
         DATA     SELO
         DATA     SELO
         DATA     2,4,2
         SPACE    2
READBREC GEN,8,24 X'10',F:BREC
         DATA     X'F8000000'
         DATA     SEL:OPN:SELF
         DATA     SEL:OPN:SELF
         PZE      *SEL:BUF
         DATA     X'800'
         DATA     SELKEY
         SPACE    2
TRAPC    GEN,8,24 X'14',TRAPPER
         DATA     X'003F8300'       TRAP ON EVERYTHING.
         SPACE    2
OPENSEL  GEN,8,24 X'14',F:SEL
         DATA     X'C1000000'
         DATA     NO:SEL:FILE
         DATA     NO:SEL:FILE
         DATA     4
         SPACE    2
READSEL  GEN,8,24 X'10',F:SEL
         DATA     X'C0000000'
         DATA     SEL:FIL:EOF
         DATA     SEL:FIL:EOF
         SPACE    2
OPNBRECO GEN,8,24 X'14',F:BREC
         DATA     X'C7400000'
         DATA     BSR1
         DATA     BSR1
         DATA     2,2,2,2
         SPACE    2
CLOSBREC GEN,8,24 X'15',F:BREC
         PZE      *0
         DATA     2
         SPACE    2
WRITBREC GEN,8,24 X'11',F:BREC
         DATA     X'F8000040'
         DATA     BSR1
         DATA     BSR1
         PZE      *SEL:BUF
         DATA     X'800'
         DATA     SELKEY
         SPACE    2
DELREC   GEN,8,24 X'0D',F:SEL
         DATA     0
         SPACE    2
CLOSSEL  GEN,8,24 X'15',F:SEL
         PZE      *0
         DATA     2
         SPACE    2
TRUNC    GEN,1,7,24   1,X'12',R7
         DATA     0
         SPACE    2
DELSEL   GEN,8,24 X'0D',F:BREC
         PZE      *0
         DATA     SELKEY
         SPACE    2
TYPE     GEN,8,24 X'02',0
         PZE      *0
         PZE      *R5
         SPACE    2
OPNXTAP  GEN,8,24 X'14',FL:TAPE
         DATA     X'C0000400'
         DATA     BSR1
         DATA     BSR1
         SPACE    2
CLSTPREM GEN,8,24 X'15',FL:TAPE
         DATA     X'20'
         SPACE    2
OPNUSREL GEN,8,24 X'14',F:USR
         DATA     X'C0000000'
         DATA     BSR1
         DATA     BSR1
         SPACE    2
CLSUSREL GEN,8,24 X'15',F:USR
         PZE      *0
         DATA     1
         SPACE    2
PFILEOF  GEN,8,24 X'1C',FL:TAPE
         DATA     0
         SPACE    2
CLSTAPSV GEN,8,24 X'15',FL:TAPE
         PZE      *0
         DATA     2
         SPACE    2
OPNBACKO GEN,8,24 X'14',F:BACKUP
         DATA     X'C1400000'
         DATA     GO:BACK1
         DATA     GO:BACK1
         DATA     2,2
         SPACE    2
OPNDEVTP GEN,8,24 X'14',FL:TAPE
         DATA     X'C0040000'
         DATA     BSR1
         DATA     BSR1
         PZE      *TAPETYP
         SPACE    2
OPENBACK GEN,8,24 X'14',F:BACKUP
         DATA     X'C1000000'
         DATA     ERBCK
         DATA     ERBCK
         DATA     4                 INOUT
         SPACE    2
CLSBACK  GEN,8,24 X'15',F:BACKUP
         PZE      *0
         DATA     2
         SPACE    2
PRECORDT GEN,8,24 X'1D',FL:TAPE
         DATA     X'10'
         SPACE    2
PRECORDF GEN,8,24 X'1D',F:USR
         DATA     X'10'
         SPACE    2
CLSUSRSV GEN,8,24 X'15',F:USR
         PZE      *0
         DATA     2
         SPACE    2
OPENTAPE GEN,8,24 X'14',FL:TAPE
         DATA     X'C134040A'
         DATA     TPERR
         DATA     TPABN
         DATA     1                 OPEN INPUT
         DATA     FPAR
         DATA     BLABL
         PZE      *TAPETYP
         DATA     X'02010202'
TAPACCT  TEXT     ':SYS    '
         SPACE    2
READSPEC GEN,8,24 X'10',FL:TAPE
         DATA     X'F0000000'
         DATA     TPERR
         DATA     TPABN
         PZE      *BUF
         PZE      *BUFSZ
         SPACE    2
READDAT  GEN,8,24 X'10',FL:TAPE
         DATA     X'F0000000'
         DATA     ENDFILE1
         DATA     ENDFILE1
         DATA     BLABL
         DATA     24
         SPACE    2
TFFDNA   GEN,8,7,17  X'14',X'44',F:USR   TEST FILENX ACCT,FILDIR
         DATA     X'C0000001'
         DATA     SPECERR,SPECABN
         DATA     X'01000101',X'01000000'
         DATA     X'02010202'
ZAPACCT  DATA     0,0
         SPACE    2
SYS      GEN,8,24 8,0
DEBUG    PZE      0
PATCH    RES      150
         TITLE    '**MAIN PROGRAM-STARTUP & OPEN TAPE**'
         CSECT    1
FILL     EQU      %
         BAL,SR4  DO:TABLES:ADS
         CAL1,8   INTPURGE
         CAL1,8   TRAPC             ESTABLISH TRAP CONTROL FOR DUMPS
         BAL,SR4  DO:TIME           SET UP START SN FOR BACKUP
         CAL1,6   SYS               CHECK FOR PROPER LOADING
         BAL,R6   SLAVE
         CI,SR1   QUEUE
         BNE      BADLOAD
         CI,SR2   QUEUE1
         BNE      BADLOAD
         CI,SR3   NEWQ
         BE       FILL1
BADLOAD  EQU      %
         LI,R5    BADLMN
         CAL1,2   TYPE              TELL OPERATOR OF PROBLEM
         CAL1,9   1                  AND EXIT
FILL1    EQU      %
         LC       J:JIT             IS IT A GHOST RUNNING
         BCR,4    FILL2             NO, DON'T BUMP BASE PRIORITY
         LB,R5    J:JIT,R3          GET SYSID
         CAL1,6   SYS               MASTER MODE
         LW,R4    SL:GPRIO
         AI,R4    -2                BUMP BASE PRIORITY BY 2
         STB,R4   UB:PRIOB,R5
         BAL,R6   SLAVE
FILL2    EQU      %
         MTW,0    DEBUG
         BEZ      FILL3
         LCI      2                 STRAIGHTEN OUT ACCOUNTS
         LM,R4    J:JIT+1            USED IN FPTS TO AVOID
         STM,R4   TAPACCT             UNNECESSARY ABNORMALS.
         STM,R4   EOACCT
         STM,R4   DATACCT
FILL3    EQU      %
*
*        INITIALIZE ALLYCAT'S THRESHOLD TO BE THE SAME AS OURS
*
         LW,R6    THRESH
         CW,R6    *GRANMINAD
         BE       FILL4             THRESHOLDS ARE THE SAME
         MTW,0    DEBUG
         BGEZ     FILL4
         STW,R6   *GRANMINAD        MAKE THEM THE SAME
FILL4    EQU      %
*
*        READ THE SAV KEY FO F:BREC TO RESTORE FIXED OPTIONS
*
         CAL1,1   1ST:OPEN          OPEN F:BREC (ABN TO BREC:ERR - BACKUP)
         LI,R7    SAVESIZ           MAKE SIZE IN BYTES
         SLS,R7   2
         CAL1,1   1ST:READ          READ F:BREC (ABN TO % + 1)
         LI,R7    F:BREC
         CAL1,1   TRUNC             FREE UP THE BUFFER PAGE
*
         LW,R6    REELTMP
         AI,R6    X'C000'           C'A'-1
         STW,R6   LASTREELX
         LI,R5    FILLINIT
         CAL1,2   TYPE
         B        NO:FILL
         SPACE    3
SLAVE    EQU      %
         LPSD,0   SLAVEPSD
SLAVE1   B        0,R6
         BOUND    8
SLAVEPSD DATA     X'00C00000'+SLAVE1
         DATA     0
         PAGE
*
*F*      NAME:    YESFL
*F*
*F*      PURPOSE: INTERROGATE THE OPERATOR FOR THE STARTING REEL NUMBERS
*F*               OF THE BACKUP TAPE SETS TO BE RESTORED; THIS IS THE
*F*               ENTRY POINT FOR A FULL RESTORE OF THE TAPE SETS.
*F*      DESCRIPTION:  THE OPERATOR IS REQUESTED TO KEY-IN
*F*               THE STARTING REEL NUMBER AND THE STARTING FILE.  THE
*F*               ROUTINE THEN OPENS THE TAPE TO THE FIRST FILE.  IF THIS
*F*               IS THE FIRST REEL OF A BACKUP SET, THE OPERATOR WILL BE
*F*               INFORMED OF THE TAPE TYPE (FSAVE,SAVEALL,SQUIRREL,
*F*               INCREMENTAL, OR PURGE) AND THE DATE THE TAPE WAS CREATED.
*F*               THE TAPE FILES WILL BE OPENED SUCCESSIVELY UNTIL THE
*F*               LAST REEL OF THE SET HAS BEEN PROCESSED.  THE OPERATOR
*F*               IS THEN ASKED IF THERE ARE MORE TAPE SETS TO BE RESTORED;
*F*               IF SO, THE PROCESS IS REPEATED.  OTHERWISE, FILL EXITS
*F*               TO BACKUP AND EVENTUALLY TO SLEEP.
*F*
YESFL    EQU      %
DO:SN    EQU      %
         LI,R6    5                 FILL TYPE OPERATION
         STW,R6   LASTRUN
         BAL,SR4  SETHEADR
         LI,R5    NTRREEL
         LI,R6    FID:ACCT
         LI,R7    5
         CAL1,2   KEYIN
         STW,R0   ZAPACCT
         STW,R0   ZAPACCT+1
         LW,R4    FID:ACCT
         LW,R5    FID:ACCT+1
         SCD,R4   8                 4-CHAR NUMBER NOW ASSEMBLED
         LB,R5    FID:ACCT          CHECK INPUT LENGTH
         CI,R5    5                 4 CHARS + LINE FEED
         BNE      DO:SN             ILLEGAL INPUT
         LB,R5    FID:ACCT,R5
         CI,R5    X'15'             N/L
         BNE      DO:SN             5TH CHAR MUST BE LINE FEED
*                    SAVE SN OF TODAYS LAST SET
         LI,R5    X'F0000'
         CS,R4    LASTREELX
         BNE      SN:DO
         LI,R5    X'FF00'
         CS,R4    LASTREELX
         BL       SN:DO
         STW,R4   LASTREELX
SN:DO    EQU      %
         LI,R6    -36
         LI,R5    X'FFF00'
NXT:SN   EQU      %
         STS,R4   FL:TAPE:SN+37,R6
         CW,R4    FL:TAPE:SN+37,R6
         BNE      %+2
         STW,R6   FL:VOL            SAVE INDEX TO COMPUTE VOL
         BIR,R6   NXT:SN
         LI,R6    37                CONVERT NEG INDEX TO + VOL
         AW,R6    FL:VOL
         STW,R6   FL:VOL
         AI,R6    -1
         STW,R6   ZAPFLAG           0 IF 1ST VOL, NON-ZERO IF NOT
*                 CHECK FOR SKIPPING
GET:START EQU     %
         STW,R0   START:ACCT        ZAP START OF ACCT
         STW,R0   START:ACCT+1
         LI,R5    STARTFILE
         LI,R6    FID:ACCT
         LI,R7    42
         CAL1,2   KEYIN
         LB,R5    FID:ACCT,R1       NULL REPLY
         CI,R5    X'15'             NL
         BE       SET:SN            NULL--LEAVE ACCT=0
FID:ACCTX EQU     FID:ACCT+11       ADDR FOR NEGATIVE IX
         LI,R5    -43               MSG INPUT IX
         LI,R6    0                 FNE LENGTH
         LB,R4    FID:ACCTX,R5
         CI,R4    C'.'
         BE       MOVE:ACCT         ACCT ONLY
*                    SETUP FILE NAME
GET:FNE EQU       %
         BAL,SR4  CHK:TERM          CHK FOR TERMINATOR
         B        END:FNE
         AI,R6    1
         BIR,R5   GET:FNE
         B        GET:START         NO TERMINATOR
END:FNE  EQU      %
         CI,R4    C'.'
         BNE      GET:START         NAME TERMINATOR NOT '.'
*                    HANDLE ACCT
MOVE:ACCT EQU     %
         STB,R6   FID:ACCT          SET FNE LENGTH
         LI,R6    -8
MOVE:ACCT1 EQU    %
         BIR,R5   %+2               STEP TO NEXT INPUT CHARACTER
         B        GET:START
         BAL,SR4  CHK:TERM
         B        MOVE:ACCT2        END ACCT
MOVE:ACCT3 EQU    %
         STB,R4   START:ACCT+2,R6
         BIR,R6   MOVE:ACCT1
         STW,R3   ZAPFLAG           SKIP PRECEEDING ACCTS IN DO:FILDR
         B        SET:SN
MOVE:ACCT2 EQU    %
         LI,R4    C' '              SET BLANKS
         AI,R5    -1                FORCE REPEAT TO BLANK FILL
         B        MOVE:ACCT3
CHK:TERM EQU      %
*                 FETCHES NEXT CHARACTER FROM FID:ACCTX,R5 AND
*                   CHECKS FOR TERMINATOR    EXIT NORMAL IF DATA
*                   EXIT SKIPPING IF TERMINATOR
         LB,R4    FID:ACCTX,R5
         CI,R4    C'.'
         BE       *SR4
         CI,R4    C' '
         BE       *SR4
         CI,R4    X'15'
         BE       *SR4
         AI,SR4   1
         B        *SR4
         TITLE    '**  MAIN PROGRAM--SELECTIVE FILL  **'
*D*      NAME:    SEL:BUF
*D*      PURPOSE: INTERNAL TABLE CONTAINING REFORMATTED
*D*               SEL:FIL FILE ENTRIES
*D*
*D*  ******************************
*D*  * BYTE COUNT  * BYTE LOCATION*
*D*  * OF ACCOUNT  * OF LAST USED *
*D*  * ENTRIES     * FILE ENTRY   *
*D*  ************************************************************
*D*  *             *              * FLAG WORD    *              *
*D*  *          ACCOUNT           *     AND      *    REEL #    *
*D*  *             *              * FILE POINTER *              *
*D*  ************************************************************
*D*  *                            /              \              *
*D*  *                          /                  \            *
*D*  *                        /                      \          *
*D*  *                      /                          \        *
*D*  *                    /                              \      *
*D*  *                   *********************************      *
*D*  *                   *               *               *      *
*D*  *                   *               * FILE NAME PNTR*      *
*D*  *                   *               * (0 = ACCOUNT) *      *
*D*  *                   *********************************      *
*D*  *            BITS    012345                                *
*D*  *                    ||||--- REQUESTED ACCOUNT PASSED      *
*D*  *                    |||---- REQUESTED FILE FOUND ON TAPE  *
*D*  *                    ||----- REQUESTED ACCOUNT FOUND       *
*D*  *                    |------ REQUESTED REEL MOUNTED        *
*D*  \                                                          \
*D*  /                                                          /
*D*  ************************************************************
*D*  *             *              *              *              *
*D*  *    TEXTC FILE NAME POINTED TO BY ACCOUNT ENTRY (4 WORDS) *
*D*  *             *              *              *              *
*D*  ************************************************************
         PAGE
*
*F*      NAME:    SELFILL
*F*
*F*      PURPOSE: TO PERFORM THE SELECTIVE RESTORE OF INDIVIDUAL FILES
*F*               OR ACCOUNTS FROM SYSTEM BACKUP TAPES.
*F*      DESCRIPTION:  THE FILE SEL:FIL IN THE :SYS ACCOUNT IS OPENED AND
*F*               THE SPECIFIC REQUESTS ARE READ, REFORMATTED, AND SAVED
*F*               INTERNALLY AND IN THE F:BREC FILE.  AS THE SEL:FIL ENTRY
*F*               IS PROCESSED, IT IS DELETED FROM THE FILE.  THE ROUTINE
*F*               THEN SORTS THE INTERNAL TABLE BY REQUESTED SERIAL NUM-
*F*               BER, INFORMS THE OPERATOR A SELECTIVE FILL IS STARTING,
*F*               AND REQUESTS THE FIRST TAPE.  AS FILES ARE FOUND ON THE
*F*               TAPE, THE TAPE DATE IS COMPARED TO THE CORRESPONDING
*F*               FILE DATE (IF IT EXISTS) AND THE TAPE FILE IS COPIED TO
*F*               DISC IF IT IS NEWER THAN THE DISC FILE ALREADY THERE.
*F*               THE ACCOUNT REQUESTING THE SELECTIVE RESTORE WILL BE
*F*               NOTIFIED OF THE SUCCESS OR FAILURE OF THE OPERATION VIA
*F*               A MAILBOX FILE BUILT OR UPDATED IN THAT USER'S ACCOUNT.
*F*               PROCESSING CONTINUES UNTIL ALL SPECIFIED TAPES HAVE BEEN
*F*               SEARCHED FOR THE REQUESTED FILES.
*F*      REFERENCE:  OPERATIONS REFERENCE MANUAL
*F*
SELFILL  EQU      %
         CAL1,8   L(X'08000001')    GET ONE DYNAMIC DATA PAGE
         BCS,8    BB1               NO PAGES AVAILABLE
         STW,SR2  SEL:BUF           SAVE START ADDRESS OF PAGE
*                 INITIALIZE SELFIL TABLE
         LI,R7    511
         STW,R0   *SEL:BUF,R7       ZERO WORDS 1-511
         BDR,R7   %-1
         LI,R7    2*4
         STW,R7   *SEL:BUF          NEXT ENTRY CTL WD
         LI,R7    512*4
         STW,R7   *SEL:BUF,R1       FIRST FID ENTRY CTL WD
*                 OPEN :BREC AND READ SEL:FIL RECORD
         CAL1,1   OPENBREC
*                 ER,ABN=SELO;DIRECT;INOUT;SAVE
         CAL1,1   READBREC
*                 ERR,ABN=SEL:OPN:SELF;BUF=SEL:BUF;KEY=SELKEY
SEL:OPN:SELF EQU  %                 OPEN SEL:FIL FILE
         CAL1,1   OPENSEL
*                 ERR,ABN=NO:SEL:FILE;INOUT
READ:SEL  EQU     %
         LW,R1    SELBINIT          CLEAR OUT THE BUFFER
         BAL,R5   BLANKS
         CAL1,1   READSEL
*                 ERR,ABN=SEL:FIL:EOF;BUF=SEL:COM:BUF
*                 TRANSLATE AND CHEK INPUT COMMAND,BUILDING AN ENTRY IN
*                 THE TEMPORARY TABLES
         BAL,SR4  FIND:FILL         VERIFY CHARS PRECEEDING FID
         BAL,SR4  DO:FID            HANDLES FID IF PRESENT
         BAL,SR4  DO:ACCT           HANDLES ACCT
         BAL,SR4  FIND:REEL         HANDLES REEL NBR AND OTHER CHARS
*                     CHK SEL:FIL SN = CURRENT BACKUP SN
         LW,D1    TSN
         LW,D2    L(X'FFFFFF00')
         CS,D1    LASTREELX         COMPARE IF SAME TAPE SET
         BNE      %+3
         LW,D1    NOTAPFG           & CURRENT TAPE IS IN USE
         BNEZ     BAD:SEL:COM       YES-REJECT COMMAND
*                 FINISH ENTRY IN TEMP FOR FID, IF PRESENT
         STW,R0   TFIDPTR
         LB,D1    TFID
         BEZ      NO:FID
         LI,R7    504*4             LAST FID ENTRY IN TABLE
NXT:FID  EQU      %
         LB,D1    *SEL:BUF,R7
         BEZ      MTFID             EMPTY ENTRY FOUND
         AI,R7    -32
         B        NXT:FID
SELO     EQU      %                 CREATE THE :BREC FILE
         LB,D1    SR3
         CI,D1    X'13'             RECORD DOESNT EXIST ON DELREC
         BE       SEL:MT13
         CI,D1    3                 FILE DOESNT EXIST
         BNE      SEL:OPN:SELF
         CAL1,1   OPNBRECO
*                 ERR,ABN=BSR1;KEYED;DIRECT;OUT;SAVE
         CAL1,1   CLOSBREC
*                 SAVE
         CAL1,1   OPENBREC
*                 ER,ABN=SELO;DIRECT;INOUT;SAVE
         B        SEL:OPN:SELF
MTFID    EQU      %
         STW,R7   TFIDPTR           SAVE IX OF FID
         LI,R6    -32
         CW,R7    *SEL:BUF,R1
         BGE      %+2
         STW,R7   *SEL:BUF,R1       SET NEW HI WATER FOR FIDS
*                 MOVE FI//NAME INTO FID AREA OF SEL:BUF
         LB,D1    TFID+8,R6
         STB,D1   *SEL:BUF,R7
         AI,R7    1
         BIR,R6   %-3
NO:FID   EQU      %
*                 MOVE ENTRY INTO SEL:BUF
         LW,R7    *SEL:BUF
         SLS,R7   -2
         AI,R7    -1
NXT:SEL  EQU      %
         LW,D1    TSN
         CB,D1    LOW-1             ('F0')
         BL       %+4
         LI,R6    X'80'             ZERO OUT THE HIGH
         EOR,D1   R6                 ORDER BIT OF THE 'F'
         STW,D1   TSN               (MAKES #'S < LETTERS)
         CI,R7    2
         BL       ENT:FOUND         TOP OF STACK
         CW,D1    *SEL:BUF,R7
         BGE      ENT:FOUND
         AI,R7    -3
         LW,R6    R7
         AI,R6    4
         LCI      4
         LM,D1    *SEL:BUF,R7
         STM,D1   *SEL:BUF,R6
         AI,R7    -1
         B        NXT:SEL
ENT:FOUND EQU     %                 MOVE DATA INTO ENTRY
         LD,D1    MBS:T:SB
         AW,D2    R7
         AW,D2    SEL:BUF
         SLD,D1   2                 WA TO BA
         MBS,D1   0
         LI,R7    16
         AW,R7    *SEL:BUF          UPDATE ENTRY POINTER
         STW,R7   *SEL:BUF
         CAL1,1   WRITBREC
*                 ERR,ABN=BSR1;ONEWKEY;BUF=SEL:BUF;KEY=SELKEY
DEL:SEL  EQU      %
         CAL1,1   DELREC
*                 NO OPTIONS
         AI,R7    48                CHECK FOR FULL BUFFER
         CW,R7    *SEL:BUF,R1
         BLE      READ:SEL
*                 OUTPUT FULL--SAVE REST OF SEL:FIL FILE
         CAL1,1   CLOSSEL
*                 SAVE
         LI,R7    F:SEL
         CAL1,1   TRUNC
NO:SEL:FILE EQU   %
         STW,R1   SELECT            SET SELECTIVE FILL FLAG
*                 ANY SELECTIVE FILLS TO DO
         LW,R7    *SEL:BUF
         CI,R7    2*4
         BG       SEL:SET:SN
SEL:MT   EQU     %
         CAL1,9   SUPCLOSE
         CAL1,8   L(X'09000001')    RELEASE DYNAMIC PAGE
         STW,R0   SEL:BUF           CLEAR THE BUFFER OUT
         CAL1,1   DELSEL
*                 F:BREC;KEY=SELKEY
SEL:MT13 EQU      %
         CAL1,1   CLOSBREC
*                 SAVE
         B        GO:BACK
SEL:SET:SN EQU    %
*                   SETUP SN'S
         LI,R7    5
         LI,D1    X'80'
         OR,D1    *SEL:BUF,R7       RESTORE THE 'F' TO #'S
         LI,R6    -36
         LI,D2    X'FFF00'
SEL:SET:SN1 EQU   %
         STS,D1   FL:TAPE:SN+37,R6
         CW,D1    FL:TAPE:SN+37,R6   FIND WHICH SN IS START
         BNE      %+2
         STW,R6   FL:VOL            SAVE INDEX FOR VOL
         BIR,R6   SEL:SET:SN1
         LI,R6    37                CONVERT -INDEX TO +VOL
         AW,R6    FL:VOL
         STW,R6   FL:VOL
         LI,R6    6                 SELECTIVE FILL OPERATION
         STW,R6   LASTRUN
         LI,R7    0                 RESTART CODE FOR OPS MESSAGE
         BAL,SR4  OPSMSG
         BAL,SR4  SETHEADR
         B        SET:SN
         SPACE 3
SEL:FIL:EOF EQU   %
         LB,SR3   SR3               IF SHORT-WILL CATCH LATER
         CI,SR3   7
         BE       *SR1
*                 HIT EOF--ZAP THE SEL:FIL FILE AND START PROCESSING
         CAL1,1   WRITBREC
*                 ERR,ABN=BSR1;ONEWKEY;BUF=SEL:BUF;KEY=SELKEY
         LI,R7    F:BREC
         CAL1,1   TRUNC
         LI,R7    1
         XW,R7    CLOSSEL+2
         CAL1,1   CLOSSEL
*                 RELEASE
         XW,R7    CLOSSEL+2
         B        NO:SEL:FILE
         SPACE    3
*                 BAD SEL:FIL COMMAND--LOG AND SKIP
BAD:SEL:COM EQU   %
         LB,D1    BAD:COM:MESS
         CI,D1    80
         BG       %+2
         AI,D1    80                INCLUDE COMMAND
         STB,D1   BAD:COM:MESS
         LI,R5    BAD:COM:MESS
         CAL1,2   TYPE
         B        DEL:SEL
         SPACE    3
SET:SN   EQU      %
         CAL1,1   FL:TAPE:OPN          ADJ.DCB TO SET SN
         STW,R0   TIME
         LI,R6    X'FF'             PUT LARGE BUFFER SIZE
         STB,R6   BLABL              IN BLABL FOR USER LABEL
         CAL1,1   OPENTAPE
*                 ERR,ABN=TPERR,TPABN;NXTF;IN
         STW,R1   NOTAPFG           SET THE TAPE-MOUNTED FLAG
         MTW,0    SELECT
         BEZ      SET:SN3
*
*        D1 HAS SN TO SEARCH FOR IN SELFILL LIST
*
         LB,R5    F:TI+11           GET CURRENT SERIAL NUMBER
         LW,R5    F:TI+X'47',R5
         CW,R5    D1                IS THIS CORRECT?
         BE       SET:SN1           YES, PROCEDE
         LCI      0
         STM,R0   REGS
         BAL,R3   SNAPPER           GET A SNAP OF THIS..SHOULDN'T HAPPEN
SET:SN1  EQU      %
         LW,R5    *SEL:BUF
         SLS,R5   -2                MAKE WORD COUNT OF ENTRIES
         LI,R6    4
         LI,R7    5
         LI,R9    1
         SLS,R9   31                SET UP HIGH ORDER BIT AS OUND FLAG
         LI,D2    -X'81'            MASK FOR COMPARE SELECTIVE
SET:SN2  EQU      %
         CS,D1    *SEL:BUF,R7       IS THIS THE CURRENT SN?
         BNE      SET:SN3           NO, GET OUT AND READ TAPE
         STS,R9   *SEL:BUF,R6       SET TAPE FOUND BIT IN SELBUF
         AI,R6    4                  AND BUMP TO NEXT ENTRY
         AI,R7    4
         CW,R7    R5                OUT OF ENTRIES YET?
         BL       SET:SN2           NO, MORE THINGS TO LOOK AT
SET:SN3  EQU      %
         LD,R6    LBLACCT
         STD,R6   CUR:ACCT
         LCI      2
         STM,R6   LASTACCT
         CI,R6    0
         BNEZ     CUL               NOT A BEGINNING DAT FILE
         CAL1,1   READDAT
*                 ERR,ABN=ENDFILE1;SIZE=24;BUF=BLABL
         PAGE
         LB,R6    BLABL+5,R3        GET WHO WROTE IT
*                                   0 => FSAVE
*                                   1 => SAVEALL
*                                   2 => INCREMENTAL
*                                   3 => SQUIRREL
*                                   4 => PURGE
*
*        BUILD APPROPRIATE MESSAGE IN FPAR
*
         CI,R6    4
         BG       ENDFILE1          GARBAGE IN DAT FILE
         LD,R8    TAPETYPE,R6
         MBS,R8   0
         LI,R8    BA(FILLER)
         LI,R7    17
         STB,R7   R9                FILLER SIZE FOR MBS
         MBS,R8   0
         LI,R8    BA(BLABL)         DATE PART OF MESSAGE
         LI,R7    16
         STB,R7   R9
         MBS,R8   0
         AI,R9    -BA(FPAR)-1
         STB,R9   FPAR              TOTAL LENGTH OF MESSAGE
         LI,R5    FPAR
         CAL1,2   TYPE              TELL OPERATOR
         CI,R6    2                 IS THIS AN INCREMENTAL TAPE?
         BNE      ENDFILE1          NO, DON'T BOTHER OPERATOR
         BAL,R5   INCDELET
         B        ENDFILE1          PROCEED WITH THE REST
         PAGE
*
*
OPN:NXT  EQU      %                 PREPARE TO OPEN NEXT TAPE FILE
         BAL,SR4  PURGE
         LI,R6    X'FF'
         STB,R6   BLABL             PUT SIZE OF BUFFER IN 1ST BYTE
         CAL1,1   OPENTAPE
*                 ERR,ABN=TPERR,TPABN;NXTF;INOUT
**
** CONVERT USER LABEL TO OPEN FOR USER FILE
**
CUL      EQU      %
         LD,R4    LBLDATE
         MTW,0    TIME
         BEZ      GO:ON             SKIP COMPARE THE FIRST TIME
         CD,R4    TIME
         BL       BADTIME
GO:ON    STD,R4   TIME
         LB,R4    LBLORG
         CI,R4    X'F0'
         BL       USERLAB
*
*
*
         CI,R4    X'FF'             FF => FILELIST ON INCREMENTAL
         BL       ENDEND            F0 => LASTFILE ON ANYTHING
         LB,R4    LBLORG,R1         CHECK TAPE TYPE TO BE SURE
         CI,R4    2                 IF NOT AN INCREMENTAL, GET OUT
         BNE      ENDEND
         LW,R5    START:ACCT        CHK IF STILL SKIPPING
         BNEZ     SKIPPING          IGNORE INDEX IN SKIP AREA
         LW,D1    SELECT
         BEZ      DO:FILDIR         NON-SELECTIVE FILL-PROCESS LIST
         LD,R6    LBLACCT
         STD,R6   CUR:ACCT
*                 IN THE SELECTIVE MODE AND A FILE LIST HAS BEEN
*                   DETECTED.  IF THE ACCOUNT IS ONE THAT HAS BEEN
*                   SEARCHED FOR, THE ENTRY MUST BE ZAPPED.
ZAPENTRY EQU      %
         LI,R7    2
         SLS,R7   2                 PUT BACK SOON....
         LI,R9    1                 SET UP R9 AS ACCOUNT PASSED FLAG
         SLS,R9   28
ZAP1     EQU      %
         SLS,R7   -2                SEE, I SAID I WOULD
         LD,R4    COMPACCT          SET UP TO COMPARE ACCOUNTS
         LCI      4
         LM,D1    *SEL:BUF,R7
         CI,D3    0
         BGZ      ZAP3              > 0 => NOT THIS TAPE
         CBS,R4   0                 IS THIS ACCOUNT ONE WE WANT?
         BGE      ZAP2              ENTRY ACCOUNT > CUR:ACCT/LBLACCT
*                                   ENTRY ACCOUNT = CUR:ACCT/LBLACCT
*
*        ENTRY ACCOUNT HAS BEEN PASSED ON THE TAPE
*
         STS,R9   D3                SET ACCOUNT FOUND BIT
         LCI      4
         STM,D1   *SEL:BUF,R7       PUT BACK INTO SEL:BUF
ZAP2     EQU      %
         AI,R7    4
         SLS,R7   2
         CW,R7    *SEL:BUF          STILL GOT ACTIVE ENTRIES?
         BL       ZAP1              THERE ARE MORE FILES TO PROCESS
*
ZAP3     EQU      %
         LW,R6    *SEL:BUF
         SLS,R6   -2                SET UP R6 AS TOTAL WORD COUNT
         LI,R7    2                 BACK TO BEGINNING OF SEL:BUF
ZAP4     EQU      %
         LCI      4
         LM,D1    *SEL:BUF,R7
         CI,D3    0
         BGEZ     NEXTAPE           MORE TAPES TO PROCESS
         LC       D3                HAS THIS ACCOUNT BEEN FOUND OR PASSED?
         BCR,5    MORFILES          NO, MIGHT STILL BE ON TAPE
         AI,R7    4
         CW,R7    R6                ARE WE STILL IN BUFFER
         BL       ZAP4              YES, CHECK NEXT ENTRY
*
*        NOW WE ARE ALL DONE WITH ALL REQUESTS
*        EXIT WILL BE TO SEL:MT FROM END:SEL:TAP
         B        NEXTAPE
*
MORFILES EQU      %
         LB,R5    LBLORG            CHECK FOR FILELIST
         CI,R5    X'FF'
         BE       SKIPPING          SKIP THE FILELIST IF INCREMENTAL
         LD,R6    LBLACCT           UPDATE THE CURRENT ACCOUNT
         STD,R6   CUR:ACCT           AS IT HAS JUST CHANGED.
         B        USERLAB1          PROCESS THE CURRENTLY OPEN FILE.
NEXTAPE  EQU      %
         LI,SR4   END:SEL:TAP
REM:TAPE EQU      %
         LW,SR3   L(X'200000')
         CW,SR3   FL:TAPE
         BANZ     REM:TAPE1         DCB OPEN
         CAL1,1   OPNDEVTP          OPEN THE TAPE AS DEVICE
*                                   TO PREVENT REWIND FIRST
REM:TAPE1 EQU     %
         CAL1,1   CLSTPREM
*                 FL:TAPE;REMOVE
         B        *SR4
         PAGE
*                    PROCESS ACCT FILE LIST
DO:FILDIR EQU     %
         BAL,R5   INCDELET          CHECK FOR SKIPPING OF FILELISTS
         MTW,0    DELEFLAG
         BLZ      SKIPPING          FILELISTS ARE TO BE IGNORED
         CAL1,1   TFFDNA            FIND NEXT ACCT
         LD,R4    CBS:ACT2
         CBS,R4   0                 LBLACCT : ZAPACCT
         BE       SPPAGREL          DONE
         LD,R4    CBS:ACT1
         CBS,R4   0                 LBLACCT : FUSRACCT
         BG       SPLSTEND1         DO NULL ACCT
         BL       SPPAGREL          DONE
         LB,R4    LBLORG,R3         0 => NORMAL, 1 => BYPASS
         BNEZ     SPLSTEND2         TRUNCATED LIST-ACCEPT ALL FILES
         STW,R0   ZAPFLAG           ENABLE FURTHER ACCT ZAPS
         LB,R5    LBLORG,R2         SIZE IN PAGES OF FILE LIST
         BAL,SR4  GETBUF            GET THAT BIG A BUFFER
         CB,R7    LBLORG,R2         DID WE GET ENOUGH
         BL       SPPAGREL          NO.
         CAL1,1   READSPEC
*                 ERR,ABN=TPERR,TPABN;BUF=*BUF;SIZE=*BUFSZ
         LW,R6    BUF
         SLS,R6   2                 BYTE ADDRESS
         LW,R4    FL:TAPE+13        RWS
         AW,R4    R6
         STW,R4   SPBYCT            R4 <= BA(END OF BUFFER)
         BE       SPPAGREL
* REGISTER 6 CONTAINS BYTE ADDRESS OF SPECIAL LIST THROUGHOUT
SPNXNM   EQU      %
         STB,R0   FPT:SPEC+1,R2     NOT NXTF FOR COMP:AGE
         STW,R6   SR4               SAVE START ADDRESS OF TABLE
SPDONE   EQU      %
         LW,R6    SR4
         CAL1,1   TF:SPEC           FIND FILE IN ACCT SPECIFIED
SPCONT   EQU      %
         LI,R7    BA(F:USR+X'17')   FILE NAME
         LB,R4    0,R6              BYTE COUNT IN FIRST BYTE
         LB,R5    0,R7
         AI,R7    1
         CW,R5    R4
         BG       %+3
         STB,R5   R7                COMPARE SHORTER FIELD
         B        %+2
         STB,R4   R7
         CBS,6    1
         BE       SPCLSAV           IF EQUAL, SAVE THIS FILE
         BG       SPCLREL           DELETE THIS FILE
SPLSNX   EQU      %
         LW,R6    SR4
         LB,R5    0,R6              COUNT OF THIS NAME
         AW,6     R5                ADD TO TOTAL COUNT TO GET NEXT NAME
         AI,6     1                 PLUS 1 FOR COUNT BYTE
         STW,R6   SR4
         CW,6     SPBYCT            ARE WE THROUGH WITH SPECIAL LIST
         BGE      SPLSTEND          IF LIST AT END, RELEASE REMAINING
         B        SPCONT
SPCLREL  BAL,SR1  COMP:AGE
         B        SPDONE
SPCLSAV  CW,R4    R5                WERE THEY REALLY EQUAL?
         BG       SPCLREL           RELEASE-LIST IS GT FILE NAME
         BL       SPLSNX            GET NEXT LIST ENTRY
         AI,R6    1
         CW,6     SPBYCT
         BL       SPNXNM            GET NEXT FILE
         B        SPLSTEND1
SPLSTEND EQU      %
         BAL,SR1  COMP:AGE          RELEASE ALL REMAIN OLD FILES
         LB,SR1   FUSR:DESC+1,R3
         CI,SR1   2                 EOF
         BAZ      SPLSTEND1
SPLSTEND2 EQU     %
         LW,SR1   FUSRACCT          YES-MOVE ACCT NBR
         STW,SR1  ZAPACCT
         LW,SR1   FUSRACCT+1
         STW,SR1  ZAPACCT+1
         B        DO:FILDIR
SPLSTEND1 EQU     %
         MTW,0    ZAPFLAG
         BNEZ     SPLSTEND2         SKIP ACCT IF FLAG SET
         LI,SR2   X'400'            NXTF
         STS,SR2  FPT:SPEC+1
         B        SPLSTEND
         TITLE    '**MAIN PROGRAM-DATA FILE**'
USERLAB  EQU      %
         MTW,0    SELECT
         BEZ      USERLAB1
*
*        IF THE ACCOUNT HAS CHANGED ON THE TAPE FILE AND THIS IS A
*        FSAVE OR SAVEALL TAPE, WE WILL BE ABLE TO END A RESTORE OF
*        A FULL ACCOUNT WITHOUT MOUNTING THE REST OF THE REELS.
*
         LD,R6    LBLACCT
         MTW,0    CUR:ACCT          WILL BE ZERO IF FIRST ACCOUNT
         BNEZ     %+2
         STD,R6   CUR:ACCT          FAKE OUT THE COMPARE
         CD,R6    CUR:ACCT
         BE       USERLAB1          STILL IN THE SAME ACCOUNT
         LB,R5    LBLORG,R1         GET TYPE OF TAPE
         CI,R3    4                 4 => PURGE OLDER
         BLE      ZAPENTRY          FILES ARE IN ORDER ON TAPE
*                                   UNORDERED FILES => X'13' OR X'14'
USERLAB1 EQU      %
         CB,R2    LBLORG,R1         CHECK IF THIS IS AN INCREMENTAL
         BNE      %+2
         BAL,R5   INCDELET
         STW,R0   SYNFLAG           CLEAR SYNON FLAG
         LI,R6    TVLPTSZ
         LI,D3    USER:VPT
USERLAB2 EQU      %
         LB,D1    TVLPTBL,R6
         BAL,R5   LOCCODE
         BAL,R7   DUMMY
         BAL,R5   MOVEVLP
         BDR,R6   USERLAB2
         LI,R6    VLPTSIZ
         LI,D1    X'0B'             SYNON FILE VLP
         LI,D4    LBLVLPS
         BAL,R5   LOCCODE1
         B        MOVELOOP          NOT SYNONOMOUS
         LB,R4    *D4,R2            DON'T BE FOOLED BY 0 LENGTH VLPS
         BEZ      MOVELOOP           NOT A REAL ONE, SKIP IT.
         STW,R1   SYNFLAG
         BAL,R5   MOVEVLP           PUT NAME INTO PLIST
MOVELOOP LI,D4    LBLVLPS           DUMMY CLOBBERS D4
         LB,D1    VLPTBL,R6
         BAL,R5   LOCCODE1
         BAL,R7   DUMMY
         BAL,R5   MOVEVLP
         BDR,R6   MOVELOOP
         LW,R5    L(X'02010202')
         LD,R6    LBLACCT
         LCI      3
         STM,R5   *D3
         LI,D3    USER:VPT+1        FILE NAME VLP IS FIRST
         LB,R6    *D3
         LB,SR2   *D3,6
         STB,SR2  NOMSG+8,R6
         BDR,R6   %-2
         LB,R6    *D3
         AI,R6    32
         STB,R6   NOMSG
         LI,D1    9                 FIND KEYMAX FROM '09' VLP
         BAL,R5   LOCCODE
         NOP                        MUST BE THERE
         LW,R4    *D4,R1
         LB,R4    R4,R1             KEYMAX FIELD
         STW,R4   KEYMAX
         LB,R4    LBLORG
         STW,R4   USER:ORG
         LI,R5    0
         CI,R4    3                 IS IT RANDOM?
         BNE      %+2               NO
         LW,R5    LBLRSTOR
         STW,R5   URSTORE
         LI,D1    9                 FILE INFORMATION VLP
         LI,D4    LBLVLPS            FOR THE DISK FILE
         BAL,R5   LOCCODE1
         B        MOVEON            PROBABLY PRE E00 TAPE..GO ON
         LI,R4    3
         LI,R5    3
         AND,R4   *D4,R1            PICK UP NOSEP, CYLIN
         SLD,R4   -21
         STS,R4   USER:FIL           AND STUFF IN OPEN FPT
         CB,R2    LBLORG            IS FILE KEYED?
         BNE      MOVEON            NO, IGNORE SLIDES AND SPARE
         LW,R4    *D4,R2
         SLS,R4   -8                STRIP OUT POSSIBLE TRASH
         SLD,R4   16                PUTS SLIDES IN R4
         SLS,R5   24                 AND SPARE INTO R5
         STW,R4   SLIDES
         STW,R5   SPARE             PUT INTO OPEN FPT
MOVEON   EQU      %
         LW,R7    SELECT
         BEZ      OKACCT1           0=NON-SELECTIVE
*                 SEARCH SELFIL TABLE FOR ACCT/FID MATCH
         LI,R7    2
         LW,R6    *SEL:BUF
         SLS,R6   -2
         STW,R0   SELFID:PTR
         LI,R9    1                 SET UP ACCOUNT FOUND FLAG
         SLS,R9   30
         LW,R4    D3                SAVE FILE NAME POINTER IN R4
CHK:ACCT EQU      %
         LCI      4
         LM,D1    *SEL:BUF,R7       PICK UP ENTRY FROM SEL:BUF
         CI,D3    0                 IF < 0, THIS TAPE IS MOUNTED
         BGEZ     SKIPPING
         CD,D1    LBLACCT           IS THIS AN ACCOUNT WE'RE SEEKING
         BNE      CHK:NXAC
*                 RIGHT ACCT--CHK FID
         STS,R9   D3                ACCOUNT HAS BEEN FOUND
         LCI      4
         STM,D1   *SEL:BUF,R7       SET IT BACK INTO THE TABLE
         LH,R5    D3,R1             GET FID POINTER, IF ANY
         BEZ      NOSKIP            0 => ACCOUNT REQUEST
         LB,SR1   *SEL:BUF,R5       FID LENGTH
         AI,SR1   1
         LW,SR4   SEL:BUF
         SLS,SR4  2
         AW,SR4   R5
         STB,SR1  SR4
         LW,SR3   R4
         SLS,SR3  2
         CBS,SR3  0
         BNE      CHK:NXAC
*                 ENTRY FOUND FOR THIS FILE
         STW,R7   SELFID:PTR
         SLS,R9   -1                SPECIFIC FILE FOUND FLAG
         STS,R9   D3                SET FILE FOUND BIT
         LCI      4
         STM,D1   *SEL:BUF,R7        AND PUT BACK INTO BUFFER
         B        NOSKIP
*                 STILL SEARCHING
CHK:NXAC EQU      %
         AI,R7    4
         CW,R7    R6
         BL       CHK:ACCT
*                 DOESNT MATCH ANYTHING--SKIP IT
         B        SKIPPING
OKACCT1  EQU      %
         LD,R6    START:ACCT
         BEZ      NOSKIP
         CD,R6    LBLACCT
         BL       NOSKIP            LBLACCT > START:ACCT
         BG       SKIPPING          START:ACCT > LBLACCT
*                 ACCT MATCHES--CHK FID
         LB,R6    FID:ACCT
         BEZ      NOSKIP            OK--NO FID TEST
         LI,D4    BA(FID:ACCT)+1
         STB,R6   D4
         SLS,D3   2
         CBS,D3   1
         BL       SKIPPING          NOT YET THERE
NOSKIP   EQU      %
         MTW,0    SELECT
         BEZ      JITLP1
         LI,D1    4                 GET EXPIRATION
         LI,D4    LBLVLPS            DATE OF
         BAL,R5   LOCCODE1            INCOMING FILE
         NOP
         AI,D4    1
         LW,SR4   L(C'NEVE')
         CW,SR4   *D4               IS EXPIRATION NEVER?
         BE       JITLP1
         LW,SR4   *DATEAD+1
         LH,SR3   *TIMEAD
         STH,SR3  SR4
         LW,SR3   *DATEAD
         LI,D2    SR3
         BAL,R5   COMPDAT           EXIT SKIPPING IF EXPIRED
         B        JITLP1            FILE HAS NOT EXPIRED
         PAGE
*
*        GIVE EXPIRED FILES A NEW LEASE ON LIFE
*
         LI,D1    14*24             ADD 14 DAYS TO CURRENT DATE
         SAD,D1   -32
         LI,SR1   24
         DW,D1    SR1
*
*        SR3 => M M D D
*        SR4 => H H Y Y
*        D1  => BINARY HOURS
*        D2  => BINARY DAYS
*
         LI,R4    3
*
*        CONVERT DECIMAL EBCDIC TO BINARY IN EACH OF FOUR FIELDS
*
NEWEXP   LH,SR1   SR3,R4
         AND,SR1  L(X'F0F0FFFF')
         BAL,R5   DECTOBIN
         STH,SR2  SR3,R4            SR2 CONTAINS BINARY EQUIVALENT
         AI,R4    -1
         BGEZ     NEWEXP
*
         AH,D1    SR4               ADD HOURS AND ADJUST DAYS
NEWEXP1  STH,D1   SR4
         CI,D1    24
         BL       NEWEXP2
         AI,D1    -24
         AI,SR3   1                 BUMP DAY COUNT
         B        NEWEXP1
*
NEWEXP2  AW,D2    SR3               ADD DAYS AND ADJUST MONTHS
         LH,R7    D2                R7 <= MONTH
         LI,SR1   X'FFFF'
         AND,D2   SR1
NEWEXP3  CI,R7    12
         BLE      NEWEXP4
         AI,R7    -12
         AI,SR4   1                 BUMP THE YEAR
         B        NEWEXP3
*
NEWEXP4  LB,SR1   DAYMONTH,R7       GET NUMBER OF DAYS FOR THIS MONTH
         CW,D2    SR1
         BLE      NEWEXP6           MONTH NOT AFFECTED
         CI,R7    2                 IS IT FEBRUARY?
         BL       NEWEXP6           NO
         CI,SR4   3                 IS IT A LEAP YEAR?
         BANZ     NEWEXP6           (THIS WONT WORK FOR 2100 A.D.)
         CI,R7    2
         BNE      %+3
         CI,D2    29
         BE       NEWEXP6           29 IS OK FOR FEBRUARY
         AI,D2    -1
*
NEWEXP5  SW,D2    SR1               SUBTRACT CURRENT MONTH'S
         AI,R7    1                  DAYS AND BUMP MONTH.
         B        NEWEXP3
*
NEWEXP6  STH,R7   D2
         STW,D2   SR3
         LI,R4    3
         LI,D1    10
         LI,D2    X'F0F0'
*
*        CONVERT BACK TO DECIMAL EBCDIC
*
NEWEXP7  LH,SR1   SR3,R4
         SAD,SR1  -32
         DW,SR1   D1                DIVIDE BY 10
         SLS,SR1  24
         SCD,SR1  8
         OR,SR2   D2                MAKE EBCDIC
         STH,SR2  SR3,R4             AND PUT BACK
         AI,R4    -1
         BGEZ     NEWEXP7
*
         LI,D1    4                 EXPIRATION DATE VLP
         LI,D4    USER:VPT          ADDRESS OF FPT VLP'S
         BAL,R5   LOCCODE1
         B        JITLP1            SHOULD NOT OCCUR
         AI,D4    1                 POINT TO ENTRY ITSELF
         LCI      2
         STM,SR3  *D4               PUT NEW DATE IN VLPS
*
JITLP1   EQU      %
         LD,R6    LBLACCT
         STD,R6   MAIL:AC
         MTW,0    SYNFLAG           IS INCOMING FILE SYNONOMOUS?
         BEZ      NOTSYNON          NO
         BAL,R5   OPNINOUT          YES, OPEN FILE INOUT
         B        ENDFILE            AND CLOSE WITHOUT DATA TRANSFER
*
NOTSYNON EQU      %
         STW,R2   USER:MOD          SET UP TO OPEN OUTPUT
         STW,R0   USER:FPAR         CLEAR FPARAM BUFFER
*
*        IF THE FILE OF THIS NAME CURRENTLY EXISTS, FPARAM DATA WILL
*        BE RETURNED TO THE USER:FPAR BUFFER; IN THIS CASE, THE DATES
*        WILL BE COMPARED AND IF THE TAPE FILE IS NEWER THAN THE DISC
*        FILE, IT WILL BECOME THE DISC FILE AFTER COPY; IF THE TAPE FILE
*        IS NOT NEWER, THE CURRENTLY OPEN OUTPUT FILE OF THIS NAME WILL
*        BE CLOSED WITH RELEASE, LEAVING THE DISC FILE AS IT WAS.
*
         CAL1,1   USER:FIL
         MTW,0    USER:FPAR
         BEZ      CHKMAIL           TAPE FILE DOES NOT EXIST ON DISC
*
*        COMPARE TAPE MODIFICATION DATE WITH THAT OF FILE'S
*
         LI,D1    X'A'
         LI,D4    LBLVLPS           GET BACKUP DATE FROM
         BAL,R5   LOCCODE1           TAPE'S USER LABEL
         NOP
         LW,D2    D4
         LI,D4    USER:FPAR         DISK COPY
         BAL,R5   LOCCODE1
         NOP
         AI,D2    1
         AI,D4    1
         BAL,R5   COMPDAT
         B        NOCOPY            DISC FILE IS NEWER THAN TAPE FILE
CHKMAIL  EQU      %
         LCI      2
         LM,R6    NOMSG+8           IS THIS A MAILBOX FILE COMING IN?
         CD,R6    MLBXNM
         BNE      BLDFILE           NO, CREATE THE FILE
         MTW,0    SELECT            ONLY BRING IN MAILBOXES ON SELECTIVE
         BEZ      NOCOPY1
         CAL1,1   CLSUSREL          RELEASE CURRENTLY OPEN OUTPUT FILE
         LI,R5    BLDFILE           SET UP RETURN FROM OPNINOUT
OPNINOUT EQU      %
         LI,R6    4
         STW,R6   USER:MOD          SET MODE TO INOUT
         CAL1,1   USER:FIL           AND OPEN
         B        0,R5              RETURN TO CALLER
BLDFILE  EQU      %
         LW,R5    DEFAULT           ACQUIRE A DATA BUFFER
         BAL,SR4  GETBUF
         B        COPYFILE
         PAGE
NOCOPY   EQU      %
         LI,R6    1
         BAL,SR4  PRINTLIN          FORM BASIC MESSAGE
         LD,R4    SKIPMBS           ADD SKIPPED MESSAGE
         MBS,R4   0
         LI,R6    91
         STB,R6   PBUFFER
         CAL1,2   PRINT             AND PRINT
         CB,R3    LBLORG            CHECK FOR RANDOM FILE
         BNE      NOCOPY1           NOT RANDOM, NO PROBLEM
         CAL1,1   CLSUSRSV          CLOSE WITH SAVE TO NOT CLOBBER
         B        ENDFILE1           AN EXISTING RANDOM FILE
NOCOPY1  EQU      %
         CAL1,1   CLSUSREL          CLOSE THE OPEN OUTPUT FILE
         B        ENDFILE1           AND PROCEED WITH NEXT FILE
         SPACE    3
COPYFILE EQU      %
*
         CAL1,1   TAPEREAD          M:MOVE CAL
*
*        RETURN FROM MOVE CAL IS TO
*          MOERR OR MOABN
*
         PAGE
*                 SBR TO RELEASE FILE IF ITS MOD DATE IS OLDER
*                   THAN THE DATE ON THE TAPE
COMP:AGE EQU      %
         STW,SR1  SR1X
         CAL1,1   FPT:SPEC          TESTFILE W/FPARAM
         LCI      4
         STM,R4   R47
         PSW,SR4  ENVIR             SAVE R11 AS WELL...
         LB,D1    FUSR:DESC+1
         BNEZ     FIL:SAVE          IN USE
         LB,D1    FUSR:DESC+1,R2
         CI,D1    2                 NO PURGE BIT=PO TAPE FILE
         BANZ     FIL:SAVE
         LI,D1    X'A'
         LI,D4    USER:FPAR
         BAL,R5   LOCCODE1          FIND DISK MOD DATE
         NOP
         AI,D4    1
         LI,D2    BLABL+5
         LH,R7    *D4,R2
         BAL,R5   COMPDAT
         BL       FIL:SAVE          DISC LATER--SAVE
         BG       FIL:REL           TAPE LATER--RELEASE
         CI,R7    X'FF2F4'          CHK FROM PO
         BE       FIL:SAVE
FIL:REL  EQU      %
         MTW,0    DEBUG
         BNEZ     %+3
         CAL1,1   OPNUSREL
*                 F:USR;ERR,ABN=BSR1
         CAL1,1   CLSUSREL
*                 F:USR;RELEASE
         LI,R6    2                 BASIC DELETED MESSAGE
         BAL,SR4  PRINTLIN
         LD,R4    DELEMBS
         MBS,R4   0
         LI,R6    91
         STB,R6   PBUFFER
         CAL1,2   PRINT             OUTPUT THE MESSAGE
FIL:SAVE EQU      %
         LCI      4
         LM,R4    R47
         PLW,SR4  ENVIR             RESTORE R11 TO ORIGINAL VALUE
         B        *SR1X
         PAGE
*
*F*      NAME:    COMPDAT
*F*
*F*      PURPOSE: COMPARE TWO EBCDIC DATES OF THE FORM MMDDHHYY (DOUBLE-
*F*               WORD) AND DETERMINE WHICH IS LATER, IE MORE RECENT.
*F*      DESCRIPTION:  THE DATES ARE LOADED INTO REGISTERS D1 - D4
*F*               AND COMPARED.  EXIT DEPENDS ON WHICH IS MORE RECENT.
*F*
*D*      NAME:    COMPDAT
*D*
*D*      REGISTERS:  R5 - LINK PRESERVED
*D*                  D1,D2,D3,D4 CLOBBERED
*D*      CALL:    LI,D2    DATE1    DATE1 IS ADDRESS OF ONE DATE
*D*               LI,D4    DATE2    DATE2 IS ADDRESS OF OTHER DATE
*D*               BAL,R5   COMPDAT
*D*      OUTPUT:  EXITS SKIPPING (IE TO CALL+2) IF DATE1 MORE RECENT
*D*               EXITS TO CALL+1 IF DATE2 MORE RECENT OR EQUAL
*D*      DESCRIPTION:  THE DATES ARE LOADED INTO REGISTERS D1 - D4
*D*               AND COMPARED.  EXIT DEPENDS ON WHICH IS MORE RECENT.
*D*
COMPDAT  EQU      %
         LCI      2
         LM,D1    *D2
         LM,D3    *D4
         SCD,D1   -16
         SCD,D3   -16
         CD,D1    D3
         BG       1,R5
         B        0,R5
         PAGE
*
*        BAL,R5   DECTOBIN
*        INPUT    SR1 = EBCDIC DECIMAL NUMBER
*        OUTPUT   SR2 = BINARY EQUIVALENT
*        CLOBBERS R6,R7
*
DECTOBIN LI,SR2   0
         LI,R6    X'F'
DECLOOP  LB,R7    SR1
         BEZ      0,R5
         MI,SR2   10
         AND,R7   R6
         AW,SR2   R7
         SLS,SR1  8
         B        DECLOOP
         PAGE
*          THE FOLLOWING ROUTINES PROCESS THE SELECTIVE FILL CHARACTER
*                 STRINGS COMPRISING THE COMMANDS TO SELECTIVE FILL
*          LINKAGE TO PRIMARY ROUTINES IS VIA SR4 AND TO SECONDARY
*                 ROUTINES VIA SR3.  ALL ERROR EXITS ARE *ERR:RET
*          INPUTS ARE IN THE 80 BYTE BLOCK PRECEEDING SEL:COM, CHARACTERS
*                 ARE REFERENCED VIA A NEGATIVE VALUE IN R4.
*                 R7, AND D1-D4, MAY BE USED AS WORK REGS.
*                 SR2 IS USED TO POINT TO ADDITIONAL PARAMETERS,AS NEEDED
*          OUTPUT IS PLACED IN THE TEMPORARY ENTRIES AT
*                 TACT0, TACT1, TFID, TSN
*
*
*
*F*      NAME:    SK:BL
*F*
*F*      PURPOSE: FIND THE NEXT NON-BLANK, NON-TAB CHARACTER IN THE
*F*               SEL:COM:BUF BUFFER.
*F*      DESCRIPTION:  THE BUFFER IS SEARCHED FROM A GIVEN STARTING POINT
*F*               FROM LEFT TO RIGHT AND EXITS NORMALLY AT THE FIRST NON-
*F*               BLANK, NON-TAB CHARACTER; OTHERWISE, RETURN IS INDIRECT
*F*               THROUGH ERR:RET.
*F*
SK:BL    EQU      %   ****          SKIP BLANKS
*                 FINDS THE NEXT NON-BLANK, NON-TAB, CHARACTER IN
*                 THE INPUT STREAM.  TAKES ERROR EXIT IF COL 80 OR
*                 OTHER CONTROL CHARACTER IS FOUND.
         LB,D1    SEL:COM,R4
         CI,D1    ' '
         BG       *SR3              FOUND NON-BLANK, EXIT
         BL       SK:BL:TT          CHK FOR TAB
SK:BL:T80 EQU     %
         BIR,R4   SK:BL
         B        *ERR:RET          PAST COL 80
SK:BL:TT EQU      %
         CI,D1    X'05'             CODE FOR TAB CHAR
         BE       SK:BL:T80
         B        *ERR:RET          ILLEGAL CONTROL CHAR
         PAGE
*
*F*      NAME:    FIND:STRG
*F*
*F*      PURPOSE: COMPARE A GIVEN NUMBER OF CHARACTERS IN THE SEL:COM:BUF
*F*               BUFFER WITH A GIVEN TEXTC STRING AND DETERMINE WHETHER
*F*               EQUAL OR NOT.
*F*      DESCRIPTION:  THE COMPARISON IS MADE AND IF THE STRINGS ARE
*F*               EQUAL, THE ROUTINE EXITS NORMALLY; OTHERWISE, RETURN IS
*F*               INDIRECT THROUGH ERR:RET.
*F*
FIND:STRG EQU     %   ****          FIND STRING
*                 CHECKS THE NEXT N CHARACTERS FOR MATCH WITH INPUT
*                 STRING.  INPUT IS TEXTC FORMAT AT *SR2.  IF STRING
*                 MATCHES FOR LENGTH IN TEXTC, NORMAL RETURN, OTHERWISE
*                 RETURNS *ERR:RET.  SR2 IS UPDATED TO FIRST WORD AFTER
*                 THE TEXTC.
         LI,D2    BA(SEL:COM)
         AW,D2    R4
         LB,D1    *SR2
         STB,D1   D2
         LW,D1    SR2
         SLS,D1   2
         CBS,D1   1
         BNE      *ERR:RET          STRING IN ERROR
*
         AI,D1    4                 STEP TO SOMEWHERE IN NXT WORD
         SLS,D1   -2
         LW,SR2   D1                SET SR2 TO NEXT WORD
         AI,D2    -BA(SEL:COM)
         LW,R4    D2                RESTORE R4 TO NEXT CHAR
         B        *SR3
         SPACE    5
FIND:FILL EQU     %   ****          FIND FILL
*                 POSITIONS INPUT TO THE BEGINNING OF FID, OR '.'
*                 PRECEEDING ACCT IF NO FID, VERIFYING THE FIELDS
*                 'FILL', '=', AND '('.  IGNORES BLANKS IMBEDDED
*                 BETWEEN FIELDS.
*                 ERROR RETURN IS *ERR:RET
         LI,R4    -80
         BAL,SR3  SK:BL             FIND START OF FILL
         LI,SR2   FILL:TEXTC
         BAL,SR3  FIND:STRG
*                 NOW FIND =
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG
*                 THEN FIND (
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG
*                 THEN SKIP ANY BLANKS UP TO FID OR '.'
         BAL,SR3  SK:BL
         B        *SR4
         SPACE    5
DO:FID   EQU      %   ****          SET TFID
*                 IF THE NEXT STRING DOES NOT START WITH A '.', THE
*                 STRING OF UP TO 31 CHARACTERS IS SET INTO TFID IN
*                 TEXTC FORMAT.  IF MORE THAN 31 CHARACTERS, COL80
*                 IS ENCOUNTERED, OR NOT TERMINATED BY A PERIOD, THE
*                 ERROR EXIT IS TAKEN.  IF THE FIRST CHARACTER IS A
*                 '.', TFID IS SET TO 0, AND THE NORMAL RETURN IS MADE.
         STW,R0   TFID
DO:FID:NXT EQU    %
         LB,D1    SEL:COM,R4
         CI,D1    '.'
         BE       DO:FID:XIT
         CI,D1    ' '               CHECK FOR BLANK OR CTL CHAR
         BE       DO:FID:BL         BLANK AND TAB OK TERMINATORS
         BG       DO:FID:SAV
         CI,D1    X'05'             TAB
         BNE      *ERR:RET          NEITHER  IS ERROR
DO:FID:BL EQU     %
         BAL,SR3  SK:BL
         LB,D1    SEL:COM,R4
         CI,D1    '.'               MUST BE A PERIOD
         BNE      *ERR:RET
         B        DO:FID:XIT
DO:FID:SAV EQU    %
         LB,R7    TFID
         AI,R7    1
         CI,R7    31
         BG       *ERR:RET          TOO MANY CHARS
         STB,D1   TFID,R7           SAVE CHAR
         STB,R7   TFID
         BIR,R4   DO:FID:NXT
DO:FID:XIT EQU    %
         BIR,R4   DO:FID:OUT
         B        *ERR:RET          PAST END OF LINE
DO:FID:OUT EQU    %
         BAL,SR3  SK:BL             FIND START OF ACCT
         B        *SR4
         SPACE    5
DO:ACCT  EQU      %   ****          FETCH ACCOUNT
*                 THE NEXT 1-8 CHARACTERS ARE MOVED TO TACT0,TACT1
*                 AS THE ACCOUNT NUMBER.  UPDATES R4 TO FOLLOWING THE
*                 LAST CHARACTER. USES R7 AND D1
*                 EXITS *ERR:RET IF COL 80 IS PASSED
         LI,R7    -8
DO:ACCT:LUP EQU   %
         LB,D1    SEL:COM,R4
         CI,D1    C')'
         BNE      %+3
         AI,R4    -1                BLANK FILL ACCT TO 8 CHARACTERS
         LI,D1    C' '
         STB,D1   TACT0+2,R7
         BIR,R4   %+2
         B        *ERR:RET          PASSED COL 80--ERROR
         BIR,R7   DO:ACCT:LUP
         B        *SR4
         SPACE    5
FIND:REEL EQU     %   ****          FIND REEL NUMBER
*                 MOVES THE REEL NUMBER (SN) INTO TSN, AND VERIFIES
*                 ALL THE OTHER CHARACTER STRINGS FOLLOWING THE ACCT
*                 NUMBER.  USES R7 AND D1.  IF ANY CHARACTER IN THE
*                 PRESCRIBED FORMAT IS INCORRECT OR COL 80 IS PASSED
*                 THE ERROR RETURN IS TAKEN (*ERR:RET).
         BAL,SR3  SK:BL
         LI,SR2   RTPAREN
         BAL,SR3  FIND:STRG         CHK ) AFTER ACCT
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG         CHK , BETWEEN FIELDS
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG         ( BEFORE REEL
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG         'REEL'
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG         =
         BAL,SR3  SK:BL
*                 NOW MOVE 4 CHAR SN
         LI,R7    -4
FIND:REEL:LUP EQU  %
         LB,D1    SEL:COM,R4
         STB,D1   TSN+1,R7
*                 CHECK LEGAL CHARACTERS--DDLD
         CB,D1    LOW,R7
         BL       *ERR:RET
         CB,D1    HI,R7
         BG       *ERR:RET
         BIR,R4   %+2
         B        *ERR:RET          ERROR--PAST COL 80
         BIR,R7   FIND:REEL:LUP
         BAL,SR3  SK:BL
         BAL,SR3  FIND:STRG         FINAL )
         B        *SR4
         PAGE
*
*        BAL,R5   INCDELET
*
*        CHECK TO SEE IF FILELISTS SHOULD BE HONORED WHEN FILLING AN
*        INCREMENTAL TAPE.  SUBROUTINE ASKS OPERATOR IF THIS IS THE
*        FIRST TIME ENTERED AND SETS THE DELEFLAG POSITIVE IF LISTS ARE
*        TO BE HONORED AND NEGATIVE IF NOT.  DELEFLAG = 0 => THIS IS THE
*        FIRST ENTRY AND THE OPERATOR SHOULD BE ASKED.
*
INCDELET EQU      %
         MTW,0    DELEFLAG
         BNEZ     0,R5              EXIT IF WE'VE BEEN HERE BEFORE
INCDEL1  EQU      %
         STW,R0   YES               CLEAR OUT THE RESPONSE BUFFER
         LI,R5    DELMSG
         LI,R6    YES
         LI,R7    1
         CAL1,2   KEYIN
         LB,R8    YES,R1
         CI,R8    'Y'
         BNE      %+3
INCDEL2  EQU      %
         MTW,1    DELEFLAG          HONOR THE FILELISTS AND DELETE FILES
         B        0,R5
         CI,R8    'N'
         BNE      %+3
         MTW,-1   DELEFLAG          IGNORE THE FILELISTS WHEN FOUND
         B        0,R5
         LH,R8    YES
         CI,R8    X'15'             REQUEST TIMED OUT...HONOR FILELISTS
         BNE      INCDEL1           GARBAGE INPUT...RETRY THE KEYIN
         B        INCDEL2
*
*F*      NAME:    USRABN
*F*
*F*      PURPOSE: HANDLE ABNORMAL RETURNS FROM CALS ISSUED THROUGH THE
*F*               F:USR DCB.
*F*      DESCRIPTION:  THE CONTENTS OF R10 DETERMINE THE ACTION TAKEN.
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*                   (MONITOR ERROR MESSAGES)
*F*
USRABN   EQU      %
         LB,R4    SR3               PICK UP ABNORMAL CODE
         LI,R6    #USRABNS
         CB,R4    USRABNS,R6
         BE       UABNVECT,R6
         BDR,R6   %-2
         BAL,D3   ERROR             (DOESN'T RETURN - GOES TO OPN:NXT)
*
UABNVECT PZE      UABNVECT
         B        USRABN01          (01 ABN - POSSIBLY NO RANDOM GRANS)
         B        USRABN14          (14 ABN - SOME FORM OF OPEN ERROR)
         B        *SR1              (0A ABN - CLOSE OF ALREADY CLOSED)
         BAL,D3   ERROR             (2E ABN - OPEN OF ALREADY OPEN)
#USRABNS EQU      %-UABNVECT-1
         RES      4                 FOR EXPANSION BY PATCH
*
USRABNS  EQU      %
         DATA,1   0
         DATA,1   X'01'
         DATA,1   X'14'
         DATA,1   X'0A'
         DATA,1   X'2E'
         PZE                        FOR EXPANSION BY PATCH
         PAGE
USRABN01 EQU      %
         LB,R4    SR3,R1
         SLS,R4   -1
         LI,D3    %+2
         CI,R4    X'0B'
         BNE      ERROR
         BAL,SR2  NO:RCV
         CAL1,1   CLSTAPSV
         B        OPN:NXT           GO ON TO NEXT FILE
         SPACE    3
USRABN14 EQU      %
         LB,R4    SR3,R1
         SLS,R4   -1
         LI,D3    %+2               SET UP FOR CALL TO ERROR
         CI,R4    1                 FILE BUSY?
         BNE      USRAB141
         BAL,SR2  NO:RCV            TELL THE USER
         CAL1,1   CLSTAPSV
         B        OPN:NXT
         SPACE    3
USRAB141 EQU      %
         CI,R4    0
         BNE      ERROR             DON'T REALLY UNDERSTAND THIS ONE
         MTW,0    USER:FPAR
         BEZ      ERROR             NOT THE RANDOM FILE CASE
         LI,D1    X'A'              MODIFICATION DATE VLP
         LI,D4    LBLVLPS            FOR TAPE FILE
         BAL,R5   LOCCODE1
         NOP                        MUST BE THERE
         LD,D2    D4
         LI,D4    USER:FPAR
         BAL,R5   LOCCODE1          GET MOD DATE FOR DISC VERSION
         NOP
         AI,D2    1
         AI,D4    1
         BAL,R5   COMPDAT           WHICH IS NEWER?
         B        NOCOPY            DISC COPY IS NEWER
*
*        RELEASE THE EXISTING FILE TO ALLOW RESTORE OF TAPE FILE
*
         LI,D1    X'09'
         LI,D4    USER:FPAR
         BAL,R5   LOCCODE1          PICK UP EXISTING FILE'S ORG
         NOP
         AI,D4    1
         CB,R3    *D1               IS IT RANDOM
         BNE      ERROR             MORE TROUBLE..SHOULDN'T HAPPEN
         STW,R3   USER:ORG          SET ORG FOR OPEN OF RANDOM FILE
         BAL,R5   OPNINOUT           AND OPEN IT INOUT SO CAN RELEASE
         CAL1,1   CLSUSREL
         LB,R4    LBLORG
         STW,R4   USER:ORG          PUT BACK ORIGINAL FILE ORGANIZATION
         B        NOTSYNON
ERROR    EQU      %
         LCI      0
         STM,R0   REGS              SAVE THE ORIGINAL REGISTERS
         BAL,SR2  NO:RCV            TELL THE USER THE PROBLEM
         LCI      0
         LM,R0    REGS
         BAL,R3   SNAPPER
         LH,R4    F:USR
         CI,R4    X'20'             IS IT OPEN?
         BAZ      %+2
         CAL1,1   CLSUSREL
         LH,R4    F:TI
         CI,R4    X'20'
         BAZ      OPN:NXT
         CAL1,1   CLSTAPSV
         B        OPN:NXT
         PAGE
*
*F*      NAME:    ERBCK
*F*
*F*      PURPOSE: HANDLE ERROR AND ABNORMAL RETURNS FROM CALS ISSUED
*F*               THROUGH THE F:BACK DCB.
*F*      DESCRIPTION:  CONTENTS OF R10 DETERMINE ACTION TAKEN.
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*                   (MONITOR ERROR MESSAGES)
*F*
ERBCK    EQU      %
         LB,R5    SR3
         CI,R5    X'03'             DOESNT EXIST
         BNE      *SR1
         CAL1,1   OPNBACKO
*                 ERR,ABN=GO:BACK1; OUT; SAVE
         B        GO:BACK1
         PAGE
*
*F*      NAME:    TPABN
*F*      ENTRY:   TPERR
*F*
*F*      PURPOSE: HANDLE ERROR AND ABNORMAL RETURNS FROM CALS ISSUED
*F*               THROUGH THE F:TI (FL:TAPE) DCB.
*F*      DESCRIPTION:  CONTENTS OF R10 DETERMINE ACTION TAKEN.
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*                   (MONITOR ERROR MESSAGES)
*F*
TPABN    EQU      %
TPERR    EQU      %
         LB,R4    SR3               PICK UP ABNORMAL/ERROR CODE
         LI,R6    #TPABNS
         CB,R4    TPABNS,R6
         BE       TABNVECT,R6
         BDR,R6   %-2
         BAL,D3   ERROR             (DOESN'T RETURN - GOES TO OPN:NXT)
*
TABNVECT PZE      TABNVECT
         B        ENDEND            (02 ABN - END OF FILES ON THIS SET)
         B        TPABN14           (14 ABN - SOME FORM OF OPEN ERROR)
         B        *SR1              (0A ABN - CLOSE OF ALREADY CLOSED)
         B        TPABN0B           (0B ABN - UNRECOGNIZED SENTINEL)
         B        ERR49             (49 ERR - NO TAPES AVAILABLE)
         B        ERR55             (55 ERR - TOO MANY FILES OPEN)
#TPABNS  EQU      %-TABNVECT-1
         RES      4                 FOR EXPANSION BY PATCH
*
TPABNS   EQU      %
         DATA,1   0
         DATA,1   X'02'
         DATA,1   X'14'
         DATA,1   X'0A'
         DATA,1   X'0B'
         DATA,1   X'49'
         DATA,1   X'55'
         PZE                        FOR EXPANSION BY PATCH
         SPACE    3
TPABN14  EQU      %
         LB,R4    SR3,R1            PICK UP THE SUB-CODE
         SLS,R4   -1
         CI,R4    3
         BE       TPABN141
         LI,D3    %+1               CALL ADDRESS FOR SNAPPER
         B        ERROR
TPABN141 EQU      %
         AI,SR1   -1
         MTW,0    INT               CHECK FOR OPERATOR INTERRUPT
         BEZ      *SR1              JUST TRY AGAIN....
         LCI      0
         STM,R0   SAVEREGS
         BAL,SR4  PURGE             SEE WHAT OPERATOR WANTS
         LCI      0
         LM,R0    SAVEREGS
         B        *SR1              TRY THE CAL AGAIN
         SPACE    3
TPABN0B  EQU      %
         BAL,SR2  NO:RCV
         CAL1,1   CLSUSREL
         LH,R4    F:TI
         CI,R4    X'20'              IS THE TAPE FILE OPEN?
         BAZ      OPN:NXT            NO
         PAGE
         CAL1,1   CLSTAPSV
         B        OPN:NXT
ENDEND   EQU      %
         LW,D1    SELECT
         BEZ      ENDEND1           NON-SELECTIVE
         LH,R7    F:TI              IS INPUT DCB OPEN?
         CI,R7    X'20'
         BANZ     %+2               YES, SKIP THE OPEN
         CAL1,1   OPNDEVTP
*                 FL:TAPE;ERR,ABN=BSR1;NXTF
         CAL1,1   CLSTPREM
*                 FL:TAPE; REMOVE
         STW,R0   NOTAPFG           CLEAR THE TAPE-MOUNTED FLAG
END:SEL:TAP EQU   %
         LW,R7    *SEL:BUF
         SLS,R7   -2
         LI,R6    2                 POINT TO FIRST ENTRY WORD
*                 FIND HOW MANY ENTRIES WERE FOR THE TAPE JUST
*                   COMPLETED AND DELETE THOSE ENTRIES
NXT:SEL:DEL EQU   %
         CW,R6    R7
         BGE      SEL:MT            NO MORE ENTRIES..ZAP TABLE
         LW,R1    PBUFINIT
         BAL,R5   BLANKS            BLANK FILL THE PBUFFER
         LD,R4    SELACCT           MOVE REQUESTED ACCOUNT TO PBUFFER
         MBS,R4   0
         LD,R4    FAILMBS           '*FAILED*  FILE NOT ON TAPE XXXX'
         MBS,R4   0
         LCI      4                 PICK UP THE SEL:FIL ENTRY
         LM,D1    *SEL:BUF,R6
         LI,R5    X'80'             PUT REEL NUMBER IN EBCDIC
         STS,R5   D4
         LC       D3                PICK UP THE FLAGS IN WORD 3
         BCR,8    SEL:HAS           8-BIT RESET => UNDONE ENTRY - PROCEED
         BCR,4    NOACCT            4-BIT RESET => ENTRY ACCOUNT NOT FOUND
*
*        SPECIFIED ACCOUNT WAS FOUNT ON TAPE
*
         BCS,2    END:SEL2          2-BIT SET => FILE WAS FOUND
         BCR,1    NOACCT            1-BIT RESET => ACCOUNT NOT PASSED
*
*        SPECIFIED ACCOUNT HAS BEEN PASSED ON THE TAPE
*
         LH,R8    D3,R1             PICK UP FILE POINTER, IF ANY
         BEZ      END:SEL2          0 => ACCOUNT; NO FOLLOW NECESSARY
*
*        SPECIFIED FILE WAS NOT FOUND ON THE TAPE
*
         LI,R5    BA(PBUFFER)+12    SET UP FOR FILE NAME TO PBUFFER
         LW,R4    SEL:BUF
         SLS,R4   2
         AW,R4    R8                POINTER TO FID IN SEL:BUF
         LB,R8    0,R4              BYTE COUNT OF FID
         STB,R8   R5                COUNT FOR MBS
         MBS,R4   1                 FILE NAME TO PBUFFER
         LD,R4    REELMBS
         MBS,R4   0                 REEL NUMBER TO FAILURE MESSAGE
         LI,R5    X'60'
         STB,R5   PBUFFER
         CAL1,2   PRINT
END:SEL2 EQU      %
         AI,R6    4
         B        NXT:SEL:DEL
NOACCT   EQU      %
         BCS,4    END:SEL2          GET NEXT ENTRY..ACCOUNT SPANS TAPES
*
*        SPECIFIED ACCOUNT NOT FOUND ON THE TAPE
*
         LD,R4    AFAILMBS          'ACCOUNT'
         MBS,R4   0
         LD,R4    AFAIL1            'NOT ON TAPE XXXX'
         MBS,R4   0
         LD,R4    REELMBS
         AI,R5    3                 POINT TO RIGHT PLACE FOR REEL #
         MBS,R4   0
         LI,R5    X'63'
         STB,R5   PBUFFER
         CAL1,2   PRINT
         B        END:SEL2          GET NEXT ENTRY
*
ABORFILL DATA     ABORFILL          THIS WILL TRAP WITH REGS INTACT
*
SEL:HAS  EQU      %
         LI,R5    2
SEL:HAS1 EQU      %
         LCI      4
         LM,D1    *SEL:BUF,R6       PULL UP ENTRIES OF DELETIONS
         STM,D1   *SEL:BUF,R5
         AI,R5    4
         AI,R6    4
         CW,R6    R7
         BL       SEL:HAS1
*                 FINISHED SLIDES, RESET POINTER
         SLS,R5   2                 WD IX TO BYTE IX
         STW,R5   *SEL:BUF
         CAL1,1   WRITBREC
*                 ERR,ABN=BSR1;ONEWKEY;BUF=SEL:BUF;KEY=SELKEY
         LI,R7    F:BREC
         CAL1,1   TRUNC
         B        SEL:OPN:SELF
ENDEND1  EQU      %
         LW,SR4   ZAPACCT
         BEZ      ENDEND2           NOT INCR TAPE W/FILDIR
         LB,R4    LBLORG,R3         IF NOT X'FF',
         CI,R4    X'FF'              INCREMENTAL DID NOT
         BNE      ENDEND2             COMPLETE NORMALLY.
         LI,SR4   -1                SET MAX ACCT NBR
         STW,SR4  BLABL+4
         B        DO:FILDIR
ENDEND2  EQU      %
         STW,R0   ZAPACCT
         BAL,SR4  DO:TIME
         CAL1,1   CLSTAPSV          CLOSE SO CAN REOPEN AS DEVICE TAPE
         CAL1,1   OPNDEVTP
*                 ERR,ABN= BSR1; DEVICE = 'MT'
UNLOAD   CAL1,1   CLSTPREM
*                 REMOVE
         STW,R0   NOTAPFG           CLEAR THE TAPE-MOUNTED FLAG
         CAL1,9   SUPCLOSE           AND PRINT
UNLOAD1  EQU      %
         LI,R5    OPERMSG
         LI,R6    YES
         LI,R7    1
         CAL1,2   KEYIN
         LB,R6    YES,R1
         CI,R6    'Y'
         BE       YESFL
         CI,R6    'N'
         BE       NO:FILL
         LH,R6    YES               CHECK FOR TIMEOUT ON READ
         CI,R6    X'15'
         BNE      UNLOAD1           ASK HIM AGAIN..GARBAGE INPUT
         PAGE
*F*      NAME:    NO:FILL
*F*
*F*      PURPOSE: CREATE THE F:BACKUP FILE AND RELEASE DYNAMIC MEMORY.
*F*      DESCRIPTION:  THE F:BACKUP FILE IS OPENED INOUT; IF IT DOESN'T
*F*               EXIST, THE ABNORMAL ROUTINE WILL OPEN IT OUT.  THE
*F*               F:BACKUP FILE IS THEN CLOSED AND DYNAMIC AND COMMON
*F*               MEMORY ARE RETURNED TO THE SYSTEM.  NO:FILL THEN
*F*               EXITS TO BACKUP.
*F*
NO:FILL  EQU      %
         LI,R0    0
         LI,R1    1
         CAL1,1   OPENBACK
*                 ERR,ABN=ERBCK; INOUT
*                   CREATE A :BACKUP FILE IF NONE EXISTS
GO:BACK1 EQU      %
         CAL1,1   CLSBACK
*                 SAVE
GO:BACK  EQU      %
         LI,SR4   BACKUP
         STW,SR4  BACKXT
         B        RELEASE           OVERLAY
*
*  M:MOVE
*                                   FPT ABN RET
MOABN    EQU      %
MOERR    EQU      %
         LB,R4    SR3               PICK UP THE ERROR/ABNORMAL CODE
         LI,R6    #MOABNS
         CB,R4    MOABNS,R6
         BE       MABNVECT,R6
         BDR,R6   %-2
         BAL,D3   ERROR             (DOESN'T RETURN - GOES TO OPN:NXT)
*
MABNVECT PZE      MABNVECT
         BAL,D3   ERROR             (1C ABN - END OF TAPE)
         B        ENDFILE           (05 ABN - END OF DATA)
         B        ENDFILE           (06 ABN - END OF FILE)
         B        MOABN07           (07 ABN - LOST DATA)
         B        DONE              (41 ERR - READ ERROR ON TAPE)
         B        MOERR57           (57 ERR - NO MORE GRANULES)
#MOABNS  EQU      %-MABNVECT-1
         RES      4                 FOR EXPANSION BY PATCH
*
MOABNS   EQU      %
         DATA,1   0,X'1C',X'05',X'06',X'07',X'41',X'57'
         PZE                        FOR EXPANSION BY PATCH
         PAGE
MOERR57  EQU      %
         AI,R8    -1
         STW,R8   57ERR             RETURN ADDRESS FOR RETRY
*
         LW,D1    *GRANRADAD
         AW,D1    *GRANPACKAD       SUM OF AVAILABLE STORAGE
         AW,R1    *GRANCYLAD         INCLUDING CYLINDER ALLOCATED
         CW,D1    THRESH
         BL       TOPURGE           FILL PROBLEM, NO GRANS AVAILABLE
*
*        JIT AUTHORIZATHIN NOT ENOUGH, MUST BUMP
*
         LI,D1    -1
         LI,D2    X'3FFF'
         STH,D2   D1                LARGE POSITIVE NUMBER => D1
         LI,R7    PRDCRM
         STW,D1   J:JIT,R7
         LI,R7    PRDPRM
         STW,D1   J:JIT,R7
         CAL1,1   PRECORDT          BACKSPACE BOTH TAPE AND
         CAL1,1   PRECORDF           FILE FOR RETRY
         B        *57ERR            TRY AGAIN
*
TOPURGE  EQU      %                 TELL OPERATOR SITUATION AND WAIT
         STW,R1   INT               SET UP FOR OPERATOR COMMAND
         LI,R5    NOGRANS           TELL HIM THE PROBLEM
         CAL1,2   TYPE
         LH,R5    FL:TAPE
         CI,R5    X'20'             IS TAPE OPEN?
         BANZ     %+3               YES
         CAL1,1   OPNXTAP           NO, OPEN IT ONE WAY
         CAL1,1   OPNDEVTP           OR ANOTHER.
         CAL1,1   CLSTPREM          CLOSE AND REMOVE
*
         LCI      0
         STM,R0   REGS
         BAL,R3   SNAPPER
         CAL1,9   SUPCLOSE
         B        NO:FILL
*
MOABN07  EQU      %
         LH,R12   NMPG              REMEMBER WHAT WE HAVE
         LW,R5    R12
         CW,R5    DEFAULT
         BNE      %+3
         AW,R5    PGINCRM           ADD THE FIRST INCREMENT
         B        %+2
         AI,R5    255               GET ALL THERE IS
         BAL,SR4  GETBUF
         CW,R12   R7
         BE       DONE              DIDN'T GET ANY MORE, GIVE UP
         CAL1,1   PRECORDT
*                 REVERSE
         B        COPYFILE          CONTINUE WITH THE MOVE
DONE     EQU      %
         BAL,SR2  NO:RCV
         CAL1,1   CLSUSREL
         CAL1,1   CLSTAPSV
         B        OPN:NXT
         SPACE    3
GOMAIL   EQU      %                 SELECT MAILBX ENTRY ON TIME CHANGE
         LW,R4    *TIMEAD
         XW,R4    MTIME
         CW,R4    MTIME
         BNE      MAILBOX           NEW TIME
         B        FMAILBX           SAME TIME
         SPACE    5
ENDFILE  EQU      %
         CAL1,1   CLSUSRSV
*                 SAVE
         LI,R6    1
         BAL,SR4  PRINTLIN
         MTW,0    SYNFLAG           IS FILE SYNONOMOUS?
         BEZ      FPRINT            NO, PRINTLINE IS OK
         LW,R1    CLORGSIZ          CLEAR OUT THE SIZE AND
         BAL,R5   BLANKS             ORG AS NOT CORRECT
         LW,D3    ORGTBL            PICK UP THE 'SYN' ORG
         LD,R4    ORGMBS             AND PUT INTO PRINTLINE
         MBS,R4   0
FPRINT   EQU      %
         LI,R6    63                SIZE FOR NO ERROR CASE
         STB,R6   PBUFFER
         CAL1,2   PRINT             OUTPUT THE MESSAGE
         MTW,0    SELECT
         BEZ      ENDFILE1          NOT SELECT, NO MAILBOX
         LW,D4    BLDMAIL            ARE WE ALLOWED MAILBOXES?
         BEZ      ENDFILE1          NO
         LI,R4    9
         LW,R6    F:USR+22,R4       TRANSFER FILENAME TO SUCCESS
         STW,R6   SUCCESS+1,4       MESSAGE
         BDR,R4   %-2
         LB,R4    F:USR+23
         AI,R4    8
         STB,R4   SUCCESS
         LI,R4    C' '
         STB,R4   SUCCESS+2
         LI,SR3   MAILSUC
         STW,R1   NOPRINT           DISABLE REPRINT BY MAILBOX
         BAL,SR4  GOMAIL
         STW,R0   NOPRINT           BACK THE WAY IT WAS
ENDFILE1 EQU      %
         CAL1,1   CLSTAPSV
         B        OPN:NXT
         PAGE
*
*F*      NAME:    USRERR
*F*
*F*      PURPOSE: HANDLE ERROR RETURNS FROM CALS ISSUED THROUGH THE F:USR
*F*               DCB.
*F*      DESCRIPTION:  THE CONTENTS OF R10 DETERMINE ACTION.
*F*      REFERENCES:  BATCH PROCESSING REFERENCE MANUAL, APPENDIX B
*F*                   (MONITOR ERROR MESSAGES)
*F*
USRERR   EQU      %
         LB,R4    SR3               PICK UP ERROR CODE
         LI,R6    #USRERRS
         CB,R4    USRERRS,R6
         BE       UERRVECT,R6
         BDR,R6   %-2
         BAL,D3   ERROR             (DOESN'T RETURN - GOES TO OPN:NXT)
*
UERRVECT PZE      UERRVECT
         B        DONE              (51 ERR - DELETE OF BUSY INPUT FILE)
         B        ERR55             (55 ERR - TOO MANY FILES OPEN)
         B        ERR75             (75 ERR - FILE INCONSISTENCY)
#USRERRS EQU      %-UERRVECT-1
         RES      4                 FOR EXPANSION BY PATCH
*
USRERRS  EQU      %
         DATA,1   0,X'51',X'55',X'75'
         PZE                        FOR EXPANSION BY PATCH
         PAGE
ERR75    EQU      %
         BAL,SR2  NO:RCV
         LH,R4    F:USR
         CI,R4    X'20'             IS THE FILE OPEN?
         BAZ      %+2               NO
         CAL1,1   CLSUSREL          YES, CLOSE AND RELEASE IT
         CAL1,1   CLSTAPSV
         B        OPN:NXT
         SPACE    3
BADTIME  EQU      %
         LI,R6    BADSEQ            FILE OUT OF SEQUENCE
         STW,R6   KADR-1            TEMP
BDTP     EQU      %
         LW,R5    KADR-1
         LI,R6    YES
         LI,R7    1
         CAL1,2   KEYIN
         LB,R6    YES,R1
         CI,R6    'C'
         BE       GO:ON
         CI,R6    'Q'
         BNE      BDTP
         CAL1,1   CLSTAPSV
*                 SAVE
         B        ENDEND
NO:RCV   EQU      %                 SEND NO RECOVERY TO MAILBOX
         LCI      2                 SAVE RETURN AND ABN REGS
         STM,SR2  R47
         LI,R6    1                 FILL TYPE MESSAGE
         BAL,SR4  PRINTLIN
         LCI      2
         LM,SR2   R47               GET REGS BACK
         LI,R7    0
         XW,R7    BLDMAIL           FAKE OUT SEND:ERR
         BAL,SR2  SEND:ERR
         LCI      2                 GET INPUT REGS BACK AGAIN
         LM,SR2   R47
         XW,R7    BLDMAIL           PUT MAIL CODE BACK
         MTW,0    BLDMAIL
         BEZ      *SR2
         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  NOMSG,R7
         AI,R7    1
         CI,R7    11
         BL       SEND:ERR1
         LI,SR1   NOMSG:FAIL-1      'FAIL' MSG
         LI,R7    5
         LW,SR4   *SR1,R7
         STW,SR4  NOMSG+2,R7
         BDR,R7   %-2
         LW,D4    BLDMAIL           PICK UP FILE-BUILDING SWITCH
         LI,SR3   MAILPAR
         STW,R1   NOPRINT           DISABLE LINE PRINTER FROM MAILBOX
         BAL,SR4  GOMAIL
         STW,R0   NOPRINT           BACK TO ORIGINAL STATE
         B        *SR2
         PAGE
SPECERR  EQU      %
SPECABN  EQU      %
         AND,R5   R1                DON'T STEP ON OTHER STUFF
         LB,R4    SR3
         CI,R4    2
         BNE      *SR1
         LB,R4    SR3,R1            SUBCODE
         CI,R4    2                 0,1=0, 2,3=1
         BL       SPLSTEND2         END THIS ACCT
         LW,SR3   BLABL+4
         CI,SR3   -1
         BE       ENDEND2
SPPAGREL EQU      %
SKIPPING EQU      %
         LW,SR3   L(X'200000')
         CW,SR3   FL:TAPE
         BAZ      OPN:NXT           DCB ALREADY CLOSED
         CAL1,1   CLSTAPSV
*                 SAVE
         B        OPN:NXT
         END      FILL

