5 * Revision 1.2 1996/04/18 16:12:06 mclareni
6 * Incorporate changes from J.Zoll for version 3.77
8 * Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
12 #include "zebra/pilot.h"
13 SUBROUTINE MZSTOR (IXSTOR,CHNAME,CHOPT
14 +, IFENCE,LV,LLR,LLD,LIMIT,LAST)
16 C- Initialize new Zebra store region, user called
18 #include "zebra/zbcd.inc"
19 #include "zebra/zmach.inc"
20 #include "zebra/zstate.inc"
21 #include "zebra/zunit.inc"
22 #include "zebra/mqsys.inc"
23 #include "zebra/mzcwk.inc"
24 C-------------- End CDE --------------
25 DIMENSION IXSTOR(9),IFENCE(9)
26 DIMENSION LV(9),LLR(9),LLD(9),LIMIT(9),LAST(9)
27 DIMENSION MMSYSL(5), NAMELA(2), NAMESY(2)
28 CHARACTER *(*) CHNAME,CHOPT
29 #if defined(CERNLIB_QMVDS)
30 SAVE MMSYSL, NAMELA, NAMESY, NAMWSP, NAMEDV
32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
34 DATA NAMESR / 4HMZST, 4HOR /
36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
37 DATA NAMESR / 6HMZSTOR /
39 #if !defined(CERNLIB_QTRHOLL)
41 PARAMETER (NAMESR = 'MZSTOR ')
43 #if defined(CERNLIB_QHOLL)
44 DATA MMSYSL / 4HSYSL,0,0,101,2/
45 DATA NAMELA / 4Hsyst, 4Hem /
46 DATA NAMESY / 4Hsyst, 4Hem /
47 DATA NAMWSP / 4Hqwsp /
48 DATA NAMEDV / 4HQDIV /
50 #if !defined(CERNLIB_QHOLL)
51 DATA MMSYSL / 0,0,0,101,2/
54 #include "zebra/q_sbit1.inc"
55 #include "zebra/q_shiftl.inc"
56 #include "zebra/q_locf.inc"
59 C-- Clear Zebra tables on first entry
61 IF (NQSTOR.NE.-1) GO TO 13
62 CALL VZERO (NQOFFT,32)
63 LQATAB = LOCF (IQTABV(1)) - 1
64 LQASTO = LOCF (LQ(1)) - 1
65 LQBTIS = LQATAB - LQASTO
66 LQWKTB = LOCF(IQWKTB(1)) - LQASTO
67 LQWKFZ = LOCF(IQWKFZ(1)) - LQASTO
68 NQTSYS = LOCF(IQDN2(20)) - LQATAB
71 C- KQFT=342 relies on LQFSTA(1) to be LQSTA(1+342) in /MZCC/
73 #if defined(CERNLIB_QPRINT)
75 +WRITE (IQLOG,9011) LQATAB,LQATAB
76 9011 FORMAT (1X/' MZSTOR. ZEBRA table base TAB(0) in /MZCC/ at adr'
78 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
81 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
84 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
88 #if !defined(CERNLIB_QHOLL)
89 CALL UCTOH ('SYSL', MMSYSL, 4,4)
90 CALL UCTOH ('system ',NAMELA, 4,8)
91 CALL UCTOH ('system ',NAMESY, 4,8)
92 CALL UCTOH ('qwsp' ,NAMWSP, 4,4)
93 CALL UCTOH ('QDIV' ,NAMEDV, 4,4)
96 #include "zebra/qtrace.inc"
98 CALL UOPTC (CHOPT,'Q:',IQUEST)
105 C-- Calculate store off-set
107 LQSTOR = LOCF(LV(1)) - 1
108 KQS = LQSTOR - LQASTO
110 NFEND = (LQSTOR+1) - LOCF(IFENCE(1))
113 C-- Printing name of store
117 N = MIN (8, LEN(CHNAME))
118 IF (N.NE.0) CALL UCTOH (CHNAME,NQSNAM,4,N)
123 IF (LOGQ.NE.0) NQLOGL=-2
125 C-- Permanent links et al.
127 NQSTRU = LOCF(LLR(1)) - (LQSTOR+1)
128 NQREF = LOCF(LLD(1)) - (LQSTOR+1)
130 LQ2END = LOCF(LIMIT(1)) - LQSTOR
131 NDATAT = LOCF(LAST(1)) - LQSTOR
133 C-- Calculate table off-set
137 IF (JQSTOR.NE.0) THEN
138 NDATA = NDATA - NQTSYS
140 LOCT = LQSTOR + NDATA
143 CALL VFILL (LQ(KQS+NDATA),10,IQNIL)
146 #if defined(CERNLIB_QPRINT)
148 +WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
149 +, LQSTOR,LOCT,LQSTOR,LOCT,KQS,KQT,KQS,KQT
150 +, NQSTRU,NQREF,LQ2END,NDATAT,NFEND
151 9021 FORMAT (1X/' MZSTOR. Initialize Store',I3,' in ',2A4,
152 F/10X,'with Store/Table at absolute adrs',2I12
154 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
155 F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
157 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
158 F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
160 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
161 F/30X,'HEX',2(1X,Z16)/30X,'HEX',2(1X,Z16)
163 #if defined(CERNLIB_QPRINT)
164 F/30X,'relative adrs',2I12
165 F/10X,'with',I6,' Str. in',I6,' Links in',I7,' Low words in'
167 F/10X,'This store has a fence of',I5,' words.')
170 C-- Set minimum sizes
175 IF (JQSTOR.EQ.0) NQMINR=164
177 C-- Check parameters valid
179 IF (NQSTRU.LT.0) GO TO 91
180 IF (NQREF .LT.NQSTRU) GO TO 91
181 IF (NDATAT.LT.NQLINK+NWF) GO TO 91
182 IF (LQ2END.LT.NQLINK+NQMINR) GO TO 91
183 IF (NFEND .LT.1) GO TO 92
184 IF (NFEND .GE.1001) GO TO 92
185 IF (IFLSPL.EQ.1) THEN
186 IF (JQSTOR.EQ.0) GO TO 96
190 #if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
191 C-- Check overlapping stores
193 IF (JQSTOR.EQ.0) GO TO 41
200 JSA = JS - IQTABV(JT+2)
201 JSE = JS + LQSTA(JT+21)
205 IF (KSE.GT.JTA .AND. KSA.LT.JTE) GO TO 94
206 IF (KSE.GT.JSA .AND. KSA.LT.JSE) GO TO 95
209 39 IF (JQSTOR.GE.16) GO TO 93
211 C---- Initialize divisions 1 + 2 + system
213 41 NQOFFT(JQSTOR+1) = KQT
214 NQOFFS(JQSTOR+1) = KQS
215 NQALLO(JQSTOR+1) = IFLSPL
216 CALL VZERO (IQTABV(KQT+1),NQTSYS)
217 CALL VBLANK (IQDN1(KQT+1), 40)
220 LQ(KQS+NDATA-1) = IQNIL
221 LQ(KQS+NDATA) = IQNIL
224 LQSTA(KQT+21) = NDATA
228 LQSTA(KQT+20) = NDATA
229 LQEND(KQT+20) = NDATA
230 NQDMAX(KQT+20) = NDATA
232 IQKIND(KQT+20) = ISHFTL (1, 23)
233 IQRNO(KQT+20) = 9437183
234 IQDN1(KQT+20) = NAMESY(1)
235 IQDN2(KQT+20) = NAMESY(2)
237 LQSTA(KQT+2) = NDATA - NSYS
238 LQEND(KQT+2) = LQSTA(KQT+2)
239 NQDMAX(KQT+2) = NDATA
241 IQKIND(KQT+2) = MSBIT1 (2, 21)
243 IQRTO(KQT+2) = ISHFTL (3,20)
244 IQRNO(KQT+2) = 9437183
245 IQDN1(KQT+2) = NAMEDV
246 IQDN2(KQT+2) = IQNUM(3)
248 LQSTA(KQT+1) = NQLINK + 1
249 LQEND(KQT+1) = LQSTA(KQT+1)
250 NQDMAX(KQT+1) = NDATA
251 IQKIND(KQT+1) = MSBIT1 (1, 21)
253 IQRTO(KQT+1) = ISHFTL (3,20)
254 IQRNO(KQT+1) = 9437183
255 IQDN1(KQT+1) = NAMEDV
256 IQDN2(KQT+1) = IQNUM(2)
258 CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
259 CALL VFILL (IFENCE,NFEND,IQNIL)
260 IF (NQLINK.NE.0) CALL VZERO (LV,NQLINK)
264 IF (JQSTOR.EQ.0) THEN
265 IF (IXSTOR(1).EQ.0) GO TO 71
267 IDN = ISHFTL (JQSTOR,26)
270 C---- Create system link table bank
273 CALL MZLIFT (-7,LSYS,0,2,MMSYSL,0)
276 NALL = LOCF(IQTDUM(1)) - LOCF(LQSYSS(1))
277 NSTR = LOCF(LQSYSR(1)) - LOCF(LQSYSS(1))
279 LOCAR = LOCF (LQSYSS(KQT+1)) - LQSTOR
280 LOCARE = LOCAR + NALL
286 IQ(KQS+LSYS+3) = 1 + NQLINK
287 IQ(KQS+LSYS+4) = NQSTRU
288 IQ(KQS+LSYS+5) = NAMWSP
289 IQ(KQS+LSYS+6) = IQBLAN
293 IQ(KQS+LSYS+7) = LOCAR
294 IQ(KQS+LSYS+8) = LOCARE
295 IQ(KQS+LSYS+9) = NSTR
296 IQ(KQS+LSYS+10)= NAMELA(1)
297 IQ(KQS+LSYS+11)= NAMELA(2)
299 C-- Range of possible values for an origin-link
301 IQTABV(KQT+13) = MIN (1, LOCAR)
302 IQTABV(KQT+14) = MAX (LQSTA(KQT+21), LOCARE)
304 #include "zebra/qtrace99.inc"
307 C------ Error conditions
309 #if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
311 94 NQCASE = NQCASE - 2
313 IQUEST(20) = JSTO - 1
314 IQUEST(21) = NQPNAM(JT+1)
315 IQUEST(22) = NQPNAM(JT+2)
318 96 NQCASE = NQCASE + 3
319 93 NQCASE = NQCASE + 1
320 92 NQCASE = NQCASE + 1
321 91 NQCASE = NQCASE + 1
323 IQUEST(11) = NQSNAM(1)
324 IQUEST(12) = NQSNAM(2)
332 #include "zebra/qtofatal.inc"
334 * ==================================================
335 #include "zebra/qcardl.inc"