ASMB,R,L,C
*     NAME:   APOSN 
*     SOURCE: 92070-18038 
*     RELOC:  92070-16038 
*     PGMR:   G.A.A.
*     MOD:    M.L.K.
* 
*  ***************************************************************
*  * (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 APOSN,7  92070-1X038  REV.2011  800319
* 
      HED APOSN 
      ENT APOSN,EAPOS 
      EXT $KIP,NX$EC,RFLG$,.ENTR,LOCF 
      EXT GTOPN,$DBLX 
      SUP 
      SPC 1 
*     THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING
*     OF  RTE FILES 
* 
*     CALLING  SEQUENCE:
* 
*     CALL APOSN(IDCB,IERR,IREC,IRS,IOFF) 
      SPC 1 
*     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) 
* 
      SKP 
EAPOS NOP           DOUBLE WORD ENTRY 
      CCA           SET DOUBLE WORD FLAG TRUE 
      LDB EAPOS     MOVE ENTRY ADDRESS
      JMP SETUP     GO SETUP REST 
      SPC 5 
APOSN NOP 
      CLA 
      LDB APOSN     GET RETURN ADDRESS
SETUP STA DBLWD     STORE DOUBLE WORD FLAG
      STB DPOSN     STORE RETURN ADDRESS
      CLA           CLEAR PARAMETER ADDRESSES 
      STA IRC       FOR ENOUGH PARAMETER
      STA IOFF      TESTS 
      JMP DPOSN+1   GO FETCH CALL PARMS 
      SPC 5 
* 
DCB   NOP 
ER    NOP 
IRC   NOP 
IRS   NOP 
IOFF  NOP 
      SPC 1 
DPOSN NOP           ENTRY POINT 
      JSB .ENTR      FETCH PRAM 
      DEF DCB         ADDRESSES 
* 
      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 
      ARS,ALR       AND 
      ALF,ALF       CONVERT 
      RAL           TO NUMBER OF  128 WORD BLOCKS 
      STA BLKSZ     SAVE
      ADB .2        STEP TO OPEN FLAG 
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1 
      CPA B,I       IS IT SAME AS IN DCB? 
      JMP OPIN      YES, FILE OPEN
      LDA N11       NO, ERROR 11
      JMP EXIT      NOW EXIT
* 
OPIN  LDA N9        SET A= -9 
      LDB TYPE,I    IS FILE TYPE
      SZB,RSS        ZERO?
      JMP EXIT      YES; EXIT 
      ADB N3        IF TYPE 1 OR 2
      STB TYPE      SAVE FOR LATER
      LDA IRC       TEST FOR RECORD PRAM
      SSB,RSS       ELSE TEST 
      LDA IOFF      FOR FULL PRAM 
      SZA,RSS        LIST 
      JMP ER10      NOT ENOUGH PRAMS - EXIT 
* 
      ISZ DBLWD     TEST DBL FLAG 
      JMP SINGL     SINGLE WORD, SKIP TESTS 
      DLD IRC,I     GET DOUBLE RECORD 
      JSB $DBLX     CHECK RANGE 
      JMP EXIT      ERROR (A=ERROR CODE)
      ISZ IRC       POINT TO LOW BITS 
      LDB TYPE      GET TYPE INDICATION AGAIN 
      SSB            IF TYPE 1 OR 2, SKIP 
      JMP RCSET      DOUBLE TEST OF BLOCK 
      DLD IRS,I     GET DOUBLE SECTOR 
      JSB $DBLX     CHECK RANGE 
      JMP EXIT      ERROR 
      ISZ IRS       POINT TO LOW BITS 
* 
SINGL LDB TYPE      GET TYPE INDICATOR AGAIN
      SSB           IF 1 OR 2 
      JMP RCSET     GO SET RECORD NO. 
      SPC 1 
      JSB LOCF      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 
      CLB           CACULATE
      LDA CIRS      THE RELATIVE
      DIV BLKSZ     BLOCK 
      CMA,INA       NUMBER
      STA CIRS
      CLB 
      LDA IRS,I     DESIRED 
      DIV BLKSZ     AND 
      SWP           SET FOR 
      ADB CIRS      NX$EC CALL
      SZB,RSS       IF ALREADY THERE
      JMP RCSET     SKIP POSITION CALL
      JSB NX$EC     POSITION WITH NX$EC 
      JMP EXIT      ERROR - EXIT
RCSET RRL 7 
      LDB DCB       GET DCB 
      ADB .12       COMPUTE BUFFER POINTER ADDRESS
      STB CIRS
      ADB IOFF,I    COMPUTE DESIREDED 
      ADB .4        CONTENTS
      ADB A         ADD THE NO OF 128 WORD BLOCKS 
      STB CIRS,I    AND SET 
      ISZ CIRS      STEP TO THE 
      ISZ CIRS      RECORD NUMBER 
      LDB IRC,I     SET RECORD NUMBER 
      SZB            ZERO 
      SSB             OR NEG
      JMP ER12         EXIT ERROR 
      STB CIRS,I    SET THE RECORD NUMBER 
      LDB DCB       GET DCB ADDRESS 
      ADB .13       POSITION TO EOF FLAG
      LDA B,I       GET WRITTEN-ON/EOF/IN BUFFER FLAG 
      RAR,CLE,RAR   CLEAR EOF 
      ELA,RAL         READ FLAG 
      STA B,I       STORE IN DCB
      CLA,RSS       OK - EXIT 
ER10  LDA N10 
EXIT  STA ER,I      SET ERROR CODE
      JMP DPOSN,I   RETURN. 
      SPC 2 
ER12  LDA N12       SEND EOF ERROR
      JMP EXIT
      SPC 2 
*     STORAGE 
      SPC 1 
N3    DEC -3
N9    DEC -9
N11   DEC -11 
N12   DEC -12 
.2    DEC 2 
.4    DEC 4 
.5    DEC 5 
.12   DEC 12
.13   DEC 13
N10   DEC -10 
BLKSZ NOP 
CIRS  NOP 
DBLWD NOP 
TYPE  NOP 
RC    EQU TYPE
      SPC 2 
A     EQU 0 
B     EQU 1 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                                                                                                                  