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