ASMB,R,L,C
      HED "RP.." FMGR ROUTINE TO DO :RP,X,Y,Z 
*     SOURCE: 92067-18231 
*     RELOC:  92067-16185 
*     PGMR:   D.L.B.
* 
*  ***************************************************************
*  * (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 RP..,8 92067-16185 REV.2026 800306
* 
*   MODIFICATION RECORD:
*       DATE   REASON  (BY WHOM)
*  1)  800306  TO CALL "IDRP" INSTEAD OF "IDRPL" THUS ALLOWING
*              TYPE 6 FILES TO RESIDE ON ANY CARTRIDGE. 
*              REMOVED CARTRIDGE DEFAULT TO LU 2 AND 3. 
*              ADDED OPTIONAL THIRD PARAMETER:  PROGRAM NAME
*              DIFFERENT FROM FILE NAME.               (DCL)
* 
      ENT RP..
      EXT IDSGA,MSS.,EXEC,OPEN,IER.,.E.R. 
      EXT IDRPD,.ENTR,I.BUF,N.OPL                            800306 
      EXT IDRP,..BF.,..BL.                                   800306 
*      EXT BUF.,READF 
      SPC 1 
A     EQU 0 
      SPC 1 
DUMMY NOP           DUMMY PARAMETER 
PBUF  NOP           PARAMETER BUFFER
IERR  NOP           RETURNED ERROR PARAMETER
RP..  NOP           ENTRY 
      JSB .ENTR 
      DEF DUMMY 
      LDA PBUF      CALCULATE THE ADDRESS OF THE
      ADA O4        TWO PARAMETERS
      LDB A,I       GET PARAMETER TYPE
      INA           BUMP TO THE NAME
      STA PRAM2 
      SZB,RSS       CHECK IF SECOND PARAMETER 
      JMP SKPCC     SKIP THE :RP,,XXXXX 
      SPC 1 
      JSB IDSGA     FIND IF ID FOR 2ND PARAMETER
      DEF *+2 
PRAM2 DEF * 
      SEZ,RSS       FOUND?
      JMP FOUN1     YES, :RP,, IT 
      JSB MSS.      NO, OUTPUT FMGR 009 
      DEF *+2 
      DEF D2009 
      JMP SKPCC     NOW TRY :RP,
      SPC 1 
FOUN1 JSB IDRPD     DELETE THE ID 
      DEF *+3 
      DEF PRAM2,I   NAME OF ID
      DEF DUMMY     DONOT CHANGE 6P IF GOOD RETURN
      SZA           CHECK IF ANY ERRORS 
      JMP EXIT      YES, RETURN NOW 
      SPC 1 
      JSB EXEC      NO, RELEASE ANY TRACKS
      DEF *+3 
      DEF O5
      DEF OM1 
      SPC 1 
SKPCC LDA PBUF,I    GET THE 1ST PARAMETER TYPE
      SZA,RSS       CHECK IF 1ST PARAMETER
      JMP RP..,I    NO, JUST RETURN DONE
* 
      LDA PBUF      LOAD PARAMETER ARRAY ADDRESS             800306 
      ADA D8        POINT TO THIRD PARAMETER                 800306 
      LDB A,I       LOAD PARAMETER TYPE                      800306 
* 
      SZB,RSS       IF 3RD PARAMETER ABSENT                  800306 
      LDA PBUF        THEN DEFAULT PROG NAME TO FILE NAME    800306 
* 
      INA           POINT TO BEGINNING OF NAME               800306 
      STA PRAM3     SAVE PROGRAM NAME ADDRESS                800306 
* 
      JSB IDSGA     FIND IF EXISTS
      DEF *+2 
PRAM3 DEF *-*       (PROGRAM NAME)                           800306 
* 
      SEZ           CHECK IF FOUND? 
      JMP FOUN2     NO, THEN PROCEED TO :RP,
      LDA D23       YES, DUPLICATE PROGRAM
EXIT  STA IERR,I    RETURN FMGR 023 
      JMP RP..,I    ERROR RETURN, WITH ERROR CHANGED!!
      SPC 1 
FOUN2 LDA DFDIS,I   GET DISC SUBPARAMETER 
* 
** REMOVE THE CARTRIDGE DEFAULT TO LU 2 AND 3   (DCL)  800306 
**      SZA,RSS       IF NOT SPECIFIED, 
**      LDA OM2       TRY FINDING IT ON LU 2
* 
      STA DIS       SAVE IT 
      ISZ PBUF      POINT TO FILE NAME                       800306 
* 
      JSB OPEN      TRY OPENING THE TYPE 6 FILE 
      DEF *+7 
      DEF I.BUF     DCB 
      DEF .E.R.     ERROR RETURN
      DEF PBUF,I    FILE NAME 
      DEF O5        NON-EXCLUSIVE, FORCE TYPE 1 
      DEF N.OPL     FILE SECURITY CODE
      DEF DIS       DISC CRN/LU 
* 
** REMOVE THE CARTRIDGE DEFAULT TO LU 2 AND 3   (DCL)  800306 
**      LDA .E.R.     GET ERROR CODE
**      CPA OM6       FILE NOT FOUND? 
**      RSS           NOT FOUND, SO CHECK IF DISC WAS SPECIFIED 
**      JMP FOUN3     FOUND, SO CHECK FOR ANY ERROR AT ALL
**      LDA DFDIS,I   WAS DISC SPECIFIED AS A SUBPARAMETER? 
**      SZA 
**      JMP FOUN3     SPECIFIED, SO RETURN THE ERROR
**      LDA SECT3,I   NOT SPECIFIED, SO CHECK IF LU 3 EXISTS
**      SZA,RSS 
**      JMP FOUN3     NO LU 3, SO RETURN ERROR (NOT FOUND ON LU 2)
**
**      JSB OPEN      LU 3 EXISTS, TRY OPEN ON LU 3 
**      DEF *+7 
**      DEF I.BUF     DCB 
**      DEF .E.R.     ERROR RETURN
**      DEF PBUF,I    FILE NAME 
**      DEF O5        NON-EXCLUSIVE, FORCE TYPE 1 
**      DEF N.OPL     FILE SECURITY CODE
**      DEF OM3       LU 3
*** 
**FOUN3 LDA .E.R.     GET ERROR CODE
**      SSA           CHECK FOR OPEN ERROR
**      JMP FOUN4     YES, SO RETURN THE ERROR
*** 
**      JSB READF     NOW READ THE 1ST RECORD 
**      DEF *+5 
**      DEF I.BUF 
**      DEF .E.R. 
**      DEF BUF.
**      DEF D128
**FOUN4 EQU * 
* 
      JSB IER.      CHECK IF ANY ERROR
      DEF *+1 
* 
      JSB IDRP      NOW DO THE :RP,                          800306 
       DEF *+1+5                                             800306 
       DEF I.BUF     (DCB FOR FILE) 
       DEF DUMMY     (GET ERROR LOCALLY)
       DEF PRAM3,I   (PROGRAM NAME)                          800306 
       DEF ..BF.     (DISK COPY BUFFER)                      800306 
       DEF ..BL.     (BUFFER LENGTH)                         800306 
* 
      SZA,RSS       CHECK IF ANY ERROR? 
      JMP RP..,I    NO, RETURN DONE 
      JMP EXIT      YES, SET THE ERROR NUMBER 
* 
      SPC 1 
DFDIS DEF N.OPL+1 
DIS   NOP 
O4    OCT 4 
O5    OCT 5 
D8    DEC 8 
D23   DEC 23
D2009 DEC 2009
OM1   OCT -1
* 
**SECT3 EQU 1760B 
**D128  DEC 128 
**OM2   OCT -2
**OM3   OCT -3
**OM6   OCT -6
      END 
                                                                                                                                                                                                                                          