Add copyright
[unix-history] / usr / src / usr.bin / pascal / pdx / sym / printval.c
CommitLineData
f644bb55
DF
1/*
2 * Copyright (c) 1980 Regents of the University of California.
3 * All rights reserved. The Berkeley software License Agreement
4 * specifies the terms and conditions for redistribution.
5 */
204ed195 6
f644bb55
DF
7#ifndef lint
8static char sccsid[] = "@(#)printval.c 5.1 (Berkeley) %G%";
9#endif not lint
204ed195
ML
10
11/*
12 * Print out the value at the top of the stack using the given type.
13 */
14
15#include "defs.h"
16#include "sym.h"
17#include "btypes.h"
18#include "classes.h"
19#include "tree.h"
20#include "process.h"
21#include "mappings.h"
22#include "sym.rep"
23
24printval(s)
25SYM *s;
26{
00434a44
ML
27 SYM *t;
28 ADDRESS a;
29 int len;
7275bc1e 30 double r;
00434a44
ML
31
32 if (s->class == REF) {
33 s = s->type;
34 }
1a53fa88 35 switch (s->class) {
00434a44
ML
36 case ARRAY:
37 t = rtype(s->type);
1a53fa88 38 if (t == t_char || (t->class == RANGE && t->type == t_char)) {
00434a44
ML
39 len = size(s);
40 sp -= len;
41 printf("'%.*s'", len, sp);
42 break;
43 } else {
44 printarray(s);
45 }
46 break;
47
48 case RECORD:
49 printrecord(s);
50 break;
51
52 case VARNT:
53 error("can't print out variant records");
54 break;
55
56 case RANGE:
57 if (s == t_real) {
a18a57e7 58 prtreal(pop(double));
00434a44 59 } else {
1a53fa88 60 printordinal(popsmall(s), rtype(s->type));
00434a44
ML
61 }
62 break;
63
64 case FILET:
1a53fa88
ML
65 case PTR:
66 a = pop(ADDRESS);
67 if (a == 0) {
00434a44
ML
68 printf("nil");
69 } else {
1a53fa88 70 printf("0%o", a);
00434a44
ML
71 }
72 break;
204ed195 73
00434a44
ML
74 case FIELD:
75 error("missing record specification");
76 break;
77
1a53fa88
ML
78 case SCAL:
79 printordinal(popsmall(s), s);
00434a44 80 break;
204ed195 81
00434a44
ML
82 case FPROC:
83 case FFUNC:
00434a44
ML
84 a = fparamaddr(pop(long));
85 t = whatblock(a);
86 if (t == NIL) {
87 printf("(proc %d)", a);
88 } else {
89 printf("%s", t->symbol);
90 }
91 break;
00434a44
ML
92
93 default:
94 if (s->class < BADUSE || s->class > VARNT) {
95 panic("printval: bad class %d", s->class);
96 }
97 error("don't know how to print a %s", classname(s));
98 /* NOTREACHED */
99 }
204ed195
ML
100}
101
1a53fa88
ML
102/*
103 * Print out an ordinal value (either an integer, character, or
104 * an enumeration constant).
105 */
106
107printordinal(v, t)
108long v;
109SYM *t;
110{
111 BOOLEAN found;
112 SYM *c;
113 int iv;
114
115 iv = v;
116 if (t->class == SCAL) {
117 c = t->chain;
118 while (c != NIL && c->symvalue.iconval != iv) {
119 c = c->chain;
120 }
121 if (c == NIL) {
122 printf("(scalar = %d)", iv);
123 } else {
124 printf("%s", c->symbol);
125 }
126 } else if (t == t_char) {
127 printf("'%c'", iv);
128 } else if (t == t_boolean) {
129 printf("%s", (iv == TRUE) ? "true" : "false");
130 } else {
131 printf("%ld", v);
132 }
133}
134
204ed195
ML
135/*
136 * Print out the value of a record, field by field.
137 */
138
139LOCAL printrecord(s)
140SYM *s;
141{
00434a44
ML
142 SYM *t;
143
144 if ((t = s->chain) == NIL) {
145 error("record has no fields");
146 }
147 printf("(");
148 sp -= size(s);
149 printfield(t);
150 printf(")");
204ed195
ML
151}
152
153/*
154 * Print out a field, first printing out other fields.
155 * This is done because the fields are chained together backwards.
156 */
157
158LOCAL printfield(s)
159SYM *s;
160{
00434a44
ML
161 STACK *savesp;
162
163 if (s->chain != NIL) {
164 printfield(s->chain);
165 printf(", ");
166 }
167 printf("%s = ", s->symbol);
168 savesp = sp;
169 sp += (s->symvalue.offset + size(s->type));
170 printval(s->type);
171 sp = savesp;
204ed195
ML
172}
173
174/*
175 * Print out the contents of an array.
176 * Haven't quite figured out what the best format is.
177 *
178 * This is rather inefficient.
179 *
180 * The "2*elsize" is there since "printval" drops the stack by elsize.
181 */
182
183LOCAL printarray(a)
184SYM *a;
185{
00434a44
ML
186 STACK *savesp, *newsp;
187 SYM *eltype;
188 long elsize;
189
190 savesp = sp;
191 sp -= size(a);
192 newsp = sp;
193 eltype = a->type;
194 elsize = size(eltype);
195 printf("(");
196 for (sp += elsize; sp <= savesp; sp += 2*elsize) {
197 if (sp - elsize != newsp) {
198 printf(", ");
204ed195 199 }
00434a44
ML
200 printval(eltype);
201 }
202 sp = newsp;
203 printf(")");
204ed195 204}
7275bc1e
ML
205
206/*
207 * Print out the value of a real number.
208 * Pascal notation is somewhat different that what one gets
209 * from "%g" in printf.
210 */
211
a18a57e7 212LOCAL prtreal(r)
7275bc1e
ML
213double r;
214{
215 extern char *index();
216 char *p, buf[256];
217
218 sprintf(buf, "%g", r);
219 if (buf[0] == '.') {
220 printf("0%s", buf);
221 } else if (buf[0] == '-' && buf[1] == '.') {
222 printf("-0%s", &buf[1]);
223 } else {
224 printf("%s", buf);
225 }
226 if (index(buf, '.') == NIL) {
227 printf(".0");
228 }
229}