19660Slinton /* Copyright (c) 1982 Regents of the University of California */ 29660Slinton 3*18214Slinton static char sccsid[] = "@(#)check.c 1.7 (Berkeley) 03/01/85"; 49660Slinton 5*18214Slinton static char rcsid[] = "$Header: check.c,v 1.5 84/12/26 10:38:35 linton Exp $"; 6*18214Slinton 79660Slinton /* 89660Slinton * Check a tree for semantic correctness. 99660Slinton */ 109660Slinton 119660Slinton #include "defs.h" 129660Slinton #include "tree.h" 139660Slinton #include "operators.h" 149660Slinton #include "events.h" 159660Slinton #include "symbols.h" 169660Slinton #include "scanner.h" 179660Slinton #include "source.h" 189660Slinton #include "object.h" 199660Slinton #include "mappings.h" 209660Slinton #include "process.h" 21*18214Slinton #include <signal.h> 229660Slinton 239660Slinton #ifndef public 249660Slinton #endif 259660Slinton 269660Slinton /* 279660Slinton * Check that the nodes in a tree have the correct arguments 289660Slinton * in order to be evaluated. Basically the error checking here 299660Slinton * frees the evaluation routines from worrying about anything 309660Slinton * except dynamic errors, e.g. subscript out of range. 319660Slinton */ 329660Slinton 339660Slinton public check(p) 349660Slinton register Node p; 359660Slinton { 36*18214Slinton Node p1, p2; 379660Slinton Address addr; 389660Slinton Symbol f; 399660Slinton 409660Slinton checkref(p); 419660Slinton switch (p->op) { 42*18214Slinton case O_ASSIGN: 43*18214Slinton p1 = p->value.arg[0]; 44*18214Slinton p2 = p->value.arg[1]; 45*18214Slinton if (not compatible(p1->nodetype, p2->nodetype)) { 46*18214Slinton error("incompatible types"); 47*18214Slinton } 48*18214Slinton break; 49*18214Slinton 50*18214Slinton case O_CATCH: 51*18214Slinton case O_IGNORE: 52*18214Slinton if (p->value.lcon < 0 or p->value.lcon > NSIG) { 53*18214Slinton error("invalid signal number"); 54*18214Slinton } 55*18214Slinton break; 56*18214Slinton 57*18214Slinton case O_CONT: 58*18214Slinton if (p->value.lcon != DEFSIG and ( 59*18214Slinton p->value.lcon < 0 or p->value.lcon > NSIG) 60*18214Slinton ) { 61*18214Slinton error("invalid signal number"); 62*18214Slinton } 63*18214Slinton break; 64*18214Slinton 65*18214Slinton case O_DUMP: 66*18214Slinton if (p->value.arg[0] != nil) { 67*18214Slinton if (p->value.arg[0]->op == O_SYM) { 68*18214Slinton f = p->value.arg[0]->value.sym; 69*18214Slinton if (not isblock(f)) { 70*18214Slinton error("\"%s\" is not a block", symname(f)); 71*18214Slinton } 72*18214Slinton } else { 73*18214Slinton beginerrmsg(); 74*18214Slinton fprintf(stderr, "expected a symbol, found \""); 75*18214Slinton prtree(stderr, p->value.arg[0]); 76*18214Slinton fprintf(stderr, "\""); 77*18214Slinton enderrmsg(); 78*18214Slinton } 79*18214Slinton } 80*18214Slinton break; 81*18214Slinton 829660Slinton case O_LIST: 839660Slinton if (p->value.arg[0]->op == O_SYM) { 849660Slinton f = p->value.arg[0]->value.sym; 859660Slinton if (not isblock(f) or ismodule(f)) { 869660Slinton error("\"%s\" is not a procedure or function", symname(f)); 879660Slinton } 889660Slinton addr = firstline(f); 899660Slinton if (addr == NOADDR) { 909660Slinton error("\"%s\" is empty", symname(f)); 919660Slinton } 929660Slinton } 939660Slinton break; 949660Slinton 959660Slinton case O_TRACE: 969660Slinton case O_TRACEI: 979660Slinton chktrace(p); 989660Slinton break; 999660Slinton 1009660Slinton case O_STOP: 1019660Slinton case O_STOPI: 1029660Slinton chkstop(p); 1039660Slinton break; 1049660Slinton 105*18214Slinton case O_CALLPROC: 10616607Ssam case O_CALL: 10716607Ssam if (not isroutine(p->value.arg[0]->nodetype)) { 10816607Ssam beginerrmsg(); 10916607Ssam fprintf(stderr, "\""); 11016607Ssam prtree(stderr, p->value.arg[0]); 11116607Ssam fprintf(stderr, "\" not call-able"); 11216607Ssam enderrmsg(); 11316607Ssam } 11416607Ssam break; 11516607Ssam 116*18214Slinton case O_WHEREIS: 117*18214Slinton if (p->value.arg[0]->op == O_SYM and 118*18214Slinton p->value.arg[0]->value.sym == nil) { 119*18214Slinton error("symbol not defined"); 120*18214Slinton } 121*18214Slinton break; 122*18214Slinton 1239660Slinton default: 1249660Slinton break; 1259660Slinton } 1269660Slinton } 1279660Slinton 1289660Slinton /* 1299660Slinton * Check arguments to a trace command. 1309660Slinton */ 1319660Slinton 1329660Slinton private chktrace(p) 1339660Slinton Node p; 1349660Slinton { 1359660Slinton Node exp, place, cond; 1369660Slinton 1379660Slinton exp = p->value.arg[0]; 1389660Slinton place = p->value.arg[1]; 1399660Slinton cond = p->value.arg[2]; 1409660Slinton if (exp == nil) { 1419660Slinton chkblock(place); 1429660Slinton } else if (exp->op == O_LCON or exp->op == O_QLINE) { 1439660Slinton if (place != nil) { 1449660Slinton error("unexpected \"at\" or \"in\""); 1459660Slinton } 1469660Slinton if (p->op == O_TRACE) { 1479660Slinton chkline(exp); 1489660Slinton } else { 1499660Slinton chkaddr(exp); 1509660Slinton } 1519660Slinton } else if (place != nil and (place->op == O_QLINE or place->op == O_LCON)) { 1529660Slinton if (p->op == O_TRACE) { 1539660Slinton chkline(place); 1549660Slinton } else { 1559660Slinton chkaddr(place); 1569660Slinton } 1579660Slinton } else { 1589861Slinton if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_CALL) { 1599660Slinton error("can't trace expressions"); 1609660Slinton } 1619660Slinton chkblock(place); 1629660Slinton } 1639660Slinton } 1649660Slinton 1659660Slinton /* 1669660Slinton * Check arguments to a stop command. 1679660Slinton */ 1689660Slinton 1699660Slinton private chkstop(p) 1709660Slinton Node p; 1719660Slinton { 1729660Slinton Node exp, place, cond; 1739660Slinton 1749660Slinton exp = p->value.arg[0]; 1759660Slinton place = p->value.arg[1]; 1769660Slinton cond = p->value.arg[2]; 1779660Slinton if (exp != nil) { 17814444Slinton if (exp->op != O_RVAL and exp->op != O_SYM and exp->op != O_LCON) { 1799660Slinton beginerrmsg(); 1809660Slinton fprintf(stderr, "expected variable, found "); 1819660Slinton prtree(stderr, exp); 1829660Slinton enderrmsg(); 1839660Slinton } 1849660Slinton chkblock(place); 18516607Ssam } else if (place != nil) { 18616607Ssam if (place->op == O_SYM) { 18716607Ssam chkblock(place); 1889660Slinton } else { 18916607Ssam if (p->op == O_STOP) { 19016607Ssam chkline(place); 19116607Ssam } else { 19216607Ssam chkaddr(place); 19316607Ssam } 1949660Slinton } 1959660Slinton } 1969660Slinton } 1979660Slinton 1989660Slinton /* 1999660Slinton * Check to see that the given node specifies some subprogram. 2009660Slinton * Nil is ok since that means the entire program. 2019660Slinton */ 2029660Slinton 2039660Slinton private chkblock(b) 2049660Slinton Node b; 2059660Slinton { 20616607Ssam Symbol p, outer; 20716607Ssam 2089660Slinton if (b != nil) { 2099660Slinton if (b->op != O_SYM) { 2109660Slinton beginerrmsg(); 2119660Slinton fprintf(stderr, "expected subprogram, found "); 2129660Slinton prtree(stderr, b); 2139660Slinton enderrmsg(); 21416607Ssam } else if (ismodule(b->value.sym)) { 21516607Ssam outer = b->value.sym; 21616607Ssam while (outer != nil) { 21716607Ssam find(p, outer->name) where p->block == outer endfind(p); 21816607Ssam if (p == nil) { 21916607Ssam outer = nil; 22016607Ssam error("\"%s\" is not a subprogram", symname(b->value.sym)); 22116607Ssam } else if (ismodule(p)) { 22216607Ssam outer = p; 22316607Ssam } else { 22416607Ssam outer = nil; 22516607Ssam b->value.sym = p; 22616607Ssam } 22716607Ssam } 228*18214Slinton } else if ( 229*18214Slinton b->value.sym->class == VAR and 230*18214Slinton b->value.sym->name == b->value.sym->block->name and 231*18214Slinton b->value.sym->block->class == FUNC 232*18214Slinton ) { 233*18214Slinton b->value.sym = b->value.sym->block; 23416607Ssam } else if (not isblock(b->value.sym)) { 2359660Slinton error("\"%s\" is not a subprogram", symname(b->value.sym)); 2369660Slinton } 2379660Slinton } 2389660Slinton } 2399660Slinton 2409660Slinton /* 2419660Slinton * Check to make sure a node corresponds to a source line. 2429660Slinton */ 2439660Slinton 2449660Slinton private chkline(p) 2459660Slinton Node p; 2469660Slinton { 2479660Slinton if (p == nil) { 2489660Slinton error("missing line"); 2499660Slinton } else if (p->op != O_QLINE and p->op != O_LCON) { 2509660Slinton error("expected source line number, found \"%t\"", p); 2519660Slinton } 2529660Slinton } 2539660Slinton 2549660Slinton /* 2559660Slinton * Check to make sure a node corresponds to an address. 2569660Slinton */ 2579660Slinton 2589660Slinton private chkaddr(p) 2599660Slinton Node p; 2609660Slinton { 2619660Slinton if (p == nil) { 2629660Slinton error("missing address"); 2639660Slinton } else if (p->op != O_LCON and p->op != O_QLINE) { 2649660Slinton beginerrmsg(); 2659660Slinton fprintf(stderr, "expected address, found \""); 2669660Slinton prtree(stderr, p); 2679660Slinton fprintf(stderr, "\""); 2689660Slinton enderrmsg(); 2699660Slinton } 2709660Slinton } 271