ASMB,R,L,C * NAM PUTID,7 09570-16723 PRE-REL 770302 NAM PUTID,7 PRE-REL (RTE-IV) 780327 (DLB) * *-------------------------------------------------------- * * RELOC. 09570-16723 * SOURCE 09570-18723 * * W A GROVES 22 FEB 77 PRE-RELEASE * MODIFIED 3-3-77 (DLB) * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY,1976. * ALL RIGHTS RESERVED.THE INFORMATION CONTAINED ON * THIS MEDIUM MAY BE USED WITH ONLY ONE COMPUTER * AT A TIME.IT SHALL NOT OTHERWISE BE RECORDED, * TRANSMITTED,OR STORED IN A RETRIEVAL SYSTEM. * COPYING OR OTHER REPRODUCTION WITHOUT PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY IS PROHIBITED, * EXCEPT THAT ONE COPY MAY BE MADE AND RETAINED FOR ARCHIVE * PURPOSES ONLY. * * --------------- * * THE INFORMATION CONTAINED ON THIS MEDIUM IS PROPRIETARY * TO HEWLETT-PACKARD COMPANY. IT MAY BE USED WITH ONE * COMPUTER ONLY AND IS NOT TO BE DISCLOSED TO ANY THIRD * PARTIES OR REPRODUCED IN ANY FORM EXCEPT THAT IT MAY BE * TRANSFERRED TO ONE BACKUP COMPUTER DURING A COMPUTER * MALFUNCTION OR DURING PREVENTIVE MAINTENANCE. * *-------------------------------------------------------- ENT PUTID EXT IDRPL,IDDUP,IDSGA,.DFER EXT .ENTR,FSTAT,LOPEN EXT LCLOS EXT .XLA A EQU 0 B EQU 1 XEQT EQU 1717B SECT3 EQU 1760B * * THIS SUBROUTINE WILL DO WHATEVER IS NECESSARY * TO MAKE A PROGRAM SCHEDULEABLE BY AN EXEC CALL. * THE PROGRAM WILL BE RENAMED WITH TERMINAL LU * AS THE LAST 2 CHARACTERS OF THE NAME IF THE * ID SESSION BIT OF THE CALLING PROGRAM IS SET * AND THE "IH" FLAG IS NOT SET UNLESS THE PROGRAM * TO BE SCHEDULED IS A NON-DUPLICATABLE PROGRAM. * (NOT SET UP AS TYPE 6 FILE OR IF ID-SEGMENT IS * IN CORE, ID SEGMENT WAS NOT SET UP BY ":RP") * * CALLING SEQUENCE: * CALL PUTID(IDCB,IERR,NAME,LU,IRPFLG) * * WHERE: * IDCB= 144 WORD FMGR DCB BUFFER FOR SUBROUTINE USE * IERR= FMGR ERROR RETURN VARIABLE * NAME= 6-ELEMENT ARRAY AS FOLLOWS: * * NAME(1-3)= PROGRAM NAME * NAME(4)= NOT USED FOR * "NAMR" COMPATABILITY. * NAME(5)= TYPE 6 FILE SECURITY * IF "IH", INHIBIT RENAMING. * NAME(6)= TYPE 6 FILE CRN * IF "0", SEARCH LU 2,3 * NAME(1-3) WILL BE CHANGED BY PUTID * TO THE APPROPRIATE SESSION NAME * IF SESSION CONDITIONS ARE MET. * LU= TERMINAL LU * IRPFLG= NON-ZERO IF CALLING PROGRAM * SHOULD RELEASE PROGRAM'S ID * SEGMENT (CALL IDRPD) AFTER PROGRAM * HAS COMPLETED. * HED FORTRAN EXAMPLE * FORTRAN EXAMPLE: * FTN4,L * PROGRAM RPTST(3,1000) * DIMENSION NAME(13),IBUF(10),IDCB(144) * C GET TERMINAL LU (ITMLU MUST BE CALLED FIRST!) * LU=ITMLU(IDMY) * WRITE (LU,10000) * 10000 FORMAT ("ENTER PROGRAM NAMR") * READ (LU,10100)NAME * 10100 FORMAT (13A2) * C * C PARSE USING NAMR * C * IST=1 * IEND=26 * CALL NAMR(IBUF,NAME,IEND,IST) * CALL PUTID(IDCB,IERR,IBUF,LU,IRP) * IF (IERR .NE. 0) GO TO 9000 * C * C SCHEDULE PROGRAM * C * CALL EXEC(100027B,IBUF,LU) * GO TO 8000 * 100 IF (IRP .NE. 0) CALL IDRPD(IBUF) * STOP * 8000 WRITE (LU,10200) * 10200 FORMAT ("SCHEDULE CALL FAILED.") * GO TO 100 * 9000 WRITE (LU,10300) IERR,(IBUF(I),I=1,3) * 10300 FORMAT (/"/FMGR: ERR#"I6" ON "3A2) * GO TO 100 * END * END$ HED SUBROUTINE TO MAKE PROGRAM SCHEDULEABLE ADDCB NOP * ADERR NOP * ADNAM NOP * ADLU NOP * ADRPF NOP * PUTID NOP * JSB .ENTR * DEF ADDCB * JSB .DFER * MOVE PROGRAM NAME DEF NWNAM * TO INTERNAL BUFFER. DEF ADNAM,I * LDB ADNAM * ADB =D4 * LDA B,I * GET FILE SECURITY. STA SEC * INB * LDA B,I * GET FILE CRN STA CRN * CLA * STA ADRPF,I * CLEAR RP FLAG STA RNFLG * CLEAR RENAME FLAG. STA ADERR,I * CLEAR ERROR VARIABLE LDA IH * CPA SEC * INHIBIT OPTION? JMP TRYOV * YES. LDA XEQT * ADA =D20 * CHECK IF SESSION BIT IS SET JSB .XLA * DEF A,I * LDA A,I AND SESBT * SZA,RSS * IN SESSION? JMP TRYOV * NO. CCA * YES. SET RENAMING FLAG. STA RNFLG * CLB * LDA ADLU,I * GET TERMINAL LU DIV =D10 * CHANGE TERMINAL LU TO ASCII ALF,ALF * IOR B * IOR "00" * STA TEMP * DLD NWNAM * GET FIRST 2 CHARACTERS OF AND =B377 * PROGRAM NAME CPA =B40 * IMBEDDED SPACE? LDA DOT * YES. REPLACE WITH DOT. IOR NWNAM * STA NWNAM * LSR 8 * CHECK THIRD CHARACTER. CPB =B40 * BLANK? LDB DOT * YES. MAKE DOT. LDA TEMP * RRL 8 * IOR =B40 * MAKE LAST CHARACTER BLANK. STB NWNAM+1 * STA NWNAM+2 * TRYOV JSB IDSGA * IS GENERIC ID-SEGMENT IN CORE? DEF *+2 * DEF ADNAM,I * USE GENERIC NAME. SZA,RSS * FIND IT? JMP RPIT * NO. LDB RNFLG * YES. SZB,RSS * NEED TO RENAME IT? JMP PUTID,I * NO. EXIT. ADA =D26 * INDX TO DISC ADDRESS WORD JSB .XLA * GET DISC ADDRESS DEF A,I * LDA A,I STA TEMP * SAVE TILL LATER JSB IDDUP * TRY IN-CORE DUPLICATE. DEF *+4 * DEF ADNAM,I * OLD NAME DEF NWNAM * NEW NAME DEF ADERR,I * ERROR VARIABLE SZA,RSS * ERROR? JMP RPFEX * NO. EXIT. CPA =D16 * (UNKNOWN BASKINS ERROR) JMP OKERR * EXIT. CPA =D17 * ID SEGMENT NOT SET-UP BR ":RP" ? JMP OKERR * YES. USE GENERIC NAME ID. CPA =D23 * DUPLICATE ID ? RSS * YES. JMP PUTID,I * ERROR EXIT. JSB IDSGA * GET ID# OF DUPLICATE ID. DEF *+2 * DEF NWNAM * SZA,RSS * FIND ID? JMP TRYOV * NO. WHO OFF'D MY ID? ADA =D26 * YES. BUMP TO DISC TRACK ADDRESS. JSB .XLA * DEF A,I * LDA A,I CPA TEMP * DISC ADDRESS SAME AS GENERIC ID? JMP RPFEX * YES. USE IT, BUT SET ":RP,," FLAG. JMP BDERR * NO. ERROR EXIT. RPIT JSB IDSGA * DEF *+2 * SEE IF RENAMED ID IS IN CORE DEF NWNAM * SZA * FIND IT? JMP RPFEX * YES. EXIT. LDA CRN * NO. STA LUCRN * SZA * CRN SEARCH? JMP ONECR * NO. USE GIVEN CRN. LDA SECT3 * YES. GET# OF LU 3 SECTOR/TRACK SZA * LU 3 MISSING? JMP GTCRN * NO. LDA =D-2 * YES. SEARCH LU 2 ONLY. STA LUCRN * ONECR CCA * ONLY ONE CARTRIDGE TO SEARCH. STA #CRNS * JMP OPNIT * TRY TO OPEN. GTCRN JSB FSTAT * GET MOUNTED CARTRIDGE LIST DEF *+2 * DEF ADDCB,I *3-3 USE PASSED DCB BUFFER CLA * STA LUCRN * LDA ADDCB * STA CRADD * SET CURRENT ADDRESS TO START OF BUFFER GTLOP LDA CRADD,I * GET CARTRIDGE LU SZA,RSS * END OF LIST? JMP OPNIT * YES. AND =B77 * CPA =D2 * LU=2? JMP FOUND * YES. CPA =D3 * NO. IS THIS LU 3? JMP FOUND * YES. LDA CRADD * NO. ADA =D4 * BUMP ADDRESS STA CRADD * JMP GTLOP * DO SOME MORE. FOUND CMA,INA * STA LUCRN * SAVE STARTING LU. LDA =D-2 * SET # CRN'S TO SEARCH AS 2. STA #CRNS * OPNIT JSB LOPEN * OPEN TYPE 6 FILE DEF *+7 * FOR THIS PROGRAM DEF ADDCB,I * DEF ADERR,I * DEF ADNAM,I * USE GENERIC NAME DEF D1 * DEF SEC * DEF LUCRN * USE APPROPRIATE CRN SSA,RSS * OPEN SUCCESSFUL? JMP RPLIT * YES. CPA =D-6 * NO. VALID ERROR (NOT FOUND) ? RSS * YES. JMP PUTID,I * NO. BAIL OUT. ISZ #CRNS * SEARCH ANOTHER CRN? RSS * YES. JMP PUTID,I * NO. BAIL OUT. LDA LUCRN * GET CURRENT CRN. CLB,INB * CPA =D-2 * WAS THIS LU 2? CCB * YES. ADA B * BUMP CRN UP OR DOWN APPROPRIATELY. STA LUCRN * JMP OPNIT * TRY OPEN AGAIN RPLIT JSB IDRPL * DEF *+4 * DO ":RP" ON PROGRAM DEF ADDCB,I * DEF ADERR,I * DEF NWNAM * PUT IN NEW NAME JSB LCLOS * DEF *+2 * CLOSE PROGRAM FILE DEF ADDCB,I * LDA ADERR,I * SZA,RSS * ANY ERROR? JMP RPFEX * NO. EXIT. CPA =D23 * YES. DUPLICATE ID? JMP RPFEX * USE THE ID ALREADY THERE. JMP PUTID,I * ERROR EXIT. RPFEX CCA * STA ADRPF,I * SET ":RP,," FLAG. CLA * STA ADERR,I * CLEAR ERROR VARIABLE. BDERR JSB .DFER * DEF ADNAM,I * RETURN NEW NAME (IF CHANGED) DEF NWNAM * JMP PUTID,I * EXIT OKERR CLA * STA ADERR,I * RESET ERROR PARAMETER JMP PUTID,I * DON'T SET ":RP,," SWITCH. DON'T RENAME. HED PUTID VARIABLES CRADD NOP * CRN NOP * #CRNS NOP * D1 DEC 1 * DOT OCT 56 * IH ASC 1,IH * LUCRN NOP * NWNAM BSS 3 * "00" ASC 1,00 * RNFLG NOP * SEC NOP * SESBT OCT 20000 * TEMP NOP * END