Télécharger oooini.eso

Retour à la liste

oooini
C OOOINI    SOURCE    PV090527  26/04/24    08:23:11     12524          
      SUBROUTINE OOOINI (LRET,PSEG,LSEG)
C--------------------------------------------------------------------
C
C                            SEGINI , PSEG
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C   ->PSEG     POINTEUR DESIGNANT LE SEGMENT CREE
C     LSEG     NOMBRE DE MOTS DE DONNEES DU SEGMENT
C
C PROGRAMMEUR : MOUGIN
C       CREE  : 21/12/88    POUR LA FAMILLE : OOOW..
C       MODIF : 02/01/89    UTILISER : OOOMIN SIMPLIFIE
C       MODIF : 17/01/89    UTILISER : OOOMWD SIMPLIFIE
C       MODIF : 17/01/89    UTILISER : OOODEX SIMPLIFIE
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOPTRK
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
%INC IOOUNIT
      POINTEUR PSEG.PSEG,pseg1.pseg
      integer blkmsk1,blkmsk2
      logical bas
C  notre numero de thread dans mdrw
      nth=0
      if (thread) nth=oothrd
 
      if (pseg.ne.-1) then
C       verif queue de desactivation
        call ooodeq(nth)
C       verif queue de suppression
C        call ooosuq(nth)
      endif
C
      IF (LSEG.LE.0)                                   GO TO 901
C
C     DANS LE CAS D'UN POINTEUR PRESCRIT, CONTROLE DE VALIDITE
C
      IF (PSEG.GT.0)                                   THEN
        IF (PSEG.LT.MZIDEX)                            GO TO 902
        IF (MOD(PSEG-MZIDE1,MDLDE).NE.0)               GO TO 902
        IF(PSEG.GT.MZIDEY)                             THEN
          IF (TESOOO) CALL OOOWER ('OOOINI => OOODEX PSEG PRESCRIT')
          CALL OOODEX (LRET,MZNDEX+(PSEG-MZIDEY)/MDLDE)
          IF (TESOOO) CALL OOOWER ('OOOINI <= OOODEX : FIN')
          IF (LRET.EQ.1)                               RETURN
        ELSE
           IF(MDIDS(PSEG).GE.0)                        GO TO 903
        ENDIF
        IPREC=-MDIDP(PSEG)
        IF (-MDIDS(MZIDE1).NE.PSEG)                    THEN
           IDEUX=-MDIDS(MZIDE1)
           MDIDS(IPREC)=MDIDS(PSEG)
           MDIDP(-(MDIDS(PSEG)))=-IPREC
           MDIDS(PSEG)=-IDEUX
           MDIDP(ideux)=-PSEG
           MDIDS(MZIDE1)=-PSEG
           MDIDP(PSEG)=-MZIDE1
        ENDIF
      ENDIF
C
C     S'ASSURER QU'IL Y A UN DESCRIPTEUR
C
      bas=.false.
      if (pseg.eq.-1) bas=.true.
C  on reserve ntrk descripteurs pour les super segment
      ptrk=mzptrk
      ntrk=0
      if (ptrk.ne.0) ntrk=ptrk.nntrk
      if (lseg.eq.0) write(JLST,*) ' oooini lseg nul'
      pseg=-mdids(mzide1)
      if (mdidp(mzide1).eq.0)  CALL OOOERR (PSEG,-1,'CHAINAGE DETRUIT')
      do while ((pseg.lt.ntrk*mdlde+mdidx0).and.(pseg.ne.mzide1))
C      write(JLST,*) ' oooini 1 ',pseg,mdidp(pseg),mdids(pseg)
        pseg=-mdids(pseg)
      IF (PSEG.LT.MZIDEX) then
        if (pseg.ne.mzide1) CALL OOOERR (PSEG,-1,'POINTEUR TROP PETIT')
      ENDIF
      IF (PSEG.GT.MZIDEY)   CALL OOOERR (PSEG,-1,'POINTEUR TROP GRAND')
        if (pseg.eq.0)  CALL OOOERR (PSEG,-1,'POINTEUR NUL')
      enddo
C
      IF   (MZIDE1.EQ.pseg)                            THEN
        IF (TESOOO) CALL OOOWER ('OOOINI => OOODEX : ADD DESCRIPTEURS')
        CALL OOODEX (LRET,max(MZNDEX,ntrk))
        IF (TESOOO) CALL OOOWER ('OOOINI <= OOODEX : FIN')
        IF (LRET.EQ.1)                                 RETURN
      ENDIF
C
C     ATTRIBUER LA PLACE MEMOIRE POUR LE SEGMENT.
C
      IPASS=0
 142  LSG = LSEG+MSLCZ
      CALL OOOMIN (LRET,ZMEMDYN,ISEG,LSG)
      IF (LRET.EQ.1)                                   THEN
        IF (TESOOO) CALL OOOWER ('OOOINI => OOOMWD')
        CALL OOOMWD (LRET,LSG)
        IF (TESOOO) CALL OOOWER ('OOOINI <= OOOMWD')
        IF (LRET.EQ.1)                                 then
*  deuxieme chance au cas ou des threads se seraient bloques
                   ipass=ipass+1
*  recuperer le masque des threads bloques
                   blkmsk1=0
                   blkmsk2=0
               call ooombl(blkmsk1,blkmsk2)
               if (oothrd+1.lt.64) blkmsk1=ibset(blkmsk1,oothrd+1)
               if (oothrd+1.ge.64) blkmsk2=ibset(blkmsk2,oothrd+1-64)
**                 write(6,'(A16,Z16)') 'blkmsk initial ',blkmsk
**                 write(6,'(A16,Z16)') 'blkmsk ibset   ',blkmsk
                   blkmsk1=not(blkmsk1)
                   blkmsk2=not(blkmsk2)
*                  write(6,'(A16,Z16)') 'blkmsk not     ',blkmsk
                   if(blkmsk1.ne.0.or.blkmsk2.ne.0) then
*                  ipass=ipass-1
***                write(6,*) 'oooini attente avant compaction memoire',
***  >               blkmsk1,blkmsk2,oothrd
***                call sleep(1)
***                if (ipass.le.1) goto 142
                   endif
                   RETURN
        endif
                                                       GO TO 142
      ENDIF
C
C****** ENLEVE LE DESCRIPT DE LA CHAINE DES DESCRIPT. LIBRES
C
      if (bas) then
      PSEG          = -MDIDP(MZIDE1)
      pseg1=pseg
      do while ((pseg.ge.ntrk*mdlde+mdidx0).and.(pseg.ne.mzide1))
C       write(JLST,*) ' oooini bas rejete ',pseg
        pseg=-mdidp(pseg)
      enddo
C       write(JLST,*) ' MZIDE1 ',mzide1,mdids(mzide1),mdidp(mzide1)
C       write(JLST,*) ' oooini bas  ok ',pseg
      else
      PSEG          = -MDIDS(MZIDE1)
      pseg1=pseg
      do while ((pseg.lt.ntrk*mdlde+mdidx0).and.(pseg.ne.mzide1))
C       write(JLST,*) ' oooini hau rejete ',pseg
        pseg=-mdids(pseg)
      enddo
C       write(JLST,*) ' MZIDE1 ',mzide1,mdids(mzide1),mdidp(mzide1)
C       write(JLST,*) ' oooini haut  ok ',pseg
      endif
      mdidp(-mdids(mzide1)) = mdidp(mzide1)
      mdids(-mdidp(mzide1)) = mdids(mzide1)
      mdids(mzide1)=mdids(pseg)
      mdidp(-mdids(pseg))=-mzide1
      mdidp(mzide1)=mdidp(pseg)
      mdids(-mdidp(pseg))=-mzide1
 
C
C****** IMPLANTATION SEGMENT
C
C       INDICE:ISEG,LG:LSG,DESCRIPT:PSEG
C       INITIALISER LE DESCRIPTEUR DU SGM:
C       INSERER DANS LA CHAINE DES SEGMENTS ACTIFS
C
      MDZERO(PSEG) = 0
C       IMPLANTATION MEMOIRE DU SGM DE LG (LSG)
      MSIDE(ISEG) = PSEG
      MDISG(PSEG) = ISEG
      ITYP=MDLTYP(MDISOLE,MDMEM,MDACT,0,0)
      MDTYP(PSEG) = ITYP
C
      IDA=MDACHN(ACTIF)
      MDCHNP ,IDA(PSEG)
 
C       MAJ DES STATS/SGM ET /MOTS
 
      MZJSS(ACTUEL)   =     MZJSS(ACTUEL)+1
      MZJSS(DEF)      = MAX(MZJSS(ACTUEL),MZJSS(DEF))
      MZJSM(ACTUEL)   =     MZJSM(ACTUEL)+LSG
      MZJSM(DEF)      = MAX(MZJSM(ACTUEL),MZJSM(DEF))
      MZJSS(ACTACTIF) =     MZJSS(ACTACTIF)+1
      MZJSS(MAXACTIF) = MAX(MZJSS(ACTACTIF),MZJSS(MAXACTIF))
      MZJSM(ACTACTIF) =     MZJSM(ACTACTIF)+LSG
      MZJSM(MAXACTIF) = MAX(MZJSM(ACTACTIF),MZJSM(MAXACTIF))
C
      LRET = 2
      mdrw(pseg)=nth+1
      if(nth.lt.64) mdro1(pseg)=ibset(0,nth)
      if(nth.ge.64) mdro2(pseg)=ibset(0,nth-64)
C  l'horodatage dans mdhor
      mdhor(pseg)=horo(nth)
 
                                                       RETURN
C-----------------------------------------------------------------------
C
C                        MESSAGES D'ERREUR
C
 901  CALL OOOERR (LSEG,1,' LONGUEUR DU SEGMENT INVALIDE')
                                                       STOP 16
 902  CALL OOOERR (PSEG,1,' VALEUR DU POINTEUR INVALIDE')
                                                       STOP 16
 903  CALL OOOERR (PSEG,1,' POINTEUR DEJA ATTRIBUE')
                                                       STOP 16
 904  CALL OOOERR (PSEG,1,' CHAINE DES DESCRIPTEURS LIBRES CORROMPUE')
                                                       STOP 16
      END
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales