SPL,L,O,M 
!     NAME:   FM.UT 
!     SOURCE: 92067-18154 
!     RELOC:  92067-16125 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 FM.UT(8) "92067-16125 REV.1903 790515" 
! 
      LET EXEC,MSS.,RMPAR       BE SUBROUTINE, EXTERNAL 
      LET SESSN,ISMVE,FSTAT     BE SUBROUTINE, EXTERNAL 
      LET LUTRU                 BE FUNCTION,   EXTERNAL 
      LET D.RIO,DR.RD,DR.SU     BE SUBROUTINE 
      LET FM.AB                 BE LABEL,EXTERNAL 
      LET MSC.                  BE FUNCTION            ! CHECKS MAS SEC CODE
      LET IFLG.                 BE INTEGER,EXTERNAL    ! FMGR INITIALIZATION? 
      LET OVRD.                 BE INTEGER,EXTERNAL    ! DISC ACCESS OVERRIDE 
      LET PK.DR                 BE INTEGER(128),GLOBAL ! FILE DIRECT BUFFER 
      LET D.SDR                 BE INTEGER(256),GLOBAL ! DISC DIRECT BUFFER 
      LET DS.LU,D.LT,D.LB       BE INTEGER,GLOBAL      ! CUR DISC'S LU,LTR,CRN
      LET D.                    BE INTEGER,EXTERNAL    ! D.RTR
      LET DS.DF,DS.F1           BE INTEGER,GLOBAL      ! IN-CORE FLAGS
      LET DT(5)                 BE INTEGER             ! RETURN PARMS ARRAY 
      LET D.STR(2)              BE INTEGER             ! DATA TRACK ADDRESS 
      LET USRID(2)              BE INTEGER             ! USER, GROUP IDS
! 
      ASSEMBLE ["EXT $CL1";"EXT $CL2";"EXT $SMID"]
! 
      INITIALIZE DS.DF,DS.F1  TO 0,0
      LET READI               BE CONSTANT(1     ) 
      LET XEQT                BE CONSTANT(1717K)
      LET TEMP                BE CONSTANT(1721K)
      LET PRC                 BE CONSTANT(74000K) 
      LET TATSD               BE CONSTANT(1756K)
      LET WRIT                BE CONSTANT(2  )
      LET A                   BE CONSTANT (0) 
      LET B                   BE CONSTANT (1) 
! 
! 
D.RIO:SUBROUTINE(RCODE) GLOBAL
! 
!  D.RIO READS/WRITES THE DISC DIRECTORY (256 WORDS)
!  TO/FROM BUFFER D.SDR 
! 
       IF DS.DF THEN [IF RCODE = READI THEN RETURN]!  CHECK IN-CORE FLAG
! 
!  GET TRACK AND SECTOR ADDRESS OF DISC DIRECTORY 
! 
       ASSEMBLE ["LDA $CL1";"STA CL1";"LDA $CL2";"STA CL2"] 
! 
       IFNOT IFLG. THEN[\ 
           IF RCODE = WRIT THEN[\           !  USE D.RTR TO WRITE THE CL
               DR.SU(D.SDR,-65,100000K,7);\ 
               GO TO DIR02]]
! 
DIRO: EXEC(RCODE,74002K,D.SDR,256,CL1,CL2)!    WRITE/READ THE BLOCK 
      BREG_$B                               !  IF TLOG # 256 THEN ERR 
      IF BREG#256 THEN [MSS.(1001,2); GOTO FM.AB] 
! 
DIR02:DS.DF_1                               !  SET IN-CORE FLAG 
      RETURN                                !  AND RETURN 
      END 
! 
! 
DR.RD:SUBROUTINE(RCOD,DISID,BLK)FEXIT,GLOBAL
! 
!     THIS SUBROUTINE READS/WRITES THE DIRECTORY BLOCK SPECIFIED
!     BY BLK FROM THE DISC IDENTIFIED BY DISID.  FEXIT IS TAKEN 
!     IF THE DISC CANNOT BE FOUND OR IF THE END OF THE DIRECTORY
!     IS REARCHED 
! 
!     FRETURN IS TAKEN IF THE DISC IS NOT MOUNTED IN THE CL OR IF 
!     THE ID ON THE DISC DOES NOT MATCH THE 7777K OR THE CALLER'S 
!     PRIVATE OR GROUP ID OR IF THE DISC IS NOT IN CALLER'S SST.
!     IF THE DISC IS NOT IN THE CALLER'S SST THE A-REG WILL BE 0
!     ON THE FRETURN.  OTHERWISE THE A-REG WILL BE -1 ON THE FRETURN. 
!     THIS IS CHECKED BY DL.. 
! 
! 
! 
      ASSEMBLE ["LDA $SMID";"STA SMID"] 
      NOABT _ 100000K 
! 
      IF DISID = DS.F1 THEN[\               !  DISC'S DL IN CORE & WRITING
          IF RCOD = WRIT THEN[\             !  BLOCK 0 SO SKIP READ 
              IFNOT BLK THEN GO TO DIRR2];\ 
          GO TO DRRD1]
! 
      CALL SESSN($XEQT)?[USRID(1),USRID(2)_0;\ !  GET SESSION WORD
          GO TO DIR1] 
      BREG_$B                               !  IF NOT IN SESSION SKIP ISMVE 
      CALL ISMVE(BREG,SMID,USRID,2)         !  GET USER ID
! 
DIR1: D.RIO(READI)                          !  READ CARTRIDGE DIRECTORY 
! 
!     SCAN CL AND COMPARE DISID TO LU OR CRN IN EACH ENTRY
!     MAKE SURE THAT ID FOR ENTRY MATCHES EITHER PRIVATE
!     GROUP OR SYSTEM ID. 
! 
      IF DISID>0 THEN GO TO DIR2
! 
      FOR I_0 TO 252 BY 4 DO[\
          SID_($(@D.SDR+I+3));\ 
          IF ($(@D.SDR+I) AND 377K) = -DISID THEN[\ 
              IF ((USRID(1)=SID) OR (USRID(2)=SID) OR (7777K=SID)\
                  OR (USRID(1)=7777K)) THEN GO TO DIR0]]
! 
! 
DIR2: FOR SMFLG_0 TO 1 DO[\ 
          FOR I_0 TO 252 BY 4 DO[\
              SID_($(@D.SDR+I+3));\ 
              IF $(@D.SDR+I+2) = DISID THEN[\ 
                  IF ((USRID(1)=SID) OR (USRID(2)=SID) OR (7777K=SID)\
                  OR ((SMFLG=1) AND (USRID(1)=7777K))) THEN GO TO DIR0]]] 
! 
      .A._-1
      GO TO EXITF 
! 
DIR0: IF (LUTRU($(@D.SDR+I) AND 377K) # -1) THEN GO TO DIRR0
      .A._0 
EXITF:FRETURN 
! 
EREX:  MSS.(-1032,$DS.LU AND 377K)
       GOTO FM.AB 
! 
!      THE DISID HAS BEEN FOUND SO READ IN BLK0 
! 
DIRR0:D.LB_[D.LT_[DS.LU_@D.SDR+I]+1]+1      !  SET POINTERS TO CRN,LTR,LU 
! 
DIRR6:IF RCOD=WRIT THEN[\                   !  IF WRITING BLK 0, SKIP 
          IFNOT BLK THEN GO TO DIRR2]       !  FURTHER READ OF DIRECTORY
      EXEC(NOABT+READI,($DS.LU AND 377K)+PRC,PK.DR,128,$D.LT,0) 
      GOTO EREX                             !  DRIVER REJECTED CALL.
      BREG_$B 
      IF BREG#128 THEN[\
          MSS.(1001,$DS.LU AND 377K);\
          GO TO FM.AB]
! 
DIRR2:DS.F1_DISID                           !  SET UP DISC ID,
      DISBL_0                               !  THE CURRENT BLOCK, 
      DISNT_$(@PK.DR+8)                     !  THE # OF DIRECTORY TRACKS, 
      DS.SC_$(@PK.DR+6)AND 377K             !  NUMBER OF SECTORS, 
! 
      IF (BLK=0) AND (RCOD=READI) THEN GO TO EXIT 
! 
!     CALCULATE THE SECTOR ADDRESS
! 
DRRD1:TR_(BLK*14)/DS.SC 
      T_$1                                  !  SAVE IN T
      TR_TR/7 
      IF (TR+DISNT)> -1 THEN[\
          .A._-1;\
          GO TO EXITF]
      TR_$D.LT-TR                           ! SAVE TRACK ADDRESS IN TR
! 
!     READ/WRITE
! 
      IFNOT IFLG. THEN[\                     !  USE D.RTR TO WRITE DL SECTOR
           IF RCOD = WRIT THEN [\            !  IF WRITING AND NOT FMGR 
                DR.SU(PK.DR,DISID,BLK,9);\   !  INITIALIZATION
                GO TO EXIT]]
! 
DRRD4:EXEC(NOABT+RCOD,PRC+($DS.LU AND 377K),PK.DR,128,TR,T) 
      GOTO EREX                             !  DRIVER REJECTED CALL 
      BREG_$B                               !  TEST FOR ERRORS
      IF BREG#128 THEN[\
          MSS.(1001,$DS.LU AND 377K);\
          GO TO FM.AB]
! 
EXIT: RETURN
      END 
! 
! 
DR.SU:SUBROUTINE(BUF,ID,RS,CD)
! 
!     THIS ROUTINE WRITES ON THE DISC DIRECTORY BY: 
!        CALLING THE SYSTEM FOR ONE TRACK 
!        WRITING THE SECTOR THERE 
!        PASSING THE TRACK TO D.RTR 
!        RETURNING THE TRACK
! 
!     IT WRITES A SECTOR ON THE FILE DIRECTORY BY 
!        CALLING D.RTR PASSING THE 128 WORD SECTOR
!        USING STRING PASSAGE 
! 
      IF CD#7 THEN[\
           STBUF_@PK.DR;\                   !  PASS BUFFER PK.DR AS A 128 
           L_128;\                          !  WORD STRING; SKIP DATA TRACK 
           GO TO DRSU2],\                   !  STUFF
      ELSE[\
           STBUF_@D.STR;\                   !  DATA TRACK WITH ADDRESS IN 
           L_2]                             !  IN D.STR 
      EXEC(4,1,TR,LU,FLG)                   !  GET SYSTEM TRACK 
      DO[D.STR(1)_LU; D.STR(2)_TR]          !  SAVE ITS ADDRESS IN ARRAY
! 
DRSU0:EXEC(2,LU,BUF,256,TR,0)               !  WRITE THE SECTOR 
      BREG_$B 
      IF BREG#256 THEN[\
          MSS.(1001,LU);\ 
          GO TO FM.AB]
! 
DRSU2:EXEC(23,D.,$XEQT,CD+OVRD.,ID,RS,0,$STBUF,L) !  CALL D.RTR TO WRITE THE SECT 
      IF CD=7 THEN EXEC(5,1,TR,LU)          !  RETURN THE TRACK 
      RMPAR(DT) 
      IF DT(1) THEN [MSS.(DT);GO TO FM.AB]  !  IF ERRORS ABORT
      RETURN
      END 
      END 
      END$
                                                                                                      