xref: /original-bsd/usr.bin/pascal/pxp/rmothers.c (revision c3e32dec)
1 /*-
2  * Copyright (c) 1980, 1993
3  *	The Regents of the University of California.  All rights reserved.
4  *
5  * %sccs.include.redist.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)rmothers.c	8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11 
12 #ifdef RMOTHERS
13     /* and the rest of the file */
14 
15 #include "0.h"
16 #include "tree.h"
17 
18     /*
19      *	translate extended case statements to pascal (for tex).
20      *	don knuth should know better.  enough said.
21      *		... peter 5/4/83
22      *
23      *	extended case statements have the form:
24      *	    case expresion of
25      *		label1,label2,...: statement1;
26      *		...
27      *		others: otherstatement
28      *		end
29      *	which i am going to translate to:
30      *	    if expression in [ label1,label2,...] then
31      *		case expression of
32      *		    label1,label2,...: statement1;
33      *		    ...
34      *		    end
35      *	    else otherstatement
36      *	which has the effect that the expression will be evaluated twice.
37      *	i've looked very briefly at all cases in tex and
38      *	they seem to be variables or pure functions.
39      *	for simplicity i'm assuming that the others is the last labeled
40      *	statement, and that no other labels appear with the label others.
41      *	this appears correct from the tex82 documentation.
42      */
43 
44     /*
45      *	given a case statement tree and the address of an others pointer,
46      *	amputate the others statement from the case statement tree
47      *	and hang it on the the others pointer.
48      *
49      *	Case statement
50      *	r	[0]	T_CASE
51      *		[1]	lineof "case"
52      *		[2]	expression
53      *		[3]	list of cased statements:
54      *			cstat	[0]	T_CSTAT
55      *				[1]	lineof ":"
56      *				[2]	list of constant labels
57      *				[3]	statement
58      */
59 needscaseguard(r, otherspp)
60     int	*r;
61     int	**otherspp;
62 {
63     int	*statlistp;
64     int	*cutpointer;
65     int	*lstatementp;
66     int	*lablistp;
67     int	*label;
68     int	hasothers;
69 
70     *otherspp = NIL;
71     hasothers = 0;
72     if (!rmothers) {
73 	return hasothers;
74     }
75     for (cutpointer = &r[3], statlistp = r[3];
76 	 statlistp != NIL;
77 	 cutpointer = &statlistp[2], statlistp = statlistp[2]) {
78 	lstatementp = statlistp[1];
79 	if (lstatementp == NIL)
80 	    continue;
81 	lablistp = lstatementp[2];
82 	if (lablistp != NIL) {
83 	    label = lablistp[1];
84 		/* only look at the first label */
85 	    if (label != NIL &&
86 		label[0] == T_ID && !strcmp(label[1],"others")) {
87 		    hasothers = 1;
88 		    *otherspp = lstatementp[3];
89 		    *cutpointer = NIL;
90 		    if (statlistp[2] != NIL) {
91 			panic("others not last case");
92 		    }
93 		    if (lablistp[2] != NIL) {
94 			panic("others not only case label");
95 		    }
96 	    }
97 	}
98     }
99     return hasothers;
100 }
101 
102 precaseguard(r)
103     int	*r;
104 {
105     int	*statlistp;
106     int	*cutpointer;
107     int	*lstatementp;
108     int	*lablistp;
109     int	*label;
110     int	hadsome;
111     int	counter;
112 
113     if (!rmothers) {
114 	return;
115     }
116     ppkw("if");
117     ppspac();
118     rvalue(r[2], NIL);
119     ppspac();
120     ppkw("in");
121     ppgoin(DECL);
122     ppnl();
123     indent();
124     ppsep("[");
125     hadsome = 0;
126     counter = 0;
127     for (statlistp = r[3]; statlistp != NIL; statlistp = statlistp[2]) {
128 	lstatementp = statlistp[1];
129 	if (lstatementp == NIL)
130 	    continue;
131 	for (lablistp = lstatementp[2];lablistp != NIL;lablistp = lablistp[2]) {
132 	    label = lablistp[1];
133 	    if (hadsome) {
134 		if (counter < 8) {
135 		    ppsep(", ");
136 		} else {
137 		    ppsep(",");
138 		    ppnl();
139 		    indent();
140 		    ppspac();
141 		    counter = 0;
142 		}
143 	    } else {
144 		hadsome = 1;
145 	    }
146 	    gconst(label);
147 	    counter += 1;
148 	}
149     }
150     ppsep("]");
151     ppspac();
152     ppkw("then");
153     ppgoout(DECL);
154     ppgoin(STAT);
155     ppnl();
156     indent();
157 }
158 
159     /*
160      *	given an others statement, hang it on the else branch of the guard.
161      */
162 postcaseguard(othersp)
163     int	*othersp;
164 {
165     if (!rmothers) {
166 	return;
167     }
168     ppgoout(STAT);
169     ppnl();
170     indent();
171     ppkw("else");
172     ppgoin(STAT);
173     if (othersp == NIL) {
174 	    /*
175 	     *	this will print a call to the routine ``null''.
176 	     *	but it has to be checked first, or we will indirect through
177 	     *	NIL to check the statement type.
178 	     */
179 	statement(NIL);
180 	ppgoout(STAT);
181 	return;
182     }
183     if (othersp[0] == T_BLOCK) {
184 	ppnl();
185 	indent();
186 	ppstbl1(othersp, STAT);
187 	ppstbl2();
188     } else {
189 	statement(othersp);
190     }
191     ppgoout(STAT);
192 }
193 #endif RMOTHERS
194