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