         TITLE    '**** GRAND ****'
*M*      GRAND    RANDOM FILE CREATION LOGIC
         DEF      GRAND:            ALLOCATE RANDOM FILE SPACE
GRAND:   EQU      %
         PCC      0
BITS     SET      1
MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM   UTS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*        REFS
         REF      DCT22             INDEX INTO DISCLIMS
         REF      DISCLIMS          SIZE OF ONE DEVICE
         REF      ERFILDA           REPORT 7500 ERROR (BAD FSP)
         REF      FILCFU            POINT DCB TO READ FSP
         REF      FMCHKDA           CHECK CONTENT OF FSP
         REF      GBG               GET PUBLIC FIT GRANULE
         REF      GCYL              GET PUBLIC FIT GRANULE
         REF      GETSNADR          GET # VOLUMES IN SET
         REF      GMB               GET WORKSPACE FOR GZAP
         REF      GNBG              GET PUBLIC RANDOM FILE
         REF      GNPVCYL           GET PRIVATE RANDOM FILE
         REF      GPVCYL            GET PRIVATE FIT GRANULE(S)
         REF      GZAP              GRANULE CLEANER
         REF      GZAPBIT           CLEANING IN PROCESS FLAG IN CFU
         REF      GZAPCFU           GZAP BUFFER ADDR IN CFU
         REF      GZPRIV            BIT IN PRIV TO CLEAN FILES
         REF      INCREMENT%SECTOR  INCR PRIVATE GAVAL FOR FIT
         REF      J:BASE            TEMP STORAGE (WORD 0)
         REF      J:CLS             FLAGS FOR REDSECL TO READ FSP
         REF      J:JIT             GRANULE ACCOUNTING
         REF      JB:PRIV           CHECK CLEANING BIT (GZPRIV)
         REF      PRIVDCB           CHECK FOR PRIVATE FILES
         REF      RAND31            RETURN ADDRESS
         REF      REDSECL           READ FSP, UPDATE GAVAL/NGAVAL,FSP
         REF      RNBG              RELEASE FIT OF UNSUCCESSFUL ATTEMPT
         REF      RNPVCYL           RELEASE PARTIAL ABORTIVE ATTEMPTS
         REF      SETPVI            SET VOLUME INDICATORS FOR GRSUB
         REF      SETVNO            SET VOLUME NUMBER FOR SETPVI
         REF      TMDCRM            GRANULE ACCOUNTING
         REF      TMPDCPK           GRANULE ACCOUNTING
         REF      TMPDPPK           GRANULE ACCOUNTING
         REF      WRTSEC            UPDATE FSP, GAVAL/NGAVAL (PRIVATE)
         REF      Y00FF             EXTENDED RSTORE MASK
         PAGE
*P*      NAME:    GRAND
*P*      PURPOSE: ALLOCATE GRANULES FOR RANDOM FILES
*DO*
*P*      DESCRIPTION:
* GRAND - ALLOCATE GRANULES FOR RANDOM FILES
*         IN THE FOLLOWING PECKING ORDER:
*        PUBLIC:
*                 DCB:RNDEV=0
*                  TRY DP CYL
*                  TRY DP GRANULES
*                  TRY RAD
*                 DCB:RNDEV=7
*                  TRY RAD ONLY
*                 DCB:RNDEV=11
*                  TRY DP CYL
*                  TRY DP GRANULES
*        PRIVATE:
*                 ALLOCATE FROM LAST VOL TO FIRST
*FIN*
*        D4 RETURNS # GRANS GOTTEN
*        SR1 RETURNS FIRST DISC ADDRESS
         PAGE
         LI,R5    BARNDEV
         LB,R0    *R6,R5            DEVICE
         INT,D4   RSTORE,R6         # GRANS
         LW,R3    NLR,R6            EXTENDED RSTORE
         CW,R3    Y08
         BAZ      %+3               NOT IN USE
         AND,R3   Y00FF             GET EXTENDED RSTORE
         OR,D4    R3
         STW,D4   RSTORE,R6         SAVE COMBO
         LW,8     D4
         BGZ      %+5
         MTW,0    FIL1,6            EMPTY MUST BE SCRATCH
         BGEZ     OPRAND3
*E*      ERROR: 14-00
*E*      DESCRIPTION: ATTEMPT TO CREATE ZERO GRANULE RANDOM FILE.
         LI,R0    X'1400'-1
         B        GPRIV41A          OPENER03
         LI,R5    DCBPRIVBIT        DONT CHECK PRIVAATES
         AND,R5   PRIV,R6
         BNEZ     GRANDPRIV
         LI,R4    X'C'
         AND,R4   R0                0=>ANY,1=>RAD,2=>PACK,3=>NOGOOD
         SLS,R4   -2
         LW,R5    FIL1,R6
**   RANDOM FILE ACCOUNTED AGAINST TEMP IF REL OR JOB.
         SLS,R5   -30               (R5)=0,1 - REL; 2 - SAVE; 3 - JOB.
         LH,R5    RRSJTBL,R5        GET OFFSET FROM JIT.TMDCRM.
         SAS,R5   -1                USED AS DOUBLEWORD OFFSET.
         CLM,D4   J:JIT+TMDCRM,R5
         EXU      TEST,R4           CHECK RESULT
         B        GRANDPUB          GO GETETM IF OK
TEST     B        %+4               ANY, TRY BOTH
         BG       RAND50            RAD
         BCS,8    RAND50            PACK, TEST ,OW ORDER
         B        RAND50            WHAAAT..NO CAN DO
         BG       %+3               RAD BAD, TRY PACK
         LI,R0    7                 RAD OK, TRY PACK
         LI,R4    GRANDPUB-RAND50   IF NO PACK GET RAD
         BCS,8    RAND50,R4         NO PACK, 5700 OR GET RAD
         SLS,R0   8                 PACK OK, TRY IT FIRST
         AI,R0    X'B'              THEN RAD
         PAGE
*
*        GET PUBLIC RANDOM FILE
*
GRANDPUB LW,SR1   FIL1,R6
         BGEZ     HG52              IT'S SCRATCH
         PUSH     R0
         LI,R0    X'B'              TRY PACK
         BAL,SR4  GBG
         BNEZ     HG53              GOT IT
         LI,R0    7                 TRY RAD NEXT
         BAL,SR4  GBG
         BNEZ     HG53              OK
         BAL,SR4  GCYL  CYLINDER IS LAST RESORT
         BEZ      RAND50            ERROR 57
         AND,SR1  M24               NEGLECT CYL REMNANT
HG53     LW,R1    CFU,R6
         STW,SR1  SREC,R1           FIT DISK ADDRESS
         PULL     R0
HG52     EQU      %
         BAL,SR4  GNBG              GET WHATEVER
         BNEZ     GPRIV41           GOT IT
         SLS,R0   -8                TRY NEXT
         LW,SR1   R0                IF THERE IS ONE
         BNEZ     HG52
         B        GPRIV41           GIVE UP
*
RRSJTBL  DATA,2   0,0,-2,0          HW TABLE OF TMDCRM OFFSETS.
         PAGE
*
*        GET RANDOM PRIVATE FILE
*
GRANDPRIV RES
         LW,SR1   FIL1,R6
         BGEZ     HG51
HG50     LW,SR1   FILCFU+GAVAL      TRY THE CYLINDER
         BNEZ     FD05              GOT AT LEAST ONE
         BAL,SR4  SPOOLUB           GET FREE SECTOR FROM DELETE FILE
         BNEZ     GFSP              GOT ONE
         BAL,SR4  GPVCYL
         BEZ      RAND50            ERROR 57
         STW,SR1  FILCFU+GAVAL
FD05     MTB,-1   SR1
         BNEZ     SOME%LEFT
         LI,SR1   0
         B        X%GAVAL
SOME%LEFT LI,R2   1
         MTH,2    SR1,R2
         BNC      X%GAVAL
         MTH,-2   SR1,R2
         BAL,R2   INCREMENT%SECTOR
X%GAVAL  XW,SR1   FILCFU+GAVAL
GFSP     RES
         AND,SR1  M24
         LW,R1    CFU,R6
         STW,SR1  SREC,R1
HG51     RES      0
         BAL,0    GETSNADR          GET # VOLS IN 2
         STW,2    J:BASE            AND SAVE FOR LATER REFERENCE
GPRIV15  LI,D3    0                 RESTART POINT, SET NONE IN STACK
         LW,9     RSTORE,6          RESET # TO GET
GPRIV16  LW,3     J:BASE            SET PV INDICATORS TO NEXT VOL#
         BEZ      ER010B            NO VOLS LEFT
         BAL,0    SETVNO
         BAL,15   SETPVI
         LW,15    9                 NUMBER OF GRANS LEFT TO GET
         BAL,11   GNPVCYL           TRY TO GET THEM
         BEZ      RETUM1            FAILED, GIVE BACK WHAT WE GOT
         LB,3     8                 GOT SOME, CONVERT BACK TO GRANS
         MW,15    3
         LSECTA,11 8                MUST CHECK THAT VOLUME CROSSING IS RIGHT
         AI,D3    0                 IF FIRST GET, MAY END ANYWHERE
         BEZ      GPRIV20
         LI,5     BAVDCTX           OTHERWISE, MUST END AT END OF DEVICE
         LB,5     *6,5
         LB,5     DCT22,5           WHICH IS DISCLIMS MINUS
         LW,5     DISCLIMS,5        THE LAST PARTIAL CYLINDER
         SLS,5    -1
         DW,5     3
         MW,5     3
         SW,5     15                CALCULATE PROPER STARTING SCTOR
         SLS,5    1
         CW,11    5
         BNE      RETUM             BLEW IT, TRY AGAIN
GPRIV20  SW,9     15                DID WE GET ENOUGH
         BLEZ     GPRIV40           YES
         MTW,-1   J:BASE            NEED MORE PACKS
         BEZ      RETUM             NONE, GIVE UP
         PUSH     15                SAVE SIZE AND ADDRESS
         PUSH     8                 FOR RELEASE IF NECESSARY
         AI,D3    -2                COUNT PIECES
         B        GPRIV16           GET MORE IF THERE ARE MORE VOLS
RETUM    DW,15    3                 CONVERT TO CYLINDERS
         BAL,11   RNPVCYL           GET RID OF WHAT WE GOT
         MTW,1    J:BASE            STAY WITH SAME VOL IF ANY THERE
RETUM1   MTW,-1   J:BASE            GO TO NEXT IF NONE
         AI,D3    2
         BGZ      GPRIV15           ARE THERE ANY EXTENTS IN STACK
         PULL     8                 YES, RELEASE THEM
         LDCTX,3  8                 SET VN
         BAL,0    SETVNO
         BAL,15   SETPVI            SET UP PV INDICATORS
         PULL     15
         LB,3     8                 GET CYLSZ FOR CONVERSION
         B        RETUM             AND AND HAND THE CYLS BACK
*
*
GPRIV40  MSP,D3   TSTACK            REMOVE RECORD OF OTHER PIECES
GPRIV41  EQU      %
         AND,SR1  M24               DID WE GET ANY
         BNEZ     OPRAND2           WE GOT EM
*E*      ERROR: 01-0B
*E*      DESCRIPTION: CONTIGUOUS SPACE IS NOT AVAILABLE FOR A RANDOM FILE.
ER010B   LI,R0    X'0116'-1         ERROR 010B
         B        GPRIV41A
*E*      ERROR: 57-00
*E*      DESCRIPTION: FILE OVER USER MAX, OR NO GRANULE FOR THE FIT.
RAND50   LI,R0    X'5700'-1         ERROR 57
         B        GPRIV41A
OPRAND2  LW,R3    0,R6
         BAL,SR4  FMCHKDA
         BCR,15   ER010B            THE CAT GOOFED
         CI,R3    X'800'
         BANZ     OPRAND3           IT'S PRIV, NO ACCTG
         LI,R5    X'F'
         AND,R5   R0
         SLS,R5   -3
         AI,R5    TMDCRM
         LW,R3    FIL1,R6
**   RANDOM FILE ACCOUNTED AGAINST TEMP IF REL OR JOB.
         SLS,R3   -30               (R3)=0,1 - REL; 2 - SAVE; 3 - JOB.
         AH,R5    RRSJTBL,R3        ADD IN OFFSET FROM JIT.TMDCRM.
         LCW,D4   RSTORE,R6
         AWM,D4   J:JIT,R5
         LI,R3    TMPDCPK
         CI,R5    TMDCRM
         BL       OPRAND4
         BE       %+2
         LI,R3    TMPDPPK
         LW,R4    J:JIT,R5
         CW,R4    J:JIT,R3
         BGE      OPRAND4
         STW,R4   J:JIT,R3
OPRAND4  LB,3     JB:PRIV           CLEAN GRANULSE IF USER NEEDS IT
         CI,3     GZPRIV
         BAZ      OPRAND3           NO...
         BAL,11   GMB               GET A MONITOR BUFFER
         BEZ      %-1               NONE THERE...
         LCW,9    RSTORE,6          INIIALIZE IT
         SAS,9    1                 # SECTORS TO CLEAN
         SD,10    10                ZAP LAST WRITE SIZE
         LW,12    CFU,6             CFU ADDRESS
         LI,13    0                 QUEUED USER LIST
         LCI      6
         STM,8    *14
         OR,14    GZAPBIT
         LW,1     CFU,6
         STW,14   GZAPCFU,1         PUT IN CFU
         LW,10    14
         BAL,11   GZAP              START WRITING
OPRAND3  LI,R0    -100              A OK
         LW,D4    RSTORE,R6
         STW,D4   CLK,R6
         STW,SR1  CDA,R6
GPRIV41A PUSH     R0
*        RELEASE THE FIT GRAN IF WE GOT ONE BUT NO FILE
         LW,1     CFU,6
         LW,8     SREC,1
         BEZ      RAND31            NOT THERE, NUSTBE SCRATCH
         BIR,0    GPRIV42           GOT A FILE TOO, UPDATE GAVAL FOR PRIVS
         BAL,R0   PRIVDCB
         BANZ     %+4               IF PRIVATE PUT IN GAVAL
         LI,15    1
         BAL,11   RNBG              RELEASE IT, WHATEVER IT IS
         B        RAND31
         LW,9     M24
         STS,8    GAVAL+FILCFU
         MTB,1    GAVAL+FILCFU
GPRIV42  RES
         BAL,R0   PRIVDCB
         BAZ      RAND31            NOT PRIV, EXIT TO OPEN
         LI,D2    0
         LW,D1    FILCFU+FDA
         BAL,R0   REDSECL           UPDATE FILE DIRECTORY GAVAL
         LI,R2    BUFF2+X'100'      ASSUME FULL GRANULE
         LI,R0    X'4000'
         CW,R0    BUFF2+2
         BANZ     %+2               CORRECT
         LI,R2    BUFF2             HALF-GRANULE
         LW,R0    FILCFU+GAVAL
         STW,R0   X'FD',R2
         LW,R0    FILCFU+FSP        UPDATE FSP
         STW,R0   X'FE',R2
         BAL,R0   WRTSEC
         B        RAND31
         PAGE
*F*      NAME: SPOOLUB
*F*      PURPOSE: EXTRACT A DISC ADDRESS FROM FREE SECTOR POOL.
SPOOLUB  LW,D1    FILCFU+FSP        IS THERE A FSP
         BEZ      *SR4              NO
         LI,SR3   FILCFU            YES, SET CFUADDR IN DCB
         XW,SR3   CFU,R6            SAVING OLD
         PUSH     2,SR3
         LI,D2    0                 ATTEMPT TO READ THE GRANULE
         LI,R3    X'500'            DONT CHECK SCR, DONT REPORT
         STS,R3   J:CLS             ERROR, RETURN HERE IF ERROR
         BAL,R0   REDSECL           READ WITH LINK CHECK
         LW,R0    BUFF2             CHECK ERROR FLAG
         BEZ      SPOOL1            O.K.
POSTBAD  LW,SR3   FILCFU+FSP        GET D.A.
         LI,SR1   0                 SUBCODE
         BAL,SR4  ERFILDA           REPORT ERROR
         LI,D4    0                 ZAP FSP
         STW,D4   FILCFU+FSP
         B        SPOOL10
SPOOL1   LH,R3    BUFF2+NAVX        GET COUNT
         CI,R3    3
         BLE      SPOOL2            NONE
         LW,D4    BUFF2-1,R3        GET D.A.
         MTH,-1   BUFF2+NAVX        DECR COUNT
         B        SPOOL3            WRITE OUT FSP
SPOOL2   LW,D4    FILCFU+FSP        USE THIS ONE
         LW,D2    FILCFU+FSP        SET BLINK
         LW,D1    BUFF2+1           GET FLINK
         STW,D1   FILCFU+FSP        IS NEW FSP
         BEZ      SPOOL4            NOT THERE
         LI,R3    X'500'            UPDATE BLINK OF FLINK GRAN
         STS,R3   J:CLS
         BAL,R0   REDSECL
         LI,R0    0
         XW,R0    BUFF2             CHECK ERROR
         BLZ      POSTBAD           ERROR, GIVE UP
SPOOL3   BAL,R0   WRTSEC
SPOOL4   LW,SR1   D4                CHECK RESULT
         BAL,SR4  FMCHKDA
         BCR,15   POSTBAD           NO GOOD
SPOOL10  RES
         PULL     2,SR3
         STW,SR3  CFU,R6            RESTORE CFU ADDRESS
         LW,SR1   D4                SET D.A.
         B        *SR4
         END

