2N/A/*
2N/A * CDDL HEADER START
2N/A *
2N/A * The contents of this file are subject to the terms of the
2N/A * Common Development and Distribution License, Version 1.0 only
2N/A * (the "License"). You may not use this file except in compliance
2N/A * with the License.
2N/A *
2N/A * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
2N/A * or http://www.opensolaris.org/os/licensing.
2N/A * See the License for the specific language governing permissions
2N/A * and limitations under the License.
2N/A *
2N/A * When distributing Covered Code, include this CDDL HEADER in each
2N/A * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
2N/A * If applicable, add the following below this CDDL HEADER, with the
2N/A * fields enclosed by brackets "[]" replaced with your own identifying
2N/A * information: Portions Copyright [yyyy] [name of copyright owner]
2N/A *
2N/A * CDDL HEADER END
2N/A */
2N/A/*
2N/A * Copyright (c) 1999 by Sun Microsystems, Inc.
2N/A * All rights reserved.
2N/A */
2N/A
2N/A#pragma ident "%Z%%M% %I% %E% SMI"
2N/A
2N/A#include <stdio.h>
2N/A#include <stdlib.h>
2N/A#include <string.h>
2N/A#include <fcode/private.h>
2N/A
2N/A#define DIGIT(x) (((x) > 9) ? ((x) + 'a' - 10) : ((x) + '0'))
2N/A
2N/Avoid
2N/Ato_digit(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, ">digit");
2N/A TOS = DIGIT(TOS);
2N/A}
2N/A
2N/Avoid
2N/Apic_hold(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, "hold");
2N/A *(--env->picturebufpos) = (char) POP(DS);
2N/A}
2N/A
2N/Avoid
2N/Apic_start(fcode_env_t *env)
2N/A{
2N/A env->picturebufpos = env->picturebuf + env->picturebuflen - 1;
2N/A *env->picturebufpos = 0;
2N/A}
2N/A
2N/Avoid
2N/Apic_ustop(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, "u#>");
2N/A (void) POP(DS);
2N/A push_string(env, env->picturebufpos, strlen(env->picturebufpos));
2N/A}
2N/A
2N/Avoid
2N/Apic_unsigned(fcode_env_t *env)
2N/A{
2N/A ufstack_t a, b;
2N/A
2N/A CHECK_DEPTH(env, 1, "u#");
2N/A a = (ufstack_t) TOS;
2N/A b = a % env->num_base;
2N/A TOS = (fstack_t) (a / env->num_base);
2N/A *(--env->picturebufpos) = DIGIT(b);
2N/A}
2N/A
2N/Avoid
2N/Apic_sign(fcode_env_t *env)
2N/A{
2N/A fstack_t s;
2N/A
2N/A CHECK_DEPTH(env, 1, "sign");
2N/A s = POP(DS);
2N/A if (s < 0) {
2N/A PUSH(DS, '-');
2N/A pic_hold(env);
2N/A }
2N/A}
2N/A
2N/Astatic void
2N/Apic_uremainder(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, "u#s");
2N/A do {
2N/A pic_unsigned(env);
2N/A } while (TOS);
2N/A}
2N/A
2N/Avoid
2N/Aformat_number(fcode_env_t *env, int neg, int width)
2N/A{
2N/A pic_start(env);
2N/A if (width == 0) {
2N/A PUSH(DS, ' ');
2N/A pic_hold(env);
2N/A }
2N/A pic_uremainder(env);
2N/A if (env->num_base == 10 && neg) {
2N/A PUSH(DS, '-');
2N/A pic_hold(env);
2N/A }
2N/A width -= strlen(env->picturebufpos);
2N/A while (width > 0) {
2N/A PUSH(DS, ' ');
2N/A pic_hold(env);
2N/A width--;
2N/A }
2N/A pic_ustop(env);
2N/A}
2N/A
2N/Astatic void
2N/Aconvert_num(fcode_env_t *env)
2N/A{
2N/A int n;
2N/A
2N/A CHECK_DEPTH(env, 1, "(.)");
2N/A n = 0;
2N/A if (env->num_base == 10 && TOS < 0) {
2N/A TOS = -TOS;
2N/A n = 1;
2N/A }
2N/A format_number(env, n, 0);
2N/A}
2N/A
2N/Avoid
2N/Ado_dot_r(fcode_env_t *env)
2N/A{
2N/A int w, n;
2N/A
2N/A CHECK_DEPTH(env, 2, ".r");
2N/A n = 0;
2N/A w = (int) POP(DS);
2N/A if (env->num_base == 10 && TOS < 0) {
2N/A TOS = -TOS;
2N/A n = 1;
2N/A }
2N/A format_number(env, n, w);
2N/A type(env);
2N/A}
2N/A
2N/Avoid
2N/Ado_udot_r(fcode_env_t *env)
2N/A{
2N/A int w;
2N/A
2N/A CHECK_DEPTH(env, 2, "u.r");
2N/A w = (int) POP(DS);
2N/A format_number(env, 0, w);
2N/A type(env);
2N/A}
2N/A
2N/Avoid
2N/Ado_dot(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, ".");
2N/A PUSH(DS, 0);
2N/A do_dot_r(env);
2N/A}
2N/A
2N/Avoid
2N/Ado_dot_d(fcode_env_t *env)
2N/A{
2N/A int base;
2N/A
2N/A CHECK_DEPTH(env, 1, ".d");
2N/A base = env->num_base;
2N/A env->num_base = 10;
2N/A do_dot(env);
2N/A env->num_base = base;
2N/A}
2N/A
2N/Avoid
2N/Ado_dot_x(fcode_env_t *env)
2N/A{
2N/A int base;
2N/A
2N/A CHECK_DEPTH(env, 1, ".x");
2N/A base = env->num_base;
2N/A env->num_base = 16;
2N/A do_dot(env);
2N/A env->num_base = base;
2N/A}
2N/A
2N/Avoid
2N/Ado_udot(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, "u.");
2N/A PUSH(DS, 0);
2N/A do_udot_r(env);
2N/A}
2N/A
2N/Avoid
2N/Apic_dunsigned(fcode_env_t *env)
2N/A{
2N/A ufstack_t b;
2N/A u_dforth_t a;
2N/A
2N/A CHECK_DEPTH(env, 2, "#");
2N/A a = pop_double(env);
2N/A b = a % env->num_base;
2N/A a /= env->num_base;
2N/A push_double(env, a);
2N/A *(--env->picturebufpos) = DIGIT(b);
2N/A}
2N/A
2N/Avoid
2N/Apic_dremainder(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 2, "#s");
2N/A do {
2N/A pic_dunsigned(env);
2N/A } while (peek_double(env));
2N/A}
2N/A
2N/Avoid
2N/Apic_dstop(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 2, "#>");
2N/A (void) pop_double(env);
2N/A push_string(env, env->picturebufpos, strlen(env->picturebufpos));
2N/A}
2N/A
2N/A
2N/A#pragma init(_init)
2N/A
2N/Astatic void
2N/A_init(void)
2N/A{
2N/A fcode_env_t *env = initial_env;
2N/A ASSERT(env);
2N/A NOTICE;
2N/A
2N/A env->picturebuflen = 0x100;
2N/A env->picturebuf = MALLOC(env->picturebuflen);
2N/A
2N/A ANSI(0x095, 0, "hold", pic_hold);
2N/A ANSI(0x096, 0, "<#", pic_start);
2N/A ANSI(0x097, 0, "u#>", pic_ustop);
2N/A ANSI(0x098, 0, "sign", pic_sign);
2N/A ANSI(0x099, 0, "u#", pic_unsigned);
2N/A ANSI(0x09a, 0, "u#s", pic_uremainder);
2N/A ANSI(0x09b, 0, "u.", do_udot);
2N/A P1275(0x09c, 0, "u.r", do_udot_r);
2N/A P1275(0x09d, 0, ".", do_dot);
2N/A ANSI(0x09e, 0, ".r", do_dot_r);
2N/A
2N/A ANSI(0x0c7, 0, "#", pic_dunsigned);
2N/A ANSI(0x0c8, 0, "#s", pic_dremainder);
2N/A ANSI(0x0c9, 0, "#>", pic_dstop);
2N/A
2N/A FORTH(0, ">digit", to_digit);
2N/A FORTH(0, "(.)", convert_num);
2N/A FORTH(0, ".d", do_dot_d);
2N/A FORTH(0, ".x", do_dot_x);
2N/A}