ASMB,R,Q,C
      HED #CLON 91750-1X001 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM #CLON,7 91750-1X001 REV.2013 800821 RTE-IVB W/S.M.
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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.   *
******************************************************************
      SPC 1 
      ENT #CLON 
* 
      EXT IDGET,IDDUP,IDRPL,IDRPD,OPEN,CLOSE
      EXT $CVT1,.MVW,.LBT,.SBT,READF
      SUP 
* 
* NAME:   #CLON 
* SOURCE: 91750-18001 
* RELOC:  PART OF 91750-12014 
* PGMR:   JIM HARTSELL
* 
* 
*   >>>>>>>    SUBROUTINE TO CLONE A COPY OF A PROGRAM     <<<<<<<
*                     CALLED AS A RESULT OF 
*                  EXECW & PTOPM CALLS TO #SCSM 
* 
* 
*   >>>>>>>  RETURNS WITH ADDRESS OF CLONED PROGRAM NAME   <<<<<<<
* 
* 
*   >>>>>>>      DOES NOT SCHEDULE THE CLONED PROGRAM      <<<<<<<
* 
* 
* 
*  CALLING SEQUENCES: 
* 
*      CLONE A PROGRAM: 
* 
*        (A) = LU (DESTINATION SESSION ID). 
*        (B) = ADDRESS OF ORIGINAL PROGRAM NAME-ARRAY.
*        JSB #CLON
*         P+1       ERROR RETURN. COULD NOT "RP" TO CLONED ID SEGMENT.
*         P+2       PROGRAM KNOWN TO SYSTEM BUT CANNOT BE CLONED. 
*         P+3       NORMAL RETURN. (B) = ADDR OF CLONED PROGRAM NAME. 
* 
* 
*      RELEASE CLONED ID SEGMENT: 
* 
*        (A) = 0
*        (B) = ADDRESS OF CLONED PROGRAM NAME-ARRAY.
*        JSB #CLON
*         <RETURN>
      SKP 
B     EQU 1 
* 
* CHECK WHICH TYPE OF ENTRY.
* 
#CLON NOP           ENTRY.
      STA CLU       SAVE DEST. SESSION ID.
      STB NAMAD     SAVE ADDRESS OF PROGRAM NAME. 
      SZA,RSS       CHECK TYPE OF ENTRY.
      JMP UNCLO     GO HANDLE TERMINATION.
* 
* CHECK IF PROGRAM IS KNOWN TO THE SYSTEM.  IF IT IS, ATTEMPT TO USE
* IDDUP TO CREATE ANOTHER COPY. IF IT CAN'T BE DUP'D, USE ORIGINAL. 
* 
      JSB IDGET     GET ID SEG ADDR OF PROGRAM. 
      DEF *+2 
NAMAD NOP 
* 
      SZA,RSS 
      JMP UNKNO     NOT FOUND.
* 
      JSB CLONE     GENERATE A NEW NAME INTO "XNAME". 
      JMP EXIT2     COULD NOT CLONE NAME. USE ORIGINAL. 
* 
      JSB IDDUP     DUPLICATE AN ID SEGMENT THAT
      DEF *+3         IS ALREADY IN THE RTE SYSTEM, 
      DEF NAMAD,I     AND GIVE IT THE NEW NAME. 
DXNAM DEF XNAME 
* 
      SZA           WAS IT DUPLICATED?
      JMP EXIT2       NO. USE ORIGINAL NAME.
      JMP EXIT3       YES. USE CLONED NAME. 
* 
* PROGRAM NAME NOT KNOWN TO SYSTEM. 
* LOOK FOR ORIGINAL PROGRAM FILE (TO "RP" AS A CLONE).
* 
UNKNO JSB OPEN      TRY TO OPEN THE FILE. 
      DEF *+5 
      DEF FDCB
      DEF IERR
      DEF NAMAD,I 
      DEF B5        FORCE TO TYPE 1.
* 
      SSA,RSS       ERROR?
      JMP CLONP     NO. GO CHECK "DON'T COPY" FLAG. 
* 
      LDB NAMAD     YES. BLANK 6TH CHAR AND TRY AGAIN.
      ADB B2
      LDA B,I 
      AND B1774 
      IOR BLANK 
      STA B,I 
* 
      JSB OPEN
      DEF *+5 
      DEF FDCB
      DEF IERR
      DEF NAMAD,I 
      DEF B5        FORCE TO TYPE 1.
* 
      SSA           ERROR?
      JMP EXIT1     YES. PROGRAM NOT FOUND. 
* 
* FOUND. CLONE THE PROGRAM NAME AND "RP" THE PROGRAM FILE.
* 
CLONP JSB READF     READ IN THE ID SEGMENT (1ST RECORD).
      DEF *+5 
      DEF FDCB
      DEF IERR
      DEF IBUF
      DEF D33 
* 
      SSA,RSS 
      JMP CKBIT     NO ERROR.       
* 
EXITC JSB CLOSE     HAD AN ERROR. 
      DEF *+3 
      DEF FDCB
      DEF IERR
* 
      JMP EXIT1 
* 
CKBIT LDA IBUF+31   CHECK "DON'T CLONE" BIT (BIT 10). 
      ALF,RAL 
      SSA 
      JMP .RP.      DON'T CLONE THIS PROGRAM. 
* 
      JSB CLONE     OK TO CLONE. GENERATE A NEW NAME. 
      JMP EXITC     COULD NOT CLONE THE NAME. 
* 
.RP.  JSB IDRPL     "RP" THE PROGRAM FILE.
      DEF *+4 
      DEF FDCB
      DEF IERR
      DEF XNAME 
* 
      SZA           WAS IT DONE?
      JMP EXITC     NO. FMP ERROR.
* 
      JSB CLOSE     YES. CLOSE THE FILE.
      DEF *+3 
      DEF FDCB
      DEF IERR
* 
EXIT3 LDB DXNAM     RETURN WITH (B) = ADDR OF NEW NAME. 
      ISZ #CLON 
EXIT2 ISZ #CLON 
EXIT1 JMP #CLON,I 
      SPC 5 
* 
* ENTRY WITH (A)-REGISTER = 0.  RELEASE CLONED ID SEGMENT.
* THE RELEASE WILL NOT TAKE PLACE IF THE PROGRAM IS NOT DORMANT...
* IN THIS CASE THE ID SEGMENT WILL BE RELEASED BY THE SESSION MONITOR 
* WHEN THE SESSION IS LOGGED OFF. 
* 
UNCLO JSB IDRPD 
      DEF *+3 
      DEF NAMAD,I 
      DEF IERR
* 
      JMP #CLON,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO FORM THE CLONE OF A PROGRAM NAME INTO ARRAY "XNAME".
*   IF INTEGER LU (DEST SESSION ID) TO BE ATTACHED IS .GT. 99, OR IF
*   CLONE WITH LU ALREADY EXISTS IN THE SYSTEM, THE ROUTINE WILL TRY
*   ".A", ".B", ".C", ... UNTIL ONE IS FOUND THAT CAN BE USED.
* RETURNS TO P+1 IF IT CANNOT CLONE, ELSE RETURNS TO P+2. 
* 
CLONE NOP 
* 
      LDA NAMAD     MOVE NAME TO NEW NAME AREA. 
      LDB DXNAM 
      JSB .MVW
      DEF B3
      NOP 
* 
      CLA           FIND FIRST ZERO OR BLANK CHARACTER
      STA TEMP        IN NAME, IF ANY.
      LDA N3
      STA CNTR      LIMIT COUNT = 1ST 3 CHAR OF NAME. 
      LDB DXNAM 
      RBL           BYTE ADDRESS OF 1ST CHARACTER.
* 
LOOP  JSB .LBT      NEXT CHAR ZERO OR BLANK?
      SZA 
      CPA B40 
      JMP SDONE     YES. GO SEE WHAT WE GOT.
* 
      ISZ TEMP      NO. COUNT THE VALID NAME-CHARACTER. 
      ISZ CNTR
      JMP LOOP      GO CHECK NEXT CHARACTER.
* 
SDONE LDA ".@"      INITIALIZE FOR ".A", ".B", ".C",... 
      STA NEXT
      LDA DXNAM     INITIALIZE BYTE POINTER TO
      RAL             "LU SUFFIX" ADDRESS OF NAME.
      ADA TEMP
      STA PTR 
* 
      LDA CLU       IF LU (SESSION ID) .GT. 99, 
      CMA,INA         GO DIRECTLY TO ".A".
      ADA D99 
      SSA 
      JMP NXT.X 
* 
      LDA CLU       CONVERT TO ASCII LU (SESSION ID). 
      CCE 
      JSB $CVT1 
      CLB           SPLIT DIGITS INTO SEPARATE WORDS. 
      RRR 8 
      STA LUH 
      BLF,BLF 
      STB LUL 
* 
      LDB B60       IF LUH = BLANK (LU .LE. 9), 
      CPA BLANK 
      STB LUH         STORE ASCII ZERO. 
* 
NWNAM LDB PTR       BUILD CLONED NAME FROM LUH, LUL.
      LDA LUH 
      JSB .SBT
      LDA LUL 
      JSB .SBT
* 
      JSB IDGET     PROGRAM NAME ALREADY IN SYSTEM? 
      DEF *+2 
      DEF XNAME 
* 
      SZA,RSS 
      JMP CLNEX     NO. TAKE NORMAL RETURN. 
* 
NXT.X ISZ NEXT      YES. TRY NEXT ".X". 
      CLB           SPLIT INTO LUH, LUL.
      LDA NEXT
      RRR 8 
      STA LUH 
      BLF,BLF 
      STB LUL 
* 
      CMB,INB       CHECK IF WE'VE GONE PAST ".Z".
      ADB B132
      SSB,RSS 
      JMP NWNAM     NO. KEEP TRYING.
      RSS           YES. ERROR EXIT - CAN'T CLONE.
* 
CLNEX ISZ CLONE     BUMP FOR NORMAL EXIT. 
      JMP CLONE,I 
      SKP 
* 
* CONSTANTS AND STORAGE.
* 
B2    OCT 2 
B3    OCT 3 
B5    OCT 5 
B40   OCT 40
B60   OCT 60
B132  OCT 132 
B1774 OCT 177400
N3    DEC -3
D33   DEC 33
D99   DEC 99
".@"  ASC 1,.@
BLANK OCT 40
TEMP  NOP 
PTR   NOP 
CNTR  NOP 
NEXT  NOP 
LUH   NOP 
LUL   NOP 
CLU   NOP 
XNAME BSS 3 
FDCB  BSS 144 
IERR  NOP 
IBUF  BSS 33
* 
      BSS 0         SIZE OF #CLON.
* 
      END 
                                                                                                                                                                                                