ASMB,R,L,C
      HED LOCF
*     NAME:   LOCF
*     SOURCE: 92064-18071 
*     RELOC:  92064-16061 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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  92064-16061  REV.1650  761115 
* 
      ENT LOCF
      EXT .ENTR 
      SPC 2 
* 
* 
*     LOCF     RETURNS THE CURRENT STATUS OF A
*              RTE FILE TO THE CALLER.
* 
      SPC 1 
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
      SPC 1 
*     CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC)
* 
      SPC 1 
* 
*     W H E R E:
* 
      SPC 1 
*     IDCB     IS THE DATA CONTROL BLOCK FOR THE FILE.
* 
*     IERR     IS THE ERROR CODE RETURN.
*              POSSIBLE CODES ARE:
*            0  -  NO ERROR 
*          -11  -  DCB NOT OPEN 
*          -10  -  NOT ENOUGH PARAMETERS
* 
*     IREC     IS THE RECORD NUMBER OF THE NEXT RECORD. 
* 
*     IRS      IS THE RELATIVE SECTOR OF THE NEXT RECORD./2 
* 
*     IOFF     IS THE OFFSET IN THE SECTOR OF THE NEXT RECORD.
* 
*     JSEC     IS THE NO. OF SECTORS IN THE FILE (OR EXTENT). 
* 
*     JLU      IS THE FILE'S LOGICAL UNIT.
* 
*     JTY      IS THE FILE'S TYPE.
* 
*     JREC     IS THE RECORD SIZE.
* 
      SPC 1 
*     ALL PARAMETERS AFTER IREC ARE OPTIONAL. 
* 
      SKP 
LOCF  NOP 
      LDA DFDM      RESET PARMS 
      STA IREC
      STA JLU 
      STA JTY 
      LDA LOCF
      STA DOCF
      JMP DOCF+1
* 
DCB   NOP 
IER   DEF DM
IREC  DEF DM
IRS   DEF DM
IOFF  DEF DM
JSEC  DEF DM
JLU   DEF DM
JTY   DEF DM
JREC  DEF DM
DOCF  NOP           ENTRY 
      JSB .ENTR     GET 
DFDCB DEF DCB       PARAMETERS ADDRESSES
      LDA N10       NOT ENOUGH
      LDB IREC      PRAM
      CPB DFDM      TEST
      JMP EXIT      NOT ENOUGH - EXIT 
      LDA DCB       SET A TO GET DCB
      ADA .3
      STA LU
      ADA .6
      STA OPCLS 
      ADA .5
      STA REC 
* 
* 
      LDB OPCLS,I   IS
      LDA N11        FILE 
      CPB XEQT        OPEN? 
      JMP OK           YES; JUMP
EXIT  STA IER,I     NO; SET EXIT CODE 
      JMP DOCF,I    EXIT
      SPC 3 
OK    LDB REC,I   GET AND 
      STB IREC,I    SET RECORD NO.
      LDA LU,I      FETCH LU
      AND B77        ISOLATE LU 
      STA JLU,I 
      CCB           PRESET FOR CARTRIDGE TAPE FILE
      LDA DCB,I     FETCH TYPE
      CPA DUMMY     IF LU OPEN(A=177400B) THEN
      CLB                RETURN A ZERO
      STB JTY,I 
* 
*ALL DONE--EXIT 
* 
      CLA 
      JMP EXIT
* 
      SKP 
LU    NOP 
OPCLS NOP 
REC   NOP 
DM    NOP 
DFDM  DEF DM
* 
B77   OCT 77
DUMMY OCT 177400
N10   DEC -10 
N11   DEC -11 
.3    OCT 3 
.5    OCT 5 
.6    OCT 6 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                                                                                      