Sources Esope | Cast3M

oooseg
C OOOSEG    SOURCE    PV090527  26/04/24    08:23:20     12524          
      SUBROUTINE OOOSEG(imod)
C---------------------------------------------------------------------
C
C                        INITIALISER  G E M A T
C
C    UN PGM ESOPE DEBUTE PAR CALL OOOSSG ET SE TERMINE PAR CALL OOOSTP
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 09/01/89    UTILISER LE  OOOMIN  SIMPLIFIE
C       MODIF : 26/01/89    OOV(1:8) = 0
C       MODIF : 20/02/89    PRISE EN COMPTE DU PARAMETRE  VERACT
C       MODIF : 17/04/89    FORCER LE CHARGEMENT DE OOOWAD
C       MODIF : 02/05/89    NE PLUS FORCER LE CHARGEMENT DE OOOWAD
C
C---------------------------------------------------------------------
C
C%IF WIN32
C      Include fait pour l'interfaçage FORTRAN - C avec Microsoft Visual C
C      INCLUDE 'esope.fi'
C%ENDIF
%INC IOOADR
%INC IOOADZ
%INC IOOSGM
%INC IOODES
%INC IOOUNIT
%INC IOOWCOM
%INC IOOSAF
C
      CHARACTER*8 HPRM
      INTEGER     ISB(13)
C
C                TABLES DE CORRESPONDANCE DES CHAINES
C
C    (POUR LA NUMEROTATION DE CHAINE VOIR LA MACRO CORRESPONDANTE )
C                             DANS IOODES
C
      PARAMETER ( NBCHN=64 , NBBIT=8 )
      INTEGER    NCHAIN(NBCHN) , NMKSS(NBBIT) , NCBUF(NBBIT)
      INTEGER    NCMRU(12)
C
C
C      NUMERO DE CHAINE EN FONCTION DE CATEGORIE(ICAT)
C                                      ETAT(IETAT)
C                                      NATURE DE DESACTIVATION(IQUEU)
C                                      ENTREE/SORTIE (IBUF)
C
C                                |--VALEUR DE L'INDICE TABLE
C                                |          +1
C                                           ISOLE
C                                           ------
C      *ICAT  --> 00 ISOLE
C                 01 FIXE       16         1  ACTIF
C                 10 COMPOSANT  32         5  LRU
C                 11 MARQUEUR   48         6  OLIN
C                                          9  LRU
C      *IETAT --> 00 ACTIF                10  OLNOMOD
C                 01 INACTIF     4        11  MRU
C                 10 NOMOD       8        12  OMNOMOD
C                 11 MOD        12        13  LRU
C                                         14  OLMOD
C      *IQUEU -->  0 LRU                  15  MRU
C                  1 MRU         2        16  OMMOD
C                                         17  FIXE
C                                           COMPOSANTS
C                                           ----------
C      *IBUF  -->  0 MEMOIRE              33  CACTIF
C                  1 BUFFER      1        37  CLRU
C                                         41  CLRU
C                                         43  CMRU
C                                         45  CLRU
C                                         47  CMRU
C                                           MARQUEUR
C                                           --------
C                                         49  ACTIF
C                                         53  LRU
C                                         55  MRU
C                                         57  LRU
C                                         59  MRU
C                                         61  LRU
C                                         63  MRU
C
      DATA NCHAIN /1 , 0 , 0 , 0 , 3 , 8 , 0 , 0 ,
     *             3 , 9 , 4 ,11 , 3 ,10 , 4 ,12 ,
     *             2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
     *             0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
     *             5 , 0 , 0 , 0 , 6 , 0 , 0 , 0 ,
     *             6 , 0 , 7 , 0 , 6 , 0 , 7 , 0 ,
     *             1 , 0 , 0 , 0 , 3 , 0 , 4 , 0 ,
     *             3 , 0 , 4 , 0 , 3 , 0 , 4 , 0 /
C
C
C      NUMERO DE COMPTEUR STATISTIQUE EN FONCTION DE :
C                                      ETAT(IETAT)
C         (SUPER SEGMENT)              NATURE DE DESACTIVATION(IQUEU)
C
C
C                                |--VALEUR DE L'INDICE TABLE
C                                |          +1
C
C      *IETAT --> 00 ACTIF                1   STACTIF
C                 01 INACTIF     2        3   STINACT
C                 10 NOMOD       4        5   STLNOMOD
C                 11 MOD         6        6   STMNOMOD
C                                         7   STLMOD
C      *IQUEU -->  0 LRU                  8   STMMOD
C                  1 MRU         1
C
      DATA NMKSS  /1 , 0 , 2 , 0 , 3 , 5 , 4 , 6 /
C
C
C
C      NUMERO DE FILE BUFFER EN FONCTION DE :
C                                      ETAT(IETAT)
C                                      NATURE DE DESACTIVATION(IQUEU)
C
C
C                                |--VALEUR DE L'INDICE TABLE
C                                |          +1
C
C      *IETAT --> 00 ACTIF                3   OLIN
C                 01 INACTIF     2        5   OLNOMOD
C                 10 NOMOD       4        6   OMNOMOD
C                 11 MOD         6        7   OLMOD
C                                         8   OMMOD
C      *IQUEU -->  0 LRU
C                  1 MRU         1
C
      DATA NCBUF / 0 , 0 , 8 , 0 , 9 ,11 ,10 ,12 /
C
C      CHAINE LRU CORRESPONDANTE A MRU LORS DE LA FERMETURE MRU
C
C
      DATA NCMRU / 0 , 0 , 0 , 3 , 0 , 0 , 6 , 0 , 0 , 0 , 3 , 3/
C
C-----------------------------------------------------------------------
C
C
C*
C*        INIT GESTION MEMOIRE ACTIVE
C*
C-----------------------------------------------------------------------
C   Branchement des unites de sortie
C-----------------------------------------------------------------------
%IF UNIX32,UNIX64,WIN32,WIN64
      CALL OOOUNI(imod)
%ELSE
      JLST=6
      JERR=6
      JOUT=98
      JDEB=20
%ENDIF
C
C****** INITIALISATIONS
C
      thread=.false.
      ooofor=.false.
      do ith=0,128
       horo(ith)=0
       lnsf(ith)=0
      enddo
      do ith=0,128
       isupq(ith)=0
       lsupq(ith)=0
       idesq(ith)=0
      enddo
      lnsf(0)=1
      oothrd=0
      oow(1)=0
      call oooidl
      MZPRTR=MZIS0(IZA)
      CALL OOOPRM   (LRET,'OOO'   ,HPRM,LPRM,IPRM)
      TESOOO = LRET.EQ.2
      CALL OOOPRM   (LRET,'VERACT',HPRM,LPRM,IPRM)
      VERACT = LRET.EQ.4
      IF (VERACT)                               THEN
        VERACT = HPRM.NE.'NON'
      ELSE
        VERACT = .TRUE.
      ENDIF
 
      DO    I=1,MDNNCHN
        MZQCHN(I)=0
        MZCMRU(I)=NCMRU(I)
      ENDDO
C
      DO    I=1,NBCHN
        MZCHN(I)=NCHAIN(I)
      ENDDO
C
      DO    I=1,NBBIT
        MZMKSS(I)=NMKSS(I)
        MZCBUF(I)=NCBUF(I)
      ENDDO
C
C****** INIT MEMOIRE ACTIVE + RESERVE BUFFERS
C
      CALL OOOMOP (LRET)
      IF (LRET.EQ.1)                                   GO TO 950
C
C**********************************************************************
C*
C*   RESERVER MDNNCHN SEGMENTS OCCULTES(REPRESENTENT LA CLASSE VIDE)
C*                        DE TAILLE MINIMUM QUI
C*    SERVIRONT DE BASES AUX CHAINAGES DES SEGMENTS
C*
C***********************************************************************
C
C****** ATTRIB PLACE MEMOIRE(ON STOCKE DS ISB(I) L'INDICE DEBUT SEGM
C
C        ON POSITIONNE LA REGLE D'ATTRIBUTION MEMOIRE A GAUCHE
C
      MZATGD(IZA,ZMEMDYN)=0
C
      GESMEM = GESMEM_SORTIE_DISQUE
      DO    I=1,MDNNCHN
        IIIIII=MSLSM
        CALL OOOMIN (LRET,ZMEMDYN,ISB(I),IIIIII)
        IF (LRET.EQ.1)                                 GO TO 901
      ENDDO
C
C***********************************************************************
C*
C*             INIT SEGMENT DES DESCRIPTEURS
C*    INITIALISER LA PARTIE RESERVEE AU SYSTEME DU SEGMENT DES
C*    DESCRIPTEURS DE SEGMENT UTILISES PAR LE SYSTEME .
C*    CONTIENT MDNDX0 DESCRIPTEURS , SUCCESSIVEMENT :
C*
C*        UNE ZONE INITIALISEE AVEC LA VALEUR MZOC4 TQ
C*             OOA(OOT+P) AVEC P=0 --> ADRESSE INVALIDE
C*
C*    1   DESCRIPTEUR BASE DE LA CHAINE DES DESCRIPTEURS LIBRES
C*    MDNNCHN   DESCRIPTEURS DES SEGMENTS OCCULTES
C*    1   DESCRIPTEUR DU SEGMENT DES DESCRIPTEURS
C*
C*    CE SEGMENT SERA PROLONGE PAR LA SUITE AU FUR ET A MESURE
C*    DES BESOINS
C*         A L'INITIALISATION :
C*
C*    1   DESCRIPTEUR DU SEGMENT CLIENTS
C*    1   DESCRIPTEUR DU SEGMENT ACCES
C*    1   DESCRIPTEUR DU SEGMENT COPIES
C*    1   DESCRIPTEUR DU SEGMENT CLIENTM
C*    1   DESCRIPTEUR DU SEGMENT SEGM
C*    1   DESCRIPTEUR DU SEGMENT BUFFER
C*    1   DESCRIPTEUR DE LA MAP DE GESTION DISQUE
C*
C*    CALCULER  MZIDE1 INDICE DU DESCRIPTEUR BASE DE LA CHAINE DES
C*    DESCRIPTEURS LIBRES .
C*
C***********************************************************************
C
C****** INITIALISATION DU SEGMENT DES DESCRIPTEURS
C
      LSD=MDIDX0+MSLCZ
      CALL OOOMIN (LRET,ZMEMDYN,ISB(MDNNCHN+1),LSD)
      IF (LRET.EQ.1)                                   GO TO 901
C      EVALUATION DE OOT TEL QUE OOA(OOT) ADRESSE
C       LE PREMIER MOT DE DONNEE DU SEGMENT DES DESCRIPTEURS :
C         INDICE DU SEGMENT DESCRIPTEUR (BASE JZZ(1))
C         +MOTS DE CONTROLE DE TETE
C         +DISTANCE OOA-->JZZ
      OOT=ISB(MDNNCHN+1)+MSLZ1+2+1
      OOU=OOT
C
C       EVALUATION DE OOG DEPLACEMENT SUPLEMENTAIRE POUR ADRESSER
C        LES VARIABLES CARACTERES DANS UN SEGMENT A PARTIR DE LA BASE
C        D'ADRESSAGE OOH TEL QUE :
C          OOV( OOA(OOT+S) ) == OOH( OOA(OOT+S) +OOG)
      CALL OOOZZ3
C
C       DEPLACEMENT DU DESCRIPT. SERVANT DE BASE A LA CHAINE DES
C       DESCRIPTEURS LIBRES
      MZIDE1=MDIDX0-(MDNDX0)*MDLDE
C
      CALL OOOZZ4 (MZOC4)
      DO    I=1,MZIDE1
         JZZ(ISB(MDNNCHN+1)+MSLZ1+I)=MZOC4
      ENDDO
C
C******INITIALISER DANS LES MDNNCHN+1 SEGMENTS PRECEDENTS :
C            IDE,IDSP,IDSS(CHAINAGE DES DESCRIPT.)
C      INITIALISER LES DESCRIPTEURS DES SEGMENTS PRECEDENTS
C
      DO    I=1,MDNNCHN
C        CHAINAGE DU SEGM OCCULTE SUR LUI-MEME
        IDE=MDACHN(I)
        MSIDE(ISB(I)) = IDE
        MSIDP(ISB(I)) = IDE
        MSIDS(ISB(I)) = IDE
        MDISG(IDE)    = ISB(I)
        MDOPCHN(I)    = MDOPOCHN
        CASE , I
            WHEN ,ACTIF
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDACT,0,0)
            WHEN ,FIXE
                  MDTYP(IDE)=MDLTYP(MDFIXE,MDMEM,MDACT,0,0)
            WHEN ,LRU
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDMOD,MDLRU,0)
            WHEN ,MRU
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDMOD,MDMRU,0)
                  MDOPCHN(MRU)=MDOPFCHN
            WHEN ,CACTIF
                  MDTYP(IDE)=MDLTYP(MDBLOCK,MDMEM,MDACT,0,0)
            WHEN ,CLRU
                  MDTYP(IDE)=MDLTYP(MDBLOCK,MDMEM,MDMOD,MDLRU,0)
            WHEN ,CMRU
                  MDTYP(IDE)=MDLTYP(MDBLOCK,MDMEM,MDMOD,MDMRU,0)
                  MDOPCHN(CMRU)=MDOPFCHN
            WHEN ,OLIN
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDINACT,MDLRU,MDBUF)
            WHEN ,OLMOD
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDMOD,MDLRU,MDBUF)
            WHEN ,OLNOMOD
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDNOMOD,MDLRU,MDBUF)
            WHEN ,OMMOD
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDMOD,MDMRU,MDBUF)
                  MDOPCHN(OMMOD)=MDOPFCHN
            WHEN ,OMNOMOD
                  MDTYP(IDE)=MDLTYP(MDISOLE,MDMEM,MDNOMOD,MDMRU,MDBUF)
                  MDOPCHN(OMNOMOD)=MDOPFCHN
        ENDCASE
      ENDDO
C
      MZIDDX=MZIDE1+(MDNNCHN+1)*MDLDE
      MSIDE(ISB(MDNNCHN+1)) = MZIDDX
      MSIDP(ISB(MDNNCHN+1)) = MZIDDX
      MSIDS(ISB(MDNNCHN+1)) = MZIDDX
      MDISG(MZIDDX) = ISB(MDNNCHN+1)
      MDTYP(MZIDDX) = MDLTYP(MDISOLE,MDMEM,MDACT,0,0)
C
C****** FIN DE L'INITIALISATION DU SEGMENT DES DESCRIPTEURS
C
C     INDIQUER QUE LA CHAINE DES DESCRIPTEURS LIBRES EST VIDE
C     ON PROCEDERA A UNE EXTENSION DU SEGM AU PREMIER SEGINI
C     MZIDEX INDICE DU FUTUR PREMIER DESCRIPTEUR
C     MZIDEY INDICE DU DERNIER DESCRIPTEUR
C
      MDZERO(MZIDE1)=0
      MDIDS(MZIDE1)=-MZIDE1
      MDIDP(MZIDE1)=-MZIDE1
C****** MZIDEY&lt;MZIDEX--->PLUS DE DESCRIP LIBRE
      MZIDEX=MZIDE1+MDLDE*MDNDX0
      MZIDEY=MZIDEX-MDLDE
C         VALEUR PAR DEFAUT DE L'INCREMENT DESCRIPTEUR
      MZNDEX=MDNDEX
C
C***********************************************************************
C
C       REGLE D'ATTRIBUTION GENERALE = A DROITE DANS UN TROU
C                      DONC EN FIN DE MEMOIRE
C
        MZATGD(IZA,ZMEMDYN)=1
        MZATGD(IZA,ZMEMFIX)=1
C
C
C***********************************************************************
C*
C*       REMISE A ZERO DES BLOCS STATISTIQUES ...
C
      DO    I=1,MZNSTATS
        MZJSS(I)=0
        MZJSM(I)=0
      ENDDO
C
      DO    I=1,MZNMM
        MZJMM(I)=0
      ENDDO
C
      DO    I  = 1,8
        OOV(I) = 0
      ENDDO
C
C***********************************************************************
C*
C*              INITIALISATION DU DEBORDEMENT DISQUE
C*
C*   ->MZPTRK  LE SEGMENT GESTION : ESPACE FICHIER
C*   ->MZPBUF  LE SEGMENT BUFFER  : BLOCAGE DES PETITS SEGMENTS
C*
C*             ACTIF MAIS CHAINES SUR EUX MEMES
C*             POUR EVITER LEUR DESACTIVATION LORS DE LA SVGDE(OOOSAV)
C*             ET TEL QUE IDE&lt; MZIDEX
C*
C*     LES SEGM SERONT INIT A GAUCHE DS LA ZONE ACTIVE,DEPLACES A DROITE
C*      A LA PREMIERE EXTENSION DU SEGM DES DESCRIPTEURS(ATTRIB. A DRTE
C*       DS LE TROU INITIAL)
C*      MAIS CE SONT DES SGM DE DONNEE STD CONSIDERES COMME TELS PAR LE
C*      SYSTEME (POSITION MEMOIRE NON FIXE)
C
C
C****** INIT GESTION ESPACE DISQUE
C
C          LE SEGMENT BUFFER EST IMPLANTE EN FOND DE MEMOIRE,CE QUI
C           ASSURE DE NE PAS DEBORDER DU BLOC MEMOIRE LORSQU'ON
C           TRANSFERT SUR DISQUE UN GROS SEGMENT (VOIR OOODWD EN
C            FORMATTAGE)
C
C
C****** OUVERTURE FICHIER DE DEBORDEMENT (S'IL Y A LIEU)
C
      CALL OOODOP (LRET,MZPTRK,MZPBUF)
      IF (LRET.EQ.1)                                   GO TO 901
      IF (TESOOO)                               THEN
        WRITE(JLST,*)'--- TESOOO = ',TESOOO ,' , VERACT = ',VERACT
     1                                       ,' , GESMEM = ',GESMEM
        WRITE(JERR,*)'--- TESOOO = ',TESOOO ,' , VERACT = ',VERACT
     1                                       ,' , GESMEM = ',GESMEM
        CALL OOOWER ('DANS OOOSSG')
      ENDIF
                                                       RETURN
C-----------------------------------------------------------------------
C
C                          FERMETURE GEMAT
C
C     FERMER LE FICHIER DE DEBORDEMENT SI NECESSAIRE
C     LIBERER LA MEMOIRE
C
      ENTRY OOOSTP
C
C
C***  CALL OOOTHS
      IF (TESOOO) CALL OOOWER ('DANS OOOSTP')
      IF (MZPTRK.NE.0)   THEN
        CALL OOOZCL (LRET)
        IF (LRET.EQ.1)                                 GO TO 950
      ENDIF
 
      IESO=MZIZA(IZA)
      LESO=MZLZA(IZA)
      LRET=2
C***  CALL OOOZZC (LRET,IESO,LESO)
      IF (LRET.EQ.1)                                   GO TO 950
                                                       RETURN
C-----------------------------------------------------------------------
C
C                         MESSAGES D'ERREUR
C
 901  CALL OOOERR (0,0,'OOOSEG : ALLOCATION MEMOIRE INSUFFISANTE ')
 
C950  IF (LRET.EQ.999) SEGADJ , PPPP
 950                                                   STOP 16
      END