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;
}
}
