Sources Esope | Cast3M

oooext
C OOOEXT    SOURCE    PV090527  26/04/24    08:23:08     12524          
      SUBROUTINE OOOEXT (LRET,PSEG,LSEG)
C----------------------------------------------------------------------
C
C                         PSEG.X(**) = ...
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C     PSEG     DESIGNE LE SEGMENT A EXTENDRE
C     LSEG     NOMBRE DE MOTS DE DONNEES DEMANDEES
C
C     NOTE : SI NECESSAIRE ON DEPLACE LE SEGMENT MEME SI IL EST FIXE
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT  LRET DU CALL OOOSUS
C       MODIF : 23/01/89    INTEGRER DANS LA FAMILLE OOOW...
C
C----------------------------------------------------------------------
C
C extension minimale
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOTRO
%INC IOOWCOM
C
      POINTEUR PSEG.PSEG
C
      LRET = 2
      ITYP = MDTYP(PSEG)
      IF (MDETAT(ITYP).NE.MDACT)                       GO TO 901
 
C   ->LSG1   LONGUEUR ACTUELLE DU SEGMENT
C   ->LSG2   LONGUEUR DEMANDEE DU SEGMENT
 
      ISEG = MDISG(PSEG)
      LSG1 = MSLS1(ISEG)
      LSG2 = (((LSEG+MSLCZ)+(MSLSM-1))/MSLSM)*MSLSM
      IF (LSG2.LE.LSG1)                                GOTO 1000
C
      ICAT = MDCAT(ITYP)
      IF(ICAT.EQ.MDBLOCK) CALL OOOSUS (MDMK(PSEG))
 
      IF (ICAT.EQ.MDFIXE) THEN
        KZ=ZMEMFIX
      ELSE
        KZ=ZMEMDYN
      ENDIF
C
C******  EXTENSION NECESSAIRE
C
C     LG DU TROU A RECHERCHER
 
      LSE = LSG2-LSG1
      LSX = LSE
 10   IT0 = ISEG+LSG1
C
C   si pas de place suffisante avec trou droit + gauche on duplique le segment
C
        ltg=0
        ltd=0
        if (mtroug(iseg)) ltg=-mtltp(iseg)
        if (mtrou(it0)) ltd=-mtlt1(it0)
        if (lsx.gt.ltd+ltg) goto 110
 
C
C****** TROU A GAUCHE (sauf si trou a droite suffisant)
C
      IF     (MTROUG(ISEG).and.lsx.gt.ltd)                       THEN
        LT  = -MTLTP(ISEG)
C       SI TROU INSUFFISANT ON PREFERE DUPLIQUER LE SGM
C
C         SAUVEGARDE LES POINTEURS DU TROU POUR LE RECONSTRUIRE APRES
C          LE SEGMENT ET EFFACEMENT DU MOT DE CONTROLE FIN DU TROU
          IT0 = ISEG-LT
          ITS = MTITS(IT0)
          ITP = MTITP(IT0)
          JTR(IT0+LT)=0
C
C         DEPLACEMENT DU SGM,REMISE A ZERO DE LA PORTION MEMOIRE NON
C         RECOUVERTE PAR LA NOUVELLE VERSION DU SEGMENT
C
          CALL OOOZMV (JSG(ISEG+1),JSG(IT0+1),LSG1)
          MZJSS(DEPLACES)=MZJSS(DEPLACES)+1
          MZJSM(DEPLACES)=MZJSM(DEPLACES)+LSG1
          ITT = MAX(ISEG,IT0 +LSG1)
          LTT = MIN(LSG1,ISEG+LSG1-ITT)
          CALL OOOZMR (JSG(ITT+1),LTT)
          MZJMM(NXFNG)   = MZJMM(NXFNG)+1
          MZJMM(QXFNRAZ) = MZJMM(QXFNRAZ)+LTT
C         MAJ DESCRIPTEUR
          ISEG        = IT0
          MDISG(PSEG) = ISEG
         IF (MZPRTR.EQ.IT0+LT) MZPRTR=ISEG
C
C         RECONSTRUIT LE TROU DERRIERE LE SGM
C
          IT         = ISEG+LSG1
          MTITP(ITS) = IT
          MTITS(ITP) = IT
          MTITP(IT ) = ITP
          MTITS(IT ) = ITS
          MTLT1(IT ) = -LT
          MTLT2(IT ) = -LT
          IF (IT0.EQ.MZITS0(IZA,KZ)) MZITS0(IZA,KZ)=IT
        ENDIF
C
C****** TROU A DROITE
C
      IF     (MTROU(IT0))                             THEN
C
        MZJMM(NXFND)=MZJMM(NXFND)+1
C
        LT0 =-MTLT1(IT0)
        ITP = MTITP(IT0)
        ITS = MTITS(IT0)
 
C       SI EXTENSION INSUFFISANTE:ON PREND QUAND MEME
 
        LEXT = MIN(LSG2-LSG1,LT0)
         IF (MZPRTR.EQ.IT0) MZPRTR=ISEG
 
C       SI LE TROU DISPARAIT , ON LE RETIRE DE LA CHAINE DES TROUS
 
        IF (LT0.EQ.LEXT)                              THEN
          MTITS(ITP) = ITS
          MTITP(ITS) = ITP
          IF (IT0.EQ.MZITS0(IZA,KZ)) MZITS0(IZA,KZ)=ITS
C       SINON MISE A JOUR DU CHAINAGE DES TROUS
 
        ELSE
          IT         = IT0+LEXT
          LT         = LT0-LEXT
          MTITP(ITS) = IT
          MTITS(ITP) = IT
          MTITP(IT ) = ITP
          MTITS(IT ) = ITS
          MTLT1(IT ) = -LT
          MTLT2(IT ) = -LT
          IF (IT0.EQ.MZITS0(IZA,KZ)) MZITS0(IZA,KZ)=IT
        ENDIF
C
C       ON EFFACE LA FRONTIERE ENTRE ANCIEN/NOUVEAU BLOC EN SAUVEGARDANT
C       IDE DU SGM (SI CDC)
        MTLTP (IT0) = 0
        MTZERO(IT0) = 0
 
C       MAJ COMPTEUR EXTENSION ET PLACE LIBRE
 
        MZLTROU(IZA,KZ)=MZLTROU(IZA,KZ)-LEXT
 
C       INDICE ET LG DU BLOC ETENDU
 
        LSX         = LSX -LEXT
        LSG1        = LSG1+LEXT
        MSLS1(ISEG) = LSG1
        MSLS2(ISEG) = LSG1
        MSIDE(ISEG) = PSEG
C
C      SI EXTENSION INCOMPLETE ON CONTINUE
C
        IF (LSG1.LT.LSG2)                              GO TO 10
                                                       GO TO 100
C
      ENDIF
C
C****** EXTENSION AVEC DUPLICATION SEGMENT
C
C        INITIALISATION DU SEGMENT REMPLACANT AVEC REGLE D'ATTRIBUTION
C        A GAUCHE ,ECHANGE DES POINTEURS ET SUPPRESSION DE L'ANCIEN
C        SEGMENT
C
 110     CONTINUE
         LATGD          = MZATGD(IZA,KZ)
         MZATGD(IZA,KZ) = 0
         MZJMM(NXFNINI) = MZJMM(NXFNINI)+1
         IF (KZ.EQ.ZMEMDYN) THEN
            JPS=0
            CALL OOOINI (LRET,JPS,LSEG)
         ELSE
            CALL OOOYNF (LRET,JPS,LSEG)
         ENDIF
         MZATGD(IZA,KZ) = LATGD
         IF (LRET.NE.1)                                THEN
C
           ID2=JPS
           IS1=MDISG(PSEG)
           IS2=MDISG(ID2)
C          TRANSFERT DONNEES-MOTS DE CONTROLE DE TETE
           CALL OOOZMV (JSG(IS1+MSLZ1+1),JSG(IS2+MSLZ1+1),LSG1-(MSLCZ))
           MZJSS(DEPLACES)=MZJSS(DEPLACES)+1
           MZJSM(DEPLACES)=MZJSM(DEPLACES)+LSG1-(MSLCZ)
C          ECHANGE DES DESCRIPTEURS
           MSECH , PSEG(ID2)
C          SUPPRESSION DE L'ANCIEN SEGMENT
           CALL OOOSUP (LRET,JPS,0)
C          MAJ DES STATISTIQUES SI EXTENSION PARTIELLE (TROU A DROITE)
         ENDIF
         LSE=LSE-LSX
C
C****** FIN D'EXTENSION
C
 100  MZJSM(ACTUEL)  =MZJSM(ACTUEL)+LSE
      MZJSM(DEF)     =MAX(MZJSM(DEF),MZJSM(ACTUEL))
      MZJSM(ACTACTIF)=MZJSM(ACTACTIF)+LSE
      MZJSM(MAXACTIF)=MAX(MZJSM(MAXACTIF),MZJSM(ACTACTIF))
      IF (ICAT.EQ.MDFIXE) THEN
        MZQCHN(FIXE) =MZQCHN(FIXE) +LSE
      ELSE
        MZQCHN(ACTIF)=MZQCHN(ACTIF)+LSE
      ENDIF
1000  continue
                                                       RETURN
C-----------------------------------------------------------------------
C
C                         MESSAGES D'ERREUR
C
 901  CALL OOOERR (PSEG ,-1,'SEGMENT NON ACTIF ')
                                                       STOP 16
      END