MINICERN/packlib/zebra/mqg/mztabf.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:20  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE MZTABF
  11
  12 C-    Finalize Link Relocation table
  13
  14 #include "zebra/zstate.inc"
  15 #include "zebra/zunit.inc"
  16 #include "zebra/mqsys.inc"
  17 #include "zebra/mzct.inc"
  18 C--------------    End CDE                             --------------
  19 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  20       DIMENSION    NAMESR(2)
  21       DATA  NAMESR / 4HMZTA, 4HBF   /
  22 #endif
  23 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  24       DATA  NAMESR / 6HMZTABF /
  25 #endif
  26 #if !defined(CERNLIB_QTRHOLL)
  27       CHARACTER    NAMESR*8
  28       PARAMETER   (NAMESR = 'MZTABF  ')
  29 #endif
  30
  31 #include "zebra/q_jbit.inc"
  32
  33
  34 #include "zebra/qtrace.inc"
  35
  36       LMT    = LQMTA
  37       NCOLL  = 0
  38       NGARB  = 0
  39       NQNOOP = 0
  40       LFIXLO = NQLINK + 1
  41
  42 C----              Truncate initial inactive division entries
  43
  44    21 JDIV = LQ(LMT)
  45       IACT = LQ(LMT+1)
  46       IF (IACT.EQ.4)               GO TO 26
  47       IF (IACT.GE.2)               GO TO 28
  48
  49       IF (IACT.GE.0)  LFIXLO=LQEND(KQT+JDIV)
  50
  51       LMT = LMT + 8
  52       IF (LMT.LT.LQMTE)            GO TO 21
  53       NQNOOP = -7
  54       IF (NQDVMV.EQ.0)             GO TO 81
  55       NQNOOP = 7
  56       GO TO  81
  57
  58 C--                First active division is wipe
  59
  60    26 IF (LQ(LMT+9).NE.4)          GO TO 28
  61       IF (LMT+8.GE.LQMTE)          GO TO 28
  62       LMT = LMT + 8
  63       GO TO 26
  64
  65 C--                First active division has garb. coll. or shift
  66
  67    28 LFIR = LMT
  68       LQTA = LQRTA + LQ(LMT+5)
  69
  70 C--------          Loop remaining divisions
  71
  72    31 IACT = LQ(LMT+1)
  73       NSHF = LQ(LMT+2)
  74       LTU  = LQRTA + LQ(LMT+5)
  75       IF (IACT.EQ.4)               GO TO 71
  76       IF (IACT.EQ.3)               GO TO 61
  77       IF (IACT.EQ.2)               GO TO 41
  78       IF (IACT.LT.0)               GO TO 79
  79       NCOLL = NCOLL + 1
  80       IF (NCOLL.NE.1)              GO TO 79
  81       LCOLL = LMT
  82       GO TO 79
  83
  84 C------            Inactive division with shift
  85
  86    41 IF (NCOLL+NGARB.LT.2)        GO TO 49
  87
  88 C----              Squeeze out useless entries
  89
  90    43 LCOLE = LMT - 8
  91       LT    = LQ(LCOLE+5)
  92       LTF   = LQ(LCOLL+5)
  93       N     = LT - LTF
  94
  95 C--                Shift active start of the table
  96
  97       NW = LQRTA + LTF+1 - LQTA
  98       CALL UCOPY2 (LQ(LQTA),LQ(LQTA+N),NW)
  99       LQTA  = LQTA + N
 100       NCOLL = 0
 101       IF (IACT.EQ.4)               GO TO 71
 102       IF (IACT.EQ.3)               GO TO 61
 103
 104    49 LQ(LTU+2) = NSHF
 105       GO TO 77
 106
 107 C----              Garbage collection division
 108
 109    61 IF (NCOLL+NGARB.GE.2)        GO TO 43
 110       JDIV = LQ(LMT)
 111       LT   = LTU
 112       LTE  = LQRTA + LQ(LMT+6)
 113       MODE = JBIT (IQMODE(KQT+JDIV),1)
 114       IF (MODE.NE.0)               GO TO 65
 115
 116 C--                Calculate relocation constants for forward mode
 117
 118       NCUM = NSHF
 119       GO TO 66
 120
 121 C--                Calculate relocation constants for reverse mode
 122
 123    65 NCUM = LQ(LMT+7) + NSHF
 124    66 LQ(LT+2) = NCUM
 125       NCUM = NCUM - (LQ(LT+4)-LQ(LT+1))
 126       LT   = LT + 4
 127       IF (LT.LT.LTE)               GO TO 66
 128       NGARB = -64
 129       GO TO 77
 130
 131 C--                Wipe division
 132
 133    71 IF (NCOLL+NGARB.GE.2)        GO TO 43
 134    77 NCOLL = 0
 135
 136 C--                End of loop, set table termination
 137
 138    79 LMT = LMT + 8
 139       IF (LMT.LT.LQMTE)            GO TO 31
 140       LQ(LQTA-1) = LFIXLO
 141
 142       IF (NCOLL.EQ.0)              GO TO 81
 143       LQTE = LQRTA + LQ(LCOLL+5)
 144
 145    81 CONTINUE
 146 #if defined(CERNLIB_QDEVZE)
 147       IF (NQDEVZ.LT.11)            GO TO 999
 148       WRITE (IQLOG,9881) LQMTA,LQMTE
 149  9881 FORMAT (1X/' DEVZE MZTABF,  Memory Occupation Table,'
 150      F,' LQMTA,LQMTE= ',2I8/16X,
 151      F' DIV ACT     NWS    LFBK  LLBK+1     JFE     JLE    FREE')
 152
 153       WRITE (IQLOG,9882) (LQ(J),J=LQMTA,LQMTE-1)
 154  9882 FORMAT (16X,2I4,6I8)
 155
 156       WRITE (IQLOG,9883) LQRTA,LQTA,LQTE,LFIXLO
 157  9883 FORMAT (1H0,15X,'Link Relocation Table,'
 158      F,' LQRTA,LQTA,LQTE= ',3I8
 159      F/16X,'   LOC       L      LE    NREL  BG'
 160      F/30X,I8)
 161
 162       IF (LQTE.LE.LQTA)            GO TO 85
 163       I  = LQRTA
 164       JA = LQTA - I
 165       JE = LQTE - I - 1
 166       WRITE (IQLOG,9884) (J,LQ(I+J),LQ(I+J+1),LQ(I+J+2),LQ(I+J+3),
 167      +                                           J=JA,JE,4)
 168  9884 FORMAT (16X,I6,3I8,I4)
 169
 170    85 WRITE (IQLOG,9885) LQ(LQTE)
 171  9885 FORMAT (22X,I8)
 172 #endif
 173 #include "zebra/qtrace99.inc"
 174       RETURN
 175       END
 176 *      ==================================================
 177 #include "zebra/qcardl.inc"