1 : C NOMOBJ SOURCE JC220346 14/02/17 21:15:10 7942 2 : SUBROUTINE NOMOBJ(MTX,NAM,IVAL) 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : -INC CCNOYAU 6 : -INC SMBLOC 7 : CHARACTER*(*) NAM ,MTX 8 : CHARACTER*(8) MTY,MTZ 9 : LOGICAL ZCACHE 10 : 11 : C RECHERCHE DU NOM DANS LA PILE DES NOMS 12 : MTY=MTX 13 : IL=LEN(NAM) 14 : DO 765 I=IL,1,-1 15 : IF(NAM(I:I).NE.' ') GO TO 764 16 : 765 CONTINUE 17 : I=1 18 : 764 IL=I 19 : ier=345 19 : CALL POSCHA(NAM(1:IL),IPOSCH) 20 : MAA=MDEOBJ 21 : itrouv=0 22 : * LES PROCEDURES PEUVENT ETRE DES OBJETS LOCAUX 23 : * => On parcourt le debut de la pile uniquement pour la 24 : * mise en cache des procedures definies dans UTILPROC 25 : * ou GIBI.PROC 26 : ZCACHE=((IOLEC.LT.0).OR.(IOLEC.GT.654321)) 27 : IF ((MTY.EQ.'PROCEDUR').AND.ZCACHE) MAA=1 28 : DO 3 I =MAA,LMNNOM 29 : IF(IPOSCH.EQ.INOOB1(I)) THEN 30 : C ON A TROUVE 31 : itrouv=1 32 : MTZ=INOOB2(I) 33 : INOOB2(I)=MTY 34 : IF(MTY.NE.'PROCEDUR') THEN 35 : IOUEP2(I)=IVAL 36 : ELSE 37 : IF (ZCACHE) THEN 38 : c IF(MTZ.EQ.'PROCEDUR')THEN 39 : IPP=IOUEP2(I) 40 : IPIPR1(IPP) = IVAL 41 : ELSE 42 : IPIPRL=IPIPRL+1 43 : IF(IPIPRL.GT.IPIPR1(/1)) THEN 44 : LM=IPIPR1(/1)+100 45 : SEGADJ IPIPRO 46 : ENDIF 47 : IOUEP2(I)=IPIPRL 48 : IPIPR1(IPIPRL)=IVAL 49 : ENDIF 50 : ENDIF 51 : if(MTZ.ne.'PROCEDUR') RETURN 52 : ENDIF 53 : 3 CONTINUE 54 : if(itrouv.eq.1) return 55 : C IL FAUT CREER LE NOM 56 : LMNNOM=LMNNOM+1 57 : IO=IOUEP2(/1) 58 : IF(LMNNOM.GT.IO) THEN 59 : N=LMNNOM+50 60 : SEGADJ ITABOB,ITABOC,ITABOD 61 : ENDIF 62 : N=LMNNOM 63 : INOOB1(N)=IPOSCH 64 : INOOB2(N)=MTY 65 : IF(MTY.NE.'PROCEDUR')THEN 66 : IOUEP2(N)=IVAL 67 : ELSE 68 : IPIPRL=IPIPRL+1 69 : IF(IPIPRL.GT.IPIPR1(/1)) THEN 70 : LM=IPIPR1(/1)+100 71 : SEGADJ IPIPRO 72 : ENDIF 73 : IOUEP2(N)=IPIPRL 74 : IPIPR1(IPIPRL)=IVAL 75 : ENDIF 76 : RETURN 77 : END 78 : 79 : 80 :
© Cast3M 2003 - All rights reserved.
Disclaimer