C OOOWAC SOURCE PV090527 26/04/24 08:23:28 12524 CMODE 89/09/29 15:24:48 ESOP SUBROUTINE OOOWAC (LRET,IRET,HARG,PSEG,KOD) C-------------------------------------------------------------------- C C SEGXXX /ERR=100/ PSEG C C ->LRET 1 PLUS DE PLACE MEMOIRE ET : IRET = 1 C 2 OK C C IRET ACTION SI PLUS DE PLACE MEMOIRE C 0 STOP 16 C 1 RETURN AVEC LRET = 1 C C HARG 'NOM_SUBROUTINE NUMERO_LIGNE NOM_SEGMENT ' C C PSEG POINTEUR DESIGNANT LE SEGMENT C KOD 1 => SEGACT EN *NOMOD C 0 => SEGACT EN *MOD C C PROGRAMMEUR : MOUGIN C CREE : 15/12/88 OOOY.. => OOOW.. (ARGUMENT HARG EN PLUS) C MODIF : 02/05/89 SEPARE D'AVEC L'ENTRY OOOWAD C C-------------------------------------------------------------------- C %INC IOOADR %INC IOOADZ %INC IOODES %INC IOOSGM %INC IOOWCOM %INC IOOUNIT %INC IOOSAF CHARACTER*(*) HARG POINTEUR PSEG.PSEG C On met un SEGMENT pour avoir OOTHRD (le traducteur s'en charge) SEGMENT ISEG(0) C LWAIT=.TRUE. duree dans ooowait seulement C LGLL =.TRUE. duree dans ooogll seulement INTEGER ITTIME(4) LOGICAL LGLL,LWAIT CHARACTER*(6) HDUREE C C ENTRY OOOWA1 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA2 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA3 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA4 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA5 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA6 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA7 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA8 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOWA9 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW10 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW11 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW12 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW13 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW14 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW15 (LRET,IRET,HARG,PSEG,KOD) C ENTRY OOOW16 (LRET,IRET,HARG,PSEG,KOD) C Pour le message affiche HDIA = HARG LDIA = LEN(HARG) C On saute l'ENTRY OOOYAC GOTO 100 ENTRY OOOYAC (LRET,IRET,PSEG,KOD) HDIA = ' ' LDIA = 0 100 CONTINUE IF(KOD .EQ. 1)THEN KASINS = INSTRUCTION_SEGACT ELSE KASINS = INSTRUCTION_SEGACT_MOD ENDIF if(pseg.eq.abs(MZSURV)) CALL OOOMES(pseg,'GEMAT SURVEILLE ') C Logique pour chronométrer l'attente LGLL =MZATTE .LT. 0 .AND. thread LWAIT =MZATTE .GT. 0 igll = 0 nth = 0 if (thread) nth=oothrd If (.NOT.THREAD.and.THREAD) write(JLST,*) ' bug compilateur aix' If (.NOT.THREAD.and.THREAD) write(JERR,*) ' bug compilateur aix' C Retrait eventuel du SEGMENT de la queue de desactivation if ((ibits(kod,0,18) .eq.1) .and. & ((nth.lt.64.and.(ibits(mdro1(pseg),nth,1).eq.1)).or. & (nth.ge.64.and.(ibits(mdro2(pseg),nth-64,1).eq.1))) .and. & (ibits(mdrw(pseg),0,18) .eq.0)) then do i=1,idesq(nth) if (abs(desq(nth,i)).eq.pseg) desq(nth,i)=0 enddo lret=2 return endif if ((ibits(kod,0,18) .eq. 1 ) .and. & ibits(mdrw(pseg),0,18).eq. nth+1) then if (thread) then igll=1 C Debut du Chronometre if (LGLL) CALL oootps(ITTIME,nth) lnsf(nth)=0 call ooogll(1) lnsf(nth)=1 if (LGLL) then C Fin du Chronometre : Mesure du temps ITPS0=ITTIME(1)+ITTIME(2) CALL oootps(ITTIME,nth) IELAPS=ITTIME(1)+ITTIME(2)-ITPS0 IF(IELAPS .ge. ABS(MZATTE))THEN WRITE(HDUREE,'(i6)') IELAPS CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE) ENDIF endif endif C verif queue de desactivation if (idesq(nth).ne.0 .and. mdco(pseg).ne.0) call ooodeq(nth) CALL OOODES(LRET,PSEG,1) endif if ((ibits(kod,0,18).ne.1).and.(ibits(mdrw(pseg),0,18).eq.nth+1)) > then C on s'assure que le segment est en RW (on a le droit puisqu'il est a nous) ISEG =MDISG(PSEG) MDISG(PSEG)=ISEG C on l'enleve eventuellement de la queue de desactivation do i=1,idesq(nth) if (abs(desq(nth,i)).eq.pseg) desq(nth,i)=0 enddo if (thread.and.igll.eq.1) call ooogll(0) lret=2 return endif if (thread.and.igll.eq.0) then C Debut du Chronometre if (LGLL) CALL oootps(ITTIME,nth) lnsf(nth)=0 call ooogll(1) lnsf(nth)=1 if (LGLL) then C Fin du Chronometre : Mesure du temps ITPS0=ITTIME(1)+ITTIME(2) CALL oootps(ITTIME,nth) IELAPS=ITTIME(1)+ITTIME(2)-ITPS0 IF(IELAPS .ge. ABS(MZATTE))THEN WRITE(HDUREE,'(i6)') IELAPS CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE) ENDIF endif endif CALL OOOVPN (PSEG) * si le segment est ouvert en lecture, quelqu'un l'attend peut etre. * il faudra garder la condition C segact ecr= ??? C on fait toujours l'activation en mode force if (.not.ooofor .or. nth.ne.0) then 10 if ((ibits(mdrw(pseg),0,18).ne.0.and. > ibits(mdrw(pseg),0,18).ne. nth+1) > .or. > (ibits(kod,18,1).ne.0.and.ishft(mdrw(pseg),-18).eq.nth+1) > .or. > (kod.eq.0.and.nth.lt.64.and.( > (mdro1(pseg).ne.0.and.mdro1(pseg).ne.ibset(0,nth)) > .or.mdro2(pseg).ne.0)) > .or. > (kod.eq.0.and.nth.ge.64.and.( > (mdro2(pseg).ne.0.and.mdro2(pseg).ne.ibset(0,nth-64)) > .or.mdro1(pseg).ne.0)) > )then C verif queue de desactivation if (idesq(nth).ne.0) CALL OOODEQ(nth) C On doit attendre. C si on demande le segact*MOD et si on est en attente, on libere le segment C avant pour eviter les blocages C Ce segment est'il attendu? call oootdl(pseg,ifla) if (kod.eq.0.and.mdco(pseg).ne.0.and. > ((nth.lt.64.and.mdro1(pseg).eq.ibset(0,nth)).or. > (nth.ge.64.and.mdro2(pseg).eq.ibset(0,nth-64))) > .and. ifla.eq.1) call ooosig(mdco(pseg)) if (nth.lt.64) mdro1(pseg)=ibclr(mdro1(pseg),nth) if (nth.ge.64) mdro2(pseg)=ibclr(mdro2(pseg),nth-64) C Si necessaire on cree une condition if (mdco(pseg).eq.0) then call ooocon(mdco(pseg)) if (pseg.le.0) write(JLST,*) ' ooowac pseg ',pseg endif C Test deadlock call OOODDL(PSEG,HDIA) C Debut du Chronometre if (LWAIT) CALL oootps(ITTIME,nth) lnsf(nth)=0 call ooowait(mdco(pseg)) lnsf(nth)=1 if (LWAIT) then C Fin du Chronometre : Mesure du temps ITPS0=ITTIME(1)+ITTIME(2) CALL oootps(ITTIME,nth) IELAPS=ITTIME(1)+ITTIME(2)-ITPS0 I1 = INDEX(HDIA( 1:LDIA),' ') I2 = INDEX(HDIA(I1+1:LDIA),' ')+I1 I3 = INDEX(HDIA(I2+1:LDIA),' ')+I2 IF(IELAPS .GE. ABS(MZATTE) .AND. & HDIA(I2+1:I3) .NE. 'MESINS')THEN WRITE(HDUREE,'(i6)') IELAPS CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE) ENDIF endif call oooudl goto 10 endif endif CALL OOOACT(LRET,PSEG,KOD) IF (LRET.EQ.1) THEN IF (IRET.EQ.0) GO TO 901 ENDIF * au cas ou d'autres attendent call oootdl(pseg,ifla) if (ifla.eq.1) then if (mdco(pseg) .ne. 0 .and. & ibits(mdrw(pseg),0,18).eq.0) & call ooosig(mdco(pseg)) endif if (thread) call ooogll(0) RETURN C----------------------------------------------------------------------- C MESSAGES D'ERREUR C----------------------------------------------------------------------- 901 CALL OOOERR (0,0,'PAS ASSEZ DE PLACE EN MEMOIRE') STOP 16 END