MINICERN/packlib/zebra/mq/mzattm.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:11:16  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 MZATTM (IXSTOP,CHNAME
  14      +,                  MEMOR,LSTAP,NWMP,NWEXP,CHOPT,ITABLE)
  15
  16 C-    Attach flat memory as a Zebra store region, user called
  17
  18 #include "zebra/zbcd.inc"
  19 #include "zebra/zstate.inc"
  20 #include "zebra/zunit.inc"
  21 #include "zebra/mqsys.inc"
  22 C--------------    End CDE                             --------------
  23       DIMENSION    IXSTOP(9),MEMOR(99),LSTAP(9),NWMP(9),NWEXP(9)
  24       DIMENSION    ITABLE(400)
  25       CHARACTER    *(*) CHNAME,CHOPT
  26 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  27       DIMENSION    NAMESR(2)
  28       DATA  NAMESR / 4HMZAT, 4HTM   /
  29 #endif
  30 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  31       DATA  NAMESR / 6HMZATTM /
  32 #endif
  33 #if !defined(CERNLIB_QTRHOLL)
  34       CHARACTER    NAMESR*8
  35       PARAMETER   (NAMESR = 'MZATTM  ')
  36 #endif
  37
  38 #include "zebra/q_sbit1.inc"
  39 #include "zebra/q_shiftl.inc"
  40 #include "zebra/q_locf.inc"
  41
  42
  43 #include "zebra/qtrace.inc"
  44
  45       IXSTOR = IXSTOP(1)
  46       LSTA   = LSTAP(1)
  47       NWMEM  = NWMP(1)
  48       NWEX   = NWEXP(1)
  49       CALL UOPTC (CHOPT,'QIR',IQUEST)
  50       LOGQ = IQUEST(1)
  51       IREI = IQUEST(2)
  52       IONL = IQUEST(3)
  53
  54       LASTOR = LOCF(MEMOR(1)) - 1
  55       LEND20 = 0
  56
  57 C------            Reset size of an existing read-only store
  58
  59       IF (IXSTOR.EQ.0)             GO TO 21
  60       CALL MZSDIV (IXSTOR,0)
  61       IF (NQALLO(JQSTOR).GE.0)     GO TO  91
  62       IF (NQALLO(JQSTOR).LT.-3)    GO TO  92
  63       IF (IREI.NE.0)               GO TO 24
  64       IF (NQALLO(JQSTOR).EQ.-1)    GO TO  92
  65       GO TO 61
  66
  67 C------            Initialize an new read-only store
  68
  69    21 JQSTOR = NQSTOR + 1
  70       IF   (NQSTOR)           93, 24, 22
  71    22 JQSTOR = IUFIND (-1,NQALLO(2),1,NQSTOR)
  72    24 CALL VZERO (KQT,25)
  73
  74 C--                Printing name of store
  75
  76       NQSNAM(1) = IQBLAN
  77       NQSNAM(2) = IQBLAN
  78       N = MIN (8, LEN(CHNAME))
  79       IF (N.NE.0)  CALL UCTOH (CHNAME,NQSNAM,4,N)
  80
  81 C--                Set log level
  82
  83       NQLOGL = NQLOGD
  84       IF (LOGQ.NE.0)  NQLOGL=-2
  85
  86 C--                Calculate table off-set
  87
  88       LOCT = LOCF (ITABLE(1)) - 1
  89       KQT  = LOCT - LQATAB
  90
  91 #if defined(CERNLIB_QPRINT)
  92       IF (NQLOGL.GE.0)  THEN
  93           KQS = LASTOR - LQASTO
  94           WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
  95      +,                  LASTOR,LOCT,LASTOR,LOCT,KQS,KQT,KQS,KQT
  96         ENDIF
  97  9021 FORMAT (1X/' MZATTM.  Attach Memory as Store',I3,'  in ',2A4,
  98      F/10X,'with Store/Table at absolute adrs',2I12
  99 #endif
 100 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
 101      F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
 102 #endif
 103 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
 104      F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
 105 #endif
 106 #if defined(CERNLIB_QPRINT)
 107      F/30X,'relative adrs',2I12)
 108 #endif
 109
 110       IF (JQSTOR.GE.16)            GO TO  94
 111
 112 C----              Initialize divisions 1 + 2 + system
 113
 114       NQOFFT(JQSTOR+1) = KQT
 115       CALL VZERO (IQTABV(KQT+1),NQTSYS)
 116       CALL VBLANK (IQDN1(KQT+1), 40)
 117
 118       JQDVLL = 2
 119       JQDVSY = 20
 120       IQDN1(KQT+20) = IQLETT(19)
 121       IQDN1(KQT+2)  = IQLETT(4)
 122
 123       IQKIND(KQT+1) = MSBIT1 (1,21)
 124       IQDN1(KQT+1)  = NQSNAM(1)
 125       IQDN2(KQT+1)  = NQSNAM(2)
 126
 127       CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
 128
 129 C--                Return IXSTOR
 130       IF (IXSTOR.EQ.0)  THEN
 131           IXSTOP(1) = ISHFTL (JQSTOR,26)
 132         ENDIF
 133
 134       IF (JQSTOR.GT.NQSTOR)  NQSTOR = JQSTOR
 135       NQALLO(JQSTOR) = -3 + IONL
 136
 137 C------            Set size of the store
 138
 139    61 LQSTOR = LASTOR
 140       KQS    = LQSTOR - LQASTO
 141       NQOFFS(JQSTOR+1) = KQS
 142       IQTABV(KQT+1)       = LQSTOR
 143
 144       LEND1  = LSTA  + NWMEM
 145       LEND20 = LEND1 + NWEX
 146
 147       NQDMAX(KQT+1) = NWMEM + NWEX
 148       LQSTA(KQT+1)  = LSTA
 149       LQEND(KQT+1)  = LEND1
 150       LQSTA(KQT+2)  = LEND20
 151       LQEND(KQT+2)  = LEND20
 152       LQSTA(KQT+20) = LEND20
 153       LQEND(KQT+20) = LEND20
 154       LQSTA(KQT+21) = LEND20
 155 #if defined(CERNLIB_QDEBPRI)
 156       IF (NQLOGL.GE.2)
 157      +  WRITE (IQLOG,9089) JQSTOR,NQSNAM(1),NQSNAM(2),LASTOR
 158      +,                    LSTA,NWMEM,NWEX
 159  9089 FORMAT (' MZATTM-  Store',I3,'  in ',2A4,' at adr',I12
 160      F/10X,'Memory starting at LSTA=',I8,' with',2I8,' words.')
 161 #endif
 162
 163 #include "zebra/qtrace99.inc"
 164       RETURN
 165
 166 C------            Error conditions
 167
 168    94 NQCASE = NQCASE + 1
 169    93 NQCASE = NQCASE + 1
 170    92 NQCASE = NQCASE + 1
 171    91 NQCASE = NQCASE + 1
 172       NQFATA = 4
 173       IQUEST(11) = NQSNAM(1)
 174       IQUEST(12) = NQSNAM(2)
 175       IQUEST(13) = LEND20
 176       IQUEST(14) = IXSTOR
 177       JQSTOR = -1
 178 #include "zebra/qtofatal.inc"
 179       END
 180 *      ==================================================
 181 #include "zebra/qcardl.inc"