![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pepy_undo.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / isode-beta / pepy|
Return to pepy_undo.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / isode-beta / pepy |
1.1 root 1: /* pepy_undo.c - PE parser (yacc-based) building routines */
2:
3: #ifndef lint
4: static char *rcsid = "$Header: /f/osi/pepy/RCS/pepy_undo.c,v 7.0 89/11/23 22:11:55 mrose Rel $";
5: #endif
6:
7: /*
8: * $Header: /f/osi/pepy/RCS/pepy_undo.c,v 7.0 89/11/23 22:11:55 mrose Rel $
9: *
10: *
11: * $Log: pepy_undo.c,v $
12: * Revision 7.0 89/11/23 22:11:55 mrose
13: * Release 6.0
14: *
15: */
16:
17: /*
18: * NOTICE
19: *
20: * Acquisition, use, and distribution of this module and related
21: * materials are subject to the restrictions of a license agreement.
22: * Consult the Preface in the User's Manual for the full terms of
23: * this agreement.
24: *
25: */
26:
27: #include <stdio.h>
28: #include <ctype.h>
29: #include "pepy.h"
30:
31: extern struct tuple tuples[];
32: extern int rflag, hflag;
33:
34: char *gensym (), *modsym ();
35:
36: YP lookup_type (), lookup_binding ();
37: YT lookup_tag ();
38: char *add_point ();
39:
40: /* */
41:
42: undo_type (yp, level, id, arg, Vflag)
43: register YP yp;
44: register int level;
45: register char *id,
46: *arg;
47: int Vflag;
48: {
49: register int i,
50: j;
51: register char *narg;
52: register struct tuple *t;
53: register YP y;
54: register YV yv;
55:
56: if (yp -> yp_flags & YP_COMPONENTS) {
57: yyerror_aux ("oops, I shouldn't be here!");
58: print_type (yp, 0);
59: return;
60: }
61:
62: if (level == 1) {
63: printf ("(pe, explicit, len, buffer, parm)\n");
64: printf ("%sPE\tpe;\nint\texplicit;\n",
65: yp -> yp_code != YP_ANY
66: && yp -> yp_code != YP_NULL
67: && (yp -> yp_code != YP_CHOICE
68: || (yp -> yp_flags & YP_CONTROLLED))
69: ? "register " : "");
70: printf ("integer *len;\nchar **buffer;\n%s parm;\n{\n",
71: yp -> yp_param_type ? yp -> yp_param_type : "PEPYPARM");
72:
73: if (yp -> yp_action0) {
74: if (!Pflag && *sysin)
75: printf ("# line %d \"%s\"\n", yp -> yp_act0_lineno, sysin);
76: printf ("%*s%s\n", level * 4, "", yp -> yp_action0);
77: }
78: }
79:
80: switch (yp -> yp_code) {
81: case YP_BOOL:
82: case YP_INT:
83: if (!Vflag && (dflag || !((level == 1) || yp -> yp_action2
84: || yp -> yp_intexp)))
85: break; /* else fall */
86: case YP_INTLIST:
87: case YP_ENUMLIST:
88: printf ("%*sregister integer %s;\n\n", level * 4, "",
89: narg = gensym ());
90: break;
91:
92: case YP_BIT:
93: if (!Vflag && (dflag || !((level == 1) || yp -> yp_action2
94: || yp -> yp_strexp)))
95: break; /* else fall */
96: case YP_BITLIST:
97: printf ("%*sregister PE %s;\n\n", level * 4, "",
98: narg = gensym ());
99: break;
100:
101: case YP_OCT:
102: if (!dflag && ((level == 1) || yp -> yp_action2
103: || yp -> yp_strexp)) {
104: narg = gensym ();
105: if (!Vflag && yp -> yp_prfexp == 'q')
106: printf ("%*sregister struct qbuf *%s;\n\n",
107: level * 4, "", narg);
108: else
109: printf ("%*sregister char *%s;\n%*sint %s_len;\n\n",
110: level * 4, "", narg, level * 4, "", narg);
111: }
112: break;
113:
114: case YP_REAL:
115: if (!dflag && ((level == 1) || yp -> yp_action2
116: || yp -> yp_strexp)) {
117: narg = gensym ();
118: printf ("%*sregister double %s;\n\n", level * 4, "", narg);
119: }
120: break;
121:
122: case YP_NULL:
123: case YP_CHOICE:
124: case YP_ANY:
125: case YP_IDEFINED:
126: narg = NULL;
127: break;
128:
129: case YP_OID:
130: if (!Vflag && (dflag || (!yp -> yp_action2 && !yp -> yp_strexp
131: && level != 1)))
132: break; /* else fall */
133: printf ("%*sregister OID %s;\n\n", level * 4, "",
134: narg = gensym ());
135: break;
136:
137: case YP_SEQ:
138: case YP_SEQTYPE:
139: case YP_SEQLIST:
140: case YP_SET:
141: case YP_SETTYPE:
142: case YP_SETLIST:
143: narg = gensym ();
144: if (yp -> yp_code == YP_SETLIST)
145: printf ("%*sint %s_count = 0;\n", level * 4, "", narg);
146: printf ("%*sregister PE %s;\n\n", level * 4, "", narg);
147: break;
148:
149: default:
150: myyerror ("unknown type: %d", yp -> yp_code);
151: }
152:
153: if (!Vflag) {
154: printf ("#ifdef DEBUG\n%*s(void) testdebug (%s, \"",
155: level * 4, "", arg);
156: if (level == 1)
157: printf ("%s.", mymodule);
158: printf ("%s\");\n#endif\n\n", id);
159: }
160:
161: if (level == 1 && (yp -> yp_flags & YP_TAG)) {
162: printf ("%*sif (explicit\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
163: level * 4, "", (level + 2) * 4, "", arg, arg);
164: printf ("%*s!= PE_ID (PE_CLASS_%s, %d)) {\n",
165: (level + 4) * 4, "", pe_classlist[yp -> yp_tag -> yt_class],
166: val2int (yp -> yp_tag -> yt_value));
167: printf ("%*sadvise (NULLCP, \"%s %%s%%s/0x%%x\", PEPY_ERR_BAD_CLASS,\n",
168: (level + 1) * 4, "", id);
169: printf ("%*spe_classlist[%s -> pe_class], %s -> pe_id);\n",
170: (level + 3) * 4, "", arg, arg);
171: printf ("%*sreturn NOTOK;\n%*s}\n",
172: (level + 1) * 4, "", (level * 4), "");
173: }
174: else
175: if (!(yp -> yp_flags & YP_IMPLICIT)) {
176: for (t = tuples; t -> t_type != YP_UNDF; t++)
177: if (t -> t_type == yp -> yp_code) {
178: check_type (id, level, t -> t_class, t -> t_form,
179: t -> t_id, arg);
180: break;
181: }
182: }
183:
184: if (level == 1 && yp -> yp_code != YP_CHOICE &&
185: (yp -> yp_flags & YP_TAG) == YP_TAG) {
186: if ((yp -> yp_flags & YP_IMPLICIT) == 0 ||
187: is_nonimplicit_type (yp))
188: tag_pullup (yp, level, arg, "element");
189: }
190:
191: if (Vflag) {
192: if (yp -> yp_flags & YP_ID)
193: printf ("%*svname (\"%s\");\n", level * 4, "", yp -> yp_id);
194: else {
195: if (hflag && yp -> yp_code == YP_IDEFINED)
196: printf ("%*svname (\"%s\");\n", level * 4, "",
197: yp -> yp_identifier);
198: else
199: if ((yp -> yp_flags & YP_TAG)
200: && (yp -> yp_flags & (YP_OPTIONAL | YP_DEFAULT)))
201: printf ("%*svtag (%d, %d);\n", level * 4, "",
202: yp -> yp_tag -> yt_class,
203: val2int (yp -> yp_tag -> yt_value));
204: }
205: }
206: if (!dflag && yp -> yp_action05)
207: do_action (yp -> yp_action05, level, arg, yp -> yp_act05_lineno);
208: if (!dflag && yp -> yp_action1)
209: do_action (yp -> yp_action1, level, arg, yp -> yp_act1_lineno);
210:
211: switch (yp -> yp_code) {
212: case YP_BOOL:
213: if (Vflag || (!dflag && ((level == 1) || yp -> yp_action2
214: || yp -> yp_intexp)))
215: printf ("%*sif ((%s = prim2flag (%s)) == NOTOK) {\n",
216: level * 4, "", narg, arg);
217: else
218: printf ("%*sif (prim2flag (%s) == NOTOK) {\n",
219: level * 4, "", arg);
220: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BOOLEAN,\n",
221: (level + 1) * 4, "", id);
222: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
223: arg);
224: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
225: level * 4, "");
226: if (!dflag && yp -> yp_intexp)
227: printf ("%*s%s = %s;\n", level * 4, "", yp -> yp_intexp, narg);
228: if (!dflag && (level == 1))
229: printf ("%*sif (len)\n%*s*len = %s;\n", level * 4, "",
230: (level + 1) * 4, "", narg);
231: if (Vflag)
232: printf ("%*svprint (%s ? \"TRUE\" : \"FALSE\");\n",
233: level * 4, "", narg);
234: break;
235:
236: case YP_INT:
237: if (Vflag || (!dflag && ((level == 1) || yp -> yp_action2
238: || yp -> yp_intexp)))
239: printf ("%*sif ((%s = prim2num (%s)) == NOTOK\n",
240: level * 4, "", narg, arg);
241: else
242: printf ("%*sif (prim2num (%s) == NOTOK\n",
243: level * 4, "", arg);
244: printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
245: (level + 2) * 4, "", arg);
246: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_INTEGER,\n",
247: (level + 1) * 4, "", id);
248: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
249: arg);
250: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
251: level * 4, "");
252: if (!dflag && yp -> yp_intexp)
253: printf ("%*s%s = %s;\n", level * 4, "", yp -> yp_intexp, narg);
254: if (!dflag && (level == 1))
255: printf ("%*sif (len)\n%*s*len = %s;\n", level * 4, "",
256: (level + 1) * 4, "", narg);
257: if (Vflag)
258: printf ("%*svprint (\"%%d\", %s);\n", level * 4, "", narg);
259: break;
260:
261: case YP_REAL:
262: if (Vflag || (!dflag && ((level == 1) || yp -> yp_action2
263: || yp -> yp_strexp)))
264: printf ("%*sif ((%s = prim2real (%s)) == NOTOK\n",
265: level * 4, "", narg, arg);
266: else
267: printf ("%*sif (prim2real (%s) == NOTOK\n",
268: level * 4, "", arg);
269: printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
270: (level + 2) * 4, "", arg);
271: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_REAL,\n",
272: (level + 1) * 4, "", id);
273: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
274: arg);
275: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
276: level * 4, "");
277: if (!dflag && yp -> yp_strexp)
278: printf ("%*s%s = %s;\n", level * 4, "",
279: yp -> yp_strexp, narg);
280: if (Vflag)
281: printf ("%*svprint (\"%%g\", %s);\n", level * 4, "", narg);
282: break;
283:
284: case YP_INTLIST:
285: case YP_ENUMLIST:
286: printf ("%*sif ((%s = prim2%snum (%s)) == NOTOK\n",
287: level * 4, "", narg,
288: yp->yp_code == YP_ENUMLIST ? "e" : "",
289: arg);
290: printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
291: (level + 2) * 4, "", arg);
292: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_INTEGER,\n",
293: (level + 1) * 4, "", id);
294: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
295: arg);
296: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
297: level * 4, "");
298: if (!dflag && yp -> yp_intexp)
299: printf ("%*s%s = %s;\n", level * 4, "", yp -> yp_intexp, narg);
300: if (!dflag && (level == 1))
301: printf ("%*sif (len)\n%*s*len = %s;\n", level * 4, "",
302: (level + 1) * 4, "", narg);
303: uniqint (yp -> yp_value);
304: printf ("%*sswitch (%s) {\n", level * 4, "", narg);
305: for (yv = yp -> yp_value; yv; yv = yv -> yv_next) {
306: printf ("%*scase %d:", (level + 1) * 4, "", val2int (yv));
307: if (yv -> yv_flags & YV_NAMED)
308: printf ("\t/* %s */", yv -> yv_named);
309: printf ("\n");
310: if (Vflag) {
311: if (yv -> yv_flags & YV_NAMED)
312: printf ("%*svprint (\"%s\");\n", (level + 2) * 4, "",
313: yv -> yv_named);
314: else
315: printf ("%*svprint (\"%%d\", %s);\n", (level + 2) * 4,
316: "", narg);
317: }
318: if (!dflag && yv -> yv_action)
319: do_action (yv -> yv_action, level + 2, narg,
320: yv -> yv_act_lineno);
321: printf ("%*sbreak;\n", (level + 2) * 4, "");
322: }
323: if (!rflag && yp -> yp_code == YP_ENUMLIST) {
324: printf ("%*sdefault:\n", (level + 1) * 4, "");
325: printf ("%*sadvise (NULLCP, \"%s %%s%%d\", PEPY_ERR_UNK_COMP, %s);\n",
326: (level + 2) * 4, "", id, narg);
327: printf ("%*sreturn NOTOK;\n", (level + 2) * 4, "");
328: }
329: else
330: if (Vflag) {
331: printf ("%*sdefault:\n", (level + 1) * 4, "");
332: printf ("%*svprint (\"%%d\", %s);\n", (level + 2) * 4, "",
333: narg);
334: printf ("%*sbreak;\n", (level + 2) * 4, "");
335: }
336: printf ("%*s}\n", level * 4, "");
337: break;
338:
339: case YP_BIT:
340: if (Vflag || (!dflag && ((level == 1) || yp -> yp_action2
341: || yp -> yp_strexp)))
342: printf ("%*sif ((%s = prim2bit (%s)) == NULLPE) {\n",
343: level * 4, "", narg, arg);
344: else
345: printf ("%*sif (prim2bit (%s) == NULLPE) {\n",
346: level * 4, "", arg);
347: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BITS,\n",
348: (level + 1) * 4, "", id);
349: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
350: arg);
351: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
352: level * 4, "");
353: if (!dflag && yp -> yp_strexp)
354: printf ("%*s%s = bitstr2strb (%s, &(%s));\n",
355: level * 4, "", yp -> yp_strexp, arg, yp -> yp_intexp);
356: if (!dflag && (level == 1)) {
357: printf ("%*sif (buffer && len)\n", level * 4, "");
358: if (yp -> yp_strexp)
359: printf ("%*s*buffer = %s, *len = %s;\n",
360: (level + 1) * 4, "", yp -> yp_strexp, yp -> yp_intexp);
361: else
362: printf ("%*s*buffer = bitstr2strb (%s, len);\n",
363: (level + 1) * 4, "", arg);
364: }
365: if (Vflag)
366: printf ("%*svprint (\"%%s\", bit2str (%s, \"\\020\"));\n",
367: level * 4, "", narg);
368: break;
369:
370: case YP_BITLIST:
371: printf ("%*sif ((%s = prim2bit (%s)) == NULLPE) {\n",
372: level * 4, "", narg, arg);
373: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BITS,\n",
374: (level + 1) * 4, "", id);
375: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
376: arg);
377: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
378: level * 4, "");
379: if (!dflag && yp -> yp_strexp)
380: printf ("%*s%s = bitstr2strb (%s, &(%s));\n",
381: level * 4, "", yp -> yp_strexp, arg, yp -> yp_intexp);
382: if (!dflag && (level == 1)) {
383: printf ("%*sif (buffer && len)\n", level * 4, "");
384: if (yp -> yp_strexp)
385: printf ("%*s*buffer = %s, *len = %s;\n",
386: (level + 1) * 4, "", yp -> yp_strexp, yp -> yp_intexp);
387: else
388: printf ("%*s*buffer = bitstr2strb (%s, len);\n",
389: (level + 1) * 4, "", arg);
390: }
391: #ifdef notdef
392: if (!rflag) {
393: register int j;
394:
395: for (yv = yp -> yp_value, i = 0; yv; yv = yv -> yv_next)
396: if ((j = val2int (yv)) > i)
397: i = j;
398: i++;
399: printf ("%*sif (%s -> pe_nbits > %d) {\n",
400: level * 4, "", narg, i);
401: printf ("%*sadvise (NULLCP, \"%s %%s(%d): %%d\", PEPY_ERR_TOO_MANY_BITS,\n",
402: (level + 1) * 4, "", id, i);
403: printf ("%*s%s -> pe_nbits);\n", (level + 3) * 4, "", narg);
404: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
405: level * 4, "");
406: }
407: #endif
408: i = -1;
409: for (yv = yp -> yp_value; yv; yv = yv -> yv_next)
410: if ((j = val2int (yv)) < 0)
411: pyyerror (yp, "invalid bit number in BIT STRING");
412: else
413: if (j > i)
414: i = j;
415: printf ("#define\tBITS\t\"\\020");
416: if (i < sizeof (int) * 8) { /* NBBY */
417: for (yv = yp -> yp_value; yv; yv = yv -> yv_next)
418: if (yv -> yv_flags & YV_NAMED)
419: printf ("\\0%o%s", val2int (yv) + 1, yv -> yv_named);
420: else
421: printf ("\\0%oBIT%d", val2int (yv) + 1, val2int (yv));
422: }
423: printf ("\"\n");
424: uniqint (yp -> yp_value);
425: if (!dflag)
426: for (yv = yp -> yp_value; yv; yv = yv -> yv_next) {
427: if (!yv -> yv_action)
428: continue;
429: printf ("%*sif (bit_test (%s, %d) > OK) {",
430: level * 4, "", narg, val2int (yv));
431: if (yv -> yv_flags & YV_NAMED)
432: printf ("\t/* %s */", yv -> yv_named);
433: printf ("\n");
434: do_action (yv -> yv_action, level + 1, narg,
435: yv -> yv_act_lineno);
436: printf ("%*s}\n", level * 4, "");
437: }
438: if (Vflag)
439: printf ("%*svprint (\"%%s\", bit2str (%s, BITS));\n",
440: level * 4, "", narg);
441: break;
442:
443: case YP_OCT:
444: if (!dflag && ((level == 1) || yp -> yp_action2
445: || yp -> yp_strexp)) {
446: printf ("%*sif ((%s = ", level * 4, "", narg);
447: if (!Vflag && yp -> yp_prfexp == 'q')
448: printf ("prim2qb (%s)) == (struct qbuf *)0) {\n", arg);
449: else
450: printf ("prim2str (%s, &%s_len)) == NULLCP) {\n",
451: arg, narg);
452: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_OCTET,\n",
453: (level + 1) * 4, "", id);
454: printf ("%*spe_error (%s -> pe_errno));\n",
455: (level + 3) * 4, "", arg);
456: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
457: level * 4, "");
458: }
459: if (!dflag && yp -> yp_strexp) {
460: if (! (yp -> yp_prfexp == 'q' && Vflag))
461: printf ("%*s%s = %s;\n",
462: level * 4, "", yp -> yp_strexp, narg);
463: }
464: if (!dflag && yp -> yp_intexp && yp -> yp_prfexp != 'q')
465: printf ("%*s%s = %s_len;\n",
466: level * 4, "", yp -> yp_intexp, narg);
467: if (Vflag)
468: printf ("%*svstring (%s);\n", level * 4, "", arg);
469: break;
470:
471: case YP_ANY:
472: if (!dflag && yp -> yp_strexp)
473: printf ("%*s(%s = %s) -> pe_refcnt++;\n",
474: level * 4, "", yp -> yp_strexp, arg);
475: if (Vflag)
476: printf ("%*svunknown (%s);\n", level * 4, "", arg);
477: break;
478:
479: case YP_NULL:
480: if (Vflag)
481: printf ("%*svprint (\"NULL\");\n", level * 4, "");
482: break;
483:
484: case YP_OID:
485: if (Vflag || (!dflag && (yp -> yp_action2 || yp -> yp_strexp
486: || level == 1)))
487: printf ("%*sif ((%s = prim2oid (%s)) == NULLOID) {\n",
488: level * 4, "", narg, arg);
489: else
490: printf ("%*sif (prim2oid (%s) == NULLOID) {\n",
491: level * 4, "", arg);
492: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_OID,\n",
493: (level + 1) * 4, "", id);
494: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
495: arg);
496: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
497: level * 4, "");
498: if (!dflag && level == 1) {
499: printf ("%*sif (buffer)\n", level * 4, "");
500: printf ("%*s*buffer = sprintoid (%s);\n",
501: (level + 1) * 4, "", narg);
502: }
503: if(!dflag && yp -> yp_strexp)
504: printf ("%*s%s = oid_cpy (%s);\n", level * 4, "",
505: yp -> yp_strexp, narg);
506: if (Vflag)
507: printf ("%*svprint (\"%%s\", oid2ode (%s));\n", level * 4,
508: "", narg);
509: break;
510:
511: case YP_SEQ:
512: printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
513: level * 4, "", narg, arg);
514: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
515: (level + 1) * 4, "", id);
516: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
517: arg);
518: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
519: level * 4, "");
520: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
521: if (!dflag && yp -> yp_strexp)
522: printf ("%*s(%s = %s) -> pe_refcnt++;\n",
523: level * 4, "", yp -> yp_strexp, narg);
524: if (Vflag)
525: printf ("%*svunknown (%s);\n", level * 4, "", narg);
526: break;
527:
528: case YP_SEQTYPE:
529: printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
530: level * 4, "", narg, arg);
531: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
532: (level + 1) * 4, "", id);
533: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
534: arg);
535: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
536: level * 4, "");
537: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
538: if (Vflag)
539: printf ("%*svpush ();\n", level * 4, "");
540: if (yp -> yp_type) {
541: printf ("%*sfor (%s = first_member (%s); %s; %s = next_member (%s, %s)) {\n",
542: level * 4, "", narg, arg, narg, narg, arg, narg);
543: if (!dflag && yp -> yp_action3) {
544: do_action (yp -> yp_action3, ++level, arg,
545: yp -> yp_act3_lineno);
546: printf ("%*s{\n", level * 4, "");
547: }
548: undo_type (yp -> yp_type, level + 1, "element", narg, Vflag);
549: if (!dflag && yp -> yp_action3)
550: printf ("%*s}\n", level-- * 4, "");
551: printf ("%*s}\n", level * 4, "");
552: }
553: if (Vflag)
554: printf ("%*svpop ();\n", level * 4, "");
555: break;
556:
557: case YP_SEQLIST:
558: printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
559: level * 4, "", narg, arg);
560: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
561: (level + 1) * 4, "", id);
562: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
563: arg);
564: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
565: level * 4, "");
566: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
567: if (Vflag)
568: printf ("%*svpush ();\n", level * 4, "");
569: for (y = yp -> yp_type, i = 0; y; y = y -> yp_next)
570: if (y -> yp_flags & YP_COMPONENTS)
571: i += undo_components_seq (y, level, y == yp -> yp_type,
572: y -> yp_next == NULLYP, id, arg, narg, Vflag);
573: else {
574: undo_type_element (y, level, y == yp -> yp_type,
575: y -> yp_next == NULLYP, id, arg, narg, Vflag);
576: i++;
577: }
578: if (Vflag)
579: printf ("%*svpop ();\n", level * 4, "");
580: for (y = yp -> yp_type; y; y = y -> yp_next) {
581: register YP z;
582:
583: if (!(y -> yp_flags & (YP_OPTIONAL | YP_DEFAULT))
584: || lookup_tag (y) == NULLYT)
585: continue;
586: for (z = y -> yp_next; z; z = z -> yp_next)
587: if (!(z -> yp_flags & (YP_OPTIONAL | YP_DEFAULT))
588: || lookup_tag (z) == NULLYT)
589: break;
590: uniqtag (y, z);
591: if (z == NULLYP)
592: break;
593: y = z;
594: }
595: if (!rflag) {
596: printf ("\n%*sif (%s -> pe_cardinal > %d) {\n",
597: level * 4, "", arg, i);
598: printf ("%*sadvise (NULLCP, \"%s %%s(%d): %%d\", PEPY_ERR_TOO_MANY_ELEMENTS,\n",
599: (level + 1) * 4, "", id, i);
600: printf ("%*s%s -> pe_cardinal);\n", (level + 3) * 4, "", arg);
601: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
602: level * 4, "");
603: }
604: break;
605:
606: case YP_SET:
607: printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
608: level * 4, "", narg, arg);
609: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
610: (level + 1) * 4, "", id);
611: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
612: arg);
613: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
614: level * 4, "");
615: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
616: if (!dflag && yp -> yp_strexp)
617: printf ("%*s(%s = %s) -> pe_refcnt++;\n",
618: level * 4, "", yp -> yp_strexp, narg);
619: if (Vflag)
620: printf ("%*svunknown (%s);\n", level * 4, "", narg);
621: break;
622:
623: case YP_SETTYPE:
624: printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
625: level * 4, "", narg, arg);
626: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
627: (level + 1) * 4, "", id);
628: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
629: arg);
630: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
631: level * 4, "");
632: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
633: if (Vflag)
634: printf ("%*svpush ();\n", level * 4, "");
635: if (yp -> yp_type) {
636: printf ("%*sfor (%s = first_member (%s); %s; %s = next_member (%s, %s)) {\n",
637: level * 4, "", narg, arg, narg, narg, arg, narg);
638: if (!dflag && yp -> yp_action3) {
639: do_action (yp -> yp_action3, ++level, arg,
640: yp -> yp_act3_lineno);
641: printf ("%*s{\n", level * 4, "");
642: }
643: undo_type (yp -> yp_type, level + 1, "member", narg, Vflag);
644: if (!dflag && yp -> yp_action3)
645: printf ("%*s}\n", level-- * 4, "");
646: printf ("%*s}\n", level * 4, "");
647: }
648: if (Vflag)
649: printf ("%*svpop ();\n", level * 4, "");
650: break;
651:
652: case YP_SETLIST:
653: printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
654: level * 4, "", narg, arg);
655: printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
656: (level + 1) * 4, "", id);
657: printf ("%*spe_error (%s -> pe_errno));\n", (level + 3) * 4, "",
658: arg);
659: printf ("%*sreturn NOTOK;\n%*s}\n", (level + 1) * 4, "",
660: level * 4, "");
661: printf ("%*s%s = %s;\n\n", level * 4, "", arg, narg);
662: if (Vflag)
663: printf ("%*svpush ();\n", level * 4, "");
664: if (yp -> yp_type) {
665: for (y = yp -> yp_type; y; y = y -> yp_next)
666: if (y -> yp_flags & YP_COMPONENTS)
667: undo_components_set (y, level, arg, narg, Vflag);
668: else
669: undo_type_member (y, level, arg, narg, Vflag);
670: choice_pullup (y = copy_type (yp), CH_FULLY);
671: uniqtag (y -> yp_type, NULLYP);
672: if (!rflag) {
673: printf ("%*sif (%s_count != %s -> pe_cardinal)\n",
674: level * 4, "", narg, arg);
675: printf ("%*sadvise (NULLCP, \"%%s\", PEPY_ERR_EXTRA_MEMBERS);\n",
676: (level + 1) * 4, "");
677: }
678: }
679: if (Vflag)
680: printf ("%*svpop ();\n", level * 4, "");
681: break;
682:
683: case YP_CHOICE:
684: if (Vflag)
685: printf ("%*svpush ();\n", level * 4, "");
686: if (yp -> yp_type) {
687: int didefault;
688:
689: if ((yp -> yp_flags & YP_TAG)
690: && !(yp -> yp_flags & YP_PULLEDUP))
691: tag_pullup (yp, level, arg, "choice");
692: printf ("%*sswitch (PE_ID (%s -> pe_class, %s -> pe_id)) {\n",
693: level * 4, "", arg, arg);
694: choice_pullup (yp, CH_PARTIAL);
695: didefault = 0;
696: for (y = yp -> yp_type; y; y = y -> yp_next)
697: didefault += undo_type_choice (y, level + 1, arg, Vflag);
698: if (didefault > 1)
699: yyerror_aux ("multiple non-tagged ANYs in CHOICE");
700: uniqtag (yp -> yp_type, NULLYP);
701: if (!didefault && !rflag) {
702: printf ("\n%*sdefault:\n", (level + 1) * 4, "");
703: printf ("%*sadvise (NULLCP, \"%s %%s%%s/%%d/0x%%x\", PEPY_ERR_UNKNOWN_CHOICE,\n",
704: (level + 2) * 4, "", id);
705: printf ("%*spe_classlist[%s -> pe_class], %s -> pe_form, %s -> pe_id);\n",
706: (level + 4) * 4, "", arg, arg, arg);
707: printf ("%*sreturn NOTOK;\n", (level + 2) * 4, "");
708: }
709: printf ("%*s}\n", level * 4, "");
710: }
711: if (Vflag)
712: printf ("%*svpop ();\n", level * 4, "");
713: break;
714:
715: case YP_IDEFINED:
716: printf ("%*sif (%s (", level * 4, "", modsym (yp -> yp_module,
717: yp -> yp_identifier, Vflag ? YP_PRINTER : YP_DECODER));
718: printf ("%s, ", arg);
719: if (level != 1 || (yp -> yp_flags & YP_IMPLICIT))
720: printf ("%d, ", (yp -> yp_flags & YP_IMPLICIT) ? 0 : 1);
721: else
722: printf ("explicit, ");
723: if (yp -> yp_intexp)
724: printf ("&(%s), ", yp -> yp_intexp);
725: else if (level == 1)
726: printf ("len, ");
727: else
728: printf ("NULLINTP, ");
729: if (yp -> yp_strexp)
730: printf ("&(%s)", yp -> yp_strexp);
731: else if (level == 1)
732: printf ("buffer");
733: else
734: printf ("NULLVP");
735: if (yp -> yp_flags & YP_PARMVAL)
736: printf (", %s", yp -> yp_parm);
737: else
738: printf (", NullParm");
739: printf (") == NOTOK)\n%*sreturn NOTOK;\n", (level + 1) * 4, "");
740: break;
741:
742: default:
743: myyerror ("unknown type: %d", yp -> yp_code);
744: }
745:
746: if (!dflag && yp -> yp_action2)
747: do_action (yp -> yp_action2, level, narg ? narg : arg,
748: yp -> yp_act2_lineno);
749:
750: switch (yp -> yp_code) {
751: case YP_BITLIST:
752: printf ("#undef\tBITS\n");
753: break;
754:
755: case YP_OCT:
756: if (!dflag && yp -> yp_prfexp != 'q' &&
757: ((level == 1) || yp -> yp_action2)) {
758: if (level == 1) {
759: printf ("%*sif (len)\n", level * 4, "");
760: printf ("%*s*len = %s_len;\n", (level + 1) * 4, "", narg);
761: printf ("%*sif (buffer)\n", level * 4, "");
762: printf ("%*s*buffer = %s;\n", (level + 1) * 4, "", narg);
763: printf ("%*selse\n", level * 4, "");
764: }
765: printf ("%*s", (level + 1) * 4, "");
766: if (yp -> yp_strexp)
767: printf ("/* do nothing */;\n");
768: else
769: printf ("if (%s)\n%*sfree (%s);\n", narg, (level + 2) * 4,
770: "", narg);
771: }
772: break;
773:
774: default:
775: break;
776: }
777: }
778:
779: /* */
780:
781: static undo_type_element (yp, level, first, last, id, arg, narg, Vflag)
782: register YP yp;
783: register int level;
784: int first,
785: last;
786: register char *id,
787: *arg,
788: *narg;
789: int Vflag;
790: {
791: register char *narg2;
792: register YT yt;
793:
794: printf ("%*s{\n%*sregister PE %s;\n\n",
795: level * 4, "", (level + 1) * 4, "", narg2 = gensym ());
796: level++;
797:
798: if ((yp -> yp_flags & (YP_OPTIONAL | YP_DEFAULT)) && !last) {
799: YP yp2 = copy_type (yp);
800:
801: if (!(yp2 -> yp_flags & YP_TAG)) {
802: switch (yp2 -> yp_code) {
803: case YP_CHOICE:
804: break;
805: case YP_IDEFINED:
806: if (lookup_tag (yp2) == NULLYT)
807: break;
808: default:
809: tag_type (yp2);
810: break;
811: }
812: }
813: printf ("%*sif ((%s = ", level * 4, "", narg2);
814: if (first)
815: printf ("first_member (%s)) != NULLPE", arg);
816: else {
817: printf ("(%s != %s ? next_member (%s, %s) : first_member (%s))",
818: arg, narg, arg, narg, arg);
819: printf (") \n%*s!= NULLPE", (level + 3) * 4, "");
820: }
821: if (yp2 -> yp_flags & YP_TAG && !last) {
822: yt = yp2 -> yp_tag;
823: printf ("\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
824: (level + 2) * 4, "", narg2, narg2);
825: printf ("%*s!= PE_ID (PE_CLASS_%s, %d))\n%*s%s = NULLPE;\n",
826: (level + 4) * 4, "", pe_classlist[yt -> yt_class],
827: val2int (yt -> yt_value), (level + 1) * 4, "", narg2);
828: }
829: else {
830: ype zy;
831: register YP y = &zy;
832:
833: y -> yp_type = copy_type (yp2); /* XXX */
834: y -> yp_type -> yp_next = NULLYP;
835: choice_pullup (y, CH_FULLY); /* XXX */
836: for (y = y -> yp_type; y; y = y -> yp_next) {
837: if (!(y -> yp_flags & YP_TAG))
838: tag_type (y);
839: printf ("\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
840: (level + 2) * 4, "", narg2, narg2);
841: printf ("%*s!= PE_ID (PE_CLASS_%s, %d)",
842: (level + 4) * 4, "",
843: pe_classlist[y -> yp_tag -> yt_class],
844: val2int (y -> yp_tag -> yt_value));
845: }
846: printf (")\n%*s%s = NULLPE;\n", (level + 1) * 4, "", narg2);
847: }
848: printf ("%*sif (%s != NULLPE", level * 4, "", narg2);
849: }
850: else {
851: printf ("%*sif ((%s = ", level * 4, "", narg2);
852: if (first)
853: printf ("first_member (%s)", arg);
854: else
855: printf ("(%s != %s ? next_member (%s, %s) : first_member (%s))",
856: arg, narg, arg, narg, arg);
857: printf (") != NULLPE");
858: }
859: printf (") {\n%*s%s = %s;\n\n", (level + 1) * 4, "", narg, narg2);
860: level++;
861:
862: if (yp -> yp_code != YP_CHOICE && (yp -> yp_flags & YP_TAG)) {
863: if ((yp -> yp_flags & YP_IMPLICIT) == 0 ||
864: is_nonimplicit_type (yp))
865: tag_pullup (yp, level, narg2, "element");
866: }
867: printf ("%*s{", level * 4, "");
868: level++;
869: if (yp -> yp_flags & YP_ID)
870: printf ("\t/* %s */", yp -> yp_id);
871: printf ("\n");
872:
873: undo_type (yp, level, yp -> yp_flags & YP_ID ? yp -> yp_id : "element",
874: narg2, Vflag);
875:
876: level--;
877: printf ("%*s}\n", level * 4, "");
878:
879: level--;
880: printf ("%*s}\n", level * 4, "");
881:
882: if ((yp -> yp_flags & YP_DEFAULT) || !(yp -> yp_flags & YP_OPTIONAL)) {
883: printf ("%*selse {\n", level * 4, "");
884:
885: if (yp -> yp_flags & YP_DEFAULT)
886: printf ("%*s/* set default here using yp -> yp_default */\n",
887: (level + 1) * 4, "");
888: else {
889: printf ("%*sadvise (NULLCP, \"%s %%s",
890: (level + 1) * 4, "", id);
891: if (yp -> yp_flags & YP_ID)
892: printf ("%s ", yp -> yp_id);
893: printf ("element\", PEPY_ERR_MISSING);\n%*sreturn NOTOK;\n", (level + 1) * 4, "");
894: }
895:
896: printf ("%*s}\n\n", level * 4, "");
897: }
898:
899: level--;
900: printf ("%*s}\n\n", level * 4, "");
901: }
902:
903: /* */
904:
905: static undo_type_member (yp, level, arg, narg, Vflag)
906: register YP yp;
907: register int level;
908: char *arg,
909: *narg;
910: int Vflag;
911: {
912: int pullup = 0;
913: char *id = yp -> yp_flags & YP_ID ? yp -> yp_id : "member";
914: char *narg2;
915:
916: if (!(yp -> yp_flags & YP_TAG)) {
917: switch (yp -> yp_code) {
918: case YP_CHOICE:
919: break;
920: case YP_IDEFINED:
921: if (lookup_tag (yp) == NULLYT)
922: break;
923: default:
924: tag_type (yp);
925: }
926: }
927: if (yp -> yp_flags & YP_TAG)
928: printf ("%*sif (%s = set_find (%s, PE_CLASS_%s, %d)) {\n",
929: level * 4, "", narg, arg,
930: pe_classlist[yp -> yp_tag -> yt_class],
931: val2int (yp -> yp_tag -> yt_value));
932: else {
933: ype zy;
934: register YP y = &zy;
935:
936: y -> yp_type = copy_type(yp); /* XXXX !!! */
937: y -> yp_type -> yp_next = NULLYP;
938: choice_pullup (y, CH_FULLY);
939: /* this is dependant on choice_pullup coding... */
940: y = y -> yp_type;
941: if (y) {
942: if (!(y -> yp_flags & YP_TAG))
943: tag_type (y);
944: printf ("%*sif ( (%s = set_find (%s, PE_CLASS_%s, %d))",
945: level * 4, "", narg, arg,
946: pe_classlist[y->yp_tag->yt_class],
947: val2int (y -> yp_tag -> yt_value));
948: for (y = y -> yp_next; y; y = y -> yp_next) {
949: if (!(y -> yp_flags & YP_TAG))
950: tag_type (y);
951: printf ("\n%*s|| (%s = set_find (%s, PE_CLASS_%s, %d))",
952: (level + 1) * 4, "", narg, arg,
953: pe_classlist[y -> yp_tag -> yt_class],
954: val2int (y -> yp_tag -> yt_value));
955: }
956: printf (" ) {\n");
957: }
958: }
959: level ++;
960:
961: if (yp -> yp_flags & YP_TAG) {
962: if ((yp -> yp_flags & YP_IMPLICIT) == 0 ||
963: is_nonimplicit_type (yp))
964: pullup = 1;
965: }
966:
967: if (pullup) {
968: printf ("%*sregister PE %s = %s;\n\n", level * 4, "",
969: narg2 = gensym (), narg);
970: tag_pullup (yp, level, narg2, id);
971: printf ("%*s{\n", level * 4, "");
972: level++;
973: yp -> yp_flags |= YP_PULLEDUP;
974: }
975: else
976: narg2 = narg;
977:
978: undo_type (yp, level, id, narg2, Vflag);
979:
980: if (pullup) {
981: level--;
982: printf ("%*s}\n", level * 4, "");
983: }
984:
985: printf ("%*s%s_count ++;\n", level * 4, "", narg);
986: level--;
987: printf ("%*s}\n", level * 4, "");
988:
989: if ((yp -> yp_flags & YP_DEFAULT) || !(yp -> yp_flags & YP_OPTIONAL)) {
990: printf ("%*selse {\n", level * 4, "");
991:
992: if (yp -> yp_flags & YP_DEFAULT)
993: printf ("%*s/* set default here using yp -> yp_default */\n",
994: (level + 1) * 4, "");
995: else {
996: printf ("%*sadvise (NULLCP, \"%s %%s ",
997: (level + 1) * 4, "", id);
998: if (yp -> yp_flags & YP_ID)
999: printf ("%s ", yp -> yp_id);
1000: printf ("member\", PEPY_ERR_MISSING);\n%*sreturn NOTOK;\n", (level + 1) * 4, "");
1001: }
1002:
1003: printf ("%*s}\n\n", level * 4, "");
1004: }
1005: }
1006: /* */
1007:
1008: static int undo_type_choice (yp, level, narg, Vflag)
1009: register YP yp;
1010: register int level;
1011: register char *narg;
1012: int Vflag;
1013: {
1014: int pullup = 0;
1015: int result;
1016: char *id = yp -> yp_flags & YP_ID ? yp -> yp_id : "member";
1017: char *narg2;
1018:
1019: if (is_any_type (yp)) {
1020: printf ("%*sdefault:", level * 4, "");
1021:
1022: result = 1;
1023: }
1024: else if (!(yp -> yp_flags & YP_TAG) && yp->yp_code == YP_IDEFINED) {
1025: ype zy;
1026: register YP y = &zy;
1027:
1028: result = 0;
1029: y -> yp_type = copy_type(yp); /* XXXX !!! */
1030: y -> yp_type -> yp_next = NULL;
1031: choice_pullup (y, CH_FULLY);
1032: /* this is dependant on choice_pullup coding..*/
1033: for (y = y -> yp_type; y; y = y -> yp_next) {
1034: if (is_any_type (y)) {
1035: printf ("%*sdefault:%s", level * 4, "",
1036: y -> yp_next ? "\n" : "");
1037: result ++;
1038: }
1039: else {
1040: if (!(y -> yp_flags & YP_TAG))
1041: tag_type(y);
1042: printf("%*scase PE_ID (PE_CLASS_%s, %d):%s", level * 4, "",
1043: pe_classlist [y -> yp_tag -> yt_class],
1044: val2int (y -> yp_tag -> yt_value),
1045: y -> yp_next ? "\n" : "");
1046: }
1047: }
1048: }
1049: else {
1050: if (!(yp -> yp_flags & YP_TAG))
1051: tag_type (yp);
1052: printf ("%*scase PE_ID (PE_CLASS_%s, %d):", level * 4, "",
1053: pe_classlist [yp -> yp_tag -> yt_class],
1054: val2int (yp -> yp_tag -> yt_value));
1055:
1056: result = 0;
1057: }
1058: if (yp -> yp_flags & YP_ID)
1059: printf ("\t/* %s */", yp -> yp_id);
1060: printf ("\n");
1061: level++;
1062:
1063: printf ("%*s{\n", level * 4, "");
1064: level++;
1065:
1066: if (yp -> yp_flags & YP_TAG) {
1067: if ((yp -> yp_flags & YP_IMPLICIT) == 0 ||
1068: is_nonimplicit_type (yp))
1069: pullup = 1;
1070: }
1071: if (pullup) {
1072: printf ("%*sregister PE %s = %s;\n\n", level * 4, "",
1073: narg2 = gensym (), narg);
1074: tag_pullup (yp, level, narg2, id);
1075: printf ("%*s{\n", level * 4, "");
1076: level++;
1077: yp -> yp_flags |= YP_PULLEDUP;
1078: }
1079: else
1080: narg2 = narg;
1081:
1082: undo_type (yp, level, id, narg2, Vflag);
1083:
1084: if (pullup) {
1085: level--;
1086: printf ("%*s}\n", level * 4, "");
1087: }
1088:
1089: level--;
1090: printf ("%*s}\n%*sbreak;\n", level * 4, "", level * 4, "");
1091:
1092: return result;
1093: }
1094:
1095: static undo_components_seq (yp, level, first, last, id, arg, narg, Vflag)
1096: YP yp;
1097: register int level, first, last;
1098: register char *id,
1099: *arg,
1100: *narg;
1101: int Vflag;
1102: {
1103: YP newyp;
1104: YP y;
1105: int i = 0;
1106:
1107: if (yp -> yp_module) {
1108: pyyerror (yp, "Can't do COMPONENTS OF with external types for %s",
1109: yp -> yp_identifier);
1110: return i;
1111: }
1112:
1113: if (!(newyp = lookup_type (yp->yp_module, yp -> yp_identifier))) {
1114: pyyerror (yp, "Can't find referenced COMPONENTS OF %s",
1115: yp->yp_identifier);
1116: return i;
1117: }
1118:
1119: for (y = newyp -> yp_type; y; y = y -> yp_next) {
1120: if (y -> yp_flags & YP_COMPONENTS)
1121: i += undo_components_seq (y, level, first && y == yp -> yp_type,
1122: last && y -> yp_next == NULLYP,
1123: id, arg, narg, Vflag);
1124: else {
1125: undo_type_element (y, level, first && y == newyp -> yp_type,
1126: last && y -> yp_next == NULLYP, id,
1127: arg, narg, Vflag);
1128: i ++;
1129: }
1130: }
1131: return i;
1132: }
1133:
1134: static undo_components_set (yp, level, arg, narg, Vflag)
1135: register YP yp;
1136: register int level;
1137: char *arg,
1138: *narg;
1139: int Vflag;
1140: {
1141: YP newyp, y;
1142:
1143: if (yp -> yp_module) {
1144: pyyerror (yp, "Can't do COMPONENTS OF with external types for %s",
1145: yp -> yp_identifier);
1146: return;
1147: }
1148:
1149: if (!(newyp = lookup_type (yp->yp_module, yp -> yp_identifier))) {
1150: pyyerror (yp, "Can't find referenced COMPONENTS OF %s",
1151: yp->yp_identifier);
1152: return;
1153: }
1154: if (newyp -> yp_code != YP_SETLIST) {
1155: yyerror_aux ("COMPONENTS OF type is not a SET");
1156: print_type (newyp, 0);
1157: return;
1158: }
1159:
1160: choice_pullup (newyp, CH_PARTIAL);
1161: for (y = newyp -> yp_type; y; y = y ->yp_next)
1162: if (y -> yp_flags & YP_COMPONENTS)
1163: undo_components_set (y, level, arg, narg, Vflag);
1164: else
1165: undo_type_member (y, level, arg, narg, Vflag);
1166: choice_pullup (newyp, CH_FULLY);
1167: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.