MINICERN/packlib/zebra/mqg/mzgarb.F.ori

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:12:32  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:20  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZGARB (IXGP,IXWP)
  14
  15 C-    Garbage collection + wiping, user called
  16
  17 #include "zebra/zstate.inc"
  18 #include "zebra/zunit.inc"
  19 #include "zebra/zvfaut.inc"
  20 #include "zebra/mqsys.inc"
  21 #include "zebra/mzct.inc"
  22 C--------------    End CDE                             --------------
  23       DIMENSION    IXGP(1), IXWP(9)
  24 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  25       DIMENSION    NAMESR(2)
  26       DATA  NAMESR / 4HMZGA, 4HRB   /
  27 #endif
  28 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  29       DATA  NAMESR / 6HMZGARB /
  30 #endif
  31 #if !defined(CERNLIB_QTRHOLL)
  32       CHARACTER    NAMESR*8
  33       PARAMETER   (NAMESR = 'MZGARB  ')
  34 #endif
  35
  36
  37       IXGARB = IXGP(1)
  38       IXWIPE = IXWP(1)
  39 #include "zebra/qtrace.inc"
  40 #if defined(CERNLIB_QDEBUG)
  41       IF (IQVSTA.NE.0)       CALL ZVAUTX
  42       JVLEV = 2
  43 #endif
  44
  45 C--                Construct Memory Occupation table
  46
  47       MQDVGA = 0
  48       MQDVWI = 0
  49       IF (IXGARB.EQ.0)             GO TO 16
  50 #if defined(CERNLIB_QDEBUG)
  51       JVLEV = 1
  52 #endif
  53
  54       MQDVGA = MZDVAC (IXGARB)
  55       IF (IXWIPE.EQ.0)             GO TO 19
  56       JSTO   = JQSTOR
  57       MQDVWI = MZDVAC (IXWIPE)
  58       IF (JSTO.NE.JQSTOR)          GO TO 91
  59       GO TO 19
  60
  61    16 MQDVWI = MZDVAC (IXWIPE)
  62    19 IF (MQDVGA+MQDVWI.EQ.0)      GO TO 999
  63
  64       NQRESV = 0
  65       JQSTMV = -1
  66 #if defined(CERNLIB_QDEBPRI)
  67       IF (NQLOGL.LT.1)             GO TO 24
  68       IF (MQDVGA.NE.0)             GO TO 22
  69       IF (NQLOGL.LT.2)             GO TO 24
  70    22 WRITE (IQLOG,9022) JQSTOR,MQDVGA,MQDVWI
  71  9022 FORMAT (' MZGARB-  User Garb.C./Wipe for store',I3,', Divs',
  72 #endif
  73 #if !defined(CERNLIB_HEX)
  74      F2(2X,O8))
  75 #endif
  76 #if defined(CERNLIB_HEX)
  77      F2(2X,Z6))
  78 #endif
  79 #if defined(CERNLIB_QDEBUG)
  80       IQVREM(1,JVLEV) = IQVID(1)
  81       IQVREM(2,JVLEV) = IQVID(2)
  82 #endif
  83    24 CALL MZTABM
  84
  85 C--                Construct Link Relocation table
  86
  87       CALL MZTABR
  88
  89 C--                Relocate + memory move
  90
  91       CALL MZTABX
  92       CALL MZTABF
  93       IF (NQNOOP.NE.0)             GO TO 999
  94       CALL MZGSTA (NQDGAU(KQT+1))
  95       CALL MZRELX
  96       CALL MZMOVE
  97       IF (IQPART.NE.0)             GO TO 24
  98 #include "zebra/qtrace99.inc"
  99       RETURN
 100
 101 C------            Error conditions
 102
 103    91 NQCASE = 1
 104       NQFATA = 2
 105       IQUEST(11) = JSTO
 106       IQUEST(12) = JQSTOR
 107 #include "zebra/qtofatal.inc"
 108       END
 109 *      ==================================================
 110 #include "zebra/qcardl.inc"