← Back to branch summary

~ubuntu-branches/ubuntu/lucid/graphviz/lucid-security

« back to all changes in this revision

Viewing changes to tools/gpr/compile.c

  • Committer: Bazaar Package Importer
  • Author(s): Stephen M Moraco
  • Date: 2002-02-05 18:52:12 UTC
  • Revision ID: james.westby@ubuntu.com-20020205185212-8i04c70te00rc40y
Tags: upstream-1.7.16
Import upstream version 1.7.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/gpr/compile.c
 
1
#include <compile.h>
 
2
#include <assert.h>
 
3
#include <agraph.h>
 
4
#include <error.h>
 
5
#include <actions.h>
 
6
#include <sfstr.h>
 
7
 
 
8
#define ISEDGE(e) (AGTYPE(e)&2)
 
9
 
 
10
#include <gdefs.h>
 
11
 
 
12
#define BITS_PER_BYTE 8
 
13
 
 
14
static char*
 
15
symName (int op)
 
16
{
 
17
  if (op >= MINNAME && op <= MAXNAME)
 
18
    return gprnames[op - MINNAME];
 
19
  else return "<unknown>";
 
20
}
 
21
 
 
22
/* xargs:
 
23
 * Convert string argument to graph to type of graph desired.
 
24
 *   u => undirected
 
25
 *   d => directed
 
26
 *   s => strict
 
27
 *   n => non-strict
 
28
 * Case-insensitive
 
29
 * By default, the graph is directed, non-strict.
 
30
 */
 
31
static Agdesc_t
 
32
xargs (char* args)
 
33
{
 
34
  Agdesc_t desc = Agdirected;
 
35
  char     c;
 
36
  
 
37
  while (c = *args++) {
 
38
    switch (c) {
 
39
    case 'u' :
 
40
    case 'U' :
 
41
      desc.directed = 0;
 
42
      break;
 
43
    case 'd' :
 
44
    case 'D' :
 
45
      desc.directed = 1;
 
46
      break;
 
47
    case 's' :
 
48
    case 'S' :
 
49
      desc.strict = 1;
 
50
      break;
 
51
    case 'n' :
 
52
    case 'N' :
 
53
      desc.directed = 0;
 
54
      break;
 
55
    default :
 
56
      error (1, "unknown graph descriptor '%c' : ignored", c);
 
57
      break;
 
58
    }
 
59
  }
 
60
  return desc;
 
61
}
 
62
 
 
63
/* deparse:
 
64
 * Recreate string representation of expression involving
 
65
 * a reference and a symbol.
 
66
 * The parameter sf must be a string stream.
 
67
 */
 
68
static char*
 
69
deparse (Expr_t* ex, Exnode_t* n, Sfio_t* sf)
 
70
{
 
71
  exdump (ex, n, sf);
 
72
  return (sfstruse (sf));
 
73
}
 
74
 
 
75
/* deref:
 
76
 * Evaluate reference to derive desired graph object.
 
77
 * A reference is either DI* or II*
 
78
 * The parameter objp is the current object.
 
79
 * Assume ref is type-correct.
 
80
 */
 
81
static Agobj_t*
 
82
deref (Exnode_t* x, Exref_t* ref, Agobj_t* objp, Gpr_t* state)
 
83
{
 
84
  void* ptr;
 
85
 
 
86
  if (ref == 0)
 
87
    return objp;
 
88
  else if (ref->symbol->lex == DYNAMIC) {
 
89
    ptr = x->data.variable.dyna->data.variable.dyna->data.constant.value.user;
 
90
    return deref (x, ref->next, (Agobj_t*)ptr, state);
 
91
  }
 
92
  else switch (ref->symbol->index) {    /* sym->lex == ID */
 
93
    case V_outgraph :
 
94
      return deref (x, ref->next, (Agobj_t*)state->outgraph, state);
 
95
      break;
 
96
    case V_this :
 
97
      return deref (x, ref->next, state->curobj, state);
 
98
      break;
 
99
    case V_thisg :
 
100
      return deref (x, ref->next, (Agobj_t*)state->curgraph, state);
 
101
      break;
 
102
    case V_targt :
 
103
      return deref (x, ref->next, (Agobj_t*)state->target, state);
 
104
      break;
 
105
    case M_head :
 
106
      if (!objp && !(objp = state->curobj)) {
 
107
        error (1, "Current object $ not defined");
 
108
        return 0;
 
109
      }
 
110
      if (ISEDGE(objp))
 
111
        return deref (x, ref->next, (Agobj_t*)AGHEAD((Agedge_t*)objp), state);
 
112
      else error (3, "head of non-edge");
 
113
      break;
 
114
    case M_tail :
 
115
      if (!objp && !(objp = state->curobj)) {
 
116
        error (3, "Current object $ not defined");
 
117
        return 0;
 
118
      }
 
119
      if (ISEDGE(objp))
 
120
        return deref (x, ref->next, (Agobj_t*)AGTAIL((Agedge_t*)objp), state);
 
121
      else error (3, "tail of non-edge %x", objp);
 
122
      break;
 
123
    default :
 
124
      error (1, "%s : illegal reference", ref->symbol->name);
 
125
      return 0;
 
126
      break;
 
127
    }
 
128
  return 0;
 
129
 
 
130
}
 
131
 
 
132
/* lookup:
 
133
 * Apply symbol to get field value of objp
 
134
 */
 
135
static int
 
136
lookup (Agobj_t* objp, Exid_t* sym, Extype_t* v)
 
137
{
 
138
  if (sym->lex == ID) {
 
139
    switch (sym->index) {
 
140
    case M_head :
 
141
      if (ISEDGE(objp)) v->user = AGHEAD((Agedge_t*)objp);
 
142
      else {
 
143
        error (1, "head of non-edge");
 
144
        return -1;
 
145
      }
 
146
      break;
 
147
    case M_tail :
 
148
      if (ISEDGE(objp)) v->user = AGTAIL((Agedge_t*)objp);
 
149
      else {
 
150
        error (1, "tail of non-edge");
 
151
        return -1;
 
152
      }
 
153
      break;
 
154
    case  M_name :
 
155
      v->string = agnameof (objp);
 
156
      break;
 
157
    case  M_indegree :
 
158
      if (AGTYPE(objp) == AGNODE) v->integer = agdegree((Agnode_t*)objp,1,0);
 
159
      else {
 
160
        error (3, "indegree of non-node");
 
161
        return -1;
 
162
      }
 
163
      break;
 
164
    case  M_outdegree :
 
165
      if (AGTYPE(objp) == AGNODE) v->integer = agdegree((Agnode_t*)objp,0,1);
 
166
      else {
 
167
        error (3, "outdegree of non-node");
 
168
        return -1;
 
169
      }
 
170
      break;
 
171
    case  M_degree :
 
172
      if (AGTYPE(objp) == AGNODE) v->integer = agdegree((Agnode_t*)objp,1,1);
 
173
      else {
 
174
        error (3, "degree of non-node");
 
175
        return -1;
 
176
      }
 
177
      break;
 
178
    default :
 
179
      error (1, "%s : illegal reference", sym->name);
 
180
      return -1;
 
181
      break;
 
182
    }
 
183
  }
 
184
  else v->string = agget (objp, sym->name);
 
185
 
 
186
  return 0;
 
187
}
 
188
 
 
189
/* getval:
 
190
 * Return value associated with gpr identifier.
 
191
 */
 
192
Extype_t
 
193
getval(Expr_t* pgm, Exnode_t* node, Exid_t* sym, Exref_t* ref, 
 
194
       void* env, int elt, Exdisc_t* disc)
 
195
{
 
196
  Extype_t        v;
 
197
  Gpr_t*          state;
 
198
  Extype_t*       args;
 
199
  Agobj_t*        objp;
 
200
 
 
201
  assert (sym->lex != CONSTANT);
 
202
  if (elt == EX_CALL) {
 
203
    args = (Extype_t*)env;
 
204
    state = (Gpr_t*)(disc->user);
 
205
    switch (sym->index) {
 
206
    case F_graph :
 
207
      v.user = agopen (args[0].string, xargs(args[1].string), &AgDefaultDisc);
 
208
      if (v.user)
 
209
        agbindrec (v.user,UDATA,sizeof(gdata),0);
 
210
      break;
 
211
    case F_node :
 
212
      v.user = agnode ((Agraph_t*)args[0].user, args[1].string, 1);
 
213
      if (v.user)
 
214
        agbindrec (v.user,UDATA,sizeof(ndata),0);
 
215
      break;
 
216
    case F_edge :
 
217
      v.user = agedge ((Agnode_t*)args[0].user, (Agnode_t*)args[1].user, 
 
218
                       args[2].string, 1);
 
219
      if (v.user)
 
220
        agbindrec (v.user,UDATA,sizeof(edata),0);
 
221
      break;
 
222
    case F_clone :
 
223
      v.user = clone ((Agraph_t*)args[0].user, args[1].user);
 
224
      break;
 
225
    case F_induce :
 
226
      nodeInduce ((Agraph_t*)args[0].user);
 
227
      v.integer = 0;
 
228
      break;
 
229
    case F_write :
 
230
      v.integer = agwrite ((Agraph_t*)args[0].user, state->outFile);
 
231
    case F_isdirect :
 
232
      v.integer = agisdirected ((Agraph_t*)args[0].user);
 
233
      break;
 
234
    case F_isstrict :
 
235
      v.integer = agisstrict ((Agraph_t*)args[0].user);
 
236
      break;
 
237
    case F_delete :
 
238
      if (args[1].user == state->curgraph) {
 
239
        error (1, "cannot delete current graph $G");
 
240
        v.integer = 1;
 
241
      }
 
242
      else if (args[1].user == state->target) {
 
243
        error (1, "cannot delete current graph $T");
 
244
        v.integer = 1;
 
245
      }
 
246
      else
 
247
        v.integer = agdelete ((Agraph_t*)args[0].user, args[1].user);
 
248
      break;
 
249
    case F_nnodes :
 
250
      v.integer = agnnodes ((Agraph_t*)args[0].user);
 
251
      break;
 
252
    case F_nedges :
 
253
      v.integer = agnedges ((Agraph_t*)args[0].user);
 
254
      break;
 
255
    default :
 
256
      error (3, "unknown function call: %s", sym->name);
 
257
    }
 
258
    return v;
 
259
  }
 
260
 
 
261
  state = (Gpr_t*)env;
 
262
  if (ref) {
 
263
    objp = deref (node, ref, 0, state);
 
264
    if (!objp)
 
265
      error (3, "null reference in expression %s", 
 
266
        deparse (pgm, node, state->tmp));
 
267
  }
 
268
  else if ((sym->lex == ID) && (sym->index <= LAST_V)) {
 
269
    switch (sym->index) {
 
270
    case V_this :
 
271
      v.user = state->curobj;
 
272
      break;
 
273
    case V_thisg :
 
274
      v.user = state->curgraph;
 
275
      break;
 
276
    case V_targt :
 
277
      v.user = state->target;
 
278
      break;
 
279
    case V_outgraph :
 
280
      v.user = state->outgraph;
 
281
      break;
 
282
    case V_tgtname :
 
283
      v.string = state->tgtname;
 
284
      break;
 
285
    case V_travtype :
 
286
      v.integer = state->tvt;
 
287
      break;
 
288
    }
 
289
    return v;
 
290
  }
 
291
  else {
 
292
    objp = state->curobj;
 
293
    if (!objp) 
 
294
      error (3, "current object $ not defined as reference for %s",
 
295
        deparse(pgm, node, state->tmp));
 
296
  }
 
297
 
 
298
  if (lookup (objp, sym, &v))
 
299
    error (3, "in expression %s", deparse (pgm, node, state->tmp));
 
300
 
 
301
  return v;
 
302
}
 
303
 
 
304
/* setval:
 
305
 * Set sym to value v.
 
306
 * Return -1 if not allowed.
 
307
 * Assume already type correct.
 
308
 */
 
309
int
 
310
setval(Expr_t* pgm, Exnode_t* x, Exid_t* sym, Exref_t* ref,
 
311
       void* env, int elt, Extype_t v, Exdisc_t* disc)
 
312
{
 
313
  Gpr_t*          state;
 
314
  Agobj_t*        objp;
 
315
  Agsym_t*        gsym;
 
316
  int             iv;
 
317
  int             rv = 0;
 
318
 
 
319
  state = (Gpr_t*)env;
 
320
  if (ref) {
 
321
    objp = deref (x, ref, 0, state);
 
322
    if (!objp)
 
323
      error (3, "in expression %s", deparse (pgm, x, state->tmp));
 
324
  }
 
325
  else if ((MINNAME <= sym->index) && (sym->index <= MAXNAME)) {
 
326
    switch (sym->index) {
 
327
    case V_outgraph :
 
328
      state->outgraph = v.user;
 
329
      break;
 
330
    case V_travtype :
 
331
      iv = v.integer;
 
332
      if (validTVT(v.integer)) 
 
333
        state->tvt = iv;
 
334
      else
 
335
        error(1,"unexpected value %d assigned to %s : ignored", 
 
336
          iv, symName(V_travtype));
 
337
      break;
 
338
    case V_tgtname :
 
339
      if (!streq(state->tgtname,v.string)) {
 
340
        vmfree (pgm->vm, state->tgtname);
 
341
        state->tgtname = vmstrdup (pgm->vm, v.string);
 
342
        state->name_used = 0;
 
343
      }
 
344
      break;
 
345
    default :
 
346
      rv = -1;
 
347
      break;
 
348
    }
 
349
    return rv;
 
350
  }
 
351
  else {
 
352
    objp = state->curobj;
 
353
    if (!objp) 
 
354
      error (3, "current object $ undefined in expression %s",
 
355
        deparse(pgm, x, state->tmp));
 
356
  }
 
357
 
 
358
  gsym = agattrsym (objp, sym->name);
 
359
  if (!gsym) {
 
360
    gsym = agattr(agroot(agraphof(objp)),AGTYPE(objp),sym->name,"");
 
361
  }
 
362
  return agxset (objp, gsym, v.string);
 
363
}
 
364
 
 
365
static int codePhase;
 
366
 
 
367
#define haveGraph    ((1 <= codePhase) && (codePhase <= 4))
 
368
#define haveTarget   ((2 <= codePhase) && (codePhase <= 4))
 
369
#define inWalk       ((2 <= codePhase) && (codePhase <= 3))
 
370
 
 
371
/* typeChk:
 
372
 * Type check input type against implied type of symbol sym.
 
373
 * If okay, return result type; else return 0.
 
374
 * For functions, input type set must intersect with function domain.
 
375
 * This means type errors may occur, but these will be caught at runtime.
 
376
 * For non-functions, input type must be 0.
 
377
 */
 
378
static tctype
 
379
typeChk (tctype intype, Exid_t* sym)
 
380
{
 
381
  tctype dom, rng;
 
382
 
 
383
  switch (sym->lex) {
 
384
  case DYNAMIC :
 
385
    dom = 0;
 
386
    switch (sym->type) {
 
387
    case T_obj :
 
388
      rng = YALL;;
 
389
      break;
 
390
    case T_node :
 
391
      rng = Y(V);
 
392
      break;
 
393
    case T_graph :
 
394
      rng = Y(G);
 
395
      break;
 
396
    case T_edge :
 
397
      rng = Y(E);
 
398
      break;
 
399
    case INTEGER :
 
400
      rng = Y(I);
 
401
      break;
 
402
    case FLOATING :
 
403
      rng = Y(F);
 
404
      break;
 
405
    case STRING :
 
406
      rng = Y(S);
 
407
      break;
 
408
    default :
 
409
      exerror ( "\n -- unknown dynamic type %d of symbol %s", sym->lex, sym->name);
 
410
      break;
 
411
    }
 
412
    break;
 
413
  case ID :
 
414
    if (sym->index <= MAXNAME) {
 
415
      if ((sym->index == V_this) && !inWalk)
 
416
        exerror ("\n -- keyword %s can only be used in N and E statements",
 
417
          sym->name);
 
418
      else if ((sym->index == V_thisg) && !haveGraph)
 
419
        exerror ("\n -- keyword %s cannot be used in BEGIN/END statements",
 
420
          sym->name);
 
421
      else if ((sym->index == V_targt) && !haveTarget)
 
422
        exerror ("\n -- keyword %s cannot be used in BEGIN/BEG_G/END statements",
 
423
          sym->name);
 
424
      dom = tchk[sym->index][0];
 
425
      rng = tchk[sym->index][1];
 
426
    }
 
427
    else {
 
428
      dom = YALL;
 
429
      rng = Y(S);
 
430
    }
 
431
    break;
 
432
  case NAME :
 
433
    if (!intype && !inWalk)
 
434
      exerror ("\n -- undeclared, unmodified names like \"%s\" can only be\nused in N and E statements",
 
435
        sym->name);
 
436
    dom = YALL;
 
437
    rng = Y(S);
 
438
    break;
 
439
  default :
 
440
    exerror ("\n -- unexpected symbol in typeChk: name %s, lex %d",
 
441
      sym->name, sym->lex);
 
442
    break;
 
443
  }
 
444
 
 
445
  if (dom) {
 
446
    if (!intype) intype = Y(E)|Y(V);   /* type of $ */
 
447
    if (!(dom & intype)) rng = 0;
 
448
  }
 
449
  else if (intype) rng = 0;
 
450
  return rng;
 
451
}
 
452
 
 
453
/* typeChkExp:
 
454
 * Type check variable expression.
 
455
 */
 
456
static tctype
 
457
typeChkExp (Exref_t* ref, Exid_t* sym)
 
458
{
 
459
  tctype ty;
 
460
 
 
461
  if (ref) {
 
462
    ty = typeChk (0, ref->symbol);
 
463
    for (ref = ref->next; ty && ref; ref = ref->next)
 
464
      ty = typeChk (ty, ref->symbol);
 
465
    if (!ty) return 0;
 
466
  }
 
467
  else ty = 0;
 
468
  return typeChk (ty, sym);
 
469
}
 
470
 
 
471
/* refval:
 
472
 * Called during compilation for uses of references:   abc.x
 
473
 * Also for abc.f(..),  type abc.v, "abc".x and CONSTANTS.
 
474
 * The grammar has been  altered to disallow the first 3.
 
475
 * Type check expressions; return value unused.
 
476
 */
 
477
Extype_t
 
478
refval(Expr_t* pgm, Exnode_t* node, Exid_t* sym, Exref_t* ref, 
 
479
       char* str, int elt, Exdisc_t* disc)
 
480
{
 
481
    Extype_t        v;
 
482
 
 
483
    if (sym->lex == CONSTANT) {
 
484
      switch (sym->index) {
 
485
      case C_dfs :
 
486
        v.integer = TV_dfs;
 
487
        break;
 
488
      case C_flat :
 
489
        v.integer = TV_flat;
 
490
        break;
 
491
      default :
 
492
        v = exzero(node->type);
 
493
        break;
 
494
      }
 
495
    }
 
496
    else {
 
497
      if (!typeChkExp (ref, sym))
 
498
        exerror ("\n -- type error in %s", deparse (pgm, node, sfstropen()));
 
499
      v = exzero(node->type);
 
500
    }
 
501
    return v;
 
502
}
 
503
 
 
504
#include <../expr/exop.h>
 
505
 
 
506
static char*
 
507
typeName (int op)
 
508
{
 
509
  if (op > MINTOKEN && op < MAXTOKEN)
 
510
    return (char*)exop[op - MINTOKEN];
 
511
  else
 
512
    return symName(op);
 
513
}
 
514
 
 
515
static void
 
516
cvtError (Exid_t* xref, char* msg)
 
517
{
 
518
  if (xref)
 
519
    error(1, "%s: %s", xref->name, msg);
 
520
  else
 
521
    error(1, "%s", msg);
 
522
}
 
523
 
 
524
/*
 
525
 * convert:
 
526
 * Convert value x of type x->type to type type.
 
527
 * Return -1 if conversion cannot be done, 0 otherwise.
 
528
 * If arg is > 0, conversion unnecessary; just report possibility.
 
529
 * In particular, assume x != 0 if arg == 0.
 
530
 */
 
531
int
 
532
convert(Expr_t* prog, register Exnode_t* x, int type, register Exid_t* xref, int arg, Exdisc_t* disc)
 
533
 
 
534
{
 
535
    Agobj_t*  objp;
 
536
    int       ret = -1;
 
537
 
 
538
      /* If both types are built-in, let libexpr handle */
 
539
    if ((type >= MINTOKEN) && (x->type >= MINTOKEN)) return -1;
 
540
    if (type == T_obj) {
 
541
      if (x->type < MINTOKEN) ret = 0;
 
542
    }
 
543
    else if (type == INTEGER) {
 
544
      if (x->type != T_tvtyp)
 
545
        x->data.constant.value.integer = (Sflong_t)x->data.constant.value.user;
 
546
      ret = 0;
 
547
    }
 
548
    else if (x->type == T_obj) {
 
549
        /* check dynamic type */
 
550
      objp = (Agobj_t*)x->data.constant.value.user;
 
551
      if (arg) ret = 0;
 
552
      else {
 
553
        if (!objp)
 
554
          cvtError (xref, "Uninitialized object");
 
555
        else switch (type) {
 
556
        case T_graph :
 
557
          if (AGTYPE(objp) == AGRAPH) ret = 0;
 
558
          break;
 
559
        case T_node :
 
560
          if (AGTYPE(objp) == AGNODE) ret = 0;
 
561
          break;
 
562
        case T_edge :
 
563
          if (ISEDGE(objp)) ret = 0;
 
564
          break;
 
565
        }
 
566
      }
 
567
    }
 
568
    else if (type == STRING) {
 
569
      if (arg) ret = 0;
 
570
      else {
 
571
        objp = (Agobj_t*)x->data.constant.value.user;
 
572
        if (objp) {
 
573
          x->data.constant.value.string = agnameof (objp);
 
574
          ret = 0;
 
575
        }
 
576
        else cvtError (xref, "Uninitialized object");
 
577
      }
 
578
    }
 
579
#ifdef UNIMPLEMENTED
 
580
    else if (x->type == STRING) {
 
581
        /* lookup? */
 
582
    }
 
583
#endif
 
584
    if (ret == 0)
 
585
      x->type = type;
 
586
    return ret;
 
587
}
 
588
 
 
589
/* matchval:
 
590
 * Pattern match strings.
 
591
 */
 
592
static int
 
593
matchval(Expr_t* pgm, Exnode_t* xstr, const char* str, Exnode_t* xpat,
 
594
         const char* pat, void* env, Exdisc_t* disc)
 
595
{
 
596
    return strgrpmatch(str, pat, NiL, 0, STR_MAXIMAL|STR_LEFT|STR_RIGHT);
 
597
}
 
598
 
 
599
/* a2t:
 
600
 * Convert type indices to symbolic name.
 
601
 */
 
602
static int 
 
603
a2t[] = { 0, FLOATING, INTEGER, STRING,
 
604
          T_node, T_edge, T_graph, T_obj };
 
605
 
 
606
/* initDisc:
 
607
 * Create and initialize expr discipline.
 
608
 */
 
609
static Exdisc_t*
 
610
initDisc (Gpr_t* state)
 
611
{
 
612
  Exdisc_t* dp;
 
613
 
 
614
  dp = newof (0, Exdisc_t, 1, 0);
 
615
  if (!dp)
 
616
    error (3, "could not create libexp discipline: out of memory");
 
617
 
 
618
  dp->version = EX_VERSION;
 
619
  dp->flags = EX_CHARSTRING|EX_FATAL|EX_UNDECLARED;
 
620
  dp->symbols = symbols;
 
621
  dp->convertf = convert;
 
622
  dp->errorf = (Exerror_f)errorf;
 
623
  dp->getf = getval;
 
624
  dp->reff = refval;
 
625
  dp->setf = setval;
 
626
  dp->matchf = matchval;
 
627
  dp->types = a2t;
 
628
  dp->user = state;
 
629
 
 
630
  return dp;
 
631
}
 
632
 
 
633
/* compile:
 
634
 * Compile given string, then extract and return
 
635
 * typed expression.
 
636
 */
 
637
static Exnode_t*
 
638
compile (Expr_t* prog, char* src, char* input, int line, char* lbl, 
 
639
         char* sfx, int kind)
 
640
{
 
641
  Exnode_t*  e;
 
642
  Sfio_t*    sf;
 
643
  Sfio_t*    prefix;
 
644
 
 
645
    /* create input stream */ 
 
646
  if (sfx) {
 
647
    sf = sfopen (0, sfx, "rs");
 
648
    if (input) {
 
649
      prefix = sfopen (0, input, "rs");
 
650
      sfstack (sf, prefix);
 
651
    }
 
652
  }
 
653
  else sf = sfopen (0, input, "rs");
 
654
 
 
655
    /*  prefixing label if necessary */
 
656
  if (lbl) {
 
657
    prefix = sfopen (0, 0, "sr+");
 
658
    sfprintf (prefix, "%s:\n", lbl);
 
659
    sfseek (prefix, 0,0);
 
660
    sfstack (sf, prefix);
 
661
    line--;
 
662
  }
 
663
 
 
664
    /* prog is set to exit on errors */
 
665
  excomp (prog, src, line, 0, sf);
 
666
  sfclose (sf);
 
667
 
 
668
  e = exexpr(prog, lbl, NiL, kind);
 
669
 
 
670
  return e;
 
671
}
 
672
 
 
673
/* mkStmts:
 
674
 */
 
675
static case_stmt*
 
676
mkStmts (Expr_t* prog, char* src, case_info* sp, int cnt, char* lbl)
 
677
{
 
678
  case_stmt*    cs;
 
679
  int           i;
 
680
  Sfio_t*       tmps = sfstropen();
 
681
 
 
682
  cs = newof (0, case_stmt, cnt, 0);
 
683
 
 
684
  for (i = 0; i < cnt ; i++) {
 
685
    if (sp->guard) {
 
686
      sfprintf (tmps, "%s_g%d", lbl, i);
 
687
      cs[i].guard = compile (prog, src, sp->guard, sp->gstart, 
 
688
                             sfstruse(tmps), 0, INTEGER);
 
689
    }
 
690
    if (sp->action) {
 
691
      sfprintf (tmps, "%s_a%d", lbl, i);
 
692
      cs[i].action = compile (prog, src, sp->action, sp->astart, 
 
693
                              sfstruse(tmps), 0, INTEGER);
 
694
    }
 
695
    sp = sp->next;
 
696
  }
 
697
 
 
698
  sfclose (tmps);
 
699
  return cs;
 
700
}
 
701
 
 
702
/* doFlags:
 
703
 * Convert command line flags to actions in END_G.
 
704
 */
 
705
static char*
 
706
doFlags (int flags, Sfio_t* s)
 
707
{
 
708
  sfprintf (s, "\n");
 
709
  if (flags & SRCOUT) sfprintf (s, "$O = $G;\n");
 
710
  if (flags & INDUCE) sfprintf (s, "induce($O);\n");
 
711
  return sfstruse (s);
 
712
}
 
713
 
 
714
/* compileProg:
 
715
 * Convert gpr sections in libexpr program.
 
716
 */
 
717
comp_prog* 
 
718
compileProg (parse_prog* inp, Gpr_t* state, int flags)
 
719
{
 
720
  comp_prog*    p;
 
721
  Exdisc_t*     dp;
 
722
  Sfio_t*       tmps = sfstropen();
 
723
  char*         endg_sfx = 0;
 
724
 
 
725
    /* Make sure we have enough bits for types */
 
726
  assert (BITS_PER_BYTE*sizeof(tctype) >= (1<<TBITS));
 
727
 
 
728
  p = newof (0, comp_prog, 1, 0);
 
729
  if (!p)
 
730
    error (3, "could not create compiled program: out of memory");
 
731
 
 
732
  if (flags) {
 
733
    endg_sfx = doFlags (flags, tmps);
 
734
    if (*endg_sfx == '\0') endg_sfx = 0;
 
735
  }
 
736
 
 
737
  dp = initDisc (state);
 
738
  p->prog = exopen (dp);
 
739
 
 
740
  codePhase = 0;
 
741
  if (inp->begin_stmt)
 
742
    p->begin_stmt = compile (p->prog, inp->source, inp->begin_stmt, 
 
743
                             inp->l_begin, 0, 0, VOID);
 
744
  codePhase = 1;
 
745
  if (inp->begg_stmt)
 
746
    p->begg_stmt = compile (p->prog, inp->source, inp->begg_stmt, 
 
747
                             inp->l_beging, "_begin_g", 0, VOID);
 
748
 
 
749
  codePhase = 2;
 
750
  if (inp->node_stmts) {
 
751
    tchk[V_this][1] = Y(V);
 
752
    p->n_nstmts = inp->n_nstmts;
 
753
    p->node_stmts = mkStmts (p->prog, inp->source, inp->node_stmts, 
 
754
                             inp->n_nstmts, "_nd");
 
755
  }
 
756
 
 
757
  codePhase = 3;
 
758
  if (inp->edge_stmts) {
 
759
    tchk[V_this][1] = Y(E);
 
760
    p->n_estmts = inp->n_estmts;
 
761
    p->edge_stmts = mkStmts (p->prog, inp->source, inp->edge_stmts, 
 
762
                             inp->n_estmts, "_eg");
 
763
  }
 
764
 
 
765
  codePhase = 4;
 
766
  if (inp->endg_stmt || endg_sfx)
 
767
    p->endg_stmt = compile (p->prog, inp->source, inp->endg_stmt, 
 
768
                             inp->l_endg, "_end_g", endg_sfx, VOID);
 
769
 
 
770
  codePhase = 5;
 
771
  if (inp->end_stmt)
 
772
    p->end_stmt = compile (p->prog, inp->source, inp->end_stmt, 
 
773
                             inp->l_end, "_end_", 0, VOID);
 
774
  sfclose (tmps);
 
775
  return p;
 
776
}
 
777
 
 
778
/* walksGraph;
 
779
 * Returns true if program actually has node or edge statements.
 
780
 */
 
781
int 
 
782
walksGraph (comp_prog* p)
 
783
{
 
784
  return (p->n_nstmts || p->n_estmts);
 
785
}
 
786
 
 
787
/* usesGraph;
 
788
 * Returns true if program uses the graph, i.e., has
 
789
 * N/E/BEG_G/END_G statments
 
790
 */
 
791
int 
 
792
usesGraph (comp_prog* p)
 
793
{
 
794
  return (walksGraph(p) || p->begg_stmt || p->endg_stmt);
 
795
}
 
796
 
 
797
void
 
798
ptchk ()
 
799
{
 
800
  int i;
 
801
  for (i = 0; i <= LAST_M; i++)
 
802
    printf ("%d: %d %d\n", i, tchk[i][0], tchk[i][1]);
 
803
}