ASMB,R,L,C,Q
      HED APOSN 
*     NAME:   APOSN 
*     SOURCE: 92067-18134 
*     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 APOSN,7 92067-16125 REV.1903 790503 
      ENT APOSN, EAPOS
      EXT $KIP, NX$EC, RFLG$, .ENTR, ELOCF
      EXT .DNG, .DAD, .DDI
      SUP 
* 
* 
*     THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING
*     OF  RTE FILES 
* 
*     CALLING  SEQUENCE:
* 
*     CALL APOSN(IDCB,IERR,IREC,IRS,IOFF)   OR
*     CALL EAPOS(IDCB,IERR,IREC,IRS,IOFF) 
* 
*     WHERE:
* 
*         IDCB  IS THE FILES DATA CONTROL BLOCK 
* 
*         IERR  IS AN ERROR RETURN FLAG. POSSIBLE ERRORS, 
*           0   NO ERROR
*          -1   DISC DOWN 
*          -5   SPACING BEYOND END OF DEFINED EXTENT
*          -9   ATTEMPT TO POSITION TYPE ZERO FILE
*          -10  NOT ENOUGH PARAMETERS 
*          -11  DCB NOT OPEN
*          -12  SOF  IE IREC <1 
* 
*         IREC  THE RECORD NUMBER TO BE READ NEXT 
* 
*         IRS   (REQUIRED FOR 3 & ABOVE ONLY) THE 
*               RELATIVE BLOCK OF THE NEXT RECORD 
* 
* 
*         IOFF   THE BLOCK OFFSET OF THE NEXT 
*                RECORD (REQUIRED FOR TYPE 3 AND
*                   ABOVE ONLY) 
* 
*         IREC AND IRS ARE SINGLE WORD INTEGERS FOR THE APOSN CALL. 
*         FOR EAPOS, IREC AND IRS ARE DOUBLE WORD INTEGERS. 
* 
* 
* 
* 
* 
EAPOS DEC -1
      LDA EAPOS 
      STA APOSN 
      JMP APOSN+1 
* 
* 
* 
DCB   NOP 
ER    NOP 
IRC   NOP 
IRS   NOP 
IOFF  NOP 
* 
APOSN NOP           ENTRY POINT 
      JSB .ENTR      FETCH PRAM 
      DEF DCB         ADDRESSES 
      LDA EAPOS     GET APOSN\EAPOS CODE
      SSA           DOUBLE WORD CALL? 
      JMP APOS0     NO - SKIP 
      DLD IRC,I     GET DOUBLE WORD RECORD #
      DST RECRD      AND SAVE 
      DLD IRS,I     GET DOUBLE WORD BLOCK 
      JMP APOS1      AND GO TO SAVE IT
APOS0 CLA           GET RECORD #
      LDB IRC,I      AND MAKE INTO A DOUBLE WORD
      SSB             AND SAVE
      CCA 
      DST RECRD     
      CLA 
      LDB IRS,I     GET BLOCK AND MAKE INTO A DOUBLE WORD 
      SSB 
      CCA 
APOS1 DST BLOCK      AND SAVE.
      CLB,INB       SET THE READ
      STB RFLG$     FLAG
* 
      LDB DCB       COMPUTE 
      ADB .2         TYPE 
      STB TYPE        AND 
      ADB .5           STEP TO BLOCK LENGTH 
      LDA B,I       FETCH AND 
      AND BLMSK      CONVERT
      CLB             TO NUMBER OF WORD BLOCKS
      LSL 9            (MADE INTO A DOUBLE WORD)
      DST BLKSZ       AND SAVE AS A DOUBLE WORD 
      LDB DCB 
      ADB .9        STEP TO OPEN FLAG 
      LDA N11       IS
      LDB B,I        DCB
      CPB XEQT        OPEN? 
      INA,RSS       YES; SKIP 
      JMP EXIT      NO; EXIT
      INA           SET A= 9
      LDB TYPE,I    IS FILE TYPE
      SZB,RSS        ZERO?
      JMP EXIT      YES; EXIT 
      ADB N3        IF TYPE 1 OR 2
      LDA IRC       TEST FOR RECORD PRAM
      SSB,RSS       ELSE TEST 
      LDA IOFF      FOR FULL PRAM 
      SZA,RSS        LIST 
      JMP ER10      NOT ENOUGH PRAMS - EXIT 
      SSB           IF 1 OR 2 
      JMP RCSET     GO SET RECORD NO. 
* 
      JSB ELOCF     USE LOCF TO 
      DEF LOCRT      GET
      DEF DCB,I       CURRENT 
      DEF ER,I         RELATIVE 
      DEF RC            SECTOR
      DEF CIRS           ADDRESS
LOCRT CLB           CALL
      LDA DCB       SKIP
      JSB $KIP       TO 
      JMP EXIT         SET UP NX$EC 
* 
      DLD CIRS      CALCULATE RELATIVE BLOCK CHANGE 
      JSB .DDI      CURRENT BLOCK/DCB BLOCK SIZE -
      DEF BLKSZ      NEW BLOCK/DCB BLOCK SIZE 
      JSB .DNG
      DST CIRS
      DLD BLOCK 
      JSB .DDI
      DEF BLKSZ 
      JSB .DAD
      DEF CIRS
      SZA,RSS       RELATIVE BLOCK = 0?  ALREADY THERE? 
      SZB 
      RSS           NO -
      JMP RCSET     YES - SKIP POSITION CALL
      JSB NX$EC     POSITION WITH NX$EC 
      JMP EXIT      ERROR - EXIT
* 
RCSET DLD BLOCK     CALCULATE BLOCK POSITION WITHIN DCB 
      SWP 
      DIV BLKSZ+1   (WANT REMAINDER)
      CLA           CONVERT TO WORDS
      RRL 7          (MULTIPLY BY 128)
      LDA DCB       GET DCB 
      ADA .12       COMPUTE BUFFER POINTER ADDRESS
      STA CIRS
      ADA IOFF,I    COMPUTE DESIRED 
      ADA .4        CONTENTS
      ADA B         ADD THE NO OF 128 WORD BLOCKS 
      STA CIRS,I    AND SET 
      ISZ CIRS
      DLD RECRD     GET RECORD NUMBER 
      SZA,RSS       IF ZERO OR NEGATIVE SEND
      SZB            SOF\EOF ERROR
      SSA 
      JMP ER12
      DST CIRS,I    ELSE PUT NEW RECORD NUMBER IN DCB 
      LDB DCB       GET DCB ADDRESS 
      ADB .7         AND POSITION TO EOF FLAG WORD
      LDA B,I       GET BLOCK SIZE/FLAG WORD
      RAR,CLE,RAR   UNCONDITIONALLY CLEAR 
      ELA,RAL        CLEAR EOF READ FLAG
      STA B,I       AND RETURN WORD TO DCB
      CLA,RSS       OK - EXIT 
ER10  LDA N10 
EXIT  CLB           CLEAR 
      STB IRC        PRAM 
      STB IOFF        ADDRESSES FOR NEXT TIME 
      CCB           RESET APOSN\EAPOS 
      STB EAPOS      FLAG 
      STA ER,I      SET ERROR CODE
      JMP APOSN,I   RETURN. 
* 
* 
ER12  LDA N12       SEND EOF ERROR
      JMP EXIT
* 
* 
* 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
* 
.2    DEC 2 
.4    DEC 4 
.5    DEC 5 
.7    DEC 7 
.9    DEC 9 
.12   DEC 12
* 
N3    DEC -3
N10   DEC -10 
N11   DEC -11 
N12   DEC -12 
* 
BLMSK OCT 077600
* 
RECRD BSS 2 
BLOCK BSS 2 
RC    BSS 2 
CIRS  BSS 2 
BLKSZ BSS 2 
TYPE  EQU RC
* 
END   EQU * 
* 
      END 
                                                                                                          