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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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