1 /*
2 * Copyright (c) 1993-2019, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /** \file
19 * \brief Directive/pragma support modules
20 */
21
22 #include "direct.h"
23 #include "pragma.h"
24 #include "ilidir.h"
25 #include "miscutil.h"
26
27 #if DEBUG
28 static void dmp_dirset(DIRSET *);
29 static void dmp_lpprg(int);
30 #define TR0(s) \
31 if (DBGBIT(1, 1024)) \
32 fprintf(gbl.dbgfil, s);
33 #define TR1(s, a) \
34 if (DBGBIT(1, 1024)) \
35 fprintf(gbl.dbgfil, s, a);
36 #define TR2(s, a, b) \
37 if (DBGBIT(1, 1024)) \
38 fprintf(gbl.dbgfil, s, a, b);
39 #define TR3(s, a, b, c) \
40 if (DBGBIT(1, 1024)) \
41 fprintf(gbl.dbgfil, s, a, b, c);
42
43 #else
44 #define TR0(s)
45 #define TR1(s, a)
46 #define TR2(s, a, b)
47 #define TR3(s, a, b, c)
48
49 #endif
50 #include "x86.h"
51
52 DIRECT direct;
53
54 #ifdef FE90
55
56 /* For saving the directives for the backends of the native compilers */
57
58 typedef struct {
59 int beg_line; /* beginning line # of loop */
60 int end_line; /* ending line # of loop */
61 DIRSET change; /* what's changed */
62 DIRSET newset; /* dirset state for the routine & loops */
63 /* How an entry in newset is propagated depends on the
64 * type (value vs bit vector) of the entry:
65 * - if value:
66 * change == nonzero => propagate the value
67 * - if a bit vector:
68 * change == nonzero => for each bit which is
69 * set, the new value of the corresponding bit
70 * position is propagated. All other bits are
71 * left untouched.
72 * The change value is computed as
73 * change = new ^ old
74 * The new value of the bit vector is
75 * computed as
76 * val = (new & change) | (current & !change)
77 */
78 } SVDIR;
79
80 static struct {
81 SVDIR *stgb; /* [0] is reserved for the routine's directives.
82 * [>=1] used for the loops' directives.
83 */
84 int size;
85 int avail; /* avail is actually tracked as direct.lpg.avail;
86 * svdir.avail is needed for direct_export()
87 */
88 } svdir = {NULL, 0, 0};
89
90 static DIRSET inigbl;
91
92 static void update_rou_begin(void);
93 static void diff_dir(SVDIR *, DIRSET *, DIRSET *);
94 static void wr_dir(FILE *, SVDIR *);
95 #endif
96
97 /** \brief Initialize directive structure
98 *
99 * Initialize directive structure which is global for the
100 * source file and the structure which is used per routine.
101 * must be called just once for the compilation and after all of the
102 * command line options have been processed.
103 *
104 * The initial values of the global structure are extracted from
105 * the command line options. The routine structure is initialized
106 * with values from the global structure.
107 */
108 void
direct_init(void)109 direct_init(void)
110 {
111
112 /* Set/clear any xbits for which the command line processing has no
113 * effect
114 */
115 flg.x[8] |= 0x8; /* disable global reg assignment */
116
117 store_dirset(&direct.gbl);
118
119 #ifdef FE90
120 inigbl = direct.gbl;
121 #endif
122 direct.rou = direct.gbl;
123 direct.loop = direct.gbl;
124 direct.rou_begin = direct.gbl;
125
126 direct.loop_flag = false; /* seen pragma with loop scope */
127 direct.in_loop = false; /* in loop with pragmas */
128 direct.carry_fwd = false;
129
130 direct.avail = 0;
131 NEW(direct.stgb, DIRSET, (direct.size = 16));
132
133 direct.lpg.avail = 1;
134
135 NEW(direct.lpg.stgb, LPPRG, (direct.lpg.size = 16));
136 BZERO(direct.lpg.stgb, LPPRG, 1);
137 direct.lpg_stk.top = 0;
138 NEW(direct.lpg_stk.stgb, LPG_STK, (direct.lpg_stk.size = 8));
139
140 #ifdef FE90
141 direct.dynlpg.avail = 1;
142 NEW(direct.dynlpg.stgb, LPPRG, (direct.dynlpg.size = 16));
143 if (flg.genilm) {
144 /* [0] is reserved for the 'routine' directives */
145 NEW(svdir.stgb, SVDIR, (svdir.size = 16));
146 BZERO(svdir.stgb, SVDIR, 1); /* init [0] to zero */
147 }
148 direct.indep = NULL;
149 direct.index_reuse_list = NULL;
150 #endif
151
152 }
153
154 void
direct_fini()155 direct_fini()
156 {
157 if (direct.stgb) {
158 FREE(direct.stgb);
159 direct.avail = direct.size = 0;
160 }
161 if (direct.lpg.stgb) {
162 FREE(direct.lpg.stgb);
163 direct.lpg.avail = direct.lpg.size = 0;
164 }
165 if (direct.lpg_stk.stgb) {
166 FREE(direct.lpg_stk.stgb);
167 direct.lpg_stk.top = direct.lpg_stk.size = 0;
168 }
169 #ifdef FE90
170 if (direct.dynlpg.stgb) {
171 FREE(direct.dynlpg.stgb);
172 direct.dynlpg.avail = direct.dynlpg.size = 0;
173 }
174 if (svdir.stgb) {
175 FREE(svdir.stgb);
176 svdir.avail = svdir.size = 0;
177 }
178 #endif
179 } /* direct_fini */
180
181 /** \brief Re-initialize the routine structure
182 *
183 * Must be called after the end of a function is processed by semant and
184 * before the next function is parsed. For C, this is when the END ilm is
185 * written for a function. For Fortran, this is after a subprogram has been
186 * processed by all phases of the compiler.
187 *
188 * For C, process any symbol-/variable- related pragmas which may have
189 * occurred. Also, save the index into the lpprg table which is the beginning
190 * of the function's lpprg segment; mark the end of the segment with an entry
191 * whose beg_line is -1.
192 */
193 void
direct_rou_end(void)194 direct_rou_end(void)
195 {
196 /* CPLUS also needs to save routine's structure: */
197 #ifdef FE90
198 if (flg.genilm) {
199 update_rou_begin();
200 }
201 #endif
202 direct.lpg.avail = 1;
203
204 direct.rou = direct.gbl;
205 direct.loop = direct.gbl;
206 direct.rou_begin = direct.gbl;
207 direct.carry_fwd = false;
208 #ifdef FE90
209 direct.dynlpg.avail = 1;
210 #endif
211
212 }
213
214 void
direct_loop_enter(void)215 direct_loop_enter(void)
216 {
217 if (direct.loop_flag || (direct.carry_fwd && !direct.in_loop)) {
218 push_lpprg(gbl.lineno);
219 #ifdef FE90
220 if (flg.genilm) {
221 NEEDB(direct.lpg.avail, svdir.stgb, SVDIR, svdir.size,
222 direct.lpg.avail + 8);
223 diff_dir(&svdir.stgb[direct.lpg.avail - 1],
224 &direct.lpg.stgb[direct.lpg.avail - 1].dirset, &direct.loop);
225 }
226 #endif
227 }
228
229 }
230
231 /** \brief Re-initialize the loop structure
232 *
233 * Must be called after the end of a loop is processed by semant for which
234 * loop-scoped pragmas/directives apply.
235 */
236 void
direct_loop_end(int beg_line,int end_line)237 direct_loop_end(int beg_line, int end_line)
238 {
239 int i;
240 LPPRG *lpprg;
241
242 if (!direct.in_loop)
243 return;
244 i = direct.lpg_stk.stgb[direct.lpg_stk.top].dirx;
245 lpprg = direct.lpg.stgb + i;
246 if (lpprg->beg_line != beg_line)
247 return;
248
249 /***** pop_lpprg *****/
250
251 TR1("---pop_lpprg: top %d,", direct.lpg_stk.top);
252 direct.lpg_stk.top--;
253 TR1(" lpprg %d,", i);
254 lpprg = direct.lpg.stgb + i;
255
256 lpprg->end_line = end_line;
257 TR2(" beg %d, end %d\n", lpprg->beg_line, lpprg->end_line);
258
259 direct.loop = direct.rou;
260
261 #ifdef FE90
262 if (flg.genilm) {
263 svdir.stgb[i].beg_line = lpprg->beg_line;
264 svdir.stgb[i].end_line = lpprg->end_line;
265 }
266 #endif
267
268 if (direct.lpg_stk.top == 0) {
269 direct.loop_flag = false;
270 direct.in_loop = false;
271 } else if (XBIT(59, 1)) {
272 direct.loop =
273 direct.lpg.stgb[direct.lpg_stk.stgb[direct.lpg_stk.top].dirx].dirset;
274 } else {
275 /*
276 * propagate selected directives/pragmas to all nested
277 */
278 i = direct.lpg_stk.stgb[direct.lpg_stk.top].dirx;
279 direct.loop.depchk = direct.lpg.stgb[i].dirset.depchk;
280 }
281 #if DEBUG
282 if (DBGBIT(1, 512))
283 dmp_lpprg(direct.lpg_stk.stgb[direct.lpg_stk.top + 1].dirx);
284 #endif
285
286 }
287
288 #ifdef FE90
289 /*
290 * for the IPA recompile, save the loop pragma directly
291 */
292 void
direct_loop_save()293 direct_loop_save()
294 {
295 int i;
296 for (i = 1; i < direct.lpg.avail; ++i) {
297 NEED(i + 1, svdir.stgb, SVDIR, svdir.size, i + 8);
298 diff_dir(&svdir.stgb[i], &direct.lpg.stgb[i].dirset, &direct.loop);
299 svdir.stgb[i].beg_line = direct.lpg.stgb[i].beg_line;
300 svdir.stgb[i].end_line = direct.lpg.stgb[i].end_line;
301 }
302 } /* direct_loop_save */
303 #endif
304
305 typedef struct xf_tag {
306 char *fn; /* name of function */
307 int x; /* which xflag */
308 int v; /* value of xflag */
309 struct xf_tag *next;
310 } XF;
311
312 static XF *xf_p = NULL; /* list of function -x ... */
313 static XF *yf_p = NULL; /* list of function -y ... */
314
315 void
direct_xf(char * fn,int x,int v)316 direct_xf(char *fn, int x, int v)
317 {
318 XF *xfp;
319 /*printf("-xf %s %d 0x%x\n", fn, x, v);*/
320 xfp = (XF *)getitem(8, sizeof(XF));
321 xfp->next = xf_p;
322 xf_p = xfp;
323 xfp->fn = fn;
324 xfp->x = x;
325 xfp->v = v;
326 }
327
328 void
direct_yf(char * fn,int x,int v)329 direct_yf(char *fn, int x, int v)
330 {
331 XF *xfp;
332 /*printf("-yf %s %d 0x%x\n", fn, x, v);*/
333 xfp = (XF *)getitem(8, sizeof(XF));
334 xfp->next = yf_p;
335 yf_p = xfp;
336 xfp->fn = fn;
337 xfp->x = x;
338 xfp->v = v;
339 }
340
341 /** \brief Load direct.rou for the current function
342 *
343 * Called after the parse phase is complete; called once per function. For C
344 * this means the call occurs during expand when it sees the ENTRY ilm; for
345 * Fortran, this is at the beginning of expand (in main).
346 *
347 * DIRSET direct.rou_begin represents the state of the directives/pragmas at
348 * the beginning of the function.
349 *
350 * \param func - symbol of current function
351 */
352 void
direct_rou_load(int func)353 direct_rou_load(int func)
354 {
355 DIRSET *currdir;
356 XF *xfp;
357 char *fnp;
358
359 currdir = &direct.rou_begin;
360
361 load_dirset(currdir);
362
363 fnp = SYMNAME(gbl.currsub);
364 for (xfp = xf_p; xfp != NULL; xfp = xfp->next) {
365 if (strcmp(xfp->fn, fnp) == 0) {
366 /*printf("-xf %s %d 0x%x\n", xfp->fn, xfp->x, xfp->v);*/
367 set_xflag(xfp->x, xfp->v);
368 currdir->x[xfp->x] = flg.x[xfp->x];
369 }
370 }
371 for (xfp = yf_p; xfp != NULL; xfp = xfp->next) {
372 if (strcmp(xfp->fn, fnp) == 0) {
373 /*printf("-yf %s %d 0x%x\n", xfp->fn, xfp->x, xfp->v);*/
374 set_yflag(xfp->x, xfp->v);
375 currdir->x[xfp->x] = flg.x[xfp->x];
376 }
377 }
378
379 #ifndef FE90
380 /*
381 * the optimizer doesn't handle assigned goto's correctly.
382 * (Doesn't know where to put loop exit code if you assign
383 * goto out of loop)
384 */
385 if ((gbl.asgnlbls == -1) && (flg.opt >= 2)) {
386 error(I_0127_Optimization_level_for_OP1_changed_to_opt_1_OP2, ERR_Informational, 0, SYMNAME(gbl.currsub), "due to assigned goto");
387 currdir->opt = flg.opt = 1;
388 currdir->vect = flg.vect = 0;
389 }
390 if (gbl.vfrets) {
391 /*
392 * temporarily disable optimizations not correctly
393 * handle if variable functions occur.
394 */
395 if (flg.opt >= 2) {
396 error(I_0127_Optimization_level_for_OP1_changed_to_opt_1_OP2, ERR_Informational, 0, SYMNAME(gbl.currsub), "due to < > in FORMAT");
397 currdir->opt = flg.opt = 1;
398 currdir->vect = flg.vect = 0;
399 }
400 flg.x[8] |= 0x8; /* no globalregs at opt 1 */
401 }
402 #endif
403
404 #if DEBUG
405 if (DBGBIT(1, 256)) {
406 fprintf(gbl.dbgfil, "---dirset for func ");
407 fprintf(gbl.dbgfil, "%s\n", SYMNAME(func));
408 dmp_dirset(currdir);
409 }
410 #endif
411
412 #if (defined(TARGET_X86) || defined(TARGET_LLVM)) && !defined(FE90)
413 set_mach(&mach, direct.rou_begin.tpvalue[0]);
414 #endif
415
416 }
417
418 void
direct_rou_setopt(int func,int opt)419 direct_rou_setopt(int func, int opt)
420 {
421 DIRSET *currdir;
422 currdir = &direct.rou_begin;
423 flg.opt = opt;
424 currdir->opt = opt;
425 }
426
427 void
load_dirset(DIRSET * currdir)428 load_dirset(DIRSET *currdir)
429 {
430 flg.depchk = currdir->depchk;
431 flg.opt = currdir->opt;
432 flg.vect = currdir->vect;
433 BCOPY(flg.tpvalue, currdir->tpvalue, int, TPNVERSION);
434 BCOPY(flg.x, currdir->x, int, (INT)sizeof(flg.x) / sizeof(int));
435 #if DEBUG
436 if (DBGBIT(1, 2048))
437 dmp_dirset(currdir);
438 #endif
439
440 }
441
442 void
store_dirset(DIRSET * currdir)443 store_dirset(DIRSET *currdir)
444 {
445 currdir->depchk = flg.depchk;
446 currdir->opt = flg.opt;
447 currdir->vect = flg.vect;
448 BCOPY(currdir->tpvalue, flg.tpvalue, int, TPNVERSION);
449 BCOPY(currdir->x, flg.x, int, (INT)sizeof(flg.x) / sizeof(int));
450
451 }
452
453 /** \brief OPTIONS statement processed (by scan via semant)
454 *
455 * These only affect
456 * what happens in semant for the 'next' routine. alter any dirset
457 * values which can be altered by OPTIONS.
458 *
459 * \param restore true if called when restoring effects of OPTIONS
460 */
461 void
dirset_options(bool restore)462 dirset_options(bool restore)
463 {
464 if (restore)
465 direct.rou_begin.x[70] = direct.gbl.x[70];
466 else
467 direct.rou_begin.x[70] = flg.x[70];
468
469 }
470
471 #if DEBUG
472 static void
dmp_dirset(DIRSET * currdir)473 dmp_dirset(DIRSET *currdir)
474 {
475 #define _FNO(s) ((s) ? "" : "no")
476 #define _TNO(s) ((s) ? "no" : "")
477 fprintf(gbl.dbgfil,
478 " opt=%d,%sdepchk,%sassoc,%stransform,%srecog,%sswpipe,%sstream\n",
479 currdir->opt, _FNO(currdir->depchk), _TNO(currdir->vect & 0x4),
480 _TNO(currdir->x[19] & 0x8), _TNO(currdir->x[19] & 0x10),
481 _TNO(currdir->x[19] & 0x20), _TNO(currdir->x[19] & 0x40));
482 fprintf(gbl.dbgfil, " shortloop:%d", currdir->x[35]);
483 fprintf(gbl.dbgfil, " %seqvchk", _TNO(currdir->x[19] & 0x1));
484 fprintf(gbl.dbgfil,
485 " %slstval,%ssplit,%svintr,%spipei,%sdualopi,%sbounds,%ssse\n",
486 _TNO(currdir->x[19] & 0x2), _FNO(currdir->x[19] & 0x4),
487 _TNO(currdir->x[34] & 0x8), _FNO(currdir->x[4] & 0x1),
488 _FNO(currdir->x[4] & 0x2), _FNO(currdir->x[70] & 0x2),
489 _TNO(currdir->x[19] & 0x400));
490 fprintf(gbl.dbgfil, " altcode: vector=%d,swpipe=%d,unroll=%d\n",
491 currdir->x[16], currdir->x[17], currdir->x[18]);
492 fprintf(gbl.dbgfil, " %sfunc32, %sframe", _FNO(currdir->x[119] & 0x4),
493 _TNO(currdir->x[121] & 0x1));
494 fprintf(gbl.dbgfil, " info=%0x", currdir->x[0]);
495 fprintf(gbl.dbgfil, " stripsize:%d", currdir->x[38]);
496 if (currdir->x[34] & 0x100000)
497 fprintf(gbl.dbgfil, " nolastdim");
498 if (currdir->x[34] & 0x800)
499 fprintf(gbl.dbgfil, " safe_last_val");
500 fprintf(gbl.dbgfil, "\n");
501 fprintf(gbl.dbgfil, " %sconcur,%sinvarif,%sunroll=c,%sunroll=n,",
502 _TNO(currdir->x[34] & (0x20 | 0x10)), _TNO(currdir->x[19] & 0x80),
503 _TNO(currdir->x[11] & 0x1), _TNO(currdir->x[11] & 0x2));
504 fprintf(gbl.dbgfil, "unroll=c:%d,unroll=n:%d", currdir->x[9], currdir->x[10]);
505 #ifdef FE90
506 fprintf(gbl.dbgfil, ",%sindependent", _FNO(currdir->x[19] & 0x100));
507 #endif
508 fprintf(gbl.dbgfil, "\n");
509 }
510
511 static void
dmp_lpprg(int i)512 dmp_lpprg(int i)
513 {
514 LPPRG *p;
515 #ifdef FE90
516 NEWVAR *nv;
517 #endif
518
519 p = direct.lpg.stgb + i;
520 fprintf(gbl.dbgfil, "---dirset (%4d) for loop, lines %d, %d\n", i,
521 p->beg_line, p->end_line);
522 dmp_dirset(&p->dirset);
523 #ifdef FE90
524 if (p->indep) {
525 REDUCVAR *redp;
526 REDUC_JA *redjap;
527 REDUC_JA_SPEC *specp;
528
529 fprintf(gbl.dbgfil, " onhome ast %d\n", p->indep->onhome);
530
531 fprintf(gbl.dbgfil, " new variables:");
532 for (nv = p->indep->new_list; nv != NULL; nv = nv->next)
533 fprintf(gbl.dbgfil, " %d(%s)", nv->var, SYMNAME(nv->var));
534 fprintf(gbl.dbgfil, "\n");
535
536 fprintf(gbl.dbgfil, " reduction variables:");
537 for (redp = p->indep->reduction_list; redp; redp = redp->next)
538 fprintf(gbl.dbgfil, " %d(%s)", redp->var, SYMNAME(redp->var));
539 fprintf(gbl.dbgfil, "\n");
540
541 fprintf(gbl.dbgfil, " JAHPF reduction variables:");
542 for (redjap = p->indep->reduction_ja_list; redjap; redjap = redjap->next) {
543 for (specp = redjap->speclist; specp; specp = specp->next)
544 fprintf(gbl.dbgfil, " %d(%s)", specp->var, SYMNAME(specp->var));
545 }
546 fprintf(gbl.dbgfil, "\n");
547
548 fprintf(gbl.dbgfil, " index variables:");
549 for (nv = p->indep->index_list; nv != NULL; nv = nv->next)
550 fprintf(gbl.dbgfil, " %d(%s)", nv->var, SYMNAME(nv->var));
551 fprintf(gbl.dbgfil, "\n");
552 }
553 if (p->index_reuse_list) {
554 INDEX_REUSE *irp;
555
556 fprintf(gbl.dbgfil, " JAHPF INDEX_REUSE variables:");
557 for (irp = p->index_reuse_list; irp; irp = irp->next) {
558 for (nv = irp->reuse_list; nv; nv = nv->next)
559 fprintf(gbl.dbgfil, " %d(%s)", nv->var, SYMNAME(nv->var));
560 }
561 fprintf(gbl.dbgfil, "\n");
562 }
563 #endif
564 }
565 #endif
566
567 #ifdef FE90
568
569 void
direct_export(FILE * ff)570 direct_export(FILE *ff)
571 {
572 int i;
573 SVDIR *p;
574
575 fprintf(ff, "A:%d\n", svdir.avail);
576 fprintf(ff, "rou: --------------------\n");
577 wr_dir(ff, &svdir.stgb[0]);
578 for (i = 1; i < svdir.avail; i++) {
579 p = svdir.stgb + i;
580 fprintf(ff, "%d: --------------------\n", i);
581 fprintf(ff, "b:%d e:%d\n", p->beg_line, p->end_line);
582 wr_dir(ff, p);
583 }
584 }
585
586 static void
update_rou_begin(void)587 update_rou_begin(void)
588 {
589 SVDIR *df;
590 DIRSET *new, *old, *older;
591 int i;
592
593 df = &svdir.stgb[0];
594 new = &direct.rou_begin;
595 old = &direct.gbl;
596 older = &inigbl;
597
598 diff_dir(df, new, old);
599
600 if (old->opt != older->opt)
601 df->change.opt = 1;
602 if (old->vect ^ older->vect)
603 df->change.vect = 1;
604 if (old->depchk != older->depchk)
605 df->change.depchk = 1;
606 for (i = 0; i < sizeof(flg.x) / sizeof(int); i++) {
607 if (is_xflag_bit(i)) {
608 if (old->x[i] ^ older->x[i])
609 df->change.x[i] = 1;
610 } else {
611 if (old->x[i] != older->x[i])
612 df->change.x[i] = 1;
613 }
614 }
615 svdir.avail = direct.lpg.avail;
616 }
617
618 static void
diff_dir(SVDIR * df,DIRSET * new,DIRSET * old)619 diff_dir(SVDIR *df, DIRSET *new, DIRSET *old)
620 {
621 int i;
622
623 df->newset = *new;
624
625 df->change.opt = new->opt != old->opt;
626 df->change.vect = new->vect ^ old->vect;
627 df->change.depchk = new->depchk != old->depchk;
628 for (i = 0; i < sizeof(flg.x) / sizeof(int); i++) {
629 if (is_xflag_bit(i))
630 df->change.x[i] = new->x[i] ^ old->x[i];
631 else
632 df->change.x[i] = new->x[i] != old->x[i];
633 }
634 }
635
636 static void
wr_dir(FILE * ff,SVDIR * dd)637 wr_dir(FILE *ff, SVDIR *dd)
638 {
639 int i;
640
641 if (dd->change.opt)
642 fprintf(ff, "o:%x %x\n", dd->change.opt, dd->newset.opt);
643 if (dd->change.vect)
644 fprintf(ff, "v:%x %x\n", dd->change.vect, dd->newset.vect);
645 if (dd->change.depchk)
646 fprintf(ff, "d:%x %x\n", dd->change.depchk, dd->newset.depchk);
647 for (i = 0; i < sizeof(flg.x) / sizeof(int); i++)
648 if (dd->change.x[i])
649 fprintf(ff, "x%d:%x %x\n", i, dd->change.x[i], dd->newset.x[i]);
650 fprintf(ff, "z\n");
651 }
652 #endif
653
654 static FILE *dirfil;
655 static int ilmlinenum = 0;
656 #define MAXLINELEN 4096
657 static char line[MAXLINELEN];
658 static int read_line(void);
659 static int rd_dir(DIRSET *);
660
661 int
direct_import(FILE * ff)662 direct_import(FILE *ff)
663 {
664 int ret;
665 int i;
666 int idx;
667 LPPRG *lpprg;
668
669 ilmlinenum = 0;
670 dirfil = ff;
671
672 /* read size of the lpg table */
673 if (read_line())
674 goto err;
675 ret = sscanf(line, "A:%d", &direct.lpg.avail);
676 if (ret != 1)
677 goto err;
678 NEEDB(direct.lpg.avail, direct.lpg.stgb, LPPRG, direct.lpg.size,
679 direct.lpg.avail + 8);
680
681 /* read routine directives */
682 if (read_line())
683 goto err; /* rou: line */
684 if (line[0] != 'r')
685 goto err;
686 direct.rou_begin = direct.gbl;
687 if (rd_dir(&direct.rou_begin))
688 goto err;
689
690 /* read the loop directives */
691 for (i = 1; i < direct.lpg.avail; i++) {
692 lpprg = direct.lpg.stgb + i;
693
694 if (read_line())
695 goto err; /* idx: line */
696 ret = sscanf(line, "%d: ", &idx);
697 if (ret != 1)
698 goto err;
699 if (i != idx)
700 goto err;
701
702 if (read_line())
703 goto err; /* b:lineno e:lineno */
704 ret = sscanf(line, "b:%d e:%d", &lpprg->beg_line, &lpprg->end_line);
705 if (ret != 2)
706 goto err;
707
708 lpprg->dirset = direct.rou_begin;
709 if (rd_dir(&lpprg->dirset))
710 goto err;
711 #if DEBUG
712 if (DBGBIT(1, 512))
713 dmp_lpprg(i);
714 #endif
715 }
716
717 return ilmlinenum;
718 err:
719 printf("DIRECTIVES error\n");
720 return ilmlinenum;
721 }
722
723 static int
read_line(void)724 read_line(void)
725 {
726 char *ret;
727 ret = fgets(line, MAXLINELEN - 1, dirfil);
728 ++ilmlinenum;
729 if (ret == NULL)
730 return 1;
731 return 0;
732 } /* read_line */
733
734 static int
rd_dir(DIRSET * dd)735 rd_dir(DIRSET *dd)
736 {
737 int ret;
738 int v;
739 int change;
740 int idx;
741
742 #undef ST_VAL
743 #undef ST_BV
744 #undef UADDR
745 #define ST_VAL(m) \
746 if (change) \
747 dd->m = v
748 #define ST_BV(m) \
749 if (change) \
750 dd->m = (v & change) | (dd->m & ~change)
751 #define UADDR(x) (unsigned int *) & x
752
753 while (true) {
754 /* read input line */
755 if (read_line())
756 return 1;
757 switch (line[0]) {
758 case 'z':
759 return 0;
760 case 'o': /* read opt line */
761 ret = sscanf(line, "o:%x %x", UADDR(change), UADDR(v));
762 if (ret != 2)
763 return 1;
764 {
765 ST_VAL(opt);
766 }
767 break;
768 case 'v': /* read vect line */
769 ret = sscanf(line, "v:%x %x", UADDR(change), UADDR(v));
770 if (ret != 2)
771 return 1;
772 if (dd != &direct.rou_begin) {
773 ST_BV(vect);
774 } else {
775 ST_VAL(vect);
776 }
777 break;
778 case 'd': /* read depchk line */
779 ret = sscanf(line, "d:%x %x", UADDR(change), UADDR(v));
780 if (ret != 2)
781 return 1;
782 {
783 ST_VAL(depchk);
784 }
785 break;
786 case 'x':
787 /* read x flag. The line is of the form:
788 * x<n>:change new [idx:change new ]...
789 * <n> is in decimal; change & new are in hex.
790 */
791 ret = sscanf(line, "x%d:%x %x", &idx, UADDR(change), UADDR(v));
792 if (ret != 3)
793 return 1;
794 if (dd == &direct.rou_begin) {
795 ST_VAL(x[idx]);
796 } else if (is_xflag_bit(idx)) {
797 ST_BV(x[idx]);
798 } else {
799 ST_VAL(x[idx]);
800 }
801 break;
802 default:
803 return 1;
804 }
805 }
806 return 0;
807 }
808