ASMB,Q,C
      NAM JDRTP,7 92425-1X057 REV.2001 791121 
* 
*---------------------------------------------------------------
* 
*     RELOC.     92425-1X057 PHANTOM
*     SOURCE     92425-18057
* 
*     PRGM: DICK LAMPMAN
* 
*     HP 92425C TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
*     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
*     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
* 
*     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 
*     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
*     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
*     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
*     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
* 
*---------------------------------------------------------------
* 
* 
A     EQU 0 
B     EQU 1 
* 
      ENT JDRTP 
      EXT DRTXX,.ENTR,$LIBR,$LIBX 
* 
AI    NOP 
AIVAL NOP 
JDRTP NOP 
      JSB .ENTR 
      DEF AI
* 
      LDA ADRTX 
      SSA,RSS       IS INIDIRECT BIT SET? 
      JMP STADR     NO
      AND MASK
      LDA A,I 
STADR STA ADRTZ     SAVE ADRESS OF DRTXX. 
* 
      CLA 
      STA ADDR     CLEAR ADDRESS. 
* 
      LDA AI,I      CHECK PARAMETER 
      SZA,RSS 
      JMP ERR1          INDEX = 0 
* 
      SSA 
      JMP ERR2      INDEX IS NEGATIVE 
* 
      LDB ADRTZ     CHECK IF DRTXX IS AVAILABLE.
      SZB,RSS       NO EXTERNAL, SO GET OUT 
      JMP ERR3
* 
      INB          NOW CHECK IF (INDEX>LENGTH)
      XLB B,I          GET TABLE LENGTH 
      CMA,INA          SUBTRACT INDEX FROM LENGTH 
      ADA B 
      SSA           INDEX IS TOO BIG
      JMP ERR4
* 
      LDA ADRTZ     COMPUTE ADDRESS 
      INA 
      ADA AI,I
      STA ADDR
* 
      JSB $LIBR     *** GO PRIVELEGED TO PERFORM STORE
      NOP           *** 
      LDA AIVAL,I   *** 
      STA ADDR,I    *** 
      JSB $LIBX     *** 
      DEF *+1       *** 
      DEF EX        *** 
* 
EX    CLB 
      LDA ADDR
      JMP JDRTP,I 
* 
ERR1  CCB 
      JMP ERRX
ERR2  LDB M2
      JMP ERRX
ERR3  LDB M3
      JMP ERRX
ERR4  LDB M4
ERRX  JMP JDRTP,I 
* 
M2    DEC -2
M3    DEC -3
M4    DEC -4
ADDR  BSS 1 
ADRTZ BSS 1 
MASK  OCT 77777 
ADRTX DEF DRTXX 
      END 
                                                                                  