ASMB,R,L,C HED "IDRPD" FTN SUBROUTINE TO DO A FMGR ":RP,,PROG" * SOURCE: 92067-18236 * 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 IDRPD,7 92067-16185 REV.2040 800909 * * MODIFICATION RECORD: * OLD DATE NEW DATE REASON BY WHOM * 1) 12-7-75 2-3-76 TO FIX BUG IF PROGRAM IS ON DISC LU=3 (DLB) * 2) 2-3-76 10-4-76 OF,PROGM CLEAN UP INCASE OF SERIAL REUSABLE(DLB) * 3) 10-4-76 11-15-77 TO SUPPORT RTE-IV PROGRAM TYPES AND ID EXTENSIONS * 4) 11-15-77 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 5) 4-3-78 9-20-78 TO CHECK THE COPY FLAG BEFORE DELETING * 6) 9-20-78 9-29-78 TO RESTORE MESSAGE BUFFER FOR MESSS CALL * TO OVERRIDE MESSS SESSION CAPABILITY CHECKS * 7) 9-29-78 2-27-80 TO ALLOW :RP,, OF DORMANT TEMPORARILY LOADED * PROGRAMS (BECAUSE OF :RP ENHANCEMENT TO ALLOW * TYPE 6 FILES ON ANY CARTRIDGE). (DCL) * 8) 2-27-80 7-31-80 TO REPLACE ABORT PROCESSING WITH * 'OF,PROG,8,NP' (SST #4857) * ENT IDRPD EXT $LIBR,$LIBX,IDSGA,.ENTP,$OPSY EXT MESSS,SESSN A EQU 0 B EQU 1 TAT EQU 1656B TAT BASE ADDRESS TATLG EQU 1755B NEGATIVE LENGTH OF TAT TATSD EQU 1756B # TRACKS ON LU#2 SECT2 EQU 1757B # SECTORS PER TRACK ON LU#2 SECT3 EQU 1760B # SECTORS PER TRACK ON LU#3 XEQT EQU 1717B ID SEGMENT ADDR OF CURRENT PROGRAM * SUP PRESS EXTRANEOUS LISTINGS SKP * PURPOSE: * TO ACCOMPLISH THE EQUIVALENT OF A FMGR :RP,,PROG IN A SUBROUTINE. * * CALLED: * CALL IDRPD (NAME,IERR) * -OR- * IF (IDRPD (NAME,IERR).NE.0) GO TO IERROR * -OR- * IERR = IDRPD(NAME) * * WHERE: * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME DELETED FROM SYSTEM * IERR = (OPTIONAL) RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * * RETURN: * IERR = 0 > SUCCESSFUL DELETION OF ID SEGMENT FROM SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR FRETURN SPL) * IERR = 9 > ID-SEGMENT NOT FOUND * IERR = 17 > ID-SEGMENT NOT SET UP BY RP * (MEANING THAT THE PROGRAM IS NOT A TEMPORARY * LOAD OF A TYPE 2,3,4, OR 5 PROGRAM) * IERR = 18 > PROGRAM NOT DORMANT * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL) * (3) IERR IS AN OPTIONAL PARAMETER. * (4) CALLING PROGRAM MUST NOT BE PRIVILEGED. * * TEST PROGRAM: *FTN,L * PROGRAM TYRPD(2,99) * DIMENSION NAME(3),LU(5) * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT PROGRAM TO DELETE? _") * READ (LU,12) NAME * IF (NAME.EQ.2H/E) GO TO 9999 * 12 FORMAT (3A2) * IF(IDRPD(NAME,IERR).EQ.0) GO TO 9999 * 33 WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 STOP * END * END$ SKP NAME NOP PROGRAM NAME ADDRESS IERR NOP RETURNED ERROR CODE * IDRPD NOP ENTRY JSB $LIBR GO PRIVILEGED NOP JSB .ENTP DEF NAME * LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE SAVE FOR LOADA,STORA ROUTINES *780403* * JSB IDSGA FIND ID SEGMENT ADDR OF PROGRAM DEF *+2 DEF NAME,I STA IDADR SAVE ID(1) ADDRESS STA B SAVE IN B-REG LDA D9 GET SET FOR ERROR 9 SEZ FOUND? JMP ENDTA NO,FMGR ERROR 09 * ADB D8 BUMP TO XSUSP JSB LOADA GET XSUSP VALUE *780403* STA TEMP SAVE IT *780403* ADB O4 BUMP TO PROGRAM NAME WORD STB ID13 SAVE FOR LATER USE ADB O2 BUMP TO PROGRAM TYPE WORD STB ID15 SAVE FOR LATER USE * INB BUMP TO STATUS WORD (ID(16)) JSB LOADA GET STATUS WORD *780403* IOR TEMP MERGE WITH XSUSP VALUE *780403* ADB O2 BUMP TO ID(18) (CHECK NOT IN TIME LIST) STA TEMP TEMPORARY SAVE *780403* JSB LOADA GET THE T-BIT(IN TIME LIST) *780403* LDB TEMP RESTORE *780403* CCE,SZB,RSS SET E-REG IF PROG BUSY? *780403* ALF,CLE,ERA SET E=1 IF IN TIME LIST *780403* LDB ID15 GET ID(15) *780403* JSB LOADA *780403* AND O227 GET PROG TYPE & IDSEG TYPE BITS XOR O200 COMPLEMENT BIT 7 * LDB ID15 GET ID(15) ADDRESS *780403* ADB O5 MAKE ID(20) ADDRESS CPA O25 SHORT ID? JMP OKTYP YES 800227 ADB O7 BUMP TO ID(27) CPA O5 IF TYPE 5 LONG ID, THEN MAKE CLE,ARS SAME AS TYPE 2, NOT BUSY ARS CHANGE 2 & 3 TO 1 STA TEMP SAVE PGM TYPE & IDSEG TYPE BITS (SHIFTED) CPA O1 TYPE 2 OR 3? JMP TYPCK YES, TYPE 2, 3 OR 5 LONG ID LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? RSS YES, SO ALLOW TYPE 4 JMP ERR17 NO, WRONG TYPE LDA TEMP RESTORE PGM TYPE & IDSEG TYPE BITS (SHIFTED) CPA O2 TYPE 4 AND TEMPORARY? JMP TYPC2 YES, ALLOW FOR RTE-IV *780524*GLM ERR17 CLA,CCE WRONG PROGRAM TYPE FMGR ERR 17 TYPCK INA TYPC2 ADA O20 A= 17 OR 18 SEZ,RSS CHECK IF ERR 17 OR PROG BUSY(ERR 18) JMP OKTYP NO, CONTINUE * ENDTA JSB $LIBX YES, RETURN ERROR DEF *+1 DEF EXIT * * AT THIS POINT, WE KNOW THAT WE HAVE A TEMPORARY LOAD OF A * TYPE 2, 3, 4, OR 5 PROGRAM. * * EXECUTE AN 'OF,PROG,8,NP' TO CLEAN UP ANY ID SEG OWNED RESOURCES * OKTYP DLD NAME,I NAME PASSED IN CALL DST PNAME (FIRST 2 WORDS OF NAME) LDB NAME ADDRESS OF NAME PASSED IN ADB O2 OFFSET TO 3RD WORD OF NAME LDA B,I GET 3RD WORD OF NAME AND C377 MASK OFF LOW BYTE IOR COMMA MERGE IN COMMA STA PNAM3 SAVE IN MESSAGE BUFFER * JSB SESSN TEST IF IN SESSION DEF *+2 DEF XEQT SEZ SKIP IF IN SESSION CLB,RSS NON-SESSION, ZERO THE SES PARAMETER CMB SESSION, PASS -SCB ADDRESS (IDSEG WD 32) STB SES * JSB $LIBX NOW TURN BACK ON INTERRUPT SYSTEM DEF *+1 DEF *+1 FOR CALL TO MESSS (GEORGE) * JSB OFF SEND 'OF,PROG,8,NP' NOP NOP JSB OFF ONCE MORE IN CASE ID SEG WASN'T CLEARED * CLA,CLE RETURN GOOD EXIT EXIT STA IERR,I RETURN ERROR CODE CLB CLEAR OPTIONAL PARAMETER STB IERR FOR NEXT CALLER TO DEFAULT JMP IDRPD,I RETURN * SKP * * MISC ROUTINES * * LOADA NOP DOES XLA B,I IF MAPPED SYS *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAPSY YES *780403* LDA B,I NO, DO DIRECT LOAD *780403* JMP LOADA,I RETURN *780403* MAPSY XLA B,I DO CROSS-LOAD (2-WD INSTRUCT.) *780403* JMP LOADA,I RETURN *780403* SPC 1 OFF NOP LDA DOFMS ADDRESS OF MESSAGE LDB DOUTM DESTINATION ADDRESS MVW O7 7 WORDS IN MESSAGE JSB MESSS SEND 'OF,PROG,8,NP' REQUEST DEF *+5 DOUTM DEF OUTMS MESSAGE BUFFER DEF D14 14 CHARACTERS DEF ZERO DEF SES SCB ADDR TO OVERRIDE CAPABILITY CHECK JMP OFF,I RETURN SKP STYPE BSS 1 OP SYSTEM IDENTIFIER (AFTER ERA) 800227 IDADR NOP ID13 NOP ID15 NOP SES NOP TEMP NOP M9 DEC -9 ZERO OCT 0 O2 OCT 2 O1 OCT 1 O4 OCT 4 O5 OCT 5 O7 OCT 7 D8 DEC 8 D9 DEC 9 D14 DEC 14 O20 OCT 20 O25 OCT 25 O227 OCT 227 O200 OCT 200 C377 OCT 177400 COMMA OCT 54 DOFMS DEF OFMSG OFMSG ASC 2,OF, DON'T REORDER THE NEXT 7 WORDS PNAME ASC 2, PNAM3 ASC 1, , PWRAB ASC 2,8,NP OUTMS BSS 7 END