ASMB,R,L,C
      HED (FMP) LOCF: RETRIEVE FILE STATUS AND POSITION 
*     NAME:   LOCF
*     SOURCE: 92071-18045 
*     RELOC:  92071-16045 
*     PGMR:   G.A.A.
*     MOD:    M.L.K., 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.       *
*  ***************************************************************
* 
      NAM LOCF,7 92071-1X045 REV.2041 800905
* 
      ENT LOCF,  ELOCF
* 
      EXT GTOPN, CV.RB
      EXT .ENTR, $SETP
* 
      EXT F.DCB, F.LU,  F.TYP, F.SIZ, F.RCL 
      EXT F.FLG, F.RCN, F.DLU 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     LOCF RETURNS THE CURRENT STATUS OF A
*          RTE FILE TO THE CALLER.
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL LOCF(IDCB,IERR,IREC,IRB,IOFF,JSEC,JLU,JTY,JREC)
* 
*     WHERE:
* 
*     IDCB   IS THE DATA CONTROL BLOCK FOR THE FILE 
* 
*     IERR   WILL BE THE ERROR RETURN CODE
* 
*     IREC   WILL BE THE RECORD NUMBER OF THE NEXT RECORD 
* 
*     IRB    WILL BE THE RELATIVE BLOCK OF THE NEXT RECORD
*            (OPTIONAL) 
* 
*     IOFF   WILL BE THE WORD OFFSET OF THE NEXT RECORD (OPTIONAL)
* 
*     JSEC   WILL BE THE FILE'S EXTENT SIZE (IN SECTORS) (OPTIONAL) 
* 
*     JLU    WILL BE THE FILE'S LOGICAL UNIT NUMBER (OPTIONAL)
* 
*     JTY    WILL BE THE FILE'S TYPE (OPTIONAL) 
* 
*     JREC   WILL BE THE FILE'S RECORD LENGTH (OPTIONAL)
* 
*     POSSIBLE ERRORS:
* 
*       0  NO ERROR 
*     -11  DCB NOT OPEN 
*     -10  NOT ENOUGH PARAMETERS
      SKP 
* 
*     ENTRY 
* 
ELOCF NOP           DOUBLE WORD ENTRY POINT 
      CCA           SET DOUBLE WORD FLAG
      LDB ELOCF     AND GET RETURN ADDRESS
      JMP SETUP     GO FINISH SET UP
* 
LOCF  NOP 
      CLA           CLEAR DOUBLE WORD FLAG
      LDB LOCF      GET RETURN ADDRESS
* 
SETUP STA DBLWD     STORE DBL FLAG
      STB DOCF      STORE RETURN ADDRESS
      LDA DDUM
      STA IREC
      STA IRB 
      STA IOFF
      STA JSEC
      STA JLU 
      STA JTY 
      STA JREC
      JMP DOCF+1
* 
IDCB  NOP 
IERR  NOP 
IREC  DEF DUM 
IRB   DEF DUM 
IOFF  DEF DUM 
JSEC  DEF DUM 
JLU   DEF DUM 
JTY   DEF DUM 
JREC  DEF DUM 
* 
DOCF  NOP           ENTRY 
      JSB .ENTR     GET 
      DEF IDCB      PARAMETERS ADDRESSES
* 
      LDB IREC      PRAM
      CPB DDUM       TEST 
      JMP ER10        NOT ENOUGH - EXIT 
* 
      LDA IDCB      SET UP POINTERS INTO DCB
      LDB F.DCB 
      JSB $SETP 
      DEF .16 
      NOP 
* 
      JSB GTOPN     GET PROGRAM'S OPEN FLAG 
      DEF *+1 
      CPA F.FLG,I   IS IT THE SAME AS IN DCB? 
      RSS 
      JMP ER11      NO, TAKE ERROR EXIT 
      SKP 
* 
*     PROCESS REQUEST 
* 
      LDA F.TYP,I   GET THE TYPE
      SZA,RSS       IS IT ZERO? 
      JMP TYPST      YES, JUMP
* 
      ADA N3        NOW TEST IF TYPE 3
      SSA           IF NOT TYPE 3,
      JMP RALOC      THEN LOCATE RANDOM ACCESS
* 
      JSB CV.RB     COMPUTE CURRENT LOCATION
      JMP STRS
* 
RALOC CCA           SUBTRACT ONE
      ADA F.RCN,I    FROM RECORD NUMBER 
      CLB 
      MPY F.RCL,I   MULTIPLY BY RECORD LENGTH 
      DIV .128       DIVIDE BY WORDS / BLOCK
* 
STRS  STA IRB,I     GIVE RELATIVE BLOCK TO CALLER 
      STB IOFF,I    GIVE WORD OFFSET TO CALLER
* 
TYPST LDB F.TYP,I   GET FILE TYPE AGAIN 
      STB JTY,I      AND GIVE TO CALLER 
* 
      LDA F.LU,I    GET DISC FILE LU
      SZB,RSS       IF NOT DISC FILE? 
      LDA F.DLU,I    THEN USE DEVICE LU 
      AND B77       ISOLATE LU
      STA JLU,I      AND GIVE TO CALLER 
* 
      LDA F.RCL,I   GET THE RECORD LENGTH 
      STA JREC,I     AND GIVE TO CALLER 
* 
      ISZ DBLWD     TEST DOUBLE WORD FLAG 
      JMP SINGL      DO 16-BIT STORES 
* 
      CLA           CLEAR UPPER 16 BITS OF DOUBLE INTEGERS
      LDB F.RCN,I 
      DST IREC,I
      LDB F.SIZ,I 
      DST JSEC,I
      LDB IRB,I 
      DST IRB,I 
      JMP EXIT      RETURN
* 
SINGL LDB F.RCN,I 
      STB IREC,I
      LDB F.SIZ,I 
      STB JSEC,I
      SKP 
* 
*     EXIT
* 
EXIT  CLA           NO ERROR INTENDED 
      JMP EREX
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
* 
ER11  LDA N11       FILE NOT OPEN 
* 
EREX  STA IERR,I    SAVE ERROR
      JMP DOCF,I     AND RETURN 
      SKP 
* 
*     STORAGE AREA
* 
.16   DEC 16
.128  DEC 128 
* 
N3    DEC -3
N10   DEC -10 
N11   DEC -11 
* 
B77   OCT 77
* 
DDUM  DEF DUM 
* 
DBLWD NOP           DOUBLE WORD FLAG
* 
DUM   NOP           DUMMY RETURN ADDRESS
      NOP            (TWO WORDS)
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                                                                                                                                                                                      