         DEF      GRAND:
GRAND:   EQU      %
         PCC      0
*  NEW UTS MODULE TO CREATE A RANDOM FILE
ANSPROC  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
         DEF      GRAND
         SPACE    3
         REF      DCT4,GETSNADR,HGP,J:BASE,J:JIT
         REF      M24,RAND31,Y08
         REF      GNBG,GNCYL,RNCYL,RNPVCYL,M8
         REF      GNPVCYL
         REF      DCT22
         REF      DCT23
         REF      DCTSIZ
         REF      DISCLIMS
         REF      SETPVI,SETVNO
* GRAND - ALLOCATE GRANULES FOR RANDOM FILES
*         IN THE FILLOWING MANNER:
*        PUBLIC:
*                 R0=0
*                  TRY RAD
*                  TRY DP CYL
*                  TRY DP GRANULES
*                 R0=7
*                  TRY RAD ONLY
*                 R0=X'B'
*                  TRY DP CYL
*                  TRY DP GRANULES
*        PRIVATE:
*                 TRY STARTING ON VOLUME N, THEN N-1, ... THEN VOL 1
*        D4 RETURNS # GRANS GOTTEN
*        R0 RETURNS DEVICE GOTTEN ON
*        SR1 RETURNS FIRST DISC ADDRESS
         PAGE
GRAND    EQU      %
         REF      TMDCRM,TMPDCPK,TMPDPPK
         REF      FILCFU,INCREMENT%SECTOR
         REF      GBG,GCYL,REDSECL,WRTSEC
         REF      GPVCYL
         REF      PRIVDCB
         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
         REF      Y00FF
         OR,D4    R3
         STW,D4   RSTORE,R6         SAVE COMBO
         LW,8     D4
         BGZ      %+5
         MTW,0    FIL1,6            EMPTY MUST BE SCRATCH
         BGEZ     OPRAND3
         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
         SAS,R5   -31               -1 FOR SAVE, 0 FOR TEMP
         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
         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  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
         AND,SR1  M24
         LW,R1    CFU,R6
         STW,SR1  SREC,R1
HG51     RES      0
         LW,9     15                TEMP COUNTER
         LW,10    15                RESET NUMBER
         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     10                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
         LW,D4    SR3               CALCULATE TOTAL ALLOCATED
         SW,D4    SR2               #WE STARTED WITH + # WE OVERSHOT
GPRIV41  EQU      %
         STW,D4   RSTORE,R6         AND SET NEW RSTORE
         AND,SR1  M24               DID WE GET ANY
         BNEZ     OPRAND2           WE GOT EM
ER010B   LI,R0    X'0116'-1         ERROR 010B
         B        GPRIV41A
RAND50   LI,R0    X'5700'-1         ERROR 57
         B        GPRIV41A
OPRAND2  LW,R3    0,R6
         BAL,SR4  FMCHKDA
         REF      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
         BGEZ     %+2
         AI,R5    -2
         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
         REF      GZAP,GZAPCFU,GZAPBIT
         REF      GZPRIV
         REF      JB:PRIV
         REF      GMB
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
         REF      RNBG
         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    *TSTACK           GET COMPLETION (NEG IF YES)
         AND,R0   FIL1,R6           AND SAVE BIT(ALSO NEG IF YES)
         BGEZ     %+2               COUNT FIT IF BOTH TRUE
         MTW,1    X'FB',R2          INCR # FITS
         BAL,R0   WRTSEC
         B        RAND31
         SPACE    3
         SPACE    5
         END

