*************
*
*
* NOTE: THE FOLLOWING ASSEMBLY SWITCH ALLOWS 6 DIFFERENT
*       VERSIONS OF FSAVE TO BE PRODUCED.
*
*        SWITCH SETTING            RESULT
*        --------------            ------
*           -1                      BPM/BTM F00/F01 ONLY...
*            +0                     BPM/BTM ...
*            +1                     UTS B01 ONLY
*            +2                     UTS C00 ONLY
*           +3                      UTS C01
*             +4                 UTS D00
*
**************
TAURUS   SET      1
CPVC00   SET      1
CPV      SET      2                 CP-V B00
         DO       CPV=0
UTS      SET      0                   BPM/BTM
         ELSE
UTS      SET      5                 FINAL UTS WAS D00
         FIN
         DO       CPV>=2
FILL     SET      1                 MAKE FILL COMPATIBLE TAPES
         ELSE
FILL     SET      0                 MAKE FPURGE TYPE TAPES
         FIN
EASECT   EQU      %
         CSECT    0
START    EQU      %
         SYSTEM    SIG7FDP
         DO       UTS>=4
UTSPROC  SET      0
S69PROC  SET      1
         SYSTEM   UTS
         FIN
         SYSTEM   BPM
         DEF      START,PATCH
         DEF      STACK,DISCIO,MTIO
         DEF      FPTOP,VERSION
         REF      M:SO
         DO       CPV>0
         REF      DCT%MASK,SECTOR%MASK,DCT22
         REF      DISCLIMS
         FIN
         DO       UTS=-1            F00/F01
         TITLE    ;
 '* * * B P M / B T M  F 0 0 / F 0 1  F I L E  S A V E  * * *'
         ELSE
         DO       UTS=0             GOO ONLY
         TITLE    ;
 '* * * B P M / B T M   F I L E   S A V E * * *'
         ELSE
         DO       UTS=2
         TITLE    ;
 '* * * U T S     C 0 0  F I L E  S A V E * * *'
         ELSE
         DO       UTS=1
         TITLE  ;
 '* * * U  T  S    B 0 0 / B 0 1   F  I  L  E    S  A  V  E * * *'
         ELSE
         DO       UTS=3
         TITLE    ;
 ' * * * U  T  S    C 0 1   F  I  L  E   S  A  V  E * * *'
         ELSE
         DO       UTS=4
         TITLE    ;
 ' * * * U  T  S    D 0 0   F  I  L  E   S  A  V  E * * *'
         ELSE
         DO       CPV>0
         TITLE    ;
 ' * * * C  P  -  V    F  A  S  T    S  A  V  E * * *'
         FIN
         FIN
         FIN
         FIN
         FIN
         FIN
         FIN
*
*        ASSEMBLY SWITCH FOR MBS .VS. STB
*
SIGMA7   EQU      1                 1 = MBS MODE
         PCC      0
*
*
*
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,SR1   EQU      8
R9,SR2   EQU      9
R10,SR3  EQU      10
R11,SR4  EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
VERSION  EQU      X'F01'
         PAGE
*
*
*
*        FILE MANAGEMENT TABLE DEFINITIONS
*
*
*****
*        TABLE KEY LENGTHS
*****
*
FDKEYL   EQU      41                 FILE DIRECTORY KEYS
         DO       CPVC00=1
ACDKEYL  EQU      16                ACCOUNT DIRECTORY KEYS
         ELSE
ACDKEYL   EQU     21                 ACCOUNT DIRECTORY KEYS
         FIN
MIXKEYL  EQU      14                TOTAL INDEX SECTOR KEY
*                                   LENGTH (PLUS KEYM VALUE)
*****
*        1ST KEY DISPLACEMENTS IN SECTORS
*****
MIDISP   EQU      12                 MASTER INDEX DISPLACEMENT
ACDISP   EQU      12                 ACN DIRECTORY DISPLACEMENT
FDDISP   EQU      12                 FILE DIRECTORY DISPLACEMENT
         DO       UTS>=2
SCWDISP  EQU      3                 DISP. TO 1ST SCW IN CONT. GRAN.
         FIN
*
*        ACCOUNT DIRECTORY DISPLACEMENT VALUES
*
         DO       CPVC00=1
ADKBD    EQU      -5                KEY END+1 TO BYTE3 OF DA
         ELSE
ADKBD    EQU      -6                KEY END+1 TO BYTE3 OF DISC ADDRS
         FIN
ADKFD    EQU      12                KEY START TO BYTE0 OF DISC ADDRS
*
*        FILE DIRECTORY DISPLACEMENT  VALUES
*
FDKBD    EQU      -6                KEY END+1 TO BYT3 OF DISC ADDRS
FDKFD    EQU      32                KEY START TO BYT0 OF DISC ADDRS
FDBKEOF  EQU      -3                FROM KEY END+1 TO EOF BYTE
         PAGE
*
*        MASTER INDEX DISPLACEMENT VALUES
*
MIKBD    EQU      -6                KEY END+1 TO BYT3 OF DISC ADDRS
*
*        THE FOLLOWING ALL HAVE TO HAVE 'KEYM'  ADDED TO IT
*
MIKFD    EQU      5                 KEY START TO BYT0 OF DISC ADDRS
MIKTOKD  EQU      10                KEY TO KEY DISPLACEMENT
*
*-----------------------------------------------------------*
*FIELD POSITION   *                 IS DISPLACEMENT TO
*-----------------------------------------------------------*
MIFLD1   EQU      1                 BLDISP
MIFLD2   EQU      3                 BLKDIZE
MIFLD3   EQU      5                 DABLK
MIFLD4   EQU      9                 RWS
MIFLD5   EQU      11                EOF/FAK/C BYTE
MIFLD6   EQU      12                FIDBUF
*-----------------------------------------------------------*
*
         PAGE
*
*
*        ACCOUNT DIRECTORY FORMAT
*
*0     1        4           12     16    18        19    20
*----------------------------------------------------------*
* 0B  * 404040 * ACCOUNT# * DABLK * BLK * FAK/EOF * FIDBUF *
*----------------------------------------------------------*
*
*
*
*
*        FILE DIRECTORY FORMAT
*0     1                    32      36   38       39   40*
*----------------------------------------------------------*
* KL  * FILE NAME * UNUSED * DABLK * BLK * FAK/EOF * FIDBUF*
*----------------------------------------------------------*
*
*
*
*
*        MASTER INDEX KEY FORMAT
*
*
*0     1  <KEYM>    0+KEYM   2+KEYM    4+KEYM  8+KEYM 10    12
*------------------------------------------------------------------*
* KL  * KEY ITSELF * BLDISP * BLKSIZE * DABLK * BLK * FAK * FIDBUF *
*------------------------------------------------------------------*
*
*
         PAGE
*
*        FILE MANAGEMENT I/O TYC LISTS
*
NORMAL   EQU      1                 NORMAL RETURN
LOSTDATA EQU      2
BOT      EQU      3                  BEGINNING OF TAPE
BOF      EQU      4                  BEGINNING OF FILE
EOR      EQU      5                  END OF REEL
EOD      EQU      6                  END OF DATA
EOF      EQU      7                  END OF FILE
READERR  EQU      8                  READ ERROR TYC
WRTERR   EQU      9                  WRITE ERROR TYC
         PAGE
*
*
*        UTS PROCEDURE PROC'S
*
*
         DO       UTS>=4
BASEREG  CNAME
         PROC
LF       WD,0     X'37'
         LI,AF    0                 PHYSICAL PAGE NO.
         SLS,AF   9                 PHYSICAL ADDRESS OF PAGE
         AI,AF    0                 DISPLACEMENT INTO PAGE
         PEND
CALL     CNAME
         PROC
LF       STW,AF(2)  VADRS-EASECT,AF(3)
         LW,R6    AF(3)             BASE REGISTER VALUE
         AI,R6    %+2-EASECT        DISPLACEMENT
         B        AF(1)-EASECT,AF(3)   JUST LIKE A BAL,6
         STW,R0   AF(2)             AF(2) MUST BE A REGISTER
         PEND
         PAGE
*
*        END ACTION PRE-PROCESSOR FOR UTS VERSION
         CSECT    0
*
         DO       TAURUS=1
EAINIT   EQU      %
         LW,2     EAPHYADR          PHYSICAL ENDACTION PAGE
         LI,R3    X'FFE00'
         STS,R2   R0
         B        *R11
         ELSE
EAINIT   LI,R2    EASECT            VIRTUAL ADDRESS
         SLS,R2   -9                VIRTUAL PAGE #
         LOAD,R2  JX:CMAP,R2        PHYSICAL PAGE #
         LI,R3    1                 HALFWORD DISPLACEMENT
         STH,R2   DENAC+1,R3
         STH,R2   FITENAC+1,R3
         STH,R2   WTENAC+1,R3
         STH,R2   SENTENAC+1,R3
         SLS,R2   9                 PHYSICAL ADDRESS
         LI,R3    X'FFE00'          BIG MASK
         STS,R2   R0
         B        *R11
         FIN
         PAGE
*
*
*        END ACTION FOR SUBROUTINE 'DISCIO'
*
*
*
         USECT    EASECT
DENAC    BASEREG  R3
         LI,R1    0                 ZAP
         STW,R1   RBUSY-EASECT,R3   BUSY STATUS FLAG
         STW,R12  DSTATUS-EASECT,R3
MF:DWN   EQU      %                 DECREMENT MY MF
         LW,R2    CUN-EASECT,R3     GET MY USER#
         MTB,-1   UB:MF,R2          DOWN MY MASTER FUNCTION
         BNEZ     EARETRN-EASECT,R3 RETURN IF NON-ZERO
         LB,R15   UB:US,R2          OTHERWISE, CHECK MY STATE
         CI,R15   SIOW              IF SIOW
         BE       EAREP-EASECT,R3   THEN REPORT IOCOMPLETE
         CI,R15   SIOMF             OR IF SIOMF
         BNE      EARETRN-EASECT,R3 NEITHER SIOW NOR SIOMF-RETURN
EAREP    EQU      %
         MTB,1    UB:MF,R2          RE-UP MY MASTER FUNCTION
         STW,R2   *TSTACK           K L U D G E
EARETRN  EQU      %                 RETURN
         WD,0     X'27'
         B        *R11              AND EXIT
         PAGE
*
*
*       END ACTION RECEIVER FOR ALL 'QSECTOR' REQUESTS AND
*        FINAL END-ACTION CLEANUP FOR ALL OTHER READ
*        AHEAD I/O EVENTS.
*
*
*
*
FITENAC  BASEREG  R3                BASE REGISTER = R3
ENDACT   MTW,-1   DOPCNT-EASECT,R3  DECREMENT READ AHEAD COUNT
         STW,R12  DSTATUS-EASECT,R3 DISC STATUS
         CALL     VTOPU,R14,R3
ENDACT0  LB,R2    *R14              GET TYPE
         CI,R2    X'80'             DATA REQUEST
         BE       ENDACT1-EASECT,R3 YEP
         AND,R2   M7-EASECT,R3      NO, DROP BUSY BIT
         LW,R1    MIX:CNT2-EASECT,R3 GET NUMBER RECEIVED
         AI,R2    MIX:STAT-EASECT   STAT TABLE
         STW,R1   *R2,R3            PUT # RECEIVED INTO IT
         MTW,1    MIX:CNT2-EASECT,R3 AND BUMP # RECEIVED
ENDACT1  EQU      %
         LW,R0    M24-EASECT,R3     MASK OFF TO
         AND,R0   *R14              DROP BUSY BIT
         LB,R1    R12               PUT TYC
         STB,R1   R0                INTO ADDRS CELL
         STW,R0   *R14              AND REPLACE
         B        MF:DWN-EASECT,R3
         PAGE
*
*        ALL DATA WRITES END ACTION
*        PERFORMED HERE-A 'TYC' OF EOR/WRITE ERROR
*        WILL CAUSE A REEL CHANGE REQUEST
*
*        R14 WILL CONTAIN TABLE POINTER
*
*
*
WTENAC   BASEREG  R3
         MTW,-1   OPCNT-EASECT,R3   DROP I/O COUNT
         STW,R12  TPSTATUS-EASECT,R3  SAVE TAPE TYC
         LW,R7    R14               TABLE INDEX
         AI,R14   TBUF
         CALL     VTOPU,R14,R3
         LW,R0    M22-EASECT,R3     ADDRESS MASK
         AND,R0   *R14
         STW,R0   *R14
         LI,R0    TBUF              VIRTUAL ADDRESS
         CALL     VTOPU,R0,R3
         MTW,1    *R0
         LB,R1    R12               TYC TO R1
         CI,R1    EOR               TYC=EOR
         BNE      %+2-EASECT,R3     NO
         STW,R1   EOTBIT-EASECT,R3  SET END OF REEL IF SO
         CI,R1    WRTERR            WAS TAPE WRITE ERROR
         BNE      %+2-EASECT,R3     NOPE
         STW,R1   EOTBIT-EASECT,R3  SET SWITCH REELS IF SO
         B        MF:DWN-EASECT,R3
         PAGE
*
*        SENTINEL END ACTION
*
*
*        ALL SENTINELS WRITTEN TO TAPE GET
*        END ACTION HERE-END OF REEL IS IGNORED
*        A TAPE ERROR WILL CAUSE A REEL CHANGE
*
SENTENAC BASEREG  R3
         MTW,-1   OPCNT-EASECT,R3   I/O COUNT
         STW,R12  TPSTATUS-EASECT,R3   SAVE TYC
         LB,R1    R12               TYC
         CI,R1    WRTERR            TAPE ERROR
         BNE      %+2-EASECT,R3     NO
         STW,R1   EOTBIT-EASECT,R3  SET REEL SWITCH IF IT IS
         B        MF:DWN-EASECT,R3
         PAGE
*
*        VIRTUAL TO REAL ADDRESS CONVERSION
*
VTOPU    EQU      %
         LW,R2    VADRS-EASECT,R3   VIRTUAL ADDRESS TO BE CONVERTED
         LW,R0    R2                HOLD IN R0
         SLS,R2   -9                VIRTUAL PAGE NO.
         LW,R4    CUN-EASECT,R3     MY USER #
         LOAD,R4  UX:JIT,R4         MY JIT'S PHYSICAL PAGE #
         SLS,R4   9                 IT'S PHYSICAL ADDRESS
         AI,R4    JCMAP             DISPLACEMENT
         LOAD,R4  *R4,R2            PHYSICAL PAGE #
         SLS,R4   9                 POSITION IT
         LI,R5    X'FFE00'          BIG MASK
         STS,R4   R0                FINAL PHYSICAL ADDRESS
         B        0,6
VADRS    DATA     0
M22      DATA     X'3FFFFF'
M7       DATA     X'7F'
         DEF      EAPATCH
EAPATCH  RES      20                SPECIAL PATCH AREA
         USECT    START
         PAGE
         ELSE
         DO       UTS>0
CALL     CNAME
         PROC
LF       SECT
         STW,AF(2)  VADRS
         SECT
         BAL,R6   AF(1)             AND GO TO NAMED ROUTINE
         STW,R0   AF(2)             RETURN VALUE TO AF2
         PEND
*
*
SECT     CNAME
         PROC
##       SET      %
         USECT    EAINIT
         ORG      %-1
         STS,R2   ##
         B        *R11
         USECT    ##
         PEND     NAME
         PAGE
*
*        END ACTION PRE-PROCESSOR FOR UTS VERSION
*
         CSECT    0
PHYPAGE  PZE
EAINIT   LI,R2    EASECT
         SLS,R2   -9
         LB,R2    JB:CMAP,R2
         SLS,R2   9
         LI,R3    X'1FE00'
         STS,R2   R0
         CS,R2    PHYPAGE
         BE       *R11
         STW,R2   PHYPAGE
         B        *R11
         USECT    START
         ELSE
SECT     CNAME
         PROC
         PEND
         FIN
         FIN
         PAGE
*
*        I/O FUNCTION CODE
*
*        CONSTANTS
*
IOPRI    EQU      X'FF'
READFC   EQU      0                  9T AND/OR DISC READ
WRT      EQU      1                  WRITE 9T
BSR      EQU      4                  BACK SPACE RECORD
FSR      EQU      5                  FORWARD SPACE RECORD
BSF      EQU      6                  BACK SPACE FILE
FSF      EQU      7                 FORWARD SPACE FILE
         DO       UTS=-1            DO FOR F00/F01 BPM/BTM
WTM      EQU      8                  WRITE TAPE MARK
REWOL    EQU      9                  REWIND ON-LINE
         ELSE
WTM      EQU      3                 WRITE TAPE MARK
REWOL    EQU      8                 REWIND ON LINE
         FIN
REWOFL   EQU      10                 REWIND OFF-LINE
9TSENS   EQU      11                 9T SENSE
READRCVR EQU      14                 READ 9T WITH RECOVERY
READREV  EQU      16                 9T READ REVERSE
READISC  EQU      0                  READ DC
WRTDISC  EQU      1                  WRITE DC
CHKWRT   EQU      4                 WRITE W/CHECK WRITE
RETRY    EQU      X'30'             RETRY COUNT FOR DISC I/O
         DO       UTS>=2
IBUFSIZ  EQU      512               FULL GRANULE MIX BUFFERS
         DO       UTS>=4
DIRSIZ   EQU      IBUFSIZ           FULL GRANULE EVERYTHING
         ELSE
         DO       UTS<=3
DIRSIZ   EQU      256               HALF GRANULE DIRECTORIES
         FIN
         FIN
         ELSE
IBUFSIZ  EQU      256               HALF GRANULE MIX BUFFERS
DIRSIZ   EQU      256               HALF GRANULE DIRECTORIES
         FIN
SECSIZE  EQU      DIRSIZ*4          BPM LOGICAL SECTOR SIZE
GRANSIZE EQU      2048              BPM LOGICAL GRANULE SIZE
TBSIZ    EQU      2048              FSAVE MAX TAPE BUFFER SIZE (BYTES)
         PAGE
*
*        UTS REFERENCES
*
         DO       UTS>0
         REF      ACNCFU,TSTACK,DCT1,HGP,DCTSIZ
         REF      UB:MF,S:CUN,NEWQNWM,JCMAP
         REF      J:DCBLINK,UB:US,SIOW
         DO       CPV>=2
         REF      SIOMF
         ELSE
SIOMF    EQU      21                SHOULD BE DEF'D IN SSS
         FIN
         DO       UTS>=4
         REF      JX:CMAP,UX:JIT
         ELSE
         REF      JB:CMAP,UB:JIT
         FIN
         REF      E:WU,T:RUE,SW,T:REG,E:QMF
         REF      IOQ8,IOQ9
         DO       CPV>=2
         REF      MAXBQ,M:LL,M:DO,M:C,M:OC
         ELSE
         REF      MAXBQ,M:EO,M:LL,M:DO,M:C,M:OC
         FIN
         DEF      EASECT
M:ACNCFU EQU      ACNCFU
         CLOSE    ACNCFU
         FIN
         DO       UTS=-1            IF F00/FO1 VERSIONS
UTS      SET      0                 NO FURTHER NEED FOR IT
         FIN
         PAGE
*
*        ENTRY - COLLECT DATA BUFFERS,READ
*        CONTROL CARDS AND BEGIN TO PROCESS
*        THE TARGET FILE SYSTEM
*
INITIATE EQU      %
         DO       UTS=0
         STW,R0   STKPNTR           PUT AWAY BPM STACK POINTER
         AI,R0    1                 BUMP TO SIZE SPOT
         LH,R1    *R0               GET SIZE HALF/WORD
         CI,R1    X'80'             NEED LARGER STACK THAN DEFAULT
         BL       STKSIZR           TOO SMALL-ABORT RUN
         CAL1,6   SYSFPT            OK-GET INTO MASTER MODE
         STW,R10  NEWQ              SAVE NEWQ'S ADDRS
         BAL,R15  SLAVE             GO BACK TO SLAVE MODE
         ELSE
         CAL1,1   OPNLL             OPEN M:LL
         CAL1,6   SYSFPT            GO MASTER MODE
         BCS,8    NOPRIV            CC1 SET IF PRIV<C0
         DO1      TAURUS=0
         BAL,R15  SLAVE             GO BACK BROTHER
         REF      NEWQ
         CI,R10   NEWQ              SEE IF CORRECT MONSTK
         BNE      BADMONS           NOPE...TRY AGAIN SISTER
         LI,R15   FS:MSG            TYPE
         CAL1,2   TYP15             FSAVE HERE...
         FIN
         DO       UTS>=4
         DO       TAURUS=1
         M:GP     1                 GET PAGE FOR ENDACTION
         STW,9    EAADDR            SAVE VIRTUAL ADDR FOR ENDACTION
         LW,8     9
         BEZ      NOTENUFF
         AW,8     Y05               FREE SO IT WILL NOT COME BACK
         M:FVP    *8                FREE VIRTUAL PAGE JUST OBTAINED
         REF      T:STLPP
INIT10   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
         WD,0     X'37'
         REF      S:STLC
         AWM,3    S:STLC            FORCE A PAGE
         BLZ      %+2
         STW,3    S:STLC
         WD,0     X'27'             ENABLE
GRPG1    CAL1,8   GTPG              GET AND RELEASE A PAGE
         CAL1,8   FREPG
         B        INIT10
INIT15   EQU      %
         CI,3     X'1FFFF'          MAKE SURE PAGE LESS THAN 128K
         BL       INIT20            OK
         REF      T:RSPP
         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
         BAL,R15  SLAVE
         LW,R15   EAADDR            SAVE ENDACTION LOC OF END OF TAPE FLAG
         AI,R15   EOTBIT-EASECT
         STW,R15  EOTFLAG
         LW,R15   EAADDR
         AI,R15   MIX:STAT-EASECT   START OF MIX STATUS TABLE
         STW,R15  MIXSTAT
         AI,R15   #IBUF             # OF INDEX BUFFERS
         STW,R15  MIXSTATN          END OF MI STATUS TABLE
         LW,R2    EAPHYADR          PHYSICAL ENDACTION PAGE
         SLS,R2   -9
         LI,R3    1
         STH,R2   DENAC+1,R3        SET UP BASE REG FOR E. A. ROUTINES
         STH,R2   FITENAC+1,R3
         STH,R2   WTENAC+1,R3
         STH,R2   SENTENAC+1,R3
         FIN
         LI,R12   EASECT            CONVERT ADDRESS
         AND,R12  M9                TO DISPLACEMENT
         LI,R1    1                 WITHIN
         STH,R12  DENAC+3,R1        PAGE
         STH,R12  FITENAC+3,R1
         STH,R12  WTENAC+3,R1
         STH,R12  SENTENAC+3,R1
         DO       TAURUS=1
         LW,R2    EAADDR            VIRTUAL WORD ADR OF ENDACTION PAGE
         LI,R8    M24+1-EASECT      SIZE OF ENDACTION ROUTINE
         LI,R3    EASECT
         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
         FIN
         DO       UTS>=2
         DEF      FPTSECT
,FPTSECT M:GP     #IBUF             GET INDEX GRANULE BUFFERS
         ELSE
         M:GP     #IBUF/2           GET INDEX SECTOR BUFFERS
         FIN
         AWM,R8   PAGETOTAL         KEEP TRACK OF TOTAL
         DO       UTS>=2
         CI,R8    #IBUF             GET ENOUGH PAGES
         ELSE
         CI,R8    #IBUF/2           GET ENOUGH PAGES
         FIN
         BL       SP:INIT           NO
         STW,R9   BUF:LIMS          SET BUFFER AREA LOWER LIMIT
         LI,R1    #IBUF             SET LOOP
         STW,R1   INDPAGES          SAVE COUNT
INITIATE1 STW,R9  IBUF,R1           MOVE BUF WA TO TABLE
         AI,R9    IBUFSIZ           STEP TO NEXT BUFFER
         BDR,R1   INITIATE1         COMPLETE TABLES
         STW,R9   BUF:LIMS+1        MARK BUFFER AREA UPPER
         B        GET:CC            GATHER CONTROL CARDS
         DO       UTS>0
NOPRIV   EQU      %                 USER DOESN'T HAVE C0
         LI,R15   NOPRIVM
         CAL1,2   PRNT15            TELL USER
         LI,R1    BA(NOPRIVM)       AND OPERATOR
         B        BADMONS+3         AND QUIT
BADMONS  EQU      %                 FSAVE LOADED WITH WRONG MONSTK
         LI,R15   BADMONM
         CAL1,2   PRNT15
         LI,R1    BA(BADMONM)
         BAL,R15  TYPEIO
         LI,R1    FPEXIT
         B        IORUNDWN
BADMONM  TEXTC    ' FSAVE LOADED WITH WRONG MONSTK...TRY AGAIN'
NOPRIVM  TEXTC    ' C0 PRIVELEDGE REQUIRED TO USE FSAVE'
         FIN
         PAGE
*
*        COULD NOT GET ENOUGH PAGES,ASK
*        FOR 5 PAGES OR QUIT IF .LT. 5 AVAIL
*
SP:INIT  LI,R7    GET:CC            ADDRS WHERE TO GO WHEN DONE
         PSW,R7   *STKPNTR          SAVED FOR EXIT HEREIN
SP:INIT1 LW,R5    PAGETOTAL         GET TOTAL PAGE CNT NOW
         LI,R6    X'09'             SET UP
         STB,R6   R5                FREE PAGE FPT
         CAL1,8   R5                FREE ALL WE GOT
         CAL1,8   GETPAGES          ASK FOR SOME NOW
         DO       UTS>=2
         CI,R8    6                 MUST HAVE 6
         ELSE
         CI,R8    5                 MUST HAVE 5
         FIN
         BL       NOTENUFF          TOO LOW
         STW,R9   BUF:LIMS          SET BUFFER AREA LOWER LIMIT
         LI,R1    2                 SET DATA LOOP
         STW,R1   DAPAGES           LEAVE COUNT FOR LATER USE
         STW,R1   DBUF              SET TABLE HEAD FOR
         STW,R9   DBUF,R1           READING
         AI,R9    512               READING
         BDR,R1   %-2
         LI,R1    1                 ONE FOR TAPE
         STW,R1   TAPAGES           LEAVE COUNT SET
         STW,R1   TBUF              SET TABLE HEAD
         STW,R9   TBUF,R1           SET AWAY PAGE ADDRESS
         AI,R9    512               INCREMENT TO NEXT PAGE
         LI,R1    2                 TWO IPOOLS
         STW,R1   INDPAGES          LEAVE COUNT SET
         STW,R1   IBUF              SET TABLE HEAD
         STW,R9   IBUF,R1           SET TABLE ENGRY
         AI,R9    IBUFSIZ           INCREMENT TO NEXT IPOOL
         BDR,R1   %-2
         STW,R9   LIMIT             SET UP
         STW,R9   CURPOS            SENTINEL RING BUFFER
         AI,R9    511               INCREMENT TO HIGH SPOT
         STW,R9   BUFTOP            LEAVE HIGH SPOT
         STW,R9   BUF:LIMS+1        SET BUFFER AREA UPPER LIMIT
         PLW,R7   *STKPNTR
         B        0,R7
         PAGE
*
*
*
*        INITIALIZE DATA/TAPE BUFFER TABLES
*
*
*
INITIATE4 EQU     %
         PSW,R7   *STKPNTR          SAVE LINK IF DUMP MODE
         LW,R0    DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R0    STATS             OR PRODUCING DISKPOOL
         BEZ      INITIATE5         NO, NO NEED FOR THESE BUFS
         M:GP     1                 GET SENTINEL BUFFER PAGE
         AWM,R8   PAGETOTAL         KEEP TRACK OF TOTAL
         CI,R8    1                 DID WE GET ONE
         BL       SP:INIT1          NO-USE SPECIAL CASE
         STW,R9   LIMIT             SAVE BASE ADDRS
         STW,R9   CURPOS            START ADDRS
         AI,R9    511               FIX UP HIGH
         STW,R9   BUFTOP            ADDRS
INIT0    CAL1,8   GETPAGES          GET ALL POSSIBLEPAGES
         AWM,R8   PAGETOTAL         KEEP TRACK OF TOTAL
         CI,R8    3                 MUST HAVE AT LEAST 3
         BL       SP:INIT1          TOO FEW
INIT1    LW,R5    TAPAGES           GET CURRENT COUNT
         STW,R5   TBUF              SET TABLE HEAD W/COUNT
         CI,R5    #TBUF             AT MAX YET
         BGE      INIT2             ALL DONE
         STW,R9   TBUF+1,R5         GOT ROOM..STORE ADDRESS
         MTW,1    TAPAGES           INCREMENT INDEX
         AI,R8    -1                DECREMENT #OF PAGES LEFT
         BLEZ     INIT3             DONE AT ZERO...
         AI,R9    512               BUMP ADDRS
INIT2    LW,R5    DAPAGES           GET CURRENT DATA BUFFER COUNT
         STW,R5   DBUF              SET TABLE HEAD W/COUNT
         CI,R5    #DBUF             AT MAX YET
         BGE      INIT3             CHECK TAPE TABLE
         STW,R9   DBUF+1,R5         STORE ADDRESS
         MTW,1    DAPAGES           BUMP INDEX
         AI,R8    -1                DECREMENT PAGES LEFT
         BLEZ     INIT3             DONE AT ZERO
         AI,R9    512               INCREMENT ADDRESS
         B        INIT1             DO TAPE AGAIN
INIT3    STW,R9   BUF:LIMS+1        SET BUFFER AREA UPPER LIMIT
         LW,R3    DAPAGES           PUT FINAL TOTAL
         STW,R3   DBUF              INTO TABLE HEAD
         LW,R3    TAPAGES           AND DITTO
         STW,R3   TBUF              FOR THE OTHER TABLE
INITIATE5 CAL1,8  TIMFPT1           PUT TIME INTO DATE :BOF RECORD
         DO       FILL
*  R8 CONTAINS YEAR(LEFT-HALFWORD) AND JULIAN DAY(RIGHT-HALFWORD)
         LW,R0    DUMP              NO TAPE IMPLIES
         BEZ      INIT32            NO UPDATE :BREC
         INT,R3   R8                JULIAN DAY
         LI,R8    0                 CLEAR BUFFER
         LI,R1    R8**2+3           RIGHTMOST BYTE OF BUFFER
         BAL,R15  HEXTODEC          CONVERT JULIAN DAY
         LI,R1    2                 BYTE DISP.
         LB,R0    R8,R1             BINARY ZERO
         BNEZ     %+3               NO - ALL IS WELL
         LI,R0    'F0'              YES - MAKE IT
         STB,R0   R8,R1             DECIMAL
         STH,R8   REELSN            FILL TYPE OUTSN
         REF      M:EI
,OPNBREC M:OPEN   M:EI,(FILE,'F:BREC',':SYS'),(INOUT),(DIRECT),;
                  (ERR,INIT4),(ABN,INIT4)
         LW,R1    BRECFLG           SKIP READ IF
         BNEZ     INIT31            OPEN FAILED
,RDBREC  M:READ   M:EI,(BUF,BRECREC),(SIZE,9*4),(KEY,BRECKEY),;
                  (ERR,INIT5),(ABN,INIT5)
         LH,R8    REELSN            TODAY
         CH,R8    BRECREC+7         DAY OF LAST BACKUP
         BNE      INIT31            MUST BE 1ST BACKUP TODAY
         LI,R1    2                 BYTE DISP.
         LB,R8    BRECREC+7,R1      PICK UP LETTER OF SET
         LB,R2    XTABLE
         CB,R8    XTABLE,R2
         BE       INIT31            START OVER IF LAST SET
         AI,R2    -1
         CB,R8    XTABLE,R2         SEARCH FOR LETTER
         BE       %+3               FOUND A MATCH
         BDR,R2   %-2               KEEP ON LOOKIN'
         B        INIT31            CAN'T FIND, MUST BE GARBAGE
         AI,R2    1                 USE NEXT LETTER FOR SET
         LB,R8    XTABLE,R2
         STB,R8   BRECREC+7,R1      STICK INTO SN
         LI,R1    3
         LI,R2    '0'               RECYCLE VOLUMN NO.
         STB,R2   BRECREC+7,R1      STICK IN X
         LW,R8    BRECREC+7
         STW,R8   REELSN
         B        INIT31+2
INIT31   LW,R8    REELSN            USE 1ST FOR TODAY
         STW,R8   BRECREC+7         FOR SN
         LW,R2    BRECFLG           SKIP UPDATE IF
         BNEZ     %+2               BRECFLG IS NON-ZERO
,WRBREC  M:WRITE  M:EI,(BUF,BRECREC),(SIZE,9*4),(KEY,BRECKEY)
INIT32   EQU      %
         FIN
         LI,R1    1                 HALF WORD POINTER
         MTW,0    SAVBYDATE         TEST FOR SAVE BY DATE
         BNEZ     INIT34            SKIP DEFAULT TEST IF SET
         MTW,0    SAVBYHOUR         CHECK SAVE BY TIME
         BEZ      INIT34            SKIP DEFAULT TEST IF NO TIME
         MTW,7    SAVBYDATE         SET SAVEBYDATE FLAF
         MTW,7    DEFFLG            SET FLAG FOR DEFAULT DATE
INIT34   EQU      %
         LW,R2    DATBUF+6          ,'69 ...(,7YY)
         LH,R3    DATBUF+3             24   (  HH)
         STW,R2   BKUPVLP+2
         STH,R3   BKUPVLP+2         2469    (HHYY)
         MTW,0    DEFFLG            CHECK DEFAULT FLAG
         BEZ      %+3               SKIP IF NOT SET
         LH,R3    R2,R1             YY
         STH,R3   SAVEDATE+1        SET DEFAULT DATE
         LW,R2    DATBUF+4          0 NO    (N MO)
         MTW,0    DEFFLG            CKECK DEFAULT FLAG
         BEZ      %+3
         LH,R3    DATBUF+5,R1       DD
         STH,R3   SAVEDATE,R1       SET DEFAULT DATE
         LW,R3    DATBUF+5          V 01    (N DD)
         STW,R3   BKUPVLP+1
         SLS,R2   16                NO      (MO  )
         SLS,R3   -16                 V     (  N )
         OR,R2    R3                NOV     (MON )
         AI,R2    X'3D'             INSERT HALF QUOTE
         LI,R3    12                SET SEARCH
         CW,R2    MONTHTAB,R3       FIND MATCH IN MONTH TABLE
         BE       %+2               GOTCHA
         BDR,R3   %-2
         LH,R2    MONTHN,R3         GET APPROPRIATE FIELD
         STH,R2   BKUPVLP+1         1101 (MMDD)
         MTW,0    DEFFLG            CHECK DEFAULT FLAG
         BEZ      %+2
         STH,R2   SAVEDATE          SET MM - DEFAULT DATE
         LI,R1    INITIATE          CALCULATE
         AND,R1   BIASMASK          BKGRND LOWER LIMIT
         STW,R1   DATBUF+8          FOR DATE RECORD
         PLW,R7   *STKPNTR          RESTORE
         LW,R1    SAVBYDATE         SAVE BY DATE
         BEZ      0,R7              NO
         LW,R1    SAVEDATE          ZERO IF NO DAY SPECIFIED
         BEZ      INTER22           RETURN AFTER STUFFING IN TODAY
         B        0,R7              AND USE EXIT LINK
         DO       FILL
INIT4    EQU      %                 CANNOT OPEN :BREC
         STW,R10  BRECFLG           SET A FLAG
         B        *R8               AND CONTINUE
INIT5    EQU      %                 CANNOT READ SAV RECORD
         STW,R10  BRECFLG           SET A FLAG
         M:CLOSE  M:EI,(SAVE)       CLOSE FILE
         B        *R8               AND CONTINUE
         FIN
         PAGE
*
*        GATHER CONTROL CARDS
*
GET:CC   EQU      %
         DO       UTS>0
         LC       J:JIT             CHECK ORIGIN
         BCS,12   RDCRD1            ONLINE/GHOST NO PROCESSOR CARD
         FIN
         CAL1,1   READC
         LB,R1    INBUF
         CI,R1    ' '               RUNNING AS PROCESSOR
         DO       UTS<=0            BPM STUFF
         BE       RDCARD            YEP-NO PRINT NECESSARY
         CAL1,1   WRTLL             ELSE PRINT THAT LINE
RDCARD   BAL,R14  RCD               READ NEXT CONTROL CARD
         CAL1,1   WRTLL             PRINT DATA CARDS
         BAL,R15  INTER             INTERPRET CONTROL CARD
         B        RDCARD
         ELSE
         REF      J:JIT
         BE       RDCRD1
RDCRD    CAL1,1   WRTLL             ECHO IF APPROPRIATE
RDCRD1   BAL,R14  RCD               READ A COMMAND
         BAL,R15  INTER             CHECK FOR COMMANDS
         B        RDCRD2            IT IS A COMMAND
         B        RDCRD3            IT IS A DATA CARD
RDCRD2   LC       J:JIT             CHECK ORIGIN
         BCS,12   RDCRD1            NO ECHO IF GHOST/ONLINE
         B        RDCRD             OTHERWISE ECHO
         FIN
RDCRD3   LW,R1    SELECT            ARE WE USING
         AW,R1    SKIP              DATA CARDS THIS TIME
         BEZ      NOCARDS           NOPE
         LW,R1    SORT              DO WE SORT CARDS
         BEZ      NOCARDS           NOPE
         M:OPEN   M:SO,(FILE,'DATACARDS'),(KEYED),(DIRECT),;
                       (SAVE),(OUT),(KEYM,31),(ERR,SOERR),(ABN,SOABN)
         DO       UTS>0
         LC       J:JIT             WHERE WE RUNNING
         BCS,12   MOCARDS           ONLINE OR GHOST
         FIN
         CAL1,1   PAGEFPT           NEW PAGE TO PRINT CARDS
         LI,R15   SEL:MSG           ASSUME SELECT FIRST
         MTW,0    SELECT            IS CORRECT
         BNEZ     %+2               YEP
         LI,R15   SKI:MSG           NO,MUST BE SKIP
         CAL1,2   PRNT15            PRINT MESSAGE
         LI,R1    3                 SPACE
         BAL,R15  SPACE             A FEW LINES
         MTW,1    DATACARDS         INDICATE FILE WAS CREATED
         DO       UTS<=0            FOR BPM
MOCARDS  CAL1,1   WRTLL             ECHO INPUT
         ELSE
MOCARDS  LC       J:JIT
         BCS,12   %+2               NO ECHO
         CAL1,1   WRTLL             ELSE DISPLAY IT
         FIN
         BAL,R7   SKEYUP            CREATE RECORD KEY
         BAL,R14  RD:COM            READ NEXT DATA CARD
         MTW,0    END               LAST CARD IN
         BEZ      MOCARDS           NOT YET
         M:CLOSE  M:SO,(SAVE)       SAVE SORT FILE
         LH,R0    M:SI              M:SI SHOULD BE OPEN
         CI,R0    X'0020'           BE SURE
         BAZ      %+2               NOT OPEN..ODD....
         M:CLOSE  M:SI
         M:OPEN   M:SI,(FILE,'DATACARDS'),(IN),(SEQUEN)
         LI,R9    0                 CLEAR
         STW,R9   END               END HIT FLAG
         BAL,R14  READATA           READ FIRST DATA CARD FROM SORTED FILE
NOCARDS  LW,R0    LIST              IS M:LL LIST MODE SET
         BEZ       NOIPRI
         DO       UTS<=0
         LW,R1    REELSN            MOVE SN#
         STW,R1   PRTMESS+2         TO PAGE HEADER
         FIN
         CAL1,1   LLHDR             SET M:LL PAGE HEADER
         PAGE
*
*        CONTROL CARDS IN (ENUFF TO START ANYWAY)
*
NOIPRI EQU        %
         BAL,R7   INITIATE4         COMPLETE TABLE INITIALIZATION
         DO       UTS>0
         LI,R2    -34
         LW,R1    BLANK
         STW,R1   PBUF+34,R2
         BIR,R2   %-1
         ELSE
         MTW,0    STATS             CREATE STATISTICS
         BEZ      %+2
         CAL1,1   OPENPO            YES..OPEN STAT FILE
         LW,R1    X'4E'            POINTER TO DCT1
         LW,R2    *R1              GET IT
         LB,R3    R2               AND PUT SIZE
         STW,R3   DCTSIZ           AWAY
         LI,R12   X'1FFFF'         ADDRS MASK
         AND,R12  10,R1            FOR HGP ADDRS
         STW,R12  HGP               SAVE HGP CHAIN HEAD
         LI,R8    1                SECTOR #
         LI,R1    1                INDEX TO DCTX IN HGP
         LW,R9     =X'7F0000'       MASK TO PICK
         LS,R8    *R12,R1          UP HGP DCTX (FOR SYSTEM DEVICE)
         LI,R9    12               #BYTES TO READ ACNCFU
         LI,R10   BA(ACNCFU)       BUFFER FOR ACNCFU
         BAL,R15  DISCIO           GO READ IT IN
         B        READFAIL         ***DISASTER****
         MTW,0    DIRLISTSW        LIST ACNCFU OUT
         BEZ      GETAD2           NOPE
         LI,R15   ACNCFUMS          YES
         CAL1,2   PRNT15              SET
        LI,R3     ACNCFU                UP
        LI,R1     12                      TO LIST
        BAL,R15   PLIST                      THE ACNCFU TABLE
         FIN
         DO       UTS>0
         BAL,R15  MASTER            GO MASTER MODE
         LW,R15   S:CUN             GET USER NUMBER
         DO       TAURUS=1
         LI,R1    CUN-EASECT        SAVE IT
         STW,R15  *EAADDR,R1
         ELSE
         STW,R15  CUN               AND SAVE IT
         FIN
         LW,R15   M:ACNCFU+1
         STW,R15  ACNCFU
         MTW,0    STATS
         BEZ      NOSTATS           NO DISKPOOL
         CAL1,1   OPENPO
         NOP      0                 IN CASE OPEN FAILS
NOSTATS  EQU      %
         LI,R1    MAXBQ-1           SET NUMBER OF Q'S
         SLS,R1   -1                EQUAL TO HALF
         STW,R1   MAXMF
         BAL,R15  SLAVE             GO BACCK TO SLAVE
         FIN
         PAGE
*
*        INITIALIZATION COMPLETED,READ FIRST SECTOR
*        OF ACCOUNT DIRECTORY. LOOP ENTRIES FOR
*        SUBSEQUENT SECTORS ARE;
*
*        1. 'GETAD' IF SECTOR NOT READ VIA AUTO QUEUE.
*        2. 'GETAD3' IF SECTOR NOW IN CORE.
*
GETAD2   LW,R0    DUMP              IN OUTPUT MODE
         BEZ      GETAD1            MUST NOT BE SAVING FILES
         BAL,SR3  NEWREEL           GET TAPE MOUNTED
         BAL,R7   WRTDAT            WRITE THE 'DATE' FILE ON TAPE
GETAD1   LW,R8    ACNCFU            GET D/A OF ACCOUNT DIRECTORY
         BAL,R15  DTOGRAN           VERIFY ACNCFU ADDRS
         B        READFAIL          *****DISASTER*******
GETAD    LI,R9    SECSIZE           ONE SECTOR'S WORTH
         LI,R10   BA(ACBUF)         ACBUF IS WHERE IT GOES
         MTW,1    RADXCNT           INCREMENT INDICES CNT
         BAL,R15  DISCIO            QUEUE UP
         B        READFAIL2         ***LINK FAILURE****
GETAD3   AND,R8   M24               STRIP TYC FROM CDA
         LW,R6    ACBUF             GET NEW SECTOR'S BLINK
        CW,R6    LASTAC            COMPARE TO WHERE WE WERE
        BE       GETAD4            OK,GO ON
         AI,R6    0                 ERROR,HAVE WE BACKED UP END
        BEZ      READFAIL2         YUP,BAD BLINK SEQUENCE
         STW,R6   ACFLINK           NOP,READ THE BLINK TO GET IN SYNC
         B        ADDONE            READ BACKWARDS...
GETAD4   STW,R8   LASTAC            MARK CDA
         LCI      2                 MOVE
         LM,R9    ACBUF             SECTOR POINTERS
         STM,R9   ACBLINK           INTO MY MEMORY
         LH,R9    ACBUF+2           GET SECTOR NAV
         STW,R9   ACSIZE            AND SAVE
         MTW,0    DIRLISTSW          LIST DIRECTORIES SET
         BEZ       %+2
         BAL,R14   LISTAD         PRINT THE ACCOUNT DIRECTORY
         LI,R1    ACDISP            DISPLACEMENT TO FIRST KEY
         STW,R1   NEXACN            SET AS NEXT INDEX
         STW,R1   CURACN            SET AS CURRENT INDEX
         PAGE
*
*        ACCOUNT DIRECTORY PROCESS LOOP
*
*        ENTRY FOR SUCCESSIVE KEY FETCH'S
*
NACN     EQU      %
         LW,R0    Y002
         AND,R0   M:PO              DISKPOOL ALREADY CLOSED
         BEZ      %+3
         CAL1,1   CLSPO             UPDATE ACCT JUST DONE
         NOP
         LI,R1    0                 ZAP
         STW,R1   ACEQU             SO THAT SKIP WILL WORK
         LW,R3    NEXACN            GET NEXT INDEX
         STW,R3   CURACN            UPDATE CURRENT POINTER
         CW,R3    ACSIZE            INDEX=NAV YET
         BGE      ADDONE            SECTOR COMPLETED-GET NEXT
         LI,R2    ACDKEYL            KEYLENGTH FOR ACCOUNT DIRECTORY
         AWM,R2   NEXACN            NEXACN NOW POINTS TO THE NEXT ENTRY
         DO       CPVC00=1
         AI,R3    1                 POINT TO TEXT OF KEY
         ELSE
         AI,R3    4                 POINT TO TEXT OF KEY
         FIN
         STW,R3   ACN#DISP          DISP TO ACCOUNT# IN ACBUF
SELCK    MTW,0    SELECT            IN SELECT MODE
         BEZ       SKCK             NO-BRANCH
         MTW,0     END              YES-END HIT YET
         BNEZ      ENDUP            YES-ALL DONE
         BAL,R15   ACCK              NOPE-CHECK FOR ACCOUNT # MATCHUP
         MTW,0     ACEQU            ARE THEY A MATCH
         BEZ       NACN             NO-GET NEXT ACCOUNT IN DIRECTORY
         LI,R14   NOTLB             RETURN POINT FROM RD:COM
SELCK1   LW,R0    ALL               DOING ALL FILES IN ACN#
         BEZ      NOTLB             NO-PROCESS THIS FILE
         B        RD:COM            AND READ NEXT CARD
SKCK     MTW,0     END              IS END HIT ALREADY
         BNEZ      SETALLF          YESP
         MTW,0     SKIP             NO-IS KSIP MODE ON
         BEZ       STCK             NO
         BAL,R15   ACCK             YES-CHECK FOR ACCOUNT# MATCHUP
         MTW,0     ACEQU            ARE THEY A MATCH
         BEZ       NOTLB            NO
         LI,R14   NACN              RETURN POINT FROM RD:COM
         B        SELCK1
STPCK    LW,R0    STOPAT            STOP COMMAND SET
         BEZ      SETALLF           NO,DOING ALL FILES
STPCK1   BAL,R15  ACCK              SEE IF DATA CARD MATCHES
         LW,R0    ACEQU             DOES IT
         BNEZ     ENDUP             YEP,ALL S T O P
         B        SETALLF           DO ALL FILES UNTIL STOP HIT
STCK     MTW,0     STARTSET         IN 'START' MODE
         BEZ      STPCK             ONE MORE TO CHECK
         BAL,R15  ACCK              YES..SEE IF CURRENT ACCOUNT MATCHES
         MTW,0     ACEQU            DO WE HAVE A MATCH
         BEZ      NACN              NOPE..GET NEXT ACCOUNT
         LI,R0    0                 YEP
         STW,R0   STARTSET          RESET FLAG NOW WE'RE THERE
         B        SELCK1-1          READ NEXT COMMAND ETC.
SETALLF  LI,R1    -1                SET
         STW,R1   ALL               NO SKIP/SELECT/START SET
         PAGE
*
*        THIS ACCOUNT IS TO BE PROCESSED
*
NOTLB    LI,R6    BA(ACBUF)         ACN BUFFER
         LI,R7    BA(ACN#CURNT)     SLOT FOR CURRENT ACN#
         LI,R8    8                 8 BYTES OF NUMBER
         AW,R6    ACN#DISP          DIRECTORY DISPLACEMENT
         DO       SIGMA7=0
         LB,R9    0,R6
         STB,R9   0,R7
         AD,R6    DOUBLEONE
         BDR,R8   %-3
         ELSE
         STB,R8   R7
         MBS,R6   0                 MOVE TO SLOT
         FIN
         LW,R0     LIST             LIST MODE SET
         BEZ       NOPRINT          NO-SKIP PRINTING INFORMATION
         CAL1,1   PAGEFPT
         LI,R1     2                YES-SET
         BAL,R15   SPACE            TO SKIP A LINE ON LL
         LI,R15   CR                PRINT
         CAL1,2   PRNT15            'ACCOUNT XXXXX,ETC...'
         LI,R1    2                 SKIP TWO
         BAL,R15  SPACE             LINES BEFORE FILE NAME
NOPRINT  EQU      %                 *
         LI,R1    0                 RESET THE NEW ACCOUNT'S
         STW,R1   LASTFD            BACK LINK
         STW,R1   ACNSIZE           TOTAL BYTES
         STW,R1   ACNGRAN           TOTAL GRANULES
         DO       CPV>0
         STW,R1   PACKGRAN
         STW,R1   RADGRAN
         FIN
         PAGE
*
*
*        FOUND AN ACCOUNT WE'RE GOING TO USE
*        QUEUE IN NEXT AD SECTOR IF WE'RE ON LAST
*        KEY IN THE CURRENT SECTOR
*
*
         LI,R7    GETFD0            STRAIGHT THRU ADDRESS
         LW,R1    NEXACN            NEXT INDEX TO AC DIRECTORY
GETDFD0  AI,R1    BA(ACBUF)         ADD CORE ADDRS
         AI,R1    ADKBD             BACK UP TO DISC ADDRS BYTE3
         LI,R2    4                 4 BYTE LOOP
         DO       SIGMA7=0
GETDFD   LB,R4    0,R1              GET A BYTE OF DISC ADDRS
         AI,R1    -1
         SLD,R4   -8                SHIFT R4 AND R5 RIGHT 8 BITS
         BDR,R2   GETDFD
         LW,R8    R5                R8 = DISC ADDRESS
         ELSE
         LI,R3    32                DEST BA OF R8
         STB,R2   R3                SET MOVE COUNT
         LW,R2    R1                SOURCE BA TO R2
         AI,R2    -3                BACK UP TO BYTE0
         MBS,R2   0                 MOVE OUT DISC ADDRESS
         DO1      CPVC00=1
         AND,R8   M24               MASK OFF GARB FROM TEXTC
         FIN
         B        0,R7              EXIT OR FALL THRU
GETFD0   BAL,R15  DTOGRAN           VERIFY DISC ADDRESS
         B        ADERROR           BAD ACN KEY-REPORT IT
         LW,R9    M24               DISC ADDRESS MASK
         CS,R8    FDFLINKQ          HAVE WE READ THE FIRST SECTOR
         BE       %+3               YEP,SEE IF IN CORE
         MTW,1    FDRAT             NO,BUMP RATE ERROR
         B        GETFDA            AND READ IT NOW
         LI,R7    GETFD1            SET RETURN POINT
         LI,R1    FDFLINKQ          QUEUEING CELL
         B        IOSPIN            CHECK EVENT COMPLETION
GETFDA   LI,R9    SECSIZE           ONE SECTOR'S WORTH
         MTW,1    RADXCNT           BUMP INDICES CNT
         LI,R10   BA(FDBUF)         BUFFER FOR FILE DIRECTORY
GETFD    BAL,R15  DISCIO            GO READ IT
         B        READFAIL3         LINK FAILURE**********
GETFD1   AND,R8   M24               STRIP TYC FROM CDA
         LW,R6    FDBUF             GET NEW BLINK
        CW,R6    LASTFD            COMPARE TO WHERE WE WERE
        BE       GETFD2            OK,GO ON
        AI,R6    0                 BACKED UP TO END YET
        BEZ      READFAIL3         YUP,BAD BLINK SEQUENCE
        STW,R6   FDFLINK           NO,READ THE BLINK TO GET INTO SYNC
         B        FDDONE            SOMEWHERE IN DIRECTORY
         PAGE
*
*        A FILE DIRECTORY SECTOR IS READY TO BE PROCESSED.
*        MOVE SECTOR INFO INTO TABLES,SET UP POINTERS TO
*        SEARCH THE SECTOR.
*
GETFD2  STW,R8   LASTFD            MARK CDA IN DIRECTORY
         LCI      2                 MOVE
         LM,R9    FDBUF             SECTOR
         STM,R9   FDBLINK           POINTERS
         LI,R2    FDDISP            INITIAL INDEX
         AI,R9    0                 IS THIS FIRST SECTOR
         BNEZ     %+2               NOPE
         AI,R2    FDKEYL            YEP..JUMP OVER NULL KEY
         STW,R2   NEXFILE           AND STORE INDEX AWAY
         LH,R9    FDBUF+2           GET SECTOR NAV
         STW,R9   FDSIZE            AND SAVE
         LW,R3     NEXACN           GET NEXT INDEX TO AD
         CW,R3     ACSIZE           WILL IT BE LAST KEY
         BL        GETFD3           TOO EARLY
         LW,R8     ACFLINK          YES..GET FWD LINK
         BEZ       GETFD3           NONE..DIRECTORY ENDS HERE
         BAL,R15   DTOGRAN          VERIFY FLINK
         B         GETFD3           NO GOOD..DEFER ERROR
         LI,R1     ACFLINKQ         OK..SET
         LI,R10    BA(ACBUF)              UP
         BAL,R15   QSECTOR                  READ
GETFD3   MTW,0    DIRLISTSW         LIST THIS DIRECTORY
         BEZ       %+2              NOPE
         BAL,R14  LISTFD            YEP...LIST IF
         PAGE
*
*        FILE DIRECTORY PROCESS
*
*        LOOP ENTRY  FOR SUCCESSIVE KEY FETCH'S
*
GETFILE  EQU      %
         B        NODATE2           RETURN IS TO NEXT INSTRUCTION
         LI,R7    GETFILE2          STRAIGHT THRU EXIT ADDRS
         LW,R3    NEXFILE           MOVE 'NEX' KEY INDEX
         STW,R3   CURFILE           TO CURRENT INDEX
         CW,R3    FDSIZE            INDEX=NAV YET
         BGE      FDDONE            SECTOR COMPLETED-GET NEXT
         AI,R3    FDKEYL            ADD KEY ELNGTH
         STW,R3   NEXFILE           TO PRODUCE NEXT INDEX
         BAL,R6   PUSHKEY           SAVE KEY IN BUF
GETFILE1 AI,R3    BA(FDBUF)         ADD CORE ADDRS
         DO       UTS>=3
         LI,R1    8
         ELSE
         LI,R1    4                 SO
         FIN
         DO       SIGMA7=0
         AI,R3    FDKBD             BACK UP TO BYTE 3 OF DA
         LB,R4    0,R3              LOOP
         AI,R3    -1                    GETTING
         SLD,R4   -8                       DISC
         BDR,R1   %-3               ADDRESS OF THIS FILES FIT
         LW,R8    R5                DISC I/O WANTS IT IN R8
         ELSE
         LI,R5    32                DEST BA OF R8
         STB,R1   R5                SET MOVE COUNT
         LW,R4    R3                SET UP SOURCE BA
         AI,R4    FDKBD-3           POINT TO BYTE0 OF D/A
         MBS,R4   0                 MOVE OUT DISC ADDRS
         FIN
         B        0,R7              EXIT OR FALL THRU
GETFILE2 EQU      %
         DO       UTS>=3
         SLS,R9   -8                POSITION IT
         AND,R9   =X'FFF0FFFF'      MASK OFF DYNAMIC BITS
         OR,R9    =X'00800100'      STICK IN CHANGE BITS
         STW,R9   STDESCR           AND SAVE
         MTW,0    DUMP              DUMP TO TAPE
         BEZ      GETFILE2A         NO - SKIP AUTO BACKUP TEST
         MTW,0    SELECT            SELECT MODE
         BNE      GETFILE2A         YES - SKIP AUTO BACKUP TEST
         CI,R9    X'800'            NO AUTO BACKUP DESCR. SET
         BANZ     GETFILE           YUP....SKIP THIS FILE
GETFILE2A EQU     %
         CI,R9    X'4000'           IS FILE SYNON
         BAZ      %+2               NO
         MTW,3    SYNFLAG           YES,SET FLAG
         FIN
         BAL,R15  DTOGRAN           VERIFY DISC ADDRS
         B        FDERR             ***INVALID******
         LW,R9    M24               DISC ADDRESS MASK
         CS,R8    FITDA             IS FIT ALREADY READ IN NOW
         BE       GETFILE3          YEP,GO ON
         MTW,1    FITRAT            BUMP RATE ERROR TOTAL
         B        GETFILE4          AND READ IT NOW
GETFILE3 LI,R1    FITDA             CHK IF NOW COMPLETED
         LI,R7    FITCHKS           FOR COMPLETION
         B        IOSPIN
GETFILE4 LI,R9    SECSIZE
         MTW,1    RADXCNT           BUMP INDICES CNT
         LI,R10   BA(FITBUF)        BUFFER TO PUT IT IN
         BAL,R15  DISCIO            GO READ IT
         B        FDERR             ERROR RETURN HERE
         PAGE
*
*        WE HAVE A FIT, CHECK IF FILE IS TO BE USED.
*        CHECK IF ON LAST FD KEY, QUEUE NEXT SECTOR
*        IF WE'RE USING THE LAST KEY NOW.
*
**
FITCHKS  EQU      %
         DO       UTS>=3            ASSUME FIT AT END OF SECTOR
         LI,R6    FITBUF+DIRSIZ-80  SET INDEX TO TEST
         LI,R5    1                 ASSUMPTION HERE
         MTH,0    FITBUF+2,R5       IS WE RIGHT
         BL       %+2               YEP,R6 HAS POINTER
         LI,R6    FITBUF+4          NOPE,FIT IN FIRST PART
         STW,R6   FITLOC            START OF FIT
         SLS,R6   2                 BA(FIT)
         LI,R7    X'7FFFF'          MASK
         STS,R6   FNEA              STORE
         SLS,R6   -2                WA(FIT)
         AI,R6    9                 START OF SCAN
         STW,R6   INITX
         LB,R3    *FITLOC           BYTE NAME OF NAME IN F.I.T.
         ELSE
         LB,R3    FITBUF+3           BYTE LENGTH OF NAME IN F.I.T.
         FIN
         BEZ      FITSNAP           ERROR IF ZERO/LESS
FITCHKS05 LW,R4   CURFILE           CURRENT INDEX TO DIRECTORY
         AI,R4    BA(FDBUF)         GETS CORE SBA
         DO       UTS>=3            CO1 CODE
         LW,R0    SYNFLAG           IS CURRENT FILE SYNON
         BEZ      FITCHKS07         NO
         AI,R6    -10               YES-START SCAN BACK 10
         STW,R6   INITX
         LW,R3    =X'0B000909'      B ENTRY CODE WORD
         STW,R3   *INITX            STICK IT INTO FIT
         LB,R3    0,R4              YES,GET BYTE CNT FROM FD KEY
         FIN
         DO       UTS>0             ANY UTS CODE
FITCHKS07 STB,R3  FNEC              STORE BYTE CNT
         LI,R5    18                MAX PRINT LINE NAME
         CW,R3    R5                NAME OK
         BLE      %+2               YEP
         STB,R5   FNEC              NO,TRUNCATE NAME TO 18 BYTES
         FIN
         AI,R3    1                 CREATE FULL STRING COUNT
         STB,R3   FNEA              AND SAVE
         STB,R3   FNEB              DITTO
         DO       UTS>=3            CO1 ONLY
         LW,R0    SYNFLAG           CURRENT FILE SYNON
         BE       FITCHKS08         NO
         LW,R5    FNEA              BA NAME INFIT
         CBS,R4   0                 FD NAME GREATER THAN FIT NAME
         BG       FITCHKS30         YES - OK TO SAVE
         LI,R15   SYNERR            IMPOSSIABLE TO SAVE
         B        FITCHKS21         PRINT MESSAGE
FITCHKS08 EQU     %
         FIN
         DO       SIGMA7=0
         LB,R5    0,R4              TEXT CNT FROM FD KEY
         AI,R5    1                 TOTAL LENGTH
         LI,R6    0                 INDEX TO ALL POSITIONS
FITCHKS10 LB,R2   0,R4              BYTE FROM FD
         CB,R2    FITBUF+3,R6       MATCH THE FIT NAME
         BNE      FITCHKS20         DIRECTORY/FIT ERROR
         STB,R2   BOFBUF+2,R6       MOVE TO :BOF
         AI,R6    1
         AI,R4    1
         BDR,R5   FITCHKS10
         B        FITCHKS30
         ELSE
         LW,R5    FNEA              GET CBS DESTINATION
         CBS,R4   0                 FD MATCH FIT
         BE       FITCHKS30         YEP-CONTINUE
         FIN
FITCHKS20 LI,R15  FNERR             FIT .NE. FD KEY
FITCHKS21 EQU     %
         CAL1,2   PRNT15            TO PRINT ERROR MSG
         BAL,R11  BLD:BOF70         QUEUE NEXT (OR TRY TO)
         B        FITERR            PROCESS FIT ERROR
FITCHKS30 SW,R4   R3                BACK UP SBA TO START OF NAME
         LW,R5    FNEB              GET BOF DEST BA
       DO      SIGMA7=1
         LI,R0    0                 ZAP THE
         LW,R1    BOFBUFBA          FIRST PART
         MBS,R0   0                 OF BOFBUF
         MBS,R4   0                 NAME TO BOFBUF
       ELSE
       LB,R6   R5            CNT
       LB,R0   0,R4          XFER
       STB,R0  0,R5          BYTES
       AD,R4   DOUBLEONE
       BDR,R6  %-3
       FIN
         PAGE
*
*        FIT MATCHES FILE DIRECTORY KEY
*
*
*        Q NEXT FD SECTOR IF ON LAST FD KEY,OR Q NEXT FD
*        IN SEQUENCE IF ON LAST FD SECTOR/LAST KEY
*
         LI,R11   FITCHKS56         STRAIGHT THRU ADDRS
         LI,R0    0                 MAKE SURE COMING THRU HERE
         STW,R0   FDFLINKQ          CELL IS RESET
FITCHKS31 LW,R3   NEXFILE           GET NEXT INDEX TO SECTOR
         CW,R3     FDSIZE            IF
         BL        FITCHKS55           READ
         B        FITCHKS55         *******NO RAHEAD ON F.D. TIL PROB FIXED
         LW,R8    SELECT            NO FD READ AHEAD
         BNEZ     FITCHKS55         IF IN +SELECT MODE
         LW,R8     FDFLINK              AHEAD
         BNEZ     FITCHKS50         CAN READ CHAIN AHEAD
         LW,R1    NEXACN            NO MORE IN CHAIN..IS THERE A NEW
         AI,R1    ACDKEYL           KEY IN AC SECTOR
         CW,R1    ACSIZE            GREATER THAN NAV
         BLE      FITCHKS40         CAN READ IN CURRENT SECTOR
         MTW,0    ACFLINKQ          NO..IS NEXT SECTOR IN CORE YET
         BLEZ     FITCHKS55         NOPE..CAN'T READ AHEAD
         LI,R1    ACDISP+ACDKEYL    IT IS IN..GET INITIAL KEY
FITCHKS40 BAL,R7  GETDFD0           GET NEXT FD DISC ADDRESS
FITCHKS50 BAL,R15 DTOGRAN           VERIFY DISC ADDRESS
         B         FITCHKS55                 DONE
         LW,R9    M24               INSURE SECTOR ISN'T
         CS,R8    FDFLINKQ          ALREADY QUEUED
         BE       FITCHKS55         IT IS,QUIT NOW
         LI,R1     FDFLINKQ         YEP
         LI,R10    BA(FDBUF)          SET
         BAL,R15   QSECTOR                UP
FITCHKS55 B       *R11              EXIT/FALL OUT
FITCHKS56 EQU     %
         LW,R1    SKIP              SKIPPING
         BEZ      FITCHKS57         NO...MAYBE SELECT
         MTW,0    ACEQU             ACCOUNT EQUAL
         BEZ      BLD:BOF           NO...DO IT
         LW,R1    ALL               SKIPPING ALL FILES IN ACCT
         BNEZ     NACN              YUP
         B        FITCHKS58         NOPE
FITCHKS57 EQU     %                 HERE IF NOT SKIP
          LW,R1   ALL               DOING ALL FILES
         BNEZ     BLD:BOF           YEP
         MTW,0    ACEQU             ARE DATA CARDS STILL=TO CUR ACN#
         BEZ      ENDOFDT           NOPE..MOVE TO NEXT ONE
         MTW,0    SORT              DID FSAVE SORT CARDS
         BNEZ     %+2               YEP,CARD IS TEXTC NOW
FITCHKS58 EQU     %
         BAL,R1   SKEYUP0           NO,MAKE IT TEXTC NOW
         LB,R3    INBUF+3           GET NAME BYTE COUNT
         CB,R3    BOFBUF+2          COMPARE TO DIRECTORY BYTE CNT
         BGE      %+2               OKAY AS IS
         LB,R3    BOFBUF+2          WANT LARGER BYTE COUNT
       LI,R4   BA(BOFBUF+2)+1    MATCH CURRENT FIE NAME
       LI,R5   BA(INBUF+3)+1     AGAINST CURRENT DATA CARD
         BAL,R14  CBYTE                          FOR NAME MATCH
         B        FITCHKS60         FILE NAME MATCHES
         BG       FITCHKS90         ALREADY PASSED IT
         B        FITCHKS80         IS NO MATCH AND OK STILL
FITCHKS60 BAL,R14 RD:COM            READ NEXT CARD
         LD,R2    INBUF             GET NEXT ACN# FROM CARD
         CD,R2    ACN#CURNT         NEW NUMBER
         BE       FITCHKS70         NOT YET
         LI,R0    0                 YES..DEFINITELY
         STW,R0   ACEQU             RESET EQUAL FLAG
FITCHKS70  MTW,0  SELECT            SELECT MODE SET
         BEZ      GETFILE           NO-GET NEXT FILE
         B        BLD:BOF           YES-PROCESS FILE
FITCHKS80  MTW,0  SKIP              SKIP MODE SET
         BEZ      GETFILE           NOPE-GET NEXT FILE
         B        BLD:BOF           AND PROCESS
FITCHKS85 EQU     %                 PASSED FILE NAME ON SKIP DATA CARD
         LI,R14   0                 ZAP ACCOUNT
         STW,R14  INBUF             ON DATA CARD
         STW,R14  ALL               MAKE
         STW,R14  ACEQU             IT
         BAL,R14  RD:COM            WORK
         B        BLD:BOF           AND PROCESS FILE
         PAGE
*
*
*        PASSED FILE NAME SPECIFIED ON DATA CARD
*
*
FITCHKS90  EQU    %
         MTW,0    SKIP              ARE WE HERE BECAUSE OF SKIP
         BNEZ     FITCHKS85         YEAH...SPECIAL HANDLING
         LI,R1    BA(PSMSG1)        TYPE
         BAL,R15  TYPEIO            WARNING MESSAGE
         LI,R3    BA(INBUF+3)       CLEAR TEXTC FIELD
         LI,R4    ' '               ON DATA CARD
         STB,R4   0,R3              FOR TYPING
         LI,R3    45                DISPLAY
         LI,R1    BA(INBUF)         ENTIRE DATA CARD
         BAL,R15  TYPEIO2
         M:PRINT  (MESS,PSMSG1)     SEND TO PRINTER
         M:WRITE  M:LL,(BUF,INBUF),(SIZE,45)
         BAL,R14  RD:COM            READ NEXT DATA CARD
         BAL,R15  ACCK              DATA CARD MATCH CUR ACN#
         MTW,0    ACEQU             MAKE TEST
         BEZ      ENDOFDT           NO..NEW NUMBER ON CARD
         LW,R3    CURFILE           LAST INDEX
         STW,R3   NEXFILE           OK..BACK UP ONE KEY
         B        GETFILE           YEP..SMAE # GET NEXT FILE
         PAGE
*
*        THIS FILE IS TO BE USED
*        ESTABLISH FIT INFO AND Q FDA IN
*
BLD:BOF  EQU      %
         MTW,0    FITLISTSW         DUMP FIT OUT
         BEZ      %+2               NOPE
         BAL,R14  LISTFIT           YEP..DUMP TO M:LL
         DO       UTS>=2
         MTW,1    DELREC            POSSIBLE DELETED RECORD
         LW,R2    ICONKEY           INITIALIZE OLD CON. FILE KEY
         STW,R2   CONKEY
         FIN
         LI,R2    0                 CLEAR
         STW,R2   LASTGRAN          RESET SECTOR CROSSING CELL
         STW,R2   MIXBUF            RESET BUFFER POINTER
         STW,R2   MIXEOF            RESET END OF FILE HIT
         DO       TAURUS=1
         LI,R1    MIX:CNT2-EASECT   RESET NUMBER RECEIVED
         STW,R2   *EAADDR,R1
         ELSE
         STW,R2   MIX:CNT2          RESET NUMBER RECEIVED
         FIN
         STW,R2   NXTFLNK           ZAP READ-AHEAD
         DO       TAURUS=1
         LI,R1    MIX:CNT1-EASECT   RESET NUMBER MOVED
         STW,R2   *EAADDR,R1
         ELSE
         STW,R2   MIX:CNT1          RESET NUMBER MOVED
         FIN
         STW,R2   SYNFLAG           MAKE SURE SYNFLAG WAS RESET
         LI,R2    X'0B'             SYNON FLAG
         BAL,R15  CODESCAN          SEE IF SYNON FILE
         B        BLD:BOF05         NOPE
         MTW,7    SYNFLAG           SET FLAGS
         STW,R0   BENTRY            AND SAVE LOCATION OF '0B'
         B        BLD:BOF10         WE DON'T READ FDA FOR SYNON
BLD:BOF05  LW,R1  INDPAGES          TOTAL INDICES BUF COUNT
         LI,R2    X'FFFF'           SET UP
         BAL,R11  RELMIX            TO RELEASE/CLEAR
         STW,R2   INDEXDA,R1        ALL INDICES
         DO       TAURUS=1
         STW,R2   *MIXSTAT,R1       TABLES
         ELSE
         STW,R2   MIX:STAT,R1       TABLES
         FIN
         BDR,R1   %-3               FINISH UO
         LD,R2    DSTKPNTR          RELEASE DATA
         STD,R2   DSTACK            STACK SPD
         LI,R2    X'0C'             NEED C ENTRY
         BAL,R15  CODESCAN          FIND IT
         BAL,R0   FITSNAP           *** FILE ERROR ***
         AI,R0    1                 GOT IT-ADVANCE POINTER
         LW,R8    *R0               PICK IT UP
         BGEZ     %+2               HIGH ORDER BIT SET IF NULL FILE
         LI,R8    0                 NULL FILE---SET FDA=0
         STW,R8   FDA               AND SAVE
         MTW,0    FDA               IS NULL FILE
         BEZ      BLD:BOF10         YES..NO READ AHEAD
         BAL,R15  DTOGRAN           VERIFY DISC ADDRESS
         BAL,R0   FITSNAP           *** FILE ERROR ***
         LW,R1    SAVBYHOUR         ARE WE SAVING
         AW,R1    SAVBYDATE         BY HOUR/DATE
         BNEZ     BLD:BOF10         YEP..NO READ AHEAD
         STW,R8   NXTFLNK           OK..SET FLAGS
BLD:BOF10 LI,R0   0                 SET UP TO
         DO       FILL
         LI,R1    -64               CLEAR
         STW,R0   TLABUF+64,R1        OLD
         STW,R0   TPLBUF+64,R1          TAPE
         ELSE
         LI,R1    -7                CLEAR
         STW,R0   TLABUF+7,R1         OLD
         STW,R0   TPLBUF+7,R1           TAPE
         FIN
         BIR,R1   %-2                     LABELS
         LI,R2    X'09'             NEED NINE ENTRY
         BAL,R15  CODESCAN          GO FIND IT IN FIT
         BAL,R0   FITSNAP           NOT FOUND IN FIT
         LW,R1    R0                MOVE FIT INDEX TO R1
         AI,R1    1                 BUMP INDEX TO CORRECT SPOT
         LI,R0   0
         LW,R2    *R1               GET ORG FROM FIT
         STW,R2  ORG                SAVE ORG
         LI,R3    3                 INDEX TO KEYM SLOT
         LH,R2    ORG               GET FILE ORG/KEYM
         STB,R2   KEYM,R3            AND FILE AWAY KEYM
         LI,R2   13                 SET UP TO FIND 'D' ENTRY IN THE FIT
         BAL,R15 CODESCAN           RETURN WITH ADDR OF CODE IN R1
         B       BLD:BOF15
         AI,R0   1
         LW,R0   *R0                INDEX IN R0
BLD:BOF15  STW,R0 RANDOM            PLACE AWAY GRANULE COUNT
         LB,R4    ORG               GET FILE ORG
         CI,R4    3                 IS RANDOM FILE
         BE       %+2               YEP,NO INDICES IN FILE
         BAL,R15  QUEMIX            QUEUE FIRST SECTOR
BLD:BOF18 LI,R4   BOFBUF+10         FIRST ADDRS IN :BOF BUFFER
         DO       FILL
         STW,R4   BUFLOC            SAVE IT
         LI,R4    TLABUF+7          1ST ADDR. OF VLP'S IN TLABEL
         STW,R4   BUFLOC+1          SAVE IT TOO.
         FIN
         MTW,0    SYNFLAG           IS CURRENT FILE SYNON...
         BEZ      BLD:BOF20         NO
         LW,R0    BENTRY            LOCATION OF B ENTRY
         BAL,R15  MOVENTRY          AND MOVE SYNON STUFF
         DO1      FILL
         STW,R4   BUFLOC+1          SAVE POSITION
BLD:BOF20   LCI   2                 SET UP
         LM,R1    BOFINFO           :BOF RECORD
         STM,R1   BOFBUF            WITH ':BOF',ETC...
         LW,R1    BLANK
         MTW,0    SYNFLAG           IS CURRENT FILE SYNON
         BEZ      %+2               NO
         OR,R1    SYNMSG            YES-PLACE 'SYN ' IN TAPE LABEL
         STW,R1   TPLBUF
         MTW,0    SYNFLAG           IS CURRENT FILE SYNON...
         DO       UTS=0
         BNEZ     BLD:BOF41
         ELSE
         BNEZ     BLD:BOF40
         FIN
         LI,R2    3                 WANT PASSWORD ENTRY
         BAL,R15  CODESCAN          GO SEE IF THERE
         B        BLD:BOF25         NO PASSWORD FOR THIS FILE
         LW,R1    R0                R0 POINTS TO CODE ENTRY
         LCI      2                 MOVE
         LM,R14   1,R1                PASSWORD
         DO       UTS=0
         STM,R14  PBUF+21
         ELSE
         STM,R14  PBUF+29
         FIN
         DO1      FILL
         LW,R4    BUFLOC            PASSWORD GOES IN :BOF
         BAL,R15  MOVENTRY          MOVE IT TO :BOF RECORD
         DO1      FILL
         STW,R4   BUFLOC            SAVE POSITION
BLD:BOF25  MTW,0  DUMP              OUTPUT TO TAPE
         BEZ      BLD:BOF50         NOPE...GET CREATION DATA
         LI,R5    #CODES            # TO MOVE INTO :BOF
         DO1      FILL
         LW,R4    BUFLOC            FOLLOWING GO IN :BOF
BLD:BOF30 LB,R2   CODES,R5          GET CODE NUMBER
         BAL,R15  CODESCAN          GO LOOK FOR IT
         B        %+2               NOT PRESENT
         BAL,R15  MOVENTRY          MOVE IF PRESENT
         BDR,R5   BLD:BOF30         FINISH UP
         DO       FILL
         STW,R4   BUFLOC            SAVE POSITION
         LW,R4    BUFLOC+1          DATES GO IN TLABEL
         LI,R5    #CODES1           # TO MOVE INTO TLABEL
BLD:BOF35 LB,R2   CODES1,R5         VLP CODE #
         BAL,R15  CODESCAN          LOOK FOR IT
         B        %+2               NOT THERE
         BAL,R15  MOVENTRY          MOVE IF THERE
         BDR,R5   BLD:BOF35         KEEP ON TRUCKIN'
         STW,R4   BUFLOC+1          SAVE POSITION
         FIN
         DO       UTS>0             UTS CODE ONLY
BLD:BOF40 LI,R0   BKUPVLP           MOVE NEW BACKUP
         DO1      FILL
         LW,R4    BUFLOC+1          POSITION
         BAL,R15  MOVENTRY          TO :BOF(OR TLABEL) RECORD
         LCI      2                 AND NOW
         LM,R0    VLP11             MOVE CODE 11
         STM,R0   0,R4              TO TLABEL
         AI,R4    2                 BUMP POINTER
         DO1      FILL
         STW,R4   BUFLOC+1          AND SAVE
         ELSE
         FIN
BLD:BOF41 LW,R1   9ENTRY            MOVE LAST ONE (CODE=09)
         DO1      FILL
         LW,R4    BUFLOC            POSITION FOR 09 IN :BOF
         STW,R1   0,R4              PUT 09 CODE IN BOFBUF
         AI,R4    1                 ADVANCE :BOFBUF POINTER
         LB,R1    ORG               GET ORG
         STB,R1   TLABUF+3
         LH,R1    ORG               GET ORG AND KEYM
         MTW,0    SYNFLAG           IS CURRENT FILE SYNON
         BEZ      %+2               NOPE
         LI,R1    3                 YES-SET KEYM=3
         SLS,R1   8
         AW,R1    VOL#              INSERT CURRENT VOLUMN #
         SLS,R1   8
         STW,R1   *R4                  PUT ORG,KEYM,AND VOL IN :BOF RECORD
         LB,R1    ORG
         CI,R1    3
         BNE      BLD:BOF45         BRANCH IF FILE NOT RANDOM
         LW,R1    RANDOM
         STW,R1   TLABUF+4          STORE GRANULE COUNT
         LW,R2    KEYM              KEYM='07' OR '0B' FOR RANDOM
         STW,R2   TLABUF+3
         LI,R1    3
         STB,R1   TLABUF+3
         LW,R1    =X'1030100'
         STW,R1   0,R4              STORE 09 ENTRY WORD
BLD:BOF45 AI,R4   1                 ADVANCE TO NEXT POSITION
         DO       FILL
         LW,R1    BUFLOC+1          END POSITION OF TLABEL
         AI,R1    -TLABUF           WORD SIZE OF BUFFER
         SLS,R1   2                 WORDS TO BYTES
         AI,R1    -1                TEXTC
         STB,R1   TPLFLG            FIX UP COUNT
         FIN
         LW,R1    TPLFLG
         MTW,0    LABELEDT          FPURGE TAPE
         BEZ      %+2               YES
         LI,R1    0                 NO-NO TAPE LABEL
         STW,R1   0,R4              MOVE IT TO TAPE LABEL
         AI,R4    1                 TO BOFBUF POSITION
         DO1      FILL
         STW,R4   BUFLOC            SAVE POSITION
         AI,R4    -BOFBUF           GET WORD SIZE OF BOF BUFFER
         SLS,R4   2                 WORDS TO BYTES
         STW,R4   BOFSIZE
         DO       UTS=0
BLD:BOF50 LI,R2   X'0A'             DATE FIELD CODE
         BAL,R15  CODESCAN          FIND CREATION DATE IN THE FIT
         B        BLD:BOF60         NO CREATION DAYE PRESENT
         AI,R0    1                 GET AND
         LCI      2                 STORE FILE CREATION
         LM,R2    *R0               DATE INTO TAPE LABEL
         STM,R2   TLABUF+5
         ELSE
         DO       UTS>=3            CO1 CODE
         LW,R1    SYNFLAG           CURRENT FILE SYNON
         BNEZ     BLD:BOF60         YES,JUMP DOWN
         FIN
BLD:BOF50 LI,R1   0
         LI,R2    0                 PRE:INIT DATE BUF'S
         LCI      2                 CLEAR
         STM,R1   READ:AC           READ ACCOUNTS CELL
         LW,R3    DATE:TAB          GET LENGTH OF ENTRIES
BLD:BOF51 LW,R4   DATE:TAB,R3       DESTINATION SLOT WA
         LCI      2                 SUPPRESS
         STM,R1   *R4               PRIOR TO SEARCH
         LB,R2    DATE:FLD,R3       GET CODE NUMBER
         BAL,R15  CODESCAN          SEE IF IN FIT
         B        BLD:BOF52         NOT PRESENT
         AI,R0    1                 FOUND IT
         CI,R2    X'0A'             MOD DATE
         BNE      BLD:BOF5A
         LCI      3                 MOVE 3 WORDS
         B        BLD:BOF5B
BLD:BOF5A EQU     %
         LCI      2                 MOVE
BLD:BOF5B EQU     %
         LM,R5    *R0               IT FROM FIT
         STM,R5   *R4               TO OUR SLOT
BLD:BOF52 BDR,R3  BLD:BOF51         FINISH LOOKING FOR DATES
         LI,R2    5                 SET UP TO
         BAL,R15  CODESCAN          FIND READ ACCOUNTS
         B        BLD:BOF53         NONE SPECIFIED
         AI,R0    1                 ADJUST
         LCI      2                 MOVE
         LM,R0    *R0                 FROM
         STM,R0   READ:AC               FIT TO BUF
BLD:BOF53 LCI     2                 NOW GET
         LM,R2    BKUPVLP+1         BACKUP DATE FOR FRES TO CHECK
         STM,R2   TLABUF+5
         LM,R2    MOD:DATE          MODIFICATION DATE
         FIN
         LW,R1    SAVBYDATE         CHECK IF SAVING
         AW,R1    SAVBYHOUR         BY DATE AND/OR HOUR
         BEZ      BLD:BOF60         NEITHER...
         MTW,0    SAVBYDATE         BY DATE THEN
         BEZ      BLD:BOF55         NOPE
         LI,R5    1                 HALFWORD DISPLACEMENT TO YEAR IN R3
         LH,R4    R3,R5             GET YEAR INTO R4
         CH,R4    LASTACT+1,R5      COMPARE YEARS
         BL       %+5               EARLIER
         BG       %+3               LATER
         CD,R2    LASTACT           COMPARE TO LAST DATE
         BL       %+2               NOPE..STILL HAVE HIGH DATE
         STD,R2   LASTACT           MAKE IT LAST DATE
         CH,R4    SAVEDATE+1        FILE QUALIFY
         BL       GETFILE           NO...GET NEXT IF EARLIER YEAR
         BG       BLD:BOF60         SAVE IT IF LATER YEAR
         CW,R2    SAVEDATE          FILE QUALIFY
         BL       GETFILE           NO,GET NEXT IF EARLIER DATE
         BG       BLD:BOF60         SAVE IT IF LATER DATE
BLD:BOF55   MTW,0 SAVBYHOUR         SAVE BY HOUR SET
         BEZ      BLD:BOF60         NOPE..GO ON AND SAVE THIS FILE
         LW,R4    =X'FFFF0000'      MASK OFF YEAR
         AND,R4   R3                CREATED
         OR,R4    =X'0000F5F9'      IGNORE MINUTES IF SPEC'D.
         CW,R4    SAVEHOUR          TEST AGAINST HOUR CREATED SUPPLIED
         BL       GETFILE           NOPE..GET NEXT FILE
BLD:BOF60   MTW,0 DUMP              ARE WE WRITING TAPE
         BEZ      BLD:BOF65         NOPE-DON'T SEND I/O
         LCI      2                 MOVE CURRENT
         LM,R0    ACN#CURNT         ACCOUNT# INTO
         STM,R0   TLABUF+1          TAPE LABEL BUFFER
         LI,R4     BA(TLABUF+1)
         LI,R5     BA(TPLBUF)+3
         DO       FILL
         LB,R6    TPLFLG            COUNT
         ELSE
         LI,R6    28                TOTAL BYTES
         FIN
         DO       SIGMA7=1
         STB,R6   R5
         MBS,R4   0                 MOVE TO CORRECT SPOT
         ELSE
         LB,R0    0,R4
         STB,R0   0,R5
         AD,R4    DOUBLEONE
         BDR,R6   %-3
         FIN
BLD:BOF65   LI,R1 0                 RESET
         STW,R1   PBS               PREVIOUS BLOCK SIZE CELL
         STW,R1   SIZE              ZAP OLD RECORD LENGTH VALUE
         PAGE
*
*
*        NOW Q NEXT FIT BEFORE PROCESSING CURRENT FILE
*
*
*
         LI,R11   BLD:BOF81         STRAIGHT THRU ADDRS
         LI,R0    0                 MAKE SURE COMING THRU HERE
         STW,R0   FITDA             CELL IS RESET
BLD:BOF70 LW,R3   NEXFILE           NEXT FD INDEX
BLD:BOF71 AI,R3   FDKEYL            ADD NEXT KEY LENGTH
         CW,R3    FDSIZE            CURRENT=NAV YET
         BLE      BLD:BOF75         CAN READ IN THIS SECTOR
         MTW,0    FDFLINKQ          NOPE..IS NEXT SECTOR IN CORE
         BLEZ     BLD:BOF80         NO..CAN'T READ AHEAD NOW
         LI,R3    FDDISP+FDKEYL     YES..SET INDEX TO NEW SECTOR
         LW,R0    FDFLINK           GOING TO NEW ACCOUNT
         BNEZ     BLD:BOF75         NOPE
         AI,R3    FDKEYL            YES..JUMP OVER NULL KEY
BLD:BOF75 BAL,R7  GETFILE1          GET NEXT FIT'S D/A
         BAL,R15  DTOGRAN           VERIFY NEXT FIT DISC ADDRESS
         B        BLD:BOF80         NO GOOD--NO READ AHEAD
         LW,R9    M24               INSURE NOT PREVIOUSLY
         CS,R8    FITDA             QUEUED
         BE       BLD:BOF80         ITS Q'D NOW
         LI,R1    FITDA             SET WAIT CELL LOCATION
         LI,R10   BA(FITBUF)        RECEIVING BUFFER
         BAL,R15  QSECTOR           AND QUEUE NEXT FIT IN
BLD:BOF80 B       *R11              EXIT/FALL OUT
BLD:BOF81 LW,R0   DUMP              WRITING TAPE
         BEZ      BLD:BOF85         NOPE-JUMP OVER :BOF WRITE
         BAL,R15  BOFQUE            OK--WRITE THE :BOF RECORD
BLD:BOF85 LB,R2   ORG               GET FILE TYPE
         CI,R2    3                 IS FILE RANDOM
         BE       RANFILE           YES-PROCESS IS UNIQUE
         MTW,0    SYNFLAG           IS FILE SYNON
         BEZ      BLD:BOF90         NOPE
         MTW,0    LABELEDT          YES-BUT ARE WE WRITING FPURGE
         BNEZ     CKTIO             NO-REGULAR STYLE-WRITE :EOF
         MTW,0    DUMP              BUT ARE WE WRITING TAPE
         BEZ      FILEDONE          NO-FILE IS DONE NOW...
         LI,R2    BA(SYNBUF)        SET UP
         LI,R1    16                TO WRITE THE SYNON RECO
         LI,R15   CKTIO1            SET RETURN POINT
         B        MOVEI             Q/WRITE IT
BLD:BOF90 LW,R8   FDA               GET FIRST INDEX SECTOR D/A
         BEZ      CKTIO             ZERO=NULL FILE
         PAGE
*
*        PROCESS THE INDEX CHAIN SUBROUTINE
*
GETMIX   EQU      %                 INITIAL FILE START
         LW,R1    DAPAGES           GET MAX COUNT
         LI,R0    0
         STW,R0   CURBUF            CLEAR CURRENT BUFFER WA
GETMIX0  BAL,R11  RELDB             CLEAR DATA ENTRIES
         BDR,R1   GETMIX0           FINISH TABLES
         LW,R1    INDPAGES          GET COUNT
         LW,R9    M24               DISC ADDRESS MASK
         LW,R8    FDA               NEED TO FIND FIRST SECTOR
         CS,R8    INDEXDA,R1        LOOK FOR IT
         BE       GETMIX1           ALL SET
         BDR,R1   %-2               KEEP LOOKING
         MTW,1    MIXRAT            BUMP RATE ERROR TOTAL
         STW,R8   NXTFLNK           SO'S WE KIN READ IT NOW...
         BAL,R15  QUEMIX            AND USE IT...
GETMIX1  AI,R1    INDEXDA           CREATE CORE ADDRESS
         BAL,R7   IOSPIN            AND WAIT FOR EVENT
         BAL,R7   CHKIO
         BNE      ABNIO             BAD I/O
         AI,R1    -INDEXDA          GET INDEX BACK
         LW,R0    IBUF,R1           NOW SET
         MTW,0    *R0               TEST FDA'S BLINK
         BEZ      GETMIX2           FIRST BLINK OK
         STW,R0   MIXBUF            NOT OK,STORE POINTER
         BAL,R0   READFAIL5         AND ABORT FILE
GETMIX2  STB,R1   R0                INSERT BUF'S INDEX INTO CELL
         STW,R0   MIXBUF            POINTER TO SECTOR
         LI,R1    MIDISP            SET
         DO       UTS>=2
         LB,R2    ORG
         CI,R2    1                 CONSECUTIVE
         BG       %+2               NO-KEYED
         LI,R1    SCWDISP           YES-DISP. TO 1ST SCW
         FIN
         STW,R1   CURRMIX             INITIAL
         STW,R1   NEXTMIX               INDEX VALUES
         DO       UTS>=2
         CI,R2    1                 CONSECUTIVE
         BLE      GETMIX3           YEP-SPECIAL HANDLING
         FIN
         LI,R1    4
         LH,R1    *R0,R1            GET NAV
         DO       UTS>=2
         B        GETMIX4           CONTINUE
GETMIX3  EQU      %                 CONSECUTIVE-PROCESS GRAN. CW
         LI,R2    0
         LI,R1    2                 DISP. TO GRANULE CW
         INT,R1   *R0,R1            NAV OR LAST SCW TO R1
         BCR,4    %+2               CC1 SET IF GRAN. FULL
         AI,R2    1                 CONTROL GRANULE FULL
         STW,R2   FULL              0 IF NOT FULL - 1 IF FULL
GETMIX4  EQU      %                 CONTINUE
         FIN
         STW,R1   MISIZE            SAVE SECTOR SIZE
         LW,R14   INDEX             WANT TO SEE BUFFER
         BEZ      %+2               NO
         BAL,R14  LISTMIX           YES, SNAP CURRENT ONE
         LW,R11   DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R11   STATS             OR PRODUCING DISKPOOL
         BEZ      BLK:DATA05        NO,JUST PROCESS KEYS
         BAL,R11  GETFOUR           YES,QUEUE DATA NOW
         LW,R1    CURBUF            WORKING ON BUFFER NOW
         BNEZ     BLK:DATA05        YES,GO BACK FOR NEXT KEY
         PAGE
*
*        BLOCKING BUFFER BUILDER
*
BLK:DATA EQU      %
         BAL,R15  QUEMIX            TRY FOR A FLINK
         BAL,R15  GETTBUF           GET NEW TAPE BUFFER
         BNEZ     %+3               GOT ONE
         LI,R7    BLK:DATA          NO,SET RETURN
         B        BUFWAIT           AND TRY TO SCHEDULE
         STW,R1   CURINDX           SAVE INDEX
         STW,R3   CURBUF            SAVE BUF WA
         BAL,R15  GETKEYI           INIT NEW BUFFER
BLK:DATA05 BAL,R15 GETKEY           GET NEXT KEY FROM SECTOR
         LW,R1    DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R1    STATS             OR PRODUCING DISKPOOL
         BEZ      BLK:DATA05        NO,HURRY ALONG
         LI,R1    1                 INDEX TO NKEY
         LH,R2    *CURBUF,R1        GET KEY COUNT NOW
         BNEZ     BLK:DATA25        SEE WHAT TO DONE
BLK:DATA10 BAL,R15 MOVEKEY          MOVE NEW KEY TO BUFFER
BLK:DATA15 LI,R1  TBSIZ             SET BUFFER DEPTH
         BAL,R15  MOVE              MOVE DATA RECORD TO BUF
         B        NOTDONE           RECORD NOT ALL MOVED
         BAL,R7   SCHEDULE          TRY TO RELEASE DATA BUF'S
         BEZ      BLK:DATA20        NONE RELEASE
         BAL,R11  GETFOUR           READ DATA THEN
BLK:DATA20 LW,R1  MIXEOF            EOF BIT HIT YET
         BNEZ     D                 YES,OUTPUT LAST BLOCK
         LW,R1    CSET              CURRENT RECORD CONTINUED
         BE       BLK:DATA21        NO
         LB,R6    ORG
         CI,R6    2                 KEYED FILE
         BNE      BLK:DATA05        NO - GET NEXT KEY
         MTW,1    CONTFLAG          SET CONTINUE FLAG
         B        BLK:DATA05        GET NEXT KEY
BLK:DATA21 EQU    %
         LI,R1    0                 NO
         STW,R1   P2                RESET CONTINUED FLAG
         BAL,R15  KEYUP             MOVE FLAGS TO BUFFER
         DO       UTS>=2
         MTW,1    DELREC            POSSIBLE DELETED RECORD
         FIN
         LW,R1    KEYDISP           GET CURRENT BUF DISP
         AW,R1    KEYM              ADD KEY CNT
         AI,R1    12                ROUND UP ETC.
         CI,R1    TBSIZ             AT MAX YET
         BL       BLK:DATA05        NO,GET NEXT KEY
         LI,R15   BLK:DATA          YES,SET RETURN POINT
         B        QUEREC            AND WRITE OUT CURRENT BUF
BLK:DATA25 LW,R1  FAK               IS NEW KEY FIRST APPEARANCE
         BEZ      BLK:DATA15        NO,MOVE DATA ONLY
         LW,R1    KEYDISP           YES,GET CURRENT INDEX
         AW,R1    KEYM              ADD KEY CNT
         AI,R1    12                ADD TO ROUND UP ETC.
         CI,R1    TBSIZ             IS ROOM FOR NEW KEY
         BL       BLK:DATA10        YES,MOVE KEY NOW
         BAL,R15  QUEREC            NO,WRITE OUT CURRENT BUF
         BAL,R15  GETTBUF           ASK FOR NEW TAPE BUFFER
         BNEZ     %+3               GOT ONE
         BAL,R7   BUFWAIT           NO,WAIT FOR ONE
         B        %-3               TRY AGAIN
         STW,R1   CURINDX           SAVE INDEX
         STW,R3   CURBUF            SAVE BUF WA
         LI,R15   BLK:DATA10        SET RETURN POINT
         B        GETKEYI           INIT NEW BUFFER
         PAGE
*
*        CURRENT DATA RECORD DID NOT COMPLETELY FIT
*        IN CURRENT BUFFER. WRITE OUT CURRENT BLOCKING BUFFER,
*        MOVE CURRENT KEY INTO NEW BLOCKING BUFFER,AND
*        FINISH MOVING DATA TO NEW BUFFER.
*
NOTDONE  EQU      %
         LI,R1    X'200'            SET
         STW,R1   P2                RECORD CONTINUED FLAG
         BAL,R15  KEYUP             MOVE FLAGS TO BUFFER
         BAL,R15  QUEREC            WRITE OUT CURRENT BUFFER
         BAL,R7   SCHEDULE          TRY TO RELEASE DATA BUF'S
         BEZ      NOTDONE1          NONE FOUND
         BAL,R11  GETFOUR           READ DATA IF BUFS FFEE
NOTDONE1 BAL,R15  GETTBUF           GET NEW TAPE BUFFER
         BNEZ     %+3               GOT ONE
         BAL,R7   BUFWAIT           WAIT FOR BUFFER
         B        NOTDONE1          TRY AGAIN
         STW,R1   CURINDX           SAVE TABLE INDEX
         STW,R3   CURBUF            SAVE BUFFER WA
         BAL,R15  GETKEYI           INIT NEW BUFFER
         LW,R1    LASTKEY           GET LAST POSITION OF KEY
         LW,R3    CURBUF            CURRENT BUF WA
         LW,R5    KEYM              KEY MAX
         AI,R5          4           ROUND UP
         SLS,R5   -2                TO # OF WORDS
NOTDONE2 AI,R3          1           BUMP CURRENT ADDRESS
         LW,R2    *R1               GET WORD FROM LAST KEY
         STW,R2   *R3               MOVE TO CURRENT BUFFER
         AI,R1          1           INCREMENT FROM ADDRS
         BDR,R5   NOTDONE2          FINISH MOVING KEY
         LW,R1    CURBUF            GET BUF BASE
         AI,R1          1           BUMP
         STW,R1   LASTKEY           MARK AS LAST KEY ADDRS
         AI,R3          1           INCREMENT TO FLAGS SPOT
         STW,R3   P1P2P3            MARK AS FLAGS ADDRS
         SW,R3    CURBUF            CALCULATE LASTKEY
         SLS,R3   2                 MAKE IT BA
         AWM,R3   KEYDISP           ADD TO CURRENT DISP
         MTW,1    *CURBUF           SET NEW NKEY=1
         LW,R1    RWS2              GET REMAINING BYTES TO TRANSFER
         STW,R1   RWS               MAKE IT RECORD COUNT
         LI,R15   BLK:DATA15        SET RETURN POINT
         B        QUEMIX            GO THRU CHKS PRIOR
         PAGE
*
*  NOW WAITING ON TAPE BUFFER; SO PERFORM:
*        1. BUMP TAPE SPIN COUNTER.
*        2. ATTEMPT TO SCHEDULE IN.
*        3. ATTEMPT TO READ A FLINK.
*
BUFWAIT  EQU      %
         MTW,1    TBUFSPIN          BUMP BUFFER WAIT COUNTER
         PSW,R7   *STKPNTR          SAVE LINK
         BAL,R11  FITCHKS31         QUEUE NEXT FD SECTOR
         BAL,R11  BLD:BOF70         QUEUE NEXT FIT SECTOR
         BAL,R7   SCHEDULE          TRY TO RELEASE DATA BUFFERS
         BEZ      %+2               NONE RELEASED
         BAL,R11  GETFOUR           TRY TO READ DATA THEN
         PLW,R15  *STKPNTR          RESTORERETURN LINK
         B        QUEMIX            AND TRY FOR A FLINK
         PAGE
*
*        END OF INDEX CHAIN REACHED
*
D        EQU      %
         LI,R1    0                 RESET
         STW,R1   P2                CLEAR BLOCK CONTINUANCE FLAG
         DO       UTS>=2
         XW,R1    CONEOF            GET CONEOF AND SET CONEOF=0
         BNEZ     %+2               SKIP KEYUP IF CONEOF NON-ZERO
         FIN
         BAL,R15  KEYUP             SET UP KEY FLAGS
         LI,R15   CKTIO1            RETURN FROM Q RECORD
         B        QUEREC            SEND BLOCKED BUFFER
*
*        SET UP KEY FLAGS (P1,P2,P3) WORD POSITION
*
KEYUP    EQU      %
         DO       UTS>=2
         LB,R1    ORG
         CI,R1    1                 CONSECUTIVE
         BG       %+3               NO
         MTW,0    DELREC            YES-DELETED RECORD
         BNE      *R15              YES-RETURN
         FIN
         LI,R1    0
         OR,R1    P1                P1 SET=FIRST PART OF RECORD
         OR,R1    P2                P2 SET=RECORD CONTINUED
         SLS,R1   16                MOVE FLAGS TO LEFT
         OR,R1    SIZE              ADD RECORD SEGMENT BYTE COUNT
         LI,R0    0                 MOVE TO CURRENT BUFFER
         STW,R0   SIZE              AFTER ZAPPING CURRENT SIZE
         STW,R0   P1                RESET
         STW,R0   P2                  BLOCKING FLAGS
         STW,R1   *P1P2P3           ....
         B        *R15
         PAGE
*
*
*
*        OUTPUT TAPE RECORD DRIVER
*
*
*
QUEREC   EQU      %
         LW,R5    KEYDISP           CURRENT KEY DISPLACEMENT
         AI,R5    3                 ROUND UP
         SLS,R5   -2                MAKE IT WORD COUNT
         SLS,R5   2                 MAKE IT BYTE COUNT
QUEREC1  EQU      %                 ENTER HERE FOR RANDOM GUYS
         LI,R6    -1                SET
         LI,R7    QBUF              SET POINTER
         LW,R1    CURINDX           PLACE TALBE INDEX INTO R1
         MTW,0    BLOCKS            DUMP OUTPUT BUFFER
         BEZ      %+3               NOPE   JUST WRITE RECORD
         LW,R14   R15               YES..SWITCH LINKS
         LI,R15   LISTOUTBUF        TO DUMP IT AFTER
         AI,R5    0                 IF NEGATIVE THEN
         BGEZ     MTIO              RANDOM FILE..DON'T SPLIT
         LAW,R5   R5                YEP..RANDOM
         B        MTIO+2            WRITE RECORD WITHOUT CHECKING FOR
         PAGE
*
*
*        SET PBS WORD IN NEW BUFFER
*
*
GETKEYI  EQU      %
         LW,R1    PBS               GET BLOCK SIZE BYTE COUNT
         SLS,R1   16                SLIDE OVER
         STW,R1   *CURBUF           SET INTO BLOCKING BUFFER
         LI,R1    4                 RESET
         STW,R1   KEYDISP           NEXT AVAIL POSITION
         B        *R15
         PAGE
*
*        MOVE CURRENT KEY TO CURRENT BLOCKING BUFFER
*
*        NEXT AVAIL POSITION (KEYDISP) ROUNDED TO WORD
*        ADDRESS MOVED TO 'LASTKEY'
*        KEYDISP THEN IS INDEX TO MOVE CURRENT KEY INTO
*        BLOCKING BUFFER
*        'P1P2P3' UPDATED TO POINT TO TAPE KEY WORD POSITION
*
*        ALL VALUES UPDATED AS TO NEW POSITIONS IN BUFFER
*
MOVEKEY  EQU      %
         DO       UTS>=2
         LB,R6    ORG
         CI,R6    1                 CONSECUTIVE
         BG       %+3               NOPE
         MTW,0    DELREC            YEP-DELETED RECORD
         BNE      *R15              YEP-RETURN
         FIN
         MTW,1    *CURBUF           BUMP 'NKEY' IN CURRENT BLOCKING BUFFER
         LW,R2    KEYM              GET KEY MAX
         AI,R2    1                 PLUS ONE FOR 'KL'
         LW,R4    KEYDISP           GET CURRENT KEY DISPLACEMENT
         AI,R4    3                 ROUND UP
         SLS,R4   -2                MAKE IT WORD ADDRS
         STW,R4   LASTKEY           SAVE AS LAST KEY POSITION
         LW,R1    CURBUF            GET CURRENT BUFFER WORD ADDRS
         STW,R1   P1P2P3            SAVE IT
         AWM,R1   LASTKEY           ADD LAST KEY POSITION TO IT
         SLS,R4   2                 AND MAKE IT BYTE ADDRS
         DO       SIGMA7=0
         LW,R3    CURRMIX           CURRENT INDEX SECTOR INDEX
         LB,R5    *MIXBUF,R3        MOVE KEY OUT
         STB,R5   *CURBUF,R4
         AI,R4    1
         AI,R3    1
         BDR,R2   %-4
         ELSE
         DO       UTS>=2
         CI,R6    1                 CONSECUTIVE
         BG       MOVEKEY1          NOPE-KEYED
         LI,R6    BA(CONKEY)        YEP-MOVE OLD CON. FILE KEY
         B        MOVEKEY2
MOVEKEY1 EQU      %                 KEYED FILE KEY
         FIN
         LW,R6    MIXBUF            GET BUF POINTER WA
         SLS,R6   2                 CONVERT TO BA
         AW,R6    CURRMIX           PLUS CURRENT INDEX
         DO       UTS>=2
MOVEKEY2 EQU      %
         FIN
         LW,R7    CURBUF            WA OF CURRENT OUTPUT BUF
         SLS,R7   2                 TO BA
         AW,R7    R4                ADD DISPLACEMENT
         STB,R2   R7                ADD COUNT
         MBS,R6   0                 MOVE IT
         AW,R4    R2                UPDATE DISPLACEMENT VALUE
         FIN
         AI,R4    3                 ROUND UP DISPLACEMNT VALUE
         SLS,R4   -2                MAKE IT WORD ADDRS
         AWM,R4   P1P2P3            ADD TO CURRENT POINTER
         SLS,R4   2                 AND BACK TO BYTE ADDRS
         AI,R4    4                 ROUND UP
         STW,R4   KEYDISP           SAVE AS NEXT AVAIL DISP.
         LI,R1    X'100'            SET FIRST APPEARANCE
         STW,R1   P1                FLAG FOR RECORD
         B         *R15
         PAGE
*
*
*        MOVE DATA RECORDS TO BLOCKING BUFFER
*
*        CALLING SEQUENCE:
*
*        R1:      BUFFER SIZE (IN BYTES)
*        CURBUF:  WA OF OUTBUF
*        CURDBLK: BA OF INBUF
*        RWS:     #BYTES TO MOVE
*        KEYDISP: OUTPUT BUFFER DISPLACEMENT
*        BLDISP:  INPUT BUFFER DISPLACEMENT
*
*
*        UPDATE GRANULE ACCOUNTING TABLE WITH THE #
*        OF BYTES MOVED TO BLOCKING BUFFER
*
*
MOVE     EQU      %
         LW,R7    R15               XFER RETURN LINK
         MTW,0    RWS               ANY DATA TO BLOCK
         BEZ      1,R7              NOPE..EXIT NOW
         DO       UTS>=2
         LB,R6    ORG
         CI,R6    1                 CONSECUTIVE
         BG       MOVE000           NOPE
         MTW,0    DELREC            YEP-DELETED RECORD
         BNE      1,R7              YES-RETURN TO BAL+2
         MTW,0    CONCAS1           BLOCKED CONSECUTIVE
         BNE      MOVE01            YEP-ALREADY IN
MOVE000  EQU      %
         FIN
         LW,R3    M24               D/A MASK
         LW,R2    GRANULEADR        CURRENT DATA ADDRESS
         CS,R2    *CURRB            DO WE STILL HOLD IT
         BE       MOVE01            OK,D/A IN CORE
         PSW,R15  *STKPNTR          SAVE OUR RETURN
         LI,R15   MOVE00            SET RETURN POINT
         PSW,R15  *STKPNTR          FOR 'GETKEY'
         B        GETKEY01          GO GET CURRENT D/A
MOVE00   PLW,R15  *STKPNTR          RESTORE OUR EXIT
         LI,R1    TBSIZ             SET BUFFER LIMITS
MOVE01   AI,R15   1                 ASSUME IT WILL FIT FIRST
         LW,R3    R1                BUFFER SIZE TO R3
         SW,R3    KEYDISP            R3=BYTES REMAINING IN BUFFER
         CW,R3    RWS                IS ROOM FOR THIS RECORD
         BGE      MOVE2             YES-USE RWS AS COUNT
         LW,R2    KEYDISP            NO-GET CURRENT POSITION IN BUFFER
         AW,R2    RWS                ADD RECORD SIZE (IN BYTES)
         SW,R2    R1                 SUBTRACT FROM BUFFER SIZE
         STW,R2   RWS2               =BYTES REMAINING TO XFER
         STW,R3   RWS                ACTUAL # OF BYTES
         AI,R15   -1
         DO       UTS>=2
MOVE2    EQU      %
         MTW,0    CONCAS1           BLOCKED CONSECUTIVE
         BNE      MOVE21            YEP-SKIP RBHIST UPDATE
         LW,R7    CURRB             POINTER TO D/A
         ELSE
MOVE2    LW,R7    CURRB             POINTER TO D/A
         FIN
         AI,R7    -RB1              CALCULATE TABLE INDEX
         LW,R6    RBHIST,R7         #BYTES MOVED TO DATE
         AW,R6    RWS               NEW TOTAL
         STW,R6   RBHIST,R7         UPDATE TABLE
         DO       UTS>=2
MOVE21   EQU      %
         FIN
         LW,R5    CURBUF            WA CURRENT OUTBUF
         SLS,R5   2                  MAKE IT A BA..
         LW,R2    CURDBLK            BA OF INPUT BUFFER
         AW,R5    KEYDISP            NEXT AVAILABLE POSITION IN BUFFER
         LW,R3    RWS                GET RECSIZE IN BYTES
         AWM,R3   BLKDBYTES         BUMP TOTAL SENT TO TAPE
         AWM,R3   SIZE              UPDATE RECORDS SIZE
         AWM,R3   KEYDISP            UPDATE POINTER INTO OUTBUF
         AW,R2    BLDISP             CURRENT INDEX INTO INPUT BUFFER
         AWM,R3   BLDISP             UPDATE IN CASE OF CONT. RECORD
MOVEBYT  EQU      %
         DO       SIGMA7=0
         LB,R6    0,R2              TRANSFER
         STB,R6   0,R5              BYTES
         AI,R5    1
         AI,R2    1
         BDR,R3   %-4                FINISH TRANSFER
         ELSE
         LW,R4    R2                SOURCE BYTE ADDRS
         LW,R2    R3                MOVE COUNT TO R2
MOVE3    CI,R2    255               MORE THAN ONE MOVE
         BG       MOVE1             YEP-ADJUST VALUE TO MAX
         LW,R1    R2                ELSE PLACE COUNT IN R1
MOVE4    STB,R1   R5                INSERT CNT
         MBS,R4   0                 MOVE IT
         SW,R2    R1                SUBTRACT # MOVED
         BGZ      MOVE3             MORE TO GO THEN
         FIN
         B        *R15
         DO       SIGMA7=1
MOVE1    LI,R1    255               SET UP ONE MOVE
         B        MOVE4             MOVE MAX UNTIL COUNT DROPS
         FIN
         PAGE
*
*        GET MASTER INDEX KEY SUBROUTINE
*
GETKEY   EQU      %
         PSW,R15  *STKPNTR          SAVE RETURN LINK
         LI,R1    0                 CLEAR
         DO       UTS>=2
         STW,R1   CONCAS1           RESET BLOCKED CONSECUTIVE
         LB,R6    ORG
         CI,R6    1                 CONSECUTIVE
         BLE      GETKEYN           YEP
         FIN
GETKEY0 BAL,R15  QUEMIX            SEE IF A FLINK IS READY
         LW,R1    NEXTMIX           GET NEXT SECTOR INDEX
         STW,R1   CURRMIX           SET AS CURRENT INDEX
         CW,R1    MISIZE            IS MAX YET
         BGE      CHKEND            YES-CHECK IF AT END OF CHAIN
         AW,R1    KEYM              NO-ADD KEY VARIABLE
         AI,R1    MIXKEYL           ADD PRE-SET SIZE
         STW,R1   NEXTMIX           PUT AWAY AS NEXT INDEX
         LW,R6    MIXBUF            BUF POINTER
         SLS,R6   2                 TO BYTE ADDRS
         AW,R6    CURRMIX           ADD CURRENT INDEX
         LB,5     0,R6              GET 'KL' FROM KEY
         BEZ      GETKEY0           GET NEXT IF DELETED
         AW,R6    KEYM              IS GOOD-ADD IN KEY VARIABLE
         LI,R1    0                 CLEAR KEY VARIABLES
         AI,R6    MIFLD5            EOF/FAK/C BYTE
         LB,R5    0,R6              FETCH BYTE
         CI,R5    4                 CHECK FAK
         BAZ      GETKEY0A          BR IF NOT FIRST KEY
         MTW,0    CONTFLAG          CONTINUED KEY FLAG SET
         BE       GETKEY0B          NO - EVERYTHING OK
         LW,R5    CURRMIX           CURRENT INDEX
         STW,R5   NEXTMIX           BACK IN NEXT INDEX
         STW,R1   CONTFLAG          CLEAR CONT KEY FLAG
         PLW,R15  *STKPNTR          IGNORE KEY  FOR NOW
         B        BLK:DATA21        AND FINISH PROC PREVIOUS KEY
GETKEY0A EQU      %
         STW,R1   CONTFLAG          CLEAR
GETKEY0B EQU      %
         STW,R1   FAK                  KEY
         STW,R1   CSET                    VARIABLES
         AI,R6    -10               POSITION TO SBA OF 'BLDISP'
         LI,R5    2                 BLDISP IS TWO BYTE FIELD
         LI,R7    BA(BLDISP)+2      DESTINATION
         DO       SIGMA7=0
         LB,R8    0,R6              MOVE
         STB,R8   0,R7              TO WORK SLOT
         AD,R6    DOUBLEONE
         BDR,R5   %-3
         ELSE
         STB,R5   R7                SET COUNT
         MBS,R6   0
         FIN
         AI,R6    2                 POINT TO DISC ADDRS
         LI,R5    4                 FOUR BYTES
         LI,R7    BA(GRANULEADR)    DESTINATION FOR DISC ADDRS
         DO       SIGMA7=0
         LB,R8    0,R6
         STB,R8   0,R7
         AD,R6    DOUBLEONE
         BDR,R5   %-3
         ELSE
         STB,R5   R7
         MBS,R6   0
         FIN
         LI,R7    BA(RWS)+2         NEXT FIELD
         LI,R5    2                 TWO BYTE FILED
         DO       SIGMA7=0
         LB,R8    0,R6
         STB,R8   0,R7
         AD,R6    DOUBLEONE
         BDR,R5   %-3
         ELSE
         STB,R5   R7
         MBS,R6   0
         FIN
         LW,R0    RWS               THIS KEY'S TOTAL DATA BYTES
         AWM,R0   FILESIZE          INCREMENTS TOTAL FILE'S BYTES
         LB,R5    0,R6              GET FAK/EOF/C CONTROL BYTE
         CI,R5    1                 IS 'C' SET
         BAZ      %+2               NOPE
         STW,R5   CSET              SET INTERNAL IF SO
         CI,R5    2                 IS 'EOF' SET
         BAZ      %+2               NO
         STW,R5   MIXEOF            SET INTERNALLY IF SO
         SLS,R5   -2                MOVE EOF/C OUT
         STW,R5   FAK               AND SAVE FAK
GETKEY01 LW,R2    GRANULEADR        GET D/A
         BEZ      CHKRWS             IF ZERO..CHECK RWS FOR ZERO
         LW,R1    DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R1    STATS             OR PRODUCING DISKPOOL
         BEZ      GETKEY5           NOPE..EXIT NOW
GETKEY1  LW,R1    DAPAGES           DATA COUNT
         LW,R3    M24               DISC ADDRESS MASK
GETKEY2  CS,R2    RB1,R1            IS DISC ADDRS IN TABLE
         BE       GETKEY3           FOUND IT
         BDR,R1   GETKEY2           KEEP TRYING
         B        QERROR             INTERNAL ERROR-D/A NOT IN CORE
GETKEY3  LW,R4    DBUF,R1           WA OF DATA GRAN'S BUFFER
         SLS,R4   2                 CONVERT TO BYTE ADDRS
         STW,R4   CURDBLK            SAVED FOR MOVER...
         ANLZ,R4  GETKEY2           SET TABLE ENTRY ADDRESS FOR
         STW,R4   CURRB             CURRENT DATA GRANULE
         AI,R1    RB1               FIX UP ADDRS
         BAL,R7   IOSPIN            WAIT FOR EVENT
         BAL,R7   CHKIO             CHECK TYC
         BE       GETKEY5           WAS OK
GETKEY4  PLW,R15  *STKPNTR          NO,ADJUST STACK
         BAL,R0   ABNIO             ABORT FILE DUE TO BAD IO
GETKEY5  PLW,R15  *STKPNTR          RESTORE RETURN LINK
         B        QUEMIX            AND SEEABOUT FWD LINK
         PAGE
*
*        CURRENT DISC ADDRESS=0
*
CHKRWS   EQU      %
         MTW,0    RWS                IS RWS 0
         BNEZ     GETKEY4           FILE ERROR..ABORT FILE
         LI,R0    0
         STW,R0   SIZE              CLEAR SIZE VALUE
         B        GETKEY5           GO TRY READ FWD LINK
         PAGE
*
*        NAV HAS RUN-OUT ON CURRENT SECTOR,INSURE
*        THIS FILE HAS NOT ERROR IN INDEX CHAIN
*
CHKEND   EQU      %                 END OF A SECTOR
         PLW,R15  *STKPNTR          ADJUST STACK PRIOR TO TESTS
CHKEND1  LW,R7    MIXBUF            GET SECTOR'S BUF WA
         LW,R8    1,R7              CHECK FOR FORWARD LINK
         BNEZ     MIXEND            THERE IS ONE-GET IT
         MTW,0    MIXEOF            AND DID EOF BIT GO ON
         BNEZ     CHKEND2           YEP,PROPER FILE SEQUENCE
         LI,R15   EOFMSG            NO,LETS PRINT AN ERROR
         CAL1,2   PRNT15            MSG SO USER KNOWS
         MTW,1    CONEOF            SET SO WE DON'T REENTER KEYUP
         MTW,1    MIXEOF            SET IT FOR OURSELF
CHKEND2  LW,R1    DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R1    STATS             OR PRODUCING DISKPOOL
         BEZ      FILEDONE          NO..THIS IS ALL
         B        D                 RETURN
         PAGE
         DO       UTS>=2
*
*        GETKEY FOR NEW CONSECUTIVE FILES
*
GETKEYN  EQU      %                 ENTERED FROM GETKEY (R1=0)
         STW,R1   FAK               CLEAR KEY
         STW,R1   CSET                 VARIABLES
         STW,R1   MIXEOF            STORE ZERO
         BAL,R15  QUEMIX            SEE IF FLINK READY
         LI,R5    0
         LI,R6    1
         LW,R1    NEXTMIX           POINTS TO NEXT SCW
         STW,R1   CURRMIX           SET AS CURRENT
         LW,R2    FULL              1=GRANULE FULL
         CW,R1    MISIZE            POSITION OF NAV OR LAST SCW
         EXU      ENDTEST,R2        BGE OR BG CHKENDN
         INT,R2   *MIXBUF,R1        GET SCW
         BCR,2    %+2               CC3=1 IF C=1
         STW,R6   CSET              C=1
         BCS,8    CASE2             CC1=1 IF UNBLOCKED SEGMENT
CASE1    EQU      %                 CASE 1 FOR BLOCKED SEGMENT
         BCR,4    %+4               CC2=1 IF FAK=1
         STW,R5   DELREC            NOT DELETED RECORD IF FAK=1
         STW,R6   FAK               FAK=1
         AWM,R6   CONKEY            UPDATE OLD CONSEC. FILE KEY
         STW,R2   CONCAS1           SET BLOCKED CONSECUTIVE
         STW,R2   RWS               # OF BYTES IN SEGMENT
         MTW,0    DELREC            CHECK FOR DELETED RECORD
         BE       %+2               DONT ADD BYTE COUNT IF DELETED
         AWM,R2   FILESIZE          TOTAL DATA BYTES IN FILE
         SLS,R1   2                 CONVERT TO BYTES
         AI,R1    4                 POINTS TO BLOCKED DATA
         STW,R1   BLDISP            SAVE BYTE DISPLACEMENT
         AW,R1    R2                BLDISP+RWS
         AI,R1    3                 +3
         SLS,R1   -2                CONVERT TO WORD     DISPL.
         STW,R1   NEXTMIX           POINT TO NEXT SCW
         CW,R1    MISIZE            IS NEXT INDEX LAST IN BLOCK
         BGE      CASE1X            YES,DONT INDEX IT
         SLS,R1   1                 CONVERT TO HALFWORD DISPL.
         LH,R3    *MIXBUF,R1        NEXT SCW=0 IF CASE 3
         BNEZ     %+2               NOT BACKSPACE CW (CASE 3)
         MTW,1    NEXTMIX           CASE 3-SKIP CW
CASE1X   LW,R2    MIXBUF            WA OF CONTROL BUFFER
         SLS,R2   2                 CONVERT TO BYTES
         STW,R2   CURDBLK           STORE IT
         LB,R1    MIXBUF            INDEX INTO IBUF TABLES
         LW,R2    INDEXDA,R1        DISC ADDRESS
         AND,R2   M24
         STW,R2   GRANULEADR        OF GRANULE CONTAINING DATA
         B        GETKEY5           RETURN VIA GETKEY
ENDTEST  BGE      CHKENDN
         BG       CHKENDN
CHKENDN  EQU      %                 AT END OF CONTROL GRANULE
         PLW,R15  *STKPNTR          ADJUST STACK
         MTW,0    *MIXBUF,R6        IS FLINK=0
         BNE      MIXEND            NO, GET IT
         MTW,2    MIXEOF            FLINK=0, SET EOF
         STW,R6   CONEOF            SET EOF FLAG TO SKIP KEYUP
         B        CHKEND2           RETURN VIA CHKEND (IN GETKEY)
CASE2    EQU      %                 CASE 2 FOR UNBLOCKED SEGMENTS
         BCR,4    %+4               CC2=1 IF FAK=1
         STW,R5   DELREC            NOT DELETED RECORD IF FAK=1
         STW,R6   FAK               FAK=1
         AWM,R6   CONKEY            UPDATE OLD CONSEC. FILE KEY
         STB,R2   R3,R6             DCTX IN R2 (BYTE 3)
         STW,R3   GRANULEADR        DISC ADDRESS OF DATA GRANULE
         SLS,R2   -8                #DATA BYTES-2033 IN R2
         AI,R2    2033              GUESS WHAT
         STW,R2   RWS               YOU GUESSED IT
         MTW,0    DELREC            CHECK FOR DELETED RECORD
         BE       %+2               DONT ADD BYTE COUNT IF DELETED
         AWM,R2   FILESIZE          TOTAL DATA BYTES IN FILE
         AI,R1    1                 POINT TO NEXT SCW
         STW,R1   NEXTMIX           SAVE POINTER
         LI,R1    0                 UNBLOCKED DATA SEGMENTS
         STW,R1   BLDISP            ALWAYS BEGIN AT BYTE 0
         B        GETKEY01          LET GETKEY FINISH UP
         PAGE
         FIN
*
*        WE HAVE NOT READ THE DATA GRANULE NOW
*        INDICATED BY CURRENT INDEX SECTOR KEY,IF
*        NECESSARY RELEASE DATA BUFFERS TO ENABLE
*        A DATA READ. THOSE GRANULES PREMATURELY
*        RELEASED WILL GO BACK INTO THE DATA STACK.
*
QERROR   EQU      %
         MTW,1    DATARAT           BUMP DATE RATE ERROR TOTAL
         BAL,R7   SCHEDULE          TRY TO NORMALLY RELEASE BUFFER
         BNEZ     QERROR2           WE GOT ONE...
         BAL,R3   CLEAR             RELEASE ALL SHORT GRANULES
         BNEZ     QERROR2           GOT ONE
         LI,R6    0                 INIT COUNTER
         LW,R1    DAPAGES           GET # OF DATA PAGES
QERROR0  LW,R2    RB1,R1            CHECK FOR DISC ADDRESS
         BEZ      QERROR1           NONE..INSURE BUFFER IS FREE
         BLZ      QERROR0           END ACTION PENDING
         LW,R8    M24               SET MASK
         LW,R2    RBHIST,R1         GET ACCNTG ENTRY FOR CURRENT
         BNEZ     QERROR00          GO AHEAD AND RELEASE
         CI,R6    0                 WE HAVEN'T USED IT YET..BUT
         BNEZ     QERROR10          YES..GO TO NEXT ENTRY
         AND,R8   RB1,R1            NOPE..HAVEN'T RELEASED YET
         PSW,R8   DSTACK            PUT READ-AHEAD BACK INTO STACK
QERROR00 MTW,1    TRUNC1            BUMP ABNORMAL COUNT
         AI,R6    1                 BUMP RELEASE COUNTER
QERROR1 BAL,R11  RELDB             RELEASE DATA ENTRIES
QERROR10 BDR,R1   QERROR0           FINISH UP
QERROR2  LW,R2    GRANULEADR        GET CDA
         PSW,R2   DSTACK            PLACE INTO DATA STACK
         BAL,R11  GETFOUR           READ DATA NOW
         B        GETKEY01          NOW SCAN TABLES
        PAGE
*
*        RELEASE DATA TABLE ENTRY
*
RELDB    EQU      %
        LW,R12   DBUF,R1           GET ENTRY
        LC       R12               GET STATUS FLAG
         BCR,4    *R11              BUFFER NOT BUSY
         LW,R0    RB1,R1            SPIN IF
         BLZ      %-1               END ACTION PENDING
RELDB1   LI,R0    0                 SET TO CLEAR
         MTW,1    DBUF              INCREMENT TOTAL AVAILABLE
         LI,R12   X'1FFFF'          RELEASE
        AND,R12  DBUF,R1             DATA
         STW,R12  DBUF,R1               BUFFER
        STW,R0   RB1,R1            CLEAR DISC ADDRS
         STW,R0   RBHIST,R1         CLEAR HISTORY ENTRY
         B        *R11              AND EXIT
         PAGE
*
*        RELEASE IN-CORE GRANULES/BUFFERS THAT DO NOT
*        APPEAR AGAIN IN THE FILE DATA STACK.
*
CLEAR    EQU      %
         LI,R9    0                 FOR CLEARING
         LW,R1    DAPAGES           #OF DATA PAGES TOTAL
CLEAR0   LI,R7    X'3FF'            GET CURRENT SIZE
         AND,R7   DSTACK+1          OF DATA GRANULE STACK
         LW,R5    M24               DISC ADDRESS MASK
         LS,R5    RB1,R1             GET D/A
CLEAR1   CW,R5    STACK-1,R7        COMPARE TO STACK CONTENTS
         BE       CLEAR2            DON'T RELEASE NOW
         BDR,R7   CLEAR1            KEEP LOOKING
         BAL,R11  RELDB             RELEASE DATA ENTRIES
        AI,R9    1                 INCREMENT RELEASE COUNTER
         MTW,1    TRUNC3            BUMP SHORT CNT
CLEAR2   BDR,R1   CLEAR0            DO NEXT ONE...
         AI,R9    0                 SET CC=CNT WHEN DONE
         B        0,R3              EXIT
         PAGE
*
*        RELEASE DATA BUFFERS THAT WE HAVE USED
*        COMPLETELY
*
SCHEDULE EQU      %
         LW,R1    DAPAGES           GET MAX COUNT
         LI,R3    0                 CLEAR COUNTER
SCHEDULE1 LW,R4   RB1,R1            GET ENTRY
         BEZ      SCHEDULE10        NONE..INSURE BUFFER IS FREE
         LW,R4    RBHIST,R1         GET ENTRY
         CW,R4    DROPCNT           HAS BEEN USED UP...
         BL       SCHEDULE2         NO-KEEP IT IN CORE
         MTW,1    TRUNC2            BUMP NORMAL ISMISS CNT
         AI,R3    1                 INCREMENT RELEASE COUNTER
SCHEDULE10 BAL,R11 RELDB            RELEASE DATA ENTRIES
SCHEDULE2 BDR,R1  SCHEDULE1         DO NEXT ONE TILL DONE
         AI,R3    0                 SET CC'S
         STCF     R7                PLACE CC'S INTO LINK
         LW,R15   R7                SET UP RETURN SEQUENCE
         B        QUEMIX            AND RETURN THRU MIX CODE
         PAGE
*
*        RELEASE INDEX SECTOR BUFFER
*
RELMIX   EQU      %
         LW,R12   IBUF,R1           GET ENTRY
         LC       R12               GET STATUS
         BCR,12   *R11              BUFFER NOT BUSY
         MTW,1    IBUF              BUMP AVAIL COUNTER
         LI,R0    0
         STB,R0   R12               CLEAR BUSY
         STW,R12  IBUF,R1                 BIT
         B        *R11              AND EXIT
         PAGE
*
*
*
*        END OF CURRENT INDEX SECTOR REACHED
*
*
*
MIXEND   EQU      %
         BAL,R11  FITCHKS31         QUEUE NEXT FD
         BAL,R11  BLD:BOF70         QUEUE NEXT FIT
         BAL,R15  QUEMIX            INSURE NO TIMING PROBLEM
         LW,R6    MIXBUF            CURRENT BUF WA
         LB,R1    R6                AND ITS NUMBER
         LW,R8    1,R6              GET FWD LINK FROM CURRENT
         BEZ      CKTIO             NO FLINK-FILE ALL DONE
         MTW,0    MIXEOF            FLINK SET,IS EOF SET...
         BNEZ     CKTIO             YEP-FINISH OFF ANYHOW
MIXEND05 LW,R2    INDPAGES          GET # OF INDEX BUFFERS
         LW,R9    M24               MASK
         CS,R8    INDEXDA,R2        FIND FWD LINK IN TABLES
         BE       MIXEND10          WHEN FOUND
         BDR,R2   %-2               KEEP LOOKING
         MTW,1    MIXRAT            BUMP RATE ERROR SWITCH
         B        MIXEND15          READ IT NOW THEN
MIXEND10 XW,R1    R2                SWITCH INDEX VALUES
         AI,R1    INDEXDA            CREATE CORE ADDRESS
         BAL,R7   IOSPIN            WAIT FOR EVENT COMPLETION
         BAL,R7   CHKIO             CHECK TYC
         BNE      ABNIO             IO FAILURE
         AI,R1    -INDEXDA          GET INDEX BACK
         LW,R5    IBUF,R1           FLINK'S BUFFER WA
         LW,R8    0,R5              GET FLINK'S BLINK
         LW,R9    M24               MASK
         CS,R8    INDEXDA,R2        MAKE BLINK TEST
         BE       MIXEND20          PASSES OK
MIXEND15 BAL,R11  RELMIX            RELEASE BUF# IN R1
         AI,R8    0                 HAVE WE BACKED UP TO FDA YET
         BEZ      READFAIL5         YEP,DEFINITE FAILURE
         BAL,R15  DTOGRAN           VERIFY BLINK ADDRESS
         B        READFAIL5         YEP,DEFINITE FAILURE
         STW,R8   NXTFLNK           SAVE DISC ADDRS TO BACK-UP ON
         B        MIXEND            LOOP AROUND TO GET INTO SYNC
MIXEND20 PSW,R1   *STKPNTR          SAVE NEW BUF#
         LB,R1    MIXBUF            GET CURRENT#
         BAL,R11  RELMIX            AND RELEASE CURRENT BUFFER
         PLW,R1   *STKPNTR          RESTORE NEW INDEX#
         LW,R0    IBUF,R1           GET ITS ASSOCIATED BUF WA
         B        GETMIX2           AND CONTINUE PROCESSING
         PAGE
*
*
*        QUEUE INDEX SECTOR SUBROUTINE
*
*
*
QUEMIX   PSW,R15  *STKPNTR          SAVE RETURN LINK
         LW,R8    NXTFLNK           IS FLINK SET NOW
         BNEZ     QUEMIX40          YEP,TRY TO QUEUE IT
         LW,R7    MIXBUF            NO,GET CURRENT BUF WA
         BEZ      QUEMIX50          NO BUFFER ASSIGNED YET
QUEMIX10 LW,R8    1,R7              GET CURRENT FLINK
         BEZ      QUEMIX50          EXIT IF NONE
         LW,R9    M24               MASK
         LI,R6    #IBUF             SET LOOPER
         CS,R8    INDEXDA,R6        IS FLINK IN CORE
         BE       QUEMIX30          GO TO NEXT IF CURRENT IN
         BDR,R6   %-2               FINISH EXAMINATION
QUEMIX20 STW,R8   NXTFLNK           SET AS NEXT QUEUE EFFORT
         B        QUEMIX40          GET INTO PROCESS
QUEMIX30 MTW,0    INDEXDA,R6        FLINK HAD END ACTION YET
         BLZ      QUEMIX50          NO,EXIT NOW,CAN'T USE IT
         LW,R7    IBUF,R6           YEP,GET ITS BUF WA
         B        QUEMIX10          AND SEE ABOUT ITS FLINK
QUEMIX40 BAL,R15  GETIBUF           REQUEST CORE BUFFER
         BNEZ     QUEMIX60          GOT ONE
         MTW,1    IBUFSPIN          NOPE,BUMP WAIT COUNTER
QUEMIX50 BAL,R7   BUILD             SEE IF SOMETHING TO MOVE
         PLW,R7   *STKPNTR          RESTORE RETURN LINK
         LC       R7                SET CC'S
         B        0,R7              AND EXIT
QUEMIX60 LW,R7    R1                MOVE BUF# TO R7
         LI,R8    0                 PICK UP
         XW,R8    NXTFLNK           NEXT FORWARD LINK
         AI,R8    0                 IS ANYTHING TO DO
         BEZ      QUEMIX70          NO FLINK,RELEASE BUF/EXIT
         BAL,R15  DTOGRAN           VERIFY FORWARD LINK
         B        %+2               BAD ADDRESS
         B        QUEMIX65          GOOD ADDRESS
         PLW,R15  *STKPNTR          ADJUST STACK
         BAL,R0   READFAIL5         AND ABORT FILE
QUEMIX65 LW,R10   IBUF,R1           GET BUFFER'S WA
         SLS,R10  2                 TO BYTE ADDRS
         AI,R1    INDEXDA           CREATE CORE ADDRESS
         STB,R7   R8                INSERT BUFFER#
         DO       UTS>=2
         LB,R15   ORG
         CI,R15   1                 CONSECUTIVE
         BG       %+3               NO-MIX IS 1 SECTOR
         BAL,R15  QSECTOR2          YEP-QUEUE UP 2 SECTORS
         B        %+2               CONTINUE
         FIN
         BAL,R15  QSECTOR1          QUEUE IT UP
         AI,R1    -INDEXDA          RESTORE INDEX TO R1
         B        QUEMIX50          AND EXIT
QUEMIX70 BAL,R11  RELMIX            RELEASE THE BUFFER WE GOT
         B        QUEMIX50          AND EXIT
         PAGE
*
*
*
*        RANDOM FILE PROCESSING
*
*
*
RANFILE  EQU      %
         LW,R2    RANDOM            TOTAL GRANULES IN FILE
         STW,R2   RSTORE            SET LOOP THRU FILE
         LI,R1    0                 NOW
         STW,R1   RANDOM            CLEAR LOOP COUNTER
         LW,R8    DUMP              WRITING TAPE
         DO1      CPV>0
         AW,R8    STATS             OR PRODUCING DISKPOOL
         BNEZ     RANFILE1          YES..PROCEED
         STW,R2   RANDOM            SET GRANULE CNT FOR DISPLAY THEN
         SLS,R2   11                CONVERT GRANS TO BYTES
         STW,R2   FILESIZE          SAVE FOR DISPLAY
RANFILE0 B        CKTIO             PROCESS FURTHER
RANFILE1 LW,R8    FDA               FIRST GRANULE ADDRESS ON DEVICE
         DO       UTS=0
         LW,R12   HGP               GET BASE ADDRS
         ELSE
         BAL,R15  MASTER            GOT TO BE IN MASTER MODE
         LI,R12   HGP               FIRST MAP
         FIN
         LH,R2    R8                DCTX FOR FIRST DATA ADDRS
         DO1      CPV>0
         AND,R2   DCT%MASK
         LI,R1    5                 BYTE INDEX TO DCTX FIELD
         LW,R11   R12               MOVE HGP ADDRS TO R11
RANFILE2 CB,R2    *R11,R1           HGP DCTX MATCH DISC ADDRS
         BE       RANFILE3          YES-CONTINUE
         LW,R11   *R11              NO-GET NEXT HGP
         BEZ      MIXSNAP           ABORT FILE
         B        RANFILE2          AND FIND MATCH FOR DCTX
RANFILE3 LI,R1    3                 INDEX TO 'NSPT' FIELD
         LW,R5    *R11,R1           GET NSPT FIELD
         STW,R5   NSPT              SAVE SECTORS PER TRACK
         STW,R1   KEYM              MAKE KEY MAX=3
         DO       UTS>0
         BAL,R15  SLAVE
         FIN
RANFILE4 LW,R1    DAPAGES           TOTAL DATA TABLES LENGTH
         LI,R0    0
         BAL,R11  RELDB
         STW,R0   RB1,R1
         STW,R0   RBHIST,R1
         BDR,R1   %-3
         LW,R5    DAPAGES           DATA BUFER COUNT
RANFILE5 MTW,0    RSTORE            DONE YET
         BLEZ     CKTIO             YES..
         BAL,R15  GETTBUF           GET NXT  UF
         BEZ      RANFILE7          OUTPUT TO TAPE FOR AHILE
         LW,R10   TBUF,R1           GET BUFFER WA
         SLS,R10  2                 TO BA
         LW,R11   R10               MOVE IT TO R11
         OR,R11   Y8                SET BUSY BIT FOR END ACTION
RANFILE6 STW,R11  RB1,R5            AND PLACE INTO RANDOM TABLE
         ANLZ,R1  RANFILE6          GET WA
         LW,R8    FDA               GET CDA
         LI,R9    GRANSIZE          WANT A GRANULE'S WORTH
         BAL,R15  DTOGRAN           VERIFY DISC ADDRESS
         BAL,R0   MIXSNAP           ***FILE ERROR***
         LI,R7    FITENAC           END ACTION
         BAL,R15  DISCIO2           QUEUE INTO CORE
         MTW,1    RADGCNT           INCREMENT TOTAL DATA READS
         LW,R7    NSPT              NSPT
         AWM,R7   FDA               INCREMENTS DISC ADDRS
         MTW,-1   RSTORE            DROP GRAN COUNT
         BLEZ     %+2               DONE AT ZERO
         BDR,R5   RANFILE5          AND GET NEXT DISC ADDRS
RANFILE7 BAL,R15  RANMOVE           OUTPUT SOME RECORDS NOW
         B        RANFILE4          FINISH/CLEAN UP TABLES
         PAGE
*
*
*        CREATE RANDOM FILE TAPE RECORDS
*
*
*
RANMOVE  EQU      %
         LCI      0                 SAVE ALL
         PSM,R0   *STKPNTR          REGISTERS
         LI,R1    RB1               BASE +
         AW,R1    DAPAGES           #BUFFERS GOTTEN
         STW,R1   NEXDATA           SET POINTER TO INITIAL
RDATA    LW,R1    NEXDATA           GET NEXT POINTER
         CI,R1    RB1               AT END YET
         BE       RDATA2            YES-RETURN AND READ SOME MORE
         LW,R2    0,R1              NO-IS DATA IN YET
         BEZ      RDATA2            DONE IF ZERO
         BAL,R7   IOSPIN            WAIT FOR EVENT
         BAL,R7   CHKIO             CHECK TYC
         BE       RDATA0            OK TRANSFER
RDATA00  EQU      %
         LCI      0                 NOT OK
         PLM,R0   *STKPNTR          ADJUST STACK
         BAL,R0   ABNIO             ABORT FILE DUE TO BAD IO
RDATA0   SLS,R2   -2                CONVERT BUF BA TO WA
         STW,R2   CURBUF            CURRENT BUF
         LI,R3    X'1FFFF'          COREMASK
         LW,R4    TAPAGES           SIZE OF TAPE
         CS,R2    TBUF,R4           FIND IT
         BE       RDATA1            OK
         BDR,R4   %-2               KEEP LOOKING
         B        RDATA00           WE'RE LOST
RDATA1   STW,R4   CURINDX           WE NEED INDEX TO RELEASE
         MTW,-1   NEXDATA           DECREMENT POINTER
         LI,R1    2                 TAPE KEY WORD 3
         LW,R2    =X'05000800'      IS CONTROL BITS AND BLOCK SIZE
         STW,R2   TLABUF,R1         PLACE INTO TAPE KEY
         AI,R1    -1                NEXT WORD (2) IS
         LW,R2    =X'03000000'      THE DUMMY TAPE KEY
         OR,R2    RANDOM            INSERT RANDOM BLOCK NUMBER
         STW,R2   TLABUF,R1         AND PLACE INTO TAPE KEY
         AI,R1    -1                LAST WORD IS PBS
         LW,R2    PBS               PREVIOUS BLOCK SIZE
         SLS,R2   16                POSITION IT LEFT
         AI,R2    1                 ADD KEY COUNT THIS BLOCK
         STW,R2   TLABUF,R1         AND PLACE INTO TAPE KEY
         LI,R2    BA(TLABUF)        TRANSFER TAPE KEY
         LI,R1    12                TO RINGBUF
         DO       TAURUS=1
         LW,R6    *EOTFLAG
         ELSE
         LW,R6    EOTBIT            CHECK FOR EOR HERE
         FIN
         CI,R6    EOR
         BNE      %+2               NOT EOR
         BAL,R15  EOTWAIT           EOR..CHANGE REELS
         BAL,R15  MOVEI             BLK/WRITE
         MTW,1    RANDOM            BUMP BLOCK COUNTER
         LI,R1    2048              SET BUFFER SIZE
         STW,R1   RWS               AND RECORD LENGTH
         STW,R1   KEYDISP           SET LENGTH
         AWM,R1   FILESIZE          UPDATE FILE LENGTH
         AWM,R1   BLKDBYTES         UPDATE TOTAL SENT TO TAPE
         LI,R15   RDATA             SET RETURN POINT
         LCW,R5   KEYDISP           NEGATIVE FOR DON'T SPLIT RANDOM
         B        QUEREC1           FILES BETWEEN CONTROL AND DATA
RDATA2   LCI      0                 RESTORE
         PLM,R0   *STKPNTR          REGISTERS
         B        *R15              AND RETURN TO GET NEXT DATA
         PAGE
*
*        BUFFER MANAGEMENT SUBROUTINES
*
*
*        GET TAPE OUTPUT BUFFER
*
GETTBUF  EQU      %
         LI,R0    TBUF              SET TABLE BASE
         LW,R1    TAPAGES           GET PAGE COUNT
GETTBUF10 BAL,R2  GETBUF            FIND A BUFFER
         AI,R3    0                 SET CONDITION CODES
         B        *R15              RETURN
*
*        GET DISC INPUT (DATA) BUFFER
*
GETDBUF  EQU      %
         LI,R0    DBUF              SET TABLE BASE
         LW,R1    DAPAGES
         B        GETTBUF10         GET BUFFER
*
*        GET DISC INPUT (INDICES) BUFFER
*
GETIBUF  EQU      %
         LI,R0    IBUF              SET TABLE BASE
         LW,R1    INDPAGES          GET COUNT
         B        GETTBUF10         GET BUFFER
         PAGE
*
*        BUFFER REQUEST DRIVER
*
GETBUF   EQU      %
         MTW,0    *R0               DOES CNT=ONE AVAIL
         BEZ      GETBUF15          NONE AVAILABLE
         INT,R3   *R0,R1            ELSE SCAN FOR FREE BUF
         BCR,12   GETBUF20
GETBUF10 BDR,R1   %-2               KEEP LOOKING FOR UN-USED BUF
GETBUF15 LI,R3    0                 NONE AVAIL,SET CC'S
         B        0,R2              EXIT
GETBUF20 LW,R3    *R0,R1            PICK UP BUF ADDRS
         BEZ      GETBUF10          GET NEXT IF ZERO
         CLM,R3   BUF:LIMS          COMPARE TO LIMITS
         BCS,9    GETBUF10          GET NEXT IF NOT IN LIMITS
         OR,R3    Y4                SET IN USE BIT
         STW,R3   *R0,R1            SET BUSY
         MTW,-1   *R0               DROP AVAIL COUNT
         B        0,R2
         PAGE
*
*        DATA GRANULE QUEUE AHEAD SUBROUTINE
*
*
GETFOUR  EQU      %
         BAL,R15  GETDBUF           REQUEST DATA BUFFER
         BEZ      GETFOUR2          NONE AVAIL,SET UP EXIT
GETFOUR1 LI,R8    0                 RESET DISC ADDRS REGISTER
         LI,R4    0                 CLEAR STK CONDITIONS CELL
        PLW,R8   DSTACK            PULL UP NEW DISC ADDRESS
         STCF     R4                SAVE STACK CONDITIONS
        CI,R8    0                 DID WE PULL ANYTHING
         BEZ      GETFOUR3          NO,STACK MIGHT BE EMPTY
         LW,R7    DAPAGES           INSURE THIS GRANULE
         LW,R9    M24               ISN'T READY
         CS,R8    RB1,R7            IN CORE
         BE       GETFOUR1          IF ITS IN NOW,PULL ANOTHER
         BDR,R7   %-2               FINISH LOOK
         LW,R10   DBUF,R1           GET BUFFER WA
         SLS,R10  2                 CNVRT TO BA
         BAL,R15  DTOGRAN           INSURE GOOD DISC ADDRESS
         B        DATAERR           FILE ERROR..BAD DATA ADDRS
         AI,R1    RB1               CREATE CORE ADDRS
         BAL,R15  QSECTOR2          QUEUE IT UP
         LC       R4                WHAT IS STACK CONDITION
         BCR,2    GETFOUR           OK,GET NEXT BUFFER
GETFOUR2 LW,R15   R11               SET UP RETURN SEQUENCE
         B        QUEMIX            AND RETURN THRU MIX CODE
GETFOUR3 LC       R4                GET LAST STACK CONDITIONS
         BCR,2    GETFOUR1          ITS NOT EMPTY,TRY IT AGAIN
         PSW,R11  *STKPNTR          STACK IS EMPTY,SAVE EXIT
         BAL,R11  RELDB             RELEASE BUFFER WE HAD
         DO       TAURUS=1
         LI,R7    MIX:SW-EASECT     SET NEED DATA SWITCH
         MTW,1   *EAADDR,R7
         ELSE
         MTW,1    MIX:SW            SET NEED DATA SWITCH
         FIN
         BAL,R7   BUILD             SEE IF SECTOR IS READY
         PLW,R15  *STKPNTR          RESTORE RETURN LINK
         B        QUEMIX            AND EXIT THRU MIX CODE
         PAGE
*
*        UPDATE DISC ADDRESS STACK WITH NEW
*        INDEX SECTOR DATA DISC ADDRS
*
*
*
BUILD    EQU      %
         DO       CPV>0
         MTW,0    STATS             PRODUCING DISKPOOL
         BNEZ     %+3               YEAH, SKIP TAPE TEST
         FIN
         MTW,0    DUMP              ARE WE WRITING TAPE
         BEZ      0,R7              NO REASON TO BE HERE IF ZERO
         LCI      0                 PUT AWAY
         PSM,R0   *STKPNTR          ALL REGISTERS
         DO       TAURUS=1
BUILD0   LI,R4    MIX:CNT1-EASECT   CURRENT SECTOR # MOVED
         LW,R4    *EAADDR,R4
         ELSE
BUILD0   LW,R4    MIX:CNT1          CURRENT SECTOR# MOVED
         FIN
         LI,R2    #IBUF             SET LOOP THRU TABLES
         LW,R5    =X'7FFFFFFF'      MASK TO GET #
         DO       TAURUS=1
         CS,R4    *MIXSTAT,R2
         ELSE
         CS,R4    MIX:STAT,R2       FIND IT
         FIN
         BE       BUILD1            GOTCHA
         BDR,R2   %-2               KEEP LOOKING
         B        BUILD7            NOT FOUND
BUILD1   MTW,0    INDEXDA,R2        HAS IT HAD END ACTION YET
         BLZ      BUILD7            NOPE,EXIT NOW
         DO       TAURUS=1
         MTW,0    *MIXSTAT,R2       TEST FOR PRIOR COMPLETION
         ELSE
         MTW,0    MIX:STAT,R2       TEST FOR PRIOR COMPLETION
         FIN
         BLZ      BUILD6            YEP,DO THE  NEXT ONE THEN
         DO       TAURUS=1
         LW,R0    *MIXSTAT,R2       OK,SET UP
         ELSE
         LW,R0    MIX:STAT,R2       OK,SET UP
         FIN
         OR,R0    Y8                TO INDICATE MOVED TO
         DO       TAURUS=1
         STW,R0   *MIXSTAT,R2       DATA STACK
         ELSE
         STW,R0   MIX:STAT,R2       DATA STACK
         FIN
         LW,R4    IBUF,R2           GET BUFFER'S WA
         LD,R2    TEMPPNTR          REFRESH TEMP STACK
         STD,R2   TEMPSTK           S.P.D.
         STW,R4   NEWINDX           SAVE IN CASE OF CRASH
         DO       UTS>=2
         LB,R1    ORG
         CI,R1    1                 CONSECUTIVE
         BLE      BUILDN            YEP
         FIN
         LW,R1    2,R4              GET SECTOR'S NAV
         SLS,R4   2                 MAKE BUFFER BA
         SLS,R1   -16               POSITION SECTOR NAV
         LW,R6    R4                MAKE R6 LOWEST
         AI,R6    MIDISP            ADDRS TO GET TO
         AW,R4    R1                R4 POINTS TO SECTOR END
         LW,R2    KEYM              GET FILE KEY MAX
         AI,R2    MIKTOKD           KEY-TO-KEY DISPLACEMENTS
         AI,R4    MIKBD             BACK UP TO DISC ADDRS BYTE3
BUILD2   LI,R3    4                 4 BYTES OF DISC ADDRS
         DO       SIGMA7=0
         LB,R8    0,R4              BUILD
         SLD,R8   -8                  ADDRS
         AI,R4    -1                    INTO
         BDR,R3   %-3                     R8
         LW,R8    R9                ADDRS INTO R8 FOR CHECKS/IO
         ELSE
         LI,R5    32                DEST BA OF R8
         STB,R3   R5                SET COUNT
         AI,R4    -3                POINT TO BYTE0
         MBS,R4   0                 MOVE OUT DATA ADDRS
         AI,R4    -5                BACK TO BYTE0
         FIN
         SW,R4    R2                POINT TO NEXT KEY
         CI,R8    0                 NULL ADDRS
         BEZ      BUILD3            YES..NO SAVE
         CW,R8    LASTGRAN          SAME AS LAST ONE
         BE       BUILD3            UP..NO SAVE
         STW,R8   LASTGRAN          NEW ONE HIET
         PSW,R8   TEMPSTK           PLACE INTO SAVE STACK
BUILD3    CW,R4   R6                ARE WE AT END OF SECTOR
         BG       BUILD2            NOPE..FINISH UP
         DO       UTS>=2
BUILD31  EQU      %                 BUILDN RETURNS HERE
         FIN
         LI,R4    X'FF'             SIZE MASK
         AND,R4   TEMPSTK+1         GET SIZE PUSHED
         BEZ      BUILD6            NOTHING TO MOVE
         LI,R6    X'FFF'
         AND,R6   DSTACK+1          GET DATA STACK SIZE CURRENTLY
         BNEZ     %+3               GOT SOMETHING IN IT
         PSW,R6   DSTACK            NO-PLACE A STACK MARKER
         AI,R6    1                 AND BUMP HOLD COUNT
         MSP,R4   DSTACK            BUMP DATA STACK UP
         LI,R7    X'FFF'            NOW GET NEW
         AND,R7   DSTACK+1          VALUE
BUILD4   LW,R0    STACK-1,R6        MOVE CONTENTS
         STW,R0   STACK-1,R7        UP TO NEW BOUNDARY
         AI,R7    -1
         BDR,R6   BUILD4            AND FINISH MOVE
BUILD5   LW,R0    TMPSTK-1,R4
         STW,R0   STACK-1,R7        TO DATA STACK-1
         AI,R7    -1                DATA STACK DOWN
         BDR,R4   BUILD5            FINISH MOVING INTO PLACE
         DO       TAURUS=1
BUILD6   LI,R4    MIX:CNT1-EASECT   BUMP TO NEXT SECTOR #
         MTW,1    *EAADDR,R4
         ELSE
BUILD6   MTW,1    MIX:CNT1          BUMP TO NEXT SECTOR#
         FIN
         B        BUILD0            LOOK FOR NEXT SECTOR#
BUILD7   LCI      0                 RESTORE
         PLM,R0   *STKPNTR          REGISTERS WE PUSHED
         B        0,R7              AND EXIT
         DO       UTS=0
         PAGE
*
*
*        LOAD MODULE LOADED WITH TSS OF LESS THAN 80
*
*
STKSIZR  EQU      %
         LI,R1    BA(STKMS)
         BAL,R15  TYPEIO
         LI,15    STKMS
         CAL1,2   PRNT15
         CAL1,9   3
         FIN
         PAGE
         DO       UTS>=2
*
*        UPDATE DISC ADDRESS STACK WITH NEW
*        UNBLOCKED DATA SEGMENT DISC ADDRESSES
*
BUILDN   EQU      %                 R4=WA(IBUF)
         LI,R2    2                 DISP. TO GRANULE CW
         INT,R6   *R4,R2            GET CONTROL INFO.
         BCR,8    BUILD7            CC1 RESET IF NO CASE 2 ENTRIES
         BCR,4    %+2               CC2 SET IF GRANULE FULL
         AI,R6    1                 R6=1 IF FULL, =0 IF NOT FULL
         AI,R4    SCWDISP           DISP. TO 1ST SCW IN GRAN.
BUILDN1  INT,R2   *R4               GET SCW
         BCS,8    BCASE2            CC1 SET IF BLOCKED (CASE 2)
BCASE1   EQU      %                 CASE 1-SKIP TO NEXT SCW
         AI,R2    3                 ROUND UP NO. OF BYTES
         SLS,R2   -2                CONVERT TO WORDS
         AW,R4    R2                POINT TO NEXT SCW
BUILDN2  CW,R4    R7                R7=NAV
         EXU      BBR31,R6          BGE OR BG BUILD31
         LH,R2    *R4               SEE IF CASE 3
         BNEZ     BUILDN1           NOT CASE 3, CONTINUE
BUILDN3  AI,R4    1                 CASE 3-SKIP OVER/CASE 2-GET NEXT SCW
         B        BUILDN2           AND CONTINUE
BCASE2   EQU      %                 CASE 2-GET DISC ADDRESS
         LI,R1    1
         STB,R2   R3,R1             DCTX IN R2(BYTE 3)
         CW,R3    LASTGRAN          DISC ADDRESS SAME AS LAST ONE
         BE       BUILDN3           YEP-DON'T SAVE
         STW,R3   LASTGRAN          NEW ONE
         PSW,R3   TEMPSTK           PLACE INTO SAVE STACK
         B        BUILDN3           AND KEEP GOING
BBR31    BGE      BUILD31           RETURN VIA BUILD
         BG       BUILD31           RETURN VIA BUILD
         PAGE
         FIN
         PAGE
*
*        BAD I/O, TYC IN R15,DISC ADDRS IN R14
*
ABNIO    EQU      %
         M:SNAP   'BAD I/O'
         B        MIXSNAP           ABROT CURRENT FILE
         PAGE
*
*
*        QUEUE ACN/FD/FIT READ-AHEAD I/O
*
*
*
QSECTOR  EQU      %
QSECTOR1 LI,R9    SECSIZE           ENTER HERE FOR SECTOR
         MTW,1    RADXCNT           BUMP SECTOR COUNTER
         B        QSECTOR3
QSECTOR2 LI,R9    GRANSIZE          ENTER HERE FOR GRANULE
         MTW,1    RADGCNT           BUMP GRANULE COUNTER
QSECTOR3 LW,R6    R8                SET BUSY
         OR,R6    Y8                  BIT IN DISC ADDRESS
         STW,R6   0,R1                  MOVE TO TABLE SLOT
         LI,R7    FITENAC           SET UP END ACTION ADDRS
         B        DISCIO2           LINK STILL IN R15
         PAGE
*
*        RAD / DISK PAK HANDLER                                                *
*
*        CALLING SEQUENCE:
*
*        R1:      END ACTION INFORMATION
*        R8:      PUBLIC FILE DISC ADDRESS
*        R9:      BYTE COUNT FOR I/O OPERATION
*        R10:     RECEIVING BUFFER BYTE ADDRESS
*        R15:     RETURN LINK
*
*
*
         DO       TAURUS=1
DISCIO2  EQU      %
         LCI      0                 SAVE CURRENT REGS
         PSM,R0   *STKPNTR
         LI,R2    DOPCNT-EASECT     BUMP TOTAL READ AHEAD CNT
         MTW,1    *EAADDR,R2
         MTW,-1   NOWAIT            SET NOWAIT TRANSFER
         B        DISCIO1A          GET INTO PROCESS
DISCIO   EQU      %
         LCI      0                 SAVE CURRENT REGS
         PSM,R0   *STKPNTR
         LI,R2    RBUSY-EASECT      SET WAIT FLAG
         MTW,-1   *EAADDR,R2
         B        DISCIO1A          GET INTO PROCESS
         ELSE
DISCIO2  MTW,1    DOPCNT            BUMP TOTAL READ AHEAD CNT
         MTW,-1   NOWAIT            SET NO WAIT TRANSFER
         B        DISCIO1           GET INTO PROCESS
DISCIO   MTW,-1   RBUSY             SET WAIT FLAG
DISCIO1  LCI      0                 SAVE CURRENT REGISTERS
         PSM,R0   *STKPNTR          IN STACK
         FIN
         DO1      TAURUS=1
DISCIO1A EQU      %
         STW,R15  DISCIOX           PUT AWAY RETURN ADDRS
         AND,R8   M24               MASK DISC  ADDRESS
         BAL,R15  MASTER            GET INTO MASTER MODE
         LCI      5                 BRING UP
         LM,R12   QBUF              CALLING SEQUENCE REGISTERS
         OR,R13   R10                BYTE ADDRS OF BUFFER
         AND,R13  M24               SCRUB HIGH ORDER BITS IF ANY
         OR,R14   R9                 BYTE COUNT
         LW,R15   R8                 DCTX/DISC ADDRS
         LH,R8    R8                 RIGHT JUSTIFY DCTX
         DO1      CPV>0
         AND,R8   DCT%MASK
         OR,R12   R8                 SET IT FOR CALL
         MTW,0    NOWAIT             END ACTION DIFFERENT
         BEZ      %+2                NO--USE NORMAL SETTING
         STW,R7   R0                 YES--SET IT FOR CALL
         DO       CPV>0
         MTW,0    STATS             CREATING GRANULE STATISTICS
         BEZ      DISCIO3           NO
         CI,R10   BA(FITBUF)        DON'T COUNT
         BLE      DISCIO3           A.D. OR F.D. OR FIT
         REF      BATAPE
         CI,R8    BATAPE            TAPES FALL BETWEEN RADS AND PACKS
         BL       DISCIO3-1         LESS MEANS RAD
         MTW,1    PACKGRAN          BUMP PACK COUNT
         B        DISCIO3
         MTW,1    RADGRAN           BUMP RAD COUNT
DISCIO3  EQU      %
         FIN
         DO       UTS>0
         DO       TAURUS=1
         LI,R2    CUN-EASECT        GET OUR USER #
         LW,R2    *EAADDR,R2
         ELSE
         LW,R2    CUN               GET OUR USER#
         FIN
         BAL,R11  BUMPMF            INCREMENT MY MASTER FUNCTION
         BAL,R11  EAINIT            INIT PHYSICAL ADDRESSES
         BAL,R11  NEWQNWM           CALL NEWQ NO-WAIT MAPPED
         ELSE
         BAL,R11  *NEWQ              QUEUE RAD I/O REQUEST
         FIN
         B        DEVDOWN
         MTW,0    NOWAIT            IS I/O SPIN SET
         BEZ      DWAIT             YES-GO SPIN
         MTW,1    NOWAIT            NO-TURN IT OFF
         B        DNOK              AND EXIT
         DO       TAURUS=1
DWAIT    LI,R1    RBUSY-EASECT      NOW
         AW,R1     EAADDR
         ELSE
DWAIT    LI,R1    RBUSY             NOW
         FIN
         BAL,R15  SLAVE             DON'T DO IT MASTER MODE
         BAL,R7   IOSPIN            WAIT FOR EVENT
         BAL,R15  MASTER            FINISH UP NOW
         DO       TAURUS=1
         LW,R1    EAADDR
         AI,R1    DSTATUS-EASECT    GET I/O TYC
         LB,R1    *R1
         ELSE
         LB,R1    DSTATUS           GET I/O TYC
         FIN
         CI,R1    NORMAL             WAS NORMAL I/O RETURN
         BE       DNOK1             YES-EXIT + ONE
DEVDOWN  M:SNAP   'BAD I/O',(TBUF,CURRB)
         B        DNOK              ERROR EXIT
DNOK1    MTW,1    DISCIOX           BUMP RETURN ADDRS
DNOK     LCI      0                 PULL UP
         PLM,R0   *STKPNTR          RETURN REGISTERS FROM STACK
         LW,R15   DISCIOX           GET RETURN POINT
         B        SLAVE             AND GO BACK TO SLAVE MODE
         PAGE
*
*        CHECK TYC IN CELL POINTED TO BY R1
*
CHKIO    EQU      %
         LW,R14   0,R1              GET DISC ADDRS CELL
         LB,R15   R14               GET TYC FROM IT
         CI,R15   NORMAL            SET CC'S TO TYC
         B        0,R7              AND EXIT
         PAGE
         DO       UTS<4
*
*
*        END ACTION FOR SUBROUTINE 'DISCIO'
*
*
*
         DO       UTS>0
         USECT    EASECT
         FIN
DENAC   EQU       %
         WD,0     X'37'
         LI,R1    0
         SECT
         STW,R1   RBUSY              RESET BUSY STATUS FLAG
         SECT
        STW,R12   DSTATUS
         DO       UTS=0
         WD,0     X'27'
        B         *R11
         ELSE
MF:DWN   EQU      %
         SECT
         LW,R2    CUN               GET USER#
         DO       UTS>=2
         STW,R2   *TSTACK           K  L  U  D  G  E
         ELSE
         LI,R1    -1
         STW,R2   *TSTACK,R1
         FIN
         WD,0     X'27'
         B        *R11              AND EXIT
         FIN
         FIN
         PAGE
         DO       UTS<4
*
*
*       END ACTION RECEIVER FOR ALL 'QSECTOR' REQUESTS AND
*        FINAL END-ACTION CLEANUP FOR ALL OTHER READ
*        AHEAD I/O EVENTS.
*
*
*
*
FITENAC  EQU      %
         WD,0     X'37'
         SECT
ENDACT  MTW,-1   DOPCNT            DECREMENT READ-AHEAD COUNT
         SECT
         STW,R12  DSTATUS           SAVE DISC STATUS
         DO       UTS>0
         CALL     VTOPU,R14
         FIN
ENDACT0  LB,R2    *R14              GET TYPE
         CI,R2    X'80'             IS DATA REQUEST
         SECT
         BE       ENDACT1           YEP
         SECT
         AND,R2   =X'0000007F'      NO,DROP BUSY BIT
         SECT
         LW,R1    MIX:CNT2          GET NUMBER RECEIVED
         SECT
         STW,R1   MIX:STAT,R2       PUT#RECEIVED INTO STAT TABLE
         SECT
         MTW,1    MIX:CNT2          AND BUMP # RECEIVED
ENDACT1  EQU      %
         SECT
         LW,R0    M24               MASK OFF TO
         AND,R0   *R14              DROP BUSY BIT
         SECT
         LB,R1    DSTATUS           PUT TYC
         STB,R1   R0                INTO ADDRS CELL
         STW,R0   *R14              AND REPLACE
         DO       UTS=0
         WD,0     X'27'
         B        *R11              RETURN TO END RECEIVER
         ELSE
         SECT
         B        MF:DWN
         USECT    START
         FIN
         FIN
         PAGE
*
*        CALL REGISTERS FOR DISC I/O
*
QBUF     EQU      %
         DATA,1   READISC,IOPRI,RETRY,0   (R12)
        DATA      0                 R13: WILL CONTAIN BA OF BUFFER
        DATA      0                 R14: WILL CONTAIN RECORD BYTE COUNT
        DATA      0                 R15: WILL CONTAIN DISC ADDRESS
        DATA      DENAC             R0: END ACTION ADDRESS
         PAGE
*
*
*    MAG TAPE DRIVER
*
*        CALLING SEQUENCE:
*
*        R1:      END ACTION INFORMATION DESIRED
*        R6=0     NORMAL CALL-COMMAND LIST HAS END ACTION ADDRS
*        R6<0     R5 CONTAINS BYTE COUNT,CURBUF IS BUF WA
*        R6>0     NO DATA XFER-R6=FCN CODE
*        R7=      POINTER TO CALL REGS
*
*
MTIO    EQU       %                ENTRY POINT......
         DO       TAURUS=1
         MTW,0    *EOTFLAG          ARE WE HOLDING AT END OF REEL
         ELSE
        MTW,0     EOTBIT           ARE WE HOLDING AT END OF REEL
         FIN
        BNEZ      EOTWAIT          YES-GET NEXT REEL
        LCI       0                NOPE
         PSM,R0   *STKPNTR         PUT AWAY CALLER'S REGISTERS
         BAL,R15  MASTER            GET INTO MASTER MODE
         MTW,1    TPACC            INCREMENT TAPE ACCESS'S COUNT
        LCI       4                BRING UP
        LM,R12    0,R7             COMMAND LIST
        CI,R6     0                SPECIAL CALL
        BLZ       DATA             R6<0 INDICATES DATA PASSED
         DO       TAURUS=1
         LI,R0    SENTENAC-EASECT   END ACTION RECEIVER
         AW,R0    EAPHYADR          START OF ENDAC PAGE
         ELSE
         LI,R0    SENTENAC          END ACTION RECEIVER
         FIN
         CI,R6    0                 FCN PASSED
         BEZ      GONEWQ            NOPE..SET WRITE
         STB,R6   R12               YES..SET IT
         B        GONEWQ1
*
*        DATA WRITE REQUEST
*
DATA     EQU      %
         LW,R13   CURBUF            GET CURRENT BUF  WA
         AND,R13  M17               SCRUB ALL BUT WA
         STW,R13  LSTBUF            SAVE IT
         SLS,R13  2                 MAKE IT BA
         OR,R14   R5                SET BYTE COUNT UP
         STW,R5   PBS               SET PREVIOUS BLOCK SIZE
         LI,R2    0                 RESET CURRENT BUF
         STW,R2   CURBUF            POINTER TO FORCE A REQUEST
         DO       TAURUS=1
         LI,R0    WTENAC-EASECT     ENDACTION RECEIVER
         AW,R0    EAPHYADR          START OF ENDACTION PAGE
         ELSE
         LI,R0    WTENAC            SET END ACTION ADDRS
         FIN
GONEWQ   LI,R9    WRT               SET WRITE FUNCTION CODE
         STB,R9   R12               FOR NEWQ
         DO       TAURUS=1
GONEWQ1  EQU      %
         LI,R2    OPCNT-EASECT      BUMP TAPE I/O COUNT
         MTW,1    *EAADDR,R2
         ELSE
GONEWQ1  MTW,1    OPCNT             BUMP TAPE I/O COUNT
         FIN
         DO       CPV>0
         MTW,0    DUMP              REALLY WANT TO WRITE TAPE
         BEZ      MTIOX             NO..JUST PRODUCING DISKPOOL
         FIN
         OR,R12   MTDCTX            SET TAPE DCT INTO R12
         DO       UTS>0
         DO       TAURUS=1
         LI,R2    CUN-EASECT        GET OUR USER #
         LW,R2    *EAADDR,R2
         ELSE
         LW,R2    CUN               GET OUR USER#
         FIN
         BAL,R11  BUMPMF            INCREMENT MY MASTER FUNCTION
         BAL,R11  EAINIT            SET UP PHYSICAL ADDRESSES
         BAL,R11  NEWQNWM           CALL NEWQ NO-WAIT MAPPED
         ELSE
         BAL,R11  *NEWQ             QUEUE THE REQUEST
         FIN
         NOP      0                 IGNORE ERROR RETURNS
         LCI      0                 RESTORE
         PLM,R0   *STKPNTR          REGISTERS
         B        SLAVE             GO BACK TO SLAVE MODE
         DO       CPV>0
MTIOX    EQU      %                 FAKE LIKE END ACTION
         DO       TAURUS=1
         LI,R0    1                 TYC=1
         LI,R2    TPSTATUS-EASECT
         STW,R0   *EAADDR,R2
         ELSE
         LI,R2    1                 TYC=1
         STW,R2   TPSTATUS
         FIN
         LI,R0    X'1FFFF'
         AND,R0   TBUF,R1
         STW,R0   TBUF,R1
         MTW,1    TBUF
         DO       TAURUS=1
         LI,R2    OPCNT-EASECT      DROP I/O COUNT
         MTW,-1   *EAADDR,R2
         ELSE
         MTW,-1   OPCNT             DROP I/O COUNT
         FIN
         B        MTIOX-3
         FIN
         PAGE
*
*        FSAVE RUNS IN MASTER MODE ONLY WHILE QUEUEING
*        DATA,ETC, THEN RETURNS TO SLAVE MODE WHILE
*        PROCESSING.
*
SLAVE    EQU      %
         LPSD,0   SLPSD             ELSE,GO BACK TO SLAVE MODE
SLV:EXIT B        *R15              AND RETURN TO CALLER
*
*
MASTER   LCI      3                 SAVE
         PSM,R8   *STKPNTR          VOLATILES
         CAL1,6   SYSFPT            GO TO MASTER MODE
         LCI      3                 RESTORE
         PLM,R8   *STKPNTR          VOLATILES
         B        *R15              AND RETURN
         DO       UTS>0
         PAGE
*
*        CHECK MASTER FUNCTION FOR MAXIMUM
*        IF MAXIMUM,  SPIN
*        OTHERWISE,  BUMP MASTER FUNCTION
*
BUMPMF   EQU      %
         LB,R3    UB:MF,R2          GET MASTER FUNCTION
         CW,R3    MAXMF             IS IT LESS THAN MAXIMUM
         BGE      BUMPMF1           NO, SPIN UNTIL IT IS
         MTB,1    UB:MF,R2          YES, BUMP IT
         B        *R11              AND RETURN
BUMPMF1  EQU      %                 ALLOW SWAPPING HERE
         PSW,R15  *STKPNTR
         BAL,R15  SLAVE
         LI,R15   2000
         BDR,R15  %
         BAL,R15  MASTER            THAT'S LONG ENUF
         PLW,R15  *STKPNTR
         B        BUMPMF            TAKE ANOTHER PEEK
         FIN
         PAGE
         DO       UTS<4
*
*        ALL DATA WRITES END ACTION
*        PERFORMED HERE-A 'TYC' OF EOR/WRITE ERROR
*        WILL CAUSE A REEL CHANGE REQUEST
*
*        R14 WILL CONTAIN TABLE POINTER
*
*
*
         DO       UTS>0
         USECT    EASECT
         FIN
WTENAC   EQU      %
         WD,0     X'37'             DISABLE*********
         SECT
         MTW,-1   OPCNT             DROP I/O COUNT
         SECT
         STW,R12  TPSTATUS          SAVE TAPE TYC
         LW,R7    R14               TABLE INDEX IN R14
         DO       UTS=0
         LI,R0    X'1FFFF'          CORE MASK
         AND,R0   TBUF,R7           CLEAR BUSY BIT IN TABLES
         STW,R0   TBUF,R7           AND REPLACE VALUE
         MTW,1    TBUF              BUMP AVAIL COUNT
         ELSE
         AI,R14   TBUF
         CALL     VTOPU,R14
         LI,R0    X'1FFFF'          SET ADDRESS MASK
         AND,R0   *R14
         STW,R0   *R14
         LI,R0    TBUF
         CALL     VTOPU,R0
         MTW,1    *R0
         FIN
         SECT
         LB,R1    TPSTATUS          GET TYC
         CI,R1    EOR               WAS END OF REEL HIT
         SECT
         BNE      %+2               NO
         SECT
         STW,R1   EOTBIT            SET END OF REEL IF SO
         CI,R1    WRTERR            WAS TAPE WRITE ERROR
         SECT
         BNE      %+2               NOPE
         SECT
         STW,R1   EOTBIT            SET SWITCH REELS IF SO
         DO       UTS=0
         WD,0     X'27'             LET EM COME
         B        *R11              RETURN TO END RECEIVER
         ELSE
         SECT
         B        MF:DWN
         USECT    START
         FIN
         FIN
         PAGE
*
*        END OF CURRENT OUTPUT REEL REACHED
*
EOTWAIT EQU       %                 ENTRY-PUT AWAY THE I/O REQUEST
         LCI      0                 REGISTERS FOR THE I/O CALL
         PSM,R0   *STKPNTR          INPROGRESS
         DO       TAURUS=1
         LW,R1    *EOTFLAG
         ELSE
         LW,R1    EOTBIT            GET REEL CHANGE REASON
         FIN
         CI,R1    WRTERR            IS DUE TO TAPE WRITE ERR
         BE       IWTERR            YEP,OUTPUT ALARM MSG
EOTWAIT00 EQU     %
         DO       FILL
         ELSE
         LD,R0    ACN#CURNT
         LCI      2
         STM,R0   ACNBUF+1
         FIN
         BAL,R1   GOEOR             SEND EOR/EOV SENTINELS TO TAPE
         LI,R3    3
         LB,R1    REELSN,R3         GET X OF PRGX
         DO       FILL
         LB,R2    XTABLE            # OF VALUES FOR X
         CB,R1    XTABLE,R2         EQUAL TO LAST ONE
         BNE      EOTWAIT01         NO, FIND OUT WHICH ONE
         LI,R2    2                 BYTE DISP. TO LETTER
         MTB,1    REELSN,R2         BUMP TO NEXT HIGHER
         LI,R2    1                 RECYCLE X
         B        EOTWAIT02
         CB,R1    XTABLE,R2         FIND MATCH FOR X
         BE       %+2               FOUND IT
EOTWAIT01 BDR,R2  %-2               KEEP ON LOOKIN'
         AI,R2    1                 INDEX TO NEXT X
EOTWAIT02 LB,R1   XTABLE,R2         PICK UP NEXT VALUE FOR X
         STB,R1   BRECREC+7,R3      UPDATE :BREC
         ELSE
         AI,R1    1                 INCR
         CI,R1    '9'               TEST FOR CYCLE
         BLE      %+2               NOPE..DON'T RECYCLE
         AI,R1    -9                YES..RECYCLE
         FIN
         STB,R1   REELSN,R3         RESET CURRENT SERIAL#
         LW,R1    REELSN            RESTORE R1
EOTWAIT0 STW,R1   NEWRLMS+1         PLACE INTO NEW REEL MSG
         DO       UTS=0
         STW,R1   PRTMESS+2         STORE INTO HEADER MSG
         FIN
         STW,R1   REELSN            PLACE BACK INTO FPT
         MTW,1    VOL#              INCREASE VOLUMN #
         LW,R0    LIST              LIST SET
         BEZ      EOTWAIT1          NO
         CAL1,1   PAGEFPT           YES
         LI,R1    3
         BAL,R15  SPACE
         LI,R15   NEWRLMS           SET TO PRINT
         CAL1,2   PRNT15
         LI,R1    3
         BAL,R15  SPACE
         LI,R15   CR                PRINT
         CAL1,2   PRNT15            'ACCOUNT XXXX'
         LI,R1    2                 AND SPACE
         BAL,R15  SPACE
EOTWAIT1 BAL,SR3  NEWREEL           MOUNT NEXT REEL
         LI,R6    0                 AND THEN RESET
         DO       TAURUS=1
         STW,R6   *EOTFLAG
         ELSE
         STW,R6   EOTBIT            END OF REEL PENDING
         FIN
         LCI      0                 RESTORE THE I/O
         PLM,R0   *STKPNTR          REQUEST REGISTERS WE INTERCEPTED
         CI,R6    0                 LLAST ORDER=DATA XFER
         BLZ      MTIO+2            YES..WRITE IT NOW
         B        *R15              NOPE..IGNORE REQUEST
         PAGE
*
*        TAPE WRITE ERROR--SWITCH TO NEW REEL
*
IWTERR   EQU       %
         LI,R1    BA(TPWRTERR)      TELL OPERATOR
         BAL,R15  TYPEIO            ABOUT THE WRITE
         M:PRINT  (MESS,TPWRTERR)   SEND IT TO PRINTER
         B        EOTWAIT00         CHANGE REELS
         PAGE
         DO       UTS<4
*
*        SENTINEL END ACTION
*
*
*        ALL SENTINELS WRITTEN TO TAPE GET
*        END ACTION HERE-END OF REEL IS IGNORED
*        A TAPE ERROR WILL CAUSE A REEL CHANGE
*
         DO       UTS>0
         USECT    EASECT
         FIN
SENTENAC EQU      %
         SECT
         MTW,-1   OPCNT             DECREMENT I/O COUNT
         SECT
         STW,R12  TPSTATUS          SAVE TYC
         SECT
         LB,R1    TPSTATUS
         CI,R1    WRTERR            WAS TAPE ERROR
         SECT
         BNE      %+2               NOPE
         SECT
         STW,R1   EOTBIT            SET REEL SWITCH IF IT IS
         DO       UTS=0
         B        *R11              RETURN TO END RECEIVER
         ELSE
         SECT
         B        MF:DWN
         USECT    START
         FIN
         FIN
         PAGE
*
*        OUTPUT REEL REQUEST SUBROUTINE
*
NEWREEL  EQU      %
         PSW,SR3  *STKPNTR          PUT AWAY LINK
         LW,R1    REELSN            MOVE SERIAL#
         STW,R1   LBLBUF+1          INTO SENTINEL BUFFER
         STW,R1   VOL#CURNT         OPER. INFO.
         CAL1,1   OPNTAPE           ASK FOR A NEW ONE
         LI,R3    X'FF'             MASK FOR DCTX
         AND,R3   M:EO+1            PICK IT UP FROM DCB
         CI,R3    0                 DID WE GET ONE
         BEZ      DCTXERR           ***DISASTER****
         DO       UTS=0
         CW,R3    DCTSIZ
         ELSE
         CI,R3    DCTSIZ
         FIN
         BG       DCTXERR           NO--ABORT----
         STW,R3   MTDCTX            YES-SAVE IT FOR TAPE I/O
         LI,R6    REWOL             SET REWIND
         LI,R7    QBUF              SET CALL REGS
         BAL,R15  MTIO+2            REW DEVICE
         LI,R2    BA(LBLBUF)        SET UP
         LI,R1    12                TO WRITE
         BAL,R15  MOVEI             :LBL RECORD
         LCI      2
         LM,2     BKUPVLP+1         GET CURRENT DATE
         STM,2    ACNBUF+3
         STM,2    ACNBUF+5
         LI,2     X'4040'           BLANK MINUTES
         STH,2    ACNBUF+4          IN CURRENT DATE
         STH,2    ACNBUF+6          IN EXPIR DATE
         MTW,1    ACNBUF+6          ADD 1 YY TO EXPIR DATE
         LI,R2    BA(ACNBUF)        SET UP
         LI,R1    28                TO WRITE
         BAL,R15  MOVEI             THE :ACN RECORD
         BAL,R15  WRTMARK           AND A TAPE MARK
         LW,R1    VOL#              GET VOLUMN#
         CI,R1    1                 ON FIRST REEL
         BE       NEWREEL3          YEP..DON'T WRITE OLD BOF
         B        NEWREEL3-1        ***REMOVE WHEN CHECKED OUT***
         LI,R1    9                 SEARCH FOR 09 CODE IN :BOF
         LI,R2    BOFBUF+10         WHERE TO START SEARCHING
         LI,R3    3                 DISP. TO LENGTH OF ENTRY
NEWREEL1 EQU      %
         CB,R1    *R2               DOES CODE MATCH
         BE       NEWREEL2          SURE ENUF
         LB,R0    *R2,R3            LENGTH OF ENTRY
         AI,R0    1                 INCLUDE CODE WORD
         AW,R2    R0                WHERE TO CONTINUE SEARCHING
         B        NEWREEL1
NEWREEL2 EQU      %
         LI,R3    6                 BYTE DISP. TO VOL
         MTB,1    *R2,R3            BUMP VOL IN :BOF
         LI,R1    1                 RESET
         STW,R1   VOL#              SO WE WILL KNOW
         BAL,R15  BOFQUE            WRITE OLD :BOF ON NEW TAPE
NEWREEL3 EQU      %
         PLW,SR3  *STKPNTR          GET RETURN LINK
         B        *SR3              RETURN TO CALLER
         PAGE
*
*        SUBROUTINE TO WRITE DATE RECORD
*
WRTDAT   EQU      %
         MTW,0    LABELEDT          ARE WRITING FPURGE STYLE
         BNEZ     0,R7              NO--RETURN NOW
         PSW,R7   *STKPNTR          SAVE LINK
         LI,R2    BA(DATBOF)        SET UP :BOF
         LI,R1    49                TO WRITE
         BAL,R15  MOVEI             DATE RECORD
         LI,R2    BA(TPLBUF)        SET UP TO
         LI,R1    28                SEND TAPE LABEL
         BAL,R15  MOVEI             BUILD/WRITE RECORD
         BAL,R15  WRTMARK           WRITE TAPE MARK
         LI,R2    BA(DATBUF)        SET BA  OF BUFFER
         LI,R1    36                SET RECORD SIZE
         STW,R1   PBS               SET BLOCK SIZE VALUE
         BAL,R15  MOVEI             BUILD/WRITE RECORD
         BAL,R14  EOFQ              WRITE :EOF RECORD
         PLW,R7   *STKPNTR          GET LINK FROM STACK
         B        0,R7              AND RETURN
         PAGE
*
*
*        ANY ERROR FROM M:EO DCB GETS YOU HERE
*
*
*
DCTXERR  EQU      %
OPNABN   EQU      %
OPNERR   EQU      %
         M:SNAP   'OPNFAIL',(M:EO,M:EO+41)
         LI,R1     FPEXIT
         B         IORUNDWN
         PAGE
*
*        END OF REEL SUBROUTINE
*
GOEOR    EQU      %
         PSW,R1   *STKPNTR          SAVE LINK
         MTW,0    ENDOFSET          IS END OF SET
         BNEZ     GOEOR1            YES-NO :EOV SENTINEL
         BAL,R15  WRTMARK           WRITE TAPE MARK
         LW,R7    PBS               GET LAST BLOCK SIZE
         STW,R7   EOVBUF+1          SET INTO :EOV BUF
         LI,R2    BA(EOVBUF)        SET UP
         LI,R1    12                TO WRITE
         BAL,R15  MOVEI             :EOV RECORD
         BAL,R15  WRTMARK           WRITE TAPE MARK
GOEOR1   LI,R7    12                LAST PBS
         STW,R7   EORBUF+1          INTO :EOR BUF
         LI,R2    BA(EORBUF)        SET UP
         LI,R1    12                TO WRITE
         BAL,R15  MOVEI             THE :EOR RECORD
         LI,R1    4                 WRITE FOUR
         BAL,R15  WRTMARK           TAPE MARKS
         BDR,R1   WRTMARK
         DO       TAURUS=1
         LI,R1    OPCNT-EASECT      NOW SPIN DOWN
         MTW,0    *EAADDR,R1
         ELSE
         MTW,0    OPCNT             NOW SPIN DOWN
         FIN
         BGZ      %-1               ALL THOSE I/O REQUESTS
         MTW,0    ENDOFSET          IS END OF SET
         BEZ      %+3               NO
         LC       J:JIT             YES - IS IT ON-LINE
         BCS,8    %+2               YES - DON'T CLOSE REEL
         CAL1,1   CLSEO             CLOSE THIS REEL OUT
         PLW,R1   *STKPNTR          RESTORE EXIT
         B        0,R1              AND RETURN
         PAGE
*
*        QUEUE EOF SUBROUTINE
*
EOFQ     EQU      %
         PSW,R14  *STKPNTR
         BAL,R15  WRTMARK           WRITE TAPE MARK
         LW,R0    SYNFLAG           LAST FILE A SYNON
         BEZ      EOFQ1             NOPE
         LI,R2    12                YES-SET PBS AS 12
         B        %+2               AND USE IT
EOFQ1    LW,R2    PBS               PREVIOUS BLOCK SIZE
         STW,R2   EOFBUF+1          INTO :EOF RECORD
         LI,R2    BA(EOFBUF)        SOURCE BA FOR MOVEI
         LI,R1    12                RECORD BYTE COUNT
         BAL,R15  MOVEI             BUILD/WRITE RECORD
         PLW,R15  *STKPNTR
         B        WRTMARK           AND WRITE MARK/RETURN
         PAGE
*
*        SEND BOF/TAPE LABEL RECORDS TO TAPE
*
BOFQUE   EQU      %
         PSW,R15  *STKPNTR
         LI,R2    BA(BOFBUF)        SOURCE BA
         LW,R1    BOFSIZE           SIZE IN BYTES
         BAL,R15  MOVEI             BUILD/WRITE RECORD
         MTW,0    LABELEDT          R WRITING FPURGE TYPE TAPE
         BNEZ     BOFQUE1           NO-DON'T WRITE TAPE LABEL
         LI,R2    BA(TPLBUF)        TAPE LABEL BA
         DO       FILL
         LB,R1    TPLFLG            RECORD SIZE IN BYTES
         ELSE
         LI,R1    28                RECORD SIZE
         FIN
         BAL,R15  MOVEI             BUILD/WRITE RECORD
BOFQUE1  PLW,R15  *STKPNTR          GET RETURN LINK
         B        WRTMARK           WRITE TAPE MARK/RETURN
         PAGE
*
*        WAIT FOR END ACTION ON DISC ADDRESS POINTED
*        TO BY R1
*
IOSPIN   EQU      %
         MTW,0    0,R1              CHECK BYTE 0
         BGEZ     0,R7              EXIT WHEN END ACTION OCCURS
         MTW,1    IOSPINT           BUMP TOTAL SPIN COUNT
         B        IOSPIN            AND LOOP ON END ACTION
         PAGE
*
*        MOVE SENTINEL'S TO RING BUFFER PAGE
*
MOVEI    EQU      %
         LW,R3    CURPOS            GET CURRENT POSITION
         LW,R4    R1                MOVE # BYTES TO R4
         AI,R4    3                 ROUND UP
         SLS,R4   -2                TO TOTAL WORDS
         AW,R4    CURPOS            ADD CURRENT POSITION
         CW,R4    BUFTOP            COMPARE TO TOP
         BL       %+2               THERES STILL ROOM
         LW,R3    LIMIT             NO-RESET TO LOWER PAGE
         SLS,R3   2                 CHANGE DESTINATION TO BA
         STW,R3   SENTWRT1          PUT BA INTO COM LIST
         STW,R1   SENTWRT2          PUT SIZE INTO COM LIST
         DO       SIGMA7=0
         LB,R5    0,R2
         STB,R5   0,R3
         AD,R2    DOUBLEONE
         BDR,R1   %-3
         ELSE
MOVEIX   AI,R1    -255              MAX COUNT=255 BYTES
         BLEZ     %+4               COUNT<256 FINISH IN ONE MOVE
         OR,R3    YFF               MOVE 255 BYTES
         MBS,R2   0                 MOVE INTO POSITION
         B        MOVEIX            CONTINUE MOVE
         AI,R1    255               COUNT
         STB,R1   R3
         MBS,R2   0                 MOVE INTO POSITION
         FIN
         AI,R3    3                 ROUND UP DESTINATION
         SLS,R3   -2                TO WORD ADDRS
         STW,R3   CURPOS            LEAVE AS CURRENT POSITION
         LI,R6    0                 SET NORMAL END ACTION
         LI,R7    SENTWRT           SET POINTER
         B        MTIO+2            LINK STILL IN R15
         PAGE
*
*        WRITE TAPE MARK SUBROUTINE
*
WRTMARK  EQU      %
         LI,R6    WTM               SET FCN CODE
         LI,R7    QBUF              SET POINTER
         B        MTIO+2            LINK WAS R15
         PAGE
*
*
*        COULD NOT GET ANY MORE THAN 4 PAGES
*
*
*
NOTENUFF EQU      %
         LI,R15   LESSTHAN
         CAL1,2   PRNT15
         LI,R1    BA(LESSTHAN)
         BAL,R15  TYPEIO
         LI,R1     FPEXIT
         B         IORUNDWN
         PAGE
*
*        END-UP SUBROUTINE
*
ENDUP    EQU      %
         LW,R0     DUMP
         BEZ       NOEOR
         MTW,1    ENDOFSET          SET END OF VOLUMN SET FLAG
         BAL,R1    GOEOR          GO TO END OF TAPE ROUTINE
NOEOR    LI,R1    BA(ENDMS)         SEND ALL DONE MSG
         BAL,R15  TYPEIO
         BAL,R15  DISPRUNTOTL
         MTW,0    STATS             CREATING STATISTICS
         BEZ      %+2               NOPE
         CAL1,1   CLSPO             YEP,CLOSE OUT FILE (SAVED)
         BAL,R1    IORUNDWN
         MTW,0    DATACARDS         WAS THERE A DATA CARD FILE
         BEZ      %+2               NOPE
         M:CLOSE  M:SI,(REL)        RELEASE FILE IF OPEN/USED..
         DO       FILL
         LW,R0    DUMP              NO :BREC
         BEZ      FPEXIT            IF NO TAPE
         LW,R1    BRECFLG           SKIP UPDATE AND
         BNEZ     FPEXIT            CLOSE IF FLAG SET
         CAL1,1   WRBREC            WRITE OUT RECORD
         M:CLOSE  M:EI,(SAVE)
         FIN
         DO       TAURUS=1
FPEXIT   EQU      %
         LW,3     EAPHYADR          RELEASE STOLEN PAGE
         BE       FPEXIT1           NONE
         CAL1,6   SYSFPT            GO MASTER MODE
         BAL,11   T:RSPP            RELEASE PAGE FOR ENDACTION
         BAL,R15  SLAVE             GO SLAVE
FPEXIT1  EQU      %
         CAL1,9   1                 EXIT
         ELSE
FPEXIT   CAL1,9   1                 RETURN TO BPM
         FIN
         PAGE
*
*        ACCOUNT DIRECTORY SECTOR COMPLETED
*
ADDONE   EQU      %
         LW,R8    ACFLINK            GET FORWARD LINK ADDRS
         BEZ      ENDUP              IF ZERO--ALL DONE ....
         BAL,R15  DTOGRAN            VERIFY ADDRESS
         B        READFAIL2          ERROR RETURN
         LW,R9    M24               MASK
         CS,R8    ACFLINKQ          WAS FLINK Q'D BEFORE NOW
         BE       ADDONE1           ALREADY QUEUED
         MTW,1    ADRAT             BUMP RATE ERROR TOTALS
         B        GETAD             AND READ IT NOW
ADDONE1  LI,R1    ACFLINKQ          GO
         BAL,R7   IOSPIN            WAIT FOR EVENT
         BAL,R7   CHKIO             CHECK TYC
         BNE      READFAIL2         FAILURE
         B        GETAD3            AND PROCESS NEXT SECTOR
         PAGE
*
*        ERROR IN CURRENT ACCOUNT DIRECTORY KEY
*
ADERROR  EQU      %               SET UP
         LI,R1    BA(ACMESS)      TO PRINT ERROR
         BAL,R15  TYPEIO          MESSAGE
         LI,R15   ACMESS          PRINT ON
         CAL1,2   PRNT15          M:LL ALSO
         BAL,R15  TACNT           TYPE ACCOUNT# ITS ON
         MTW,0    DEBUG           IN DEBUG MODE
         BEZ      ENDOFD            NOPE
         LI,R14   ENDOFD            YES..SET RETURN
         B        LISTAD            AND SNAP SECTOR
         PAGE
*
*        RUN DOWN ALL READ/WRITE AHEAD I/O
*
         DO       TAURUS=1
IORUNDWN EQU      %
         PSW,R2  *STKPNTR
         LI,R2    OPCNT-EASECT      SPIN ON DISC I/O
         MTW,0    *EAADDR,R2
         BGZ      %-1               UNTIL DONE
         LI,R2    DOPCNT-EASECT     SPIN ON TAPE I/O
         MTW,0    *EAADDR,R2
         BGZ      %-1               UNTIL DONE
         PLW,R2  *STKPNTR
         B        0,1
         ELSE
IORUNDWN MTW,0     OPCNT          SPIN ON DISC I/O
         BGZ       %-1            UNTIL DONE
         MTW,0     DOPCNT         SPIN ON TAPE I/O
         BGZ       %-1            UNTIL DONE
         B         0,1            AND RETURN
         FIN
         PAGE
*
*        DISPLAY FINAL TOTALS SUBROUTINE
*
DISPRUNTOTL EQU   %
         PSW,R15  *STKPNTR
         LB,R7    PRTMESS               RESET
         LI,R8    X'40'                     CURRENT
         STB,R8   PRTMESS,R7                    HEADER
         BDR,R7   %-1                               MSG STRING
         LI,R0    0
         MTW,0    DUMP              WERE WRITING TAPE
         BNEZ     %+2               YES..DISPLAY # OF VOLUMNS
         STW,R0   VOL#              NOPE..RESET FOR STATISTICS
         CAL1,1   PAGEFPT           NEW PAGE FOR TOTAL'S
         LI,R2    38                PRINT LINE DISP.
         LI,R1    BA(STATISTICS)    MSG STRING
         BAL,R15  BUFSET            MOVE TO PRINT LINE
         BAL,R15  PRINT             AND PRINT IT
         LI,R1    3
         BAL,R15  SPACE              SPACE 3 LINES
         LW,R3    TRUNC2            TOTAL
         AW,R3    TRUNC1            BUFFER TRUNCATIONS UP
         AW,R3    TRUNC3            ADD SHORT GRAN'S
         STW,R3   TRUNC             FOR DISPLAY
         LW,R3    RADGCNT           DATA READ COUNT
         AW,R3    RADXCNT           ADD INDEX READ COUNT
         STW,R3   RADTOTL           MOVE TO TOTAL ACCESS'S SLOT
         LI,R7    DISPLEN           SET DISPLAY TABLE LENGTH
DISPLOOP LW,R1    R1ST,R7           GET BA OF NEXT MSG
         LI,R2    1                 PRINT LINE DISPLACEMENT
         BAL,R15  BUFSET            MOVE TO PRINT LINE
         LW,R3    R3ST,R7           GET ASSOCIATED VALUE
         BLZ      %+3               SAYS TO DISPLAY MSG ONLY
         LI,R1    BA(PBUF+9)+2      SET PRINT LINE DESTINATION
         BAL,R15  HEXTODEC          AND INSERT DECIMAL
         BAL,R15  PRINT             NOW PRINT ENTIRE LINE
DISPLOOP1 BDR,R7  DISPLOOP          GET NEXT ENTRY
         PLW,R7   *STKPNTR          RESTORE RETURN LINK
         B        0,R7              AND EXIT
         PAGE
*
*        TABLES CONTROLLING DISPLAY OF RUN STATISTICS
*
R1ST     EQU      %
         DATA     DISPLEN
         DATA     BA(DATARA)
         DATA     BA(MIXRA)
         DATA     BA(FITRA)
         DATA     BA(FDRA)
         DATA     BA(ADRA)
         DATA     BA(RAMSG)
         DATA     BA(ISPINMSG)
         DATA     BA(DSPINMSG)
         DATA     BA(TSPINMSG)
         DATA     BA(SPINMSG)
         DATA     BA(FILSMSG)
         DATA     BA(TOTAMS)
         DATA     BA(DINFO11)
         DATA     BA(TOTAPMS)
         DATA     BA(DINFO3)
         DATA     BA(DINFO2)
         DATA     BA(DINFO1)
         DATA     BA(DINFO5)
         DATA     BA(DINFO6)
         DATA     BA(TOTFMS)
         DATA     BA(IOSPINMSG)
         DATA     BA(TRUNC3MSG)
         DATA     BA(TRUNC2MSG)
         DATA     BA(TRUNC1MSG)
         DATA     BA(TRUNCMSG)
DISPLEN  EQU      WA(%)-WA(R1ST)-1
R3ST     EQU      %
         DATA     DISPLEN
DATARAT  DATA     0
MIXRAT   DATA     0
FITRAT   DATA     -1                INITIAL READ AHEAD
FDRAT    DATA     -1                ERROR DOESN'T COUNT
ADRAT    DATA     0
         DATA     -1
IBUFSPIN DATA     0
DBUFSPIN DATA     0
TBUFSPIN DATA     0
         DATA     -1
FILSKPCNT DATA    0
RUNTOTL3 DATA     0
TPACC    DATA     0
VOL#     DATA     1
RADXCNT  DATA     0
RADGCNT  DATA     0
RADTOTL  DATA     0
RUNTOTL2 DATA     0
RUNTOTL4 DATA     0
RUNTOTL1 DATA     0
IOSPINT DATA      0
TRUNC3   DATA     0
TRUNC2   DATA     0
TRUNC1   DATA     0
TRUNC    DATA     0
*-------------------*
        PAGE
*
*
*        VERIFY DCTX/ADDRESS
*
*        CALLING SEQUENCE:
*
*        R15:     LINK
*        R8:      PUBLIC FILE DISC ADDRESS
*        RETURNS:
*                 LINK+1 IF BAD DISC ADDRESS
*                 LINK+2 IF GOOD DISC ADDRESS
*
*                 1. DCTX MUST BE IN RANGE.
*                 2. AN HGP EXISTS FOR THAT DCTX.
*                 3. SECTOR # IS WITHIN RANGE.
*
*
DTOGRAN  EQU      %
         DO       UTS>0
         PSW,R15  *STKPNTR          SAVE LINK
         BAL,R15  MASTER            GO MASTER MODE
         PLW,R15  *STKPNTR          RESTORE IT
         FIN
FND      LCI      4                 PLACE AWAY REGISTERS
         PSM,R1   *STKPNTR          AWAY WORK REGISTERS
         DO1      UTS>=3            CO1 ONLY
         AND,R8   M24               SCRUB DISC ADDRS OF BIT0
         LH,R1    R8                GETTING DCTX
         BLEZ     BADADDRS          ***DCTX IN ERROR****
         DO       UTS=0
         CW,R1    DCTSIZ            COMPARE TO LENGTH
         ELSE
         DO1      CPV>0
         AND,R1   DCT%MASK
         CI,R1    DCTSIZ
         FIN
         BG       BADADDRS          NO GOOD-TAKE ERR EXIT
FND0     EQU      %                 FIND HGP
         DO       UTS=0
         LW,R2    HGP
         ELSE
         LI,R2    HGP
         FIN
         LI,R3    5                 BYTE INDEX TO DCTX FIELD
         CB,R1    *R2,R3            IS THIS CORRECT HGP
         BE       FND1               YES--CHECK SECTOR ADDRESS
         LW,R2    0,R2               NO--GET NEXT HGP ADDRS
         BNEZ     %-3                LAST HGP HAS 0 FLINK
         B        BADADDRS           RAN OUT OF HGP'S...
         DO       CPV=0             BPM OR UTS THRU D00
FND1     INT,R1   R8                GET SECTOR#
         LW,R3    2,R2               GET NSPT THIS HGP
         LI,R4    NTYPS             #POSSIBLE
         CW,R3    TYPS,R4           FIND IT IN NSPT TABLE
         BE       FND2              GOTCHA
         BDR,R4   %-2               KEEP LOOKING
         B        BADADDRS          NO GOOD
FND2     CW,R1    SIZES,R4          MATCH TO DEVICE LENGTH
         ELSE
FND1     EQU      %                 GET SUBTYPE IN R4
*                                   GET REL SECT# IN R1
         LB,R4    DCT22,R1          SUBTYPE
         BEZ      BADADDRS          NOT A DISC
         LW,R1    R8
         AND,R1   SECTOR%MASK
         MI,R1    5**7
         SCS,R1   2
         STH,R8   R1
         SCS,R1   16                REL SECT# NOW IN R1
FND2     CW,R1    DISCLIMS,R4       MATCH TO DEVICE LENGTH
         FIN
         BGE      FND3              POSSIBLE ERROR
         AI,R15   1                 BUMP RETURN WHEN GOOD ADDRESS
BADADDRS LCI      4                 INVALID ADDRESS EXIT
         PLM,R1   *STKPNTR
         DO       UTS=0
         B        *R15
         ELSE
         B        SLAVE             GO BACK TO SLAVE MODE
         FIN
FND3     LB,R4    ORG               GET FILE ORG
         CI,R4    3                 IS RANDOM FILE
         BNE      BADADDRS          DEFINITELY INVALID SECTOR#
         LW,R1    =X'7F0000'        RANDOM FILE OVERLAPS DEVICE
         LS,R0    1,R2              GET DCTX FROM HGP
         AI,R0    X'10000'          STEP TO NEXT DEVICE
         STW,R0   FDA               STORE AWAY
         STW,R0   R8                SET UP AGAIN
         LCI      4                 ADJUST
         PLM,R1   *STKPNTR          STACK
         LI,R15   RANFILE0          SET ERROR RETURN POINT FOR RANDOM
         DO       UTS=0
         B        DTOGRAN
         ELSE
         B        FND
         FIN
         PAGE
*
*
*        DEVICE RECOGNITION TABLES
*
*
         DO       CPV=0             BPM OR UTS THRU D00
TYPS     DATA     0                 OFFSET
         DATA     82                7212  *
         DATA     16                7204    *  RADS
         DATA     12                7232  *
         DATA     11                7260 DISC PACK
         DATA     6                 7242       DISC PACK
NTYPS    EQU      WA(%)-WA(TYPS)-1
*
*        SECTOR LENGTH BY DEVICE (PARALLEL TO TYPS)
*
SIZES    DATA     0                 OFFSET
         DATA     64*82             7212  *
         DATA     512*16            7204    *  RADS
         DATA     512*12            7232  *
         DATA     200*20*11         7260 DISC PACK
         DATA     200*20*6          7242       DISC PACK
         FIN
         PAGE
*
*        FILE DIRECTORY KEY IS IN ERROR
*
FDERR    LI,R1    BA(FDMESS)
         BAL,R15  TYPEIO
         LI,R15   FDMESS            PRINT
         CAL1,2   PRNT15            ERROR MSG
         MTW,0    DEBUG             IN DEBUG MODE
         BEZ      FDERR1            NO-NO SNAPS&DUMPS
         BAL,R14  LISTFD            DUMP FD SECTOR
FDERR1   BAL,R15  TACNT             TYPE CURRENT ACN#
         BAL,R15  TFILNME
         MTW,1    FILSKPCNT         BUMP SKIP COUNT
         B        GOGET             PRINT FILE NAME,ETC...
         PAGE
*
*        FIT CONTENTS ERROR,NAME CORRESPONDENCE ERROR.
*
FITSNAP  EQU      %
         LI,R15   FITMESS           PRINT ERROR MSG
         CAL1,2   PRNT15            HERE
FITERR   EQU      %
         MTW,0    DEBUG             IN DEBUG MODE
         BEZ      FITERR1           NO-NO SNAPS&DUMPS
         LW,R6    CURFILE           CURRENT FILE INDEX
         LW,R7    NEXFILE           NEXT INDEX
         M:SNAP   'FITERR'          TO DISPLAY REGISTERS
         BAL,R14  LISTFIT           DUMP OUT FIT
         BAL,R14  LISTFD            DUMP OUT FD SECTOR
FITERR1  LI,R1    BA(FITMESS)       SET TO SEND ERROR MSG
         BAL,R15  TYPEIO
         B        FDERR1            TYPE FILE NAME,ETC...
         PAGE
*
*        SAVE CURRENT FILE DIRECTORY
*        KEY IN LOCATION 'BOFBUF+2'
*
PUSHKEY  EQU      %
         LCI      5
         PSM,R2   *STKPNTR          SAVE ARGS
         LW,R2    CURFILE           CURRENT INDEX
         AI,R2    BA(FDBUF)         CORE SBA
         LI,R3    FDKEYL            LENGTH OF KEY
         LI,R5    BA(BOFBUF+2)      PLACE TO PUT IT
         BAL,R15  MOVEBYT           MOVE INTO PLACE
         LCI      5                 RESTORE
         PLM,R2   *STKPNTR          ARGS
         B        0,R6              AND EXIT
         PAGE
*
*        LIST CURRENT FILE DIRECTORY SUBROUTINE
*
LISTFD   EQU       %
         LI,R15   FDRMSG
         CAL1,2   PRNT15
         LI,R3    FDBUF
         B        LISTCALL          GET INTO LOOP
         PAGE
*
*        LIST CURRENT FIT SUBROUTINE
*
LISTFIT  EQU       %
         LI,R15   FITMSG1
         CAL1,2   PRNT15
         LI,R3    FITBUF
         B        LISTCALL          GET INTO LOOP
         PAGE
*
*        LIST CURRENT OUTPUT BUFFER
*
LISTOUTBUF EQU    %
         LI,R15   OUTPUTBLK
         CAL1,2   PRNT15
         LW,R3    LSTBUF            LAST OUTPUT BUFFER WA
         LW,R1    PBS
         LW,R15   R14               PUT LINK IN RETURN
         B        PLIST             AND SNAP AREA
         PAGE
*
*        LIST CURRENT INDEX SECTOR
*
LISTMIX  EQU       %
         LI,R15   MIXMSG1
         CAL1,2   PRNT15
         LW,R3    MIXBUF            BUFFER POINTER WA
LISTCALL LI,R1    DIRSIZ*4          SNAP THESE MANY SENORES...
         BAL,R15   PLIST
         B         *R14
         PAGE
*
*        LIST CURRENT ACCOUNT DIRECTORY SECTOR
*
LISTAD   EQU       %
         LI,R15   ADRMSG1
         CAL1,2   PRNT15
         LI,R3     ACBUF
         B        LISTCALL          GET INTO LOOP
         PAGE
*
*        INDEX CONTENT,LINKAGE ERROR SUBROUTINE
*
MIXSNAP  EQU      %
         MTW,0    DEBUG             IN DEBUG MODE
         BEZ      MIXERR1           NO-NO SNAPS&DUMPS
         M:SNAP   'STACK',(DSTACK,DSTACK+STACKSIZE+3)
         M:SNAP   'TABLES',(TBUF,ORG)
MIXERR   BAL,R14  LISTMIX           DUMP CURRENT SECTOR
MIXERR1  MTW,0    DUMP              WRITING TAPE
         BEZ      FDERR1
         LI,R14   FDERR1            SET RETURN
         B        EOFQ              CLOSE OUT FILE ON TAPE
         PAGE
*
*
*        FILE ERROR
*                 DATA GRANULE ADDRESS ERROR
*
DATAERR  EQU      %
         LI,R15   MIXMESS           PRINT
         CAL1,2   PRNT15            ERROR MSG ON M:LL
         B        MIXSNAP           AND SNAP TABLES
         DO       UTS>0
         DO       UTS<4
         USECT    EASECT
         PAGE
*
*        VIRTUAL TO REAL ADDRESS CONVERSION
*
VTOPU    EQU      %
         SECT
         LW,R2    VADRS
         LW,R0    R2                HOLD VIRTUAL IN R0
         SLS,R2   -9
         SECT
         LW,R3    CUN
         LB,R3    UB:JIT,R3
         SLS,R3   9
         AI,R3    JCMAP
         LB,R2    *R3,R2
         SLS,R2   9
         LI,R3    X'1FE00'
         STS,R2   R0
         B        0,R6
VADRS    DATA     0
         USECT    START
         FIN
         FIN
         PAGE
*
*        FILE DIRECTORY SECTOR COMPLETED
*
FDDONE   EQU      %
         LW,R8    FDFLINK            GET FORWARD LINK
         BEZ      ENDOFD             IF ZERO--END REACHED
         BAL,R15  DTOGRAN            VERIFY ADDRS
         B        READFAIL3          ERROR RETURN
         LW,R9    M24               MASK
         CS,R8    FDFLINKQ          WAS FLINK ALREADY READ
         BE       FDDONE1           ALREADY QUEUED
         MTW,1    FDRAT             BUMP RATE ERROR TOTAL
         B        GETFDA            AND READ IT NOW
FDDONE1  LI,R1    FDFLINKQ          GO
         BAL,R7   IOSPIN            WAIT FOR EVENT
         BAL,R7   CHKIO             CHECK TYC
         BNE      READFAIL3         FAILURE***
         B        GETFD1            AND CONTINUE
         PAGE
*
*
*        FINISHED A FILE DIRECTORY
*
*
* GET HERE WHEN ACCT CHANGES ON SAVE BY DATE CARD
ENDOFDT  LW,R3    TOTLFILS          DID WE SAVE ANY FILES
         BEZ      NACN              NO..DON'T PRINT ANYTHING
* GET HERE IN ALL OTHER CASES
ENDOFD   EQU      %
         MTW,1    RUNTOTL3           RUN TOTAL # OF ACCOUNTS
         LD,R0    ACN#CURNT         GET CURRENT ACCOUNT#
         STD,R0   POBUF             INTO STAT BUFFER
         LW,R3    TOTLFILS           TOTAL FILE COUNT
         STW,R3   POBUF+2           STORE TOTAL FILES
         LW,R15   SAVBYDATE         NO-ARE WE SAVING BY DATE
         OR,R15   SAVBYHOUR         OR BY HOUR
         BEZ      FILECOUNT         NOPE
         LI,R1    2
         BAL,R15  SPACE             SPACE 5 LINES
         LW,R2    LASTACT           GET LAST ACTIVITY DATE
         AND,R2   =X'0F0FFFFF'      MASK OFF
         STH,R2   NOACTIVMS+09      PLACE DAY  BACK INTO MSG
         SLS,R2   -16               POSITION MONTH RIGHT
         CI,R2    X'09'             IS SEPTEMBER OR LESS
         BLE      ENDOFD1           YES-NO NEED TO CHANGE
         AND,R2   MFF               DROP OFF 0-2 BYTES
         AI,R2    10                CONVERT TO HEX VALUE
ENDOFD1  LW,R2    MONTHTAB,R2       GET EBCDIC MONTH
         STW,R2   NOACTIVMS+8       STORE MONTH
         LI,R1    1
         LH,R2    LASTACT+1         GET HOUR CODE
         STH,R2   NOACTIVMS+10,R1   AND PLACE INTO MSG
         LI,R15   NOACTIVMS         AND SET
         CAL1,2   PRNT15            TO PRINT 'LAST ACTIVITY' MSG
         LW,R0    RESTFLD           RESET
         STW,R0   NOACTIVMS+13      DATE/MONTH FIELDS IN MSG
         LI,R1    2                 SPACE
         BAL,R15  SPACE             A FEW LINES
FILECOUNT LI,R1   BA(DASHMSG)
         DO       UTS=0             BPM CODE ONLY
         LI,R2    41
         ELSE
         LI,R2    16                PRINT LINE INDEX
         FIN
         BAL,R15  BUFSET
         LI,R1    BA(DASHMSG)       GET IT AGAIN
         LB,R3    0,R1
         AI,R1    1
         DO       UTS=0
         LI,R2    53
         ELSE
         LI,R2    26                PRINT LINE INDEX
         FIN
         BAL,R15  BUFSET1
         BAL,R15  LPRINT            AND PRINT LINE
FILECOUNT1 LW,R3  TOTLFILS          #FILES IN ACCOUNT WE SAVED...
         DO       UTS=0
         LI,R1    BA(PBUF)+27
         ELSE
         LI,R1    BA(PBUF+1)
         FIN
         BAL,R15  HEXTODEC
         LI,R1    3
         BAL,R15  SPACE
         LW,R3    ACNSIZE
         STW,R3   POBUF+4           STORE TOTAL BYTES
         DO       UTS=0
         LI,R1    BA(PBUF+15)
         ELSE
         LI,R1    BA(PBUF+7)+5
         FIN
         BAL,R15  HEXTODEC
         LW,R3    ACNGRAN
         STW,R3   POBUF+3           STORE TOTAL GRANULES
         AWM,R3   RUNTOTL2           RUN TOTAL GRANULES
         DO       UTS=0
         LI,R1    BA(PBUF+12)
         ELSE
         LI,R1    BA(PBUF+4)+7
         FIN
         BAL,R15  HEXTODEC
         DO       CPV>0
         LW,R15   ACNGRAN           TOTAL GRANS IN ACCT
         SW,R15   PACKGRAN         -TOTAL PACK GRANS IN ACCT
         SW,R15   RADGRAN          -TOTAL RAD GRANS IN ACCT
         BEZ      GRANCOUNT         SHOULD BE ZERO
         LW,R3    RADGRAN           OTHERWISE, ADJUST.
         CW,R3    PACKGRAN          FIND OUT WHICH IS LARGER
         BG       %+3
         AWM,R15  PACKGRAN          PACK IS LARGER, ADJUST IT.
         B        GRANCOUNT+1
         AWM,R15  RADGRAN           RAD  IS LARGER, ADJUST IT.
GRANCOUNT EQU     %
         LW,R3    RADGRAN           TOTAL RAD GRANS IN ACCT
         STW,R3   POBUF+5
         LW,R3    PACKGRAN          TOTAL PACK GRANS IN ACCT
         STW,R3   POBUF+6
         FIN
         BAL,R15  LPRINT            PRINT AND CLEAR LINE
FDDONEX  LI,R1    0                 SET TO
         STW,R1   TOTLFILS           ZERO OUT FILE COUNT
         LW,R0    Y8                RESET DATE OF
         LI,R1    X'8000'
         STD,R0   LASTACT                 LAST ACTIVITY
         MTW,0    STATS             CREATE STAT FILE
         BEZ      NACN              NOPE..GO TO NEXT ACCOUNT
         CAL1,1   WRTPO             YES..WRITE RECORD
         B        NACN
         PAGE
*
*        FILE IS COMPLETE
*
CKTIO,CKTIO1 EQU  %
         MTW,0    DUMP              TAPE OUTPUT MODE
         BEZ      FILEDONE          NO,OUTPUT PRINT LINE
         BAL,R14  EOFQ              SEND :EOF RECORD TO TAPE
FILEDONE MTW,1    TOTLFILS          BUMP TOTAL FILE COUNT
         MTW,1    RUNTOTL1          AND RUN TOTAL FILES
FILEDONE0 B       GOGET             AND OUTPUT PRINT LINE
         PAGE
*
*        FIND FIT CODE SUBROUTINE
*
CODESCAN EQU      %
         LCI      5
         PSM,R1   *STKPNTR
         LI,R0    0
         LI,R5    X'FF'
         LW,R1    INITX             PICK UP INITIAL INDEX
         LI,R4    0
FINDCODE CB,R2    *R1               CODES MATCH UP
         BE       FOUND             YEP-EXIT
         LH,R3    *R1               NO-GET
         CI,R3    X'FF'             LEI BYTE
         BANZ     NFOUND            IS SET-EXIT
         LS,R4    *R1               NO-GET JUMP INDEX
         AW,R1    R4                ADD TO BASE ADDRS
         AI,R1    1                 PLUS ONE FOR ENTRY WORD
         B        FINDCODE          AND LOOP
FOUND    LW,R0    R1                MOVE INDEX TO R1
         AI,R15   1                 BUMP RETURN
NFOUND   LCI      5                 RESTORE WORK AREA
         PLM,R1   *STKPNTR
         B        *R15
         PAGE
*
*        PRINT FILE NAME,FILE INFO SUBROUTINE
*
GOGET    EQU     %
         BAL,R11  FITCHKS31         QUEUE NEXT FD
         BAL,R11  BLD:BOF70         DITTO FOR NEXT FIT
         MTW,0    TABLES            TABLES MODE SET
         BEZ      GOGET1            NO,NO DISPLAY OF TABLES
         M:SNAP   'TBUFS',(TBUF,TBUF+#TBUF)
         M:SNAP   'DBUFS',(DBUF,RBHIST+#DBUF)
         M:SNAP   'IBUFS',(IBUF,INDEXDA+#IBUF)
         DO       TAURUS=1
         M:SNAP   'ISTATS',(*MIXSTAT,*MIXSTATN)
         ELSE
         M:SNAP   'ISTATS',(MIX:STAT,MIX:STAT+#IBUF)
         FIN
         M:SNAP   'TABLES',(CURRB,ORG)
         M:SNAP   'STACK',(DSTACK,DSTACK+STACKSIZE)
GOGET1   LW,R4    FNEB              FILE NAME SBA
         LW,R5    FNEC              PRINT LINE DEST BA
         LB,R6    0,R4              BYTE CNT OF FILE NAME
         STB,R6   R5                SET FOR MBS
         AI,R4    1                 POINT TO TEXT STRING
         DO       SIGMA7=0
         LB,R6    R5                COUNT
         LB,R7    0,R4
         STB,R7   0,R5
         AD,R4    DOUBLEONE
         BDR,R6   %-3
         ELSE
         MBS,R4   0
         FIN
         MTW,0    SYNFLAG           CURRENT SYNON
         BEZ      NOELEV            NOPE-BYPASS CHECK
         LW,R1    SYNMSG            YEP
         DO       UTS=0
         STW,R1   PBUF+19
         ELSE
         STW,R1   PBUF+09
         FIN
         B        NODATE1           ALL DONE WITH THIS LINE
NOELEV   EQU      %
         LW,R3    RANDOM            FILE GRANULE COUNT
         AWM,R3   ACNGRAN           UPDATES ACCOUNT TOTAL
         DO       UTS=0
         LI,R1    BA(PBUF+12)
         ELSE
         LI,R1    BA(PBUF+4)+7
         FIN
         BAL,R15  HEXTODEC
         LW,R3    FILESIZE
         AWM,R3   ACNSIZE
         DO       UTS=0
         LI,R1    BA(PBUF+15)
         ELSE
         LI,R1    BA(PBUF+7)+5
         FIN
         BAL,R15  HEXTODEC
NOSAVET  LB,R1    ORG               GET FILE'S ORGANIZATION
         LW,R1   ORGTX,R1           GET ORG TEXT TYPE
         DO       UTS=0
         STW,R1   PBUF+17           PRINT LINE SLOT
         LI,R0    TLABUF+4          CREATION DATE STILL IN TLABUF
         LI,R2   4
         LH,R1   *R0,R2             GET HOUR
         STH,R1   PBUF+24,R2        MOVE 'HOUR' TO PRINT LINE
         AI,R2    1                 JUMP INDEX
         LH,R4   *R0,R2             GET YEAR CREATED
         SLD,R4  -16
         LI,R4   '/'                SLASH
         SLD,R4  -8
         LI,R1   3
         LH,R4   *R0,R1             GET DAY CREATED
         SLD,R4  -8
         STW,R5   PBUF+24           MOVE '/DAY/YEAR' TO LINE
         SLD,R4  -8
         LI,R4   '/'                SLASH
         SLD,R4  -8
         LI,R1   2
         LH,R4   *R0,R1             GET MONTH CREATED
         SLD,R4  -16
         STW,R5   PBUF+23           MOVE '  MONTH/' TO LINE
         ELSE
         STW,R1   PBUF+09           STORE ORG IN PRINT LINE
         LW,R6    DATE:TAB          GET LENGTH OF DATE TABLES
DATE:LP  LW,R7    DATE:PS,R6        GET PRINT LINE POSITION
         LW,R1    DATE:TAB,R6       GET ENTRY
         MTW,0    *R1               WAS ONE SPECIFIED
         BNEZ     DATE:LP2          YES,SHOVE IT IN
DATE:LP1 LW,R0    NO:DTMSG          NO,PLACE
         STW,R0   0,R7              'NONE' IN PRINT LINE
         B        DATE:LP3          AND LOOP TO NEXT FIELD
DATE:LP2 BAL,R15  IN:DATE           INSERT DATE INTO PRINT LINE
DATE:LP3 BDR,R6   DATE:LP           DO NEXT FIELD
         MTW,0    READ:AC           ANY READ ACCESS SPECIFED
         BEZ      DATE:LP4          NOPE
         LCI      2                 MOVE
         LM,R0    READ:AC            IT
         STM,R0   PBUF+32               PRINT LINE
DATE:LP4 EQU      %
         FIN
NODATE   LW,R0    FILESIZE          ANY BYTES MOVED
         AWM,R0   RUNTOTL4          INCREMENT TOTAL RUN #OF BYTES
NODATE1  BAL,R15  LPRINT            PRINT/CLEAR PRINT LINE
NODATE2  LI,R1    0
         STW,R1   BLKDBYTES         RESET #BYTES MOVED TO TAPE
         STW,R1   FILESIZE          ZAP OLD FILESIZE VALUE
         STW,R1   RANDOM            RESET #GRANULES IN FILE
         STW,R1   SYNFLAG           RESET SYNON FILE FLAG
         B        GETFILE+1
         DO       UTS>0
         PAGE
*
*        INSERT DATE INTO PRINT LINE,CALLLING SEQUENCE;
*
*        R1:      POINTS TO DATE BUFFER (TWO WORDS)
*        R7:      CONTAINS PRINT LINE WA
*
IN:DATE  EQU      %
         LW,R4    1,R1              GET 'HHYY' FIELD
         AND,R4   M16               DROP OFF 'HH'
         CI,R4    X'F0F0'           IS NUMERIC
         BGE      IN:DATE1          YEP
         LCI      2                 NO,JUST
         LM,R4    0,R1              PLACE WHATEVER IT SAYS
         STM,R4   0,R7              INTO PRINT LINE
         B        *R15              AND EXIT
IN:DATE1 LI,R0    0
         LI,R4    -3                SET UP
         STW,R0   BLD:DATE+3,R4     TO CLEAR DATE BLOCK BUF
         BIR,R4   %-1               COMPLETELY
         LW,R4    0,R1              GET MMDD FIELD
         AND,R4   =X'0F0FFFFF'      MASK OFF ODD BITS
         STH,R4   BLD:DATE+1        INSERT DD INTO BUFFER
         SLS,R4   -16               POSITION MONTH
         CI,R4    X'09'             IS SEPTEMBER
         BLE      IN:DATE2          YEP
         AND,R4   MFF               DROP BYTE 0-2
         AI,R4    10                CONVERT TO HEX VALUE
IN:DATE2 LW,R3    MONTHTAB,R4       GET EBCDIC MONTH
         STW,R3   BLD:DATE          STORE INTO BUFFER
         LW,R3    BLD:DATE+1        GET DAY FIELD BACK
         MTB,0    HOUR:DI,R6        IS HOUR TO GO INTO MSG
         BEZ      IN:DATE4          YEP,BUILD IT IN
IN:DATE3 LCI      3                 NO,MSG IS COMPLETE
         LM,R3    BLD:DATE          MOVE ENTIRE
         STM,R3   0,R7              MSG TO PRINT LINE
         B        *R15              AND EXIT
IN:DATE4 LW,R4    1,R1              GET HHYY FIELD
         SLS,R4   -16               POSITION HH
         SLD,R4   -8                MOVE BYTE ONE OF HH
         AND,R5   YFF               CLEAR OUT R5
         OR,R4    LPR               INSERT LEFT PAREN
         OR,R3    R4                INTO MSG WORD 1
         STW,R3   BLD:DATE+1        BACK TO BLOCK
         OR,R5    RPR               INSERT RIGHT PAREN
         STW,R5   BLD:DATE+2        INTO BLOCK
         B        IN:DATE3          AND MOVE TO BUFFER
         FIN
         PAGE
*
*
*        BUILD RECORD AND KEY TO OUTPUT TO SORTED FILE
*
*
SKEYUP   EQU      %
         LI,R2    -10
         LI,R3    0                 CLEAR
         STW,R3   RKEY+10,R2          KEY
         BIR,R2   %-1                   BUFFER
         LI,R2    BA(INBUF)         MOVE
         LI,R5    BA(RKEY)+1          ACCOUNT
         LI,R3    8                     NUMBER
         BAL,R15  MOVEBYT
         LI,R1    SKEYUP3           STRAIGHT THRU ADDRS
SKEYUP0  LI,R6    30                MAX FILE NAME
         LI,R3    0                 HAVE TO COUNT NAME LENGTH
         LI,R2    BA(INBUF+3)+1     R2 HAS LOC OF FILE NAME
SKEYUP1  LB,R4    0,R2              GET A BYTE OF NAME
         CI,R4    ' '               IS TERMINATOR OF NAME
         BE       SKEYUP2           YUP
         DO       UTS>0
         CI,R4    X'0D'             ALSO A TERMINATOR
         BE       SKEYUP2
         FIN
         AD,R2    DOUBLEONE         NO..BUMP COUNT AND SBA
         BDR,R6   SKEYUP1           FINISH MAX LOOP
SKEYUP2  STW,R3   R14               HANG ONTO COUNT
         LI,R2    BA(INBUF+3)       MAKE DATA CARD NAME
         CI,R3    0                 WAS A NAME THERE...
         BEZ      %+2               NOPE,DONT INSERT ANY COUNT
         STB,R3   0,R2              TEXTC FIELD BEFORE WRITING
         B        0,R1              EXIT/FALL THRU
SKEYUP3  AI,R2    1                 BUMP TO TEXT
         BAL,R15  MOVEBYT
         AI,R14   8                 CALCULATE TOTAL BYTES IN KEY
         CI,R14   31                TEST FOR MAX KEY
         BLE      SKEYUP4
         LI,R14   31                SET TO MAX
SKEYUP4  EQU      %
         STB,R14  RKEY              AND PLACE INTO KEY BUFFER
         M:WRITE  M:SO,(BUF,INBUF),(SIZE,50),(KEY,RKEY),;
                  (ONEWKEY),(WAIT)
         B        0,R7              WRITE RECORD AND EXIT THIS PASS
RKEY     EQU      START             USE PROCEDURE
         PAGE
*
*        MOVE  FROM FIT TO BOF SUBROUTINE
*
MOVENTRY EQU      %
         LW,R1    =X'FF00FFFF'      MASK OFF LEI IF PRESENT
         AND,R1   *R0               PICK UP FROM FIT BUFFER
         STW,R1   0,R4              STORE CODE WORD IN BOF RECORD
         AND,R1   MFF               LEAVE COUNT IN R1
         AI,R1    1                 ADJUST COUNTS
         AI,R4    1
         AI,R0    1
         LW,R3    *R0               GET ENTRY FROM FIT
         STW,R3   0,R4              PUT ENTRY IN BOFBUF
         BDR,R1   %-4
         B        *R15              AND EXIT
         PAGE
*
*        HEX TO DECIMAL SUBROUTINE
*
HEXTODEC EQU      %
         LI,R2    3                 COMMA COUNT
         STW,R2   COMCNT            RESET
DIVIDE   LI,R2    0
         DW,R2    TEN
         AI,R2    X'F0'
         STB,R2   0,R1
         AI,R1    -1
         CI,R3    ZERO
         BEZ      *R15              DONE IF ZERO
         MTW,-1   COMCNT            NOT DONE-IS COMMA COUNT OUT
         BGZ      DIVIDE            NOPE-KEEP GOING
         LI,R2    ','               YES
         STB,R2   0,R1              MOVE COMMA TO PRINT LINE
         AI,R1    -1                DROP PRINT LINE INDEX
         B        HEXTODEC          AND LOOP
         PAGE
*
*        TYPE ACCOUNT/FILE NAME SUBROUTINES
*
TACNT    EQU      %
         LI,R1    BA(CR)
       B       TYPEIO        LINK STILL IN R15
TFILNME EQU       %
       PSW,R15 *STKPNTR      SAVE RETURN LINK
         MTW,0    SYNFLAG           CURRENT FILE SYNON
         BNEZ     TFILNME1          YES - NOT HERE FOR LINK FAILURE
         MTW,2    NONL
         LI,R1    BA(SKIPFILMS)
         BAL,R15  TYPEIO
TFILNME1 EQU      %
         MTW,1    NONL
         LW,R1    FNEB              BA OF CURRENT FILE NAME
       PLW,R15 *STKPNTR      RESTORE LINK
       B       TYPEIO        GO TYPE MSG
         PAGE
         PAGE
*
*        INTERPRET CARD IN 'INBUF' FOR POSSIBLE
*        FSAVE CONTROL COMMAND
*
INTER    EQU      %
         LW,R7    R15               MOVE LINK TO R7
         LI,R0    0                 PREPARE TO TURN OFF COM
         LI,R1    -#COMMANDS        LENGTH OF TABLES
         LW,R2    INBUF             GET WORD1 IMAGE
         CW,R2    COMS+#COMMANDS,R1 FIND MATCH
         BE       INTER1            GOTCHA
         BIR,R1   %-2               FINISH
         LI,R2    '+'
         CB,R2    INBUF             IS THIS A CONTROL CARD
         BE       INTER4            YES..MUST BE ERROR
         LCI      0                 NOT A COMMAND
         B        1,R7              TAKE EXIT PLUS ONE
INTER1   LW,R3    INBUF+2           GET FIELD2 FROM COMMAND
         CW,R3    OFFCOM            SUPPOSED TO TURN OFF COMMAND
         BNE      INTER2            NO,JUMP
         STW,R0   SWITCH+#COMMANDS,R1 YES,TURN IT OFF
         B        INTER3            AND EXIT
INTER2   STW,R2   SWITCH+#COMMANDS,R1 SET COMMAND SWITCH
         CW,R2    COMSKI            IS THIS +SKIP
         BNE      %+3               NO
         STW,R0   SELECT            YES...TURN OFF +SELECT
         B        %+4
         CW,R2    COMSEL            IS THIS +SELECT
         BNE      %+2               NO...ALL COOL
         STW,R0   SKIP              YES...TURN OFF +SKIP
         CW,R2    COMDAY            IS IT +DAY (ANOTHER SPECIAL CASE)
         BE       %+3               YES, DON'T SWEAT IF NOTHING THERE
         CW,R3    BLANK             ANYTHING THERE
         BE       INTER3            NO,JUMP
         LW,R3    SWITCH1+#COMMANDS,R1 SUPPOSED TO HAVE ONE
         BEZ      INTER3            NO,NO FIELD2
         LC       R3                GET FIELD LENGTH
         LM,R4    INBUF+2           GET FIELD 2
         STM,R4   0,R3              MOVE TO BUFFER
         CW,R2    COMDAY            SPECIAL CASE FOR +DAY
         BNE      INTER3            NOT +DAY
         CW,R4    BLANK             ANY DAY SPECIFIED
         BE       INTER22           NO, USE TODAY'S DATE
         LI,R1    0                 INDEX
INTER21  LB,R6    R4,R1             GET A CHAR.
         CI,R6    '0'               CHECK TO
         BL       INTER5            SEE IF
         CI,R6    '9'               A VALID
         BG       INTER5            NUMBER
         CI,R1    5                 DONE YET
         BGE      INTER3            YUP
         AI,R1    1                 INDEX
         B        INTER21
INTER22  EQU      %                 DATE LEFT OUT..USE TODAY
         LCI      2
         LM,R4    BKUPVLP+1
         SLS,R5   16                LEFT JUSTIFY YEAR
         STD,R4   SAVEDATE
INTER3   CW,R2    ENDCOM            WAS THIS COMMAND END
         BE       1,R7              YES,NO MORE INPUT
         LCI      8                 ELSE SET COMMAND CODES
         B        0,R7              AND EXIT
INTER4   EQU      %                 UNRECOGNIZED CONTROL CARD
         LI,R1    BA(XMSSG)         PRINT ERROR
         BAL,R15  TYPEIO            MESSAGE
         LI,R15   XMSSG             PRINT ON
         CAL1,2   PRNT15            M:LL ALSO
         B        FPEXIT            AND GO BYEBYE
INTER5   EQU      %                 INVALID DATE ON +DAY
         LI,R1    BA(XMSSG1)
         BAL,R15  TYPEIO
         LI,R15   XMSSG1
         CAL1,2   PRNT15
         B        FPEXIT
         PAGE
*
*        CHECK IF CURRENT ACCOUNT # MATCHES
*        CURRENT DATA CARD
*
*
*        RETURNS:
*         'ALL'   =  -1 IF 'ALL' FILES MODE
*                 =   0 IF NOT
*
*
*        'ACEQU'  =  -1 IF ACCOUNT# EQUAL
*                 =   0 IF NOT EQUAL
*
ACCK     EQU       %
         LI,R2     0                *
         LI,R3     8                EIGHT BYTES OF ACN#
       LI,R4   BA(ACBUF)     COMPARE CURRENT ACCOUNT IN AC DIRECTORY
       LI,R5   BA(INBUF)     AGAINST DATA CARD WE HAVE NOW
       AW,R4   ACN#DISP      ADD CURRENT DISP TO AC DIRECT.
         BAL,R14   CBYTE            COMPARE THEM
         B         ACE              AH-THEY COMPARED
         BG       PASSED            GONE TOO FAR BY NOW
         STW,R2   ALL               ZAP ALL FLAG
MODECK   STW,R2    ACEQU            NO-SET ACCOUNTS ARE NOT EQUAL
         B         *R15             AND RETURN
ACE      LI,R2    -1                SET SWITCH
         LI,R0     0                SET R0
         LW,R1    INBUF+3           IS THERE A FILE NAME
         CW,R1    BLANK             ON THIS DATA CARD
         BNE      %+2               YES-SET 'ALL' WITH ZERO
         LI,R0    -1                NO-SET  'ALL' WITH -1
         STW,R0    ALL              SET 'ALL' FLAG
         B         MODECK           AND SET 'ACEQU'
         PAGE
*
*        READ CONTROL COMMANDS THRU M:C
*
RCD      EQU      %
         BAL,R0   PROM:CH           SEE ABOUT PROMPTING USER
         LI,R7    RCD1              PREPARE FOR ERROR
         CAL1,1   READC             READ A CARD
         LW,R0    M:C+13            GET BYTE CNT
         BEZ      SETENDUP          NONE,SET UP END SEQUENCE
RCD0     LW,R1    INBUF             GET WORD0 IMAGE
RCD1     CW,R1    ENDCOM            IS END COMMAND
         BNE      *R14              NO...NOT YET
         STW,R1   END               YES...SET SWITCH
         B        *R14              AND RETURN
SETENDUP EQU      %
         LW,R1    ENDCOM            SIMULATE END ON ERROR
         B        0,R7              TAKE ERROR RETURN
         PAGE
*
*        PROMPT IF ONLINE/GHOST MODE
*
PROM:CH  EQU      %
         DO       UTS>0
         LC       J:JIT             CHECK ORIGIN
         BCR,12   *R0               RETURN,MUST BE BATCH
         LI,R15   PROMPT            ELSE,SEND
         CAL1,2   TYP15             A ':'
         FIN
         LI,R7    -20               BLANK BUFFER
         LW,R6    BLANK             PRIOR TO
         STW,R6   INBUF+20,R7       READING COMMAND
         BIR,R7   %-1
         B        *R0               AND EXIT
         PAGE
*
*        READ SUCCESSIVE DATA CARDS SUBROUTINE
*
READATA EQU       %
         LH,R0    M:SI              SEE IF USING
         CI,R0    X'20'             SI DCB
         BAZ      RCD               NO,READ M:C DCB
         LI,R7    -1                ZAP INBUF
         STW,R7   INBUF             BEFORE READING NEXT CARD
         LI,R7    RCD1              OTHERWISE SET FOR ERROR
READATA0 CAL1,1   READSI            READ A CARD
         B        *R14              RETURN WITH CARD
         PAGE
*
*        ERROR/ABNORMAL FROM STATISTICS FILE
*
OPNPOABN,OPNPOERR  EQU  %
         LB,R15   R10
         CI,R15   3                 DISKPOOL NOT FOUND
         BNE      POERR             NO-SOME OTHER ERROR
         MTW,-2   POFCN             SET FPT TO OUT
         CAL1,1   OPENPO            CREATE DISKPOOL
         NOP
         CAL1,1   CLSPO             SAVE IT
         NOP
         MTW,2    POFCN             RESET  TO INOUT
         CAL1,1   OPENPO            OPEN INOUT
         NOP
POERR    EQU      %
         LI,R15   FILERROR          PRINT ERROR MESSAGE
         CAL1,2   PRNT15            ABOUT PROBLEM
         B        *R8               RETURN TO CAL+2
         PAGE
*
*        ACCOUNT DIRECTORY INDICATES WE'VE
*        PASSED THE DATA CARD ACCOUNT.
*
PASSED   EQU      %
         CI,R15   STPCK1+1          SPECIAL CASE FOT +STOP
         BE       ACE               BINGO-TREAT PASSED AS EQUAL
         MTW,0    END               IS IT END WE'RE LOOKING AT
         BNEZ     SELCK             YES..SEE WHAT TO DO
         CAL1,1   PAGEFPT           KICK OUT NEW PAGE
         LI,R1    5
         BAL,R15  SPACE             SPACE A FEW LINES
         LI,R1    BA(PSMSG)         SHOVE OUT MSG
         LI,R2    5                 ABOUT PROBLEM
         BAL,R15  BUFSET
         LI,R1    BA(INBUF)         LOCATION OF ACCOUNT#
         LI,R2    27                PRINT LINE DISPLACEMENT
         LI,R3    8                 BYTE COUNT
         BAL,R15  BUFSET1           MOVE ACN# TO PRINT LINE
         BAL,R15  LPRINT            PRINT/CLEAR  RINT LINE
         LD,R4    INBUF             HOLD CURRENT IMAGE IN R4-R5
PASSED1  BAL,R14  RD:COM            READ NEXT CARD
         MTW,0    END               AT END OF DATA STREAM YET
         BNEZ     PASSED2           YES..GO ON AND SEE WHAT TO DO
         LD,R2    INBUF             GET NEW IMAGE
         CD,R2    R4                CHANGE YET
         BE PASSED1                 NO..READ NEXT
PASSED2  LI,R4    0                 RESET
         STW,R4   ALL               READ-AHEAD FLAG
         B        SELCK             SEE WHAT TO DO
         PAGE
*
*        READ SUCCESSIVE DATA CARDS THRU HERE
*
RD:COM   PSW,R14  *STKPNTR          SAVE LINK
RD:COM1  BAL,R14  READATA           READ ONE CARD
         BAL,R15  INTER             CHECK FOR COMMAND
         BCS,8    RD:COM1           READ TILL DATA CARD
         PLW,R7   *STKPNTR          RESTORE LINK
         B        0,R7              AND RETURN
         PAGE
*
*        CHECK CURRENT FILE NAME AGAINST DATA CARD
*
*        DATA CARD STRING STARTS IN CC14
*        CURRENT FILE NAME IS IN 'BOFBUF+2'
*
*
CBYTE    EQU      %
         LW,R7    R14
         DO       SIGMA7=0
         LB,R1    0,R4              GET INPUT BYTE
         CB,R1    0,R5              COMPARE TO CURRENT ACCOUNT/FILE
         BNE      1,R7
         AI,R4    1                 EQUAL MEANS BUMP
         AI,R5    1                 INDEX VALUES
         BDR,R3   CBYTE             AND CONTINUE WITH COUNT
         B        *R14              AND RETURN-FIELDS ARE EQUAL
         ELSE
         STB,R3   R5                SET COUNT
         CBS,R4   0
         BE       0,R7
         B        1,R7              NOT EQUAL
         FIN
PATCH    EQU      %
         RES      100
         PAGE
*
*        ACNCFU DISC ADDRESS ERROR
*
READFAIL EQU      %
         LI,R1    BA(RF1)
         BAL,R15  TYPEIO
         LI,R15   RF1
         CAL1,2   PRNT15
         M:SNAP   'ACNCFU',(ACNCFU,ACNCFU+3)
         B        READFAILX          MUST ABORT ON THIS ERROR
         PAGE
*
*        ACCOUNT DIRECTORY LINK FAILURE
*
READFAIL2 EQU     %                 LINKAGE FAILURE IN AD
         LW,R13   LASTAC            PLACE LAST AD ADDRS IN R13
         LW,R14   ACBLINK
         LW,R15   ACFLINK
         M:SNAP   'ACLINK',(ACBUF,ACBUF+3)
         LI,R15   RF3
         CAL1,2   PRNT15
         B        READFAILX         MUST ABORT
         PAGE
*
*        LINK FAILURE IN FILE DIRECTORY
*
READFAIL3 EQU     %
         LW,R13   LASTFD
         LW,R14   FDBLINK
         LW,R15   FDFLINK
         M:SNAP   'FDLINK',(FDBUF,FDBUF+3)
         LI,R15   RF4
         CAL1,2   PRNT15
         B        ENDOFD            LOG END OF ACCOUNT
         PAGE
*
*        LINK FAILURE IN INDEX CHAIN
*
READFAIL5 EQU     %
         LI,R1    BA(RF5)           REPORT ERROR
         BAL,R15  TYPEIO            TO OPERATOR
         LI,R15   RF5
         CAL1,2   PRNT15
         B        MIXSNAP           SNAP/CLEANUP,ETC...
*
*
READFAILX EQU     %
         MTW,2    FPEXIT            STEP EXIT TO ABORT
         B        ENDUP             AND EXIT
         PAGE
*
*        PRINT AND CLEAR LINE SUBROUTINE
*
LPRINT   EQU      %
         MTW,0    LIST              LISTING MODE ON
         BEZ      *R15              NOPE..EXIT
         LCI      3
         PSM,R15  *STKPNTR          SAVE LINK&WORK REGISTERS
        BAL,R15   PRINT
         DO       SIGMA7=0
         LI,R1    -34
         LI,R0    0
         STW,R0   PBUF+34,R1        CLEAR PRINT LINE
         BIR,R1   %-1
         ELSE
         LW,R1    PBUFBA
         LI,R0    0
         MBS,R0   0                 ZAP PRINT LINE
         FIN
         LCI      3
         PLM,R15  *STKPNTR
         B        *R15
         PAGE
*
*        SNAP AREA POINTED TO BY R3 AND THE NUMBER
*        OF BYTES IN R1
*
PLIST   LCI       0               ENTRY-PUT AWAY
         PSM,R0   *STKPNTR        CALLER'S REGISTERS
         AI,R1    3                 ROUND UP BYTE CNT
         SLS,R1   -2                MAKE TOTAL WORDS
         LW,R4    R3                BASE ADDRS
         AW,R4    R1                ADD EM UP
         AND,R3   M17
         AND,R4   M17               DEBUG DOESN'T LIKE EXTRA BITS
         M:SNAP   '    ',(*R3,*R4)
         LCI      0                 PULL ALL
         PLM,R0   *STKPNTR          CALLER REGISTERS
         B        *R15              AND RETURN
         PAGE
*
*        BUILD/MOVE TO PRINT LINE SUBROUTINES
*
*
BUFSET   EQU       %
         LB,R3    0,R1              R3 = NO OF BYTES TO PRINT
         AI,R1    1                 R1 = SBA OF MESSAGE
CLRBUF   EQU      %
         DO       SIGMA7=0
         LI,R5    -34
         LI,R0    0
         STW,R0   PBUF+34,R5
         BIR,R5   %-1
         ELSE
         PSW,R1   *STKPNTR
         LW,R1    PBUFBA
         LI,R0    0
         MBS,R0   0                 ZAP LAST PRINT LINE
         PLW,R1   *STKPNTR          RESTORE R1
         FIN
BUFSET1  EQU      %
         DO       SIGMA7=0
         LW,R4    R1                SBA TO R4
         LB,R5    0,R4              GET A BYTE
         STB,R5   PBUF,R2           MOVE TO PRINT LINE
         AI,R4    1                 INCREMENT SBA
         AI,R2    1                 INCREMENT PBUF INDEX
         BDR,R3   %-4               FINISH UP
         ELSE
         LI,R5    BA(PBUF)          DESTINATION BA
         LW,R4    R1                SOURCE BA
         AW,R5    R2                DISP IN PRINT LINE
         STB,R3   R5                SET COUNT
         MBS,R4   0                 MOVE MSG STRING
         FIN
         B        *R15
         PAGE
*
*        WRITE PRINT LINE SUBROUTINE
*
PRINT    EQU       %
         MTW,0    LIST              LISTING MODE ON
         BEZ      *R15              NNOPE..EXIT
         CAL1,1   WRTPBUF
         B         *R15
SPACE    EQU       %
         MTW,0    LIST              LISTING MODE ON
         BEZ      *R15              NOPE..EXIT
         CAL1,1   WRTBLNK
         BDR,R1    %-1
         B         *R15
         PAGE
*
*        FILE MANAGEMENT ERROR FROM SORT FILE
*
SOERR,SOABN EQU   %
         LI,R15   SOMSG
         CAL1,2   PRNT15            PRINT ERROR MSG
         M:SNAP   ' '
         CAL1,9   3                 ABORT RUN
         PAGE
*
*
*    TELETYPE I/O DRIVER
*      BAL,R15  TYPEIO   W/  R1 = BA OF TEXTC MESSAGE
*     BAL,R15    TYPEIO2  W/R1 = BA OF MESSAGE BUFFER , R3 = BYTE COUNT
*
*
TYPEIO2  LCI      6
         PSM,R15  *STKPNTR
         MTW,1    NONL
         B        TYPEIO1
TYPEIO   LCI      6
         PSM,R15  *STKPNTR
         LB,R3    0,R1
         AI,R1    1
TYPEIO1  EQU      %
         MTW,0    NONL
         BNEZ     %+4
         LI,R4    X'15'
         STB,R4   0,R1              PLACE NEW LINE INTO MSG
         PSW,R1   *STKPNTR          HANG ON TO INDEX
         LI,R2     3
         AND,R2    R1
         SLS,R1    -2             WORD ADDRESS OF MESS BUFFER IN R1
         CAL1,1   WRTOC
         MTW,0    NONL
         BNEZ     %+4
         PLW,R1   *STKPNTR          GET INDEX BACK
         LI,R4    ' '
         STB,R4   0,R1              REPLACE NEW LINE
         LI,R0    0
         STW,R0   NONL
         LCI      6
         PLM,R15  *STKPNTR
         B        *R15
         PAGE
*
*
*        MESSAGES/TEMP CELLS/ETC....
*
*
*
NONL     DATA     0
GETPAGES GEN,8,24 X'08',#TBUF+#DBUF    THATS ALL WE NEED
         DO       FILL
TIMFPT1  GEN,8,1,23  X'10',1,DATBUF+3     M:TIME
         ELSE
TIMFPT1  GEN,8,24 X'10',DATBUF+3
         FIN
CLSEO    GEN,8,24 X'15',M:EO
         PZE      *X'20'
         DATA     1
WRTPBUF  GEN,8,24 X'11',M:LL
         GEN,8,24 X'34',0
         DATA     PBUF,132,0
WRTBLNK  GEN,8,24 X'11',M:LL
         DATA     X'30000000'
         DATA     BLANK,4
READSI   GEN,8,24 X'10',M:SI
         GEN,8,24 X'F0',16
         DATA     SETENDUP,SETENDUP,INBUF,80
         REF      M:SI
WRTOC    GEN,8,24 X'11',M:OC
         DATA     X'34000000'
         PZE      *R1               BUFFER ADDRESS IN R1
         PZE      *R3               SIZE IN R3
         PZE      *R2               BTD IN R2
PBUFBA   GEN,8,24 132,BA(PBUF)      FOR BUFFER BLANKING
OPNLL    GEN,8,24 X'14',M:LL        OPEN
         DATA     0                 NO OPTIONS
PAGEFPT  GEN,8,24 X'04',M:LL
LLHDR    GEN,8,24 X'26',M:LL
         DATA     X'C0000000'
LLHDRB   DATA     PRTMESS
         DATA     1                 PRINT LINE POSITION
         REF      M:PO
         DO       CPV>0
POBUFSZ  EQU      7                 ALLOW ROOM FOR RAD AND PACK GRANS
         ELSE
POBUFSZ  EQU      5
         FIN
OPENPO   GEN,8,24 20,M:PO
         DATA     X'F7480001'
         DATA     OPNPOABN,OPNPOERR
         DATA     POBUF,POBUFSZ*4,2,2
POFCN    DATA     4,2,15
         DATA     X'01000303'
         TEXTC    'DISKPOOL'
         DATA     X'02010202'
         TEXT     '99999999'
WRTPO    GEN,8,24 17,M:PO
         DATA     X'08000050'       KEY/WAIT BITS
         DATA     POBUF-2
CLSPO    GEN,8,24 21,M:PO
         DATA     X'80000000'
         DATA     2
         BOUND    8
         GEN,8,24 15,'   '
         TEXT     ' '
POBUF    RES      POBUFSZ
OPNTAPE  GEN,8,24 20,M:EO
         DO       CPV>=2
         DATA     X'E9000040'
         ELSE
         DATA     X'E9040040'
         FIN
         DATA     OPNABN
         DATA     OPNERR
         DATA     BUF
         DATA     15
         DATA     2
         DO       UTS=0
         DATA     X'18A00'
         ELSE
         DO       CPV<2
         GEN,16,16 0,'MT'
         FIN
         FIN
         DATA     X'08010101'       OUTSN
         DO       FILL
REELSN   TEXT     '01A0'
         ELSE
REELSN   TEXT     'PRG1'
         FIN
BUF      TEXT     ' '
         DO       UTS=0
STKMS    TEXTC    ' ***BPM STACK SIZE TOO SMALL'
         FIN
LESSTHAN EQU      %
   TEXTC ' NOT ENOUGH CORE TO RUN, LESS THAN 5 PAGES AVAILABLE.'
READC    GEN,8,24 X'10',M:C
         GEN,4,20,8  X'F',0,16
         DATA     SETENDUP,SETENDUP
         DATA     INBUF,80
WRTLL    GEN,8,24 X'11',M:LL
         GEN,4,28 3,0
         DATA     INBUF,80
PRNT15   EQU      %
         GEN,8,24 X'01',0
         PZE      *0
         PZE      *15               MSG ADDRS IN R15
TYP15    GEN,8,24 X'02',0
Y8       PZE      *0
         PZE      *15
RESTFLD  TEXT     '0100'
TRUNCMSG TEXTC '#DATA BUFFER DISMISSAL EVENTS'
TRUNC3MSG TEXTC   '  SHORT:'
TRUNC1MSG TEXTC   '  FORCED:'
TRUNC2MSG TEXTC   '  SCHEDULED:'
BENTRY   DATA     0                 POINTS TO '0B' ENTRY FOR SYNON FILES
         DO1      UTS<=0
NEWQ     DATA     0                 CORE ADDRESS OF NEWQ
NEXACN   DATA     0                 NEXT ACN INDEX
NEXFILE  DATA     0                 NEXT FD INDEX
ACSIZE   DATA     0                 SIZE OF CURRENT AC SECTOR
FDSIZE   DATA     0                 SIZE OF CURRENT FD SECTOR
ACNSIZE  DATA     0                 #OF BYTES IN CURRENT ACCOUNT
PAGETOTAL DATA    0                 TOTAL PAGES GOTTEN
DAPAGES  DATA     0                 TOTAL DATA BUFFER PAGES
TAPAGES  DATA     0                 TOTAL TAPE BUFFER PAGES
INDPAGES DATA     0                 TOTAL INDICES BUFFERS
ACNGRAN  DATA     0                 #GRANULES IN CURRENT ACCOUNT
         DO       CPV>0
         DO       TAURUS=1
         DEF      EAADDR
EAADDR   DATA     0                 ENDACTION WORD ADDR
EAPHYADR DATA     0                 PHYSICAL PAGE OF STOLEN PAGE FOR EA.
EOTFLAG  DATA     0                 END OF REEL
MIXSTAT  DATA     0                 MI STATUS TABLE
MIXSTATN DATA     0                 END OF MI STATUS TABLE
Y05      DATA     X'05000000'
CVMFPT   DATA     X'87000003'
         DATA     X'80000008'
GTPG     GEN,8,24 8,1
FREPG    GEN,8,24 9,1
         FIN
PACKGRAN DATA     0                 # PACK GRANS IN CURR. ACCT.
RADGRAN  DATA     0                 #RAD GRANS ETC. ETC.
         FIN
CURACN   DATA     0                 CURRENT INDEX TO ACN DIRECTORY
ENDOFSET DATA     0                 END OF TAPE REEL VOLUMNS FLAG
CURFILE  DATA     0                 CURRENT FILE DIRECTORY INDEX
ACFLINKQ DATA     0                 USED FOR SWITCHING SECTORS
FDFLINKQ DATA     0                 USED FOR SWITCHING SECTORS
LASTAC   DATA     0                 LAST ACN SECTOR DISC ADDRESS
LASTFD   DATA     0                 LAST FD  SECTOR DISC ADDRESS
ORGTX    EQU      %
         TEXT     'CON '
         TEXT     'CON '
         DATA    'KEY '
         DATA    'RAN '
FILESIZE DATA     0   #OF TOTAL DATA BYTES BY MASTER KEYS
BLKDBYTES DATA  0    #OF TOTAL DATA BYTES SENT TO TAPE
BOFBUFBA GEN,8,24 64,BA(BOFBUF)
FNEA     GEN,8,24 0,BA(FITBUF+3)
FNEB     GEN,8,24 0,BA(BOFBUF+2)
         DO       UTS=0
FNEC     GEN,8,24 0,BA(PBUF)+18
         ELSE
FNEC     GEN,8,24 0,BA(PBUF)
         FIN
TOTLFILS DATA     0
9ENTRY   DATA,1   9,1,2,2
SYNFLAG  DATA     0                 CURRENT FILE=SYNON FLAG
CONTFLAG DATA     0                 CONTINUED KEY FLAG
FITDA    DATA     0                 READ-AHEAD CELL FOR FIT'S
PBS      DATA     0                 PREVIOUS BLOCK SIZE CELL
ALL      DATA     0                 PROCESS ALL FILES FLAG
ACEQU    DATA     0                 ACCOUNT# EQUAL TO DATA CARD FLAG
TOTAPMS  TEXTC    '#TAPES USED:'
TOTFMS   TEXTC    '#FILES PROCESSED:'
SPINMSG  TEXTC    '#OF NO BUFFER EVENTS'
ISPINMSG TEXTC    '  INDICES:'
DSPINMSG TEXTC    '  DATA:'
TSPINMSG TEXTC    '  TAPE:'
RAMSG    TEXTC    '#OF READ-AHEAD RATE ERRORS'
ADRA     TEXTC    '  ACCOUNT DIRECTORY:'
FDRA     TEXTC    '  FILE DIRECTORIES:'
FITRA    TEXTC    '  FILE INFO TABLES:'
MIXRA    TEXTC    '  MASTER INDICES:'
DATARA   TEXTC    '  DATA GRANULES:'
DINFO1   TEXTC    'RAD/DISC I/O ACCESS''S: '
DINFO6   TEXTC    '#OF TOTAL DATA BYTES:'
DINFO11  TEXTC    '#TAPE ACCESS''S: '
DINFO2   TEXTC    '#DATA GRANULES:'
DINFO3   TEXTC    '#INDEX SECTORS:'
IOSPINMSG TEXTC '#OF I/O SPIN EVENTS:'
TOTAMS   TEXTC    '#ACCOUNTS PROCESSED:'
STATISTICS EQU    %
         DO       CPV>0
   TEXTC '* * * C P - V   F S A V E   S T A T I S T I C S * * *'
         ELSE
         DO       UTS>0
  TEXTC '* * * U T S   F S A V E   S T A T I S T I C S * * *'
         ELSE
  TEXTC '* * * B P M   F S A V E   S T A T I S T I C S * * *'
         FIN
         FIN
ACMESS   EQU      %
   TEXTC ' ***FILE DIRECTORY ADDRESS ERROR IN ACCOUNT KEY'
FNERR    EQU      %
     TEXTC ' FILE NAME DOES NOT MATCH FILE DIRECTORY KEY'
ACNCFUMS TEXTC    '****ACNCFU TABLE****'
DINFO5   EQU      %
   TEXTC  '#GRANULES IN USE:'
NEWRLMS EQU       %
  TEXTC '***     STARTED'
TPWRTERR EQU      %
   TEXTC ' IRRECOVERABLE TAPE WRITE ERROR'
NOACTIVMS EQU     %
 TEXTC 'LAST ACTIVITY IN THIS ACCOUNT: XXXXZZ AT 24:00'
FDRMSG   TEXTC    '** FILE DIRECTORY   '
FITMSG1  TEXTC    '** FILE INFORMATION TABLE   '
OUTPUTBLK TEXTC   '** OUTPUT BUFFER   '
MIXMSG1  TEXTC    '** INDEX SECTOR   '
ADRMSG1  TEXTC    '** ACCOUNT DIRECTORY   '
SEL:MSG TEXTC '*** FOLLOWING DATA CARDS USED FOR',;
              ' ACCOUNT/FILE SELECTION ***'
SKI:MSG TEXTC '*** FOLLOWING DATA CARDS USED FOR',;
              ' ACCOUNT/FILE SKIPPING ***'
TEN      DATA     10
ZERO     EQU      0
SYSFPT   DATA     X'08000000'
COMCNT   DATA     3
M16      DATA     X'0000FFFF'
YFF      GEN,8,24 -1,0
MFF      GEN,24,8 0,-1
FILERROR TEXTC 'ERR/ABN FROM STAT FILE..CONTINUING'
PSMSG    TEXTC    'CANNOT FIND ACCOUNT- '
PSMSG1 TEXTC ' FILE NAME NOT FOUND - DATA CARD REJECTED 

  '
SYNERR   TEXTC    'SYNON FILE CANNOT BE SAVED'
XMSSG    TEXTC    ' UNRECOGNIZED CONTROL CARD..RUN ABORTED'
XMSSG1   TEXTC    ' INVALID DATE ON +DAY COMMAND'
RF1      TEXTC    ' CANNOT READ FIRST ACCOUNT DIRECTORY SECTOR'
RF3      TEXTC    ' LINK FAILURE IN ACCOUNT DIRECTORY'
RF4      TEXTC    ' LINK FAILURE IN FILE DIRECTORY'
RF5      TEXTC    ' LINK FAILURE IN INDEX CHAIN'
SOMSG    TEXTC    ' I/O ERROR FROM SORT FILE (OUTPUT PHASE) '
DATACARDS         DATA              0
MONTHTAB EQU      %
         TEXT     '   '
         TEXT     'JAN'''
         TEXT     'FEB'''
         TEXT     'MAR'''
         TEXT     'APR'''
         TEXT     'MAY'''
         TEXT     'JUN'''
         TEXT     'JUL'''
         TEXT     'AUG'''
         TEXT     'SEP'''
         TEXT     'OCT'''
         TEXT     'NOV'''
         TEXT     'DEC'''
MONTABL  EQU      WA(%)-WA(MONTHTAB)-1
         DO       UTS>0
FS:MSG   EQU      %
         DATA,1   FS:MSGL,'F','S','A'
         TEXT     'VE H'
         DATA,1   'E','R','E',X'15'
FS:MSGL  EQU      BA(%)-BA(FS:MSG)-1
         BOUND    4
PROMPT   TEXTC    ':'
         FIN
*
*        NEW BACKUP INSERT FOR :BOF RECORD
*
BKUPVLP  DATA     X'10000202'
         DATA     0,0               BACKUP DATE
MONTHN   TEXT     '0101020304050607080910111200'
         BOUND    8
DOUBLEONE DATA    1,1
DSTKPNTR DATA     STACK-1
         GEN,1,15,1,15   1,STACKSIZE,1,0
TEMPSTK  DATA     TMPSTK-1
         DO       UTS>=2
         DATA     X'80A88000'       NO TRAPS, 168 WORD MAX.
         ELSE
         DATA     X'80448000'       NO TRAPS,68 WORD MAX
         FIN
TEMPPNTR DATA     TMPSTK-1
         DO       UTS>=2
         DATA     X'80A88000'       SPD REFRESHER
         ELSE
         DATA     X'80448000'       SPD REFRESHER
         FIN
         DO1      UTS<2
TMPSTK   EQU      START+6
         DO       UTS=0
SLPSD    GEN,10,22 2,SLV:EXIT       NON-MAPPED
         ELSE
SLPSD    GEN,10,22 3,SLV:EXIT       OR MAPPED
         FIN
         DATA     0
BUF:LIMS DATA     0,0               BUFFER LOW/HIGH AREA WA'S
LASTACT  DATA     X'80000000',X'8000' DATE OF LAST ACTIVITY
CR       TEXTC    ' ACCOUNT#                      '
ACN#CURNT EQU     CR+4
BLANK    EQU      CR+6
VOL#CURNT EQU     CR+7
ENDMS    EQU      %
         TEXTC    ' PROCESSING TERMINATED'
FDMESS   EQU      %
   TEXTC '  ***FIT DISC ADDRESS ERROR IN FILE DIRECTORY KEY'
M17      DATA     X'1FFFF'
M9       DATA     X'1FF'
Y4       DATA     X'40000000'
Y002     DATA     X'00200000'
         DO       UTS>=3
Y004     DATA     X'00400000'
         FIN
FILSMSG  TEXTC    '#FILES SKIPPED:'
FITMESS  TEXTC    ' ERROR IN FILE INFORMATION TABLE'
NO:DTMSG TEXT     'NONE'
DASHMSG  TEXTC    '--------'
EOFMSG TEXTC '**FLINK ZERO AND FILE EOF MISSING'
EOFMSG1 TEXTC '**FLINK NON-ZERO AND FILE EOF SET'
MIXMESS  TEXTC    ' ERROR IN MASTER INDEX'
SKIPFILMS TEXTC   ' **PARTIAL FILE: '
         DO       UTS=0             BPM HEADER
PRTMESS  EQU      %
   TEXTC 'VOLUMN                FILE NAME          ',;
         '  GRANULES    BYTES        ORG    TYPE',;
         '    PASSWORD    DATE    HOUR        COMMENTS'
         ELSE
PRTMESS  TEXTC    ' FILE NAME        GRANULES  ',;
                  'BYTES   ORG     CREATION    ',;
                  'EXPIRES     ',;
                  'ACCESSED        ',;
                  'MODIFIED        ',;
                  'BACKED-UP       ',;
                  'PASSWORD    ',;
                  'READ'
         FIN
BIASMASK DATA     X'FE00'
FDBLINK  DATA     0                 BACK LINK CURRENT FD SECTOR
FDFLINK DATA      0                 FWD LINK CURRENT SECTOR
ACBLINK  DATA     0                 CURRENT AD SECTOR
ACFLINK  DATA     0                 FWD LINK CURRENT AD SECTOR
FDA      DATA     0                 FIRST INDEX SECTOR DISC ADDRS
         DO       UTS>0
         PAGE
*
*        UTS FILE DATE TABLES
*
DATE:TAB EQU      %
         DATA     #DATES            GENERATE TABLE LENGTH
         DATA     BKP:DATE          LAST BACKUP DATE
         DATA     MOD:DATE          LAST MODIFICATION DATE
         DATA     ACC:DATE          LAST ACCESS DATE
         DATA     EXP:DATE          EXPIRATION DATE
         DATA     CRE:DATE          CREATION DATE
#DATES   EQU      WA(%)-WA(DATE:TAB)-1
*
*
DATE:PS  EQU      %
         DATA     #DATES
         DATA     PBUF+25,PBUF+21,PBUF+17,PBUF+14,PBUF+11
*
*
DATE:FLD DATA,1   #DATES,X'10',X'0A',X'0F',X'04',X'0E'
         BOUND    4
*
*
READ:AC  DATA     0,0
BKP:DATE DATA     0,0
MOD:DATE DATA     0,0,0
ACC:DATE DATA     0,0
EXP:DATE DATA     0,0
CRE:DATE DATA     0,0
*
*
LPR      DATA,1   0,0,' ',0
RPR      DATA,1   0,':','0','0'
BLD:DATE DATA     0,0,0
*
*
HOUR:DI  DATA,1   #DATES,0,0,0,-1,-1
         BOUND    4
         FIN
         PAGE
*
*        ACCEPTABLE CONTROL COMMANDS FOR FSAVE
*
COMS     EQU      %
         TEXT     '+LOG'
         TEXT     '+BLO'            DUMP OUTPUT BLOCKS
         TEXT     '+DEB'            RUN IN DEBUG MODE
         TEXT     '+LIS'            LIST FILE INFO ON M:LL
         TEXT     '+IND'            DUMP EACH INDEX SECTOR
         TEXT     '+FIT'            DUMP EACH FIT SECTOR
         TEXT     '+TAB'            DUMP TABLES AFTER EACH FILE
         TEXT     '+DIR'            DUMP EACH AD/FD SECTOR
         TEXT     '+SOR'            SORT DATA CARDS
         TEXT     '+DUM'            PRODUCE OUTPUT TAPE
         TEXT     '+ACN'            USE PROVIDED ACN#
         TEXT     '+LBL'            USE PROVIDED SERIAL#
ENDCOM   TEXT     '+END'            ENDS INPUT STREAM
COMSEL   TEXT     '+SEL'            SELECT ONLY
         TEXT     '+STA'            START AT
         TEXT     '+STO'            STOP AT
COMSKI   TEXT     '+SKI'            SAVE ALL SKIPPING
COMDAY   TEXT     '+DAY'            SAVE BY DATE PROVIDED OR TODAY
         TEXT     '+HOU'            SAVE BY HOUR PROVIDED
#COMMANDS EQU     WA(%)-WA(COMS)    LENGTH OF TABLE
         PAGE
*
*        COMMAND SWITCHES,PARALLEL TO COMS
*
SWITCH   EQU      %
LOGSW    DATA     1                 DEFAULT RUN MODE
BLOCKS   DATA     0
DEBUG    DATA     0
LIST     DATA     1                 DEFAULT CONDITION
INDEX    DATA     0
FITLISTSW DATA    0
TABLES   DATA     0
DIRLISTSW DATA    0
SORT     DATA     1
DUMP     DATA     0
ACNSW    DATA     0
LBLSW    DATA     0
END      DATA     0
SELECT   DATA     0
STARTSET DATA     0
STOPAT   DATA     0
SKIP     DATA     0
SAVBYDATE DATA    0
SAVBYHOUR DATA    0
LABELEDT DATA     0
         PAGE
*
*        FIELD TWO LEGALITY TABLE;
*
*        ENTRY SETTINGS:
*        0        NOT LEGAL
*        NON-ZERO FIELD COUNT AND BUFFER POINTER
*
SWITCH1  EQU      %
         GEN,4,28 1,STATS           WORD COUNT/POINTER
         DATA     0,0,0,0,0,0,0,0
         GEN,4,28 1,STATS
         GEN,4,28 2,ACNBUF+1
         GEN,4,28 1,REELSN
         DATA     0,0,0,0,0
         GEN,4,28 2,SAVEDATE
         GEN,4,28 1,SAVEHOUR
         DATA     0
         PAGE
*
*        REMAINING POINTERS/CELLS FOR RUNNING FSAVE
*
SAVEHOUR DATA     0
         BOUND    8
SAVEDATE DATA     C'MMDD','YY  '    SECOND WORD IS YEAR
         DO       UTS<=0
STKPNTR  DATA     0
         ELSE
STKPNTR  DATA     STK
         FIN
*
*        VLP CODES TO MOVE INTO :BOF RECORD
*
CODES    EQU      %
         DO       FILL
         DATA,1   #CODES,5,6
         ELSE
         DATA,1   #CODES,4,5,6,10,14,15
         FIN
#CODES   EQU      BA(%)-BA(CODES)-1
         BOUND    4
         DO       FILL
*
*        VLP CODES TO MOVE INTO TLABEL RECORD
*
CODES1   EQU      %
         DATA,1   #CODES1,4,10,14,15,20,21
#CODES1  EQU      BA(%)-BA(CODES1)-1
         BOUND    4
         FIN
STATS    DATA     0
DEFFLG   DATA     0                 DEFAULT DATE FLAG
OFFCOM   TEXT     'OFF'
         PAGE
*
*        ACCOUNT/FILE DIRECTORY AND FIT BUFFERS
*
*
         DEF      RESAREA
         BOUND    8
RESAREA  EQU       %
INBUF    EQU      %                 CONTROL CARD BUFFER
PBUF     EQU      INBUF+14          PRINT LINE BUFFER
ACNCFU   EQU      PBUF+36           BUF FOR ACNCFU TABLE
ACBUF    EQU      PBUF+36           ACCOUNT DIRECTTRY BUFFER
FDBUF    EQU      ACBUF+DIRSIZ      CURRENT FILE DIRECTORY BUFFER
FITBUF   EQU      FDBUF+DIRSIZ      FILE INFORMATION TABLE BUFFER
BOFBUF   EQU      FITBUF+DIRSIZ
         RES      BOFBUF-RESAREA+100
         PAGE
*
*        BUFFER MANAGEMENT TABLES
*
*        FOLLOWING EQU'S CONTROL MAXIMUM # OF PAGES
*        THE PROGRAM WILL USE,ESSENTIALLY TABLE DEFINITIONS
*
         DEF      #TBUF,#DBUF,#IBUF
*
#TBUF    EQU      8                 #PAGES FOR TAPE BUFS
#DBUF    EQU      20                #PAGES FOR DATA BUFS
#IBUF    EQU      4                 #PAGES FOR INDEX POOLS
*
*
         DO       UTS>=2
STACKSIZE EQU     #IBUF*164+(#DBUF) DATA ADDRESS STACK
         ELSE
STACKSIZE EQU     #IBUF*64+(#DBUF)  DATA ADDRESS STACK
         FIN
         PAGE
*
*
*        TAPE BUFFER ADDRESS TABLE
*
*
*
TBUF     EQU      %
         DATA     #TBUF
         DO1      #TBUF
         DATA     0
         PAGE
*
*
*        DATA BUFFER ADDRESS TABLE
*
*
*
DBUF     EQU      %
         DATA     #DBUF
         DO1      #DBUF
         DATA     0
         PAGE
*
*
*        DISC ADDRESS TABLE
*        PARALLEL TO DBUF
*
*
*
RB1      EQU      %
         DATA     #DBUF
         DO1      #DBUF
         DATA     0
         PAGE
*
*
*        DISC ADDRESS USE HISTORY TABLE
*        PARALLEL TO DBUF/RB1
*
*
RBHIST   EQU      %
         DATA     #DBUF
         DO1      #DBUF
         DATA     0
         PAGE
*
*
*        INDICES TABLES
*
*
*
IBUF     EQU      %
         DATA     #IBUF
         DO1      #IBUF
         DATA     0
INDEXDA  EQU      %
         DATA     #IBUF
         DO1      #IBUF
         DATA     0
         DO       UTS>0
         USECT    EASECT
         FIN
MIX:STAT DATA     #IBUF
         DO1      #IBUF
         DATA     0
MIX:CNT1 DATA     0
MIX:CNT2 DATA     0
MIX:SW   DATA     0
         DO       UTS>0
         USECT    START
         FIN
         DO       UTS>0
         BOUND    8
STK      DATA     %+1
         DATA     X'00800000'
         RES      X'80'
         FIN
         PAGE
*
*
*        BLOCKING BUFFER VARIABLE CELLS
*
*
*
CURRB    DATA     0                 CURRENT DISC ADDRS TABLE POINTER
KEYDISP  DATA     0                 CURRENT KEY DISPLACEMENT IN BUFFER
CURBUF   DATA     0                 CURRENT BUFFER WORD ADDRS
CSET     DATA     0                 CONTINUED RECORD FLAG
P1P2P3   DATA     0                 MARKER FOR TAPE KEY
KEYM     DATA     0                 KEY MAX BYTE COUNT
MIXEOF   DATA     0                 END OF MASTER INDEX CHAIN FALG
RWS      DATA     0                 RECORD SIZE
RWS2     DATA     0                 #BYTES LEFT TO MOVE TO NEW BUFFER(CURRENT RE
BLDISP   DATA     0                 DISPLACEMENT INTO DATA GRANULE
KEYSAVE  DATA     0                 POINTER FOR KEY MARKER
CURDBLK  DATA     0                 CURRENT DATA GRANULE BUF ADDRS
LASTKEY  DATA     0                 TAPE KEY FLAG
P1       DATA     0                 SET=FIRST PART OF RECORD
         DO       UTS>0
MAXMF    DATA     0                 MAXIMUM MASTER FUNCTION
         FIN
         DO       UTS>=2
FULL     DATA     0                 NON-ZERO IF CONTROL GRAN. FULL
CONKEY   DATA     0                 OLD CONSEC. FILE KEY
ICONKEY  DATA     X'02FFFFFF'       INITIAL VALUE OF
CONCAS1  DATA     0                 BLOCKED CONSECUTIVE FLAG
CONEOF   DATA     0                 CONSECUTIVE EOF FLAG
DELREC   DATA     0                 NON-ZERO IF PROCESSING DELETED RECORD
         DO1      UTS>=3
FITLOC   DATA     0                 DISPLACEMENT TO FIT IN MIX
         DO       FILL
BUFLOC   DATA     0,0               DISP. INTO :BOF AND TLABEL OF VLP'S
VLP11    DATA     X'11010101'       VLP ENTRY FOR DESCRIPTORS
         ELSE
VLP11    DATA     X'11000101'       VLP ENTRY FOR DESCRIPTOES
         FIN
STDESCR  DATA     0                 DESCRIPTERS RIGHT JUSTIFIED
         FIN
P2       DATA     0                 SET=RECORD CONTINUED
FAK      DATA     0                 FIRST APPEARANCE OF INDEX KEY FLAG
SIZE     DATA     0                 INDIVIDUAL RECORD SEGMENT SIZE
CURINDX  DATA     0                 CURRENT TABLE INDEX
GRANULEADR DATA   0                 CURRENT DATA DISC ADDRESS
MISIZE   DATA     0                 CURRENT SECTOR NAV
CURRMIX  DATA     0                 CURRENT SECTOR INDEX
NEXTMIX  DATA     0                 NEXT INDEX TO CURRENT SECTOR
DROPCNT  DATA     2048              #BYTES BLOCKED PRIOR TO DISMISSAL
LASTGRAN DATA     0                 LAST DISC ADDRESS INTO DATA STACK
NXTFLNK  DATA     0                 NEXT FWD LINK CURRENT FILE
MIXBUF   DATA     0                 WA OF CURRENT INDICES BUFFER
NEXDATA  DATA     0                 NEXT INDEX SECTOR INDEX
NSPT     DATA     0                 #SECTORS PER TRACK IF RANDOM FILE
RSTORE   DATA     0                 #GRANULES IN RANDOM FILE
BUFTOP   DATA     0                 HIGHEST WA TO USE IN SENTINEL BUF
LIMIT    DATA     0                 DITTO
NEWINDX  DATA     0                 *
NOWAIT   DATA     0                 *
         DO       UTS=0
HGP      DATA     0                 MAP BASE ADDRS
         ELSE
         FIN
DISCIOX  DATA     0                 RETURN ADDRESS FOR DISC HANDLER
         DO       UTS>0
         USECT    EASECT
         FIN
DOPCNT   DATA     0                 #OUTSTANDING Q ENTRIES DISC I/O
RBUSY    DATA     0
DSTATUS  DATA     0                 CURRENT DISC STATUS
OPCNT    DATA     0                 #OF TAPE OPERATINS CURRENTLY
TPSTATUS DATA     0                 CURRENT TAPE TYC
EOTBIT   DATA     0                 SET IF AT EOR
M24      GEN,8,24 0,-1              MASK
         DO       UTS>0
         USECT    START
         FIN
ACN#DISP DATA     0                 DISP TO ACN IN CURRENT
MTDCTX   DATA     0                 DEVICE INDEX OF REEL
CURPOS   DATA     0                 WA OF SENTINEL RING BUF
*                                   CURRENT POSITION
         DO       UTS=0
DCTSIZ   DATA     0                 SIZE OF DCT1
         ELSE
         FIN
RANDOM   DATA     0                 #GRANS CURRENT FILE
LSTBUF   DATA     0                 LAST TAPE BUFFER
INITX    DATA     FITBUF+12         START WA FOR CODESCAN
         DO       UTS>0
         USECT    EASECT
CUN      DATA     -1
         USECT    START
         FIN
ORG      DATA     0                 '09' ENTRY FROM FIT
SENTWRT  DATA,1   WRT,IOPRI,RETRY,0
SENTWRT1 DATA     0
SENTWRT2 DATA     0
         DATA     0
         PAGE
*
*        TAPE SENTINEL'S
*
BOFINFO  EQU      %
DATBOF   EQU      %
         TEXT     ':BOF'
         DATA     X'01000808'
         TEXTC    'DAT'
         DATA     0,0,0,0,0,0,0
         DATA     X'09010202'
         DATA     X'00030139'
TPLFLG   DATA     X'1B000000'
BOFSIZE  DATA     64*4
LBLBUF   TEXT     ':LBLPRG1    '    F00 WRITES 12 BYTES
DATBUF   DATA      1
         DATA,1    3,0,0,0,1,0,0,X'18'
         DO1       5
         TEXT      '    '
         DATA      X'2E00'
EOFBUF  TEXT      ':EOF'
        DATA      0
         DATA     0
SYNBUF  DATA      1
         DATA     X'03000000'       DUMMY KEY
         DATA     X'01000004'       DUMMY TAPE KEY
SYNMSG   TEXT     'SYN '            DUMMY TAPE RECORD
EORBUF  TEXT      ':EOR'
        DATA      0
         DATA     0
EOVBUF  TEXT      ':EOV'
        DATA      0
         DATA     0
TLABUF  DATA      0,0,0,0,0,0,0
         DO       FILL
         RES      57                VLP'S GO HERE FOR FILL TAPES
XTABLE   TEXTC    '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
ACNBUF   TEXT     ':ACN:SYS    '
         DATA     0,0,0,0           DATES FOR :ACN LABEL
         ELSE
ACNBUF   TEXT     ':ACN99999999'
         FIN
TPLBUF   DATA     0,0,0,0,0,0,0,0   ACTUAL TAPE LABEL BUFFER
         DO       FILL
         RES      57                VLP'S GO HERE FOR FILL TAPES
BRECREC  DATA     0,0,0,0,0,0,0,0,0 BUFFER FOR :BREC RECORD
BRECKEY  TEXTC    'SAV'             KEY FOR :BREC RECORD
BRECFLG  DATA     0                 SET NON-ZERO IF NO FILE OR RECORD
         FIN
         PAGE
*
*
*        GRANULE STACK FOR FILE I/O
*
*
*
         BOUND    8
DSTACK   DATA     STACK-1
         GEN,1,15,1,15  1,STACKSIZE,1,0
STACK    EQU      %
         RES      STACKSIZE
         DO1      UTS>=2
TMPSTK   RES      168
         PAGE
*
*        DEVICE DCB'S FOR OUTPUT VIA CAL'S
*
CNTRLSECT EQU     %
         DO       UTS=0             BPM ONLY CODE
M:LL     DSECT    1
         DATA     3,X'40003',0,0,0,0,0,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
M:EO     DSECT    1
         DATA     3,X'40003',0,0,0,0,FLP,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
FLP      DATA     X'08010101'       OUTSN
         DATA     0
M:C      DSECT    1
         DATA     3,X'20001',0,0,0,0,0,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
M:OC     DSECT    1
         DATA     3,X'0102',0,0,0,0,0,0,0,0,0,0
         DATA     0,0,0,0,0,0,0,0,0,0
         FIN
         DO       CPV>=2
M:EO     DSECT    1
M:EO     M:DCB    (DEVICE,'MT'),(OUTSN)
         FIN
         DO       UTS>0
         USECT    EASECT
         ELSE
         USECT    CNTRLSECT
         FIN
FPTOP    END      INITIATE

