ASMB,L,R,C,Q
      HED POSNT 
*     NAME:   POSNT 
*     SOURCE: 92067-18133 
*     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 POSNT,7 92067-16125 REV.1903 790316 
      ENT POSNT, EPOSN
      EXT EXEC,.ENTR,RFLG$,P.PAS,READF,$KIP 
      EXT .DNG, .DAD, .DDE, .DIS
      SUP 
* 
* 
*     POSNT  IS THE  FILE  POSITION ROUTINE  FOR THE
*            RTE  FILE  MANAGEMENT PACKAGE
* 
* 
*     CALLING  SEQUENCE:
* 
*     CALL POSNT (IDCB,IERR,NP,IR)     OR 
*     CALL EPOSN (IDCB,IERR,NP,IR)
* 
*         WHERE:
* 
*           IDCB  IS THE FILE'S 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 
*           NP    IF >0  THEN SKIP NP RECORDS 
*                 IF <0  THEN BACK SPACE NP RECORDS 
*                 IF =0  THEN  NO  OPERATION
*                 NP IS A SINGLE WORD FOR POSNT CALLS.
*                 IT IS A DOUBLE WORD FOR EPOSN CALLS.
*           IR  (OPTIONAL) IF NOT CODED OR ZERO 
*                 NP  IS RELATIVE  OTHERWIZE
*                 NP IS ABSOLUTE (NP MUST BE>0) 
* 
* 
* 
* 
      SKP 
* 
* 
EPOSN DEC -1
      LDA EPOSN 
      STA POSNT 
      JMP POSNT+1 
* 
* 
* 
DCB   NOP 
ER    NOP 
NP    DEF ZERO
IR    DEF ZERO
* 
POSNT NOP           ENTRY POINT 
      JSB .ENTR      FETCH
      DEF DCB         ADDRESSES 
      LDA EPOSN     GET POSNT\EPOSN FLAG
      SSA           DOUBLE WORD CALL? 
      JMP POSN0     NO - SKIP 
      DLD NP,I      GET DOUBLE WORD RECORD NUMBER 
      JMP POSN1     AND GO SAVE 
POSN0 CLA           GET RECORD NUMBER,
      LDB NP,I       MAKE INTO A DOUBLE WORD
      SSB             TAKING INTO ACCOUNT THAT
      CCA              IT MAY BE POSITIVE OR NEGATIVE 
POSN1 DST RECRD         AND SAVE. 
* 
      SZA,RSS       IF NP IS ZERO 
      SZB 
      JMP POSN2     IT'S NOT SO CONTINUE
      CLA           PRESET FOR NO ERROR EXIT
      LDB IR,I      IF NP IS ZERO AND IR IS NON-ZERO
      SZB            (ABSOLUTE POSITION TO RECORD 0)
      JMP EXIT      THEN WANT TO EXIT NO OPERATION
* 
POSN2 LDA N10       ENOUGH
      LDB NP         PRAMS
      CPB DFZER       SUPPLIED? 
      JMP EXIT         NO,EXIT
      STB RFLG$     FOURCE READS WHILE SPACING
* 
      CLB,CLE       SET UP
      LDA DCB        LOCAL DCB
      JSB P.PAS       ADDRESSES 
      DEC -15 
RCOUT NOP           USED FOR DOUBLE 
RCT1  NOP            WORD COUNTER 
TYPE  NOP           TYPE
LU    NOP           LU FOR TYPE 0 
TMP   NOP           TEMPORARY STORAGE 
SPACE NOP           SPACING LEGAL FLAGE TYPE 0
CONND NOP           CONTROL WORD FOR CONTROL REQUEST
RWFLG NOP           WRITTEN-ON FLAG 
DSTAT NOP           CONTROL WORD FOR STATUS REQUEST 
OPEN  NOP           OPEN FLAG 
LN    NOP           ONE WORD DUMMY BUFFER 
RCLN  NOP           STORAGE FOR TYPE >=3 RECORD LENGTH
BFPT  NOP           BUFFER POINTER
RC1   NOP           DOUBLE WORD 
RC    NOP            RECORD  COUNT
      LDA N11       GET NOT OPEN ERROR.CODE TO A
      LDB OPEN,I    GET OPEN FLAG TO B
      CPB XEQT      OPEN
      CCE,RSS       YES; SKIP;SET E 
      JMP EXIT      NO;  EXIT OPEN ERROR
* 
      LDA BFPT      GET BUFFER POINTER ADDRESS
      RAL,ERA       SET INDIRECT BIT
      STA BFPT      RESET POINTER 
      LDA IR,I      GET RELATIVE /ABSOLUTE  FLAG
      CLB           IF IR=0, THIS IS A RELATIVE POSITION
      SZA,RSS        SO WANT TO LOAD DOUBLE WORD
      LDB RC,I        CURRENT RECORD NUMBER INTO A,B
      SZA           IF IR#0, THIS IS AN ABSOLUTE POSITION 
      CLA,RSS        SO WANT TO CLEAR A,B 
      LDA RC1,I       (DOUBLE WORD 0) 
      JSB .DAD      ADD TO THIS THE DOUBLE WORD NUMBER
      DEF RECRD      OF RECORDS TO BE POSITIONED
      DST RECRD       AND SAVE. 
      JSB .DNG      NEGATE AND
      JSB .DAD       ADD TO CURRENT RECORD NUMBER 
      DEF RC1,I       TO GET ABSOLUTE RECORD NUMBER.
      JSB .DNG      MAKE NEGATIVE FOR USE AS COUNTER
      SZA,RSS       ZERO? 
      SZB 
      RSS 
      JMP EXOK      YES - GO EXIT 
      DST RCOUT     NO - SAVE COUNT 
* 
      LDB TYPE,I    GET TYPE  OF  FILE
      CMB,INB,SZB,RSS TYPE ZERO?
      JMP TYP0      YES; GO TO TYPE ZERO ROUTINE
* 
      INB,SZB       TYPE; 1 
      INB,SZB,RSS    OR 2 
      JMP TY1/2     YES; GO TO RANDOM ACESS POSITION
* 
      SSA,RSS       TYPE 3 OR ABOVE AND FORWARD SPACE?
      JMP FSRC      YES - GO DO IT. 
* 
* 
*     TYPE 3 AND ABOVE BACKSPACE ROUTINE
* 
* 
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       AND SAVE IT
      CMA           BACK SPACE
      STA B          TO THE 
      LDA DCB         TWIN
      JSB $KIP         WITH THE 
      JMP EXIT          SKIP ROUTINE
      LDA BFPT,I    GET TWIN
      CPA RCLN      TWINS MATCH?
BSRC5 RSS           YES - SKIP AND GO COUNT THE RECORD
      JMP ER5       NO; ERROR -5
      DLD RC1,I     GET RECORD NUMBER 
      JSB .DDE       DECREMENT IT AND 
      DST RC1,I       RESTORE IT. 
      JSB .DIS      INCREMENT AND SKIP IF ZERO
      DEF RCOUT     RECORDS TO BE SPACED COUNTER
      RSS           MORE TO BACKSPACE 
      JMP EXOK      WE'RE DONE - GO EXIT
      JMP BSRC3     GO BACKSPACE ANOTHER
* 
* 
*     FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES 
* 
* 
FSRC  DLD RCOUT     GET COUNTER 
      JSB .DNG       NEGATE AND SAVE
      DST RCOUT       COUNTER 
FSRC1 JSB READF     READ
      DEF REART      A
      DEF DCB,I       RECORD
      DEF ER,I         TO 
      DEF TMP           LOCAL DUMMY 
      DEF .1             ONE WORD BUFFER
      DEF LN
REART SSA           IF ERROR
      JMP EXIT      EXIT
      LDB LN        GET WORD
      SSB           EOF?
      JMP EOFEX  YES - TAKE EOF EXIT
      JSB .DIS      INCREMENT AND SKIP IF ZERO
      DEF RCOUT      RECORDS TO BE SPACED COUNTER 
      RSS           MORE TO FORWARD SPACE 
      JMP EXIT      WE'RE DONE - GO EXIT
      JMP FSRC1     GO FORWARD SPACE ANOTHER
* 
* 
*     TYPE ZERO  SPACE  ROUTINE 
* 
* 
TYP0  SSA,RSS       IF FORWARD  SPACE 
      JMP FSRC       GO TO READ ROUTINE 
      LDA N3        PRESET FOR ERROR
      LDB SPACE,I   GET FORWARD OR BACKSPACE
      SSB,RSS        LEGAL CODE 
      JMP EXIT      BACK SPACE NOT LEGAL-EXIT 
      LDA LU,I      GET AND 
      AND B77        ISOLALE  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 .3          BACK
      DEF CONND         SPACE 
EXRTN JSB EXEC      DO DYNAMIC STATUS 
      DEF STRTN 
      DEF .3
      DEF DSTAT 
STRTN AND B200      MASK  EOF BIT 
      STA TMP        AND SAVE IT
      DLD RC1,I     GET RECORD NUMBER 
      JSB .DDE       DECREMENT IT AND 
      DST RC1,I       RESTORE IT
      LDA TMP       GET EOF BIT AGAIN 
      SZA,RSS       AT EOF? 
      JMP NTEOF     NO
      CCA           YES - PRESET TO FORWARD SPACE 
      CCB            ONE RECORD 
      ISZ OPEN      SKIP IF EOF ON FIRST RECORD 
      JMP FSRC       ELSE GO FORWARD SPACE
NTEOF JSB .DIS      INCREMENT AND SKIP IF ZERO
      DEF RCOUT      RECORDS TO BE SPACED COUNTER 
      RSS           MORE TO SPACE 
      JMP EXOK      ALL DONE - GO EXIT
      JMP SPC0      CONTINUE SPACING
* 
* 
ER5   LDA N5          LENGTH MISMATCH ERROR 
      JMP EXIT      SEND ERROR CODE 
* 
* 
*     TYPE 1 AND 2 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 DLD RECRD     GET THE ABSOLUTE RECORD NO. 
      CCE,SZA,RSS   IF ZERO OR NEGATIVE 
      SZB            SET TO RECORD 1
      SSA 
      CLA,CLE 
      SEZ,RSS 
      CLB,INB 
      DST RC1,I     SET NEW RECORD NO.
      SEZ           IF FORCED TO ONE TAKE SOF EXIT
EXOK  CLA,RSS       GOOD EXIT 
EOFEX LDA N12       EOF/SOFEXIT 
EXIT  LDB DFZER     EXIT - RESET
      STB NP         OPTIONAL 
      STB IR          ADDRESSES 
      CCB           RESET POSNT\EPOSN 
      STB EPOSN      FLAG 
      STA ER,I      SET ERROR AND 
      JMP POSNT,I    RETURN 
* 
* 
* 
ZERO  BSS 2 
.1    DEC 1 
.3    DEC 3 
* 
N3    DEC -3
N5    DEC -5
N10   DEC -10 
N11   DEC -11 
N12   DEC -12 
* 
DFZER DEF ZERO
* 
B77   OCT 77
B200  OCT 200 
B400  OCT 400 
* 
RECRD BSS 2 
* 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
* 
END   EQU * 
* 
      END 
                                                              