1 /*
2 * CDDL HEADER START
3 *
4 * The contents of this file are subject to the terms of the
5 * Common Development and Distribution License, Version 1.0 only
6 * (the "License"). You may not use this file except in compliance
7 * with the License.
8 *
9 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10 * or http://www.opensolaris.org/os/licensing.
11 * See the License for the specific language governing permissions
12 * and limitations under the License.
13 *
14 * When distributing Covered Code, include this CDDL HEADER in each
15 * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16 * If applicable, add the following below this CDDL HEADER, with the
17 * fields enclosed by brackets "[]" replaced with your own identifying
18 * information: Portions Copyright [yyyy] [name of copyright owner]
19 *
20 * CDDL HEADER END
21 */
22 /*
23 * Copyright (c) 1999 by Sun Microsystems, Inc.
24 * All rights reserved.
25 */
26
27 #pragma ident "%Z%%M% %I% %E% SMI"
28
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <string.h>
32 #include <fcode/private.h>
33
34 #define DIGIT(x) (((x) > 9) ? ((x) + 'a' - 10) : ((x) + '0'))
35
36 void
to_digit(fcode_env_t * env)37 to_digit(fcode_env_t *env)
38 {
39 CHECK_DEPTH(env, 1, ">digit");
40 TOS = DIGIT(TOS);
41 }
42
43 void
pic_hold(fcode_env_t * env)44 pic_hold(fcode_env_t *env)
45 {
46 CHECK_DEPTH(env, 1, "hold");
47 *(--env->picturebufpos) = (char) POP(DS);
48 }
49
50 void
pic_start(fcode_env_t * env)51 pic_start(fcode_env_t *env)
52 {
53 env->picturebufpos = env->picturebuf + env->picturebuflen - 1;
54 *env->picturebufpos = 0;
55 }
56
57 void
pic_ustop(fcode_env_t * env)58 pic_ustop(fcode_env_t *env)
59 {
60 CHECK_DEPTH(env, 1, "u#>");
61 (void) POP(DS);
62 push_string(env, env->picturebufpos, strlen(env->picturebufpos));
63 }
64
65 void
pic_unsigned(fcode_env_t * env)66 pic_unsigned(fcode_env_t *env)
67 {
68 ufstack_t a, b;
69
70 CHECK_DEPTH(env, 1, "u#");
71 a = (ufstack_t) TOS;
72 b = a % env->num_base;
73 TOS = (fstack_t) (a / env->num_base);
74 *(--env->picturebufpos) = DIGIT(b);
75 }
76
77 void
pic_sign(fcode_env_t * env)78 pic_sign(fcode_env_t *env)
79 {
80 fstack_t s;
81
82 CHECK_DEPTH(env, 1, "sign");
83 s = POP(DS);
84 if (s < 0) {
85 PUSH(DS, '-');
86 pic_hold(env);
87 }
88 }
89
90 static void
pic_uremainder(fcode_env_t * env)91 pic_uremainder(fcode_env_t *env)
92 {
93 CHECK_DEPTH(env, 1, "u#s");
94 do {
95 pic_unsigned(env);
96 } while (TOS);
97 }
98
99 void
format_number(fcode_env_t * env,int neg,int width)100 format_number(fcode_env_t *env, int neg, int width)
101 {
102 pic_start(env);
103 if (width == 0) {
104 PUSH(DS, ' ');
105 pic_hold(env);
106 }
107 pic_uremainder(env);
108 if (env->num_base == 10 && neg) {
109 PUSH(DS, '-');
110 pic_hold(env);
111 }
112 width -= strlen(env->picturebufpos);
113 while (width > 0) {
114 PUSH(DS, ' ');
115 pic_hold(env);
116 width--;
117 }
118 pic_ustop(env);
119 }
120
121 static void
convert_num(fcode_env_t * env)122 convert_num(fcode_env_t *env)
123 {
124 int n;
125
126 CHECK_DEPTH(env, 1, "(.)");
127 n = 0;
128 if (env->num_base == 10 && TOS < 0) {
129 TOS = -TOS;
130 n = 1;
131 }
132 format_number(env, n, 0);
133 }
134
135 void
do_dot_r(fcode_env_t * env)136 do_dot_r(fcode_env_t *env)
137 {
138 int w, n;
139
140 CHECK_DEPTH(env, 2, ".r");
141 n = 0;
142 w = (int) POP(DS);
143 if (env->num_base == 10 && TOS < 0) {
144 TOS = -TOS;
145 n = 1;
146 }
147 format_number(env, n, w);
148 type(env);
149 }
150
151 void
do_udot_r(fcode_env_t * env)152 do_udot_r(fcode_env_t *env)
153 {
154 int w;
155
156 CHECK_DEPTH(env, 2, "u.r");
157 w = (int) POP(DS);
158 format_number(env, 0, w);
159 type(env);
160 }
161
162 void
do_dot(fcode_env_t * env)163 do_dot(fcode_env_t *env)
164 {
165 CHECK_DEPTH(env, 1, ".");
166 PUSH(DS, 0);
167 do_dot_r(env);
168 }
169
170 void
do_dot_d(fcode_env_t * env)171 do_dot_d(fcode_env_t *env)
172 {
173 int base;
174
175 CHECK_DEPTH(env, 1, ".d");
176 base = env->num_base;
177 env->num_base = 10;
178 do_dot(env);
179 env->num_base = base;
180 }
181
182 void
do_dot_x(fcode_env_t * env)183 do_dot_x(fcode_env_t *env)
184 {
185 int base;
186
187 CHECK_DEPTH(env, 1, ".x");
188 base = env->num_base;
189 env->num_base = 16;
190 do_dot(env);
191 env->num_base = base;
192 }
193
194 void
do_udot(fcode_env_t * env)195 do_udot(fcode_env_t *env)
196 {
197 CHECK_DEPTH(env, 1, "u.");
198 PUSH(DS, 0);
199 do_udot_r(env);
200 }
201
202 void
pic_dunsigned(fcode_env_t * env)203 pic_dunsigned(fcode_env_t *env)
204 {
205 ufstack_t b;
206 u_dforth_t a;
207
208 CHECK_DEPTH(env, 2, "#");
209 a = pop_double(env);
210 b = a % env->num_base;
211 a /= env->num_base;
212 push_double(env, a);
213 *(--env->picturebufpos) = DIGIT(b);
214 }
215
216 void
pic_dremainder(fcode_env_t * env)217 pic_dremainder(fcode_env_t *env)
218 {
219 CHECK_DEPTH(env, 2, "#s");
220 do {
221 pic_dunsigned(env);
222 } while (peek_double(env));
223 }
224
225 void
pic_dstop(fcode_env_t * env)226 pic_dstop(fcode_env_t *env)
227 {
228 CHECK_DEPTH(env, 2, "#>");
229 (void) pop_double(env);
230 push_string(env, env->picturebufpos, strlen(env->picturebufpos));
231 }
232
233
234 #pragma init(_init)
235
236 static void
_init(void)237 _init(void)
238 {
239 fcode_env_t *env = initial_env;
240 ASSERT(env);
241 NOTICE;
242
243 env->picturebuflen = 0x100;
244 env->picturebuf = MALLOC(env->picturebuflen);
245
246 ANSI(0x095, 0, "hold", pic_hold);
247 ANSI(0x096, 0, "<#", pic_start);
248 ANSI(0x097, 0, "u#>", pic_ustop);
249 ANSI(0x098, 0, "sign", pic_sign);
250 ANSI(0x099, 0, "u#", pic_unsigned);
251 ANSI(0x09a, 0, "u#s", pic_uremainder);
252 ANSI(0x09b, 0, "u.", do_udot);
253 P1275(0x09c, 0, "u.r", do_udot_r);
254 P1275(0x09d, 0, ".", do_dot);
255 ANSI(0x09e, 0, ".r", do_dot_r);
256
257 ANSI(0x0c7, 0, "#", pic_dunsigned);
258 ANSI(0x0c8, 0, "#s", pic_dremainder);
259 ANSI(0x0c9, 0, "#>", pic_dstop);
260
261 FORTH(0, ">digit", to_digit);
262 FORTH(0, "(.)", convert_num);
263 FORTH(0, ".d", do_dot_d);
264 FORTH(0, ".x", do_dot_x);
265 }
266