1 /* 2 * Copyright (c) 1983 The Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.redist.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)check.c 5.4 (Berkeley) 06/01/90"; 10 #endif /* not lint */ 11 12 /* 13 * Check a tree for semantic correctness. 14 */ 15 16 #include "defs.h" 17 #include "tree.h" 18 #include "operators.h" 19 #include "events.h" 20 #include "symbols.h" 21 #include "scanner.h" 22 #include "source.h" 23 #include "object.h" 24 #include "mappings.h" 25 #include "process.h" 26 #include <signal.h> 27 28 #ifndef public 29 #endif 30 31 /* 32 * Check that the nodes in a tree have the correct arguments 33 * in order to be evaluated. Basically the error checking here 34 * frees the evaluation routines from worrying about anything 35 * except dynamic errors, e.g. subscript out of range. 36 */ 37 38 public check(p) 39 register Node p; 40 { 41 Node p1, p2; 42 Address addr; 43 Symbol f; 44 45 checkref(p); 46 switch (p->op) { 47 case O_ASSIGN: 48 p1 = p->value.arg[0]; 49 p2 = p->value.arg[1]; 50 if (varIsSet("$unsafeassign")) { 51 if (size(p1->nodetype) != size(p2->nodetype)) { 52 error("incompatible sizes"); 53 } 54 } else if (not compatible(p1->nodetype, p2->nodetype)) { 55 error("incompatible types"); 56 } 57 break; 58 59 case O_CATCH: 60 case O_IGNORE: 61 if (p->value.lcon < 0 or p->value.lcon > NSIG) { 62 error("invalid signal number"); 63 } 64 break; 65 66 case O_CONT: 67 if (p->value.lcon != DEFSIG and ( 68 p->value.lcon < 0 or p->value.lcon > NSIG) 69 ) { 70 error("invalid signal number"); 71 } 72 break; 73 74 case O_DUMP: 75 if (p->value.arg[0] != nil) { 76 if (p->value.arg[0]->op == O_SYM) { 77 f = p->value.arg[0]->value.sym; 78 if (not isblock(f)) { 79 error("\"%s\" is not a block", symname(f)); 80 } 81 } else { 82 beginerrmsg(); 83 fprintf(stderr, "expected a symbol, found \""); 84 prtree(stderr, p->value.arg[0]); 85 fprintf(stderr, "\""); 86 enderrmsg(); 87 } 88 } 89 break; 90 91 case O_LIST: 92 if (p->value.arg[0]->op == O_SYM) { 93 f = p->value.arg[0]->value.sym; 94 if (not isblock(f) or ismodule(f)) { 95 error("\"%s\" is not a procedure or function", symname(f)); 96 } 97 addr = firstline(f); 98 if (addr == NOADDR) { 99 error("\"%s\" is empty", symname(f)); 100 } 101 } 102 break; 103 104 case O_TRACE: 105 case O_TRACEI: 106 chktrace(p); 107 break; 108 109 case O_STOP: 110 case O_STOPI: 111 chkstop(p); 112 break; 113 114 case O_CALLPROC: 115 case O_CALL: 116 if (not isroutine(p->value.arg[0]->nodetype)) { 117 beginerrmsg(); 118 fprintf(stderr, "\""); 119 prtree(stderr, p->value.arg[0]); 120 fprintf(stderr, "\" not call-able"); 121 enderrmsg(); 122 } 123 break; 124 125 case O_WHEREIS: 126 if (p->value.arg[0]->op == O_SYM and 127 p->value.arg[0]->value.sym == nil) { 128 error("symbol not defined"); 129 } 130 break; 131 132 default: 133 break; 134 } 135 } 136 137 /* 138 * Check arguments to a trace command. 139 */ 140 141 private chktrace(p) 142 Node p; 143 { 144 Node exp, place, cond; 145 146 exp = p->value.arg[0]; 147 place = p->value.arg[1]; 148 cond = p->value.arg[2]; 149 if (exp == nil) { 150 chkblock(place); 151 } else if (exp->op == O_LCON or exp->op == O_QLINE) { 152 if (place != nil) { 153 error("unexpected \"at\" or \"in\""); 154 } 155 if (p->op == O_TRACE) { 156 chkline(exp); 157 } else { 158 chkaddr(exp); 159 } 160 } else if (place != nil and (place->op == O_QLINE or place->op == O_LCON)) { 161 if (p->op == O_TRACE) { 162 chkline(place); 163 } else { 164 chkaddr(place); 165 } 166 } else { 167 if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_CALL) { 168 error("can't trace expressions"); 169 } 170 chkblock(place); 171 } 172 } 173 174 /* 175 * Check arguments to a stop command. 176 */ 177 178 private chkstop(p) 179 Node p; 180 { 181 Node exp, place, cond; 182 183 exp = p->value.arg[0]; 184 place = p->value.arg[1]; 185 cond = p->value.arg[2]; 186 if (exp != nil) { 187 if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_LCON) { 188 beginerrmsg(); 189 fprintf(stderr, "expected variable, found "); 190 prtree(stderr, exp); 191 enderrmsg(); 192 } 193 chkblock(place); 194 } else if (place != nil) { 195 if (place->op == O_SYM) { 196 chkblock(place); 197 } else { 198 if (p->op == O_STOP) { 199 chkline(place); 200 } else { 201 chkaddr(place); 202 } 203 } 204 } 205 } 206 207 /* 208 * Check to see that the given node specifies some subprogram. 209 * Nil is ok since that means the entire program. 210 */ 211 212 private chkblock(b) 213 Node b; 214 { 215 Symbol p, outer; 216 217 if (b != nil) { 218 if (b->op != O_SYM) { 219 beginerrmsg(); 220 fprintf(stderr, "expected subprogram, found "); 221 prtree(stderr, b); 222 enderrmsg(); 223 } else if (ismodule(b->value.sym)) { 224 outer = b->value.sym; 225 while (outer != nil) { 226 find(p, outer->name) where p->block == outer endfind(p); 227 if (p == nil) { 228 outer = nil; 229 error("\"%s\" is not a subprogram", symname(b->value.sym)); 230 } else if (ismodule(p)) { 231 outer = p; 232 } else { 233 outer = nil; 234 b->value.sym = p; 235 } 236 } 237 } else if ( 238 b->value.sym->class == VAR and 239 b->value.sym->name == b->value.sym->block->name and 240 b->value.sym->block->class == FUNC 241 ) { 242 b->value.sym = b->value.sym->block; 243 } else if (not isblock(b->value.sym)) { 244 error("\"%s\" is not a subprogram", symname(b->value.sym)); 245 } 246 } 247 } 248 249 /* 250 * Check to make sure a node corresponds to a source line. 251 */ 252 253 private chkline(p) 254 Node p; 255 { 256 if (p == nil) { 257 error("missing line"); 258 } else if (p->op != O_QLINE and p->op != O_LCON) { 259 error("expected source line number, found \"%t\"", p); 260 } 261 } 262 263 /* 264 * Check to make sure a node corresponds to an address. 265 */ 266 267 private chkaddr(p) 268 Node p; 269 { 270 if (p == nil) { 271 error("missing address"); 272 } else if (p->op != O_LCON and p->op != O_QLINE) { 273 beginerrmsg(); 274 fprintf(stderr, "expected address, found \""); 275 prtree(stderr, p); 276 fprintf(stderr, "\""); 277 enderrmsg(); 278 } 279 } 280