CPV      SET      1
*M*      FRES     FILE RESTORE PROCESSOR.
*P*      NAME:    FRES
*P*      PURPOSE: TO RESTORE FILES FROM TAPES CREATED BY THE FAST SAVE
*P*               (FSAVE) OR FILL PROCESSORS. FILES ARE RESTORED ON
*P*               A SELECTIVE BASIS.
*P*      DESCRIPTION: THE FRES PROCESSOR MUST BE RUN UNDER AN ACCOUNT
*P*               WITH C0 PRIVILEGE. THE TASKS TO BE PERFORMED ARE
*P*               DEFINED BY CONTROL COMMANDS AND THE FILES TO BE
*P*               SELECTED ARE DEFINED BY DATA RECORDS THAT FOLLOW
*P*               THE CONTROL COMMAND TO WHICH THEY APPLY.
*P*      REFERENCE: OPERATIONS REFERENCE MANUAL.
         DO       CPV
         TITLE    ;
 '* * * C P - V   F I L E   R E S T O R E   P R O C E S S O R * * *'
         ELSE
         TITLE    ;
 '****B P M  F I L E  R E S T O R E  P R O C E S S O R ***'
         FIN
M:EO     DSECT    1
M:EI     DSECT    1
         CSECT    0
EASECT   EQU      %
         SYSTEM   SIG7FDP
         DEF      EAREAD,PATCH,DBUF,START
UTSPROC  SET      0
S69PROC  SET      1
TAURUS   SET      CPV
         SYSTEM   UTS
         SYSTEM   BPM
         REF      M:C               DCB FOR CONTROL CARD INPUT.
         REF      M:SI              DCB FOR CONTROL CARD INPUT FOR ONLINE.
         REF      M:SO               DCB TO BUILD SORTED DATA CARD FILE.
         DO       CPV
         REF      J:ACCN            JIT ACCOUNT NAME
         REF      J:FDDA            FILE DIRECTORY DISK ADDR IN JIT -
*,*                                 CLEARED AFTER EACH ACCOUNT IS RESTORED.
         REF      J:ASSIGN          RD NONE BIT RESET DURING RESTORE.
         REF      PRDCRM            MAX PERM RAD IN JIT
         REF      TMDCRM            MAX TEMP RAD IN JIT
         REF      PRDPRM            MAX PERM DISC IN JIT
         REF      TMDPRM            MAX TEMP DISC IN JIT
         REF      MRT               MAX RUN TIME IN JIT
         REF      J:JIT             ADDR OF USER JIT.
         FIN
         DO       1-CPV
OPTPFPT  GEN,8,24 20,M:EI
         DATA     X'40040040'
         DATA     OTABN
         DATA     X'18A00'
         DATA     X'07010101'
         TEXT     'PRG1'
         FIN
EOR      EQU      5                 TYC CODE FOR EOR=05
TYC      EQU      2                 OFFSET TO TYC IN DCB
FCN      EQU      7                 OFSET TO FCN IN DCB
TMK      EQU      6                 TYC CODE FOR TAPE MARK=06
#PAGES   EQU      16                DATA BUFFER DEFAULT SIZE
#BUF     EQU      5                 NUMBER OF TAPE BUFFERS
#SKIP    EQU      16                # OF SKIP ACCOUNTS MAX
#TBUFSZ  EQU      1                 DEFAULT BUFFERS ARE 1 PAGE LONG
         PAGE
         DO       CPV
         REF      S:CUN             CURRENT USER NUMBER - USED TO
*,*                                 ACCESS USER TABLES.
         REF      UB:MF             COUNT OF I/O REQUESTS OUTSTANDING
*,*                                 USED BY END ACTION.
         REF      NEWQNWM           CALL NEWQ - NO WAIT - MAPPED.
         REF      TSTACK            MONITOR TSTACK - USED BY END ACTION.
         REF      UB:US             USER STATE - USED BY END ACTION.
         REF      SIOW              I/O WAIT STATE - USED BY END ACTION.
         REF      SIOMF             USER STATE WAITINF ON MASTER
*,*                                 FUNCTION COUNT DOWN.
         REF      JX:CMAP           START OF CMAP IN JIT - USED TO
*,*                                 CONVERT VIRTUAL TO PHYSICAL PAGE
*,*                                 FOR ENDACTION.
         FIN
BASEREG  CNAME
         PROC
LF       WD,0     X'37'             DISABLE
         LI,AF    0                 PHYSICAL PAGE #
         SLS,AF   9                 PHYSICAL ADDRESS OF PAGE
         AI,AF    0                 DISPLACEMENT INTO PAGE
         PEND
         USECT    EASECT
*  R12=TYC,-,RBC  R14=PHY. BA(TSTATUS) THIS GUY
*  R15=PHY. BA(BUF)
EAREAD   BASEREG  1
         LB,13    12                TYC
         CI,13    EOR               ENTER CAUTION
         BNE      %-EAREAD+2,1      THAT IS NO READ-AHEAD
         STW,13   CAUTION-EAREAD,1  MODE AT END OF TAPE
         LW,7     14                BYTE ADDRESS OF TSTATUS
         STB,13   0,7               TYC
         AND,12   MASK-EAREAD,1     RBC
         SW,R12   TBUFSZ-EAREAD,R1  CHECK RBC FOR SENTINEL (12 BYTES)
         CI,R12   -12
         BNE      ENDIT-EAREAD,1    NO-NOT A SENTINEL
         SLS,15   -2                PHY. WA(BUF)
         LW,15    *15               FIRST WORD
         CW,15    TXT:EOR-EAREAD,1  :EOR
         BE       ENDIT-EAREAD+2,1
ENDIT    EQU      %
         LI,2     0
         STW,2    TPBUSY-EAREAD,1   ZAP
         DO       CPV
         LW,2     CUN-EAREAD,1
         MTB,-1   UB:MF,2           DOWN MY MASTER FUNCTION
         BNEZ     EARETRN-EAREAD,1  RETURN IF NON-ZERO
         LB,15    UB:US,2           OTHERWISE CHECK MY STATE
         CI,15    SIOW              IF SIOW
         BE       EAREP-EAREAD,1    THEN REPORT IOCOMPLETE
         CI,15    SIOMF             OR IF SIOMF
         BNE      EARETRN-EAREAD,1  NEITHER SIOW NOR SIOMF-RET
EAREP    MTB,1    UB:MF,2           RE-UP MY MASTER FUNCTION
         STW,2    *TSTACK           STUFF MY USER NO. IN TSTACK
         ELSE
         MTB,-1   M:EI+FCN          DOWN FUNCTION COUNT
         FIN
EARETRN  EQU      %                 RETURN
         REF      SW,T:RUE,E:WU
         LW,5     2                 MOVE USER #
         CI,15    SW                IS FRES ASLEEP RIGHT NOW...
         BNE      *11               NO-> RETURN TO IOQ
         LI,6     E:WU              LETS WAKE EM UP
         B        T:RUE             TO CONTINUE...
MASK     DATA     X'FFFF'
CUN      RES      1                 S:CUN
MTDCTX   RES      1
TXT:EOR  TEXT     ':EOR'
TPBUSY   RES      1                 0 IF NOT BUSY
CAUTION  RES      1                 NON-ZERO IF NO READ AHEAD ALLOWED
         BOUND    8
DOUBLEONE DATA    1,1
BUFR1    RES      1
BUFR2    RES      1
BUFRSIZ  RES      1
TBUFSZ   PZE                        SET UP BY INITIAL BEFORE MOVED TO EA PAGE
PATCH    RES      100
PTCHEND  EQU      %-1
         PAGE
         CSECT    0
         DO       TAURUS=1
         DEF      EAADDR
EAADDR   DATA     0                 ENDACTION WORD ADDR
EAPHYADR DATA     0                 PHYSICAL PAGE OF STOLEN PAGE FOR EA.
Y05      DATA     X'05000000'
CVMFPT   DATA     X'87000003'
         DATA     X'80000008'
GTPG     GEN,8,24 8,1
FREPG    GEN,8,24 9,1
OPNERFIL GEN,8,24 X'14',M:EI        OPEN ERRMSG FILE
         DATA     X'C7480001'
         DATA     ERRADD
         DATA     ERRADD
         DATA     2                 KEYED FILE
         DATA     2                 DIRRECT ACCESS
         DATA     1                 INPUT
         DATA     2                 SAVE
         DATA     4                 MAX KEY SIZE
         DATA     X'01000202'
         TEXTC    'ERRMSG'          FILE NAME
         DATA     X'07000000'       CLEAR INSN BEFORE OPN FILE
         DATA     X'02010202'
         TEXT     ':SYS    '        ACCOUNT
READERFIL GEN,8,24 X'10',M:EI
         DATA     X'F8000000'
         DATA     ERRADDRD
         DATA     ERRADDRD
         PZE      *3                BUFF
         PZE      80                SIZE
         PZE      *3                KEYAD
         FIN
CLOSE    GEN,8,24 X'15',M:EI
         DATA     X'80000000'
         DATA     2                 SAVE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
SR1      EQU      8
R9       EQU      9
SR2      EQU      9
R10      EQU      10
SR3      EQU      10
R11      EQU      11
SR4      EQU      11
R12      EQU      12
D1       EQU      12
R13      EQU      13
D2       EQU      13
R14      EQU      14
D3       EQU      14
R15      EQU      15
D4       EQU      15
DBUF     DATA     0                 ADDRESS OF DATA BUFFER
PAGES    DATA     #PAGES            # PAGES IN DBUF
XPAGES   DATA     0                 XTRA PAGES GOTTEN
CURBUF   RES      2                 ORDINAL, ADDRESS
NXTBUF   RES      1                 NEXT TBUF TO READ INTO
TBUFSIZ  DATA     #TBUFSZ
BUF      DATA     #BUF              NUMBER OF TAPE BUFFERS
         DO1      #BUF
         DATA     0                 WA(TBUF)
*  TAPE BUFFERS   STATUS BYTE = 0 IF AVAILABLE
*                             = TYC IF IN USE
*                             = FF IF BUSY
TSTATUS  RES,1    #BUF+1            BYTE TABLE
         BOUND    4
DBUFSIZ  RES      1                 SIZE OF DATA BUF IN BYTES
ORG      RES      1
KEYM     RES      1
DEVICE   RES      1
RSTORE   RES      1
RC       RES      1
RWS      RES      1
DBUFLOC  RES      1
KBUF     RES      8
TEMP     RES      1
TAPECNT  RES      1                 COUNT OF TAPES MOUNTED
FILESKIP DATA     0                 TOTAL FILES SKIPPED
SYNFLG   DATA     0                 NON-ZERO FOR SYNON FILE
RATE     RES      1                 NO. OF RATE ERRORS
PFLAG    DATA     0                 PAGE HEADING FLAG
BPMTAPE  DATA     0                 TAPE MADE USING BPM FLAG
         DO1      CPV
X0F000001 DATA    X'0F000001'       SLEEP CAL FPT
HIYALL   TEXTC    'FRES HERE  '
         DATA     X'15000000'       CR
COLON    TEXTC    ':'
PROMPT   DATA     X'2C00007A'       FPT TO CLEAR PROMPT
         DO       CPV
DATMESS  TEXTC    '   DATE ON TAPE IS XX:XX XXX XX, XX'
         ELSE
DATMESS  DATA     X'23154040'
         TEXT     'DATE ON TAPE IS XX:XX XXX XX, XX'
         FIN
FNFMESS  TEXTC    '  FOLLOWING FILES NOT FOUND: '
NONE     TEXTC    '*NONE*  '
ACCTMESS TEXTC    ' ACCOUNT#  '
LASTACCT TEXT     '           '     ACCOUNT OF LAST FILE RESTORED
LASTFILE RES      9                 FNAME VLP ENTRY OF LAST FILE
         GEN,8,24 8,BA(STACCT)
STACCT   DATA     0,0               START ACCT 0=NONE
STFILE   DATA     0,0,0,0,0,0,0,0   START FILE  0=NONE
SAVDATE  DATA     0,0               DATE FROM TLABEL
         GEN,8,24 8,BA(SAVDATE)
SELECT   DATA     0,0               SWITCH,FLAG TO INDICATE FINISH
SELBUFC  GEN,8,24 8,BA(SELBUF)
         GEN,8,24 8,BA(SELKEY)+1    LEAVE ROOM FOR TEXTC COUNT
ANY      DATA     0                 COUNTER FOR SELECT
FCHEK    DATA     0                 FLAG TO VERIFY TAPES
PACK     DATA     0                 FLAG TO RESTORE TO PRIV PACK
PPFPTSN  DATA     X'07000101',0     PRIVATE PACK SN DUMMY VLP
VLPTAB1  DATA,1   04,06,05,03,01    VLP CODE SET UP FOR FILL
         BOUND    4
********ENTRY 0A MUST COME FIRST IN VLPTAB2***************
********FOR THE NEW FILE MODIFICATION DATE OPTION TO WORK*****
VLPTAB2  DATA,1   7,X'0A',X'0F',X'0E',X'10',X'15',X'14',X'04'
         BOUND    4
VLPTABDU DATA,1   4,X'10',X'0F',X'0E',X'0A'
         BOUND    8
SKIP     DATA     0,0               ACCTS TO SKIP
         RES,8    #SKIP
MYACCT   RES      2                 LOGON ACCOUNT
FILL     DATA     0                 NON-ZERO FOR FILL TAPES
         DO       CPV
JASSIGN  DATA     0                 SAVE READ NONE BIT FROM JIT
MAXGRAN# EQU      X'3FFFFFFF'
         ELSE
MAXGRAN# EQU      X'7FFFF'          HALF WORD IN BPM
         FIN
MAXGRAN  DATA     MAXGRAN#
SVPRDC   DATA     MAXGRAN#
SVTMDC   DATA     MAXGRAN#
SVPRDP   DATA     MAXGRAN#
SVTMDP   DATA     MAXGRAN#
* KEEP NEXT 4 LINES TOGETHER
DCUSED   TEXTC    'NUMBER OF RAD GRANULES RESTORED                '
RADUSED  EQU      %-3
DPUSED   TEXTC    'NUMBER OF DISC GRANULES RESTORED               '
PACKUSED EQU      %-3
SKIPPED  TEXTC    'NUMBER OF FILES SKIPPED            '
NOSKIP   EQU      %-3
TAPEUSED TEXTC    'NUMBER OF TAPES            '
NOTAPES  EQU      %-3
*
         BOUND    8
TXT:PRG1 TEXT     ':LBL'
         TEXT     'PRG1'            INSN MAY COME FROM +VOL DATA CARD
OPNFLFPT GEN,8,24 X'14',M:EO        M:OPEN
         DATA     X'CF4C1001'       PP'S
         DATA     FERR
         DATA     FABN
         DATA     10                TRIES
         GEN,1,31 1,ORG
         DATA     2                 DIRECT
FPTMODE  DATA     2                 OUT
         DATA     2                 SAVE
         GEN,1,31 1,KEYM
         GEN,1,31 1,DEVICE
         GEN,1,31 1,RSTORE
FPTVLP   RES      256               FLP'S (256 JUST IN CASE)
VLP09    RES      17                17 JUST IN CASE
         BOUND    8
STACK    DATA     STACK+1
         GEN,16,16 50,0
         RES      50
         BOUND    8
CCBUF    EQU      %
         DO1      20
         TEXT     '    '
SELBUF   EQU      CCBUF             MAY AS WELL USE SAME BUFFER
SELKEY   EQU      %
         DO1      8
         TEXT     '    '
         DO       1-CPV
NEWQ     RES      1                 ADDRESS OF BPM NEWQ
J:JIT    RES      1                 FIRST WORD OF BPM JIT
MRT      EQU      38                JIT DISP FOR MRT
PRMDCJB  EQU      18                JIT WORD DISP FOR RAD USED (HW ENTRY)
PRMDPJB  EQU      19                JIT WORD DISP FOR DISC USED (HW ENTRY)
PUF      EQU      40                PROC/MON RUNNING FLAGS
SVDCX    RES      1
SVDPX    RES      1
SYSACNT  TEXT     ':SYS    '        YE OLDE SYSTEM ACCOUNT
OLDRNST  RES      1
X1FFFF   DATA     X'1FFFF'
         FIN
         PAGE
         CSECT    1
START    EQU      %
         BAL,0    INITIAL
         BAL,0    CCI               PROCESS CONTROL COMMANDS
START:   BAL,0    OPNTAP            OPEN AND REWIND
         BAL,0    NEXTBUF
         LD,12    TXT:PRG1          GET FIRST TWO WORDS
         LW,14    FILL              FILL OR FPURGE FORMAT
         BNEZ     %+3               FILL
         LI,14    'P'               FPURGE, ACTUAL INSN ALWAYS PRGX
         STB,14   13                MAKE PRGX BEFORE COMPARING
         CD,12    *CURBUF+1         = :LBLPRG1
         BNE      BADSN             NO...BAD INSN ON TAPE
         LW,15    TAPECNT           # OF TAPES ALREADY MOUNTED
         CI,15    1                 IF 1 THEN FIRST REEL
         BG       OPNNXTF           IF GREATER THEN NOT PRG1 WITH DAT
         LI,3     3                 BYTE DISPLACEMENT
         LB,3     13,3              GET X OF PRGX
         BAL,0    SKP:BOF           GET TO FIRST FILE
         B        EOVEOR            :EOV OR :EOR
         CI,3     '1'               IS IT PRG1
         BAL,0    DODAT             HANDLE DAT FILE
OPNNXTF  EQU      %                 OPEN NEXT FILE
         LW,0     SELECT+1          NON-ZERO MEANS WE'RE DONE
         BNEZ     EXIT
         BAL,0    SKP:BOF           OKAY OPEN NEXT FILE
         B        EOVEOR            :EOV OR :EOR
         B        %+2               *****DONT COUNT GRANULES FOR NOW
         BAL,15   GETGCNT           GET CURRENT GRANULE COUNT
         BAL,0    GOT1              PROCESS FILE
         B        OPNNXTF           ERROR OPENING FILE
         MTW,0    SYNFLG            SYNON FILE FLAG
         BNE      SAVFILE           SET-CLOSE AND SAVE
         BAL,0    BUILD             BUILD THE FILE
         B        RELFILE           ERROR RETURN
SAVFILE  EQU      %
         MTW,0    FCHEK
         BNEZ     SAVFIL1
         M:PRINT  (MESS,LASTFILE+1) PRINT FILE NAME
         B        %+2               ******DONT COUNT GRANULES FOR NOW
         BAL,15   GETGTOT           UPDATE TOTAL COUNT
         M:CLOSE  M:EO,(SAVE)       FILE FINISHED-SAVE IT
SAVFIL1  EQU      %
         B        OPNNXTF           CONTINUE
RELFILE  EQU      %
         LW,15    ORG
         CI,15    3                 RANDOM
         BE       SAVFILE           YES-TRY TO SAVE
         MTW,0    FCHEK
         BNEZ     REFIL1
         M:CLOSE  M:EO,(REL)        ERROR RELEASE FILE
REFIL1   EQU      %
         B        OPNNXTF           AND CONTINUE
EOVEOR   EQU      %                 :EOV OR :EOR ENCOUNTERED
*  R7 CONTAINS SENTINEL
         CW,7     TXT:EOV           IS IT :EOV
         BE       START:            YEP-OPEN NEXT VOLUMN ETC.
         B        EXIT              NOPE-EXIT ON :EOR
BADSN    EQU      %                 :LBL DOESN'T PASS TEST
         M:PRINT  (MESS,BADSNM)
         LD,10    *CURBUF+1         PICK UP ACTUAL :LBL
         BAL,15   ABORTX
GETGCNT  EQU      %
         DO       CPV
         M:SYS
         LI,1     J:JIT
         LW,3     PRDCRM,1
         ELSE
         LW,1     X'4F'
         INT,3    PRMDCJB,1
         FIN
         STW,3    CURRAD
         DO       CPV
         LW,3     PRDPRM,1
         ELSE
         INT,3    PRMDPJB,1         BH-#H02
         FIN
         STW,3    CURPACK
         B        GETGTOT1
GETGTOT  EQU      %
         DO       CPV
         M:SYS
         LI,1     J:JIT
         LW,3     CURRAD
         SW,3     PRDCRM,1
         AWM,3    TOTRAD
         LW,3     CURPACK
         SW,3     PRDPRM,1
         ELSE
         LW,1     X'4F'
         INT,13   PRMDCJB,1         PERM RAD FROM BPM JIT
         LW,3     CURRAD            PERM RAD BEFORE THIS FILE
         SW,3     13                PERM RAD USED BY THIS FILE
         AWM,3    TOTRAD            ADD TO TOTAL USED
         INT,13   PRMDPJB,1         PERM DISK
         LW,3     CURPACK           PERM DISK BEFORE THIS FILE
         SW,3     13                PERM DISK USED BY THIS FILE
         FIN
         AWM,3    TOTPACK
GETGTOT1 EQU      %
         BAL,0    SLAVE
         B        *15
CURRAD   DATA     0
CURPACK  DATA     0
TOTRAD   DATA     0
TOTPACK  DATA     0
         PAGE
*F*      NAME:    QTAP
*F*      PURPOSE: QUEUE TAPE I/O
*F*      DESCRIPTION: QTAP CONTROLS THE READING OF TAPE. AS READ
*F*               AHEAD BUFFERS BECOME AVAILABLE MTREAD IS CALLED TO
*F*               READ ANOTHER TAPE RECORD.
QTAP     EQU      %
         DO       TAURUS=1
         LI,R7    CAUTION-EAREAD    NO READ AHEAD
         LW,R7    *EAADDR,R7
         ELSE
         LW,7     CAUTION           NO READ AHEAD
         FIN
         BNEZ     *0                ALLOWED IN CAUTION MODE
QTAP1    EQU      %                 ENTER HERE ON RATE ERRORS
         LW,7     NXTBUF            ORDINAL
         MTB,0    TSTATUS,7         STATUS BYTE
         BNE      *0                NOT AVAILABLE, RETURN
         PSW,0    STACK
         DO       TAURUS=1
         PSW,7    STACK
         LI,7     TPBUSY-EAREAD     MARK TAPE BUSY
         MTW,1    *EAADDR,7
         PLW,7    STACK
         ELSE
         MTW,1    TPBUSY            MARK TAPE BUSY
         FIN
         LI,0     X'FF'
         STB,0    TSTATUS,7
         BAL,0    MTREAD            DO I/O
         CW,7     BUF               ORDINAL=MAX
         BL       %+2               NOT YET
         LI,7     0                 RECYCLE
         AI,7     1                 BUMP
         STW,7    NXTBUF            UPDATE
         PLW,0    STACK
         B        *0                RETURN
         PAGE
*F*      NAME:    MTREAD
*F*      PURPOSE: CALL NEWQNWM IN IOQ WHICH PERFORMS TAPE I/O
*F*      DESCRIPTION: MTREAD SETS UP END ACTION INFORMATION
*F*               INCREMENTS THE MASTER FUNCTION COUNT AND SETS
*F*               UP A READ REQUEST FOR 2048 BYTES INTO THE
*F*               BUFFER PROVODED BY QTAP.
MTREAD   EQU      %                 R7=TBUFX
         LCI      5
         PSM,0    STACK
         DO       CPV
         M:SYS                      MASTER MODE
         LW,1     S:CUN             UP MY
         MTB,1    UB:MF,1           MASTER FUNCTION
         DO       TAURUS=1
         LI,R2    CUN-EAREAD        SAVE FOR ENDACTION
         STW,R1   *EAADDR,R2
         ELSE
         STW,1    CUN               SAVE FOR END ACTION
         FIN
         FIN
         LI,1     BA(TSTATUS)
         AW,1     7                 BYTE ADDRESS THIS GUY
         DO       CPV
         LW,R2    R1                MOVE BA OF IT
         SLS,R2   -11               AND POSITION FOR INDEXING
         LOAD,2   JX:CMAP,2         TO
         SLS,2    11                PHYSICAL
         LI,3     X'FF800'          BYTE
         STS,2    1                 ADDRESS
         FIN
         DO       TAURUS=1
         LI,0     EAREAD            VIRTUAL ADDRESS OF END-ACTION CODE
         LW,2     EAPHYADR          PHYSICAL ENDACTION PAGE
         ELSE
         LI,0     EAREAD            VIRTUAL ADDRESS EA ROUTINE
         LI,2     EAREAD            CONVERT
         SLS,2    -9                VIRTUAL ADDRESS
         DO1      CPV
         LOAD,2   JX:CMAP,2         TO
         LI,3     1
         STH,2    EAREAD+1,3
         SLS,2    9                 PHYSICAL
         FIN
         LI,3     X'FFE00'          WORD
         STS,2    0                 ADDRESS
         LW,12    READ              FC,PRI,NRT,0
         OR,12    MTDCTX            FC,PRI,NRA,DCTX
         LW,13    BUF,7             WA(BUF)
         SLS,13   2                 BA(BUF)
         LW,R14   TBUFSIZ
         SLS,R14  11                BYTE SIZE OF TAPE BUFFER
         LI,15    0
         DO       CPV
         BAL,11   NEWQNWM           DO IO
         ELSE
         MTB,1    M:EI+FCN          UP FUNCTION COUNT
         BAL,11   *NEWQ             DO BPM I/O
         FIN
         NOP
         LCI      5
         PLM,0    STACK
         B        SLAVE             RETURN VIA SLAVE
READ     GEN,8,8,8,8 0,X'FF',10,0  READ FC,PRI,NRA,0
         PAGE
*F*      NAME:    OPNTAP
*F*      PURPOSE: OPEN UNLABELED TAPE
*F*      DESCRIPTION: THIS ROUTINE OPENS M:EI TO DEVICE TAPE
*F*               WITH THE CORRECT SERIAL NUMBER, AND
*F*               INITIALIZE TAPE READ BUFFER POINTERS.
OPNTAP   EQU      %                 R1=X OF PRGX
         LW,7     Y002              OPEN BIT
         CW,7     M:EI
         BAZ      OPT               NOT OPEN
         LI,7     3                 BYTE DISP.
         LCI      3
         PSM,0    STACK
         DO       CPV
OPNTAP1  M:SYS                      MASTER MODE
         LW,1     S:CUN             MAKE SURE I/O
         LB,1     UB:MF,1           HAS BEEN
         BEZ      OPNTAP2-1         RUN DOWN
         BAL,0    SLAVE             ALLOW KEYINS
         LI,1     2000
         BDR,1    %
         B        OPNTAP1
         BAL,0    SLAVE
         FIN
OPNTAP2  EQU      %
         M:CLOSE  M:EI,(SAVE),(REM)
         LB,1     OPTPFPT+5,7
         MTW,0    FILL              FILL OR FPURGE TYPE SN
         BNE      OPNTAP3           WOULD YOU BELIEVE FILL
         CI,1     '9'               MAX X
         BL       %+2               X OKAY TO BUMP
         LI,1     '0'               RECYCLE
         AI,1     1                 BUMP X
OPNTAP21 EQU      %
         STB,1    OPTPFPT+5,7       STICK IN X
         STB,1    TXT:PRG1+1,7
         LCI      3
         PLM,0    STACK
OPT      EQU      %
         DO       CPV
,OPTPFPT M:OPEN   M:EI,(INSN,'PRG1'),(ABN,OTABN),(DEVICE,'9T')
         ELSE
         CAL1,1   OPTPFPT           OPEN BPM DEVICE TAPE
         FIN
         LW,7     Y002
         CW,7     M:EI              MAKE SURE DCB IN OPEN
         BAZ      OTABN             SHOULD NOT HAPPEN
         MTW,1    TAPECNT           COUNT OF REELS ALREADY MOUNTED
         LI,7     X'FF'             MASK
         AND,7    M:EI+1            DCTX
         STW,7    MTDCTX
         M:REW    M:EI
         LI,15    0
         DO       TAURUS=1
         LI,R7    CAUTION-EAREAD    RESET- GO BACK TO NORMAL MODE
         STW,15   *EAADDR,7
         ELSE
         STW,15   CAUTION           RESET - GO BACK TO NORMAL MODE
         FIN
         LI,14    1
         STW,15   CURBUF
         STW,14   NXTBUF
         LW,7     BUF               NO. OF TBUFS
         STB,15   TSTATUS,7         ZAP
         BDR,7    %-1
         DO       TAURUS=1
         LI,R7    TPBUSY-EAREAD     ZAP
         STW,R15  *EAADDR,R7
         ELSE
         STW,15   TPBUSY            ZAP
         FIN
         B        QTAP              RETURN VIA QTAP
OTABN    EQU      %
         M:PRINT  (MESS,OTABNM)
         BAL,15   ABORTX            ABNORMAL OPENING TAPE...SEE R10
OPNTAP3  EQU      %                 FIGURE NEXT SN FOR FILL SET
         LB,2     XTABLE            # OF VALUES OF X
         CB,1     XTABLE,2          X=LAST VALUE
         BNE      OPNTAP4           NO
         LI,2     2                 LAST VALUE,  BYTE DISP. TO LETTER
         MTB,1    OPTPFPT+5,2       BUMP TO NEXT HIGHER LETTER
         MTB,1    TXT:PRG1+1,2      DITTO
         LI,2     1                 RECYCLE X
         B        OPNTAP4+2
         CB,1     XTABLE,2          FIND MATCH FOR X
         BE       %+2               FOUND IT
OPNTAP4  BDR,2    %-2               KEEP ON TRUCKIN'
         AI,2     1                 INDEX TO NEXT HIGHER X
         LB,1     XTABLE,2          GET SAME
         B        OPNTAP21          AND CONTINUE
         PAGE
SKPTMK   EQU      %
         LCI      2
         PSM,0    STACK
         LW,1     CURBUF            ORDINAL
         LB,7     TSTATUS,1         CHECK FOR
         CI,7     TMK               TAPE MARK
         BE       %+3               YES
         BAL,0    NEXTBUF           NO KEEP LOOKING
         B        SKPTMK+2
         LCI      2
         PLM,0    STACK
         B        *0
         PAGE
*F*      NAME:    NEXBUF
*F*      PURPOSE: UPDATES POINTER TO CURRENT TAPE BUFFER.
*F*      DESCRIPTION: THIS ROUTINE IS CALLED TO GET THE NEXT TAPE
*F*               BUFFER FOR PROCESSING. THE CURRENT TAPE BUFFER IS
*F*               FREED AND THE CURRENT BUFFER POINTER IS UPDATED TO THE
*F*               NEXT READ AHEAD BUFFER.
NEXTBUF  EQU      %
         LW,7     CURBUF            ORDINAL
         LI,15    0
         STB,15   TSTATUS,7
         CW,7     BUF               MAX
         BL       %+2               NOT YET
         LI,7     0                 RECYCLE
         AI,7     1                 BUMP ORDINAL
         STW,7    CURBUF            ORDINAL
         LW,14    BUF,7             GET ADDRESS
         STW,14   CURBUF+1          ADDRESS
TAPSPN   EQU      %
         LB,13    TSTATUS,7         FF=BUSY   00=AVAILABLE
         BEZ      RATERR            AVAILABLE=RATE ERROR
         CI,13    X'FF'             BUSY
         BNE      QTAP              NO-RETURN BY QTAP
         MTW,0    SELECT
         BE       TAPSPN            SPIN IF NOT SELECT
         REF      E:QMF             REPORT QUEUE FOR MASTER FUNCTION
*,*                                 COUNT DOWN EVENT.
         REF      T:REG             REPORT EVENT AND GIVE UP CONTROL.
         LW,13    0                 SAVE LINK REG
         M:SYS                      GO MASTER MODE
         LI,6     E:QMF             QUEUE FOR MF COUNT DOWN
         BAL,11   T:REG
         BAL,0    SLAVE             BACK TO SLAVE MODE
         LW,0     13                RESET LINK REG
         B        TAPSPN
RATERR   EQU      %                 RATE ERROR-READ NOW
         MTW,1    RATE
         PSW,0    STACK
         BAL,0    QTAP1             READ IT IN EVEN IF IN CAUTION MODE
         PLW,0    STACK
         LW,7     CURBUF            ORDINAL
         B        TAPSPN            IOSPIN
         PAGE
*F*      NAME:    INITIAL
*F*      PURPOSE: TO PERFORM INITIALIZATION.
*F*      DESCRIPTION: THIS ROUTINE OBTAINS TAPE BUFFERS AND SETS
*F*               UP TABLES USED TO CONTROL TAPE READ AHEAD.
*F*               END ACTION ROUTINES ARE INITIALIZED IN A STOLEN
*F*               PAGE, AND EXIT CONTRIL IS ESTABLISHED IN CASE THE
*F*               RUN ABORTS WITHOUT GOING THROUGH THE NORMAL CLEAN UP.
INITIAL  EQU      %
         LB,7     ACCTMESS
         AI,7     11                UP
         STB,7    ACCTMESS          TEXTC COUNT
         MTB,1    HIYALL            UP TEXTC COUNT
         PSW,0    STACK
         DO       CPV
         LCI      2
         LM,12    J:ACCN            SAVE LOGON
         STM,12   MYACCT            ACCOUNT FOR LOGOFF
         LI,1     J:JIT             MAKE OPERATOR PROOF
         M:SYS                      MASTER MODE
         BCS,8    ABORTK            CC1 SET IF PRIV<C0
         REF      NEWQ              NEWQ - ONLY USED TO MAKE SURE
*,*                                 FRES IS LOADED WITH RIGHT MONSTK.
         CI,10    NEWQ              IS THIS THE RIGHT MONSTK
         BNE      ABORTJ            NO...SCREWUP
*SAVE AND RESET READ NONE FLAG IN THE JIT
         LW,R15   J:ASSIGN
         STW,R15  JASSIGN
         AND,R15  XEFFFFFFF         RESET Y1 BIT
         STW,R15  J:ASSIGN
         LW,15    MAXGRAN           2**31
         XW,15    PRDCRM,1          SET MAX PERM RAD
         XW,15    SVPRDC              & SAVE OLD VALUE
         XW,15    PRDPRM,1          SET MAX PERM DISC
         XW,15    SVPRDP
         ELSE
         M:SYS                      GET MASTER MODE
         STW,10   NEWQ              PUT AWAY ADDRESS OF NEWQ
         LW,1     *X'4F'            GET FIRST WORD OF JIT
         STW,1    J:JIT             PUT IT AWAY
         LW,1     X'4F'
         LW,15    PRMDCJB,1         SAVE OLD VALUE OF
         STW,15   SVDCX                    RAD USED
         LW,15    PRMDPJB,1         SAVE OLD VALUE OF
         STW,15   SVDPX                    DISC USED
         LW,15    Y0038
         LS,15    PUF,1
         STW,15   OLDRNST           SAVE ORIGINAL RUNFLAGS
         LI,14    0
         LW,15    Y0038
         STS,14   PUF,1             SET MONITOR RUNNING
         FIN
*OPEN SORT FILE NAME WITH UNIQUE NAME IN CASE MULTIJOBING
         LI,5     X'FFFF'
         LS,4     J:JIT
         STS,4    SOFPT1+10         APPEND JOB ID TO FILE NAME
         STS,4    SOFPT2+10
         LI,15    0
         STW,15   MRT,1             MAX RUN TIME
         DO       TAURUS=1
         M:XCON   EXCONT            SET EXIT CONTROL IN CASE OP ABORT
INIT5    M:GP     1                 GET PAGE FOR ENDACTION
         STW,9    EAADDR            SAVE VIRTUAL ADDR FOR ENDACTION
         LW,8     9
         BEZ      ABORTI            NO PAGE
         AW,8     Y05               FREE SO IT WILL NOT COME BACK
         M:FVP    *8                FREE VIRTUAL PAGE JUST OBTAINED
         REF      T:STLPP           STEAL A PHYSICAL PAGE FOR
*,*                                 END ACTION ROUTINES.
INIT10   EQU      %
         LI,8     0                 SET FLAG TO REQUEST STEAL.
INIT11   EQU      %
         BAL,11   T:STLPP           STEAL A PHYSICAL PAGE.
         AI,3     0
         BGZ      INIT15            GOT ONE
         BEZ      GRPG1             TRY AGAIN AFTER MAKING SURE
*                                   PAGE IS THERE TO STEAL
         AI,8     0                 TEST FLAG.
         BNEZ     GRPG1             ALREADY REQUESTED.
         WD,0     X'37'
         REF      S:STLC            STOLEN PAGE LIMIT - USED TO FORCE
*,*                                 ALLOCATION OF A STOLEN PAGE.
         AWM,3    S:STLC            FORCE A PAGE
         BLZ      %+2
         STW,3    S:STLC
         WD,0     X'27'             ENABLE
         LI,8     1                 SET FLAG.
GRPG1    CAL1,8   GTPG              GET AND RELEASE A PAGE
         CAL1,8   FREPG
         B        INIT11
INIT15   EQU      %
         CI,3     X'1FFFF'          MAKE SURE PAGE LESS THAN 128K
         BL       INIT20            OK
         REF      T:RSPP            RELEASE A STOLEN PAGE
         BAL,11   T:RSPP            GIVE BACK PAGE JUST STOLE
         B        INIT10            TRY AGAIN
INIT20   EQU      %
         STW,3    EAPHYADR
         LW,8     EAADDR            VIRTUAL PAGE FOR ENDACTION
         CAL1,8   CVMFPT
         LW,3     EAPHYADR
         SLS,3    -9
         LI,2     3                 BASE REG SETUP FOR ENDACTION
         STH,3    EAREAD,2          WITH PHYSICAL PAGE
         FIN
         BAL,0    SLAVE             SLAVE MODE
         PLW,0    STACK
         LW,R5    BUF               PICK UP NUMBER OF BUFFERS
         MW,R5    TBUFSIZ           X PAGE SIZE OF EACH BUFFER
         M:GP     *R5               AND GET THAT MANY PAGES
         BCS,8    ABORTI            NOT ENUF
         LW,R7    BUF               NUMBER OF BUFFERS
         LW,R5    TBUFSIZ           SIZE OF EACH TAPE BUFFER
         SLS,R5   9                 SIZE IN WORDS
         STW,9    BUF,7             WA(TBUF)
         AW,R9    R5                BUMP TO BEGINNING OF NEXT BUFFER
         BDR,7    %-2
         SLS,R5   2                 BYTE SIZE OF BUFFER
         STW,R5   TBUFSZ            BUFFER SIZE FOR END ACTION ROUTINE
         M:GP     #PAGES            GET DATA BUFFER'S PAGES
         AI,8     0                 GET ANY
         BEZ      ABORTI            NONE AVAILABLE
         STW,8    PAGES             NUMBER GOTTEN
         SLS,8    11                DATA BUFFER BYTE SIZE
         STW,8    DBUFSIZ
         STW,9    DBUF              WORD ADDRESS OF DATA BUFFER
         LI,15    0
         STW,15   XPAGES            ZAP
         STW,15   RATE
         STW,15   CAUTION           START OUT IN NORMAL MODE
         STW,15   TAPECNT           COUNT OF TAPES MOUNTED
         LI,12    EAREAD            CONVERT ADDRESS
         AND,12   M9                TO DISPLACEMENT
         LI,1     1                 WITHIN
         STH,12   EAREAD+3,1        PAGE
         DO       TAURUS=1
         LW,R2    EAADDR            VIRTUAL WORD ADR OF ENDACTION PAGE
         AW,R2    12                R2= SAME DISP AS IN EASECT
         LI,R8    PTCHEND-EAREAD    SIZE OF ENDACTION ROUTINE
         LI,R3    EAREAD
         LW,R15   0,R3              MOVE ENDACTION ROUTINE TO
         STW,R15  0,R2              PAGE WE KNOW IS LESS THAN 128K
         AD,R2    DOUBLEONE         FOR TARUS
         BDR,R8   %-3
         FIN
         B        *0
ABORTI   EQU      %
         M:PRINT  (MESS,NOPAGES)
         M:EXIT
ABORTJ   EQU      %                 FRES LOADED WITH WRONG MONSTK
         M:PRINT  (MESS,BADMON)
         BAL,15   ABORTX
ABORTK   EQU      %                 USER DOESN'T HAVE C0
         M:PRINT  (MESS,NOPRIV)
         BAL,15   ABORTX
         PAGE
*F*      NAME:    CCI
*F*      PURPOSE: PROCESS CONTROL CARDS
*F*      DESCRIPTION: THIS ROUTINE IS RESPONSIBLE FOR READING
*F*               CONTROL CARDS, INTERPRETING THEM AND SETTING
*F*               THE APPROPRIATE FLAGS.
CCI      EQU      %                 PROCESS +START  +SKIP  +END
         DO1      CPV
         CAL1,1   PROMPT            SET PROMPT TO NOT PROMPT
         LC       J:JIT             IF ON-LINE OR GHOST
         BCS,12   CCI01             DON'T READ ! CARD
         M:READ   M:C,(ERR,CCIX),(ABN,CCIX),(BUF,CCBUF),(SIZE,80)
,CCFPT1  M:WRITE  M:LL,(BUF,CCBUF),(SIZE,80)
         B        CCI1
CCI01    EQU      %
         M:TYPE   (MESS,HIYALL)     GREET THEM
CCI02    EQU      %
CCI1     EQU      %
         LW,1     MBSWRD            CLEAR INPUT BUFFER
         MBS,0    BA(DATMESS)+1
,CCFPT2  M:READ   M:SI,(ERR,CCIX),(ABN,CCIX),(BUF,CCBUF),(SIZE,80)
         LC       J:JIT             DON'T ECHO IF
         BCS,12   CCI11             NOT BATCH
         CAL1,1   CCFPT1            PRINT CC
CCI11    LW,15    CCBUF             1ST WORD OF CC
         CW,15    CCEND             +END
         BE       CCIR              YES - RETURN
         CW,15    CCVOL             +VOL
         BE       CCI4              YES
         CW,15    CCDEV             DEVICE TYPE OF RESTORE TAPE
         BE       CCI4
         CW,R15   CCPACK            RESTORE TO PRIVATE PACK
         BNE      %+3
         MTW,1    PACK              SET PRIVATE PACK FLAG
         B        CCI4
         CW,15    CCSTART           +STA = +START
         BE       CCI3              YEP-DATA CARD FOLLOWS
         CW,15    CCSEL             +SEL = +SELECT
         BE       CCI5              YES - DATA CARDS FOLLOW
         CW,15    CCSKIP            +SKI = +SKIP
         BE       CCI2
         CW,15    CCNEW             NEW FILE CREATION DATE
         BNE      CCI11A
         LI,R1    1
         LI,R15   X'FF'
         STB,R15  VLPTAB2,R1        DONT FIND CREATION DATE
         B        CCI02             PROCESS NEXT CC
CCI11A   EQU      %
         CW,15    CCCHEK            VERIFY TAPES
         BNE      CCIX              NOT A CC = ERROR
         MTW,1    FCHEK             SET TAPE CHECK FLAG
         B        CCI02             PROCESS NEXT CC
CCI2     EQU      %                 PROCESS +SKIP DATA CARDS
         BAL,R12  RDDATA
         LC       J:JIT
         BCS,12   %+2               DON'T ECHO INPUT IF ONLINE OR GHOST
         CAL1,1   CCFPT1            PRINT CARD FOR BATCH GUY
         LB,15    CCBUF             1ST CHARACTER OF DATA CARD
         CI,15    '+'               IS IT A CC
         BE       CCI21             YES-NO MORE DATA CARDS
         LD,12    CCBUF             ACCOUNT FROM DATA CARD
         LW,7     SKIP              # OF DATA CARDS PREVIOSLY PROCESSED
         AI,7     1
         CI,7     #SKIP             ANY MORE ROOM
         BG       CCIX              NOPE-ABORT RUN
         STD,12   SKIP,7            PUT ACCT INTO TABLE
         STW,7    SKIP              SAVE #
         B        CCI2              AND PROCESS NEXT DATA CARD
CCI21    MTW,0    SKIP              WERE THERE ANY DATA CARDS
         BE       CCIX              NO-ABORT RUN
         B        CCI11             YES-PROCESS CC
CCI3     EQU      %                 PROCESS +START DATA CARD
         BAL,R12  RDDATA
         LC       J:JIT
         BCS,12   %+2               DON'T ECHO INPUT IF ONLINE OR GHOST
         CAL1,1   CCFPT1            PRINT CARD FOR BATCH GUY
         LB,15    CCBUF             1ST CHARACTER OF DATA CARD
         CI,15    '+'               IS IT CC
         BE       CCIX              YEP-NO DATA CARD-ABORT RUN
         LD,12    CCBUF             PICK UP START ACCT
         STW,12   STACCT            PUT IN
         STW,13   STACCT+1          SLOT RESERVED
         LI,7     0                 INDEX
         LI,6     1                 INDEX
CCI31    LB,15    CCBUF+3,6         MOVE START FILE
         CI,15    ' '               ONE BYTE AT
         BLE      CCI02             A
         STB,15   STFILE,7          TIME
         AI,7     1                 BUMP INDEX
         CI,7     31                MAX
         BE       CCI02             UH HUH
         AI,6     1                 BUMP INDEX
         B        CCI31             UH UH
CCI4     EQU      %                 PROCESS +VOL DATA CARD
         BAL,R12  RDDATA
         LC       J:JIT
         BCS,12   %+2               DON'T ECHO INPUT IF ONLINE OR GHOST
         CAL1,1   CCFPT1            PRINT CARD FOR BATCH GUY
         LW,7     CCBUF             SN FROM DATA CARD
         CW,R15   CCPACK            ARE WE PROCESSING +PACK DATA
         BNE      CCI402            NO - GOT TO BE +VOL DATA
         STW,7    PPFPTSN+1         SAVE PACK SN IN DUMMY FPT
         B        CCI02             PROCESS NEXT CONT CARD
CCI402   EQU      %
         CW,15    CCDEV             CHECK FOR DEVICE COMMAND
         BNE      CCI403            GOT TO BE +VOL
         SLS,7    -16
         STW,7    OPTPFPT+3         STICK DEV TYPE IN FPT
         B        CCI02             PROCESS NEXT COMMAND
CCI403   EQU      %
         STW,7    OPTPFPT+5
         STW,7    TXT:PRG1+1
         SLS,7    -8                GET 2ND AND 3RD CHARS.
         INT,7    7                     OF SN
         CI,7     'RG'              IS SN FPURGE TYPE
         BE       CCI02             YES-DO NOT SET FILL FLAG
         STW,7    FILL              NO-FILL SN
         B        CCI02             PROCESS NEXT CC
CCI5     EQU      %                 PROCESS +SELECT DATA CARDS
         LW,7     SELECT            +SELECT ALREADY PROCESSED
         BNEZ     CCIX              YES - ILLEGAL
         STW,15   SELECT            SET SWITCH FOR +SELECT
,SOFPT1  M:OPEN   M:SO,(FILE,'DATACARDSID'),(OUT),(SAVE),(DIRECT),;
         (KEYED),(KEYM,31)
CCI51    LI,7     '  '              BLANK OUT FILE NAME
         STH,7    SELBUF+3          IN BUFFER
         BAL,R12  RDDATA
         LC       J:JIT
         BCS,12   %+2               DON'T ECHO INPUT IF ONLINE OR GHOST
         CAL1,1   CCFPT1            PRINT CARD FOR BATCH GUY
         LB,7     CCBUF             1ST CHAR. OF DATA CARD
         CI,7     '+'               IS IT A CC
         BE       CCI6              YEP - NO MORE DATA CARDS
         LI,4     BA(CCBUF)         SOURCE
         LW,5     SELBUFC+1         COUNT,DESTINATION
         MBS,4    0                 MOVE ACCOUNT # TO KEY BUF
         LI,7     31-8              MAX FILE NAME ALLOWED
         LI,4     1                 INDEX
CCI52    LB,5     CCBUF+3,4         GET A BYTE OF FILE NAME
         CI,5     ' '               IS IT NON BLANK
         BLE      CCI53             IS DELIMITER...(OR NEW LINE)
         STB,5    SELKEY+2,4        MOVING NAME TO KEY BUF
         AI,4     1                 BUMP INDEX
         BDR,7    CCI52             KEEP ON MOVIN'
CCI53    AI,4     -1                TEXTC COUNT OF NAME
         STB,4    CCBUF+3
         AI,4     8                 TEXTC COUNT OF KEY
         STB,4    SELKEY
         M:WRITE  M:SO,(BUF,CCBUF),(SIZE,80),(KEY,SELKEY),;
                  (ONEWKEY),(WAIT)
         B        CCI51             GET NEXT DATA CARD
CCI6     EQU      %                 NO MORE +SELECT DATA CARDS
         M:CLOSE  M:SO,(SAVE)
         B        CCI11             PROCESS CONTROL CARD
CCI7     EQU      %                 ERR/ABN READING 1ST SELECT CARD
         M:PRINT  (MESS,SELMESS)    SOMETHING AWFUL JUST HAPPENED
         M:SNAP   'SBUF',(SELBUF,SELBUF+19)
         LI,7     0                 ZAP FLAG SO THAT
         STW,7    SELECT            FILE WILL REMAIN
         B        EXIT              QUIT
CCIR     EQU      %                 NO MORE CC'S - RETURN
         LW,15    SELECT            RESTORE SELECTIVE
         BEZ      *0                NO - CAN RETURN NOW
,SOFPT2  M:OPEN   M:SO,(FILE,'DATACARDSID'),(INOUT),(SAVE),(SEQUEN),;
         (BUF,SELBUF),(RECL,80)
         M:READ   M:SO,(ERR,CCI7),(ABN,CCI7)
         B        *0
CCIX     EQU      %                 ERROR READING CC'S
         M:PRINT  (MESS,CCMESS)
         M:SNAP   'CCBF',(CCBUF,CCBUF+19)
         B        EXIT
         PAGE
ABORT    EQU      %
         M:PRINT  (MESS,SEER15)
         B        ABORTX
ABORTX   EQU      %                 SEE R15 FOR LOCATION
         M:SNAP   'CR15',(DBUF,LASTACCT)
         B        EXIT
RDDATA   EQU      %                 READ DATA CARD ROUTINE
         LW,1     MBSWRD            CLEAR INPUT BUFFER
         MBS,0    BA(DATMESS)+1
         CAL1,1   CCFPT2            READ M:SI
         LW,R1    M:SI+4            REC SIZE
         SLS,R1   -17
         AI,1     -1
         LB,R7    CCBUF,R1          LAST INPUT CHAR
         CI,R7    X'0D'             CR
         BE       %+3
         CI,R7    X'15'             LF
         BNE      *R12
         LI,R7    X'40'
         STB,R7   CCBUF,R1          OVERWRITE WITH BLANK
         B        *12
MBSWRD   GEN,8,24 80,BA(SELBUF)
         PAGE
SKP:BOF  EQU      %
         LCI      2
         PSM,0    STACK
SKP:BOF1 EQU      %
         LW,7     *CURBUF+1         1ST WORD
         CW,7     TXT:BOF           :BOF
         BE       RTN:BOF           YES - SKIP RETURN
         CW,7     TXT:EOV           :EOV
         BE       RTN:EOV           YES - NON-SKIP RETURN
         CW,7     TXT:EOR           :EOR
         BE       RTN:EOR           YES - NON-SKIP RETURN
         BAL,0    SKPTMK            FIND EOF
         BAL,0    NEXTBUF
         B        SKP:BOF1          KEEP GOING
RTN:EOR  EQU      %
RTN:EOV  EQU      %
         LCI      2
         PLM,0    STACK
         B        *0
RTN:BOF  EQU      %
         LCI      2
         PLM,0    STACK
         AI,0     1                 SKIP RETURN
         B        *0
         PAGE
DODAT    EQU      %
         PSW,0    STACK
         BAL,0    NEXTBUF           TLABEL
         LW,7     *CURBUF+1         1ST WORD=0
         BNEZ     DODATR            NO-NOT DAT FILE-RETURN
         BAL,0    NEXTBUF           TAPE MARK FOLLOWS TLABEL
         LW,7     CURBUF            ORDINAL
         LB,7     TSTATUS,7         TYC
         CI,7     TMK               =EOD
         BNE      DODATR            NO-IMPOSSIBLE-BUT RETURN ANYHOW
         BAL,0    NEXTBUF           DATE RECORD BLOCK
         LW,7     CURBUF+1          ADDRESS OF BUFFER
         AI,7     3                 DISP. TO DATA
         LCI      4                 MOVE DATE
         LM,8     *7                FROM DATA
         STM,8    DATMESS+5         TO MESSAGE
         M:TYPE   (MESS,DATMESS)    AND SPIT IT OUT
DODATR   PLW,0    STACK
         B        QTAP              RETURN VIA QTAP
         PAGE
*F*      NAME:    GOT1
*F*      PURPOSE: OPEN DISK FILE CORRESPONDING TO FILE ON TAPE
*F*      DESCRIPTION: THIS ROUTINE TRANSFERS VLP INFORMATION
*F*               FROM THE :BOF RECORD AND TLABEL RECORDS ON
*F*               TAPE TO THE FPT USED TO OPEN THE DISK FILE.
*F*               THE ROUTINE CHECKIT IS CALLED TO DETERMINE
*F*               IF THE FILE SHOULD BE RESTORED.
GOT1     EQU      %
         LCI      7                 1 EXTRA
         PSM,0    STACK
         LI,15    0
         STW,15   RWS               ZAP
         MTW,0    SYNFLG            WAS LAST FILE SYNON
         BE       GOT1X             NO
         STW,15   SYNFLG            RESET FLAG
         LI,1     2                 MODE =
         STW,1    FPTMODE           OUT
         LI,1     -X'801'           RESET SYNON FILE
         AND,1    OPNFLFPT+1        FLAG IN PP
         STW,1    OPNFLFPT+1        WORD OF FPT
GOT1X    EQU      %
         MTW,0    XPAGES            ANY PAGES TO FREE
         BE       GOT1A             NOPE
         DO       CPV
         M:FP     *XPAGES           YEP-
         ELSE
         LW,0     XPAGES            GET # OF PAGES
         LI,1     X'1FFFF'
         STS,0    FPTFP             STUF # OF PAGES
,FPTFP   M:FP     0
         FIN
         LW,14    XPAGES            CONVERT TO
         SLS,14   11                BYTES
         LCW,13   14                SUBTRACT FROM
         AWM,13   DBUFSIZ           BUFFER SIZE
         STW,15   XPAGES            AND ZAP
GOT1A    EQU      %
         LW,4     PAGES
         SLS,4    -1                1/2 # BUFFER PAGES
         SLS,4    9                 # WORDS IN HALF OF BUFFER
         LW,5     DBUF              ADDRESS OF START OF BUFFER
         STW,5    BUFR1
         STW,5    BUFR2
         AWM,4    BUFR2
         SLS,4    2
         STW,4    BUFRSIZ           # BYTES IN EACH BUFFER
         LW,4     CURBUF+1          WA(BUF)
         AI,4     1                 BUMP TO VLP
         SLS,4    2                 MAKE IT BYTE ADDRESS
         STW,4    TEMP              SAVE
         LI,5     BA(FPTVLP)
         MTW,0    PACK              RESTORE TO PRIVATE PACK
         BE       GOT1A1            NO
         LI,6     7                 VLP CODE
         LI,4     BA(PPFPTSN)       SN FROM +PACK DATA CARD
         BAL,0    GETVLP            GET SN FROM DUMMY FPT
         BAL,R15  ABORT             ERROR - NO SN
         LW,4     TEMP
GOT1A1   EQU      %
         LW,6     FILL              FILL OR FPURGE
         BNEZ     GOT1F             FILL - RETURNS AT GOT1B2
         LB,1     VLPTAB            LENGTH OF TABLE OF CODES
GOT1B    EQU      %
         LB,6     VLPTAB,1          PICK UP CODE
         BAL,0    GETVLP
         BAL,2    GOT1D             NOT FOUND - MOVE DUMMY
GOT1B1   LW,4     TEMP
         BDR,1    GOT1B             ENTRY MOVED-DO NEXT ONE
         LI,6     X'0B'             CODE FOR SYNON FILE
         BAL,0    GETVLP            FIND AND MOVE-IF PRESENT
         B        %+2               NOT PRESENT-NOT SYNON
         MTW,1    SYNFLG            SET FLAG FOR SYNON FILE
         LW,4     TEMP
         SLS,5    -2                WORD ADDRESS NEXT AVAILABLE
         LI,3     X'10002'          FAKE LAST VLP ENTRY
         STW,3    *5                LAST ENTRY JUST IN CASE
GOT1B2   EQU      %
         LI,5     BA(VLP09)         SPECIAL PLACE FOR 09 ENTRY
         LI,6     09                CODE
         BAL,0    GETVLP            FIND AND MOVE 09 ENTRY
         B        GOT1E             TROUBLE
         LW,5     VLP09+1           PICK UP 09 ENTRY
         LB,4     5                 R5=ORG,KEYM,VOL,HDL
         STW,4    ORG
         SLS,5    8                 R5=KEYM,VOL,HDL,0
         LB,4     5
         STW,4    KEYM
         B        %+5               ***REMOVE WHEN FSAVE FIXED***
         SLS,5    8                 R5=VOL,HDL,0,0
         LB,4     5                 VOL
         CI,4     1                 =1
         BNE      GOT1C             NOPE...FORGET THIS FILE
         BAL,0    NEXTBUF           POINT AT TLABEL
         DO       CPV
         LI,15    X'10000'          NULL DEVICE
         STW,15   DEVICE            DEVICE=RAD OR PACK
         ELSE
         LI,1     X'18000'
         STW,1    DEVICE            STICK INTO FPT
         FIN
         LW,1     FILL              FILL OR FPURGE
         BNEZ     GOT1G             FILL - RETURNS AT GOT1B3
GOT1B3   EQU      %
         BAL,0    ACCTOJIT          MOVE ACCT TO JIT
         LB,5     0,4               ORG FROM TLABEL (R4 POINTS THERE)
         MTW,0    FILL              FILL OR FPURGE
         BEZ      %+3               FPURGE
         CI,5     X'F0'             FILL FILE
         BGE      GOT1C             YES-SKIP IT
         CI,5     3                 RANDOM
         BNE      OPNFL             NO-READY TO OPEN
         STW,5    ORG               CORRECT ORG TO RANDOM
         LI,1     X'FF00'           MASK
         LS,1     *CURBUF+1,5       DEVICE FROM TLABEL (R5=3)
         CI,1     X'700'            IS IT RAD
         BNE      %+2               NOPE
         LI,1     0                 YEP-BETTER ALLOW PACK IF NO RAD
         AI,1     X'18000'          DEVICE MASK
         STW,1    DEVICE            STICK INTO FPT
         LI,5     4
         LW,1     *CURBUF+1,5       RSTORE FROM TLABEL
         SLS,1    -8                SHIFT OFF GARBAGE
         STW,1    RSTORE            STICK INTO FPT
         LW,1     DBUF              WA(DBUF)
         SLS,1    2                 BA(DBUF)   RESET
         STW,1    DBUFLOC           FOR RANDOM MOVES
OPNFL    EQU      %                 OPEN THE FILE
         BAL,0    CHECKIT           IFF IT PASSES CHECKS
         B        GOT1C             IT NO PASSES-SKIP IT
         LW,1     PFLAG             PAGE HEADING FLAG SET
         BEZ      NOPAGE            3/8/74
         MTW,0    FCHEK
         BNEZ     OPNFL01
         M:DEVICE M:LL,(PAGE)
OPNFL01  EQU      %
         M:PRINT  (MESS,ACCTMESS)
         LI,1     0                 ZAP
         STW,1    PFLAG             PAGE HEADING FLAG
NOPAGE   EQU      %
         MTW,0    SYNFLG            SYNON FILE FLAG SET
         BE       OPNFL1            NO-NOT A SYNON FILE
         LI,1     4                 MODE =
         STW,1    FPTMODE           UPDATE
         LI,1     X'800'            FLAG FOR SYNON FILE
         OR,1     OPNFLFPT+1        SET IT IN
         STW,1    OPNFLFPT+1        IN PP WORD OF FPT
OPNFL1   EQU      %
         MTW,0    FCHEK
         BNEZ     OPNFL2
         LW,R15   ORG
         CI,R15   3                 RANDOM FILE
         BNE      OPNFL1B           NO
         CAL1,1   OPNFLFPT          OPEN OUT
*        CHECK TO SEE IF RSTORE ON DISK BIG ENOUGH FOR RESTORE
         LI,R15   X'FFFF'
         AND,R15  M:EO+20           RSTORE FROM DCB
         LH,R1    M:EO+5            EXTENSION FIELD
         CI,R1    X'0800'           EXTENSION FLAG SET
         BAZ      NOEXT
         AND,R1   M8                KEEP EXT
         STH,R1   R15
NOEXT    CW,R15   RSTORE            DISK FILE BIG ENOUGH
         BGE      OPNFL2            YES - GO
         M:CLOSE  M:EO,(REL)        CLOSE AND RELEASE
OPNFL1A  EQU      %
OPNFL1B  EQU      %
         CAL1,1   OPNFLFPT          M:OPEN M:EO, ETC.
OPNFL2   EQU      %
         LCI      7                 1 EXTRA
         PLM,0    STACK
         AI,0     1                 SKIP RETURN IF OPEN OKAY
         B        QTAP              RETURN VIA QTAP
FERR     EQU      %
FABN     EQU      %
         LB,R15   10
         CI,R15   X'16'             CHECK FOR DUPLICATE KEY
         BE       *8                YES - KEEP ON GOING
         CI,R15   3                 CHECK FILE NOT FOUND
         BNE      FABN1             NO
         LW,R15   ORG               CHECK FOR RANDOM FILE
         CI,R15   3
         BE       OPNFL1A           YES - CREATE RANDOM FILE
         MTW,0    SYNFLG
         BE       FABN1
         M:PRINT  (MESS,MESSYN)     PARENT FILE MISSING
         B        FABN2             DONT DUMP
FABN1    EQU      %
         M:PRINT  (MESS,FERRM)
         M:PRINT  (MESS,LASTFILE+1) PRINT FILE NAME
         LW,11    CURBUF+1          FWA
         LW,R12   TBUFSIZ
         SLS,R12  9                 WORD SIZE OF BUFFER
         AI,R12   -1
         AW,12    11                LWA
         M:SNAP   'TBUF',(*11,*12)
         M:SNAP   'DATA',(DBUF,MYACCT+1)
         M:SNAP   'OFPT',(OPNFLFPT,FPTVLP+89)
         M:SNAP   'M:EO ',(M:EO,M:EO+X'61')
FABN2    EQU      %
         MTW,1    FILESKIP          BUMP TOTAL FILES SKIPPED
GOT1C    EQU      %                 NON-SKIPPING RETURN
         LCI      7                 1 EXTRA
         PLM,0    STACK
         B        QTAP              RETURN VIA QTAP
GOT1D    EQU      %                 MOVE DUMMY VLP ENTRY
         LI,4     BA(DUMFPT)        SOURCE
         BAL,0    GETVLP
         B        GOT1E             NOT-FOUND    TROUBLE
         B        *2                  OKAY - CONTINUE
GOT1E    M:PRINT  (MESS,MESS09)
         BAL,0    NEXTBUF           DONT KEEP LOOKING AT SAME THING
         B        FABN1             DUMP AND GO TO NEXT FILE
GOT1F    EQU      %                 MOVE VLP'S FROM :BOF TO FPT
         LB,1     VLPTAB1           # OF ENTRIES IN :BOF
         LB,6     VLPTAB1,1         VLP CODE
         BAL,0    GETVLP
         BAL,2    GOT1D             NOT FOUND - MOVE DUMMY
         LW,4     TEMP
         BDR,1    GOT1F+1           ENTRY MOVED - GET NEXT ONE
         STW,5    TEMP              SAVE BA(FPTVLP) NEXT AVAILABLE
         B        GOT1B2            GO BACK TO THE OLD PATH
GOT1G    EQU      %                 MOVE VLP'S FROM TLABEL TO FPT
         LW,4     CURBUF+1          WA(TBUF)
         SLS,4    2                 BA(TBUF)
         AI,4     11                DISP TO FILE ORG
         LB,5     0,4               CHECK IF INVALID ORG
         CI,5     3
         BG       GOT1C             SKIP SPECIAL FILL FILE
         AI,4     16                BA(VLP'S IN TLABEL
         LW,5     TEMP              BA(FPTVLP) NEXT AVAILABLE
         STW,4    TEMP
GOT1G1   EQU      %                 NOW READY TO MOVE 'EM
         LB,1     VLPTAB2           # OF ENTRIES IN TLABEL
         LB,6     VLPTAB2,1         VLP CODE
         BAL,0    GETVLP
         B        %+2               MOVE DUMMY
         B        GOT1G20           GOT IT
         CI,R6    X'FF'             MOVE DUMMY DATES IF +NEWFILE
         BNE      GOT1G10
         LI,R6    X'0A'             DUMMY FOR MODIFICATION DATE
GOT1G10  EQU      %
         BAL,2    GOT1D             NOT FOUND - MOVE DUMMY
GOT1G20  EQU      %
         LW,4     TEMP
         BDR,1    GOT1G1+1          ENTRY MOVED - GET NEXT ONE
         LI,6     X'0B'             CODE FOR SYNON FILE
         BAL,0    GETVLP            FIND AND MOVE - IF PRESENT
         B        %+2               NOT PRESENT - FILE NOT SYNON
         MTW,1    SYNFLG            SET FLAG FOR SYNON FILE
         LW,4     TEMP
         LI,6     X'11'
         LI,R2    1
         LB,R0    VLPTAB2,2         CHECK FOR NEW FILE
         CI,R0    X'FF'
         BE       %+2               DON'T MOVE DESC IF NEWFILE
         BAL,0    GETVLP
         BAL,2    GOT1D
         SLS,5    -2                WORD ADDRESS NEXT AVAILABLE
         LI,3     X'10002'          FAKE LAST VLP
         STW,3    *5                LAST ENTRY JUST IN CASE
         B        GOT1B3            GO BACK TO OLD PATH
         BOUND    4
VLPTAB   DATA,1   10,X'11',X'10',X'0F',X'0E',X'0A',04,06,05,03,01
         BOUND    4
VLP      COM,8,24 AF(1),0
DUMFPT   EQU      %                 DUMMY FPT ENTRIES
         VLP      3                 PASSWORD
         VLP      4                 EXPIRES
         VLP      5                 READ
         VLP      6                 WRITE
         VLP      X'A'              MODIFY
         VLP      X'E'              CREATE
         VLP      X'F'              LAST ACCESSED
         VLP      X'10'             BACK UP
         VLP      X'11'             DESCRIPTORS
         VLP      X'14'             EXECUTE
         VLP      X'15'             ACCESS ACCOUNT
         PAGE
*F*      NAME:    CHECKIT
*F*      PURPOSE: CHECK FILE BEFORE OPENING.
*F*      DESCRIPTION: THIS ROUTINE DETERMINES IF THE CURRENT
*F*               FILE ON TAPE SHOULD BE RESTORED OR SKIPPED.
CHECKIT  EQU      %                 CHECK FILE BEFORE OPENING
         MTW,0    STACCT            START ACCT/FILE SET
         BE       CHECKIT2          NO-CHECK IF SKIP SET
         LI,4     BA(LASTACCT)+3    SOURCE-DON'T COMPARE LEADING BLANKS
         LW,5     STACCT-1          COUNT, DESTINATION
         CBS,4    0                 ARE WE AT START YET
         BL       *0                NOT YET-RETURN TO BAL+1
         BG       CHECKIT1          PAST START-ZAP 'EM
*  AT STARTING ACCT-SEE IF STARTING FILE SPECIFIED
         MTW,0    STFILE            START FILE SET
         BE       CHECKIT1          NO-ZAP 'EM
         LI,4     BA(LASTFILE+1)+1 SOURCE-SKIP TEXTC COUNT
         LI,5     BA(STFILE)        DESTINATION
         LB,7     LASTFILE+1        COUNT
         STB,7    5
         CBS,4    0                 ARE WE AT START YET
         BL       *0                NOT YET-RETURN TO BAL+1
CHECKIT1 EQU      %                 AT OR PAST START ACCT/FILE
         LI,7     0
         STW,7    STACCT
         STW,7    STFILE            ZAP 'EM
CHECKIT2 EQU      %                 CHECK FOR +SKIP
         LW,7     SKIP              ANY ACCTS TO SKIP
         BE       CHECKIT3          NOPE-RETURN TO BAL+2
*  +SKIP SET-SEE IF THIS IS ONE OF THEM.
         LCI      3
         LM,11    LASTACCT          PICK UP
         SLD,12   -8                LAST ACCOUNT
         STB,11   12                INTO R12,R13
         CD,12    SKIP,7            COMPARE WITH SKIP ACCTS
         BE       *0                RETURN TO BAL+1 IF MATCH
         BDR,7    %-2               NO MATCH-KEEP CHECKING
CHECKIT3 EQU      %                 NO MATCH.
         MTW,0    SYNFLG            NO DATE IN TLABEL FOR SYNON.
         BNE      CHECKIT4-2        SYNON.   SKIP SEQUENCE TEST
         LW,4     CURBUF+1          WA(TLABEL)
         SLS,4    2                 BA(TLABEL)
         AI,4     19                SOURCE=DATE IN TLABEL
         LW,5     SAVDATE+2         COUNT,DEST.
         MTW,0    SAVDATE           FIRST TIME IF ZERO
         BNE      %+3               NOT FIRST TIME..COMPARE 'EM
         MBS,4    0                 FIRST TIME...MOVE DATE
         B        CHECKIT3A         AND RETURN
         DO       CPV
         CBS,4    0                 TLABEL DATE VS. SAVDATE
*
         BL       CHECKIT5          TROUBLE IF GOING BACKWARDS
         FIN
*
*  CP-V ADD-ON CODE FOR RESTORE SELECTIVE..
CHECKIT3A EQU     %
         LW,7     SELECT            RESTORE SELECTIVE
         BEZ      CHECKIT5-2        NOPE-FILE OKAY
CHECKIT4 LI,4     BA(LASTACCT)+3    SOURCE
         LW,5     SELBUFC           COUNT,DESTINATION
         CBS,4    0                 HOW ABOUT IT
         BL       *0                SKIP FILE IF LESS
         BG       CHECKIT7          READ NEXT SELECT CARD
*  ACCOUNTS MATCH - CHECK FILE NAMES
         MTW,1    ANY               SHOW AT LEAST 1 ACCOUNT MATCH
         LB,7     SELBUF+3          TEXTC COUNT FROM CARD
         BEZ      CHECKIT5-2        ZERO IF NO FILE SPECIFIED
         MTW,-1   ANY               FILE SPECIFIED - ZAP MATCH FLAG
         CB,7     LASTFILE+1        IF COUNT ON TAPE FILE LESS
         BLE      %+2
         LB,7     LASTFILE+1        USE IT FOR COMPARE
         LI,4     BA(LASTFILE+1)+1  SOURCE-EXCLUDE COUNT
         LI,5     BA(SELBUF+3)+1    DESTINATION-EXCLUDE COUNT
         STB,7    5                 COUNT
         CBS,4    0                 HOW ABOUT IT
         BL       *0                SKIP FILE IF LESS
         BG       CHECKIT7+3        READ NEXT SELECT CARD WITHOUT ZAPPING
*                                   STRING MATCHES - NOW MAKE SURE
*                                   LENGTHS ARE THE SAME
         LB,7     SELBUF+3          FILE NAME COUNT ON CARD
         CB,7     LASTFILE+1        MATCH FILE NAME COUNT IN BUFFER
         BG       *0                SKIP FILE IF CARD IS HIGH
         BL       CHECKIT7+3        READ NEXT SEL CARD WITHOUT ZAPPING
*  ACCOUNT AND NAME MATCH
         M:DELREC M:SO              ZAP THE SELECT CARD
         LI,7     0                 ZAP
         STW,7    ANY               COUNTER
         M:READ   M:SO,(ERR,CHECKIT6),(ABN,CHECKIT6)
         AI,0     1                 BUMP RETURN REGISTER
         B        *0                RETURN TO BAL+2
CHECKIT5 EQU      %                 FILE SEQUENCE ERROR
         M:PRINT  (MESS,FSERR)
         LW,11    CURBUF+1          FWA
         LI,12    6
         AW,12    11                LWA
         M:SNAP   'TLAB',(*11,*12)
         M:SNAP   'DATA',(DBUF,TXT:PRG1+1)
         B        EXIT
*  ERROR/ABNORMAL READING SELECT CARD - PROBABLY FINISHED
*  GET HERE AFTER MATCH FROM LAST CARD
CHECKIT6 EQU      %
         LI,7     6                 CODE FOR EOD
         CB,7     10                IS THAT WHAT IT ARE
         BNE      %+3               NOPE
         STW,7    SELECT+1          YUP-SET A FLAG
         B        *8                AND CONTINUE
         M:PRINT  (MESS,SELMESS)    SOMETHING BAD JUST HAPPENED
         M:SNAP   'SBUF',(SELBUF,SELBUF+19)
         LI,7     0                 ZAP FLAG SO THAT
         STW,7    SELECT            FILE WILL REMAIN
         B        EXIT              LET'S QUIT
*  PASSED ACCOUNT/FILE ON SELECT CARD-READ NEXT CARD
CHECKIT7 EQU      %
         LW,7     ANY               ANY MATCH ON THIS CARD
         BEZ      %+4               NO-DON'T ZAP IT
         M:DELREC M:SO              YES-ZAP SELECT CARD
         LI,7     0                 ZAP
         STW,7    ANY               COUNTER
         M:READ   M:SO,(ERR,CHECKIT8),(ABN,CHECKIT8)
         B        CHECKIT4          AND LOOP BACK
*  ERROR/ABNORMAL READING SELECT CARD - PROBABLY FINISHED
*  GET HERE BECAUSE PASSED ACCOUNT/FILE ON LAST CARD
CHECKIT8 EQU      %
         LW,8     0                 SET RETURN TO BAL+1
         B        CHECKIT6
         PAGE
ACCTOJIT EQU      %                 CURBUF POINTS TO TLABEL
         LW,4     CURBUF+1          WA(TBUF)
         SLS,4    2                 BA(TBUF)=SOURCE
         AI,4     3                 ONLY MOVE 8 BYTES TO JIT
         LI,5     BA(LASTACCT)+3    DESTINATION
         OR,5     Y08               COUNT
         STW,4    2                 SAVE FOR 1ST MBS
         STW,5    3
         CBS,4    0                 COMPARE 'EM
         BNE      %+4               THEY NO MATCH-   MOVE 'EM
         LW,4     2
         AI,4     8                 POINT R4 TO BA(ORG)
         B        QTAP              RETURN VIA QTAP
         LW,4     2                 SAVE FOR 2ND MBS
         MBS,2    0                 MOVE TO LASTACCT
         STW,0    PFLAG             SET FLAG FOR PAGE HEADING
         DO       CPV
         LI,5     BA(J:ACCN)        DESTINATION IN JIT
         OR,5     Y08               COUNT
         LI,15    0                 ZAP J:FDDA IN JIT
         M:SYS                      MASTER MODE
         STW,15   J:FDDA            ZAP
         ELSE
         LW,5     X'4F'             GET JIT ADDRESS
         AND,5    X1FFFF            MASK OFF ADDR
         AI,5     1                 BUMP TO ACCOUNT ADDR
         SLS,5    2                 MAKE BYTE ADDR
         OR,5     Y08               COUNT
         FIN
         MBS,4    0                 MOVE ACCT TO JIT
         B        SLAVE             RETURN VIA SLAVE
         PAGE
SLAVE    EQU      %
         DO1      CPV
         LPSD,0   SLPSD             GO SLAVE
SLV:EXIT B        *0
         BOUND    8
SLPSD    GEN,10,22  3,SLV:EXIT      SLAVE AND MAPPED
         DATA     0
         PAGE
*  INPUT:   R4=BA(VLP)   R5=BA(FPT)   R6=VLP CODE
*  OUTPUT:  R5=BA(FPT) NEXT AVAILABLE
*  RETURN:  BAL+1 IF VLP ENTRY NOT PRESENT
*  RETURN:  BAL+2 IF VLP ENTRY FOUND AND MOVED
GETVLP   EQU      %
         CB,6     0,4               CODE MATCH
         BE       MOVVLP            YEP-MOVE ENTRY
         AI,4     1                 POINT TO LEI
         LB,7     0,4               LEI SET
         BNEZ     *0                YES-CODE NOT FOUND-RETURN TO BAL+1
         AI,4     2                 POINT TO LENGTH RESERVED
         LB,7     0,4               LENGTH IN WORDS
         SLS,7    2                 LENGTH IN BYTES
         AW,4     7                 BUMP TO
         AI,4     1                 NEXT ENTRY
         B        GETVLP            SEARCH ON
MOVVLP   EQU      %                 CODE FOUND - MOVE IT
         AI,4     3                 POINT TO WORDS RESERVED
         LB,3     0,4               LENGTH IN WORDS OF ENTRY
         CI,3     41                MAX ALLOWED
         BG       *0                ELSE RETURN TO BAL+1
         AI,4     -3                RESET POINTER
         AI,3     1                 LENGTH TO MOVE IN WORDS
         SLS,3    2                 LENGTH IN BYTES
         STB,3    5                 COUNT
         CI,6     1                 FNAME VLP ENTRY
         BNE      MOVVLP1           NO-JUST 1 MOVE REQ'D
         LI,13    BA(LASTFILE)      DEST. OF FNAME VLP ENTRY
         STB,3    13                COUNT
         STW,4    12                SOURCE
         MBS,12   0                 MOVE FNAME VLP ENTRY
MOVVLP1  EQU      %                 MOVE VLP ENTRY TO FPT
         MBS,4    0                 MOVE ENTRY TO FPT
         AI,0     1                 RETURN TO BAL+2
         B        QTAP              RETURN VIA QTAP
         PAGE
*F*      NAME:    BUILD
*F*      PURPOSE: TRANSFER DATA RECORDS FROM TAPE FILE TO DISK FILE.
*F*      DESCRIPTION: THIS ROUTINE WRITES RECORDS DIRECTLY FROM
*F*               THE TAPE DATA BLOCK TO DISK IF THE ORG IS
*F*               KEYED OR CONSEC AND IF THE DATA
*F*               IS BLOCKED IN A SINGLE TAPE BLOCK. WHEN DATA IS
*F*               CHAINED BETWEEN TWO OR MORE TAPE BLOCKS OR THE
*F*               FILE ORG IS RANDOM, RECORDS ARE MOVED TO A DATA
*F*               BUFFER AND THEN WRITTEN TO THE DISK FILE.
BUILD    EQU      %                 CURBUF POINTS TO TLABEL
         LCI      7
         PSM,0    STACK
BUILD:   BAL,0    NEXTBUF           POINT TO TAPE MARK AFTER :BOF,TLABEL
         LW,1     CURBUF            ORDINAL
         LB,7     TSTATUS,1
         CI,7     TMK               EOD
         BNE      BLDERR1           IT HAD BETTER BE
BUILD1   EQU      %                 NOW GO BUILD
         BAL,0    NEXTBUF           POINT TO FIRST (NEXT) BLOCK
         LW,1     CURBUF            ORDINAL
         LB,7     TSTATUS,1         TYC
         CI,7     TMK               TYC=TMK=EOD
         BE       BUILT             FILE DONE
         CI,7     1                 TYC=1=OKAY
         BE       %+3               OKAY
         CI,7     EOR               TYC=EOR=OKAY TOO
         BNE      BLDERR2           ERROR
         LI,2     1                 HALFWORD DISPLACEMENT
         LH,6     *CURBUF+1,2       GET NKEY
         BGZ      %+2               # OKAY
         B        BUILD1            # = 0     CHECK NEXT BLOCK
         LW,4     CURBUF+1          WA(TBUF)
         SLS,4    2                 BA(TBUF)
         AI,4     4                 INCREMENT TO 1ST KEY
NEWREC   BAL,0    QTAP              TRY TO READ AHEAD
         LW,2     KEYM              LENGTH RESERVED IN TBUF
         AI,2     1                 INCLUDES COUNT
         AW,2     MOD4              ROUND # OF BYTES
         AND,2    TRUNC             TO WORD BOUNDARY
         LW,3     4                 BA(RCW) IN TBUF
         AW,3     2
         LB,5     0,3               GET RC
         STW,5    RC                SAVE IT
         LW,15    ORG               CHECK FOR
         CI,15    3                 RANDOM FILES
         BE       RANDOM            HANDLE DIFFERENTLY
         CI,5     3                 MAX ALLOWED-BLOCKED SEG. NG
         BG       BLDERR3           BLOCKED=ERROR
         B        %+1,5
         B        RC0               0=LAST SEG OF N (1<N)
         B        RC1               1=COMPLETE RECORD
         B        RC2               2=MTH SEG OF N (1<M<N)
         B        RC3               3=1ST SEG OF N (1<N)
*  R3=BA(DATA)-4  R4=BA(KEY)  R5=RC=1  R6=NKEY
RC1      EQU      %                 COMPLETE RECORD IN TBUF
         SLS,4    -2                WA(KEY)
         AI,3     2                 POINT TO BA(RWS)
         SLS,3    -1                HA(RWS)
         LH,1     0,3               GET RWS
         AI,3     1                 HA(DATA)
         SLS,3    -1                WA(DATA)
         MTW,0    FCHEK
         BNEZ     RC10
         M:WRITE  M:EO,(ERR,DERR),(ABN,DABN),(BUF,*3),;
                  (SIZE,*1),(KEY,*4),(NEWKEY)
RC10     EQU      %
         LW,4     3                 WA(DATA)
         SLS,4    2                 BA(DATA)
UPDATE   AW,4     1                 +SIZE IN BYTES
         AW,4     MOD4              ROUND TO BYTES
         AND,4    TRUNC             WORD BOUNDARY
         BDR,6    NEWREC            HIT THE NEXT RECORD
         B        BUILD1            DONE-GET NEXT BLOCK
*  R2=KEYL IN TBUF  R3=BA(DATA)-4  R4=BA(KEY)  R5=RC=3  R6=NKEY
RC3      EQU      %                 1ST SEGMENT OF N (1<N)
         LI,5     BA(KBUF)          DESTINATION
         STB,2    5                 COUNT
         MBS,4    0                 MOVE KEY TO KBUF
         LW,5     DBUF              WA(DATA)
         SLS,5    2                 DESTINATION=BA(DATA)
MOFN     AI,3     2                 BA(RWS)
         SLS,3    -1                HA(RWS)
         LH,1     0,3               GET RWS
         STW,1    TEMP              SAVE
         LW,15    RWS               # OF BYTES ALREADY BLOCKED
         AW,15    TEMP              +RWS
         STW,15   RWS               ACCUMULATE TOTAL RECORD SIZE
         CW,15    DBUFSIZ           BUFFER BIG ENUF
         BLE      RWSOKAY           YEP
         SW,15    DBUFSIZ           CALCULATE HOW MANY NEEDED
         AI,15    2048
         SLS,15   -11               15 = # OF PAGES NEEDED
         M:GP     *15               ASK FOR EM
         BCS,8    TOOBIG            CANT GET EM-ABORT FILE
         AI,8     0                 GET ANY
         BE       TOOBIG            NOPE-TUF
         AWM,8    XPAGES            NUMBER GOTTEN
         SLS,8    11                CONVERT TO BYTES
         AWM,8    DBUFSIZ           BUMP
RWSOKAY  EQU      %                 R1=RWS OF THIS CHUNK
         AI,3     1                 HA(DATA)
         SLS,3    1                 BA(DATA)
         LW,4     3                 SOURCE
MOVEM    AI,1     -255              MAX COUNT=255
         BLEZ     %+4               COUNT<255  FINISH
         OR,5     TWO55             MOVE 255 BYTES
         MBS,4    0
         B        MOVEM             CONTINUE MOVE
         AI,1     255               COUNT REMAINING
         STB,1    5
         MBS,4    0                 MOVE THE REST
         STW,5    DBUFLOC           NEXT BYTE IN DBUF
         LW,7     RC                RC=0 IF LAST SEG-WRITE IT OUT
         BEZ      WRITEM
         B        BUILD1            GET NEXT BLOCK
WRITEM   EQU      %
         MTW,0    FCHEK
         BNEZ     RC100
,WMFPT   M:WRITE  M:EO,(ERR,DERR),(ABN,DABN),(BUF,*DBUF),;
                  (SIZE,*RWS),(KEY,KBUF),(NEWKEY)
RC100    EQU      %
         LI,15    0
         STW,15   RWS
         LW,1     TEMP              PICK UP RWS FOR NTH SEG
         LW,4     3                 TO R4
         B        UPDATE            SET UP FOR NEXT REC
*  R3=BA(DATA)-4  R4=BA(KEY)  R5=RC=2  R6=NKEY REMAINING
RC0      EQU      %                 NTH SEG OF N (1<N)
         LW,5     DBUFLOC           DESTINATION THIS SEG.
         B        MOFN              COMMON CODE
RC2      EQU      %                 MTH SEG OF N (1<M<N)
         CI,6     1                 MUST BE LAST SEG IN TBUF
         BNE      BLDERR3           OR ELSE ERROR
         LW,5     DBUFLOC           DESTINATION THIS SEG
         B        MOFN              COMMON CODE
BUILT    EQU      %                 AT TAPE MARK-:EOV OR :EOF MUST FOLLOW
         BAL,0    NEXTBUF
         LW,7     *CURBUF+1         GET FIRST WORD
         CW,7     TXT:EOV           IS IT :EOV
         BNE      BUILT0            NOPE
         BAL,0    OPNTAP            YEP-OPEN NEXT VOLUMN
         BAL,0    NEXTBUF           GET TO :LBL
         LD,12    TXT:PRG1          :LBLPRGX
         LW,14    FILL              FILL OR FPURGE FORMAT
         BNEZ     %+3               FILL
         LI,14    'P'               FPURGE...ACTUAL SN ALWAYS PRGX
         STB,14   13                MAKE IT PRGX
         CD,12    *CURBUF+1         FIRST 2 WORDS
         BNE      BADSN             NO MATCH=BAD SN ON TAPE
         BAL,0    SKP:BOF           FIND :BOF
         BAL,15   ABORT             :EOV OR :EOR BEFORE :BOF
         BAL,0    NEXTBUF           POINT AT TLABEL
         B        BUILD:            AND CONTINUE PROCESSING THIS FILE
BUILT0   EQU      %
         LW,7     ORG               CHECK FOR RANDOM
         CI,7     3
         BE       LAST1             IF RANDOM-1 MORE WRITE
BUILT1   EQU      %
         LCI      7
         PLM,0    STACK
         AI,0     1                 BUMP RETURN REGISTER
         B        QTAP              RETURN VIA QTAP
LAST1    EQU      %                 END OF RANDOM FILE-WRITE LAST CHUNK
         MTW,0    RWS               ANYTHING TO WRITE
         BE       BUILT1            NO-RETURN
         MTW,0    FCHEK
         BNEZ     LAST10
         M:WRITE  M:EO,(BUF,*BUFR1),(SIZE,*RWS),(ABN,DABN),(ERR,DERR)
LAST10   EQU      %
         B        BUILT1            AND RETURN
BLDERR1  M:PRINT  (MESS,BUILDMS1)
         B        BUILDERR          TELL IT LIKE IT IS
BLDERR2  EQU      %                 TYC BAD
         M:PRINT  (MESS,BUILDMS2)
         B        BUILDERR
*
*        BAD TAPE BLOCK FLAGS
*
BLDERR3  EQU      %
         LI,R15   FENDERMSG         ASSUME WE HIT A :BOF RECORD
         LW,14    *CURBUF+1         GET FIRST WORD OF THIS BUFFER
         CW,14    TXT:BOF           WAS :BOF SENTINEL FLAG..
         BE       %+2               YES-> PRIOR FILE ENDED WRONG
         LI,R15   BUILDMS3          NO--> JUST BAD TAPE BLOCK FLAGS
         CAL1,2   PRINT15           PRINT IT
         B        BUILDERR
BLDERR4  M:PRINT  (MESS,BUILDMS4)
         B        BUILDERR
BUILDERR EQU      %                 ERROR ON TAPE-SNAP BUFFER
         M:PRINT  (MESS,BUILDMS)
         M:PRINT  (MESS,LASTFILE+1) GIVE NAME OF BUM FILE
         LW,11    CURBUF+1          FWA
         LI,12    511
         AW,12    11                LWA
         M:SNAP   'TBUF',(*11,*12)
         MTW,1    FILESKIP          BUMP TOTAL FILES SKIPPED
         LCI      7
         PLM,0    STACK
         B        QTAP              RETURN VIA QTAP
TOOBIG   EQU      %                 RECORD TOO BIG
         M:PRINT  (MESS,2BIGM)
         M:PRINT  (MESS,LASTFILE+1)
         M:SNAP   '2BIG',(DBUF,LASTACCT)
         MTW,1    FILESKIP          BUMP TOTAL FILES SKIPPED
         LCI      7
         PLM,0    STACK
         B        QTAP              RETURN VIA QTAP
DERR     EQU      %
         LW,15    ORG               SKIP TEST
         CI,15    3                 IF RANDOM
         BE       DERR01
         LB,15    10                ERROR CODE
         CI,15    X'57'             DISK SATURATED
         BE       DERR1             YES-QUIT
DERR01   EQU      %
DABN     EQU      %
         LI,15    2                 ERROR CODE
         M:PRINT  (MESS,DERRM)
         B        BUILDERR+1        SNAP
DERR1    EQU      %                 DISK SATURATED
         M:PRINT  (MESS,DERRM1)
         B        EXIT
RANDOM   EQU      %                 R6=NKEY  R5=RC  R3=BA(RC)
         CI,5     5                 RC MUST = 05 FOR RANDOM
         BNE      BLDERR3           OR ELSE
RANDOM1  LW,0     RWS
         CW,0     BUFRSIZ
         BGE      RANDOM3           NO MORE ROOM
         BAL,0    NEXTBUF           GET DATA BLOCK
         LW,4     CURBUF
         LB,5     TSTATUS,4
         CI,5     TMK               TYC=TMK=EOD
         BE       BUILT             DONE
         CI,5     1                 TYC=1=OK
         BE       %+3
         CI,5     EOR               TYC=EOR=OK
         BNE      BLDERR2           ERROR
         LW,4     CURBUF+1          ADDRESS OF DATA
         LW,5     RWS
         SLS,5    -2                # WORDS USED IN BUFR1
         AW,5     BUFR1             ADDRESS TO PUT NEXT BLOCK
         LI,3     512/8
RANDOM2  LCI      8
         LM,8     0,4               MOVE 8 WORDS
         STM,8    0,5
         AI,4     8
         AI,5     8
         BDR,3    RANDOM2
         LI,3     2048
         AWM,3    RWS               INCREMENT # BYTES USED IN BUFFER
         B        BUILD1            GET NEXT TAPE RECORD
*
RANDOM3  EQU      %                 WRITE OUT CURRENT BLOCK
         LW,0     FCHEK             DON'T WRITE IF CHECKING TAPE OR
         BNEZ     RANDOM9
         MTB,0    M:EO+FCN
         BEZ      RANDOM6           BR IF NO I/O OUTSTANDING
RANDOM4  M:CHECK  M:EO,(ABN,DABN),(ERR,DERR)
         B        RANDOM8
RANDOM6  LW,3     M:EO+TYC
         SLS,3    -17
         AND,3    M7
         CI,3     1                 TYC MUST BE 1
         BNE      RANDOM4           NO - ISSUE M:CHECK TO GET ERROR
*
RANDOM8  M:WRITE  M:EO,(BUF,*BUFR1),(SIZE,*RWS)
RANDOM9  LW,3     BUFR1             SWITCH BUFFER POINTERS
         XW,3     BUFR2
         STW,3    BUFR1
         LI,3     0
         STW,3    RWS
         B        RANDOM1
         PAGE
EXIT     EQU      %
         DO       CPV
         M:SYS                      MASTER MODE
         LCI      2
         LM,12    MYACCT            RESTORE LOGON
         STM,12   J:ACCN            ACCOUNT TO JIT
EXIT1    EQU      %
         LW,1     S:CUN             MAKE SURE
         LB,2     UB:MF,1           I/O HAS BEEN
         BEZ      EXIT2             RUN DOWN
         BAL,0    SLAVE             ALLOW KEYINS
         LI,3     2000
         BDR,3    %
         M:SYS
         B        EXIT1
         ELSE
         LI,1     1
         LCI      2
         LM,12    SYSACNT
         STM,12   *X'4F',1
         FIN
EXIT2    EQU      %
         BAL,0    SLAVE
         LW,15    SELECT            RESTORE SELECTIVE
         BEZ      EXIT4             NO
         LW,15    ANY               YES-
         BEZ      %+2
         M:DELREC M:SO
         M:REW    M:SO              YES
         LI,14    0                 FLAG FOR ALL FILES FOUND
         M:DEVICE M:LL,(PAGE)
         M:PRINT  (MESS,FNFMESS)
         LI,15    ' '               BLANK OUT TEXTC COUNT
         M:READ   M:SO,(ERR,EXIT3),(ABN,EXIT3)
         STB,15   SELBUF+3          BLANK OUT TEXTC COUNT
         M:WRITE  M:LL,(BUF,SELBUF),(SIZE,80)
         MTW,1    14                COUNT FILES NOT FOUND
         B        %-4
EXIT3    EQU      %                 ERROR/ABNORMAL - MUST BE DONE
         CI,14    0                 ALL FILES FOUND
         BNE      EXIT3A            NO
         M:PRINT  (MESS,NONE)       YES - PRINT NONE MISSING
EXIT3A   EQU      %
         M:CLOSE  M:SO,(REL)
EXIT4    EQU      %
         LW,15    Y002              OPEN BIT
         CW,15    M:EI
         BAZ      EXIT40            NOT OPEN
         M:CLOSE  M:EI,(SAVE),(REM)
EXIT40   EQU      %
*
* PRINT NUMBER OF RAD & PACK GRANULES RESTORED
*
         MTW,0    PACK              WE DONT COUNT PRIV PACK STORAGE
         BNE      EXIT40A           SO DONT PRINT MESSAGE IF PRIV
         B        EXIT40A           DONT PRINT GRANULE COUNT
************************************UNLESS EASY WAY TO GET
************************************A ACCURATE COUNT IS FOUND.
         LW,3     TOTRAD            RAD GRANULES USED
         LI,4     RADUSED           MOVE DECIMAL
         BAL,0    DECCNVT             NUMBER TO MESSAGE
         M:DEVICE M:LL,(PAGE)
         M:PRINT  (MESS,DCUSED)
         LW,3     TOTPACK           PACK GRANULES USED
         LI,4     PACKUSED
         BAL,0    DECCNVT
         M:PRINT  (MESS,DPUSED)
EXIT40A  EQU      %
         LW,3     FILESKIP          TOTAL FILES SKIPPED
         LI,4     NOSKIP            PUT IN MESSAGE
         BAL,0    DECCNVT           CONVERT TO DEC AND PUT IN MESSG
         M:PRINT  (MESS,SKIPPED)
         LW,3     TAPECNT           TOTAL TAPES USED
         LI,4     NOTAPES           PUT IN MESSAGE
         BAL,0    DECCNVT           CONVERT TO DEC AND PUT IN MESSG
         M:PRINT  (MESS,TAPEUSED)
*
* RESTORE OLD JIT VALUES
*
         M:SYS
EXIT41   EQU      %
         DO       CPV
         LI,1     J:JIT             (THIS INST PROB REDUND.)
*RESTORE READ NONE FLAG
         LW,R15   Y1
         AND,R15  JASSIGN
         OR,R15   J:ASSIGN
         STW,R15  J:ASSIGN
         LW,2     SVPRDC            RESTORE
         STW,2    PRDCRM,1          MAX PERM RAD
         LW,2     SVPRDP
         STW,2    PRDPRM,1          MAX PERM DISC
         ELSE
         LW,1     X'4F'             GET JIT ADDRESS
         LW,3     OLDRNST
         STS,3    PUF,1             RESTORE OLD RUNFLAGS
         LW,2     SVDCX             RESTORE
         STW,2    PRMDCJB,1            RAD USED
         LW,2     SVDPX             RESTORE
         STW,2    PRMDPJB,1            DISC USED
         FIN
         DO       TAURUS=1
         LI,3     0
         XW,3     EAPHYADR          RELEASE STOLEN PAGE IF THERE
         BE       EXIT4A            NO PAGE
         WD,0     X'37'             DISABLE BEFORE RELEASE
         BAL,11   T:RSPP            RELEASE ENDACTION PAGE
         WD,0     X'27'             ENABLE
EXIT4A   EQU      %
         FIN
         BAL,0    SLAVE
EXIT4B   EQU      %
         M:EXIT
         DO       CPV
EXCONT   EQU      %                 EXIT CONTROL ROUTINE
         CI,8     X'FF'             CHECK FOR ERROR
         BAZ      EXIT4B            NO ERRORS - NO CLEAN UP
         LI,R15   USRABT            USER ABORTED MESSAGE
         CI,8     X'C8'
         BANZ     EXCONT0
         LI,R15   OPRABT            OPERATOR ABORT MESSAGE
         CI,8     X'30'
         BANZ     EXCONT0
         LI,R15   LIMABT            LIMIT ABORT MESSAGE
         CI,8     4
         BAZ      EXCONT1
EXCONT0  EQU      %
         M:PRINT  (MESS,*15)        PRINT ABORT MESSAGE
         B        ERRADD
EXCONT1  EQU      %
         STW,11   12                SUBCODE TO 12
         SLS,10   8
         AW,12    10                ERROR CODE TO 12
         LI,11    X'0300'
         STH,11   12                COMPLETE KEY IN R12
         LH,11    M:EI
         CI,11    X'20'
         BAZ      EXCONT5           BR IF NOT OPEN
         CAL1,1   CLOSE
EXCONT5  EQU      %
         LI,R3    SELBUF            BUFFER
         STW,12   *R3               USE FOR THE KEY
         CAL1,1   OPNERFIL
         CAL1,1   READERFIL
         LW,4     M:EI+4
         SLS,4    -17
         CAL1,1   CLOSE
         M:WRITE  M:LL,(BUF,SELBUF),(SIZE,*4)
         B        ERRADD            SNAP IN BATCH
EXCONT50 EQU      %
         M:SYS
         LW,1     S:CUN
         LB,2     UB:MF,1           RUNDOWN ALL I/O
         BEZ      EXCONT60
         BAL,0    SLAVE
         LI,3     2000
         BDR,3    %
         B        EXCONT50
EXCONT60 EQU      %
         LCI      2
         LM,12    MYACCT            RESTORE LOGON ACCOUNT
         STM,12   J:ACCN            TO JIT
         B        EXIT41
ERRADDRD EQU      %
         CAL1,1   CLOSE
ERRADD   EQU      %
         LC       J:JIT
         BCS,8    EXCONT50          NO SNAP IF ON-LINE
         M:SNAP   'ABORTED',(SELBUF,SELBUF+19)
         B        EXCONT50
         FIN
*
* ROUTINE TO CONVERT R3 TO DECIMAL EBCDIC
*        RESULT RETURNED *R4, LINK R0
*
DECCNVT  LI,5     0                 ZERO
         LI,6     0                   DESTINATION
         LI,7     0
         LCI      3
         STM,5    *4
         LI,1     11
DECLOOP  LI,2     0                 CLEAR REMAINDER
         DW,2     DEC10             DIVIDE R3 BY 10
         AI,2     X'F0'             CONVERT REMAINDER TO EBCDIC
         STB,2    *4,1              & STORE IT AWAY
         AI,3     0                 IF NON-ZERO QUOTIENT, CONTINUE
         BEZ      %+2               STOP & BLANK FILL
         BDR,1    DECLOOP
         LI,1     0
         LI,2     X'40'             BLNK
DECLOOP2 MTB,0    *4,1              SCAN FOR ZEROS
         BNEZ     *0                IF HIT A NUMBER, RETURN
         STB,2    *4,1              ELSE, STORE A BLANK
         AI,1     1                   & CONTINUE SCAN
         B        DECLOOP2
*
DEC10    DATA     10
         PAGE
TXT:BOF  TEXT     ':BOF'
TXT:EOF  TEXT     ':EOF'
TXT:EOV  TEXT     ':EOV'
CCEND    TEXT     '+END'
CCSTART  TEXT     '+STA'
CCSKIP   TEXT     '+SKI'
CCVOL    TEXT     '+VOL'
CCDEV    TEXT     '+DEV'
CCPACK   TEXT     '+PAC'
CCSEL    TEXT     '+SEL'
CCCHEK   TEXT     '+CHE'
CCNEW    TEXT     '+NEW'
MOD4     DATA     3
TRUNC    DATA     -4
TWO55    DATA     X'FF000000'
XEFFFFFFF DATA    X'EFFFFFFF'
Y1       DATA     X'10000000'
Y08      DATA     X'08000000'
Y002     DATA     X'00200000'
M7       DATA     X'7F'
Y0038    DATA     X'00380000'
M8       DATA     X'FF'
M9       DATA     X'1FF'
XTABLE   TEXTC    '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
         BOUND    4
         PAGE
BADSNM   TEXTC    ' WRONG INSN ON TAPE '
FSERR    TEXTC    ' FILE SEQUENCE ERROR...JOB ABORTED'
OTABNM   TEXTC    ' ABNORMAL OPENING TAPE...SEE R10'
NOPAGES  TEXTC    ' NOT ENOUGH PAGES.......'
BADMON   TEXTC    ' FRES LOADED WITH WRONG MONSTK...TRY AGAIN'
NOPRIV   TEXTC    ' C0 PRIVILEGE REQUIRED TO USE FRES'
CCMESS   TEXTC    ' CONTROL OR DATA CARD ERROR-RUN ABORTED'
SEER15   TEXTC    ' FATAL ERROR-SEE R15 AND REFER TO LISTING'
FERRM    TEXTC    ' ERROR/ABNORMAL OPENING FILE'
MESSYN   TEXTC    ' SYNON PARENT FILE MISSING '
SELMESS  TEXTC    ' ERROR/ABNORMAL READING SELECT CARDS'
MESS09   TEXTC    ' NO 09 ENTRY IN :BOF-SKIP TO NEXT FILE'
BUILDMS  TEXTC    ' BAD TAPE BLOCK-SKIP THIS FILE'
BUILDMS1 TEXTC    ' TAPE MARK (EOD) REQUIRED BUT NOT FOUND (R7=TYC).'
BUILDMS2 TEXTC    ' IRRECOVERABLE READ ERROR - TYC IN R7.'
BUILDMS3 TEXTC    ' TAPE RECORD CONTROL BYTE (IN R5) INVALID.'
BUILDMS4 TEXTC    ' :EOF SENTINEL MISSING.'
2BIGM    TEXTC    ' RECORD TOO BIG...CANNOT GET BUFFER'
DERRM    TEXTC    ' ERROR/ABNORMAL WRITING FILE'
DERRM1   TEXTC    ' DISK SATURATED - JOB ABORTED.'
USRABT   TEXTC    'ABORTED BY PROGRAM OR USER'
OPRABT   TEXTC    'ABORTED BY OPERATOR'
LIMABT   TEXTC    'LIMIT EXCEEDED - SEE R9 UNDER EXIT CONT'
*
PRINT15  GEN,8,24  1,0
         PZE       *0
         PZE       *R15             MSG TEXTC WA IN R15
*
FENDERMSG TEXTC   '** :BOF HIT BEFORE END OF PRIOR FILE SEEN **'
*
         PAGE
M:EI     M:DCB    (DEVICE,'9T'),(SN),(FILE,8),(ASN,DEVICE)
         PAGE
M:EO     M:DCB    (FILE),(READ,21),(WRITE,21),(SYNON),(PASS),(SN,8)
         ORG      M:EO+90
         DATA     X'0B000008'       OVERWRITE LEI
         DO1      8
         DATA     0
         DATA     X'04000002',0,0   EXPIRES
         DO       CPV
         DATA     X'0A000003',0,0,0 MODIFIED
         DATA     X'0E000002',0,0   CREATED
         DATA     X'0F000002',0,0   ACCESSED
         DATA     X'10000002',0,0   BACKED UP
         DATA     X'14000010'       EXECUTE ACCOUNTS
         DO1      16
         DATA     0
         DATA     X'15000010'       ACCESS ACCOUNTS
         DO1      16
         DATA     0
         ELSE
         DATA     X'0A000002',0,0   CREATED
         FIN
         DATA     X'11010101',0     DESCRIPTORS
KBUFD    SET      %
DSIZ     SET      %-M:EO+8
         RES      8
         ORG      M:EO
         DATA,1   DSIZ
         ORG      M:EO+10
         DATA     KBUFD
         END      START

