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 * 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