projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| eb2698b9 WJ |
1 | /* Copyright (C) 1989, 1990, 1991 Aladdin Enterprises. All rights reserved. |
| 2 | Distributed by Free Software Foundation, Inc. | |
| 3 | ||
| 4 | This file is part of Ghostscript. | |
| 5 | ||
| 6 | Ghostscript is distributed in the hope that it will be useful, but | |
| 7 | WITHOUT ANY WARRANTY. No author or distributor accepts responsibility | |
| 8 | to anyone for the consequences of using it or for whether it serves any | |
| 9 | particular purpose or works at all, unless he says so in writing. Refer | |
| 10 | to the Ghostscript General Public License for full details. | |
| 11 | ||
| 12 | Everyone is granted permission to copy, modify and redistribute | |
| 13 | Ghostscript, but only under the conditions described in the Ghostscript | |
| 14 | General Public License. A copy of this license is supposed to have been | |
| 15 | given to you along with Ghostscript so you can know your rights and | |
| 16 | responsibilities. It should be in a file named COPYING. Among other | |
| 17 | things, the copyright notice and this notice must be preserved on all | |
| 18 | copies. */ | |
| 19 | ||
| 20 | /* zarith.c */ | |
| 21 | /* Arithmetic operators for GhostScript */ | |
| 22 | #include "math_.h" | |
| 23 | #include "ghost.h" | |
| 24 | #include "errors.h" | |
| 25 | #include "oper.h" | |
| 26 | #include "store.h" | |
| 27 | ||
| 28 | /****** NOTE: none of the arithmetic operators ******/ | |
| 29 | /****** currently check for floating exceptions ******/ | |
| 30 | ||
| 31 | /* Imported operators */ | |
| 32 | extern int zcvi(P1(os_ptr)); | |
| 33 | ||
| 34 | /* Macro for accessing next-to-top stack element */ | |
| 35 | #define opm1 (op-1) | |
| 36 | /* Macros for generating non-integer cases for arithmetic operations. */ | |
| 37 | /* 'frob' is one of the arithmetic operators, +, -, or *. */ | |
| 38 | #define non_int_cases(frob,frob_equals)\ | |
| 39 | switch ( r_type(op) ) {\ | |
| 40 | default: return e_typecheck;\ | |
| 41 | case t_real: switch ( r_type(opm1) ) {\ | |
| 42 | default: return e_typecheck;\ | |
| 43 | case t_real: op[-1].value.realval frob_equals op->value.realval; break;\ | |
| 44 | case t_integer: make_real(opm1, op[-1].value.intval frob op->value.realval);\ | |
| 45 | } break;\ | |
| 46 | case t_integer: switch ( r_type(opm1) ) {\ | |
| 47 | default: return e_typecheck;\ | |
| 48 | case t_real: op[-1].value.realval frob_equals op->value.intval; break;\ | |
| 49 | case t_integer: | |
| 50 | #define end_cases()\ | |
| 51 | } } | |
| 52 | ||
| 53 | /* add */ | |
| 54 | /* We make this into a separate procedure because */ | |
| 55 | /* the interpreter will almost always call it directly. */ | |
| 56 | int | |
| 57 | zop_add(register os_ptr op) | |
| 58 | { non_int_cases(+, +=) | |
| 59 | { long int2 = op->value.intval; | |
| 60 | if ( ((op[-1].value.intval += int2) ^ int2) < 0 && | |
| 61 | ((op[-1].value.intval - int2) ^ int2) >= 0 | |
| 62 | ) | |
| 63 | { /* Overflow, convert to real */ | |
| 64 | make_real(opm1, (float)(op[-1].value.intval - int2) + int2); | |
| 65 | } | |
| 66 | } | |
| 67 | end_cases() | |
| 68 | return 0; | |
| 69 | } | |
| 70 | int | |
| 71 | zadd(os_ptr op) | |
| 72 | { int code = zop_add(op); | |
| 73 | if ( code == 0 ) { pop(1); } | |
| 74 | return code; | |
| 75 | } | |
| 76 | ||
| 77 | /* div */ | |
| 78 | int | |
| 79 | zdiv(register os_ptr op) | |
| 80 | { register os_ptr op1 = op - 1; | |
| 81 | /* We can't use the non_int_cases macro, */ | |
| 82 | /* because we have to check explicitly for op == 0. */ | |
| 83 | switch ( r_type(op) ) | |
| 84 | { | |
| 85 | default: return e_typecheck; | |
| 86 | case t_real: | |
| 87 | if ( op->value.realval == 0 ) return e_undefinedresult; | |
| 88 | switch ( r_type(op1) ) | |
| 89 | { | |
| 90 | default: return e_typecheck; | |
| 91 | case t_real: op1->value.realval /= op->value.realval; break; | |
| 92 | case t_integer: make_real(op1, op1->value.intval / op->value.realval); | |
| 93 | } | |
| 94 | break; | |
| 95 | case t_integer: | |
| 96 | if ( op->value.intval == 0 ) return e_undefinedresult; | |
| 97 | switch ( r_type(op1) ) | |
| 98 | { | |
| 99 | default: return e_typecheck; | |
| 100 | case t_real: op1->value.realval /= op->value.intval; break; | |
| 101 | case t_integer: make_real(op1, (float)op1->value.intval / op->value.intval); | |
| 102 | } | |
| 103 | } | |
| 104 | pop(1); | |
| 105 | return 0; | |
| 106 | } | |
| 107 | ||
| 108 | /* mul */ | |
| 109 | int | |
| 110 | zmul(register os_ptr op) | |
| 111 | { non_int_cases(*, *=) | |
| 112 | { long int1 = op[-1].value.intval; | |
| 113 | long int2 = op->value.intval; | |
| 114 | long abs1 = (int1 >= 0 ? int1 : - int1); | |
| 115 | long abs2 = (int2 >= 0 ? int2 : - int2); | |
| 116 | float fprod; | |
| 117 | if ( (abs1 > 0x7fff || abs2 > 0x7fff) && | |
| 118 | /* At least one of the operands is very large. */ | |
| 119 | /* Check for integer overflow. */ | |
| 120 | abs1 != 0 && | |
| 121 | abs2 > 0x7fffffffL / abs1 && | |
| 122 | /* Check for the boundary case */ | |
| 123 | (fprod = (float)int1 * int2, | |
| 124 | (int1 * int2 != -0x80000000L || | |
| 125 | fprod != (float)-0x80000000L)) | |
| 126 | ) | |
| 127 | make_real(opm1, fprod); | |
| 128 | else | |
| 129 | op[-1].value.intval = int1 * int2; | |
| 130 | } | |
| 131 | end_cases() | |
| 132 | pop(1); | |
| 133 | return 0; | |
| 134 | } | |
| 135 | ||
| 136 | /* sub */ | |
| 137 | /* We make this into a separate procedure because */ | |
| 138 | /* the interpreter will almost always call it directly. */ | |
| 139 | int | |
| 140 | zop_sub(register os_ptr op) | |
| 141 | { non_int_cases(-, -=) | |
| 142 | { long int1 = op[-1].value.intval; | |
| 143 | if ( (int1 ^ (op[-1].value.intval = int1 - op->value.intval)) < 0 && | |
| 144 | (int1 ^ op->value.intval) < 0 | |
| 145 | ) | |
| 146 | { /* Overflow, convert to real */ | |
| 147 | make_real(opm1, (float)int1 - op->value.intval); | |
| 148 | } | |
| 149 | } | |
| 150 | end_cases() | |
| 151 | return 0; | |
| 152 | } | |
| 153 | int | |
| 154 | zsub(os_ptr op) | |
| 155 | { int code = zop_sub(op); | |
| 156 | if ( code == 0 ) { pop(1); } | |
| 157 | return code; | |
| 158 | } | |
| 159 | ||
| 160 | /* idiv */ | |
| 161 | int | |
| 162 | zidiv(register os_ptr op) | |
| 163 | { /* The Red Book says this only works on integers, */ | |
| 164 | /* but implementations also accept reals. */ | |
| 165 | ref save_num; | |
| 166 | int code; | |
| 167 | save_num = op[-1]; | |
| 168 | code = zdiv(op); | |
| 169 | if ( code < 0 ) return code; /* division failed */ | |
| 170 | code = zcvi(op - 1); | |
| 171 | if ( code < 0 ) | |
| 172 | { /* cvi failed, restore numerator */ | |
| 173 | op[-1] = save_num; | |
| 174 | osp = op; /* restore osp as well */ | |
| 175 | } | |
| 176 | return code; | |
| 177 | } | |
| 178 | ||
| 179 | /* mod */ | |
| 180 | int | |
| 181 | zmod(register os_ptr op) | |
| 182 | { check_type(op[-1], t_integer); | |
| 183 | check_type(*op, t_integer); | |
| 184 | if ( op->value.intval == 0 ) return e_undefinedresult; | |
| 185 | op[-1].value.intval %= op->value.intval; | |
| 186 | pop(1); | |
| 187 | return 0; | |
| 188 | } | |
| 189 | ||
| 190 | /* neg */ | |
| 191 | int | |
| 192 | zneg(register os_ptr op) | |
| 193 | { switch ( r_type(op) ) | |
| 194 | { | |
| 195 | default: return e_typecheck; | |
| 196 | case t_real: op->value.realval = -op->value.realval; break; | |
| 197 | case t_integer: | |
| 198 | if ( op->value.intval == -0x80000000L ) /* min integer */ | |
| 199 | make_real(op, -(float)-0x80000000L); | |
| 200 | else | |
| 201 | op->value.intval = -op->value.intval; | |
| 202 | } | |
| 203 | return 0; | |
| 204 | } | |
| 205 | ||
| 206 | /* ceiling */ | |
| 207 | int | |
| 208 | zceiling(register os_ptr op) | |
| 209 | { switch ( r_type(op) ) | |
| 210 | { | |
| 211 | default: return e_typecheck; | |
| 212 | case t_real: op->value.realval = ceil(op->value.realval); | |
| 213 | case t_integer: ; | |
| 214 | } | |
| 215 | return 0; | |
| 216 | } | |
| 217 | ||
| 218 | /* floor */ | |
| 219 | int | |
| 220 | zfloor(register os_ptr op) | |
| 221 | { switch ( r_type(op) ) | |
| 222 | { | |
| 223 | default: return e_typecheck; | |
| 224 | case t_real: op->value.realval = floor(op->value.realval); | |
| 225 | case t_integer: ; | |
| 226 | } | |
| 227 | return 0; | |
| 228 | } | |
| 229 | ||
| 230 | /* round */ | |
| 231 | int | |
| 232 | zround(register os_ptr op) | |
| 233 | { switch ( r_type(op) ) | |
| 234 | { | |
| 235 | default: return e_typecheck; | |
| 236 | case t_real: op->value.realval = floor(op->value.realval + 0.5); | |
| 237 | case t_integer: ; | |
| 238 | } | |
| 239 | return 0; | |
| 240 | } | |
| 241 | ||
| 242 | /* truncate */ | |
| 243 | int | |
| 244 | ztruncate(register os_ptr op) | |
| 245 | { switch ( r_type(op) ) | |
| 246 | { | |
| 247 | default: return e_typecheck; | |
| 248 | case t_real: | |
| 249 | op->value.realval = | |
| 250 | (op->value.realval < 0.0 ? | |
| 251 | ceil(op->value.realval) : | |
| 252 | floor(op->value.realval)); | |
| 253 | case t_integer: ; | |
| 254 | } | |
| 255 | return 0; | |
| 256 | } | |
| 257 | ||
| 258 | /* ------ Initialization table ------ */ | |
| 259 | ||
| 260 | op_def zarith_op_defs[] = { | |
| 261 | {"2add", zadd}, | |
| 262 | {"1ceiling", zceiling}, | |
| 263 | {"2div", zdiv}, | |
| 264 | {"2idiv", zidiv}, | |
| 265 | {"1floor", zfloor}, | |
| 266 | {"2mod", zmod}, | |
| 267 | {"2mul", zmul}, | |
| 268 | {"1neg", zneg}, | |
| 269 | {"1round", zround}, | |
| 270 | {"2sub", zsub}, | |
| 271 | {"1truncate", ztruncate}, | |
| 272 | op_def_end(0) | |
| 273 | }; |