Sources Esope | Cast3M

ooowac
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