ASMB,L,R,C
*     NAME:   POSNT 
*     SOURCE: 92070-18049 
*     RELOC:  92070-16049 
*     PGMR:   G.A.A.
*     MOD:    G.L.M 
* 
*  ***************************************************************
*  * (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 POSNT,7  92070-1X049  REV.1941  790709
* 
      HED POSNT 
      ENT POSNT,EPOSN 
      EXT EXEC,.ENTR,RFLG$,P.PAS,READF,$KIP 
      EXT GTOPN,$DBLX 
      SUP 
* 
*     POSNT  IS THE  FILE  POSITION ROUTINE  FOR THE
*            RTE  FILE  MANAGEMENT PACKAGE
* 
*     CALLING  SEQUENCE:
*     CALL POSNT (IDCB,IERR,NP,IR)
*         WHERE:
*           IDCB  IS THE FILES DATA CONTROL BLOCK 
*                 ADDRESS 
*           IERR  IS THE  ERROR RETURN ADDRESS
*                 POSNT ERRORS ARE: 
*              0  NONE
*             -1  DISC DOWN 
*             -5  AN ILLEGAL RECORD WASENCOUNTERED
*                 (LENGTHS AT EACH END DID NOT MATCH
*             -10 NOT ENOUGH PARAMETERS 
*             -11 DCB NOT OPEN
*             -12 EOF OR SOF SENSED 
*             -17 CONTROL REQUEST FAILED
*           NP    IF >0  THEN SKIP NP RECORDS 
*                 IF <0  THEN BACK SPACE NP RECORDS 
*                 IF =0  THEN  NO  OPERATION
*           IR  (OPTIONAL) IF NOT CODED OR ZERO 
*                 NP  IS RELATIVE  OTHERWIZE
*                 NP IS ABSOLUTE (NP MUST BE>0) 
      SKP 
EPOSN NOP           DOUBLE WORD ENTRY POINT 
      CCA           SET DBL FLAG TRUE 
      LDB EPOSN     GET RETURN ADDRESS
      JMP SETUP     GO FINISH SET UP
      SPC 3 
POSNT NOP           SINGLE WORD ENTRY 
      CLA           SET DBL FLAG FALSE
      LDB POSNT     GET RETURN ADDRESS
SETUP STA DBLWD     STORE DBL FLAG
      STB DOSNT     STORE RETURN ADDRESS
      LDA DFZER     PRE-SET OPTIONAL ENTRY PARMS
      STA NP
      STA IR
      CLA 
      STA ZERO
      JMP DOSNT+1   GO FETCH CALL PARMS 
      SPC 3 
DCB   NOP 
ER    NOP 
NP    DEF ZERO
IR    DEF ZERO
      SPC 1 
DOSNT NOP           ENTRY POINT 
      JSB .ENTR      FETCH
      DEF DCB         ADDRESSES 
      LDA N10       ENOUGH
      LDB NP         PRAMS
      CPB DFZER       SUPPLIED? 
      JMP EXIT         NO,EXIT
      ISZ DBLWD     DOUBLE OR SINGLE ENTRY? 
      JMP SINGL     SINGLE, SKIP RANGE TESTS
      DLD NP,I      GET DOUBLE INTEGER
      JSB $DBLX     CHECK RANGE 
      JMP EXIT      ERROR RETURN (A= ERROR CODE)
      ISZ NP        POINT TO LOWER BITS 
* 
SINGL STB RFLG$     FORCE READS WHILE SPACING 
      CLB,CLE       SET 
      LDA DCB       UP
      JSB P.PAS       LOCAL 
      DEC -15          DCB
RCOU  NOP               ADDRESSES 
DUM   NOP 
TYPE  NOP           TYPE
LU    NOP           LU FOR TYPE 0 
EOF   NOP           EOF CODE FOR TYPE 0 
SPACE NOP           SPACING LEGAL FLAGE TYPE 0
CONND NOP 
LN    NOP 
DSTAT NOP 
OPEN  NOP           OPEN FLAG 
ABRC  NOP 
RCLN  NOP 
BFPT  NOP           BUFFER POINTER TYPE 3AND ABOVE
RWFLG NOP           READ/WRIE /EOF  FLAG
RC    NOP           RECORD  COUNT 
      JSB GTOPN     GET CURRENT OPEN FLAG 
      DEF *+1 
      CPA OPEN,I    SAME AS IN DCB? 
      JMP OPIN      YES, IT'S OK
      LDA N11       NO, NOT OPEN
      JMP EXIT        SO LEAVE
OPIN  CCE           SET E FOR LATER 
      LDA BFPT      GET BUFFER POINTER ADDRESS
      RAL,ERA       SET INDIRECT BIT
      STA BFPT      RESET POINTER 
* 
      LDA NP,I      GET RECORD NUMBER 
      SZA,RSS       IS IT 0?
      JMP EXOK      YES, NOP EXIT 
* 
      LDA IR,I      GET RELATIVE /ABSOLUTE  FLAG
      CLB           ASSUME ABSOLUTE 
      SZA,RSS       RELATIVE? 
      LDB RC,I      YES; GET CURRENT RECORD NO. 
      ADB NP,I      ADD THE  REQUESTED  MOVEMENT
      STB ABRC      SAVE NEW ABSOLUTE ADDRESS 
      CMB,INB       SET NEGATIVE AND
      ADB RC,I      COMPUTE RELATIVE RECORD NUMBER
      CMB,INB,SZB,RSS SET TO RIGHT  SIGN - ZERO?
      JMP EXOK      YES - GO EXIT 
      STB RCOU      NO;  SET COUNT
      SPC 1 
      LDA TYPE,I    GET TYPE  OF  FILE
      CMA,INA,SZA,RSS TYPE ZERO?
      JMP TYP0      YES; GO TO TYPE ZERO ROUTINE
      INA,SZA       TYPE; 1 
      INA,SZA,RSS    OR 2 
      JMP TY1/2     YES; GO TO RANDOM ACESS POSITION
      SPC 1 
      CMB,SSB,INB     TYPE 3 OR  ABOVE - FORWARD
      JMP FSRC          SPACE - YES  GO  DO IT. 
      SPC 2 
*     TYPE 3 AND ABOVE BACKSPACE ROUTINE
      SPC 1 
BSRC  LDA BFPT,I    GET CURRENT POSITION
      INA,SZA       IS IT EOF?
      JMP BSRC3     NO; GO BACKSPACE
      LDA RWFLG,I   YES; GET THE READ/WRITE 
      RAR,CLE,RAR   FLAG AND CLEAR THE EOF BIT
      ELA,RAL       THEN
      STA RWFLG,I   RESTORE THE FLAG
      SEZ           WAS IT SET? 
      JMP BSRC5     YES; COUNT AS A RECORD
BSRC3 CCB           NO; BACKSPACE 1 
      LDA DCB       WORD
      JSB $KIP      WITH THE
      JMP EXIT      SKIP ROUTINE
      LDA BFPT,I    GET THE RECORD LENGTH 
      STA RCLN      SAVE IT 
      CMA           BACK SPACE TO 
      STA B         THE 
      LDA DCB       TWIN
      JSB $KIP      WITH THE
      JMP EXIT      SKIP ROUTINE
      LDA BFPT,I    GET TWIN
      CPA RCLN      TWINS MATCH?
BSRC5 CCA,RSS       YES; SKIP 
      JMP ER5       NO; ERROR -5
      ADA RC,I      DECREMENT THE 
      STA RC,I      RECORD  COUNT 
      ISZ RCOU      STEP BACKSPACE COUNT ; DONE?
      JMP BSRC3     NO; DO THE NEXT ONE 
      JMP EXOK
*     FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES 
* 
FSRC  STB RCOU      SET COUNT 
FSRC1 JSB READF     READ
      DEF REART      A
      DEF DCB,I       RECORD
      DEF ER,I         TO 
      DEF DUM           LOCAL DUMMY 
      DEF .1             ONE WORD BUFFER
      DEF LN
REART SSA           IF ERROR
      JMP EXIT      EXIT
      LDB LN
      SSB 
      JMP EOFEX 
      ISZ RCOU
      JMP FSRC1 
      JMP EXIT
      SKP 
*     TYPE ZERO  SPACE  ROUTINE 
      SPC 1 
TYP0  CMB,SSB,INB     IF FORWARD  SPACE 
      JMP FSRC      GO TO READ ROUTINE
      SPC 1 
      LDA N3        PRESET FOR ERROR
      LDB SPACE,I   BACK SPACE  GET 
      SSB,RSS       LEGAL CODE
      JMP EXIT      BACK SPACE NOT LEGAL-EXIT 
      SPC 1 
      LDA LU,I      GET AND 
      AND B77       ISOLATE  LU 
      ADA B200      ADD BACK SPACE FUNCTION 
      STA CONND     SET FOR CALL
      ADA B400      MAKE A DYNAMIC STATUS RQ
      STA DSTAT     SET IT
      CCA           SET FIRST EOF RECORD FLAG 
SPC0  STA OPEN      IN OPEN 
      JSB EXEC      CALL EXEC 
      DEF EXRTN      TO 
      DEF .3I         BACK
      DEF CONND         SPACE 
EXRTN JMP ER17      EXEC ERROR
      JSB EXEC      DO DYNAMIC STATUS 
      DEF STRTN 
      DEF .3I 
      DEF DSTAT 
STRTN JMP ER17      EXEC ERROR
      AND B200      MASK  EOF BIT 
      CCB           DECREMENT 
      ADB RC,I      THE RECORD COUNT
      STB RC,I
      CCB           SET  B  TO FORWARD SPACE 1
      SZA,RSS       IF  EOF TEST FOR FIRST
      JMP *+3       ELSE SKIP TO COUNT THE RECORD 
      ISZ OPEN      SKIP IF EOF ON FIRST RECORD 
      JMP FSRC      ELSE  GO  FORWARD  SPACE
      ISZ RCOU      DONE? 
      JMP SPC0      NO;  DO NEXT ONE
      JMP EXOK      YES;  GO  EXIT
      SKP 
*     TYPE  1 AND  TWO  SPACE  ROUTINE
*           THE   NEW  RECORD  NO. IS SET ONLY
*             NO EOF CHECK IS DONE
*               NEGATIVE  OR  ZERO  RECORD
*                 NUMBERS  ARE  REPLACED
*                 WITH  1  AND  SOF  ERROR SENT 
* 
TY1/2 LDA ABRC      GET THE ABSOLUTE RECORD NO. 
      CCE,SZA       IF ZERO 
      SSA            OR NEGATIVE
      CLA,CLE,INA     SET TO ONE
      STA RC,I      SET NEW RECORD NO.
      SEZ           IF FORCED TO ONE TAKE SOF EXIT
      SPC 2 
EXOK  CLA,RSS       GOOD EXIT 
EOFEX LDA N12       EOF/SOF EXIT
      SPC 1 
EXIT  STA ER,I      SET ERROR AND 
      JMP DOSNT,I   RETURN
      SPC 2 
ER17  LDA N17 
      JMP EXIT
      SPC 2 
ER5   LDA N5
      JMP EXIT
      SKP 
*       STORAGE 
      SPC 2 
.1    DEC 1 
.3I   OCT 100003
N12   DEC -12 
N10   DEC -10 
N11   DEC -11 
DFZER DEF ZERO
ZERO  NOP           \THESE TWO ARE DOUBLE 
      NOP           /  DUMMY ZERO 
DBLWD NOP           DOUBLE WORD FLAG
N3    DEC -3
N17   DEC -17 
N5    DEC -5
B200  OCT 200 
B400  OCT 400 
B77   OCT 77
      SPC 2 
A     EQU 0 
B     EQU 1 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                                                                                                      