date and time created 82/01/18 19:21:17 by linton

SCCS-vsn: usr.bin/pascal/pdx/sym/printdecl.c 1.1

diff --git a/usr/src/usr.bin/pascal/pdx/sym/printdecl.c b/usr/src/usr.bin/pascal/pdx/sym/printdecl.c
new file mode 100644 (file)
index 0000000..8e68f97
--- /dev/null
+++ b/usr/src/usr.bin/pascal/pdx/sym/printdecl.c
@@ -0,0 +1,257 @@
+/* Copyright (c) 1982 Regents of the University of California */
+
+static char sccsid[] = "@(#)printdecl.c 1.1 %G%";
+
+/*
+ * print out the type of a symbol
+ */
+
+#include "defs.h"
+#include "sym.h"
+#include "symtab.h"
+#include "tree.h"
+#include "btypes.h"
+#include "classes.h"
+#include "sym.rep"
+
+printdecl(s)
+SYM *s;
+{
+       register SYM *t;
+       BOOLEAN semicolon;
+
+       semicolon = TRUE;
+       switch(s->class) {
+               case CONST:
+                       if (s->type->class == SCAL) {
+                               printf("(enumeration constant, ord %ld)",
+                                       s->symvalue.iconval);
+                       } else {
+                               printf("const %s = ", s->symbol);
+                               if (s->type == t_real->type) {
+                                       printf("%g", s->symvalue.fconval);
+                               } else {
+                                       printf("%ld", s->symvalue.iconval);
+                               }
+                       }
+                       break;
+
+               case TYPE:
+                       printf("type %s = ", s->symbol);
+                       printtype(s, s->type);
+                       break;
+
+               case VAR:
+                       if (isparam(s)) {
+                               printf("(parameter) %s : ", s->symbol);
+                       } else {
+                               printf("var %s : ", s->symbol);
+                       }
+                       printtype(s, s->type);
+                       break;
+
+               case REF:
+                       printf("(var parameter) %s : ", s->symbol);
+                       printtype(s, s->type);
+                       break;
+
+               case RANGE:
+               case ARRAY:
+               case RECORD:
+               case VARNT:
+               case PTR:
+                       printtype(s, s);
+                       semicolon = FALSE;
+                       break;
+
+               case FVAR:
+                       printf("(function variable) %s : ", s->symbol);
+                       printtype(s, s->type);
+                       break;
+
+               case FIELD:
+                       printf("(field) %s : ", s->symbol);
+                       printtype(s, s->type);
+                       break;
+
+               case PROC:
+                       printf("procedure %s", s->symbol);
+                       listparams(s);
+                       break;
+
+               case PROG:
+                       printf("program %s", s->symbol);
+                       t = s->chain;
+                       if (t != NIL) {
+                               printf("(%s", t->symbol);
+                               for (t = t->chain; t != NIL; t = t->chain) {
+                                       printf(", %s", t->symbol);
+                               }
+                               printf(")");
+                       }
+                       break;
+
+               case FUNC:
+                       printf("function %s", s->symbol);
+                       listparams(s);
+                       printf(" : ");
+                       printtype(s, s->type);
+                       break;
+
+               default:
+                       error("class %s in printdecl", classname(s));
+       }
+       if (semicolon) {
+               putchar(';');
+       }
+       putchar('\n');
+}
+
+/*
+ * Recursive whiz-bang procedure to print the type portion
+ * of a declaration.  Doesn't work quite right for variant records.
+ *
+ * The symbol associated with the type is passed to allow
+ * searching for type names without getting "type blah = blah".
+ */
+
+LOCAL printtype(s, t)
+SYM *s;
+SYM *t;
+{
+       register SYM *tmp;
+
+       tmp = findtype(t);
+       if (tmp != NIL && tmp != s) {
+               printf("%s", tmp->symbol);
+               return;
+       }
+       switch(t->class) {
+               case VAR:
+               case CONST:
+               case FUNC:
+               case PROC:
+                       panic("printtype: class %s", classname(t));
+                       break;
+
+               case ARRAY:
+                       printf("array[");
+                       tmp = t->chain;
+                       for (;;) {
+                               printtype(tmp, tmp);
+                               tmp = tmp->chain;
+                               if (tmp == NIL) {
+                                       break;
+                               }
+                               printf(", ");
+                       }
+                       printf("] of ");
+                       printtype(t, t->type);
+                       break;
+
+               case RECORD:
+                       printf("record\n");
+                       if (t->chain != NIL) {
+                               printtype(t->chain, t->chain);
+                       }
+                       printf("end");
+                       break;
+
+               case FIELD:
+                       if (t->chain != NIL) {
+                               printtype(t->chain, t->chain);
+                       }
+                       printf("\t%s : ", t->symbol);
+                       printtype(t, t->type);
+                       printf(";\n");
+                       break;
+
+               case RANGE: {
+                       long r0, r1;
+
+                       r0 = t->symvalue.rangev.lower;
+                       r1 = t->symvalue.rangev.upper;
+                       if (t == t_char) {
+                               printf("'%c'..'%c'", (char) r0, (char) r1);
+                       } else {
+                               printf("%ld..%ld", r0, r1);
+                       }
+                       break;
+               }
+
+               case PTR:
+                       putchar('^');
+                       printtype(t, t->type);
+                       break;
+
+               case TYPE:
+                       if (t->symbol != NIL) {
+                               printf("%s", t->symbol);
+                       } else {
+                               printtype(t, t->type);
+                       }
+                       break;
+
+               case SCAL:
+                       printf("(");
+                       t = t->type->chain;
+                       if (t != NIL) {
+                               printf("%s", t->symbol);
+                               t = t->chain;
+                               while (t != NIL) {
+                                       printf(", %s", t->symbol);
+                                       t = t->chain;
+                               }
+                       } else {
+                               panic("empty enumeration");
+                       }
+                       printf(")");
+                       break;
+
+               default:
+                       printf("(class %d)", t->class);
+                       break;
+       }
+}
+
+/*
+ * List the parameters of a procedure or function.
+ * No attempt is made to combine like types.
+ */
+
+listparams(s)
+SYM *s;
+{
+       SYM *t;
+
+       if (s->chain != NIL) {
+               putchar('(');
+               for (t = s->chain; t != NIL; t = t->chain) {
+                       switch (t->class) {
+                               case REF:
+                                       printf("var ");
+                                       break;
+
+                               case FPROC:
+                                       printf("procedure ");
+                                       break;
+
+                               case FFUNC:
+                                       printf("function ");
+                                       break;
+
+                               case VAR:
+                                       break;
+
+                               default:
+                                       panic("unexpected class %d for parameter", t->class);
+                       }
+                       printf("%s : ", t->symbol);
+                       printtype(t, t->type);
+                       if (t->chain != NIL) {
+                               printf("; ");
+                       }
+               }
+               putchar(')');
+       }
+}