SPL,L,O,M 
!     NAME:   DR.RD 
!     SOURCE: 92071-18059 
!     RELOC:  92071-16059 
!     PGMR:   E.D.B.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME DR.RD(7) "92071-1X059 REV.2041 800623" 
! 
!  EXTERNAL SUBROUTINES 
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET MSS.      BE SUBROUTINE,EXTERNAL
! 
!  EXTERNAL FUNCTIONS 
      LET CR.LU     BE FUNCTION,EXTERNAL
      LET GTOPN     BE FUNCTION,EXTERNAL
! 
!  EXTERNAL LABELS
      LET FM.AB     BE LABEL,EXTERNAL 
! 
!  EXTERNAL INTEGERS
      LET O.BUF     BE INTEGER,EXTERNAL 
! 
!  GLOBAL INTEGERS
      LET DS.LU     BE INTEGER,GLOBAL            !DISC LU 
      LET D.LT      BE INTEGER,GLOBAL            !DISC LAST TRACK 
      LET D.LB      BE INTEGER,GLOBAL            !DISC LABEL
      LET D.LK      BE INTEGER,GLOBAL            !DISC LOCK 
      LET DISBL     BE INTEGER,GLOBAL            !DISC CURRENT BLOCK
      LET DISNT     BE INTEGER,GLOBAL            !DISC NUMBER DIR TRACKS
      LET DS.SC     BE INTEGER,GLOBAL            !DISC SECTORS / TRACK
      LET DFMT      BE INTEGER,GLOBAL            !DISC SECTOR SKIP
! 
!  GLOBAL BUFFERS 
      LET PK.DR(128)BE INTEGER,GLOBAL            !DR.RD BUFFER
! 
!  INTERNAL CONSTANTS 
      LET WRIT      BE CONSTANT (2)              !WRITE EXEC REQUEST
! 
DR.RD:SUBROUTINE(RCOD,DISID,BLK) FEXIT,GLOBAL 
! 
!     DR.RD TRANSFERS A DIRECTORY BLOCK (SPECIFIED BY BLK)
!     BETWEEN A CARTRIDGE (SPECIFIED BY DISID) AND AN INTERNAL
!     BUFFER (DETERMINED BY RCOD).
!     FEXIT IS TAKEN IF THE CARTRIDGE CANNOT BE FOUND OR IF THE END 
!     OF THE DIRECTORY IS REACHED.
! 
!     DETERMINE WHICH BUFFER TO USE 
! 
      IF [RWCD_ RCOD] < 0 THEN [                 \IF WRITE FROM O.BUF 
          RWCD_ -RCOD;                           \THEN FIX RWCD 
          DBUF_ @O.BUF],                         \USE O.BUF 
          ELSE DBUF_ @PK.DR                      !ELSE USE PK.DR
! 
!     IF REQUESTING A BLOCK BEYOND THE FIRST, ASSUME THAT 
!     DR.RD HAS BEEN CALLED WITH THE DISID BEFORE.
! 
      IFNOT BLK THEN [                           \IF BLOCK ZERO,
          IFNOT CR.LU(DISID,DS.LU,D.LT,D.LB,D.LK) \CONVERT DISID TO LU
              THEN FRETURN;                      \AND IF NOT FOUND, ERROR 
          PDSLU_ DS.LU + 7700K;                  \MAKE PROTECTED DISC LU
          TR_ D.LT;                              \USE THE LAST TRACK
          SC_ 0],                                \AND SECTOR 0
      ELSE [                                     \IF PAST BLOCK ZERO, 
          TR_ (BLK*DFMT)/DS.SC; SC_.B.;          \SET TRACK AND SECTOR
          TR_ TR/(DFMT->1);                      \GET RELATIVE TRACK
          IF (TR+DISNT)> -1 THEN FRETURN;        \IF OUT OF RANGE, ERROR
          TR_ D.LT-TR]                           !SET THE TRACK ADDRESS 
! 
!     IF WRITE REQUEST, DISC MUST BE LOCKED TO USER 
! 
      IF RWCD=WRIT THEN [                        \IF WRITE
          IF D.LK#GTOPN THEN [                   \AND NOT LOCKED
              MSS.(61);                          \THEN PRINT MESSAGE
              GOTO FM.AB]]                       !AND ABORT 
! 
!     DO ACTUAL DISC TRANSFER 
! 
      EXEC(RWCD,PDSLU,$DBUF,128,TR,SC)
! 
!     CHECK FOR ERRORS
! 
      DO [BREG_.B.;                              \CHECK FOR ERRORS
          IF BREG#128 THEN [                     \IF NOT ALL TRANSFERRED, 
              MSS.(1,DS.LU);                     \PRINT MESSAGE 
              GOTO FM.AB]]                       !AND ABORT 
! 
      IFNOT BLK THEN [                           \IF FIRST BLOCK, 
          DISNT_ $(DBUF+8);                      \SET # OF DIRECTORY TRACKS 
          DS.SC_ $(DBUF+6) AND 377K;             \ISOLATE AND SET # SECTORS 
          DFMT_ ($(DBUF+6)->8) AND 377K;         \SAVE SECTOR SKIP INFO 
          IFNOT DFMT THEN DFMT_ 14]              \DEFAULTS TO 14 (7 BLOCKS) 
! 
      DISBL_ BLK                                 !SET CURRENT BLOCK 
      RETURN                                     !AND RETURN
      END 
! 
      END 
      END$
                                                                                                                          