Télécharger ooodes.eso

Retour à la liste

ooodes
C OOODES    SOURCE    PV090527  26/04/24    08:23:03     12524          
      SUBROUTINE OOODES (LRET,PSEG,KOD)
C-----------------------------------------------------------------------
C
C                       SEGDES , PSEG*(XMOD,XRU)
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C     PSEG     POINTEUR DESIGNANT LE SEGMENT A DESACTIVER
C
C     KOD      PARAMETRE DE DESACTIVATION
C           0  NOMOD+LRU
C           1    MOD+LRU
C           2  NOMOD+MRU
C           3    MOD+MRU
C           4  RECORD
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 17/01/89    UTILISER LE  OOODLB  SIMPLIFIE
C
C-----------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
      POINTEUR PSEG.PSEG , PSMARK.PSMARK
C
      LRET=2
      ITYP = MDTYP(PSEG)
      IETAT1 = MDETAT (ITYP)
C PV SI DEJA INACTIF ON NE FAIT RIEN
      IF (IETAT1.EQ.MDINACT)                           RETURN
 
      nth=0
      if (thread) nth=oothrd
      IF (thread.and.(nth.lt.64.and.ibits(mdro1(pseg),nth,1).eq.0).or.
     >           (nth.ge.64.and.ibits(mdro2(pseg),(nth-64),1).eq.0))
     >        return
C PV
      ibro=0
      if (thread) then
        nth=oothrd
        mdrw(pseg)=ibits(mdrw(pseg),0,18)
        if (mdrw(pseg).eq.nth+1) then
          mdrw(pseg)=0
          ibro=1
        endif
        if (nth.lt.64) mdro1(pseg)=ibclr(mdro1(pseg),nth)
        if (nth.ge.64) mdro2(pseg)=ibclr(mdro2(pseg),nth-64)
 
C       segdes*record
        if (kod/4.ne.0) 
     >       mdrw(pseg)=ibits(mdrw(pseg),0,18)+ishft((nth+1),18)
        if ((mdro1(pseg).eq.0.and.mdro2(pseg).eq.0).or.kod/4.ne.0) 
     >  ibro=1
        call oootdl(pseg,iflag)
        if(iflag.eq.0) ibro=0
 
        if((mdro1(pseg).ne.0.or.mdro2(pseg).ne.0).and.(.not.ooofor))then
          if(mdco(pseg).ne.0) then
            if(ibro.eq.1) call ooosig(mdco(pseg))
            call ooosdl(pseg)
          endif
          return
        endif
 
        if (ooofor.and.nth.eq.0)  then
          mdro1(pseg)=0
          mdro2(pseg)=0
          mdrw(pseg)=0
        endif
 
      else
        mdro1(pseg)=0
        mdro2(pseg)=0
        mdrw(pseg)=0
      endif
      METTRE CE SEGMENT EN READ ONLY (PSEG) = PSEG
      NN   = KOD+1
      IF (MDDISK(ITYP).EQ.MDDISQUE)                    GOTO 1000
      ISTAT1 = MSMKISS(ITYP)
      ICAT   = MDCAT  (ITYP)
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IF (MZPBUF.NE.0)                                 THEN
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IF (ICAT.EQ.MDISOLE)                             THEN
        ITRK   = MDTRK(PSEG)
      ELSE
        PSMARK = MDMK (PSEG)
        IF (PSMARK.LT.MZIDEX)                           GO TO 904
        IF (PSMARK.GT.MZIDEY)                           GO TO 904
        IF (MOD(PSMARK-MZIDE1,MDLDE).NE.0)              GO TO 904
        ITYPMK = MDTYP(PSMARK)
        IF (MDCAT(ITYPMK).NE.MDMARK)                    GO TO 904
C
        ISMARK = MDISG(PSMARK)
        ITRK   = MDTRK(PSMARK)
      ENDIF
C
C****** DESACTIVATION LRU D'UN COMPOSANT DE SUPER SEGMENT ? :
C          ON TRANSFERT LE MARQUEUR DANS LA CHAINE LRU :
C             -SI LE MARQUEUR ETAIT MRU
C             -SI LE SUPER SEGMENT ETAIT ACTIF
C
      IF (ICAT.EQ.MDBLOCK)                                THEN
        IF( (S S ACTIF(ISMARK)) .OR.
     *       ((NN.EQ.LNOMOD .OR. NN.EQ.LMOD).AND.
     *        (MDQUEU(ITYPMK).EQ.MDMRU)) )                THEN
          IDEA  = MDACHN(LRU)
          MDCHN , IDEA(PSMARK)
          MDQUEU(ITYPMK) = MDLRU
          MDETAT(ITYPMK) = MDINACT
          MDTYP (PSMARK) = ITYPMK
        ENDIF
        IF(S S ACTIF(ISMARK))                               THEN
          MZJSS(ACTACTIF)=MZJSS(ACTACTIF)-1
          MZJSM(ACTACTIF)=MZJSM(ACTACTIF)-(MSLMARK)
        ENDIF
      ENDIF
C
C****** SI LE SEGMENT EST MODIFIE,ON LIBERE LA PLACE DISQUE
C
C     IF ((ITRK.NE.0) .AND. (NN.EQ.LMOD .OR. NN.EQ.MMOD)) THEN
C       CALL OOODLB (MZPTRK,ITRK)
C       IF (ICAT.EQ.MDISOLE)                              THEN
C         MDTRK(PSEG)   = 0
C       ELSE
C         MDTRK(PSMARK) = 0
C       ENDIF
C     ENDIF
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      ENDIF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C****** PREPARATION DU NOUVEAU TYPE
C
C     IF (NN.EQ.LNOMOD .OR. NN.EQ.MNOMOD)              THEN
C     IF (ITRK.NE.0                     )              THEN
      IF (.FALSE.                       )              THEN
        MDETAT(ITYP)=MDNOMOD
      ELSE
        MDETAT(ITYP)=MDMOD
      ENDIF
C
      IF ((NN.EQ.MNOMOD .OR. NN.EQ.MMOD)
     *     .AND. (MDOPCHN(MRU).EQ.MDOPOCHN) )          THEN
        MDQUEU(ITYP) = MDMRU
      ELSE
        MDQUEU(ITYP) = MDLRU
      ENDIF
      MDIO(ITYP) = MDNBUF
C
C****** CHANGEMENT DE CHAINE
C
C         CHARGEMENT DANS LA CHAINE LRU OU MRU
C         CHARGEMENT DU NOUVEAU TYPE SEGMENT
C
C           SI COMPOSANT D'UN SUPER SEGMENT :
C
C         MISE A JOUR DE L 'ETAT DU SUPER SEGMENT
C         REMISE EN TETE  DE CHAINE DU MARQUEUR SI COMPOSANT INACTIF
C                   D'UN SUPER SEGMENT
C
      IF (ICAT.EQ.MDISOLE)                             THEN
        IF (MDQUEU(ITYP).EQ.MDLRU)                     THEN
          IDEA = MDACHN(LRU)
        ELSE
          IDEA = MSIDS(MDISG(MDACHN(MRU)))
        ENDIF
C
      ELSE
C
        ISTAT2 = MSMKISS(ITYP)
        MSMKSTAT(ISMARK,ISTAT1) = MSMKSTAT(ISMARK,ISTAT1) - 1
        MSMKSTAT(ISMARK,ISTAT2) = MSMKSTAT(ISMARK,ISTAT2) + 1
        IF (IETAT1.EQ.MDINACT)                         THEN
          IDEA  = MDACHN(LRU)
          MDCHN , IDEA(PSMARK)
        ENDIF
        IF (MDQUEU(ITYP).EQ.MDLRU)                     THEN
          IDEA  = MDACHN(CLRU)
        ELSE
          IDEA  = MSIDS(MDISG(MDACHN(CMRU)))
        ENDIF
      ENDIF
C
      IF   (IDEA.NE.PSEG)                              THEN
        MDCHN ,IDEA(PSEG)
      ENDIF
      MDTYP(PSEG) = ITYP
C
C****** MISE A JOUR DES STATISTIQUES
C
      ISEG = MDISG(PSEG)
      LSEG = MSLS1(ISEG)
      IF (IETAT1.EQ.MDACT)                             THEN
        MZJSS(ACTACTIF) = MZJSS(ACTACTIF)-1
        MZJSM(ACTACTIF) = MZJSM(ACTACTIF)-LSEG
      ENDIF
C
C******  CONTROLE DE VRAISEMBLANCE DES ZONES GEREES PAR GEMAUX
C            A L'INTERIEUR DU SGM ET DUMP SEGMENT
      CALL OOODMS (PSEG,1)
      IDG = 0
      IF (MSIDE(ISEG).NE.PSEG) IDG=IDG+1
      IF (MSLS2(ISEG).NE.LSEG) IDG=IDG+2
      IF (IDG.NE.0)                                    GO TO 905
      IF (VERACT) ADRESSE NEGATIVE DANS LE DESCRIPTEUR (PSEG) = ISEG
                                                       GOTO 1000
 1000 continue
C  signaler qu'on libere le segment
         if (thread.and.mdco(pseg).ne.0) then
           if (ibro.eq.1) call ooosig(mdco(pseg))
           call ooosdl(pseg)
         endif
      return
C-----------------------------------------------------------------------
C
C                        MESSAGES D'ERREUR
C
C
 904  CALL OOOERR (PSMARK,-1,'SUPER SEGMENT INCOHERENT')
                                                       GO TO 950
 905  CALL OOOERR (IDG , 1,'DESTRUCTION MEMOIRE')
 
 950                                                   STOP 16
C
      END
 
 

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