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