* * $Id: mzrelb.F,v 1.4 1999/06/18 13:30:28 couet Exp $ * * $Log: mzrelb.F,v $ * Revision 1.4 1999/06/18 13:30:28 couet * - qcardl.inc was empty: It is now removed and not used. * Comment END CDE removed. * * Revision 1.3 1996/04/24 17:26:32 mclareni * Extend the include file cleanup to dzebra, rz and tq, and also add * dependencies in some cases. * * Revision 1.2 1996/04/18 16:12:37 mclareni * Incorporate changes from J.Zoll for version 3.77 * * Revision 1.1.1.1 1996/03/06 10:47:20 mclareni * Zebra * * #include "zebra/pilot.h" SUBROUTINE MZRELB C- Relocator for links in banks #include "zebra/zstate.inc" #include "zebra/zunit.inc" #include "zebra/mqsys.inc" #include "zebra/mzcn.inc" #include "zebra/mzct.inc" * #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M)) DIMENSION NAMESR(2) DATA NAMESR / 4HMZRE, 4HLB / #endif #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M)) DATA NAMESR / 6HMZRELB / #endif #if !defined(CERNLIB_QTRHOLL) CHARACTER NAMESR*8 PARAMETER (NAMESR = 'MZRELB ') #endif #if !defined(CERNLIB_QDEBUG) #include "zebra/q_jbyt.inc" #endif #include "zebra/qtrace.inc" LFIXLO = LQ(LQTA-1) LFIXRE = LQ(LQTA) LFIXHI = LQ(LQTE) JHIGO = (LQTE-LQTA) / 4 NENTR = JHIGO - 1 IF (NENTR.EQ.0) THEN LADTB1 = LQ(LQTA+1) NRLTB2 = LQ(LQTA+2) IFLTB3 = LQ(LQTA+3) ENDIF LMRNX = LQMTA 12 LMR = LMRNX IF (LMR.GE.LQMTE) GO TO 999 LMRNX = LMRNX + 8 #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) +WRITE (IQLOG,9813) (LQ(J+LMR-1),J=1,8) 9813 FORMAT (1X/' DEVZE MZRELB. DIV, ACT, NSH, LF, LL, LTA, LTB' F,', NFREE'/14X,2I5,6I7) #endif IACT = LQ(LMR+1) IF (IACT.LE.0) GO TO 12 IF (IACT.EQ.4) GO TO 12 LSTOP = LQ(LMR+4) IF (IACT.EQ.3) GO TO 14 LN = LQ(LMR+3) LDEAD = LSTOP GO TO 19 14 LSEC = LQRTA + LQ(LMR+5) - 4 C------ Next bank, check if dead group 16 LSEC = LSEC + 4 LNX = LQ(LSEC) LDEAD = LQ(LSEC+1) 17 LN = LNX IF (LN.GE.LSTOP) GO TO 12 IF (LN.EQ.LDEAD) GO TO 16 C-- Next bank, alive 19 CONTINUE #if defined(CERNLIB_QDEBUG) CALL MZCHLN (-7,LN) IF (IQFOUL.NE.0) GO TO 91 LNX = IQNX IF (IQND.LT.0) GO TO 17 LS = IQLS LX = LS + 3 L2 = LS - IQNS L1 = LS - IQNL #endif #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) WRITE (IQLOG,9819) LN, IQID,IQNL,IQNS,IQND 9819 FORMAT (1X/' DEVZE MZRELB. Do bank at LN =',I7 F,' ID,NL,NS,ND= ',A4,3I7) #endif #if !defined(CERNLIB_QDEBUG) NST = JBYT (LQ(KQS+LN),1,16) - 11 IF (NST.LT.0) THEN LNX = LN + NST + 11 GO TO 17 ELSE LS = LN + NST LX = LS + 3 L2 = LS - IQ(KQS+LS-2) L1 = LS - IQ(KQS+LS-3) LNX = LS + IQ(KQS+LS-1) + 9 ENDIF #endif IF (NENTR) 66, 46, 26 C-------------- 2 OR MORE RELOCATION INTERVALS ------------- C---- Next link 24 LQ(KQS+L1)= 0 25 L1 = L1 + 1 IF (L1.EQ.LX) GO TO 17 26 LFIRST= LQ(KQS+L1) 27 LINK = LQ(KQS+L1) IF (LINK.EQ.0) GO TO 25 #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1 9827 FORMAT (16X,'Link =',I7,' from L1 =',I7) #endif IF (IQFLIO.EQ.0) THEN IF (LINK.LT.LFIXLO) GO TO 25 IF (LINK.GE.LFIXHI) GO TO 25 IF (LINK.LT.LFIXRE) GO TO 24 ELSE IF (LINK.LT.LFIXRE) GO TO 24 IF (LINK.GE.LFIXHI) GO TO 24 ENDIF C-- Binary search in relocator table JLOW = 0 JHI = JHIGO 29 JEX = (JHI+JLOW) / 2 IF (JEX.EQ.JLOW) GO TO 31 IF (LINK.GE.LQ(LQTA+4*JEX)) GO TO 30 JHI = JEX GO TO 29 30 JLOW = JEX GO TO 29 C-- Relocate 31 JTB = LQTA + 4*JLOW #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) +WRITE (IQLOG,9831) JLOW, (LQ(JTB+J-1),J=1,4) 9831 FORMAT (50X,'Entry',I5,',',4I7) #endif IF (LINK.GE.LQ(JTB+1)) GO TO 33 LQ(KQS+L1) = LINK + LQ(JTB+2) GO TO 25 C---- Link into dead area 33 IF (LQ(JTB+3)) 25, 24, 34 C-- Bridge structural link 34 IF (L1.LT.L2) GO TO 24 IF (LS+1-L1) 36, 24, 35 35 CONTINUE #if defined(CERNLIB_QDEBUG) CALL MZCHLS (-7,LINK) IF (IQFOUL.NE.0) GO TO 92 #endif LINK = LQ(KQS+LINK) LQ(KQS+L1) = LINK IF (LINK.NE.LFIRST) GO TO 27 GO TO 24 C-- Reverse bridging of s-link 36 LINK = LQ(KQS+LINK+2) LQ(KQS+L1) = LINK GO TO 27 C-------------- 1 RELOCATION INTERVAL ONLY ------------- C---- Next link 44 LQ(KQS+L1)= 0 45 L1 = L1 + 1 IF (L1.EQ.LX) GO TO 17 46 LFIRST= LQ(KQS+L1) 47 LINK = LQ(KQS+L1) IF (LINK.EQ.0) GO TO 45 #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1 #endif IF (IQFLIO.EQ.0) THEN IF (LINK.LT.LFIXLO) GO TO 45 IF (LINK.GE.LFIXHI) GO TO 45 IF (LINK.LT.LFIXRE) GO TO 44 IF (LINK.GE.LADTB1) GO TO 53 ELSE IF (LINK.LT.LFIXRE) GO TO 44 IF (LINK.GE.LADTB1) GO TO 44 ENDIF C-- Relocate LQ(KQS+L1) = LINK + NRLTB2 GO TO 45 C---- Link into dead area 53 IF (IFLTB3) 45, 44, 54 C-- Bridge structural link 54 IF (L1.LT.L2) GO TO 44 IF (LS+1-L1) 56, 44, 55 55 CONTINUE #if defined(CERNLIB_QDEBUG) CALL MZCHLS (-7,LINK) IF (IQFOUL.NE.0) GO TO 92 #endif LINK = LQ(KQS+LINK) LQ(KQS+L1) = LINK IF (LINK.NE.LFIRST) GO TO 47 GO TO 44 C-- Reverse bridging of s-link 56 LINK = LQ(KQS+LINK+2) LQ(KQS+L1) = LINK GO TO 47 C-------------- NO RELOCATION INTERVAL ------------- C---- Next link 64 LQ(KQS+L1)= 0 65 L1 = L1 + 1 IF (L1.EQ.LX) GO TO 17 66 LINK = LQ(KQS+L1) IF (LINK.EQ.0) GO TO 65 #if defined(CERNLIB_QDEVZE) IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1 #endif IF (LINK.LT.LFIXLO) GO TO 65 IF (LINK.GE.LFIXHI) GO TO 65 GO TO 64 C------ Error conditions #if defined(CERNLIB_QDEBUG) 92 NQCASE = 1 NQFATA = 2 LN = LS IQUEST(12) = L1 IQUEST(13) = LINK 91 NQCASE = NQCASE + 1 NQFATA = NQFATA + 1 IQUEST(11) = LN IF (IQFLIO.NE.0) GO TO 98 #include "zebra/qtofatal.inc" 98 IQUEST(9) = NQCASE IQUEST(10)= NQFATA NQCASE = 0 NQFATA = 0 IQFLIO = -7 #endif #include "zebra/qtrace99.inc" RETURN END