va_dcl #else Symbol_t* Symbol(Msg_t msg, ...) #endif { char blank[64]; String_t* image; size_t indent; Symbol_t* obj; va_init(ap, msg, obj); if (!obj) return NULL; switch (msg) { case _Init: return (Symbol_t*) Obj(_Init, obj, Symbol); case _Image: image = va_arg(ap, String_t*); if ((indent = va_arg(ap, size_t)) >= sizeof(blank)) return NULL; if (indent > 0) memset(blank, ' ', indent); blank[indent] = 0; return (Symbol_t*) String(_Cat, image, blank, "'", Val(obj), "'", 0); default: return (Symbol_t*) String(_Relay, msg, obj, ap); } }
va_dcl #else Seq_t* Seq (Msg_t msg, ...) #endif { int i; size_t indent; String_t* image; Obj_t** elem; char blank[32]; Seq_t* obj; va_init(ap, msg, obj); if (!obj) return NULL; switch (msg) { case _Init: return (Seq_t*) Obj(_Init, obj, Seq); case _Image: image = va_arg(ap, String_t*); if ((indent = va_arg(ap, size_t)) >= sizeof(blank)) return NULL; if (indent > 0) memset(blank, ' ', indent); blank[indent] = 0; if (! String(_Cat, image, blank, "(", 0)) return NULL; i = 0; elem = (Obj_t**) Val(obj); while (elem[i] != NULL) if (! Image(elem[i], image, 0) || ! String(_Cat, image, !elem[++i] ? ")" : (i%5?", ":",\n"), 0)) return NULL; return (Seq_t*) image; default: return (Seq_t*) Array(_Relay, msg, obj, ap); } }
va_dcl #else Object_t* Object (Msg_t msg, ...) #endif { char blank[64]; size_t indent; String_t* image; Object_t* obj; va_init(ap, msg, obj); if (!obj) return NULL; switch (msg) { case _Init: #ifdef DEBUG printf(" [Object] "); #endif return (Object_t*) Obj(_Init, obj, Object); case _Find: return (Object_t*) Relay(_Find, Value(obj), ap); case _Image: image = va_arg(ap, String_t*); if ((indent = va_arg(ap, size_t)) >= sizeof(blank)) return NULL; if (indent > 0) memset(blank, ' ', indent); blank[indent] = 0; if (! String(_Cat, image, blank, "OBJECT = ", Name(obj), "\n", 0) || ! String(_Cat, Image(Value(obj), image, indent+2), blank, "END_OBJECT = ", Name(obj), "\n", 0)) return NULL; return (Object_t*) image; default: return (Object_t*) Label(_Relay, msg, obj, ap); } }
void error(char *fmt, ...) { #else void error(fmt, va_alist) char *fmt; va_dcl { #endif va_list ap; va_init(ap, fmt); if (firstfile != file && firstfile && *firstfile) fprint(2, "%s: ", firstfile); /* omit */ fprint(2, "%w: ", &src); vfprint(2, fmt, ap); if (++errcnt >= errlimit) { errcnt = -1; error("too many errors\n"); exit(1); } va_end(ap); } /* expect - advance if t is tok, otherwise issue message */ int expect(tok) { if (t == tok) { t = gettok(); return t; } errcnt--; error("syntax error; found"); printtoken(); fprint(2, " expecting `%k'\n", tok); return 0; } /* fatal - issue fatal error message and exit */ int fatal(name, fmt, n) char *name, *fmt; { *bp++ = '\n'; outflush(); error("compiler error in %s--", name); fprint(2, fmt, n); exit(1); return 0; } /* printtoken - print current token preceeded by a space */ static void printtoken() { switch (t) { case ID: fprint(2, " `%s'", token); break; case ICON: if (*token == '\'') { char *s; case SCON: fprint(2, " "); for (s = token; *s && s - token < 20; s++) if (*s < ' ' || *s >= 0177) fprint(2, "\\%o", *s); else fprint(2, "%c", *s); if (*s) fprint(2, " ..."); else fprint(2, "%c", *token); break; } /* else fall thru */ case FCON: { char c = *cp; *cp = 0; fprint(2, " `%s'", token); *cp = c; break; } case '`': case '\'': fprint(2, " \"%k\"", t); break; default: fprint(2, " `%k'", t); } } /* skipto - skip input up to tok U set, for a token where kind[t] is in set */ void skipto(tok, set) char set[]; { int n; char *s; for (n = 0; t != EOI && t != tok; t = gettok()) { if (set) { for (s = set; *s && kind[t] != *s; s++) ; if (kind[t] == *s) break; } if (n++ == 0) { errcnt--; error("skipping", 0, 0, 0, 0); } if (n <= 8) printtoken(); else if (n == 9) fprint(2, " ...\n"); } if (n > 8) { errcnt--; error("up to", 0, 0, 0, 0); printtoken(); } if (n > 0) fprint(2, "\n"); } /* test - check for token tok, skip to tok U set, if necessary */ void test(tok, set) char set[]; { if (t == tok) t = gettok(); else { expect(tok); skipto(tok, set); if (t == tok) t = gettok(); } } /* warning - issue warning error message */ #ifdef __STDC__ void warning(char *fmt, ...) { #else void warning(fmt, va_alist) char *fmt; va_dcl { #endif va_list ap; va_init(ap, fmt); if (wflag == 0) { errcnt--; /* compensate for increment in error */ error("warning: "); vfprint(2, fmt, ap); } va_end(ap); }
va_dcl #else UnsignedInt_t* UnsignedInt (Msg_t msg, ...) #endif { char blank[64], buf[16]; String_t* image; size_t indent; UnsignedInt_t* obj; va_init(ap, msg, obj); if (!obj) return NULL; switch (msg) { case _Init: Obj(_Init, obj, UnsignedInt); obj->vlast = -1; obj->value = 0; obj->unit = 0; return String(_Relay, _Init, &obj->image, ap) ? obj : NULL; case _Destroy: Destroy(&obj->image); if (obj->unit) { Destroy(obj->unit); free(obj->unit); obj->unit = 0; } return NULL; case _SetVal: obj->value = va_arg(ap, unsigned int); obj->vlast = 1; return obj; case _Val: if (obj->vlast < 0) { if (sscanf(Val(&obj->image), "%u", &obj->value) != 1) return NULL; obj->vlast = 0; } return (UnsignedInt_t*) &obj->value; case _Unit_of: return (UnsignedInt_t*) Val(obj->unit); case _SetUnit: return (obj->unit = va_arg(ap, Unit_t*), obj); case _Image: image = va_arg(ap, String_t*); if ((indent = va_arg(ap, size_t)) >= sizeof(blank)) return NULL; if (indent > 0) memset(blank, ' ', indent); blank[indent] = 0; if (obj->vlast > 0) { sprintf(buf, "%u", obj->value); if (! SetVal(&obj->image, buf)) return NULL; obj->vlast = 0; } return (UnsignedInt_t*) String(_Cat, image, blank, Val(&obj->image), 0); default: return NULL; } }