*COMDECK  PFCD02
          CTEXT  PFCD02- (PRU INDEX)/(RBTA,RBTO,PRU) CONVERSIONS
CVPR.     IF     DEF,CVPR.
          QUAL   CALPTR 
**        CALPTR CALCULATE RBTA,RBTO,PRU FROM PRU INDEX 
* 
*                GIVEN A PRU INDEX AND A FIRST RBT ADDRESS THIS 
*                SUBROUTINE CALCULATES A CHAIN POINTER .
*                THE RESULT IS PUT INTO RBTA,RBTO,PRU.
* 
*         ENTRY  (A)=(0,ABORT ON ERRORS),(1,RETURN ON ERRORS) 
*                (D.Z7,D.T0)=PRU INDEX
*                (D.T1)=FIRST RBT ADDRESS 
* 
*         EXIT   (A)=-1, IF ANY ERRORS
*                (A).GE.0, IF NO ERRORS 
*                RBTA=RBT WORD PAIR ADDRESS 
*                RBTO=BYTE INDEX
*                PRU =PRU NUMBER
*         CALLS  FINDRBR,GETRBT 
* 
*         USES   (D.Z1-D.Z5),TEMP,RBSIZE
  
CALPTR    ENM    X
          STM    CALPTRA           SAVE ABORT FLAG
          LDD    D.T1 
          STM    RBTA 
          STM    RBTWRD+C.RBTWPL
          IF     -DEF,ATTACH,2
          LDK    P.RBT
          CRM    PRBT,D.PPONE 
  
*         GET ANOTHER WORD PAIR 
  
CALPTR1   RJM  GETRBT              GET RBT WORD PAIR
          LOAD   RBTWRD+C.RBTRBR
          STD    D.T1 
          LPN    7
          STD    TEMP 
          LDD    D.T1 
          SHN    -S.RBTDRB
          LMC    777B 
          ZJN  CALPTR2             OVERFLOW WORD PAIR 
          LDD    TEMP 
          SBN    7
          NJN  CALPTR6             NOT FIRST WORD PAIR
CALPTR2   LDN    7
          STD    TEMP 
          LOAD   RBTWRD+C.RBTAUS+5
          STM    RBSIZE 
  
*         PROCESS RB BYTE 
  
CALPTR6   LDD    D.Z7              COMPARE PRU INDEX
          SHN    12 
          LMD    D.T0 
          SBM    RBSIZE 
          MJN  CALPTR4             IF OUT RANGE 
          STD    D.T0              SAVE NEW PRU INDEX 
          SHN    -12D 
          STD    D.Z7 
          AOD    TEMP              ADVANCE INDEX
          SBN    8
          PJN  CALPTR3             IF END OF WORD PAIR
          LDM    RBTWRD+2,TEMP
          NJN  CALPTR6             IF NOT END OF WORD PAIR
  
CALPTR3   LOAD   RBTWRD+C.RBTWPL
          ZJN  CALPTR4B            END OF CHAIN 
          STM    RBTA 
          UJK  CALPTR1             LOOP 
* 
CALPTR4B  LDD    D.Z7 
          ADD    D.T0 
          NJN  CALPTR5             ERROR
* 
*         PRU OFFSET FELL ON RB BOUNDARY AND NO MORE RB"S.  SO, SET 
*         PRU=RBSIZE AND RBTO POINTING TO LAST RB.. 
* 
          SOD    TEMP 
          LDM    RBSIZE 
          STD    D.T0 
  
CALPTR4   LDD    TEMP              GET BYTE INDEX 
          STM    RBTO 
          LDD    D.T0              GET PRU
          STM    PRU
CALPTR4A  UJK  CALPTRX             EXIT...
  
*         PROCESS ERRORS
  
CALPTR5   LDC    0                 CHECK FLAG 
CALPTRA   EQU    *-1
          ZJN  CALPTR5A 
CALPTR7   LCN    1                 ERRORS 
          UJN  CALPTR4A 
  
CALPTR5A  LDN    CODE21            *BAD PRU INDEX*
          RJM  ERR
          QUAL   *
CVPR.     ENDIF 
CVRP.     IF     DEF,CVRP.
          QUAL   CALPTR 
 CRP      SPACE  5,10 
**        CRP -  CONVERT RBT ADDRESS TO REL PRU OFFSET
*                SHOULD USED ON PFD AND RBTC FILES ONLY 
* 
*         ENTRY  (A)=FIRST WORD PAIR LINK 
*                (D.Z2)=CURRENT RBT WORD PAIR ADDRESS 
*                (D.Z3)=BYTE INDEX
*                (D.Z5)=CURRENT PRU 
* 
*         EXIT   (D.Z4,D.Z5)=REL PRU OFFSET 
*                (A)=-1, IF ERROR 
* 
*         CALLS  FINDRBR,GETRBT.
  
  
CRP4      LCN    1                 ERROR
  
CRP       ENM    X                 ENTRY/EXIT LINE
          STM    RBTWRD+C.RBTWPL
          STD    D.Z7 
          RJM    GETRBT            READ FIRST WORD PAIR 
          LOAD   RBTWRD+5+C.RBTAUS
          STD    D.T4 
          LDN    0
          STD    D.Z4 
          UJN    CRP5              ENTER LOOP 
  
 CRP1     LOAD   RBTWRD+C.RBTWPL
          ZJN    CRP4              IF LINK ZERO 
          STD    D.Z7 
          RJM    GETRBT            READ IN WORD PAIR
CRP5      LDD    D.Z7 
          SBD    D.Z2 
          ZJN    CRP2              IF CORRECT WORD PAIR 
  
          LDD    RBTWRD+C.RBTRBR
          LPN    7
          STD    D.T1              BYTE INDEX 
CRP6      LDM    RBTWRD+2,D.T1
          ZJN    CRP7              SKIP INCREMENT PRU COUNT IF RB ZERO
          LDD    D.T4              RBSIZE 
          RAD    D.Z5 
          SHN    -12
          RAD    D.Z4 
CRP7      AOD    D.T1 
          SBN    8
          MJN    CRP6 
          UJN    CRP1              GO TO NEXT LINK
  
*         PROCESS LAST WORD PAIR
  
 CRP2     LOAD   RBTWRD+C.RBTRBR      COMPARE BYTE INDEXS 
          LMD    D.Z3 
          LPN    7
          NJN    CRP3 
          UJK    CRPX        EXIT IF AT END 
CRP3      LDD    D.T4              ADVANCE PRU COUNT
          RAD    D.Z5 
          SHN    -12
          RAD    D.Z4 
          AOM    RBTWRD+C.RBTRBR   ADVANCE BYTE INDEX 
          LPN    7
          NJN    CRP2              LOOP 
          UJK    CRP4              IF ERROR 
DZ1       BSS    10D
          QUAL   *
CVRP.     ENDIF 
 CRP=     IF     DEF,CVRP.. 
 CRP=     SPACE  5,10 
          QUAL   CALPTR 
**        CRP= - CONVERT LONG TO SHORT DISK ADDRESSES 
* 
*         ENTRY  (A)  = FIRST WORD PAIR ORDINAL 
*                D.Z2 = CURRENT WORD PAIR ORDINAL 
*                D.Z3 = BYTE INDEX
*                D.Z4 = CURRENT PRU 
* 
*         EXIT   (A) = -1 IF ERROR OCCURED
*                D.Z4,D.Z5 = PRU OFFSET 
  
 CRP1     SOD    D.Z5 
          PJN  CRP=X
          SOD    D.Z4 
          AOD    D.Z5 
  
 CRP=     ENM    X                 ENTRY / EXIT 
  
          STD    D.Z1              FIRST WORD PAIR ORDINAL
          LDK    P.ZERO 
          CRD    D.T0 
          RJM  EXRBT
          LDD    D.Z4              UPPER 12 BITS OF PRU OFFSET
          ADD    D.Z5              LOWER 12 BITS OF PRU OFFSET
          NJN  CRP1                ZERO OFFSET MEANS ERROR OCCURED
          LCN    1
          UJK  CRP=X
          QUAL   *
 CRP=     ENDIF 
 CPR=     IF     DEF,CVPR.. 
 CPR=     SPACE  5,10 
          QUAL   CALPTR 
**        CPR= - CONVERT SHORT TO LONG DISK ADDRESSES 
* 
*         ENTRY  (A)  = 0  ABORT ON ERRORS
*                     " 0  RETURN ON ERRORS 
*                D.T1,D.T2 = PRU INDEX
*                D.T3 " 0  FST ADDRESS
*                     = 0  D.Z1 CONTAINS FIRST WORD PAIR ORDINAL
* 
*         EXIT   (A)  = -1  ERROR OCCURED 
*                RBTA = CURRENT WORD PAIR ORDINAL 
*                RBTO = CURRENT BYTE OFFSET 
*                PRU  = CURRENT PRU 
  
 CPR1     LDC    *-*               ** INSTRUCTION MODIFIED ** 
          NJN  CPR2                RETURN ERROR CONDITION 
          LDN    CODE21 
          RJM  ERR
  
 CPR2     LCN    1
  
 CPR=     ENM    X                 ENTRY / EXIT 
  
          STM    CPR1+1            ERROR EXIT FLAG
          AOD    D.T2 
          SHN    -12
          RAD    D.T1 
          RJM  EXRBT
          LDD    D.T0+C.FLRBWP
          STW    RBTA 
          LDD    D.T0+C.FCB 
          LPN    7
          STW    RBTO 
          STD    D.T0+C.FCB 
          LDD    D.T0+C.FLPRU 
          STW    PRU
          LDD    D.Z7 
          ADD    D.Z6 
          NJN  CPR1                POSITION PAST END OF CHAIN 
          UJK  CPR=X
          QUAL   *
 CPR=     ENDIF 
          IF     -DEF,CVPR..,1
 EXRBT    IF     DEF,CVRP.. 
 EXRBT    SPACE  5,10 
          QUAL   CALPTR 
**        EXRBT - ISSUE EX.RBT M.ICE FUNCTION 
* 
*         ENTRY  D.Z0-D.Z4 = VALUES FOR PPMES1
*                D.T0-D.T4 = VALUES FOR M.ICE REQUEST 
* 
*         EXIT   D.Z3-D.Z7 = PPMES2 RESPONCE
*                D.T0-D.T4 = PPMES1 RESPONCE
  
 EXRBT    ENM    X                 ENTRY / EXIT 
  
          LDD    D.PPMES1 
          CWD    D.Z0 
          LDK    EX.RBT 
          STD    D.T0+4 
          LDK    M.ICE
          RJM  R.MTR
          LDD    D.PPMES1 
          CRD    D.T0 
          ADN    1
          CRD    D.Z3 
          UJK  EXRBTX 
          QUAL   *
 EXRBT    ENDIF 
          ENDX
