ASMB
  HED  CLEAR ID SEGMENT  (RTE-IV ONLY)   F. GAULLIER  06/JUL/77 
      NAM IDCLR,7 . 92903-16001 REV.1805  780228
* 
*     SOURCE 92903-18016
* 
      SPC 2 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
      SPC 2 
*   ********************************************************************
*   *                                                                  *
*   *   THIS ROUTINE CHECKS THE STATUS OF THE PROGRAM, AND IF IT IS    *
*   *   DORMANT, DISC RESIDENT AND LOADED TEMPORARILY, THIS SUBROUTINE *
*   *   DO A  'OF,PNAME,8' TO REMOVE IT FROM THE SYSTEM.               *
*   *   IF THE CONDITION ARE NOT OK, A STATUS IS RETURNED TO THE USER. *
*   *                                                                  *
*   * ------------- FORTRAN CALL ------------------------------------- *
*   *                                                                  *
*   *   IF( IDCLR(NAME[,IERR]) ) GOTO  [ NON-SUCCESSFULL OPERATION ]   *
*   *                                                                  *
*   *   IERR IS AN ERROR FLAG RETURNED BY IDCLR SUBROUTINE.            *
*   *                                                                  *
*   *         IERR VALUE        DEFINED ERROR                          *
*   *         ----------        -------------                          *
*   *             0             EVERYTHING IS O.K.                     *
*   *            -1             PROGRAM NOT LOADED                     *
*   *            -2             PROGRAM NOT FULLY DORMANT              *
*   *            -3             PROGRAM IS RTE-IV SYSTEM               *
*   *            -4             PROGRAM IS LOADED PERMANENTLY          *
*   *            -5             PROGRAM IS CORE RESIDENT               *
*   *                                                                  *
*   ********************************************************************
       SPC 1
      ENT IDCLR 
      EXT .ENTR,DORMT,IDGET,MESSS 
* 
A     EQU 0 
B     EQU 1 
      SUP 
* 
*-----ENTRY POINT 
* 
ANAME BSS 1 
AIERR OCT 0 
IDCLR NOP 
      JSB .ENTR 
      DEF ANAME     ADDRESS OF BUFFER CONTAINING PRG. NAME
* 
*-----GET I.D. SEGMENT ADDRESS
* 
      JSB IDGET 
      DEF *+2 
      DEF ANAME,I   PROGRAM NAME
      STA OFBUF+2   SAVE ID SEG ADDR TEMPORARILY
* 
*-----VERIFY THAT PROGRAM IS LOADED 
* 
      SZA           IDGET RETURNED NUL I.D. SEGMENT ADDRESS ! 
      JMP IDCL3     CONTINUE PROCESS
      CCA           ERROR: IERR=-1  PROGRAM IS NOT LOADED ! 
RETUN STA AIERR,I   RETURN ERROR CODE IF REQUIRED 
      CLB           CLEAR ADDRESS OF ERROR PARAMETER
      STB AIERR     FOR THE NEXT TIME 
      JMP IDCLR,I   RETURN LOGICAL VALUE
   SPC 3
* 
*-----CHECK THAT PROGRAM IS FULLY DORMANT 
* 
IDCL3 JSB DORMT     CHECK IF PROGRAM IS DORMANT 
      DEF *+2 
      DEF ANAME,I   PROGRAM NAME
      SZA,RSS       FULLY DORMANT ? 
      JMP ERR02     NO, ERROR -2
* 
*-----VERIFY PROGRAM IS NOT A SYSTEM ONE (LOADED AT GEN.) 
* 
      LDA OFBUF+2   RECALL ID SEG ADDR
      ADA P14       (A)=NAM5 ADDRESS, "SS" BIT & PROG. TYPE 
      STA B 
      XLA B,I       GET PROGRAM TYPE
      AND B17       ISOLATE TYPE
      SZA,RSS       CORE RESIDENT ? 
      JMP ERR05     YES, ERROR -5 
      CPA P1        CORE RESIDENT ? 
      JMP ERR05     YES, ERROR -5 
      XLA B,I       NO, GET NAM5 WORD AND "SS" BIT
      AND M20       ISOLATE "SS" BIT
      INB 
      SZA,RSS       SHORT OR LONG I.D. SEG ?
      ADB P7        LONG I.D. SEGMENT 
      ADB P4        (B)=ADDRESS OF DISC WORD
      XLA B,I       GET DISC WORD 
      SSA           TRACK ON AUXILIARY LU # 3 
      JMP IDCL5     YES: NOT SYSTEM PROGRAM 
      CMA,INA       SUBSTRACT FROM DISC LIB ADDRESS 
      ADA DSCLB 
      SSA           SYSTEM AREA ? 
      JMP IDCL5     NOT SYSTEM PROGRAM
      LDA N3        YES, ERROR: IERR=-3 
      JMP RETUN     RTE-III PROGRAM 
* 
*-----TRY TO PURGE IT WITH  OF,NAME,8 
* 
IDCL5 LDA ANAME     MOVE NAME INTO  OF,...
      LDB .OF2      BUFFER
      MVW P3
      LDA =A,8
      STA OFBUF+5 
* 
      JSB MESSS     CALL SYSTEM PROCESSOR MESSAGE 
      DEF *+3 
.OF   DEF OFBUF 
      DEF P12       MESSAGE LENGTH IN CHAR. 
* 
      JSB IDGET     PROGRAM REMOVED ? 
      DEF *+2 
      DEF ANAME,I 
      SZA,RSS       REMOVED ? 
      JMP RETUN     YES, RETURN OK  (.FALSE.  VALUE)
      LDA N4        NO, ERROR: IERR=-4, PROGRAM IS LOADED 
      JMP RETUN     PERMANENTLY.
* 
*-----ERROR -2, PROGRAM IS NOT DORMANT
* 
ERR02 LDA N2
      JMP RETUN 
* 
*-----ERROR -5, PROGRAM IS CORE RESIDENT
* 
ERR05 LDA N5
      JMP RETUN 
* 
*-----CONSTANTS 
* 
.     EQU 1650B 
* 
M20   OCT 20        MASK TO GET "SS" BIT OF WORD NAM5 OF I.D. 
B17   OCT 17
OFBUF ASC 2, OF,
      BSS 4 
.OF2  DEF OFBUF+2 
* 
*-----SYSTEM CONSTANTS
* 
DSCLB EQU .+73      DISC ADDRESS OF RES LIB ENTRY POINTS
      SPC 2 
P1    DEC 1 
P3    DEC 3 
P4    DEC 4 
P7    DEC 7 
P12   DEC 12
P14   DEC 14
N2    DEC -2
N3    DEC -3
N4    DEC -4
N5    DEC -5
      END 
                                                                                                                                                            