Télécharger oooin1.eso

Retour à la liste

oooin1
C OOOIN1    SOURCE    PV090527  26/04/24    08:23:10     12524          
      SUBROUTINE OOOIN1 (LRET,IP2,IP1)
C--------------------------------------------------------------------
C
C                           SEGINI , P = Q
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C   ->IP2      POINTEUR DESIGNANT LE SEGMENT CREE
C     IP1      POINTEUR DESIGNANT LE SEGMENT EMETTEUR
C
C PROGRAMMEUR : MOUGIN
C        CREE : 19/12/88    POUR LA FAMILLE : OOOW..
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
C
      POINTEUR  IP2.IDE , IP1.IDE , ID1.IDE
C
      nth=0
      if (thread) nth=oothrd
      call ooodeq(nth)
C      call ooosuq(nth)
      ID1   = IP1
      LFLAG = 0
C
C****** ON ACTIVE LE SEGMENT A COPIER APRES AVOIR SAUVEGARDE LES
C         INFORMATIONS DU DESCRIPTEUR
C
 100  MAXDEF=MZJSM(DEF)
      MXACTS=MZJSS(MAXACTIF)
      MXACTM=MZJSM(MAXACTIF)
C
      ITRK  = MDTRK(ID1)
      ITYP  = MDTYP(ID1)
      IDISK = MDDISK(ITYP)
      IQUEU = MDQUEU(ITYP)
      IETAT = MDETAT(ITYP)
      ILEN  = MDLEN(ID1)
      LRET=2
       IF (MDTYP(ID1).NE.MDACT) then
           CALL OOOACT (LRET,ID1,1)
       endif
      IF (LRET.EQ.1)                                   RETURN
C
C****** LE SEGMENT ETAIT GROS ET SUR DISQUE?
C            LE SEGMENT EN MEMOIRE SERA LA COPIE
C
      IF (IDISK.EQ.MDDISQUE .AND. MDCAT(ITYP).EQ.MDISOLE) THEN
         IDE=0
         CALL OOOINI (LRET,IDE,MSLSM-(MSLCZ))
         IF (LRET.EQ.1)                                RETURN
         ISG=MDISG(IDE)
         LSG=MSLS1(ISG)
         IS1=MDISG(ID1)
         LS1=MSLS1(IS1)
C         RECTIFIE LES STATISTIQUES
         MZJSM(ACTUEL)=MZJSM(ACTUEL)+(LS1-LSG)
         MZJSM(DEF)=MAX0(MZJSM(ACTUEL),MAXDEF)
         IF (IDISK.EQ.MDMEM .AND. IETAT.EQ.MDACT)      THEN
           MZJSM(ACTACTIF)=MZJSM(ACTACTIF)+LS1-LSG
         ELSE
           MZJSS(ACTACTIF)=MZJSS(ACTACTIF)-1
           MZJSM(ACTACTIF)=MZJSM(ACTACTIF)-LSG
         ENDIF
         MZJSS(MAXACTIF)=MAX0(MZJSS(ACTACTIF),MXACTS)
         MZJSM(MAXACTIF)=MAX0(MZJSM(ACTACTIF),MXACTM)
C         ON FAIT POINTER LE SEGMENT IDE SUR LA COPIE MEMOIRE DU SEGMENT
C           ID1
         MDCH0 , IDE
         CALL OOOMSU (IZA,ISG,LSG)
         MDCH0 , ID1
         MDISG(IDE) = IS1
         MSIDE(IS1) = IDE
         IDEA=MDACHN(ACTIF)
         MDCHNP, IDEA(IDE)
C         ON RESTAURE LE DESCRIPTEUR DU SEGMENT ID1
         MDTYP(ID1)=ITYP
         MDLEN(ID1)=ILEN
         MDTRK(ID1)=ITRK
C
C******   SINON ON PREND LA COPIE DU SEGMENT EN MEMOIRE
C
      ELSE
         IF (LFLAG.EQ.1) THEN
           CALL OOOSUP (LRET,IDE,0)
           IF (LRET.EQ.1)                              RETURN
         ENDIF
         LSG=MSLS1(MDISG(ID1))-(MSLCZ)
         IDE=0
         CALL OOOINI (LRET,IDE,LSG)
         IF (LRET.EQ.1)                                RETURN
 
C         SI LE SEGMENT EST REPARTI SUR DISQUE ,ON RECOMMENCE
 
         ITYPX=MDTYP(ID1)
         IF (MDDISK(ITYPX).EQ.MDDISQUE) THEN
             LFLAG=1
                                                        GO TO 100
         ENDIF
         IS1=MDISG(ID1)
         LS1=MSLS1(IS1)
         ISG=MDISG(IDE)
         CALL OOOZMV(JSG(IS1+MSLZ1+1),JSG(ISG+MSLZ1+1),LS1-(MSLCZ))
         MZJSS(DEPLACES)=MZJSS(DEPLACES)+1
         MZJSM(DEPLACES)=MZJSM(DEPLACES)+LS1-(MSLCZ)
C
C         SI COMPOSANT ON RECYCLE LE MARQUEUR (ACTIVATION VIRTUELLE)
         ITYPX=MDTYP(ID1)
         IF (MDCAT(ITYPX).EQ.MDBLOCK) THEN
           IDMK=MDMK(ID1)
           ITYPX=MDTYP(IDMK)
           ICHN=MDNCHN(ITYPX)
           IDEA=MDACHN(ICHN)
           MDCHN , IDEA(IDMK)
         ENDIF
C         ON DESACTIVE LE SEGMENT A COPIER SI BESOIN
         IF (IDISK.EQ.MDDISQUE .OR. IETAT.NE.MDACT) THEN
            IF (IQUEU.EQ.MDLRU) THEN
              NDES=LNOMOD
            ELSE
              NDES=MNOMOD
            ENDIF
            CALL OOODES (LRET,ID1,NDES-1)
         ENDIF
      ENDIF
C  PV ON ACTIVE IDE EN ECRITURE
      CALL OOOACT (LRET,IDE,0)
 
      IP2  = IDE
      LRET = 2
C  notre numero de thread dans mdrw
      mdrw(ip2)=nth+1
      if (nth.lt.64) mdro1(ip2)=ibset(0,nth)
      if (nth.ge.64) mdro2(ip2)=ibset(0,nth-64)
C  l'horodatage dans mdhor
      mdhor(ip2)=horo(nth)
                                                       RETURN
      END
 
 

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