/* pepy_undo.c - PE parser (yacc-based) building routines */
static char *rcsid
= "$Header: /f/osi/pepy/RCS/pepy_undo.c,v 7.4 91/02/22 09:35:08 mrose Interim $";
* $Header: /f/osi/pepy/RCS/pepy_undo.c,v 7.4 91/02/22 09:35:08 mrose Interim $
* Revision 7.4 91/02/22 09:35:08 mrose
* Revision 7.3 90/11/11 10:01:29 mrose
* Revision 7.2 90/10/29 18:38:24 mrose
* Revision 7.1 90/10/23 20:42:45 mrose
* Revision 7.0 89/11/23 22:11:55 mrose
* Acquisition, use, and distribution of this module and related
* materials are subject to the restrictions of a license agreement.
* Consult the Preface in the User's Manual for the full terms of
extern struct tuple tuples
[];
char *gensym (), *modsym ();
YP
lookup_type (), lookup_binding ();
undo_type (yp
, level
, id
, arg
, Vflag
)
register struct tuple
*t
;
if (yp
-> yp_flags
& YP_COMPONENTS
) {
yyerror_aux ("oops, I shouldn't be here!");
printf ("(pe, explicit, len, buffer, parm)\n");
printf ("%sPE\tpe;\nint\texplicit;\n",
&& yp
-> yp_code
!= YP_NULL
&& (yp
-> yp_code
!= YP_CHOICE
|| (yp
-> yp_flags
& YP_CONTROLLED
))
printf ("int *len;\nchar **buffer;\n%s parm;\n{\n",
yp
-> yp_param_type
? yp
-> yp_param_type
: "PEPYPARM");
printf ("# line %d \"%s\"\n", yp
-> yp_act0_lineno
, sysin
);
printf ("%*s%s\n", level
* 4, "", yp
-> yp_action0
);
if (!Vflag
&& (dflag
|| !((level
== 1) || yp
-> yp_action2
printf ("%*sregister integer %s;\n\n", level
* 4, "",
if (!Vflag
&& (dflag
|| !((level
== 1) || yp
-> yp_action2
printf ("%*sregister PE %s;\n\n", level
* 4, "",
if (!dflag
&& ((level
== 1) || yp
-> yp_action2
if (!Vflag
&& yp
-> yp_prfexp
== 'q')
printf ("%*sregister struct qbuf *%s;\n\n",
printf ("%*sregister char *%s;\n%*sint %s_len;\n\n",
level
* 4, "", narg
, level
* 4, "", narg
);
if (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sregister double %s;\n\n", level
* 4, "", narg
);
if (!Vflag
&& (dflag
|| (!yp
-> yp_action2
&& !yp
-> yp_strexp
printf ("%*sregister OID %s;\n\n", level
* 4, "",
if (yp
-> yp_code
== YP_SETLIST
)
printf ("%*sint %s_count = 0;\n", level
* 4, "", narg
);
printf ("%*sregister PE %s;\n\n", level
* 4, "", narg
);
myyerror ("unknown type: %d", yp
-> yp_code
);
printf ("#ifdef DEBUG\n%*s(void) testdebug (%s, \"",
printf ("%s.", mymodule
);
printf ("%s\");\n#endif\n\n", id
);
if (level
== 1 && (yp
-> yp_flags
& YP_TAG
)) {
printf ("%*sif (explicit\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
level
* 4, "", (level
+ 2) * 4, "", arg
, arg
);
printf ("%*s!= PE_ID (PE_CLASS_%s, %d)) {\n",
(level
+ 4) * 4, "", pe_classlist
[yp
-> yp_tag
-> yt_class
],
val2int (yp
-> yp_tag
-> yt_value
));
printf ("%*sadvise (NULLCP, \"%s %%s%%s/0x%%x\", PEPY_ERR_BAD_CLASS,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_classlist[%s -> pe_class], %s -> pe_id);\n",
(level
+ 3) * 4, "", arg
, arg
);
printf ("%*sreturn NOTOK;\n%*s}\n",
(level
+ 1) * 4, "", (level
* 4), "");
if (!(yp
-> yp_flags
& YP_IMPLICIT
)) {
for (t
= tuples
; t
-> t_type
!= YP_UNDF
; t
++)
if (t
-> t_type
== yp
-> yp_code
) {
check_type (id
, level
, t
-> t_class
, t
-> t_form
,
if (level
== 1 && yp
-> yp_code
!= YP_CHOICE
&&
(yp
-> yp_flags
& YP_TAG
) == YP_TAG
) {
if ((yp
-> yp_flags
& YP_IMPLICIT
) == 0 ||
is_nonimplicit_type (yp
))
tag_pullup (yp
, level
, arg
, "element");
if (yp
-> yp_flags
& YP_ID
)
printf ("%*svname (\"%s\");\n", level
* 4, "", yp
-> yp_id
);
if (hflag
&& yp
-> yp_code
== YP_IDEFINED
)
printf ("%*svname (\"%s\");\n", level
* 4, "",
if ((yp
-> yp_flags
& YP_TAG
)
&& (yp
-> yp_flags
& (YP_OPTIONAL
| YP_DEFAULT
)))
printf ("%*svtag (%d, %d);\n", level
* 4, "",
yp
-> yp_tag
-> yt_class
,
val2int (yp
-> yp_tag
-> yt_value
));
if (!dflag
&& yp
-> yp_action05
)
do_action (yp
-> yp_action05
, level
, arg
, yp
-> yp_act05_lineno
);
if (!dflag
&& yp
-> yp_action1
)
do_action (yp
-> yp_action1
, level
, arg
, yp
-> yp_act1_lineno
);
if (Vflag
|| (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sif ((%s = prim2flag (%s)) == NOTOK) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sif (prim2flag (%s) == NOTOK) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BOOLEAN,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_intexp
)
printf ("%*s%s = %s;\n", level
* 4, "", yp
-> yp_intexp
, narg
);
if (!dflag
&& (level
== 1))
printf ("%*sif (len)\n%*s*len = %s;\n", level
* 4, "",
(level
+ 1) * 4, "", narg
);
printf ("%*svprint (%s ? \"TRUE\" : \"FALSE\");\n",
if (Vflag
|| (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sif ((%s = prim2num (%s)) == NOTOK\n",
level
* 4, "", narg
, arg
);
printf ("%*sif (prim2num (%s) == NOTOK\n",
printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
(level
+ 2) * 4, "", arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_INTEGER,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_intexp
)
printf ("%*s%s = %s;\n", level
* 4, "", yp
-> yp_intexp
, narg
);
if (!dflag
&& (level
== 1))
printf ("%*sif (len)\n%*s*len = %s;\n", level
* 4, "",
(level
+ 1) * 4, "", narg
);
printf ("%*svprint (\"%%d\", %s);\n", level
* 4, "", narg
);
if (Vflag
|| (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sif ((%s = prim2real (%s)) == NOTOK\n",
level
* 4, "", narg
, arg
);
printf ("%*sif (prim2real (%s) == NOTOK\n",
printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
(level
+ 2) * 4, "", arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_REAL,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s%s = %s;\n", level
* 4, "",
printf ("%*svprint (\"%%g\", %s);\n", level
* 4, "", narg
);
printf ("%*sif ((%s = prim2%snum (%s)) == NOTOK\n",
yp
->yp_code
== YP_ENUMLIST
? "e" : "",
printf ("%*s&& %s -> pe_errno != PE_ERR_NONE) {\n",
(level
+ 2) * 4, "", arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_INTEGER,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_intexp
)
printf ("%*s%s = %s;\n", level
* 4, "", yp
-> yp_intexp
, narg
);
if (!dflag
&& (level
== 1))
printf ("%*sif (len)\n%*s*len = %s;\n", level
* 4, "",
(level
+ 1) * 4, "", narg
);
uniqint (yp
-> yp_value
);
printf ("%*sswitch (%s) {\n", level
* 4, "", narg
);
for (yv
= yp
-> yp_value
; yv
; yv
= yv
-> yv_next
) {
printf ("%*scase %d:", (level
+ 1) * 4, "", val2int (yv
));
if (yv
-> yv_flags
& YV_NAMED
)
printf ("\t/* %s */", yv
-> yv_named
);
if (yv
-> yv_flags
& YV_NAMED
)
printf ("%*svprint (\"%s\");\n", (level
+ 2) * 4, "",
printf ("%*svprint (\"%%d\", %s);\n", (level
+ 2) * 4,
if (!dflag
&& yv
-> yv_action
)
do_action (yv
-> yv_action
, level
+ 2, narg
,
printf ("%*sbreak;\n", (level
+ 2) * 4, "");
if (!rflag
&& yp
-> yp_code
== YP_ENUMLIST
) {
printf ("%*sdefault:\n", (level
+ 1) * 4, "");
printf ("%*sadvise (NULLCP, \"%s %%s%%d\", PEPY_ERR_UNK_COMP, %s);\n",
(level
+ 2) * 4, "", id
, narg
);
printf ("%*sreturn NOTOK;\n", (level
+ 2) * 4, "");
printf ("%*sdefault:\n", (level
+ 1) * 4, "");
printf ("%*svprint (\"%%d\", %s);\n", (level
+ 2) * 4, "",
printf ("%*sbreak;\n", (level
+ 2) * 4, "");
printf ("%*s}\n", level
* 4, "");
if (Vflag
|| (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sif ((%s = prim2bit (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sif (prim2bit (%s) == NULLPE) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BITS,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s%s = bitstr2strb (%s, &(%s));\n",
level
* 4, "", yp
-> yp_strexp
, arg
, yp
-> yp_intexp
);
if (!dflag
&& (level
== 1)) {
printf ("%*sif (buffer && len)\n", level
* 4, "");
printf ("%*s*buffer = %s, *len = %s;\n",
(level
+ 1) * 4, "", yp
-> yp_strexp
, yp
-> yp_intexp
);
printf ("%*s*buffer = bitstr2strb (%s, len);\n",
(level
+ 1) * 4, "", arg
);
printf ("%*sif (%s -> pe_nbits < 128)\n",
printf ("%*svprint (\"%%s\", bit2str (%s, \"\\020\"));\n",
(level
+ 1) * 4, "", narg
);
printf ("%*selse\n%*svunknown (%s);\n",
level
* 4, "", (level
+ 1) * 4, "", narg
);
printf ("%*sif ((%s = prim2bit (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_BITS,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s%s = bitstr2strb (%s, &(%s));\n",
level
* 4, "", yp
-> yp_strexp
, arg
, yp
-> yp_intexp
);
if (!dflag
&& (level
== 1)) {
printf ("%*sif (buffer && len)\n", level
* 4, "");
printf ("%*s*buffer = %s, *len = %s;\n",
(level
+ 1) * 4, "", yp
-> yp_strexp
, yp
-> yp_intexp
);
printf ("%*s*buffer = bitstr2strb (%s, len);\n",
(level
+ 1) * 4, "", arg
);
for (yv
= yp
-> yp_value
, i
= 0; yv
; yv
= yv
-> yv_next
)
if ((j
= val2int (yv
)) > i
)
printf ("%*sif (%s -> pe_nbits > %d) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s(%d): %%d\", PEPY_ERR_TOO_MANY_BITS,\n",
(level
+ 1) * 4, "", id
, i
);
printf ("%*s%s -> pe_nbits);\n", (level
+ 3) * 4, "", narg
);
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
for (yv
= yp
-> yp_value
; yv
; yv
= yv
-> yv_next
)
if ((j
= val2int (yv
)) < 0)
pyyerror (yp
, "invalid bit number in BIT STRING");
printf ("#define\tBITS\t\"\\020");
if (i
< sizeof (int) * 8) { /* NBBY */
for (yv
= yp
-> yp_value
; yv
; yv
= yv
-> yv_next
)
if (yv
-> yv_flags
& YV_NAMED
)
printf ("\\0%o%s", val2int (yv
) + 1, yv
-> yv_named
);
printf ("\\0%oBIT%d", val2int (yv
) + 1, val2int (yv
));
uniqint (yp
-> yp_value
);
for (yv
= yp
-> yp_value
; yv
; yv
= yv
-> yv_next
) {
printf ("%*sif (bit_test (%s, %d) > OK) {",
level
* 4, "", narg
, val2int (yv
));
if (yv
-> yv_flags
& YV_NAMED
)
printf ("\t/* %s */", yv
-> yv_named
);
do_action (yv
-> yv_action
, level
+ 1, narg
,
printf ("%*s}\n", level
* 4, "");
printf ("%*svprint (\"%%s\", bit2str (%s, BITS));\n",
if (!dflag
&& ((level
== 1) || yp
-> yp_action2
printf ("%*sif ((%s = ", level
* 4, "", narg
);
if (!Vflag
&& yp
-> yp_prfexp
== 'q')
printf ("prim2qb (%s)) == (struct qbuf *)0) {\n", arg
);
printf ("prim2str (%s, &%s_len)) == NULLCP) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_OCTET,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n",
(level
+ 3) * 4, "", arg
);
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& yp
-> yp_strexp
) {
if (! (yp
-> yp_prfexp
== 'q' && Vflag
))
level
* 4, "", yp
-> yp_strexp
, narg
);
if (!dflag
&& yp
-> yp_intexp
&& yp
-> yp_prfexp
!= 'q')
printf ("%*s%s = %s_len;\n",
level
* 4, "", yp
-> yp_intexp
, narg
);
printf ("%*svstring (%s);\n", level
* 4, "", arg
);
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s(%s = %s) -> pe_refcnt++;\n",
level
* 4, "", yp
-> yp_strexp
, arg
);
printf ("%*svunknown (%s);\n", level
* 4, "", arg
);
printf ("%*svprint (\"NULL\");\n", level
* 4, "");
if (Vflag
|| (!dflag
&& (yp
-> yp_action2
|| yp
-> yp_strexp
printf ("%*sif ((%s = prim2oid (%s)) == NULLOID) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sif (prim2oid (%s) == NULLOID) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_OID,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
if (!dflag
&& level
== 1) {
printf ("%*sif (buffer)\n", level
* 4, "");
printf ("%*s*buffer = sprintoid (%s);\n",
(level
+ 1) * 4, "", narg
);
if(!dflag
&& yp
-> yp_strexp
)
printf ("%*s%s = oid_cpy (%s);\n", level
* 4, "",
printf ("%*svprint (\"%%s\", oid2ode (%s));\n", level
* 4,
printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s(%s = %s) -> pe_refcnt++;\n",
level
* 4, "", yp
-> yp_strexp
, narg
);
printf ("%*svunknown (%s);\n", level
* 4, "", narg
);
printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
printf ("%*svpush ();\n", level
* 4, "");
printf ("%*sfor (%s = first_member (%s); %s; %s = next_member (%s, %s)) {\n",
level
* 4, "", narg
, arg
, narg
, narg
, arg
, narg
);
if (!dflag
&& yp
-> yp_action3
) {
do_action (yp
-> yp_action3
, ++level
, arg
,
printf ("%*s{\n", level
* 4, "");
undo_type (yp
-> yp_type
, level
+ 1, "element", narg
, Vflag
);
if (!dflag
&& yp
-> yp_action3
)
printf ("%*s}\n", level
-- * 4, "");
printf ("%*s}\n", level
* 4, "");
printf ("%*svpop ();\n", level
* 4, "");
printf ("%*sif ((%s = prim2seq (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SEQ,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
printf ("%*svpush ();\n", level
* 4, "");
for (y
= yp
-> yp_type
, i
= 0; y
; y
= y
-> yp_next
)
if (y
-> yp_flags
& YP_COMPONENTS
)
i
+= undo_components_seq (y
, level
, y
== yp
-> yp_type
,
y
-> yp_next
== NULLYP
, id
, arg
, narg
, Vflag
);
undo_type_element (y
, level
, y
== yp
-> yp_type
,
y
-> yp_next
== NULLYP
, id
, arg
, narg
, Vflag
);
printf ("%*svpop ();\n", level
* 4, "");
for (y
= yp
-> yp_type
; y
; y
= y
-> yp_next
) {
if (!(y
-> yp_flags
& (YP_OPTIONAL
| YP_DEFAULT
))
|| lookup_tag (y
) == NULLYT
)
for (z
= y
-> yp_next
; z
; z
= z
-> yp_next
)
if (!(z
-> yp_flags
& (YP_OPTIONAL
| YP_DEFAULT
))
|| lookup_tag (z
) == NULLYT
)
printf ("\n%*sif (%s -> pe_cardinal > %d) {\n",
printf ("%*sadvise (NULLCP, \"%s %%s(%d): %%d\", PEPY_ERR_TOO_MANY_ELEMENTS,\n",
(level
+ 1) * 4, "", id
, i
);
printf ("%*s%s -> pe_cardinal);\n", (level
+ 3) * 4, "", arg
);
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
if (!dflag
&& yp
-> yp_strexp
)
printf ("%*s(%s = %s) -> pe_refcnt++;\n",
level
* 4, "", yp
-> yp_strexp
, narg
);
printf ("%*svunknown (%s);\n", level
* 4, "", narg
);
printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
printf ("%*svpush ();\n", level
* 4, "");
printf ("%*sfor (%s = first_member (%s); %s; %s = next_member (%s, %s)) {\n",
level
* 4, "", narg
, arg
, narg
, narg
, arg
, narg
);
if (!dflag
&& yp
-> yp_action3
) {
do_action (yp
-> yp_action3
, ++level
, arg
,
printf ("%*s{\n", level
* 4, "");
undo_type (yp
-> yp_type
, level
+ 1, "member", narg
, Vflag
);
if (!dflag
&& yp
-> yp_action3
)
printf ("%*s}\n", level
-- * 4, "");
printf ("%*s}\n", level
* 4, "");
printf ("%*svpop ();\n", level
* 4, "");
printf ("%*sif ((%s = prim2set (%s)) == NULLPE) {\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%s %%s%%s\", PEPY_ERR_BAD_SET,\n",
(level
+ 1) * 4, "", id
);
printf ("%*spe_error (%s -> pe_errno));\n", (level
+ 3) * 4, "",
printf ("%*sreturn NOTOK;\n%*s}\n", (level
+ 1) * 4, "",
printf ("%*s%s = %s;\n\n", level
* 4, "", arg
, narg
);
printf ("%*svpush ();\n", level
* 4, "");
for (y
= yp
-> yp_type
; y
; y
= y
-> yp_next
)
if (y
-> yp_flags
& YP_COMPONENTS
)
undo_components_set (y
, level
, arg
, narg
, Vflag
);
undo_type_member (y
, level
, arg
, narg
, Vflag
);
choice_pullup (y
= copy_type (yp
), CH_FULLY
);
uniqtag (y
-> yp_type
, NULLYP
);
printf ("%*sif (%s_count != %s -> pe_cardinal)\n",
level
* 4, "", narg
, arg
);
printf ("%*sadvise (NULLCP, \"%%s\", PEPY_ERR_EXTRA_MEMBERS);\n",
printf ("%*svpop ();\n", level
* 4, "");
printf ("%*svpush ();\n", level
* 4, "");
if ((yp
-> yp_flags
& YP_TAG
)
&& !(yp
-> yp_flags
& YP_PULLEDUP
))
tag_pullup (yp
, level
, arg
, "choice");
printf ("%*sswitch (PE_ID (%s -> pe_class, %s -> pe_id)) {\n",
level
* 4, "", arg
, arg
);
choice_pullup (yp
, CH_PARTIAL
);
for (y
= yp
-> yp_type
; y
; y
= y
-> yp_next
)
didefault
+= undo_type_choice (y
, level
+ 1, arg
, Vflag
);
yyerror_aux ("multiple non-tagged ANYs in CHOICE");
uniqtag (yp
-> yp_type
, NULLYP
);
if (!didefault
&& !rflag
) {
printf ("\n%*sdefault:\n", (level
+ 1) * 4, "");
printf ("%*sadvise (NULLCP, \"%s %%s%%s/%%d/0x%%x\", PEPY_ERR_UNKNOWN_CHOICE,\n",
(level
+ 2) * 4, "", id
);
printf ("%*spe_classlist[%s -> pe_class], %s -> pe_form, %s -> pe_id);\n",
(level
+ 4) * 4, "", arg
, arg
, arg
);
printf ("%*sreturn NOTOK;\n", (level
+ 2) * 4, "");
printf ("%*s}\n", level
* 4, "");
printf ("%*svpop ();\n", level
* 4, "");
printf ("%*sif (%s (", level
* 4, "", modsym (yp
-> yp_module
,
yp
-> yp_identifier
, Vflag
? YP_PRINTER
: YP_DECODER
));
if (level
!= 1 || (yp
-> yp_flags
& YP_IMPLICIT
))
printf ("%d, ", (yp
-> yp_flags
& YP_IMPLICIT
) ? 0 : 1);
printf ("&(%s), ", yp
-> yp_intexp
);
printf ("&(%s)", yp
-> yp_strexp
);
if (yp
-> yp_flags
& YP_PARMVAL
)
printf (", %s", yp
-> yp_parm
);
printf (") == NOTOK)\n%*sreturn NOTOK;\n", (level
+ 1) * 4, "");
myyerror ("unknown type: %d", yp
-> yp_code
);
if (!dflag
&& yp
-> yp_action2
)
do_action (yp
-> yp_action2
, level
, narg
? narg
: arg
,
printf ("#undef\tBITS\n");
if (!dflag
&& yp
-> yp_prfexp
!= 'q' &&
((level
== 1) || yp
-> yp_action2
)) {
printf ("%*sif (len)\n", level
* 4, "");
printf ("%*s*len = %s_len;\n", (level
+ 1) * 4, "", narg
);
printf ("%*sif (buffer)\n", level
* 4, "");
printf ("%*s*buffer = %s;\n", (level
+ 1) * 4, "", narg
);
printf ("%*selse\n", level
* 4, "");
printf ("%*s", (level
+ 1) * 4, "");
printf ("/* do nothing */;\n");
printf ("if (%s)\n%*sfree (%s);\n", narg
, (level
+ 2) * 4,
static undo_type_element (yp
, level
, first
, last
, id
, arg
, narg
, Vflag
)
printf ("%*s{\n%*sregister PE %s;\n\n",
level
* 4, "", (level
+ 1) * 4, "", narg2
= gensym ());
if ((yp
-> yp_flags
& (YP_OPTIONAL
| YP_DEFAULT
)) && !last
) {
if (!(yp2
-> yp_flags
& YP_TAG
)) {
switch (yp2
-> yp_code
) {
if (lookup_tag (yp2
) == NULLYT
)
printf ("%*sif ((%s = ", level
* 4, "", narg2
);
printf ("first_member (%s)) != NULLPE", arg
);
printf ("(%s != %s ? next_member (%s, %s) : first_member (%s))",
arg
, narg
, arg
, narg
, arg
);
printf (") \n%*s!= NULLPE", (level
+ 3) * 4, "");
if (yp2
-> yp_flags
& YP_TAG
&& !last
) {
printf ("\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
(level
+ 2) * 4, "", narg2
, narg2
);
printf ("%*s!= PE_ID (PE_CLASS_%s, %d))\n%*s%s = NULLPE;\n",
(level
+ 4) * 4, "", pe_classlist
[yt
-> yt_class
],
val2int (yt
-> yt_value
), (level
+ 1) * 4, "", narg2
);
y
-> yp_type
= copy_type (yp2
); /* XXX */
y
-> yp_type
-> yp_next
= NULLYP
;
choice_pullup (y
, CH_FULLY
); /* XXX */
for (y
= y
-> yp_type
; y
; y
= y
-> yp_next
) {
if (!(y
-> yp_flags
& YP_TAG
))
printf ("\n%*s&& PE_ID (%s -> pe_class, %s -> pe_id)\n",
(level
+ 2) * 4, "", narg2
, narg2
);
printf ("%*s!= PE_ID (PE_CLASS_%s, %d)",
pe_classlist
[y
-> yp_tag
-> yt_class
],
val2int (y
-> yp_tag
-> yt_value
));
printf (")\n%*s%s = NULLPE;\n", (level
+ 1) * 4, "", narg2
);
printf ("%*sif (%s != NULLPE", level
* 4, "", narg2
);
printf ("%*sif ((%s = ", level
* 4, "", narg2
);
printf ("first_member (%s)", arg
);
printf ("(%s != %s ? next_member (%s, %s) : first_member (%s))",
arg
, narg
, arg
, narg
, arg
);
printf (") {\n%*s%s = %s;\n\n", (level
+ 1) * 4, "", narg
, narg2
);
if (yp
-> yp_code
!= YP_CHOICE
&& (yp
-> yp_flags
& YP_TAG
)) {
if ((yp
-> yp_flags
& YP_IMPLICIT
) == 0 ||
is_nonimplicit_type (yp
))
tag_pullup (yp
, level
, narg2
, "element");
printf ("%*s{", level
* 4, "");
if (yp
-> yp_flags
& YP_ID
)
printf ("\t/* %s */", yp
-> yp_id
);
undo_type (yp
, level
, yp
-> yp_flags
& YP_ID
? yp
-> yp_id
: "element",
printf ("%*s}\n", level
* 4, "");
printf ("%*s}\n", level
* 4, "");
if ((yp
-> yp_flags
& YP_DEFAULT
) || !(yp
-> yp_flags
& YP_OPTIONAL
)) {
printf ("%*selse {\n", level
* 4, "");
if (yp
-> yp_flags
& YP_DEFAULT
)
printf ("%*s/* set default here using yp -> yp_default */\n",
printf ("%*sadvise (NULLCP, \"%s %%s",
(level
+ 1) * 4, "", id
);
if (yp
-> yp_flags
& YP_ID
)
printf ("%s ", yp
-> yp_id
);
printf ("element\", PEPY_ERR_MISSING);\n%*sreturn NOTOK;\n", (level
+ 1) * 4, "");
printf ("%*s}\n\n", level
* 4, "");
printf ("%*s}\n\n", level
* 4, "");
static undo_type_member (yp
, level
, arg
, narg
, Vflag
)
char *id
= yp
-> yp_flags
& YP_ID
? yp
-> yp_id
: "member";
if (!(yp
-> yp_flags
& YP_TAG
)) {
if (lookup_tag (yp
) == NULLYT
)
if (yp
-> yp_flags
& YP_TAG
)
printf ("%*sif (%s = set_find (%s, PE_CLASS_%s, %d)) {\n",
level
* 4, "", narg
, arg
,
pe_classlist
[yp
-> yp_tag
-> yt_class
],
val2int (yp
-> yp_tag
-> yt_value
));
y
-> yp_type
= copy_type(yp
); /* XXXX !!! */
y
-> yp_type
-> yp_next
= NULLYP
;
choice_pullup (y
, CH_FULLY
);
/* this is dependant on choice_pullup coding... */
if (!(y
-> yp_flags
& YP_TAG
))
printf ("%*sif ( (%s = set_find (%s, PE_CLASS_%s, %d))",
level
* 4, "", narg
, arg
,
pe_classlist
[y
->yp_tag
->yt_class
],
val2int (y
-> yp_tag
-> yt_value
));
for (y
= y
-> yp_next
; y
; y
= y
-> yp_next
) {
if (!(y
-> yp_flags
& YP_TAG
))
printf ("\n%*s|| (%s = set_find (%s, PE_CLASS_%s, %d))",
(level
+ 1) * 4, "", narg
, arg
,
pe_classlist
[y
-> yp_tag
-> yt_class
],
val2int (y
-> yp_tag
-> yt_value
));
if (yp
-> yp_flags
& YP_TAG
) {
if ((yp
-> yp_flags
& YP_IMPLICIT
) == 0 ||
is_nonimplicit_type (yp
))
printf ("%*sregister PE %s = %s;\n\n", level
* 4, "",
narg2
= gensym (), narg
);
tag_pullup (yp
, level
, narg2
, id
);
printf ("%*s{\n", level
* 4, "");
yp
-> yp_flags
|= YP_PULLEDUP
;
undo_type (yp
, level
, id
, narg2
, Vflag
);
printf ("%*s}\n", level
* 4, "");
printf ("%*s%s_count ++;\n", level
* 4, "", narg
);
printf ("%*s}\n", level
* 4, "");
if ((yp
-> yp_flags
& YP_DEFAULT
) || !(yp
-> yp_flags
& YP_OPTIONAL
)) {
printf ("%*selse {\n", level
* 4, "");
if (yp
-> yp_flags
& YP_DEFAULT
)
printf ("%*s/* set default here using yp -> yp_default */\n",
printf ("%*sadvise (NULLCP, \"%s %%s ",
(level
+ 1) * 4, "", id
);
if (yp
-> yp_flags
& YP_ID
)
printf ("%s ", yp
-> yp_id
);
printf ("member\", PEPY_ERR_MISSING);\n%*sreturn NOTOK;\n", (level
+ 1) * 4, "");
printf ("%*s}\n\n", level
* 4, "");
static int undo_type_choice (yp
, level
, narg
, Vflag
)
char *id
= yp
-> yp_flags
& YP_ID
? yp
-> yp_id
: "member";
printf ("%*sdefault:", level
* 4, "");
else if (!(yp
-> yp_flags
& YP_TAG
) && yp
->yp_code
== YP_IDEFINED
) {
y
-> yp_type
= copy_type(yp
); /* XXXX !!! */
y
-> yp_type
-> yp_next
= NULL
;
choice_pullup (y
, CH_FULLY
);
/* this is dependant on choice_pullup coding..*/
for (y
= y
-> yp_type
; y
; y
= y
-> yp_next
) {
printf ("%*sdefault:%s", level
* 4, "",
y
-> yp_next
? "\n" : "");
if (!(y
-> yp_flags
& YP_TAG
))
printf("%*scase PE_ID (PE_CLASS_%s, %d):%s", level
* 4, "",
pe_classlist
[y
-> yp_tag
-> yt_class
],
val2int (y
-> yp_tag
-> yt_value
),
y
-> yp_next
? "\n" : "");
if (!(yp
-> yp_flags
& YP_TAG
))
printf ("%*scase PE_ID (PE_CLASS_%s, %d):", level
* 4, "",
pe_classlist
[yp
-> yp_tag
-> yt_class
],
val2int (yp
-> yp_tag
-> yt_value
));
if (yp
-> yp_flags
& YP_ID
)
printf ("\t/* %s */", yp
-> yp_id
);
printf ("%*s{\n", level
* 4, "");
if (yp
-> yp_flags
& YP_TAG
) {
if ((yp
-> yp_flags
& YP_IMPLICIT
) == 0 ||
is_nonimplicit_type (yp
))
printf ("%*sregister PE %s = %s;\n\n", level
* 4, "",
narg2
= gensym (), narg
);
tag_pullup (yp
, level
, narg2
, id
);
printf ("%*s{\n", level
* 4, "");
yp
-> yp_flags
|= YP_PULLEDUP
;
undo_type (yp
, level
, id
, narg2
, Vflag
);
printf ("%*s}\n", level
* 4, "");
printf ("%*s}\n%*sbreak;\n", level
* 4, "", level
* 4, "");
static undo_components_seq (yp
, level
, first
, last
, id
, arg
, narg
, Vflag
)
register int level
, first
, last
;
pyyerror (yp
, "Can't do COMPONENTS OF with external types for %s",
if (!(newyp
= lookup_type (yp
->yp_module
, yp
-> yp_identifier
))) {
pyyerror (yp
, "Can't find referenced COMPONENTS OF %s",
for (y
= newyp
-> yp_type
; y
; y
= y
-> yp_next
) {
if (y
-> yp_flags
& YP_COMPONENTS
)
i
+= undo_components_seq (y
, level
, first
&& y
== yp
-> yp_type
,
last
&& y
-> yp_next
== NULLYP
,
undo_type_element (y
, level
, first
&& y
== newyp
-> yp_type
,
last
&& y
-> yp_next
== NULLYP
, id
,
static undo_components_set (yp
, level
, arg
, narg
, Vflag
)
pyyerror (yp
, "Can't do COMPONENTS OF with external types for %s",
if (!(newyp
= lookup_type (yp
->yp_module
, yp
-> yp_identifier
))) {
pyyerror (yp
, "Can't find referenced COMPONENTS OF %s",
if (newyp
-> yp_code
!= YP_SETLIST
) {
yyerror_aux ("COMPONENTS OF type is not a SET");
choice_pullup (newyp
, CH_PARTIAL
);
for (y
= newyp
-> yp_type
; y
; y
= y
->yp_next
)
if (y
-> yp_flags
& YP_COMPONENTS
)
undo_components_set (y
, level
, arg
, narg
, Vflag
);
undo_type_member (y
, level
, arg
, narg
, Vflag
);
choice_pullup (newyp
, CH_FULLY
);