386BSD 0.1 development
[unix-history] / usr / othersrc / public / ghostscript-2.4.1 / ztype.c
CommitLineData
0a025064
WJ
1/* Copyright (C) 1989, 1992 Aladdin Enterprises. All rights reserved.
2 Distributed by Free Software Foundation, Inc.
3
4This file is part of Ghostscript.
5
6Ghostscript is distributed in the hope that it will be useful, but
7WITHOUT ANY WARRANTY. No author or distributor accepts responsibility
8to anyone for the consequences of using it or for whether it serves any
9particular purpose or works at all, unless he says so in writing. Refer
10to the Ghostscript General Public License for full details.
11
12Everyone is granted permission to copy, modify and redistribute
13Ghostscript, but only under the conditions described in the Ghostscript
14General Public License. A copy of this license is supposed to have been
15given to you along with Ghostscript so you can know your rights and
16responsibilities. It should be in a file named COPYING. Among other
17things, the copyright notice and this notice must be preserved on all
18copies. */
19
20/* ztype.c */
21/* Type, attribute, and conversion operators for GhostScript */
22#include "math_.h"
23#include "memory_.h"
24#include "string_.h"
25#include "ghost.h"
26#include "errors.h"
27#include "oper.h"
28#include "dict.h"
29#include "iutil.h"
30#include "name.h"
31#include "store.h"
32#include "stream.h"
33
34/* Imported procedures */
35extern int scan_number_only(P2(ref *, ref *));
36
37/* Forward references */
38private int near access_check(P3(os_ptr, int, int));
39private int convert_to_string(P2(os_ptr, os_ptr));
40
41/* Max and min integer values expressed as reals. */
42/* Note that these are biased by 1 to correct for truncation. */
43#define lb_real_int (-1.0 * 0x8000L * 0x10000L - 1)
44#define ub_real_int ( 1.0 * 0x8000L * 0x10000L)
45
46/* Get the pointer to the access flags for a ref. */
47#define access_ref(opp)\
48 (r_has_type(opp, t_dictionary) ? dict_access_ref(opp) : opp)
49
50/* Initialize the table of type names. */
51/* We export the type names just in case they might be useful. */
52ref type_names[t_next_index];
53private void
54ztype_init()
55{ static const char *tnames[] = { type_name_strings };
56 int i;
57 for ( i = 0; i < t_next_index; i++ )
58 { name_enter(tnames[i], &type_names[i]);
59 r_set_attrs(&type_names[i], a_executable);
60 }
61}
62
63/* type */
64int
65ztype(register os_ptr op)
66{ ref *ptref;
67 check_op(1);
68 ptref = &type_names[r_btype(op)];
69 ref_assign(op, ptref);
70 return 0;
71}
72
73/* cvlit */
74int
75zcvlit(register os_ptr op)
76{ ref *aop;
77 check_op(1);
78 aop = access_ref(op);
79 r_clear_attrs(aop, a_executable);
80 return 0;
81}
82
83/* cvx */
84int
85zcvx(register os_ptr op)
86{ ref *aop;
87 check_op(1);
88 aop = access_ref(op);
89 r_set_attrs(aop, a_executable);
90 return 0;
91}
92
93/* xcheck */
94int
95zxcheck(register os_ptr op)
96{ check_op(1);
97 make_bool(op, (r_has_attr(access_ref(op), a_executable) ? 1 : 0));
98 return 0;
99}
100
101/* executeonly */
102int
103zexecuteonly(register os_ptr op)
104{ check_op(1);
105 if ( r_has_type(op, t_dictionary) ) return e_typecheck;
106 return access_check(op, a_execute, 1);
107}
108
109/* noaccess */
110int
111znoaccess(register os_ptr op)
112{ return access_check(op, 0, 1);
113}
114
115/* readonly */
116int
117zreadonly(register os_ptr op)
118{ return access_check(op, a_read+a_execute, 1);
119}
120
121/* rcheck */
122int
123zrcheck(register os_ptr op)
124{ int code = access_check(op, a_read, 0);
125 if ( code >= 0 ) make_bool(op, code), code = 0;
126 return code;
127}
128
129/* wcheck */
130int
131zwcheck(register os_ptr op)
132{ int code = access_check(op, a_write, 0);
133 if ( code >= 0 ) make_bool(op, code), code = 0;
134 return code;
135}
136
137/* cvi */
138int
139zcvi(register os_ptr op)
140{ float fval;
141 switch ( r_type(op) )
142 {
143 case t_integer: return 0;
144 case t_real: fval = op->value.realval; break;
145 default: return e_typecheck;
146 case t_string:
147 { ref nref;
148 int code;
149 code = scan_number_only(op, &nref);
150 if ( code ) return code; /* error condition */
151 if ( r_has_type(&nref, t_integer) ) { *op = nref; return 0; }
152 /* Otherwise, result was a real */
153 fval = nref.value.realval;
154 }
155 }
156 /* Check if a real will fit into an integer value */
157 if ( fval <= lb_real_int || fval >= ub_real_int )
158 return e_rangecheck;
159 make_int(op, (long)fval); /* truncates towards 0 */
160 return 0;
161}
162
163/* cvn */
164int
165zcvn(register os_ptr op)
166{ check_read_type(*op, t_string);
167 return name_from_string(op, op);
168}
169
170/* cvr */
171int
172zcvr(register os_ptr op)
173{ switch ( r_type(op) )
174 {
175 case t_integer: make_real(op, op->value.intval);
176 case t_real: return 0;
177 default: return e_typecheck;
178 case t_string:
179 { ref nref;
180 int code;
181 code = scan_number_only(op, &nref);
182 if ( code ) return code; /* error condition */
183 if ( r_has_type(&nref, t_real) ) { *op = nref; return 0; }
184 /* Otherwise, result was an integer */
185 make_real(op, nref.value.intval);
186 return 0;
187 }
188 }
189}
190
191/* cvrs */
192int
193zcvrs(register os_ptr op)
194{ int radix;
195 check_type(op[-1], t_integer);
196 if ( op[-1].value.intval < 2 || op[-1].value.intval > 36 )
197 return e_rangecheck;
198 radix = op[-1].value.intval;
199 check_write_type(*op, t_string);
200 if ( radix == 10 )
201 { switch ( r_type(op - 2) )
202 {
203 case t_integer: case t_real:
204 { int code = convert_to_string(op - 2, op);
205 if ( code < 0 ) return code;
206 pop(2);
207 return 0;
208 }
209 default:
210 return e_typecheck;
211 }
212 }
213 else
214 { ulong ival;
215 byte digits[32];
216 byte *endp = &digits[32];
217 byte *dp = endp;
218 switch ( r_type(op - 2) )
219 {
220 case t_integer:
221 ival = (ulong)op[-2].value.intval;
222 break;
223 case t_real:
224 { float fval = op[-2].value.realval;
225 if ( fval <= lb_real_int || fval >= ub_real_int )
226 return e_rangecheck;
227 ival = (ulong)(long)fval;
228 } break;
229 default:
230 return e_typecheck;
231 }
232 do
233 { int dit = ival % radix;
234 *--dp = dit + (dit < 10 ? '0' : ('A' - 10));
235 ival /= radix;
236 }
237 while ( ival );
238 if ( endp - dp > r_size(op) ) return e_rangecheck;
239 memcpy(op->value.bytes, dp, (uint)(endp - dp));
240 r_set_size(op, endp - dp);
241 }
242 op[-2] = *op;
243 pop(2);
244 return 0;
245}
246
247/* cvs */
248int
249zcvs(register os_ptr op)
250{ int code;
251 check_write_type(*op, t_string);
252 code = convert_to_string(op - 1, op);
253 if ( code >= 0 ) pop(1);
254 return code;
255}
256
257/* ------ Initialization procedure ------ */
258
259op_def ztype_op_defs[] = {
260 {"1cvi", zcvi},
261 {"1cvlit", zcvlit},
262 {"1cvn", zcvn},
263 {"1cvr", zcvr},
264 {"3cvrs", zcvrs},
265 {"2cvs", zcvs},
266 {"1cvx", zcvx},
267 {"1executeonly", zexecuteonly},
268 {"1noaccess", znoaccess},
269 {"1rcheck", zrcheck},
270 {"1readonly", zreadonly},
271 {"1type", ztype},
272 {"1wcheck", zwcheck},
273 {"1xcheck", zxcheck},
274 op_def_end(ztype_init)
275};
276
277/* ------ Internal routines ------ */
278
279/* Test or modify the access of an object. */
280/* If modify = 1, restrict to the selected access and return 0; */
281/* if modify = 0, do not change the access, and return 1 */
282/* if the object had the access. */
283/* Return an error code if the object is not of appropriate type, */
284/* or if the object did not have the access already when modify=1. */
285private int near
286access_check(os_ptr op,
287 int access, /* mask for attrs */
288 int modify) /* if true, reduce access */
289{ ref *aop = op;
290 switch ( r_type(op) )
291 {
292 default: return e_typecheck;
293 case t_dictionary:
294 aop = dict_access_ref(op);
295 case t_array: case t_file: case t_gstate: case t_string:
296 case t_mixedarray: case t_shortarray: ;
297 }
298 if ( modify )
299 { if ( !r_has_attrs(aop, access) )
300 return e_invalidaccess;
301 if ( aop != op ) /* i.e., t_dictionary */
302 { ref_save(aop, "access_check(modify)");
303 }
304 r_clear_attrs(aop, a_all);
305 r_set_attrs(aop, access);
306 return 0;
307 }
308 else
309 { return (r_has_attrs(aop, access)? 1 : 0);
310 }
311}
312
313/* Do all the work of cvs. The destination has been checked, but not */
314/* the source. This is a separate procedure so that */
315/* cvrs can use it when the radix is 10. */
316private int
317convert_to_string(os_ptr op1, os_ptr op)
318{ int code;
319 uint len;
320 if ( r_has_type(op1, t_string) )
321 check_read(*op1);
322 code = obj_cvs(op1, op->value.bytes, r_size(op), &len);
323 if ( code < 0 ) return code;
324 *op1 = *op;
325 r_set_size(op1, len);
326 return 0;
327}