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