ASMB,R,L,C,Q
      HED LOCF
*     NAME:   LOCF
*     SOURCE: 92067-18136 
*     RELOC:  92067-16125 
*     PGMR:   G.A.A.,N.J.S. 
* 
*  ***************************************************************
*  * (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 92067-16125 REV.1903 781110
      ENT LOCF,ELOCF
      EXT P.PAS,.ENTR 
      EXT .DDE, .DMP, .DAD
* 
* 
* 
* 
*     LOCF     RETURNS THE CURRENT STATUS OF A
*              RTE FILE TO THE CALLER.
* 
* 
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
* 
*     CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC)  OR
*     CALL ELOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) 
* 
* 
* 
*     W H E R E:
* 
* 
*     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
*          -30  -  VALUE TOO LARGE FOR PARAMETER
* 
*     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.
* 
* 
*     ALL PARAMETERS AFTER IREC ARE OPTIONAL. 
* 
* 
*     FOR LOCF CALLS, IREC, IRB, JSEC ARE SINGLE WORD INTEGERS. 
*     FOR ELOCF CALLS, IREC, IRB, JSEC ARE DOUBLE WORD INTEGERS.
* 
      SKP 
* 
* 
ELOCF DEC -1
      LDA ELOCF 
      STA LOCF
      JMP LOCF+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
* 
LOCF  NOP           ENTRY 
      JSB .ENTR     GET 
DFDCB DEF DCB       PARAMETER ADDRESSES 
* 
      LDA N10       TEST FOR
      LDB IREC       NOT ENOUGH 
      CPB DFDM        PARAMETERS
      JMP EXIT      NOT ENOUGH - EXIT 
      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 
TMP   NOP 
TYP   NOP 
TRK   NOP 
SEC   NOP 
#SEC  NOP 
SIZE  NOP 
COUNT NOP 
SEC/T NOP 
OPCLS NOP 
CTRK  NOP 
CSEC  NOP 
BUFPT NOP 
REC1  NOP 
REC   NOP 
EXNO  NOP 
* 
      LDB OPCLS     IS
      LDA N11        FILE 
      CPB XEQT        OPEN? 
      JMP OK           YES; JUMP
EXIT  STA IER,I     NO; SET EXIT CODE 
      LDB N9        SET UP
      STB COUNT      AND
      LDB DFDCB       RESTORE 
      STB TMP          DUMMY
      LDB DFDM          PARAMETER 
      STB TMP,I          ADDRESSES
      ISZ TMP 
      ISZ COUNT           IN
      JMP *-3              CALL 
      CCB           RESET LOCF\ELOCF
      STB ELOCF      FLAG 
      JMP LOCF,I    EXIT
* 
* 
* 
OK    LDA #SEC      GET SIZE IN +SECTORS
      CLB            OR IN -TRACKS
      SSA,RSS       IF IN -TRACKS CONVERT TO
      JMP OK.1       DOUBLE WORD NUMBER 
      CMA,INA         OF SECTORS
      LSL 8 
OK.1  SWP 
      DST FSIZE     SAVE DOUBLE WORD SIZE IN SECTORS
      LDA AREC1     GET RECORD #
      LDB IREC       AND SET IN 
      JSB PRMRT       RETURN PARAMETERS 
      LDA TYP       GET THE TYPE
      SZA,RSS            SET NEG AND TEST FOR ZERO
      JMP TYPST     TYPE ZERO SO JUMP 
      LDA AFSIZ     SET SIZE
      LDB JSEC       IN RETURN
      JSB PRMRT       PARAMETERS
      LDA TYP       GET TYPE AGAIN
      CMA,INA        AND MAKE IT NEGATIVE 
      ADA .2        IF THREE OR GREATER 
      SSA            THEN 
      JMP NOTRA       JUMP NOT RAMDOM ACCESS
      CLA           GET RECORD LENGTH 
      LDB SIZE       AND MAKE INTO
      DST DTMP        A DOUBLE WORD 
      DLD REC1      GET CURRENT RECORD NUMBER 
      JSB .DDE       LESS ONE 
      JSB .DMP        AND MULTIPLY BY 
      DEF DTMP         RECORD LENGTH
      SWP 
      STA TMP 
      AND B177      MASK OFF BLOCK OFFSET AND 
      STA IOFF,I     SET IN RETURN PARAMETERS 
      XOR TMP 
      ASR 7         CONVERT TO NUMBER OF BLOCKS 
      SWP 
      JMP STRS      GO RETURN IT
NOTRA LDA TRK       TYPE >= 3 
      CMA,INA       ((STARTING TRACK - CURRENT TRACK) 
      ADA CTRK       * #SECTORS PER TRACK)
      MPY SEC/T        - STARTING SECTOR
      SWP               + CURRENT SECTOR
      DST DTMP
      LDB SEC 
      CMB,INB 
      ADB CSEC
      CLA           MAKE INTO A DOUBLE WORD 
      SSB            SO CAN USE DOUBLE WORD 
      CCA             ADD ROUTINE.
      JSB .DAD
      DEF DTMP      # SECTORS "INTO" THIS EXTENT
      SWP 
      ASR 1         CONVERT TO BLOCKS 
      SWP 
      DST DTMP      # BLOCKS "INTO" THIS EXTEN
* 
      CLA           MULTIPLY FILE SIZE
      LDB EXNO       IN SECTORS TIMES 
      JSB .DMP        THE NUMBER OF 
      DEF FSIZE        PREVIOUS EXTENTS 
      SWP 
      ASR 1         CONVERT TO BLOCKS 
      SWP 
      JSB .DAD      ADD TO # BLOCKS "INTO" THE CURRENT
      DEF DTMP       EXTENT AND SAVE
      DST FSIZE 
* 
      LDA DCB       COMPUTE 
      CMA,INA        CURRENT
      ADA BUFPT       BUFFER OFFSET 
      ADA N16       ADJUST FOR BUFFER ADDRESS 
      CLB           ADJUST OFFSET TO
      DIV .128       128 WORD BASE
      STB IOFF,I    RETURN OFFSET 
      CLB           ADD IN # 128 WORD 
      SWP            BLOCKS IN
      JSB .DAD       DCB BUFFER (BEFORE CURRENT 
      DEF FSIZE       POSITION) TO GET CURRENT
STRS  DST FSIZE        BLOCK OFFSET INTO FILE 
      LDA AFSIZ 
      LDB IRS 
      JSB PRMRT     RETURN CURRENT BLOCK OFFSET 
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
* 
* 
* 
* 
*   PRMRT         ROUTINE TO STUFF A DOUBLE WORD INTO A SINGLE OR 
*                 DOUBLE WORD RETURN PARAMETER  (DEPENDING ON 
*                 WHETHER THE SINGLE WORD OR THE DOUBLE WORD
*                 ROUTINE WAS CALLED) 
* 
*   ON ENTRY
*   A = ADDRESS OF DOUBLE WORD
*   B = ADDRESS OF DESTINATION
* 
* 
*   ERROR 30 EXIT IS TAKEN IF VALUE IS >32K BUT SINGLE WORD 
*   ROUTINE WAS CALLED. 
* 
* 
PRMRT NOP 
      STB TMP 
      LDB ELOCF 
      CPB N1
      JMP PR.1
      DLD A,I 
      DST TMP,I 
      JMP PRMRT,I 
PR.1  DLD A,I 
      STB TMP,I 
      LDB N30 
      SZA 
      JMP EXIT
      JMP PRMRT,I 
* 
* 
* 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
* 
.2    DEC 2 
.128  DEC 128 
* 
N1    DEC -1
N9    DEC -9
N10   DEC -10 
N11   DEC -11 
N30   DEC -30 
* 
B77   OCT 77
B177  OCT 177 
* 
FSIZE BSS 2 
AFSIZ DEF FSIZE 
DTMP  BSS 2 
DM    BSS 2 
DFDM  DEF DM
AREC1 DEF REC1
* 
END   EQU * 
* 
      END 
                                                                                                                                                                                                                                                      