ASMB,R,L,C
*     NAME:   LOCF
*     SOURCE: 92070-18045 
*     RELOC:  92070-16045 
*     PGMR:   G.A.A.
*     MOD:    M.L.K.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
* 
      NAM LOCF,7  92070-1X045 REV.2001  800103  
* 
      HED LOCF
      ENT LOCF,ELOCF
      EXT P.PAS,.ENTR,GTOPN 
      SUP 
      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 
ELOCF NOP           DOUBLE WORD ENTRY POINT 
      CCA           SET DOUBLE WORD FLAG
      LDB ELOCF     AND GET RETURN ADDRESS
      JMP SETUP     GO FINISH SET UP
      SPC 3 
LOCF  NOP 
      CLA           CLEAR DOUBLE WORD FLAG
      LDB LOCF      GET RETURN ADDRESS
SETUP STA DBLWD     STORE DBL FLAG
      STB DOCF      STORE RETURN ADDRESS
      LDA DFDM
      STA IER 
      STA IREC
      STA IRS 
      STA IOFF
      STA JSEC
      STA JLU 
      STA JTY 
      STA JREC
      JMP DOCF+1
      SPC 3 
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 
      DEF DCB       PARAMETERS ADDRESSES
      LDA N10       NOT ENOUGH
      LDB IREC      PRAM
      CPB DFDM      TEST
      JMP EXIT      NOT ENOUGH - EXIT 
* 
      ISZ DBLWD     TEST DOUBLE FLAG
      JMP SINGL     SINGLE WORD ENTRY 
      CLA           STORE UPPER BITS
      STA IREC,I    AS ZERO IN
      STA IRS,I     DOUBLE WORD 
      STA JSEC,I    PARAMETERS
      ISZ IREC      THEN POINT THEM 
      ISZ IRS       TO THE SECOND 
      ISZ JSEC      HALF OF THE INTEGER 
* 
SINGL LDA DCB       SET A TO GET DCB
      CLB,CCE       SET TO GET
      ERB,CLE       ACTUAL WORDS
      JSB P.PAS     CALL TO PASS
N16   DEC -16       DCB 
LU    NOP            PARAMETERS 
AD    NOP 
TYP   NOP 
TRK   NOP 
SEC   NOP 
#SEC  NOP 
SIZE  NOP 
COUNT NOP 
SEC/T NOP 
OPCLS NOP 
CTRK  NOP 
CSEC  NOP 
BUFPT NOP 
TMP   NOP 
REC   NOP 
EXNO  NOP 
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1       IS IT THE SAME AS IN DCB? 
      CPA OPCLS 
      JMP OK        YES, IT IS OPEN 
      LDA N11       NO, SET ERROR -11 
EXIT  STA IER,I     NO; SET EXIT CODE 
      JMP DOCF,I    EXIT
      SPC 3 
OK    LDB REC       GET AND 
      STB IREC,I    SET RECORD NO.
      LDB #SEC      SET 
      STB JSEC,I    THE FILE SIZE IN SECTORS
      LDA TYP       GET THE TYPE
      CMA,INA,SZA,RSS    SET NET AND TEST FOR ZERO
      JMP TYPST     ZERO SO JUMP
      ADA .2        IF THREE OR GREATER 
      SSA           THEN
      JMP NOTRA     JUMP  NOT RANDOM ACCESS 
      CCA           COMPUTE THE OFFSET
      ADA REC       AND  BLOCK
      MPY SIZE      FOR 
      STA TMP       TYPE
      AND B177      ONE AND 
      STA IOFF,I    TWO 
      XOR TMP       FILES 
      ASR 7         NOW 
      JMP STRS      GO STORE IT 
NOTRA LDA DCB       COMPUTE 
      CMA,INA       CURRENT 
      ADA BUFPT     BUFFER OFFSET 
      ADA N16       ADJUST FOR BUFFER ADDRESS 
      CLB           RE ADDJUST OFFSET TO
      DIV .128      128 WORD BLOCK BASE 
      STB IOFF,I
      STA TMP       SAVE OVERFLOW 
      LDA #SEC      GET AND 
      CLE,ERA       DIVIDE BY TWO TO GET BLOCKS 
      MPY EXNO      COMPUTE EXTENT OFFSET 
      STA EXNO        AND SAVE
      LDA TRK       COMPUTE RELATIVE
      CMA,INA       SECTOR
      ADA CTRK      CTRK-TRK
      MPY SEC/T     (CTRK-TRK)*#SEC/TRACK 
      LDB SEC 
      CMB,INB 
      ADA B         (CTRK-TRK)*#S/TR-SEC
      ADA CSEC      (CTRK-TRK)*#S/TR-SEC+CSEC 
      CLE,ERA       CONVERT TO BLOCKS 
      ADA EXNO      ADD #BLOCKS IN PREVIOUS EXTENTS 
      ADA TMP       ADD THE BLOCK OVER FLOW 
STRS  STA IRS,I     AND PASS TO CALLER
TYPST LDB TYP       GET AND SET 
      STB JTY,I     TYPE
      LDA LU        GET LU (DISC FILE)
      SZB,RSS       IS IT A DISC FILE?
      LDA TRK       NO; USE TYPE 0 LU 
      AND B77       MASK
      STA JLU,I     AND SET 
      LDA SIZE      GET THE RECORD
      STA JREC,I    SIZE AND SET IT 
      CLA           NO ERRORS 
      JMP EXIT      RETURN
      SPC 4 
B177  OCT 177 
.128  DEC 128 
.2    DEC 2 
N10   DEC -10 
N11   DEC -11 
B77   OCT 77
DFDM  DEF *+1 
DM    NOP           \ THESE TWO ARE DUMMIES (TWO FOR
      NOP           /    DOUBLE INTEGER)
DBLWD NOP           DOUBLE WORD FLAG
A     EQU 0 
B     EQU 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                