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 37 to_digit(fcode_env_t *env) 38 { 39 CHECK_DEPTH(env, 1, ">digit"); 40 TOS = DIGIT(TOS); 41 } 42 43 void 44 pic_hold(fcode_env_t *env) 45 { 46 CHECK_DEPTH(env, 1, "hold"); 47 *(--env->picturebufpos) = (char) POP(DS); 48 } 49 50 void 51 pic_start(fcode_env_t *env) 52 { 53 env->picturebufpos = env->picturebuf + env->picturebuflen - 1; 54 *env->picturebufpos = 0; 55 } 56 57 void 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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