File: | c_intf.c |
Location: | line 4053, column 8 |
Description: | Assigned value is garbage or undefined |
1 | /* File: "c_intf.c" */ | |||
2 | ||||
3 | /* Copyright (c) 1994-2013 by Marc Feeley, All Rights Reserved. */ | |||
4 | ||||
5 | /* | |||
6 | * This module implements the conversion functions for the C | |||
7 | * interface. | |||
8 | */ | |||
9 | ||||
10 | #define ___INCLUDED_FROM_C_INTF | |||
11 | #define ___VERSION407000 407000 | |||
12 | #include "gambit.h" | |||
13 | ||||
14 | #include "os_base.h" | |||
15 | #include "os_dyn.h" | |||
16 | #include "setup.h" | |||
17 | #include "mem.h" | |||
18 | #include "c_intf.h" | |||
19 | ||||
20 | ___LOCALstatic ___SCMOBJlong ___temp; /* needed by some macros in "gambit.h" */ | |||
21 | ||||
22 | /**********************************/ | |||
23 | #ifdef ___DEBUG | |||
24 | #ifdef ___DEBUG_ALLOC_MEM_TRACE | |||
25 | #define ___alloc_mem(bytes) ___alloc_mem_debug(bytes,__LINE__25,__FILE__"c_intf.c") | |||
26 | #endif | |||
27 | #endif | |||
28 | ||||
29 | ||||
30 | /*---------------------------------------------------------------------------*/ | |||
31 | ||||
32 | /* Utilities for 64 bit arithmetic. */ | |||
33 | ||||
34 | ||||
35 | #ifdef ___BUILTIN_64BIT_INT_TYPE | |||
36 | ||||
37 | ||||
38 | /* | |||
39 | * If the symbol ___BUILTIN_64BIT_INT_TYPE is defined then the data | |||
40 | * types ___S64 and ___U64 are builtin integer types. | |||
41 | */ | |||
42 | ||||
43 | ||||
44 | ___EXP_FUNC(___S64,___S64_from_SM32_fn)long ___S64_from_SM32_fn | |||
45 | ___P((___SM32 val),(int val) | |||
46 | (val)(int val) | |||
47 | ___SM32 val;)(int val) | |||
48 | { | |||
49 | return ___S64_from_SM32 (val)((long)(((int)(val)))); | |||
50 | } | |||
51 | ||||
52 | ||||
53 | ___EXP_FUNC(___S64,___S64_from_SM32_UM32_fn)long ___S64_from_SM32_UM32_fn | |||
54 | ___P((___SM32 hi32,(int hi32, unsigned int lo32) | |||
55 | ___UM32 lo32),(int hi32, unsigned int lo32) | |||
56 | (hi32,(int hi32, unsigned int lo32) | |||
57 | lo32)(int hi32, unsigned int lo32) | |||
58 | ___SM32 hi32;(int hi32, unsigned int lo32) | |||
59 | ___UM32 lo32;)(int hi32, unsigned int lo32) | |||
60 | { | |||
61 | return ___S64_from_SM32_UM32 (hi32, lo32)((((long)(((int)(hi32)))) << 32) + ((long)(((unsigned int )(lo32))))); | |||
62 | } | |||
63 | ||||
64 | ||||
65 | ___EXP_FUNC(___S64,___S64_from_LONGLONG_fn)long ___S64_from_LONGLONG_fn | |||
66 | ___P((___LONGLONG val),(long long val) | |||
67 | (val)(long long val) | |||
68 | ___LONGLONG val;)(long long val) | |||
69 | { | |||
70 | return ___S64_from_LONGLONG (val)((long)(val)); | |||
71 | } | |||
72 | ||||
73 | ||||
74 | ___EXP_FUNC(___LONGLONG,___S64_to_LONGLONG_fn)long long ___S64_to_LONGLONG_fn | |||
75 | ___P((___S64 val),(long val) | |||
76 | (val)(long val) | |||
77 | ___S64 val;)(long val) | |||
78 | { | |||
79 | return ___S64_to_LONGLONG (val)((long long)(val)); | |||
80 | } | |||
81 | ||||
82 | ||||
83 | ___EXP_FUNC(___BOOL,___S64_fits_in_width_fn)int ___S64_fits_in_width_fn | |||
84 | ___P((___S64 val,(long val, int width) | |||
85 | int width),(long val, int width) | |||
86 | (val,(long val, int width) | |||
87 | width)(long val, int width) | |||
88 | ___S64 val;(long val, int width) | |||
89 | int width;)(long val, int width) | |||
90 | { | |||
91 | return ___S64_fits_in_width (val, width)((((val) >> ((width)-1)) == 0) || (((val) >> ((width )-1)) == -1)); | |||
92 | } | |||
93 | ||||
94 | ||||
95 | ___EXP_FUNC(___U64,___U64_from_UM32_fn)unsigned long ___U64_from_UM32_fn | |||
96 | ___P((___UM32 val),(unsigned int val) | |||
97 | (val)(unsigned int val) | |||
98 | ___UM32 val;)(unsigned int val) | |||
99 | { | |||
100 | return ___U64_from_UM32 (val)((unsigned long)(((unsigned int)(val)))); | |||
101 | } | |||
102 | ||||
103 | ||||
104 | ___EXP_FUNC(___U64,___U64_from_UM32_UM32_fn)unsigned long ___U64_from_UM32_UM32_fn | |||
105 | ___P((___UM32 hi32,(unsigned int hi32, unsigned int lo32) | |||
106 | ___UM32 lo32),(unsigned int hi32, unsigned int lo32) | |||
107 | (hi32,(unsigned int hi32, unsigned int lo32) | |||
108 | lo32)(unsigned int hi32, unsigned int lo32) | |||
109 | ___UM32 hi32;(unsigned int hi32, unsigned int lo32) | |||
110 | ___UM32 lo32;)(unsigned int hi32, unsigned int lo32) | |||
111 | { | |||
112 | return ___U64_from_UM32_UM32 (hi32, lo32)((((unsigned long)(((unsigned int)(hi32)))) << 32) + (( unsigned long)(((unsigned int)(lo32))))); | |||
113 | } | |||
114 | ||||
115 | ||||
116 | ___EXP_FUNC(___U64,___U64_from_ULONGLONG_fn)unsigned long ___U64_from_ULONGLONG_fn | |||
117 | ___P((___ULONGLONG val),(unsigned long long val) | |||
118 | (val)(unsigned long long val) | |||
119 | ___ULONGLONG val;)(unsigned long long val) | |||
120 | { | |||
121 | return ___U64_from_ULONGLONG (val)((unsigned long)(val)); | |||
122 | } | |||
123 | ||||
124 | ||||
125 | ___EXP_FUNC(___ULONGLONG,___U64_to_ULONGLONG_fn)unsigned long long ___U64_to_ULONGLONG_fn | |||
126 | ___P((___U64 val),(unsigned long val) | |||
127 | (val)(unsigned long val) | |||
128 | ___U64 val;)(unsigned long val) | |||
129 | { | |||
130 | return ___U64_to_ULONGLONG (val)((unsigned long long)(val)); | |||
131 | } | |||
132 | ||||
133 | ||||
134 | ___EXP_FUNC(___BOOL,___U64_fits_in_width_fn)int ___U64_fits_in_width_fn | |||
135 | ___P((___U64 val,(unsigned long val, int width) | |||
136 | int width),(unsigned long val, int width) | |||
137 | (val,(unsigned long val, int width) | |||
138 | width)(unsigned long val, int width) | |||
139 | ___U64 val;(unsigned long val, int width) | |||
140 | int width;)(unsigned long val, int width) | |||
141 | { | |||
142 | return ___U64_fits_in_width (val, width)(((val) >> (width)) == 0); | |||
143 | } | |||
144 | ||||
145 | ||||
146 | ___EXP_FUNC(___U64,___U64_mul_UM32_UM32_fn)unsigned long ___U64_mul_UM32_UM32_fn | |||
147 | ___P((___UM32 x,(unsigned int x, unsigned int y) | |||
148 | ___UM32 y),(unsigned int x, unsigned int y) | |||
149 | (x,(unsigned int x, unsigned int y) | |||
150 | y)(unsigned int x, unsigned int y) | |||
151 | ___UM32 x;(unsigned int x, unsigned int y) | |||
152 | ___UM32 y;)(unsigned int x, unsigned int y) | |||
153 | { | |||
154 | return ___U64_mul_UM32_UM32 (x, y)(((unsigned long)(((unsigned int)(x)))) * ((unsigned int)(y)) ); | |||
155 | } | |||
156 | ||||
157 | ||||
158 | ___EXP_FUNC(___U64,___U64_add_U64_U64_fn)unsigned long ___U64_add_U64_U64_fn | |||
159 | ___P((___U64 x,(unsigned long x, unsigned long y) | |||
160 | ___U64 y),(unsigned long x, unsigned long y) | |||
161 | (x,(unsigned long x, unsigned long y) | |||
162 | y)(unsigned long x, unsigned long y) | |||
163 | ___U64 x;(unsigned long x, unsigned long y) | |||
164 | ___U64 y;)(unsigned long x, unsigned long y) | |||
165 | { | |||
166 | return ___U64_add_U64_U64 (x, y)(((unsigned long)(x)) + ((unsigned long)(y))); | |||
167 | } | |||
168 | ||||
169 | ||||
170 | #else | |||
171 | ||||
172 | /* | |||
173 | * If the symbol ___BUILTIN_64BIT_INT_TYPE is not defined then the | |||
174 | * data types ___S64 and ___U64 are structures. | |||
175 | */ | |||
176 | ||||
177 | ||||
178 | ___EXP_FUNC(___S64,___S64_from_SM32_fn)long ___S64_from_SM32_fn | |||
179 | ___P((___SM32 val),(int val) | |||
180 | (val)(int val) | |||
181 | ___SM32 val;)(int val) | |||
182 | { | |||
183 | ___S64long r; | |||
184 | r.lo32 = ___CAST_U32(val)((unsigned int)(val)); | |||
185 | r.hi32 = (val < 0) ? -1 : 0; | |||
186 | return r; | |||
187 | } | |||
188 | ||||
189 | ||||
190 | ___EXP_FUNC(___S64,___S64_from_SM32_UM32_fn)long ___S64_from_SM32_UM32_fn | |||
191 | ___P((___SM32 hi32,(int hi32, unsigned int lo32) | |||
192 | ___UM32 lo32),(int hi32, unsigned int lo32) | |||
193 | (hi32,(int hi32, unsigned int lo32) | |||
194 | lo32)(int hi32, unsigned int lo32) | |||
195 | ___SM32 hi32;(int hi32, unsigned int lo32) | |||
196 | ___UM32 lo32;)(int hi32, unsigned int lo32) | |||
197 | { | |||
198 | ___S64long r; | |||
199 | r.lo32 = lo32; | |||
200 | r.hi32 = hi32; | |||
201 | return r; | |||
202 | } | |||
203 | ||||
204 | ||||
205 | ___EXP_FUNC(___S64,___S64_from_LONGLONG_fn)long ___S64_from_LONGLONG_fn | |||
206 | ___P((___LONGLONG val),(long long val) | |||
207 | (val)(long long val) | |||
208 | ___LONGLONG val;)(long long val) | |||
209 | { | |||
210 | #if ___LONGLONG_WIDTH64 <= 32 | |||
211 | return ___S64_from_SM32 (val)((long)(((int)(val)))); | |||
212 | #else | |||
213 | return ___S64_from_SM32_UM32 (___CAST_S32(val >> 32), ___CAST_U32(val))((((long)(((int)(((int)(val >> 32)))))) << 32) + ( (long)(((unsigned int)(((unsigned int)(val))))))); | |||
214 | #endif | |||
215 | } | |||
216 | ||||
217 | ||||
218 | ___EXP_FUNC(___LONGLONG,___S64_to_LONGLONG_fn)long long ___S64_to_LONGLONG_fn | |||
219 | ___P((___S64 val),(long val) | |||
220 | (val)(long val) | |||
221 | ___S64 val;)(long val) | |||
222 | { | |||
223 | #if ___LONGLONG_WIDTH64 <= 32 | |||
224 | return ___CAST_S32 (val.lo32)((int)(val.lo32)); | |||
225 | #else | |||
226 | return (___CAST(___LONGLONG,val.hi32)((long long)(val.hi32)) << 32) + val.lo32; | |||
227 | #endif | |||
228 | } | |||
229 | ||||
230 | ||||
231 | ___EXP_FUNC(___BOOL,___S64_fits_in_width_fn)int ___S64_fits_in_width_fn | |||
232 | ___P((___S64 val,(long val, int width) | |||
233 | int width),(long val, int width) | |||
234 | (val,(long val, int width) | |||
235 | width)(long val, int width) | |||
236 | ___S64 val;(long val, int width) | |||
237 | int width;)(long val, int width) | |||
238 | { | |||
239 | if (val.hi32 < 0) | |||
240 | { | |||
241 | if (width > 32) | |||
242 | return (val.hi32 >> (width-32-1)) == -1; | |||
243 | return val.hi32 == -1 && (___CAST_S32(val.lo32)((int)(val.lo32)) >> (width-1)) == -1; | |||
244 | } | |||
245 | else | |||
246 | { | |||
247 | if (width > 32) | |||
248 | return (val.hi32 >> (width-32-1)) == 0; | |||
249 | return val.hi32 == 0 && (___CAST_S32(val.lo32)((int)(val.lo32)) >> (width-1)) == 0; | |||
250 | } | |||
251 | } | |||
252 | ||||
253 | ||||
254 | ___EXP_FUNC(___U64,___U64_from_UM32_fn)unsigned long ___U64_from_UM32_fn | |||
255 | ___P((___UM32 val),(unsigned int val) | |||
256 | (val)(unsigned int val) | |||
257 | ___UM32 val;)(unsigned int val) | |||
258 | { | |||
259 | ___U64unsigned long r; | |||
260 | r.lo32 = val; | |||
261 | r.hi32 = 0; | |||
262 | return r; | |||
263 | } | |||
264 | ||||
265 | ||||
266 | ___EXP_FUNC(___U64,___U64_from_UM32_UM32_fn)unsigned long ___U64_from_UM32_UM32_fn | |||
267 | ___P((___UM32 hi32,(unsigned int hi32, unsigned int lo32) | |||
268 | ___UM32 lo32),(unsigned int hi32, unsigned int lo32) | |||
269 | (hi32,(unsigned int hi32, unsigned int lo32) | |||
270 | lo32)(unsigned int hi32, unsigned int lo32) | |||
271 | ___UM32 hi32;(unsigned int hi32, unsigned int lo32) | |||
272 | ___UM32 lo32;)(unsigned int hi32, unsigned int lo32) | |||
273 | { | |||
274 | ___U64unsigned long r; | |||
275 | r.lo32 = lo32; | |||
276 | r.hi32 = hi32; | |||
277 | return r; | |||
278 | } | |||
279 | ||||
280 | ||||
281 | ___EXP_FUNC(___U64,___U64_from_ULONGLONG_fn)unsigned long ___U64_from_ULONGLONG_fn | |||
282 | ___P((___ULONGLONG val),(unsigned long long val) | |||
283 | (val)(unsigned long long val) | |||
284 | ___ULONGLONG val;)(unsigned long long val) | |||
285 | { | |||
286 | #if ___LONGLONG_WIDTH64 <= 32 | |||
287 | return ___U64_from_UM32 (val)((unsigned long)(((unsigned int)(val)))); | |||
288 | #else | |||
289 | return ___U64_from_UM32_UM32 (___CAST_U32(val >> 32), ___CAST_U32(val))((((unsigned long)(((unsigned int)(((unsigned int)(val >> 32)))))) << 32) + ((unsigned long)(((unsigned int)(((unsigned int)(val))))))); | |||
290 | #endif | |||
291 | } | |||
292 | ||||
293 | ||||
294 | ___EXP_FUNC(___ULONGLONG,___U64_to_ULONGLONG_fn)unsigned long long ___U64_to_ULONGLONG_fn | |||
295 | ___P((___U64 val),(unsigned long val) | |||
296 | (val)(unsigned long val) | |||
297 | ___U64 val;)(unsigned long val) | |||
298 | { | |||
299 | #if ___LONGLONG_WIDTH64 <= 32 | |||
300 | return val.lo32; | |||
301 | #else | |||
302 | return (___CAST(___ULONGLONG,val.hi32)((unsigned long long)(val.hi32)) << 32) + val.lo32; | |||
303 | #endif | |||
304 | } | |||
305 | ||||
306 | ||||
307 | ___EXP_FUNC(___BOOL,___U64_fits_in_width_fn)int ___U64_fits_in_width_fn | |||
308 | ___P((___U64 val,(unsigned long val, int width) | |||
309 | int width),(unsigned long val, int width) | |||
310 | (val,(unsigned long val, int width) | |||
311 | width)(unsigned long val, int width) | |||
312 | ___U64 val;(unsigned long val, int width) | |||
313 | int width;)(unsigned long val, int width) | |||
314 | { | |||
315 | if (width >= 64) | |||
316 | return 1; | |||
317 | if (width >= 32) | |||
318 | return (val.hi32 >> (width-32)) == 0; | |||
319 | return val.hi32 == 0 && (val.lo32 >> width) == 0; | |||
320 | } | |||
321 | ||||
322 | ||||
323 | ___EXP_FUNC(___U64,___U64_mul_UM32_UM32_fn)unsigned long ___U64_mul_UM32_UM32_fn | |||
324 | ___P((___UM32 x,(unsigned int x, unsigned int y) | |||
325 | ___UM32 y),(unsigned int x, unsigned int y) | |||
326 | (x,(unsigned int x, unsigned int y) | |||
327 | y)(unsigned int x, unsigned int y) | |||
328 | ___UM32 x;(unsigned int x, unsigned int y) | |||
329 | ___UM32 y;)(unsigned int x, unsigned int y) | |||
330 | { | |||
331 | ___U64unsigned long r; | |||
332 | ___UM32unsigned int xlo = x & 0xffff; | |||
333 | ___UM32unsigned int xhi = x >> 16; | |||
334 | ___UM32unsigned int ylo = y & 0xffff; | |||
335 | ___UM32unsigned int yhi = y >> 16; | |||
336 | ___UM32unsigned int lo = xlo * ylo; /* 0 .. 0xfffe0001 */ | |||
337 | ___UM32unsigned int m1 = xlo * yhi + (lo >> 16); /* 0 .. 0xfffeffff */ | |||
338 | ___UM32unsigned int m2 = xhi * ylo; /* 0 .. 0xfffe0001 */ | |||
339 | ___UM32unsigned int m3 = (m1 & 0xffff) + (m2 & 0xffff); /* 0 .. 0x1fffe */ | |||
340 | ___UM32unsigned int hi = xhi * yhi + (m1 >> 16) + (m2 >> 16) + (m3 >> 16); /* 0 .. 0xfffffffe */ | |||
341 | r.lo32 = ((m3 & 0xffff) << 16) + (lo & 0xffff); | |||
342 | r.hi32 = hi; | |||
343 | return r; | |||
344 | } | |||
345 | ||||
346 | ||||
347 | ___EXP_FUNC(___U64,___U64_add_U64_U64_fn)unsigned long ___U64_add_U64_U64_fn | |||
348 | ___P((___U64 x,(unsigned long x, unsigned long y) | |||
349 | ___U64 y),(unsigned long x, unsigned long y) | |||
350 | (x,(unsigned long x, unsigned long y) | |||
351 | y)(unsigned long x, unsigned long y) | |||
352 | ___U64 x;(unsigned long x, unsigned long y) | |||
353 | ___U64 y;)(unsigned long x, unsigned long y) | |||
354 | { | |||
355 | ___U64unsigned long r; | |||
356 | r.lo32 = x.lo32 + y.lo32; | |||
357 | r.hi32 = x.hi32 + y.hi32 + (r.lo32 < x.lo32); | |||
358 | return r; | |||
359 | } | |||
360 | ||||
361 | ||||
362 | #endif | |||
363 | ||||
364 | ||||
365 | /*---------------------------------------------------------------------------*/ | |||
366 | ||||
367 | /* Utilities for UTF-8 encoding of characters. */ | |||
368 | ||||
369 | ||||
370 | /* | |||
371 | * '___UTF_8_bytes (c)' returns the number of bytes that are needed to | |||
372 | * encode the character 'c' using the UTF-8 variable-length encoding. | |||
373 | * If the character is not legal, 0 is returned. | |||
374 | */ | |||
375 | ||||
376 | int ___UTF_8_bytes | |||
377 | ___P((___UCS_4 c),(unsigned int c) | |||
378 | (c)(unsigned int c) | |||
379 | ___UCS_4 c;)(unsigned int c) | |||
380 | { | |||
381 | if (c <= 0x7f) return 1; | |||
382 | if (c <= 0x7ff) return 2; | |||
383 | if (c <= 0xffff) | |||
384 | { | |||
385 | #ifdef ___REJECT_ILLEGAL_UCS_4 | |||
386 | if (c > 0xd7ff && (c <= 0xdfff || c > 0xfffd)) return 0; | |||
387 | #endif | |||
388 | return 3; | |||
389 | } | |||
390 | if (c <= 0x1fffff) return 4; | |||
391 | if (c <= 0x3ffffff) return 5; | |||
392 | #ifdef ___REJECT_ILLEGAL_UCS_4 | |||
393 | if (c > 0x7fffffff) return 0; | |||
394 | #endif | |||
395 | return 6; | |||
396 | } | |||
397 | ||||
398 | ||||
399 | /* | |||
400 | * '___UTF_8_put (ptr, c)' converts the character 'c' into its UTF-8 | |||
401 | * variable-length encoding. 'ptr' is a pointer to a byte pointer | |||
402 | * designating the start of the UTF-8 encoding. On return the byte | |||
403 | * pointer points to the first byte following the UTF-8 encoding. If | |||
404 | * the character is not legal, the pointer is not updated. | |||
405 | */ | |||
406 | ||||
407 | void ___UTF_8_put | |||
408 | ___P((___UTF_8STRING *ptr,(char* *ptr, unsigned int c) | |||
409 | ___UCS_4 c),(char* *ptr, unsigned int c) | |||
410 | (ptr,(char* *ptr, unsigned int c) | |||
411 | c)(char* *ptr, unsigned int c) | |||
412 | ___UTF_8STRING *ptr;(char* *ptr, unsigned int c) | |||
413 | ___UCS_4 c;)(char* *ptr, unsigned int c) | |||
414 | { | |||
415 | ___UTF_8STRINGchar* p = *ptr; | |||
416 | if (c <= 0x7f) | |||
417 | { | |||
418 | *p++ = c; | |||
419 | *ptr = p; | |||
420 | } | |||
421 | else | |||
422 | { | |||
423 | int bytes; | |||
424 | if (c <= 0x7ff) bytes = 2; | |||
425 | else if (c <= 0xffff) | |||
426 | { | |||
427 | #ifdef ___REJECT_ILLEGAL_UCS_4 | |||
428 | if (c > 0xd7ff && (c <= 0xdfff || c > 0xfffd)) return; | |||
429 | #endif | |||
430 | bytes = 3; | |||
431 | } | |||
432 | else if (c <= 0x1fffff) bytes = 4; | |||
433 | else if (c <= 0x3ffffff) bytes = 5; | |||
434 | #ifdef ___REJECT_ILLEGAL_UCS_4 | |||
435 | else if (c > 0x7fffffff) return; | |||
436 | #endif | |||
437 | else bytes = 6; | |||
438 | p += bytes; | |||
439 | *ptr = p; | |||
440 | switch (bytes) | |||
441 | { | |||
442 | case 6: *--p = 0x80+(c&0x3f); c >>= 6; | |||
443 | case 5: *--p = 0x80+(c&0x3f); c >>= 6; | |||
444 | case 4: *--p = 0x80+(c&0x3f); c >>= 6; | |||
445 | case 3: *--p = 0x80+(c&0x3f); c >>= 6; | |||
446 | default: *--p = 0x80+(c&0x3f); c >>= 6; | |||
447 | } | |||
448 | *--p = 0xff - (0xff>>bytes) + c; | |||
449 | } | |||
450 | } | |||
451 | ||||
452 | ||||
453 | /* | |||
454 | * '___UTF_8_get (ptr)' converts a UTF-8 variable-length encoding to | |||
455 | * the character it encodes. 'ptr' is a pointer to a byte pointer | |||
456 | * designating the start of the UTF-8 encoding. If the encoding is | |||
457 | * legal, the byte pointer will point to the first byte following the | |||
458 | * UTF-8 encoding and the character is returned. If the encoding is | |||
459 | * illegal, the byte pointer is not updated and 0 is returned. | |||
460 | */ | |||
461 | ||||
462 | ___UCS_4unsigned int ___UTF_8_get | |||
463 | ___P((___UTF_8STRING *ptr),(char* *ptr) | |||
464 | (ptr)(char* *ptr) | |||
465 | ___UTF_8STRING *ptr;)(char* *ptr) | |||
466 | { | |||
467 | ___UTF_8STRINGchar* p = *ptr; | |||
468 | unsigned char byte = *p++; | |||
469 | ___UCS_4unsigned int c; | |||
470 | int bits; | |||
471 | if (byte <= 0x7f) | |||
472 | { | |||
473 | *ptr = p; | |||
474 | return byte; | |||
475 | } | |||
476 | if (byte <= 0xbf || byte > 0xfd) | |||
477 | return 0; /* illegal first byte */ | |||
478 | c = byte; /* upper bits are removed later */ | |||
479 | bits = 6; | |||
480 | while (byte & 0x40) | |||
481 | { | |||
482 | unsigned char next = *p++; | |||
483 | if (next <= 0x7f || next > 0xbf) | |||
484 | return 0; /* faulty byte found after the first byte */ | |||
485 | c = (c << 6) + (next & 0x3f); | |||
486 | byte <<= 1; | |||
487 | bits += 5; | |||
488 | } | |||
489 | c &= ___CAST(___U32,1<<bits)((unsigned int)(1<<bits))-1; | |||
490 | #ifdef ___REJECT_ILLEGAL_UCS_4 | |||
491 | if ((c > 0xd7ff && c <= 0xdfff) || | |||
492 | (c > 0xfffd && c <= 0xffff)) | |||
493 | return 0; /* it is not a legal UCS-4 character */ | |||
494 | if (c < 0x80 || | |||
495 | c < ((___UCS_4unsigned int)1<<(bits-5))) | |||
496 | return 0; /* character was not encoded with the shortest sequence */ | |||
497 | #endif | |||
498 | *ptr = p; | |||
499 | return c; | |||
500 | } | |||
501 | ||||
502 | ||||
503 | /*---------------------------------------------------------------------------*/ | |||
504 | ||||
505 | /* | |||
506 | * Decoding/encoding of a buffer of characters (of type ___C) to a | |||
507 | * buffer of bytes (of type ___U8) in a certain encoding. | |||
508 | */ | |||
509 | ||||
510 | ||||
511 | #define bytes_per_ISO_8859_11 1 | |||
512 | #define max_ISO_8859_10xff 0xff | |||
513 | ||||
514 | #define bytes_per_UTF_81 1 /* optimization for 1 byte case */ | |||
515 | #define max_UTF_80x7f 0x7f | |||
516 | ||||
517 | #define bytes_per_UTF_162 2 /* optimization for 2 byte case */ | |||
518 | #define max_UTF_160x10ffff 0x10ffff | |||
519 | ||||
520 | #define bytes_per_UCS_22 2 | |||
521 | #define max_UCS_20xffff 0xffff | |||
522 | ||||
523 | #define bytes_per_UCS_44 4 | |||
524 | #define max_UCS_40x7fffffff 0x7fffffff | |||
525 | ||||
526 | ||||
527 | #define DECODE_EOL(loop_label)if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto loop_label ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto loop_label; } state += (2<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto loop_label; } state += (1<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } \ | |||
528 | if (c != ___UNICODE_LINEFEED10) \ | |||
529 | { \ | |||
530 | if (c != ___UNICODE_RETURN13) \ | |||
531 | { \ | |||
532 | state = ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); \ | |||
533 | *clo++ = c; \ | |||
534 | if (clo < chi) \ | |||
535 | goto loop_label; \ | |||
536 | } \ | |||
537 | else \ | |||
538 | { \ | |||
539 | int eol = ___EOL_ENCODING(state)((state)&(3<<7)); \ | |||
540 | if (eol != ___EOL_ENCODING_LF(1<<7)) \ | |||
541 | { \ | |||
542 | if (eol != ___EOL_ENCODING_CR(2<<7)) \ | |||
543 | { \ | |||
544 | int rs = ___DECODE_STATE(state)((state)&(3<<11)); \ | |||
545 | if (rs == ___DECODE_STATE_LF(1<<11)) \ | |||
546 | { \ | |||
547 | state += ___DECODE_STATE_NONE(0<<11)-___DECODE_STATE_LF(1<<11); \ | |||
548 | goto loop_label; \ | |||
549 | } \ | |||
550 | state += ___DECODE_STATE_CR(2<<11)-rs; \ | |||
551 | } \ | |||
552 | c = char_EOL10; \ | |||
553 | } \ | |||
554 | *clo++ = c; \ | |||
555 | if (clo < chi) \ | |||
556 | goto loop_label; \ | |||
557 | } \ | |||
558 | } \ | |||
559 | else \ | |||
560 | { \ | |||
561 | int eol = ___EOL_ENCODING(state)((state)&(3<<7)); \ | |||
562 | if (eol != ___EOL_ENCODING_CR(2<<7)) \ | |||
563 | { \ | |||
564 | if (eol != ___EOL_ENCODING_LF(1<<7)) \ | |||
565 | { \ | |||
566 | int rs = ___DECODE_STATE(state)((state)&(3<<11)); \ | |||
567 | if (rs == ___DECODE_STATE_CR(2<<11)) \ | |||
568 | { \ | |||
569 | state += ___DECODE_STATE_NONE(0<<11)-___DECODE_STATE_CR(2<<11); \ | |||
570 | goto loop_label; \ | |||
571 | } \ | |||
572 | state += ___DECODE_STATE_LF(1<<11)-rs; \ | |||
573 | } \ | |||
574 | c = char_EOL10; \ | |||
575 | } \ | |||
576 | *clo++ = c; \ | |||
577 | if (clo < chi) \ | |||
578 | goto loop_label; \ | |||
579 | } | |||
580 | ||||
581 | ||||
582 | #define DECODE_CHARS_LOOP(loop_label,bytes_per_char,max_char,get_char)loop_label: blo += bytes_per_char; if (blo <= bhi) { c = get_char (-1); if (max_char <= 0x10ffff || c <= 0x10ffff) { if ( c != 10) { if (c != 13) { state = ((state)&~(3<<11) )+(0<<11); *clo++ = c; if (clo < chi) goto loop_label ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto loop_label; } state += (2<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto loop_label; } state += (1<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } } else if (blo - bytes_per_char == byte_buf) result = 2; else blo -= bytes_per_char; } else { blo -= bytes_per_char; if (bytes_per_char > 1 && blo == byte_buf) result = 1; } break; \ | |||
583 | loop_label: \ | |||
584 | blo += bytes_per_char; \ | |||
585 | if (blo <= bhi) \ | |||
586 | { \ | |||
587 | c = get_char(-1); \ | |||
588 | if (max_char <= ___MAX_CHR0x10ffff || \ | |||
589 | c <= ___MAX_CHR0x10ffff) \ | |||
590 | { \ | |||
591 | DECODE_EOL(loop_label)if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto loop_label ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto loop_label; } state += (2<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto loop_label; } state += (1<<11)- rs; } c = 10; } *clo++ = c; if (clo < chi) goto loop_label ; } \ | |||
592 | } \ | |||
593 | else if (blo - bytes_per_char == byte_buf) \ | |||
594 | result = ___ILLEGAL_CHAR2; \ | |||
595 | else \ | |||
596 | blo -= bytes_per_char; \ | |||
597 | } \ | |||
598 | else \ | |||
599 | { \ | |||
600 | blo -= bytes_per_char; \ | |||
601 | if (bytes_per_char > 1 && \ | |||
602 | blo == byte_buf) \ | |||
603 | result = ___INCOMPLETE_CHAR1; \ | |||
604 | } \ | |||
605 | break; | |||
606 | ||||
607 | ||||
608 | #define ENCODE_EOL(loop_label,bytes_per_char,put_char)switch (((state)&(3<<7))) { case (2<<7): put_char (-1,13); break; case (3<<7): blo += bytes_per_char; if ( blo > bhi) { blo -= 2*bytes_per_char; clo--; goto encode_chars_end ; } put_char(-2,13); default: put_char(-1,10); break; } if (! (((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto loop_label; \ | |||
609 | switch (___EOL_ENCODING(state)((state)&(3<<7))) \ | |||
610 | { \ | |||
611 | case ___EOL_ENCODING_CR(2<<7): \ | |||
612 | put_char(-1,___UNICODE_RETURN13); \ | |||
613 | break; \ | |||
614 | case ___EOL_ENCODING_CRLF(3<<7): \ | |||
615 | blo += bytes_per_char; \ | |||
616 | if (blo > bhi) \ | |||
617 | { \ | |||
618 | blo -= 2*bytes_per_char; \ | |||
619 | clo--; \ | |||
620 | goto encode_chars_end; \ | |||
621 | } \ | |||
622 | put_char(-2,___UNICODE_RETURN13); \ | |||
623 | default: \ | |||
624 | put_char(-1,___UNICODE_LINEFEED10); \ | |||
625 | break; \ | |||
626 | } \ | |||
627 | if (!___FULLY_BUFFERED(state)(((state)&(3<<9))>=(3<<9))) \ | |||
628 | goto encode_chars_end; /* must empty byte buffer */ \ | |||
629 | else if (clo < chi) \ | |||
630 | goto loop_label; | |||
631 | ||||
632 | ||||
633 | #define ENCODE_CHARS_LOOP(loop_label,bytes_per_char,max_char,put_char)loop_label: c = *clo++; if (0x10ffff <= max_char || c <= max_char) { blo += bytes_per_char; if (blo <= bhi) { if ( c != 10) { put_char(-1,c); if (clo < chi) goto loop_label; } else { switch (((state)&(3<<7))) { case (2<< 7): put_char(-1,13); break; case (3<<7): blo += bytes_per_char ; if (blo > bhi) { blo -= 2*bytes_per_char; clo--; goto encode_chars_end ; } put_char(-2,13); default: put_char(-1,10); break; } if (! (((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto loop_label;; } } else { blo -= bytes_per_char ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; \ | |||
634 | loop_label: \ | |||
635 | c = *clo++; \ | |||
636 | if (___MAX_CHR0x10ffff <= max_char || \ | |||
637 | c <= max_char) \ | |||
638 | { \ | |||
639 | blo += bytes_per_char; \ | |||
640 | if (blo <= bhi) \ | |||
641 | { \ | |||
642 | if (c != char_EOL10) \ | |||
643 | { \ | |||
644 | put_char(-1,c); \ | |||
645 | if (clo < chi) \ | |||
646 | goto loop_label; \ | |||
647 | } \ | |||
648 | else \ | |||
649 | { \ | |||
650 | ENCODE_EOL(loop_label,bytes_per_char,put_char)switch (((state)&(3<<7))) { case (2<<7): put_char (-1,13); break; case (3<<7): blo += bytes_per_char; if ( blo > bhi) { blo -= 2*bytes_per_char; clo--; goto encode_chars_end ; } put_char(-2,13); default: put_char(-1,10); break; } if (! (((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto loop_label;; \ | |||
651 | } \ | |||
652 | } \ | |||
653 | else \ | |||
654 | { \ | |||
655 | blo -= bytes_per_char; \ | |||
656 | clo--; \ | |||
657 | goto encode_chars_end; \ | |||
658 | } \ | |||
659 | } \ | |||
660 | else \ | |||
661 | { \ | |||
662 | clo--; \ | |||
663 | if (clo == char_buf) \ | |||
664 | result = ___ILLEGAL_CHAR2; \ | |||
665 | goto encode_chars_end; \ | |||
666 | } \ | |||
667 | break; | |||
668 | ||||
669 | ||||
670 | #define get_ISO_8859_1(i)blo[(i)*1] \ | |||
671 | blo[(i)*bytes_per_ISO_8859_11] | |||
672 | ||||
673 | #define get_UTF_8(i)blo[(i)*1] \ | |||
674 | blo[(i)*bytes_per_UTF_81] | |||
675 | ||||
676 | #define get_UTF_16BE(i)(((unsigned short)(blo[(i)*2 +0])) << 8) + ((unsigned short )(blo[(i)*2 +1])) \ | |||
677 | (___CAST(___UTF_16,blo[(i)*bytes_per_UTF_16+0])((unsigned short)(blo[(i)*2 +0])) << 8) + \((unsigned short)(blo[(i)*2 +1])) | |||
678 | ___CAST(___UTF_16,blo[(i)*bytes_per_UTF_16+1])((unsigned short)(blo[(i)*2 +1])) | |||
679 | ||||
680 | #define get_UTF_16LE(i)(((unsigned short)(blo[(i)*2 +1])) << 8) + ((unsigned short )(blo[(i)*2 +0])) \ | |||
681 | (___CAST(___UTF_16,blo[(i)*bytes_per_UTF_16+1])((unsigned short)(blo[(i)*2 +1])) << 8) + \((unsigned short)(blo[(i)*2 +0])) | |||
682 | ___CAST(___UTF_16,blo[(i)*bytes_per_UTF_16+0])((unsigned short)(blo[(i)*2 +0])) | |||
683 | ||||
684 | #define get_UCS_2BE(i)(((unsigned short)(blo[(i)*2 +0])) << 8) + ((unsigned short )(blo[(i)*2 +1])) \ | |||
685 | (___CAST(___UCS_2,blo[(i)*bytes_per_UCS_2+0])((unsigned short)(blo[(i)*2 +0])) << 8) + \((unsigned short)(blo[(i)*2 +1])) | |||
686 | ___CAST(___UCS_2,blo[(i)*bytes_per_UCS_2+1])((unsigned short)(blo[(i)*2 +1])) | |||
687 | ||||
688 | #define get_UCS_2LE(i)(((unsigned short)(blo[(i)*2 +1])) << 8) + ((unsigned short )(blo[(i)*2 +0])) \ | |||
689 | (___CAST(___UCS_2,blo[(i)*bytes_per_UCS_2+1])((unsigned short)(blo[(i)*2 +1])) << 8) + \((unsigned short)(blo[(i)*2 +0])) | |||
690 | ___CAST(___UCS_2,blo[(i)*bytes_per_UCS_2+0])((unsigned short)(blo[(i)*2 +0])) | |||
691 | ||||
692 | #define get_UCS_4BE(i)(((((((unsigned int)(blo[(i)*4 +0])) << 8) + ((unsigned int)(blo[(i)*4 +1]))) << 8) + ((unsigned int)(blo[(i)* 4 +2]))) << 8) + ((unsigned int)(blo[(i)*4 +3])) \ | |||
693 | (((((___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+0])((unsigned int)(blo[(i)*4 +0])) << 8) + \ | |||
694 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+1])((unsigned int)(blo[(i)*4 +1]))) << 8) + \ | |||
695 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+2])((unsigned int)(blo[(i)*4 +2]))) << 8) + \((unsigned int)(blo[(i)*4 +3])) | |||
696 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+3])((unsigned int)(blo[(i)*4 +3])) | |||
697 | ||||
698 | #define get_UCS_4LE(i)(((((((unsigned int)(blo[(i)*4 +3])) << 8) + ((unsigned int)(blo[(i)*4 +2]))) << 8) + ((unsigned int)(blo[(i)* 4 +1]))) << 8) + ((unsigned int)(blo[(i)*4 +0])) \ | |||
699 | (((((___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+3])((unsigned int)(blo[(i)*4 +3])) << 8) + \ | |||
700 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+2])((unsigned int)(blo[(i)*4 +2]))) << 8) + \ | |||
701 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+1])((unsigned int)(blo[(i)*4 +1]))) << 8) + \((unsigned int)(blo[(i)*4 +0])) | |||
702 | ___CAST(___UCS_4,blo[(i)*bytes_per_UCS_4+0])((unsigned int)(blo[(i)*4 +0])) | |||
703 | ||||
704 | #define put_ISO_8859_1(i,c)blo[(i)*1] = (c); \ | |||
705 | blo[(i)*bytes_per_ISO_8859_11] = (c); | |||
706 | ||||
707 | #define put_UTF_8(i,c)blo[(i)*1] = (c); \ | |||
708 | blo[(i)*bytes_per_UTF_81] = (c); | |||
709 | ||||
710 | #define put_UTF_16BE(i,c)blo[(i)*2 +1] = (c) & 0xff; blo[(i)*2 +0] = ((c)>>8 ) & 0xff; \ | |||
711 | blo[(i)*bytes_per_UTF_162+1] = (c) & 0xff; \ | |||
712 | blo[(i)*bytes_per_UTF_162+0] = ((c)>>8) & 0xff; | |||
713 | ||||
714 | #define put_UTF_16LE(i,c)blo[(i)*2 +0] = (c) & 0xff; blo[(i)*2 +1] = ((c)>>8 ) & 0xff; \ | |||
715 | blo[(i)*bytes_per_UTF_162+0] = (c) & 0xff; \ | |||
716 | blo[(i)*bytes_per_UTF_162+1] = ((c)>>8) & 0xff; | |||
717 | ||||
718 | #define put_UCS_2BE(i,c)blo[(i)*2 +1] = (c) & 0xff; blo[(i)*2 +0] = ((c)>>8 ) & 0xff; \ | |||
719 | blo[(i)*bytes_per_UCS_22+1] = (c) & 0xff; \ | |||
720 | blo[(i)*bytes_per_UCS_22+0] = ((c)>>8) & 0xff; | |||
721 | ||||
722 | #define put_UCS_2LE(i,c)blo[(i)*2 +0] = (c) & 0xff; blo[(i)*2 +1] = ((c)>>8 ) & 0xff; \ | |||
723 | blo[(i)*bytes_per_UCS_22+0] = (c) & 0xff; \ | |||
724 | blo[(i)*bytes_per_UCS_22+1] = ((c)>>8) & 0xff; | |||
725 | ||||
726 | #define put_UCS_4BE(i,c)blo[(i)*4 +3] = (c) & 0xff; blo[(i)*4 +2] = ((c)>>8 ) & 0xff; blo[(i)*4 +1] = ((c)>>16) & 0xff; blo [(i)*4 +0] = ((c)>>24) & 0xff; \ | |||
727 | blo[(i)*bytes_per_UCS_44+3] = (c) & 0xff; \ | |||
728 | blo[(i)*bytes_per_UCS_44+2] = ((c)>>8) & 0xff; \ | |||
729 | blo[(i)*bytes_per_UCS_44+1] = ((c)>>16) & 0xff; \ | |||
730 | blo[(i)*bytes_per_UCS_44+0] = ((c)>>24) & 0xff; | |||
731 | ||||
732 | #define put_UCS_4LE(i,c)blo[(i)*4 +0] = (c) & 0xff; blo[(i)*4 +1] = ((c)>>8 ) & 0xff; blo[(i)*4 +2] = ((c)>>16) & 0xff; blo [(i)*4 +3] = ((c)>>24) & 0xff; \ | |||
733 | blo[(i)*bytes_per_UCS_44+0] = (c) & 0xff; \ | |||
734 | blo[(i)*bytes_per_UCS_44+1] = ((c)>>8) & 0xff; \ | |||
735 | blo[(i)*bytes_per_UCS_44+2] = ((c)>>16) & 0xff; \ | |||
736 | blo[(i)*bytes_per_UCS_44+3] = ((c)>>24) & 0xff; | |||
737 | ||||
738 | ||||
739 | int chars_from_bytes | |||
740 | ___P((___C *char_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
741 | int *char_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
742 | ___U8 *byte_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
743 | int *byte_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
744 | int *decoding_state),(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
745 | (char_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
746 | char_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
747 | byte_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
748 | byte_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
749 | decoding_state)(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
750 | ___C *char_buf;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
751 | int *char_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
752 | ___U8 *byte_buf;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
753 | int *byte_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
754 | int *decoding_state;)(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *decoding_state) | |||
755 | { | |||
756 | int result; | |||
757 | ___UCS_4unsigned int c; | |||
758 | ___Cunsigned int *clo = char_buf; | |||
759 | ___Cunsigned int *chi = char_buf + *char_buf_avail; | |||
760 | ___U8unsigned char *blo = byte_buf; | |||
761 | ___U8unsigned char *bhi = byte_buf + *byte_buf_avail; | |||
762 | int state = *decoding_state; | |||
763 | ||||
764 | result = ___CONVERSION_DONE0; | |||
765 | ||||
766 | /* fill character buffer as much as possible */ | |||
767 | ||||
768 | if (clo < chi && blo < bhi) | |||
769 | { | |||
770 | /* there is still some space in the character buffer and byte buffer */ | |||
771 | ||||
772 | dispatch_on_char_encoding: | |||
773 | ||||
774 | switch (___CHAR_ENCODING(state)((state)&(31<<0))) | |||
775 | { | |||
776 | default: | |||
777 | case ___CHAR_ENCODING_ASCII(1<<0): | |||
778 | case ___CHAR_ENCODING_ISO_8859_1(2<<0): | |||
779 | DECODE_CHARS_LOOP(decode_next_ISO_8859_1,decode_next_ISO_8859_1: blo += 1; if (blo <= bhi) { c = blo [(-1)*1]; if (0xff <= 0x10ffff || c <= 0x10ffff) { if ( c != 10) { if (c != 13) { state = ((state)&~(3<<11) )+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1 ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_ISO_8859_1; } state += (2 <<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else { int eol = ((state)&(3 <<7)); if (eol != (2<<7)) { if (eol != (1<< 7)) { int rs = ((state)&(3<<11)); if (rs == (2<< 11)) { state += (0<<11)-(2<<11); goto decode_next_ISO_8859_1 ; } state += (1<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else if (blo - 1 == byte_buf) result = 2; else blo -= 1; } else { blo -= 1; if ( 1 > 1 && blo == byte_buf) result = 1; } break; | |||
780 | bytes_per_ISO_8859_1,decode_next_ISO_8859_1: blo += 1; if (blo <= bhi) { c = blo [(-1)*1]; if (0xff <= 0x10ffff || c <= 0x10ffff) { if ( c != 10) { if (c != 13) { state = ((state)&~(3<<11) )+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1 ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_ISO_8859_1; } state += (2 <<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else { int eol = ((state)&(3 <<7)); if (eol != (2<<7)) { if (eol != (1<< 7)) { int rs = ((state)&(3<<11)); if (rs == (2<< 11)) { state += (0<<11)-(2<<11); goto decode_next_ISO_8859_1 ; } state += (1<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else if (blo - 1 == byte_buf) result = 2; else blo -= 1; } else { blo -= 1; if ( 1 > 1 && blo == byte_buf) result = 1; } break; | |||
781 | 0xff,decode_next_ISO_8859_1: blo += 1; if (blo <= bhi) { c = blo [(-1)*1]; if (0xff <= 0x10ffff || c <= 0x10ffff) { if ( c != 10) { if (c != 13) { state = ((state)&~(3<<11) )+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1 ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_ISO_8859_1; } state += (2 <<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else { int eol = ((state)&(3 <<7)); if (eol != (2<<7)) { if (eol != (1<< 7)) { int rs = ((state)&(3<<11)); if (rs == (2<< 11)) { state += (0<<11)-(2<<11); goto decode_next_ISO_8859_1 ; } state += (1<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else if (blo - 1 == byte_buf) result = 2; else blo -= 1; } else { blo -= 1; if ( 1 > 1 && blo == byte_buf) result = 1; } break; | |||
782 | get_ISO_8859_1)decode_next_ISO_8859_1: blo += 1; if (blo <= bhi) { c = blo [(-1)*1]; if (0xff <= 0x10ffff || c <= 0x10ffff) { if ( c != 10) { if (c != 13) { state = ((state)&~(3<<11) )+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1 ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_ISO_8859_1; } state += (2 <<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else { int eol = ((state)&(3 <<7)); if (eol != (2<<7)) { if (eol != (1<< 7)) { int rs = ((state)&(3<<11)); if (rs == (2<< 11)) { state += (0<<11)-(2<<11); goto decode_next_ISO_8859_1 ; } state += (1<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_ISO_8859_1; } } else if (blo - 1 == byte_buf) result = 2; else blo -= 1; } else { blo -= 1; if ( 1 > 1 && blo == byte_buf) result = 1; } break;; | |||
783 | ||||
784 | case ___CHAR_ENCODING_UTF_8(3<<0): | |||
785 | { | |||
786 | decode_next_UTF_8: | |||
787 | blo += bytes_per_UTF_81; | |||
788 | if (blo <= bhi) | |||
789 | { | |||
790 | c = get_UTF_8(-1)blo[(-1)*1]; | |||
791 | if (c <= 0x7f) | |||
792 | { | |||
793 | DECODE_EOL(decode_next_UTF_8)if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UTF_8 ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UTF_8; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_8 ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UTF_8; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_8 ; }; | |||
794 | } | |||
795 | else if (c <= 0xbf || c > 0xfd) | |||
796 | { | |||
797 | if (blo - bytes_per_UTF_81 == byte_buf) | |||
798 | result = ___ILLEGAL_CHAR2; | |||
799 | else | |||
800 | blo -= bytes_per_UTF_81; | |||
801 | } | |||
802 | else | |||
803 | { | |||
804 | ___U8unsigned char* orig_blo = blo; | |||
805 | ___U8unsigned char b0 = c; | |||
806 | int bits = 6; | |||
807 | while (b0 & 0x40) | |||
808 | { | |||
809 | ___U8unsigned char next = *blo++; | |||
810 | if (blo > bhi) | |||
811 | { | |||
812 | blo = orig_blo-bytes_per_UTF_81; | |||
813 | if (blo == byte_buf) | |||
814 | result = ___INCOMPLETE_CHAR1; | |||
815 | goto end_UTF_8; | |||
816 | } | |||
817 | if (next <= 0x7f || next > 0xbf) | |||
818 | { | |||
819 | if (orig_blo-bytes_per_UTF_81 == byte_buf) | |||
820 | result = ___ILLEGAL_CHAR2; | |||
821 | else | |||
822 | blo = orig_blo-bytes_per_UTF_81; | |||
823 | goto end_UTF_8; | |||
824 | } | |||
825 | c = (c << 6) + (next & 0x3f); | |||
826 | b0 <<= 1; | |||
827 | bits += 5; | |||
828 | } | |||
829 | c &= (___CAST(___UCS_4,1)((unsigned int)(1))<<bits)-1; | |||
830 | if (c >= 0x80 && | |||
831 | c >= (___CAST(___UCS_4,1)((unsigned int)(1))<<(bits-5)) && | |||
832 | c <= ___MAX_CHR0x10ffff) | |||
833 | { | |||
834 | state = | |||
835 | ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); | |||
836 | *clo++ = c; | |||
837 | if (clo < chi) | |||
838 | goto decode_next_UTF_8; | |||
839 | } | |||
840 | else | |||
841 | { | |||
842 | if (orig_blo-bytes_per_UTF_81 == byte_buf) | |||
843 | result = ___ILLEGAL_CHAR2; | |||
844 | else | |||
845 | blo = orig_blo-bytes_per_UTF_81; | |||
846 | } | |||
847 | end_UTF_8:; | |||
848 | } | |||
849 | } | |||
850 | else | |||
851 | blo -= bytes_per_UTF_81; | |||
852 | break; | |||
853 | } | |||
854 | ||||
855 | case ___CHAR_ENCODING_UTF_16(4<<0): | |||
856 | { | |||
857 | blo += bytes_per_UTF_162; | |||
858 | if (blo <= bhi) | |||
859 | { | |||
860 | ___UCS_4unsigned int cle; | |||
861 | c = get_UTF_16BE(-1)(((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short )(blo[(-1)*2 +1])); | |||
862 | if (c == ___UNICODE_BOM0xfeff) | |||
863 | { | |||
864 | state += ___CHAR_ENCODING_UTF_16BE(5<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
865 | goto decode_next_UTF_16BE; | |||
866 | } | |||
867 | cle = ((c&0xff) << 8) + | |||
868 | ((c>>8)&0xff); | |||
869 | if (cle == ___UNICODE_BOM0xfeff) | |||
870 | { | |||
871 | state += ___CHAR_ENCODING_UTF_16LE(6<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
872 | goto decode_next_UTF_16LE; | |||
873 | } | |||
874 | blo -= bytes_per_UTF_162; | |||
875 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
876 | state += ___CHAR_ENCODING_UTF_16BE(5<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
877 | goto decode_next_UTF_16BE; | |||
878 | #else | |||
879 | state += ___CHAR_ENCODING_UTF_16LE(6<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
880 | goto decode_next_UTF_16LE; | |||
881 | #endif | |||
882 | } | |||
883 | else | |||
884 | { | |||
885 | blo -= bytes_per_UTF_162; | |||
886 | if (bytes_per_UTF_162 > 1 && | |||
887 | blo == byte_buf) | |||
888 | result = ___INCOMPLETE_CHAR1; | |||
889 | } | |||
890 | break; | |||
891 | } | |||
892 | ||||
893 | case ___CHAR_ENCODING_UTF_16BE(5<<0): | |||
894 | { | |||
895 | decode_next_UTF_16BE: | |||
896 | blo += bytes_per_UTF_162; | |||
897 | if (blo <= bhi) | |||
898 | { | |||
899 | c = get_UTF_16BE(-1)(((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short )(blo[(-1)*2 +1])); | |||
900 | if (c <= 0xd7ff) | |||
901 | { | |||
902 | if (c <= ___MAX_CHR0x10ffff) | |||
903 | { | |||
904 | DECODE_EOL(decode_next_UTF_16BE)if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UTF_16BE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UTF_16BE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_16BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UTF_16BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_16BE ; }; | |||
905 | } | |||
906 | else | |||
907 | { | |||
908 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
909 | result = ___ILLEGAL_CHAR2; | |||
910 | else | |||
911 | blo = blo-bytes_per_UTF_162; | |||
912 | } | |||
913 | } | |||
914 | else if (c > 0xdfff) | |||
915 | { | |||
916 | if (c <= ___MAX_CHR0x10ffff) | |||
917 | { | |||
918 | state = | |||
919 | ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); | |||
920 | *clo++ = c; | |||
921 | if (clo < chi) | |||
922 | goto decode_next_UTF_16BE; | |||
923 | } | |||
924 | else | |||
925 | { | |||
926 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
927 | result = ___ILLEGAL_CHAR2; | |||
928 | else | |||
929 | blo = blo-bytes_per_UTF_162; | |||
930 | } | |||
931 | } | |||
932 | else if (c > 0xdbff) | |||
933 | { | |||
934 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
935 | result = ___ILLEGAL_CHAR2; | |||
936 | else | |||
937 | blo = blo-bytes_per_UTF_162; | |||
938 | } | |||
939 | else | |||
940 | { | |||
941 | blo += bytes_per_UTF_162; | |||
942 | if (blo <= bhi) | |||
943 | { | |||
944 | ___UCS_4unsigned int x = get_UTF_16BE(-1)(((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short )(blo[(-1)*2 +1])); | |||
945 | if (x > 0xdbff && | |||
946 | x <= 0xdfff && | |||
947 | (c = (c << 10) + x - | |||
948 | ((0xd800 << 10) + 0xdc00 - 0x10000)) | |||
949 | <= ___MAX_CHR0x10ffff) | |||
950 | { | |||
951 | state = | |||
952 | ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); | |||
953 | *clo++ = c; | |||
954 | if (clo < chi) | |||
955 | goto decode_next_UTF_16BE; | |||
956 | } | |||
957 | else | |||
958 | { | |||
959 | if (blo-2*bytes_per_UTF_162 == byte_buf) | |||
960 | result = ___ILLEGAL_CHAR2; | |||
961 | else | |||
962 | blo = blo-2*bytes_per_UTF_162; | |||
963 | } | |||
964 | } | |||
965 | else | |||
966 | { | |||
967 | if (blo-2*bytes_per_UTF_162 == byte_buf) | |||
968 | result = ___ILLEGAL_CHAR2; | |||
969 | else | |||
970 | blo = blo-2*bytes_per_UTF_162; | |||
971 | } | |||
972 | } | |||
973 | } | |||
974 | else | |||
975 | blo -= bytes_per_UTF_162; | |||
976 | break; | |||
977 | } | |||
978 | ||||
979 | case ___CHAR_ENCODING_UTF_16LE(6<<0): | |||
980 | { | |||
981 | decode_next_UTF_16LE: | |||
982 | blo += bytes_per_UTF_162; | |||
983 | if (blo <= bhi) | |||
984 | { | |||
985 | c = get_UTF_16LE(-1)(((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short )(blo[(-1)*2 +0])); | |||
986 | if (c <= 0xd7ff) | |||
987 | { | |||
988 | if (c <= ___MAX_CHR0x10ffff) | |||
989 | { | |||
990 | DECODE_EOL(decode_next_UTF_16LE)if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UTF_16LE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UTF_16LE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_16LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UTF_16LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UTF_16LE ; }; | |||
991 | } | |||
992 | else | |||
993 | { | |||
994 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
995 | result = ___ILLEGAL_CHAR2; | |||
996 | else | |||
997 | blo = blo-bytes_per_UTF_162; | |||
998 | } | |||
999 | } | |||
1000 | else if (c > 0xdfff) | |||
1001 | { | |||
1002 | if (c <= ___MAX_CHR0x10ffff) | |||
1003 | { | |||
1004 | state = | |||
1005 | ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); | |||
1006 | *clo++ = c; | |||
1007 | if (clo < chi) | |||
1008 | goto decode_next_UTF_16LE; | |||
1009 | } | |||
1010 | else | |||
1011 | { | |||
1012 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
1013 | result = ___ILLEGAL_CHAR2; | |||
1014 | else | |||
1015 | blo = blo-bytes_per_UTF_162; | |||
1016 | } | |||
1017 | } | |||
1018 | else if (c > 0xdbff) | |||
1019 | { | |||
1020 | if (blo-bytes_per_UTF_162 == byte_buf) | |||
1021 | result = ___ILLEGAL_CHAR2; | |||
1022 | else | |||
1023 | blo = blo-bytes_per_UTF_162; | |||
1024 | } | |||
1025 | else | |||
1026 | { | |||
1027 | blo += bytes_per_UTF_162; | |||
1028 | if (blo <= bhi) | |||
1029 | { | |||
1030 | ___UCS_4unsigned int x = get_UTF_16LE(-1)(((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short )(blo[(-1)*2 +0])); | |||
1031 | if (x > 0xdbff && | |||
1032 | x <= 0xdfff && | |||
1033 | (c = (c << 10) + x - | |||
1034 | ((0xd800 << 10) + 0xdc00 - 0x10000)) | |||
1035 | <= ___MAX_CHR0x10ffff) | |||
1036 | { | |||
1037 | state = | |||
1038 | ___DECODE_STATE_MASK(state)((state)&~(3<<11))+___DECODE_STATE_NONE(0<<11); | |||
1039 | *clo++ = c; | |||
1040 | if (clo < chi) | |||
1041 | goto decode_next_UTF_16LE; | |||
1042 | } | |||
1043 | else | |||
1044 | { | |||
1045 | if (blo-2*bytes_per_UTF_162 == byte_buf) | |||
1046 | result = ___ILLEGAL_CHAR2; | |||
1047 | else | |||
1048 | blo = blo-2*bytes_per_UTF_162; | |||
1049 | } | |||
1050 | } | |||
1051 | else | |||
1052 | { | |||
1053 | if (blo-2*bytes_per_UTF_162 == byte_buf) | |||
1054 | result = ___ILLEGAL_CHAR2; | |||
1055 | else | |||
1056 | blo = blo-2*bytes_per_UTF_162; | |||
1057 | } | |||
1058 | } | |||
1059 | } | |||
1060 | else | |||
1061 | blo -= bytes_per_UTF_162; | |||
1062 | break; | |||
1063 | } | |||
1064 | ||||
1065 | case ___CHAR_ENCODING_UTF_FALLBACK_ASCII(7<<0): | |||
1066 | case ___CHAR_ENCODING_UTF_FALLBACK_ISO_8859_1(8<<0): | |||
1067 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_8(9<<0): | |||
1068 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16(10<<0): | |||
1069 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16BE(11<<0): | |||
1070 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16LE(12<<0): | |||
1071 | { | |||
1072 | if (blo < bhi) | |||
1073 | { | |||
1074 | ___U8unsigned char b0 = blo[0]; | |||
1075 | if (b0 >= 0xfe) | |||
1076 | { | |||
1077 | /* start of UTF-16BE or UTF-16LE BOM */ | |||
1078 | if (blo+1 < bhi) | |||
1079 | { | |||
1080 | if (blo[1] == (b0 ^ 1)) | |||
1081 | { | |||
1082 | /* complete BOM */ | |||
1083 | blo += 2; /* skip BOM */ | |||
1084 | if (b0 == 0xfe) | |||
1085 | { | |||
1086 | state += ___CHAR_ENCODING_UTF_16BE(5<<0) - | |||
1087 | ___CHAR_ENCODING_UTF(9<<0); | |||
1088 | goto decode_next_UTF_16BE; | |||
1089 | } | |||
1090 | else | |||
1091 | { | |||
1092 | state += ___CHAR_ENCODING_UTF_16LE(6<<0) - | |||
1093 | ___CHAR_ENCODING_UTF(9<<0); | |||
1094 | goto decode_next_UTF_16LE; | |||
1095 | } | |||
1096 | } | |||
1097 | else | |||
1098 | { | |||
1099 | /* not a UTF-16BE BOM, so use fallback encoding */ | |||
1100 | state += ___CHAR_ENCODING_ASCII(1<<0) - | |||
1101 | ___CHAR_ENCODING_UTF_FALLBACK_ASCII(7<<0); | |||
1102 | goto dispatch_on_char_encoding; | |||
1103 | } | |||
1104 | } | |||
1105 | } | |||
1106 | else | |||
1107 | { | |||
1108 | /* check start of UTF-8 BOM */ | |||
1109 | if ((b0 != 0xef) || | |||
1110 | (blo+1 < bhi && blo[1] != 0xbb) || | |||
1111 | (blo+2 < bhi && blo[2] != 0xbf)) | |||
1112 | { | |||
1113 | /* not a UTF-8 BOM, so use fallback encoding */ | |||
1114 | state += ___CHAR_ENCODING_ASCII(1<<0) - | |||
1115 | ___CHAR_ENCODING_UTF_FALLBACK_ASCII(7<<0); | |||
1116 | goto dispatch_on_char_encoding; | |||
1117 | } | |||
1118 | else if (blo+2 < bhi) | |||
1119 | { | |||
1120 | /* complete UTF-8 BOM */ | |||
1121 | blo += 3; /* skip BOM */ | |||
1122 | state += ___CHAR_ENCODING_UTF_8(3<<0) - | |||
1123 | ___CHAR_ENCODING_UTF(9<<0); | |||
1124 | goto decode_next_UTF_8; | |||
1125 | } | |||
1126 | } | |||
1127 | } | |||
1128 | result = ___INCOMPLETE_CHAR1; | |||
1129 | break; | |||
1130 | } | |||
1131 | ||||
1132 | case ___CHAR_ENCODING_UCS_2(13<<0): | |||
1133 | { | |||
1134 | blo += bytes_per_UCS_22; | |||
1135 | if (blo <= bhi) | |||
1136 | { | |||
1137 | ___UCS_4unsigned int cle; | |||
1138 | c = get_UCS_2BE(-1)(((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short )(blo[(-1)*2 +1])); | |||
1139 | if (c == ___UNICODE_BOM0xfeff) | |||
1140 | { | |||
1141 | state += ___CHAR_ENCODING_UCS_2BE(14<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1142 | goto decode_next_UCS_2BE; | |||
1143 | } | |||
1144 | cle = ((c&0xff) << 8) + | |||
1145 | ((c>>8)&0xff); | |||
1146 | if (cle == ___UNICODE_BOM0xfeff) | |||
1147 | { | |||
1148 | state += ___CHAR_ENCODING_UCS_2LE(15<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1149 | goto decode_next_UCS_2LE; | |||
1150 | } | |||
1151 | blo -= bytes_per_UCS_22; | |||
1152 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
1153 | state += ___CHAR_ENCODING_UCS_2BE(14<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1154 | goto decode_next_UCS_2BE; | |||
1155 | #else | |||
1156 | state += ___CHAR_ENCODING_UCS_2LE(15<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1157 | goto decode_next_UCS_2LE; | |||
1158 | #endif | |||
1159 | } | |||
1160 | else | |||
1161 | { | |||
1162 | blo -= bytes_per_UCS_22; | |||
1163 | if (bytes_per_UCS_22 > 1 && | |||
1164 | blo == byte_buf) | |||
1165 | result = ___INCOMPLETE_CHAR1; | |||
1166 | } | |||
1167 | break; | |||
1168 | } | |||
1169 | ||||
1170 | case ___CHAR_ENCODING_UCS_2BE(14<<0): | |||
1171 | DECODE_CHARS_LOOP(decode_next_UCS_2BE,decode_next_UCS_2BE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short)(blo[ (-1)*2 +1])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2BE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1172 | bytes_per_UCS_2,decode_next_UCS_2BE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short)(blo[ (-1)*2 +1])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2BE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1173 | 0xffff,decode_next_UCS_2BE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short)(blo[ (-1)*2 +1])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2BE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1174 | get_UCS_2BE)decode_next_UCS_2BE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +0])) << 8) + ((unsigned short)(blo[ (-1)*2 +1])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2BE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2BE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break;; | |||
1175 | ||||
1176 | case ___CHAR_ENCODING_UCS_2LE(15<<0): | |||
1177 | DECODE_CHARS_LOOP(decode_next_UCS_2LE,decode_next_UCS_2LE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short)(blo[ (-1)*2 +0])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2LE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1178 | bytes_per_UCS_2,decode_next_UCS_2LE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short)(blo[ (-1)*2 +0])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2LE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1179 | 0xffff,decode_next_UCS_2LE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short)(blo[ (-1)*2 +0])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2LE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break; | |||
1180 | get_UCS_2LE)decode_next_UCS_2LE: blo += 2; if (blo <= bhi) { c = (((unsigned short)(blo[(-1)*2 +1])) << 8) + ((unsigned short)(blo[ (-1)*2 +0])); if (0xffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<< 11))+(0<<11); *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } else { int eol = ((state)&(3<<7)); if (eol != ( 1<<7)) { if (eol != (2<<7)) { int rs = ((state)& (3<<11)); if (rs == (1<<11)) { state += (0<< 11)-(1<<11); goto decode_next_UCS_2LE; } state += (2<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_2LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_2LE ; } } else if (blo - 2 == byte_buf) result = 2; else blo -= 2 ; } else { blo -= 2; if (2 > 1 && blo == byte_buf) result = 1; } break;; | |||
1181 | ||||
1182 | case ___CHAR_ENCODING_UCS_4(16<<0): | |||
1183 | { | |||
1184 | blo += bytes_per_UCS_44; | |||
1185 | if (blo <= bhi) | |||
1186 | { | |||
1187 | ___UCS_4unsigned int cle; | |||
1188 | c = get_UCS_4BE(-1)(((((((unsigned int)(blo[(-1)*4 +0])) << 8) + ((unsigned int)(blo[(-1)*4 +1]))) << 8) + ((unsigned int)(blo[(-1 )*4 +2]))) << 8) + ((unsigned int)(blo[(-1)*4 +3])); | |||
1189 | if (c == ___UNICODE_BOM0xfeff) | |||
1190 | { | |||
1191 | state += ___CHAR_ENCODING_UCS_4BE(17<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1192 | goto decode_next_UCS_4BE; | |||
1193 | } | |||
1194 | cle = ((((((c&0xff) << 8) + | |||
1195 | ((c>>8)&0xff)) << 8) + | |||
1196 | ((c>>16)&0xff)) << 8) + | |||
1197 | ((c>>24)&0xff); | |||
1198 | if (cle == ___UNICODE_BOM0xfeff) | |||
1199 | { | |||
1200 | state += ___CHAR_ENCODING_UCS_4LE(18<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1201 | goto decode_next_UCS_4LE; | |||
1202 | } | |||
1203 | blo -= bytes_per_UCS_44; | |||
1204 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
1205 | state += ___CHAR_ENCODING_UCS_4BE(17<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1206 | goto decode_next_UCS_4BE; | |||
1207 | #else | |||
1208 | state += ___CHAR_ENCODING_UCS_4LE(18<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1209 | goto decode_next_UCS_4LE; | |||
1210 | #endif | |||
1211 | } | |||
1212 | else | |||
1213 | { | |||
1214 | blo -= bytes_per_UCS_44; | |||
1215 | if (bytes_per_UCS_44 > 1 && | |||
1216 | blo == byte_buf) | |||
1217 | result = ___INCOMPLETE_CHAR1; | |||
1218 | } | |||
1219 | break; | |||
1220 | } | |||
1221 | ||||
1222 | case ___CHAR_ENCODING_UCS_4BE(17<<0): | |||
1223 | DECODE_CHARS_LOOP(decode_next_UCS_4BE,decode_next_UCS_4BE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +0])) << 8) + ((unsigned int )(blo[(-1)*4 +1]))) << 8) + ((unsigned int)(blo[(-1)*4 + 2]))) << 8) + ((unsigned int)(blo[(-1)*4 +3])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4BE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4BE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1224 | bytes_per_UCS_4,decode_next_UCS_4BE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +0])) << 8) + ((unsigned int )(blo[(-1)*4 +1]))) << 8) + ((unsigned int)(blo[(-1)*4 + 2]))) << 8) + ((unsigned int)(blo[(-1)*4 +3])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4BE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4BE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1225 | 0xffffffff,decode_next_UCS_4BE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +0])) << 8) + ((unsigned int )(blo[(-1)*4 +1]))) << 8) + ((unsigned int)(blo[(-1)*4 + 2]))) << 8) + ((unsigned int)(blo[(-1)*4 +3])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4BE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4BE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1226 | get_UCS_4BE)decode_next_UCS_4BE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +0])) << 8) + ((unsigned int )(blo[(-1)*4 +1]))) << 8) + ((unsigned int)(blo[(-1)*4 + 2]))) << 8) + ((unsigned int)(blo[(-1)*4 +3])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4BE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4BE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4BE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4BE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break;; | |||
1227 | ||||
1228 | case ___CHAR_ENCODING_UCS_4LE(18<<0): | |||
1229 | DECODE_CHARS_LOOP(decode_next_UCS_4LE,decode_next_UCS_4LE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +3])) << 8) + ((unsigned int )(blo[(-1)*4 +2]))) << 8) + ((unsigned int)(blo[(-1)*4 + 1]))) << 8) + ((unsigned int)(blo[(-1)*4 +0])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4LE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4LE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1230 | bytes_per_UCS_4,decode_next_UCS_4LE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +3])) << 8) + ((unsigned int )(blo[(-1)*4 +2]))) << 8) + ((unsigned int)(blo[(-1)*4 + 1]))) << 8) + ((unsigned int)(blo[(-1)*4 +0])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4LE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4LE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1231 | 0xffffffff,decode_next_UCS_4LE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +3])) << 8) + ((unsigned int )(blo[(-1)*4 +2]))) << 8) + ((unsigned int)(blo[(-1)*4 + 1]))) << 8) + ((unsigned int)(blo[(-1)*4 +0])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4LE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4LE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break; | |||
1232 | get_UCS_4LE)decode_next_UCS_4LE: blo += 4; if (blo <= bhi) { c = ((((( ((unsigned int)(blo[(-1)*4 +3])) << 8) + ((unsigned int )(blo[(-1)*4 +2]))) << 8) + ((unsigned int)(blo[(-1)*4 + 1]))) << 8) + ((unsigned int)(blo[(-1)*4 +0])); if (0xffffffff <= 0x10ffff || c <= 0x10ffff) { if (c != 10) { if (c != 13) { state = ((state)&~(3<<11))+(0<<11); *clo ++ = c; if (clo < chi) goto decode_next_UCS_4LE; } else { int eol = ((state)&(3<<7)); if (eol != (1<<7)) { if (eol != (2<<7)) { int rs = ((state)&(3<<11 )); if (rs == (1<<11)) { state += (0<<11)-(1<< 11); goto decode_next_UCS_4LE; } state += (2<<11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else { int eol = ((state)&(3<<7)); if (eol != (2<<7)) { if (eol != (1<<7)) { int rs = ((state) &(3<<11)); if (rs == (2<<11)) { state += (0<< 11)-(2<<11); goto decode_next_UCS_4LE; } state += (1<< 11)-rs; } c = 10; } *clo++ = c; if (clo < chi) goto decode_next_UCS_4LE ; } } else if (blo - 4 == byte_buf) result = 2; else blo -= 4 ; } else { blo -= 4; if (4 > 1 && blo == byte_buf) result = 1; } break;; | |||
1233 | } | |||
1234 | } | |||
1235 | ||||
1236 | /* | |||
1237 | * When the byte buffer is empty or there is at least one byte that | |||
1238 | * was converted into some characters (but possibly 0 in the case of | |||
1239 | * a BOM), result == ___CONVERSION_DONE. The byte_buf_avail and | |||
1240 | * char_buf_avail are adjusted to indicate how many bytes were | |||
1241 | * processed and how many characters were added to the character | |||
1242 | * buffer. The conversion ends when the character buffer is filled | |||
1243 | * or the byte buffer is emptied or at the first byte sequence that | |||
1244 | * cannot form a complete character or that forms an illegal | |||
1245 | * character. Errors are only reported when they are at the head of | |||
1246 | * the byte buffer (i.e. not even one valid character or BOM can be | |||
1247 | * formed from the byte buffer). When the bytes in the byte buffer | |||
1248 | * don't form a complete character, result == ___INCOMPLETE_CHAR and | |||
1249 | * byte_buf_avail will be updated to *not* skip these bytes. When | |||
1250 | * the bytes in the byte buffer form an illegal character, result == | |||
1251 | * ___ILLEGAL_CHAR and byte_buf_avail will be updated to skip these | |||
1252 | * bytes. | |||
1253 | */ | |||
1254 | ||||
1255 | *char_buf_avail = chi - clo; | |||
1256 | *byte_buf_avail = bhi - blo; | |||
1257 | *decoding_state = state; | |||
1258 | ||||
1259 | return result; | |||
1260 | } | |||
1261 | ||||
1262 | ||||
1263 | int chars_to_bytes | |||
1264 | ___P((___C *char_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1265 | int *char_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1266 | ___U8 *byte_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1267 | int *byte_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1268 | int *encoding_state),(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1269 | (char_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1270 | char_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1271 | byte_buf,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1272 | byte_buf_avail,(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1273 | encoding_state)(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1274 | ___C *char_buf;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1275 | int *char_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1276 | ___U8 *byte_buf;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1277 | int *byte_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1278 | int *encoding_state;)(unsigned int *char_buf, int *char_buf_avail, unsigned char * byte_buf, int *byte_buf_avail, int *encoding_state) | |||
1279 | { | |||
1280 | int result; | |||
1281 | ___UCS_4unsigned int c; | |||
1282 | ___Cunsigned int *clo = char_buf; | |||
1283 | ___Cunsigned int *chi = char_buf + *char_buf_avail; | |||
1284 | ___U8unsigned char *blo = byte_buf; | |||
1285 | ___U8unsigned char *bhi = byte_buf + *byte_buf_avail; | |||
1286 | int state = *encoding_state; | |||
1287 | ||||
1288 | result = ___CONVERSION_DONE0; | |||
1289 | ||||
1290 | /* empty character buffer as much as possible */ | |||
1291 | ||||
1292 | if (clo < chi) | |||
1293 | { | |||
1294 | /* the character buffer is not empty */ | |||
1295 | ||||
1296 | switch (___CHAR_ENCODING(state)((state)&(31<<0))) | |||
1297 | { | |||
1298 | default: | |||
1299 | case ___CHAR_ENCODING_ASCII(1<<0): | |||
1300 | case ___CHAR_ENCODING_ISO_8859_1(2<<0): | |||
1301 | ENCODE_CHARS_LOOP(encode_next_ISO_8859_1,encode_next_ISO_8859_1: c = *clo++; if (0x10ffff <= 0xff || c <= 0xff) { blo += 1; if (blo <= bhi) { if (c != 10) { blo[(-1)*1] = (c);; if (clo < chi) goto encode_next_ISO_8859_1 ; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*1] = (13);; break; case (3<<7): blo += 1; if (blo > bhi) { blo -= 2*1; clo--; goto encode_chars_end; } blo[(-2)*1] = (13);; default: blo[(-1)*1] = (10);; break; } if (!(((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto encode_next_ISO_8859_1;; } } else { blo -= 1; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf) result = 2; goto encode_chars_end; } break ; | |||
1302 | bytes_per_ISO_8859_1,encode_next_ISO_8859_1: c = *clo++; if (0x10ffff <= 0xff || c <= 0xff) { blo += 1; if (blo <= bhi) { if (c != 10) { blo[(-1)*1] = (c);; if (clo < chi) goto encode_next_ISO_8859_1 ; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*1] = (13);; break; case (3<<7): blo += 1; if (blo > bhi) { blo -= 2*1; clo--; goto encode_chars_end; } blo[(-2)*1] = (13);; default: blo[(-1)*1] = (10);; break; } if (!(((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto encode_next_ISO_8859_1;; } } else { blo -= 1; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf) result = 2; goto encode_chars_end; } break ; | |||
1303 | max_ISO_8859_1,encode_next_ISO_8859_1: c = *clo++; if (0x10ffff <= 0xff || c <= 0xff) { blo += 1; if (blo <= bhi) { if (c != 10) { blo[(-1)*1] = (c);; if (clo < chi) goto encode_next_ISO_8859_1 ; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*1] = (13);; break; case (3<<7): blo += 1; if (blo > bhi) { blo -= 2*1; clo--; goto encode_chars_end; } blo[(-2)*1] = (13);; default: blo[(-1)*1] = (10);; break; } if (!(((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto encode_next_ISO_8859_1;; } } else { blo -= 1; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf) result = 2; goto encode_chars_end; } break ; | |||
1304 | put_ISO_8859_1)encode_next_ISO_8859_1: c = *clo++; if (0x10ffff <= 0xff || c <= 0xff) { blo += 1; if (blo <= bhi) { if (c != 10) { blo[(-1)*1] = (c);; if (clo < chi) goto encode_next_ISO_8859_1 ; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*1] = (13);; break; case (3<<7): blo += 1; if (blo > bhi) { blo -= 2*1; clo--; goto encode_chars_end; } blo[(-2)*1] = (13);; default: blo[(-1)*1] = (10);; break; } if (!(((state)&(3<<9))>=(3<<9))) goto encode_chars_end ; else if (clo < chi) goto encode_next_ISO_8859_1;; } } else { blo -= 1; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf) result = 2; goto encode_chars_end; } break ;; | |||
1305 | ||||
1306 | case ___CHAR_ENCODING_UTF_8(3<<0): | |||
1307 | { | |||
1308 | encode_next_UTF_8: | |||
1309 | c = *clo++; | |||
1310 | if (___MAX_CHR0x10ffff <= max_UTF_80x7f || | |||
1311 | c <= max_UTF_80x7f) | |||
1312 | { | |||
1313 | blo += bytes_per_UTF_81; | |||
1314 | if (blo <= bhi) | |||
1315 | { | |||
1316 | if (c != char_EOL10) | |||
1317 | { | |||
1318 | put_UTF_8(-1,c)blo[(-1)*1] = (c);; | |||
1319 | if (clo < chi) | |||
1320 | goto encode_next_UTF_8; | |||
1321 | } | |||
1322 | else | |||
1323 | { | |||
1324 | ENCODE_EOL(encode_next_UTF_8,bytes_per_UTF_8,put_UTF_8)switch (((state)&(3<<7))) { case (2<<7): blo[ (-1)*1] = (13);; break; case (3<<7): blo += 1; if (blo > bhi) { blo -= 2*1; clo--; goto encode_chars_end; } blo[(-2)* 1] = (13);; default: blo[(-1)*1] = (10);; break; } if (!(((state )&(3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UTF_8;; | |||
1325 | } | |||
1326 | } | |||
1327 | else | |||
1328 | { | |||
1329 | blo -= bytes_per_UTF_81; | |||
1330 | clo--; | |||
1331 | goto encode_chars_end; | |||
1332 | } | |||
1333 | } | |||
1334 | else | |||
1335 | { | |||
1336 | ___U8unsigned char *p; | |||
1337 | int bytes; | |||
1338 | if (c <= 0x7ff) bytes = 2; | |||
1339 | else if (c <= 0xffff) bytes = 3; | |||
1340 | else if (c <= 0x1fffff) bytes = 4; | |||
1341 | else if (c <= 0x3ffffff) bytes = 5; | |||
1342 | else if (c <= 0x7fffffff) bytes = 6; | |||
1343 | else | |||
1344 | { | |||
1345 | clo--; | |||
1346 | if (clo == char_buf) | |||
1347 | result = ___ILLEGAL_CHAR2; | |||
1348 | goto encode_chars_end; | |||
1349 | } | |||
1350 | p = blo + bytes; | |||
1351 | if (p <= bhi) | |||
1352 | { | |||
1353 | blo = p; | |||
1354 | switch (bytes) | |||
1355 | { | |||
1356 | case 6: *--p = 0x80+(c&0x3f); c >>= 6; | |||
1357 | case 5: *--p = 0x80+(c&0x3f); c >>= 6; | |||
1358 | case 4: *--p = 0x80+(c&0x3f); c >>= 6; | |||
1359 | case 3: *--p = 0x80+(c&0x3f); c >>= 6; | |||
1360 | default: *--p = 0x80+(c&0x3f); c >>= 6; | |||
1361 | } | |||
1362 | *--p = 0xff - (0xff>>bytes) + c; | |||
1363 | if (clo < chi) | |||
1364 | goto encode_next_UTF_8; | |||
1365 | } | |||
1366 | else | |||
1367 | { | |||
1368 | clo--; | |||
1369 | goto encode_chars_end; | |||
1370 | } | |||
1371 | } | |||
1372 | break; | |||
1373 | } | |||
1374 | ||||
1375 | case ___CHAR_ENCODING_UTF_16(4<<0): | |||
1376 | blo += bytes_per_UTF_162; | |||
1377 | if (blo > bhi) | |||
1378 | { | |||
1379 | blo -= bytes_per_UTF_162; | |||
1380 | goto encode_chars_end; | |||
1381 | } | |||
1382 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
1383 | put_UTF_16BE(-1,___UNICODE_BOM)blo[(-1)*2 +1] = (0xfeff) & 0xff; blo[(-1)*2 +0] = ((0xfeff )>>8) & 0xff;; | |||
1384 | state += ___CHAR_ENCODING_UTF_16BE(5<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
1385 | goto encode_next_UTF_16BE; | |||
1386 | #else | |||
1387 | put_UTF_16LE(-1,___UNICODE_BOM)blo[(-1)*2 +0] = (0xfeff) & 0xff; blo[(-1)*2 +1] = ((0xfeff )>>8) & 0xff;; | |||
1388 | state += ___CHAR_ENCODING_UTF_16LE(6<<0)-___CHAR_ENCODING_UTF_16(4<<0); | |||
1389 | goto encode_next_UTF_16LE; | |||
1390 | #endif | |||
1391 | ||||
1392 | case ___CHAR_ENCODING_UTF_16BE(5<<0): | |||
1393 | { | |||
1394 | encode_next_UTF_16BE: | |||
1395 | c = *clo++; | |||
1396 | if (c <= 0xdbff) | |||
1397 | { | |||
1398 | blo += bytes_per_UTF_162; | |||
1399 | if (blo <= bhi) | |||
1400 | { | |||
1401 | if (c != char_EOL10) | |||
1402 | { | |||
1403 | put_UTF_16BE(-1,c)blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; | |||
1404 | if (clo < chi) | |||
1405 | goto encode_next_UTF_16BE; | |||
1406 | } | |||
1407 | else | |||
1408 | { | |||
1409 | ENCODE_EOL(encode_next_UTF_16BE,bytes_per_UTF_16,put_UTF_16BE)switch (((state)&(3<<7))) { case (2<<7): blo[ (-1)*2 +1] = (13) & 0xff; blo[(-1)*2 +0] = ((13)>>8 ) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +1] = (13) & 0xff; blo[(-2)*2 +0] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +1] = (10) & 0xff; blo[(-1)*2 +0] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UTF_16BE;; | |||
1410 | } | |||
1411 | } | |||
1412 | else | |||
1413 | { | |||
1414 | blo -= bytes_per_UTF_162; | |||
1415 | clo--; | |||
1416 | goto encode_chars_end; | |||
1417 | } | |||
1418 | } | |||
1419 | else if (c > 0xffff) | |||
1420 | { | |||
1421 | blo += 2*bytes_per_UTF_162; | |||
1422 | if (blo <= bhi) | |||
1423 | { | |||
1424 | c -= 0x10000; | |||
1425 | put_UTF_16BE(-2,0xd800+((c>>10)&0x3ff))blo[(-2)*2 +1] = (0xd800+((c>>10)&0x3ff)) & 0xff ; blo[(-2)*2 +0] = ((0xd800+((c>>10)&0x3ff))>> 8) & 0xff;; | |||
1426 | put_UTF_16BE(-1,0xdc00+(c&0x3ff))blo[(-1)*2 +1] = (0xdc00+(c&0x3ff)) & 0xff; blo[(-1)* 2 +0] = ((0xdc00+(c&0x3ff))>>8) & 0xff;; | |||
1427 | if (clo < chi) | |||
1428 | goto encode_next_UTF_16BE; | |||
1429 | } | |||
1430 | else | |||
1431 | { | |||
1432 | blo -= 2*bytes_per_UTF_162; | |||
1433 | clo--; | |||
1434 | goto encode_chars_end; | |||
1435 | } | |||
1436 | } | |||
1437 | else if (c > 0xdfff) | |||
1438 | { | |||
1439 | blo += bytes_per_UTF_162; | |||
1440 | if (blo <= bhi) | |||
1441 | { | |||
1442 | put_UTF_16BE(-1,c)blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; | |||
1443 | if (clo < chi) | |||
1444 | goto encode_next_UTF_16BE; | |||
1445 | } | |||
1446 | else | |||
1447 | { | |||
1448 | blo -= bytes_per_UTF_162; | |||
1449 | clo--; | |||
1450 | goto encode_chars_end; | |||
1451 | } | |||
1452 | } | |||
1453 | else | |||
1454 | { | |||
1455 | clo--; | |||
1456 | if (clo == char_buf) | |||
1457 | result = ___ILLEGAL_CHAR2; | |||
1458 | goto encode_chars_end; | |||
1459 | } | |||
1460 | break; | |||
1461 | } | |||
1462 | ||||
1463 | case ___CHAR_ENCODING_UTF_16LE(6<<0): | |||
1464 | { | |||
1465 | encode_next_UTF_16LE: | |||
1466 | c = *clo++; | |||
1467 | if (c <= 0xdbff) | |||
1468 | { | |||
1469 | blo += bytes_per_UTF_162; | |||
1470 | if (blo <= bhi) | |||
1471 | { | |||
1472 | if (c != char_EOL10) | |||
1473 | { | |||
1474 | put_UTF_16LE(-1,c)blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; | |||
1475 | if (clo < chi) | |||
1476 | goto encode_next_UTF_16LE; | |||
1477 | } | |||
1478 | else | |||
1479 | { | |||
1480 | ENCODE_EOL(encode_next_UTF_16LE,bytes_per_UTF_16,put_UTF_16LE)switch (((state)&(3<<7))) { case (2<<7): blo[ (-1)*2 +0] = (13) & 0xff; blo[(-1)*2 +1] = ((13)>>8 ) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +0] = (13) & 0xff; blo[(-2)*2 +1] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +0] = (10) & 0xff; blo[(-1)*2 +1] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UTF_16LE;; | |||
1481 | } | |||
1482 | } | |||
1483 | else | |||
1484 | { | |||
1485 | blo -= bytes_per_UTF_162; | |||
1486 | clo--; | |||
1487 | goto encode_chars_end; | |||
1488 | } | |||
1489 | } | |||
1490 | else if (c > 0xffff) | |||
1491 | { | |||
1492 | blo += 2*bytes_per_UTF_162; | |||
1493 | if (blo <= bhi) | |||
1494 | { | |||
1495 | c -= 0x10000; | |||
1496 | put_UTF_16LE(-2,0xd800+((c>>10)&0x3ff))blo[(-2)*2 +0] = (0xd800+((c>>10)&0x3ff)) & 0xff ; blo[(-2)*2 +1] = ((0xd800+((c>>10)&0x3ff))>> 8) & 0xff;; | |||
1497 | put_UTF_16LE(-1,0xdc00+(c&0x3ff))blo[(-1)*2 +0] = (0xdc00+(c&0x3ff)) & 0xff; blo[(-1)* 2 +1] = ((0xdc00+(c&0x3ff))>>8) & 0xff;; | |||
1498 | if (clo < chi) | |||
1499 | goto encode_next_UTF_16LE; | |||
1500 | } | |||
1501 | else | |||
1502 | { | |||
1503 | blo -= 2*bytes_per_UTF_162; | |||
1504 | clo--; | |||
1505 | goto encode_chars_end; | |||
1506 | } | |||
1507 | } | |||
1508 | else if (c > 0xdfff) | |||
1509 | { | |||
1510 | blo += bytes_per_UTF_162; | |||
1511 | if (blo <= bhi) | |||
1512 | { | |||
1513 | put_UTF_16LE(-1,c)blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; | |||
1514 | if (clo < chi) | |||
1515 | goto encode_next_UTF_16LE; | |||
1516 | } | |||
1517 | else | |||
1518 | { | |||
1519 | blo -= bytes_per_UTF_162; | |||
1520 | clo--; | |||
1521 | goto encode_chars_end; | |||
1522 | } | |||
1523 | } | |||
1524 | else | |||
1525 | { | |||
1526 | clo--; | |||
1527 | if (clo == char_buf) | |||
1528 | result = ___ILLEGAL_CHAR2; | |||
1529 | goto encode_chars_end; | |||
1530 | } | |||
1531 | break; | |||
1532 | } | |||
1533 | ||||
1534 | case ___CHAR_ENCODING_UTF_FALLBACK_ASCII(7<<0): | |||
1535 | case ___CHAR_ENCODING_UTF_FALLBACK_ISO_8859_1(8<<0): | |||
1536 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_8(9<<0): | |||
1537 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16(10<<0): | |||
1538 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16BE(11<<0): | |||
1539 | case ___CHAR_ENCODING_UTF_FALLBACK_UTF_16LE(12<<0): | |||
1540 | blo += 3; | |||
1541 | if (blo > bhi) | |||
1542 | { | |||
1543 | blo -= 3; | |||
1544 | goto encode_chars_end; | |||
1545 | } | |||
1546 | put_UTF_8(-3,0xef)blo[(-3)*1] = (0xef);; /* UTF-8 BOM */ | |||
1547 | put_UTF_8(-2,0xbb)blo[(-2)*1] = (0xbb);; | |||
1548 | put_UTF_8(-1,0xbf)blo[(-1)*1] = (0xbf);; | |||
1549 | state += ___CHAR_ENCODING_UTF_8(3<<0) - ___CHAR_ENCODING(state)((state)&(31<<0)); | |||
1550 | goto encode_next_UTF_8; | |||
1551 | ||||
1552 | case ___CHAR_ENCODING_UCS_2(13<<0): | |||
1553 | blo += bytes_per_UCS_22; | |||
1554 | if (blo > bhi) | |||
1555 | { | |||
1556 | blo -= bytes_per_UCS_22; | |||
1557 | goto encode_chars_end; | |||
1558 | } | |||
1559 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
1560 | put_UCS_2BE(-1,___UNICODE_BOM)blo[(-1)*2 +1] = (0xfeff) & 0xff; blo[(-1)*2 +0] = ((0xfeff )>>8) & 0xff;; | |||
1561 | state += ___CHAR_ENCODING_UCS_2BE(14<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1562 | goto encode_next_UCS_2BE; | |||
1563 | #else | |||
1564 | put_UCS_2LE(-1,___UNICODE_BOM)blo[(-1)*2 +0] = (0xfeff) & 0xff; blo[(-1)*2 +1] = ((0xfeff )>>8) & 0xff;; | |||
1565 | state += ___CHAR_ENCODING_UCS_2LE(15<<0)-___CHAR_ENCODING_UCS_2(13<<0); | |||
1566 | goto encode_next_UCS_2LE; | |||
1567 | #endif | |||
1568 | ||||
1569 | case ___CHAR_ENCODING_UCS_2BE(14<<0): | |||
1570 | ENCODE_CHARS_LOOP(encode_next_UCS_2BE,encode_next_UCS_2BE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2BE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +1] = (13) & 0xff; blo[(-1)*2 +0] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +1] = (13) & 0xff; blo[(-2)*2 +0] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +1] = (10) & 0xff; blo[(-1)*2 +0] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2BE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1571 | bytes_per_UCS_2,encode_next_UCS_2BE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2BE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +1] = (13) & 0xff; blo[(-1)*2 +0] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +1] = (13) & 0xff; blo[(-2)*2 +0] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +1] = (10) & 0xff; blo[(-1)*2 +0] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2BE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1572 | max_UCS_2,encode_next_UCS_2BE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2BE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +1] = (13) & 0xff; blo[(-1)*2 +0] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +1] = (13) & 0xff; blo[(-2)*2 +0] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +1] = (10) & 0xff; blo[(-1)*2 +0] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2BE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1573 | put_UCS_2BE)encode_next_UCS_2BE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +1] = (c) & 0xff; blo[(-1)*2 +0] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2BE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +1] = (13) & 0xff; blo[(-1)*2 +0] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +1] = (13) & 0xff; blo[(-2)*2 +0] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +1] = (10) & 0xff; blo[(-1)*2 +0] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2BE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break;; | |||
1574 | ||||
1575 | case ___CHAR_ENCODING_UCS_2LE(15<<0): | |||
1576 | ENCODE_CHARS_LOOP(encode_next_UCS_2LE,encode_next_UCS_2LE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2LE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +0] = (13) & 0xff; blo[(-1)*2 +1] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +0] = (13) & 0xff; blo[(-2)*2 +1] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +0] = (10) & 0xff; blo[(-1)*2 +1] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2LE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1577 | bytes_per_UCS_2,encode_next_UCS_2LE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2LE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +0] = (13) & 0xff; blo[(-1)*2 +1] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +0] = (13) & 0xff; blo[(-2)*2 +1] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +0] = (10) & 0xff; blo[(-1)*2 +1] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2LE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1578 | max_UCS_2,encode_next_UCS_2LE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2LE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +0] = (13) & 0xff; blo[(-1)*2 +1] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +0] = (13) & 0xff; blo[(-2)*2 +1] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +0] = (10) & 0xff; blo[(-1)*2 +1] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2LE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1579 | put_UCS_2LE)encode_next_UCS_2LE: c = *clo++; if (0x10ffff <= 0xffff || c <= 0xffff) { blo += 2; if (blo <= bhi) { if (c != 10 ) { blo[(-1)*2 +0] = (c) & 0xff; blo[(-1)*2 +1] = ((c)>> 8) & 0xff;; if (clo < chi) goto encode_next_UCS_2LE; } else { switch (((state)&(3<<7))) { case (2<< 7): blo[(-1)*2 +0] = (13) & 0xff; blo[(-1)*2 +1] = ((13)>> 8) & 0xff;; break; case (3<<7): blo += 2; if (blo > bhi) { blo -= 2*2; clo--; goto encode_chars_end; } blo[(-2)* 2 +0] = (13) & 0xff; blo[(-2)*2 +1] = ((13)>>8) & 0xff;; default: blo[(-1)*2 +0] = (10) & 0xff; blo[(-1)*2 +1] = ((10)>>8) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_2LE;; } } else { blo -= 2 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break;; | |||
1580 | ||||
1581 | case ___CHAR_ENCODING_UCS_4(16<<0): | |||
1582 | blo += bytes_per_UCS_44; | |||
1583 | if (blo > bhi) | |||
1584 | { | |||
1585 | blo -= bytes_per_UCS_44; | |||
1586 | goto encode_chars_end; | |||
1587 | } | |||
1588 | #ifdef ___DEFAULT_CHAR_ENCODING_TO_BIG_ENDIAN | |||
1589 | put_UCS_4BE(-1,___UNICODE_BOM)blo[(-1)*4 +3] = (0xfeff) & 0xff; blo[(-1)*4 +2] = ((0xfeff )>>8) & 0xff; blo[(-1)*4 +1] = ((0xfeff)>>16) & 0xff; blo[(-1)*4 +0] = ((0xfeff)>>24) & 0xff ;; | |||
1590 | state += ___CHAR_ENCODING_UCS_4BE(17<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1591 | goto encode_next_UCS_4BE; | |||
1592 | #else | |||
1593 | put_UCS_4LE(-1,___UNICODE_BOM)blo[(-1)*4 +0] = (0xfeff) & 0xff; blo[(-1)*4 +1] = ((0xfeff )>>8) & 0xff; blo[(-1)*4 +2] = ((0xfeff)>>16) & 0xff; blo[(-1)*4 +3] = ((0xfeff)>>24) & 0xff ;; | |||
1594 | state += ___CHAR_ENCODING_UCS_4LE(18<<0)-___CHAR_ENCODING_UCS_4(16<<0); | |||
1595 | goto encode_next_UCS_4LE; | |||
1596 | #endif | |||
1597 | ||||
1598 | case ___CHAR_ENCODING_UCS_4BE(17<<0): | |||
1599 | ENCODE_CHARS_LOOP(encode_next_UCS_4BE,encode_next_UCS_4BE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +3] = (c) & 0xff; blo[(-1)*4 +2] = ( (c)>>8) & 0xff; blo[(-1)*4 +1] = ((c)>>16) & 0xff; blo[(-1)*4 +0] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4BE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +3] = (13) & 0xff; blo[(-1)*4 +2] = ((13)>>8) & 0xff; blo[(-1)* 4 +1] = ((13)>>16) & 0xff; blo[(-1)*4 +0] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +3] = (13) & 0xff; blo[(-2)*4 +2] = ((13)>>8) & 0xff; blo[(-2)*4 +1] = ((13)>>16) & 0xff; blo[(-2) *4 +0] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +3 ] = (10) & 0xff; blo[(-1)*4 +2] = ((10)>>8) & 0xff ; blo[(-1)*4 +1] = ((10)>>16) & 0xff; blo[(-1)*4 +0 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4BE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1600 | bytes_per_UCS_4,encode_next_UCS_4BE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +3] = (c) & 0xff; blo[(-1)*4 +2] = ( (c)>>8) & 0xff; blo[(-1)*4 +1] = ((c)>>16) & 0xff; blo[(-1)*4 +0] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4BE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +3] = (13) & 0xff; blo[(-1)*4 +2] = ((13)>>8) & 0xff; blo[(-1)* 4 +1] = ((13)>>16) & 0xff; blo[(-1)*4 +0] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +3] = (13) & 0xff; blo[(-2)*4 +2] = ((13)>>8) & 0xff; blo[(-2)*4 +1] = ((13)>>16) & 0xff; blo[(-2) *4 +0] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +3 ] = (10) & 0xff; blo[(-1)*4 +2] = ((10)>>8) & 0xff ; blo[(-1)*4 +1] = ((10)>>16) & 0xff; blo[(-1)*4 +0 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4BE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1601 | max_UCS_4,encode_next_UCS_4BE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +3] = (c) & 0xff; blo[(-1)*4 +2] = ( (c)>>8) & 0xff; blo[(-1)*4 +1] = ((c)>>16) & 0xff; blo[(-1)*4 +0] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4BE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +3] = (13) & 0xff; blo[(-1)*4 +2] = ((13)>>8) & 0xff; blo[(-1)* 4 +1] = ((13)>>16) & 0xff; blo[(-1)*4 +0] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +3] = (13) & 0xff; blo[(-2)*4 +2] = ((13)>>8) & 0xff; blo[(-2)*4 +1] = ((13)>>16) & 0xff; blo[(-2) *4 +0] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +3 ] = (10) & 0xff; blo[(-1)*4 +2] = ((10)>>8) & 0xff ; blo[(-1)*4 +1] = ((10)>>16) & 0xff; blo[(-1)*4 +0 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4BE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1602 | put_UCS_4BE)encode_next_UCS_4BE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +3] = (c) & 0xff; blo[(-1)*4 +2] = ( (c)>>8) & 0xff; blo[(-1)*4 +1] = ((c)>>16) & 0xff; blo[(-1)*4 +0] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4BE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +3] = (13) & 0xff; blo[(-1)*4 +2] = ((13)>>8) & 0xff; blo[(-1)* 4 +1] = ((13)>>16) & 0xff; blo[(-1)*4 +0] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +3] = (13) & 0xff; blo[(-2)*4 +2] = ((13)>>8) & 0xff; blo[(-2)*4 +1] = ((13)>>16) & 0xff; blo[(-2) *4 +0] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +3 ] = (10) & 0xff; blo[(-1)*4 +2] = ((10)>>8) & 0xff ; blo[(-1)*4 +1] = ((10)>>16) & 0xff; blo[(-1)*4 +0 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4BE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break;; | |||
1603 | ||||
1604 | case ___CHAR_ENCODING_UCS_4LE(18<<0): | |||
1605 | ENCODE_CHARS_LOOP(encode_next_UCS_4LE,encode_next_UCS_4LE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +0] = (c) & 0xff; blo[(-1)*4 +1] = ( (c)>>8) & 0xff; blo[(-1)*4 +2] = ((c)>>16) & 0xff; blo[(-1)*4 +3] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4LE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +0] = (13) & 0xff; blo[(-1)*4 +1] = ((13)>>8) & 0xff; blo[(-1)* 4 +2] = ((13)>>16) & 0xff; blo[(-1)*4 +3] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +0] = (13) & 0xff; blo[(-2)*4 +1] = ((13)>>8) & 0xff; blo[(-2)*4 +2] = ((13)>>16) & 0xff; blo[(-2) *4 +3] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +0 ] = (10) & 0xff; blo[(-1)*4 +1] = ((10)>>8) & 0xff ; blo[(-1)*4 +2] = ((10)>>16) & 0xff; blo[(-1)*4 +3 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4LE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1606 | bytes_per_UCS_4,encode_next_UCS_4LE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +0] = (c) & 0xff; blo[(-1)*4 +1] = ( (c)>>8) & 0xff; blo[(-1)*4 +2] = ((c)>>16) & 0xff; blo[(-1)*4 +3] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4LE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +0] = (13) & 0xff; blo[(-1)*4 +1] = ((13)>>8) & 0xff; blo[(-1)* 4 +2] = ((13)>>16) & 0xff; blo[(-1)*4 +3] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +0] = (13) & 0xff; blo[(-2)*4 +1] = ((13)>>8) & 0xff; blo[(-2)*4 +2] = ((13)>>16) & 0xff; blo[(-2) *4 +3] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +0 ] = (10) & 0xff; blo[(-1)*4 +1] = ((10)>>8) & 0xff ; blo[(-1)*4 +2] = ((10)>>16) & 0xff; blo[(-1)*4 +3 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4LE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1607 | max_UCS_4,encode_next_UCS_4LE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +0] = (c) & 0xff; blo[(-1)*4 +1] = ( (c)>>8) & 0xff; blo[(-1)*4 +2] = ((c)>>16) & 0xff; blo[(-1)*4 +3] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4LE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +0] = (13) & 0xff; blo[(-1)*4 +1] = ((13)>>8) & 0xff; blo[(-1)* 4 +2] = ((13)>>16) & 0xff; blo[(-1)*4 +3] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +0] = (13) & 0xff; blo[(-2)*4 +1] = ((13)>>8) & 0xff; blo[(-2)*4 +2] = ((13)>>16) & 0xff; blo[(-2) *4 +3] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +0 ] = (10) & 0xff; blo[(-1)*4 +1] = ((10)>>8) & 0xff ; blo[(-1)*4 +2] = ((10)>>16) & 0xff; blo[(-1)*4 +3 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4LE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break; | |||
1608 | put_UCS_4LE)encode_next_UCS_4LE: c = *clo++; if (0x10ffff <= 0x7fffffff || c <= 0x7fffffff) { blo += 4; if (blo <= bhi) { if ( c != 10) { blo[(-1)*4 +0] = (c) & 0xff; blo[(-1)*4 +1] = ( (c)>>8) & 0xff; blo[(-1)*4 +2] = ((c)>>16) & 0xff; blo[(-1)*4 +3] = ((c)>>24) & 0xff;; if (clo < chi) goto encode_next_UCS_4LE; } else { switch (((state)& (3<<7))) { case (2<<7): blo[(-1)*4 +0] = (13) & 0xff; blo[(-1)*4 +1] = ((13)>>8) & 0xff; blo[(-1)* 4 +2] = ((13)>>16) & 0xff; blo[(-1)*4 +3] = ((13)>> 24) & 0xff;; break; case (3<<7): blo += 4; if (blo > bhi) { blo -= 2*4; clo--; goto encode_chars_end; } blo[(-2)* 4 +0] = (13) & 0xff; blo[(-2)*4 +1] = ((13)>>8) & 0xff; blo[(-2)*4 +2] = ((13)>>16) & 0xff; blo[(-2) *4 +3] = ((13)>>24) & 0xff;; default: blo[(-1)*4 +0 ] = (10) & 0xff; blo[(-1)*4 +1] = ((10)>>8) & 0xff ; blo[(-1)*4 +2] = ((10)>>16) & 0xff; blo[(-1)*4 +3 ] = ((10)>>24) & 0xff;; break; } if (!(((state)& (3<<9))>=(3<<9))) goto encode_chars_end; else if (clo < chi) goto encode_next_UCS_4LE;; } } else { blo -= 4 ; clo--; goto encode_chars_end; } } else { clo--; if (clo == char_buf ) result = 2; goto encode_chars_end; } break;; | |||
1609 | } | |||
1610 | } | |||
1611 | ||||
1612 | encode_chars_end: | |||
1613 | ||||
1614 | /* | |||
1615 | * When the character buffer is empty or there is at least one | |||
1616 | * character that was converted into some bytes, result == | |||
1617 | * ___CONVERSION_DONE. The char_buf_avail and byte_buf_avail are | |||
1618 | * adjusted to indicate how many characters were processed and how | |||
1619 | * many bytes were added to the byte buffer. The conversion ends | |||
1620 | * when the byte buffer is filled or the character buffer is emptied | |||
1621 | * or past the first character that is illegal. Errors are only | |||
1622 | * reported when they are at the head of the character buffer. When | |||
1623 | * the first character is an illegal character, result == | |||
1624 | * ___ILLEGAL_CHAR and char_buf_avail and byte_buf_avail will not | |||
1625 | * change. | |||
1626 | */ | |||
1627 | ||||
1628 | *char_buf_avail = chi - clo; | |||
1629 | *byte_buf_avail = bhi - blo; | |||
1630 | *encoding_state = state; | |||
1631 | ||||
1632 | return result; | |||
1633 | } | |||
1634 | ||||
1635 | ||||
1636 | /*---------------------------------------------------------------------------*/ | |||
1637 | ||||
1638 | /* Scheme to C conversion */ | |||
1639 | ||||
1640 | /* | |||
1641 | * The following Scheme to C conversion functions may allocate memory | |||
1642 | * in the C heap: | |||
1643 | * | |||
1644 | * ___SCMOBJ_to_FUNCTION | |||
1645 | * ___SCMOBJ_to_NONNULLFUNCTION | |||
1646 | * ___SCMOBJ_to_STRING | |||
1647 | * ___SCMOBJ_to_NONNULLSTRING | |||
1648 | * ___SCMOBJ_to_NONNULLSTRINGLIST | |||
1649 | * ___SCMOBJ_to_CHARSTRING | |||
1650 | * ___SCMOBJ_to_NONNULLCHARSTRING | |||
1651 | * ___SCMOBJ_to_NONNULLCHARSTRINGLIST | |||
1652 | * ___SCMOBJ_to_ISO_8859_1STRING | |||
1653 | * ___SCMOBJ_to_NONNULLISO_8859_1STRING | |||
1654 | * ___SCMOBJ_to_NONNULLISO_8859_1STRINGLIST | |||
1655 | * ___SCMOBJ_to_UTF_8STRING | |||
1656 | * ___SCMOBJ_to_NONNULLUTF_8STRING | |||
1657 | * ___SCMOBJ_to_NONNULLUTF_8STRINGLIST | |||
1658 | * ___SCMOBJ_to_UTF_16STRING | |||
1659 | * ___SCMOBJ_to_NONNULLUTF_16STRING | |||
1660 | * ___SCMOBJ_to_NONNULLUTF_16STRINGLIST | |||
1661 | * ___SCMOBJ_to_UCS_2STRING | |||
1662 | * ___SCMOBJ_to_NONNULLUCS_2STRING | |||
1663 | * ___SCMOBJ_to_NONNULLUCS_2STRINGLIST | |||
1664 | * ___SCMOBJ_to_UCS_4STRING | |||
1665 | * ___SCMOBJ_to_NONNULLUCS_4STRING | |||
1666 | * ___SCMOBJ_to_NONNULLUCS_4STRINGLIST | |||
1667 | * ___SCMOBJ_to_WCHARSTRING | |||
1668 | * ___SCMOBJ_to_NONNULLWCHARSTRING | |||
1669 | * ___SCMOBJ_to_NONNULLWCHARSTRINGLIST | |||
1670 | * ___SCMOBJ_to_VARIANT | |||
1671 | * | |||
1672 | * The allocated objects contain a reference count. This reference | |||
1673 | * count is managed with the following functions: | |||
1674 | * | |||
1675 | * OBJECT DECREMENT COUNT INCREMENT COUNT | |||
1676 | * function: ___release_function ___addref_function | |||
1677 | * string: ___release_string ___addref_string | |||
1678 | * string list: ___release_string_list ___addref_string_list | |||
1679 | * variant: ___release_variant ___addref_variant | |||
1680 | * | |||
1681 | * All these functions can be passed a null pointer. The memory | |||
1682 | * allocated to the object is freed when the reference count reaches | |||
1683 | * 0. | |||
1684 | */ | |||
1685 | ||||
1686 | ||||
1687 | /* | |||
1688 | * Release a Scheme foreign object, calling the object's release | |||
1689 | * function if it hasn't been done yet. | |||
1690 | */ | |||
1691 | ||||
1692 | ___EXP_FUNC(___SCMOBJ,___release_foreign)long ___release_foreign | |||
1693 | ___P((___SCMOBJ obj),(long obj) | |||
1694 | (obj)(long obj) | |||
1695 | ___SCMOBJ obj;)(long obj) | |||
1696 | { | |||
1697 | ___SCMOBJlong e; | |||
1698 | ___SCMOBJlong (*release_fn) ___P((void *ptr),())(void *ptr); | |||
1699 | void *ptr; | |||
1700 | ||||
1701 | if (!___TESTSUBTYPE(obj,___sFOREIGN)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (18))<<3)))) | |||
1702 | return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2); | |||
1703 | ||||
1704 | release_fn = ___CAST(___SCMOBJ (*) ___P((void *ptr),()),((long (*) (void *ptr))((*((((long*)((obj)-(1)))+1)+1)))) | |||
1705 | ___FIELD(obj,___FOREIGN_RELEASE_FN))((long (*) (void *ptr))((*((((long*)((obj)-(1)))+1)+1)))); | |||
1706 | ||||
1707 | if (release_fn != 0) | |||
1708 | { | |||
1709 | ptr = ___CAST(void*,___FIELD(obj,___FOREIGN_PTR))((void*)((*((((long*)((obj)-(1)))+1)+2)))); | |||
1710 | ___FIELD(obj,___FOREIGN_RELEASE_FN)(*((((long*)((obj)-(1)))+1)+1)) = | |||
1711 | ___CAST(___SCMOBJ,___CAST(___SCMOBJ (*) ___P((void *ptr),()),0))((long)(((long (*) (void *ptr))(0)))); | |||
1712 | ___FIELD(obj,___FOREIGN_PTR)(*((((long*)((obj)-(1)))+1)+2)) = | |||
1713 | ___CAST(___SCMOBJ,___CAST(void*,0))((long)(((void*)(0)))); | |||
1714 | if ((e = release_fn (ptr)) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
1715 | return e; | |||
1716 | } | |||
1717 | ||||
1718 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1719 | } | |||
1720 | ||||
1721 | ||||
1722 | /* Release a C pointer created by the C-interface. */ | |||
1723 | ||||
1724 | ___EXP_FUNC(___SCMOBJ,___release_pointer)long ___release_pointer | |||
1725 | ___P((void *x),(void *x) | |||
1726 | (x)(void *x) | |||
1727 | void *x;)(void *x) | |||
1728 | { | |||
1729 | /* | |||
1730 | * Nothing needs to be done because the data pointed to by the | |||
1731 | * pointer is under the control of the "C world". | |||
1732 | */ | |||
1733 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1734 | } | |||
1735 | ||||
1736 | ||||
1737 | /* Release a C function created by the C-interface. */ | |||
1738 | ||||
1739 | ___EXP_FUNC(___SCMOBJ,___release_function)long ___release_function | |||
1740 | ___P((void *x),(void *x) | |||
1741 | (x)(void *x) | |||
1742 | void *x;)(void *x) | |||
1743 | { | |||
1744 | if (___is_a_c_closure (x)) | |||
1745 | ___release_rc (x); | |||
1746 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1747 | } | |||
1748 | ||||
1749 | ||||
1750 | /* Add a reference to a C function created by the C-interface. */ | |||
1751 | ||||
1752 | ___EXP_FUNC(void,___addref_function)void ___addref_function | |||
1753 | ___P((void *x),(void *x) | |||
1754 | (x)(void *x) | |||
1755 | void *x;)(void *x) | |||
1756 | { | |||
1757 | if (___is_a_c_closure (x)) | |||
1758 | ___addref_rc (x); | |||
1759 | } | |||
1760 | ||||
1761 | ||||
1762 | /* Release a C string created by the C-interface. */ | |||
1763 | ||||
1764 | ___EXP_FUNC(void,___release_string)void ___release_string | |||
1765 | ___P((void *x),(void *x) | |||
1766 | (x)(void *x) | |||
1767 | void *x;)(void *x) | |||
1768 | { | |||
1769 | ___release_rc (x); | |||
1770 | } | |||
1771 | ||||
1772 | ||||
1773 | /* Add a reference to a C string created by the C-interface. */ | |||
1774 | ||||
1775 | ___EXP_FUNC(void,___addref_string)void ___addref_string | |||
1776 | ___P((void *x),(void *x) | |||
1777 | (x)(void *x) | |||
1778 | void *x;)(void *x) | |||
1779 | { | |||
1780 | ___addref_rc (x); | |||
1781 | } | |||
1782 | ||||
1783 | ||||
1784 | /* Release a C string list created by the C-interface. */ | |||
1785 | ||||
1786 | ___EXP_FUNC(void,___release_string_list)void ___release_string_list | |||
1787 | ___P((void *x),(void *x) | |||
1788 | (x)(void *x) | |||
1789 | void *x;)(void *x) | |||
1790 | { | |||
1791 | if (x != 0) | |||
1792 | { | |||
1793 | void **string_list = ___CAST(void**,x)((void**)(x)); | |||
1794 | void *elem; | |||
1795 | int i = 0; | |||
1796 | ||||
1797 | while ((elem = string_list[i++]) != 0) | |||
1798 | ___release_string (elem); | |||
1799 | ||||
1800 | ___release_rc (string_list); | |||
1801 | } | |||
1802 | } | |||
1803 | ||||
1804 | ||||
1805 | /* Add a reference to a C string list created by the C-interface. */ | |||
1806 | ||||
1807 | ___EXP_FUNC(void,___addref_string_list)void ___addref_string_list | |||
1808 | ___P((void *x),(void *x) | |||
1809 | (x)(void *x) | |||
1810 | void *x;)(void *x) | |||
1811 | { | |||
1812 | ___addref_rc (x); | |||
1813 | } | |||
1814 | ||||
1815 | ||||
1816 | /* Release a variant created by the C-interface. */ | |||
1817 | ||||
1818 | ___EXP_FUNC(void,___release_variant)void ___release_variant | |||
1819 | ___P((___VARIANT x),(___VARIANT x) | |||
1820 | (x)(___VARIANT x) | |||
1821 | ___VARIANT x;)(___VARIANT x) | |||
1822 | { | |||
1823 | /* | |||
1824 | * Not yet implemented. | |||
1825 | */ | |||
1826 | } | |||
1827 | ||||
1828 | ||||
1829 | /* Add a reference to a variant created by the C-interface. */ | |||
1830 | ||||
1831 | ___EXP_FUNC(void,___addref_variant)void ___addref_variant | |||
1832 | ___P((___VARIANT x),(___VARIANT x) | |||
1833 | (x)(___VARIANT x) | |||
1834 | ___VARIANT x;)(___VARIANT x) | |||
1835 | { | |||
1836 | /* | |||
1837 | * Not yet implemented. | |||
1838 | */ | |||
1839 | } | |||
1840 | ||||
1841 | ||||
1842 | /* Convert a Scheme integer to a C '___S64'. */ | |||
1843 | ||||
1844 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_S64)long ___SCMOBJ_to_S64 | |||
1845 | ___P((___SCMOBJ obj,(long obj, long *x, int arg_num) | |||
1846 | ___S64 *x,(long obj, long *x, int arg_num) | |||
1847 | int arg_num),(long obj, long *x, int arg_num) | |||
1848 | (obj,(long obj, long *x, int arg_num) | |||
1849 | x,(long obj, long *x, int arg_num) | |||
1850 | arg_num)(long obj, long *x, int arg_num) | |||
1851 | ___SCMOBJ obj;(long obj, long *x, int arg_num) | |||
1852 | ___S64 *x;(long obj, long *x, int arg_num) | |||
1853 | int arg_num;)(long obj, long *x, int arg_num) | |||
1854 | { | |||
1855 | ___S64long val; | |||
1856 | ||||
1857 | if (___FIXNUMP(obj)(((obj)&((1<<2)-1))==(0))) | |||
1858 | { | |||
1859 | #if ___SCMOBJ_WIDTH64 == 32 | |||
1860 | val = ___S64_from_SM32 (___INT(obj))((long)(((int)(((obj)>>2))))); | |||
1861 | #else | |||
1862 | val = ___INT(obj)((obj)>>2); | |||
1863 | #endif | |||
1864 | } | |||
1865 | else | |||
1866 | { | |||
1867 | if (!___BIGNUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (31))<<3)))) | |||
1868 | return ___FIX(___STOC_S64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(7<<7))+arg_num))<<2); | |||
1869 | if (___BIGALENGTH(obj)(((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>3)))<<2) == ___FIX(1)(((long)(1))<<2)) | |||
1870 | { | |||
1871 | ___BIGADIGITunsigned long d0 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),0)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(0)); | |||
1872 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
1873 | val = ___S64_from_SM32 (___CAST(___BIGADIGITSIGNED,d0))((long)(((int)(((long)(d0)))))); | |||
1874 | #else | |||
1875 | val = ___CAST(___BIGADIGITSIGNED,d0)((long)(d0)); | |||
1876 | #endif | |||
1877 | } | |||
1878 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
1879 | else if (___BIGALENGTH(obj)(((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>3)))<<2) == ___FIX(2)(((long)(2))<<2)) | |||
1880 | { | |||
1881 | ___BIGADIGITunsigned long d0 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),0)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(0)); | |||
1882 | ___BIGADIGITunsigned long d1 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),1)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(1)); | |||
1883 | val = ___S64_from_SM32_UM32 (___CAST(___BIGADIGITSIGNED,d1), d0)((((long)(((int)(((long)(d1)))))) << 32) + ((long)(((unsigned int)(d0))))); | |||
1884 | } | |||
1885 | #endif | |||
1886 | else | |||
1887 | return ___FIX(___STOC_S64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(7<<7))+arg_num))<<2); | |||
1888 | } | |||
1889 | ||||
1890 | *x = val; | |||
1891 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1892 | } | |||
1893 | ||||
1894 | ||||
1895 | /* Convert a Scheme integer to a C '___U64'. */ | |||
1896 | ||||
1897 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_U64)long ___SCMOBJ_to_U64 | |||
1898 | ___P((___SCMOBJ obj,(long obj, unsigned long *x, int arg_num) | |||
1899 | ___U64 *x,(long obj, unsigned long *x, int arg_num) | |||
1900 | int arg_num),(long obj, unsigned long *x, int arg_num) | |||
1901 | (obj,(long obj, unsigned long *x, int arg_num) | |||
1902 | x,(long obj, unsigned long *x, int arg_num) | |||
1903 | arg_num)(long obj, unsigned long *x, int arg_num) | |||
1904 | ___SCMOBJ obj;(long obj, unsigned long *x, int arg_num) | |||
1905 | ___U64 *x;(long obj, unsigned long *x, int arg_num) | |||
1906 | int arg_num;)(long obj, unsigned long *x, int arg_num) | |||
1907 | { | |||
1908 | ___U64unsigned long val; | |||
1909 | ||||
1910 | if (___FIXNUMP(obj)(((obj)&((1<<2)-1))==(0))) | |||
1911 | { | |||
1912 | if (___FIXNEGATIVEP(obj)((obj)<0)) | |||
1913 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1914 | val = ___U64_from_ULONGLONG (___CAST(___ULONGLONG,___INT(obj)))((unsigned long)(((unsigned long long)(((obj)>>2))))); | |||
1915 | } | |||
1916 | else | |||
1917 | { | |||
1918 | if (!___BIGNUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (31))<<3)))) | |||
1919 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1920 | if (___BIGALENGTH(obj)(((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>3)))<<2) == ___FIX(1)(((long)(1))<<2)) | |||
1921 | { | |||
1922 | ___BIGADIGITunsigned long d0 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),0)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(0)); | |||
1923 | if (___CAST(___BIGADIGITSIGNED,d0)((long)(d0)) < 0) | |||
1924 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1925 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
1926 | val = ___U64_from_UM32 (d0)((unsigned long)(((unsigned int)(d0)))); | |||
1927 | #else | |||
1928 | val = d0; | |||
1929 | #endif | |||
1930 | } | |||
1931 | else if (___BIGALENGTH(obj)(((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>3)))<<2) == ___FIX(2)(((long)(2))<<2)) | |||
1932 | { | |||
1933 | ___BIGADIGITunsigned long d0 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),0)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(0)); | |||
1934 | ___BIGADIGITunsigned long d1 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),1)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(1)); | |||
1935 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
1936 | if (___CAST(___BIGADIGITSIGNED,d1)((long)(d1)) < 0) | |||
1937 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1938 | val = ___U64_from_UM32_UM32 (d1, d0)((((unsigned long)(((unsigned int)(d1)))) << 32) + ((unsigned long)(((unsigned int)(d0))))); | |||
1939 | #else | |||
1940 | if (d1 != 0) | |||
1941 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1942 | val = d0; | |||
1943 | #endif | |||
1944 | } | |||
1945 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
1946 | else if (___BIGALENGTH(obj)(((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>3)))<<2) == ___FIX(3)(((long)(3))<<2)) | |||
1947 | { | |||
1948 | ___BIGADIGITunsigned long d0 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),0)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(0)); | |||
1949 | ___BIGADIGITunsigned long d1 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),1)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(1)); | |||
1950 | ___BIGADIGITunsigned long d2 = ___BIGAFETCH(___BODY_AS(obj,___tSUBTYPED),2)*(((unsigned long*)((((long*)((obj)-(1)))+1)))+(2)); | |||
1951 | if (d2 != 0) | |||
1952 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1953 | val = ___U64_from_UM32_UM32 (d1, d0)((((unsigned long)(((unsigned int)(d1)))) << 32) + ((unsigned long)(((unsigned int)(d0))))); | |||
1954 | } | |||
1955 | #endif | |||
1956 | else | |||
1957 | return ___FIX(___STOC_U64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(8<<7))+arg_num))<<2); | |||
1958 | } | |||
1959 | ||||
1960 | *x = val; | |||
1961 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1962 | } | |||
1963 | ||||
1964 | ||||
1965 | /* Convert a Scheme integer to a C '___S8'. */ | |||
1966 | ||||
1967 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_S8)long ___SCMOBJ_to_S8 | |||
1968 | ___P((___SCMOBJ obj,(long obj, signed char *x, int arg_num) | |||
1969 | ___S8 *x,(long obj, signed char *x, int arg_num) | |||
1970 | int arg_num),(long obj, signed char *x, int arg_num) | |||
1971 | (obj,(long obj, signed char *x, int arg_num) | |||
1972 | x,(long obj, signed char *x, int arg_num) | |||
1973 | arg_num)(long obj, signed char *x, int arg_num) | |||
1974 | ___SCMOBJ obj;(long obj, signed char *x, int arg_num) | |||
1975 | ___S8 *x;(long obj, signed char *x, int arg_num) | |||
1976 | int arg_num;)(long obj, signed char *x, int arg_num) | |||
1977 | { | |||
1978 | ___S64long val; | |||
1979 | ||||
1980 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
1981 | !___S64_fits_in_width (val, 8)((((val) >> ((8)-1)) == 0) || (((val) >> ((8)-1)) == -1))) | |||
1982 | return ___FIX(___STOC_S8_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(1<<7))+arg_num))<<2); | |||
1983 | ||||
1984 | *x = ___CAST(___S8,___S64_to_LONGLONG (val))((signed char)(((long long)(val)))); | |||
1985 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
1986 | } | |||
1987 | ||||
1988 | ||||
1989 | /* Convert a Scheme integer to a C '___U8'. */ | |||
1990 | ||||
1991 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_U8)long ___SCMOBJ_to_U8 | |||
1992 | ___P((___SCMOBJ obj,(long obj, unsigned char *x, int arg_num) | |||
1993 | ___U8 *x,(long obj, unsigned char *x, int arg_num) | |||
1994 | int arg_num),(long obj, unsigned char *x, int arg_num) | |||
1995 | (obj,(long obj, unsigned char *x, int arg_num) | |||
1996 | x,(long obj, unsigned char *x, int arg_num) | |||
1997 | arg_num)(long obj, unsigned char *x, int arg_num) | |||
1998 | ___SCMOBJ obj;(long obj, unsigned char *x, int arg_num) | |||
1999 | ___U8 *x;(long obj, unsigned char *x, int arg_num) | |||
2000 | int arg_num;)(long obj, unsigned char *x, int arg_num) | |||
2001 | { | |||
2002 | ___U64unsigned long val; | |||
2003 | ||||
2004 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2005 | !___U64_fits_in_width (val, 8)(((val) >> (8)) == 0)) | |||
2006 | return ___FIX(___STOC_U8_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(2<<7))+arg_num))<<2); | |||
2007 | ||||
2008 | *x = ___CAST(___U8,___U64_to_ULONGLONG (val))((unsigned char)(((unsigned long long)(val)))); | |||
2009 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2010 | } | |||
2011 | ||||
2012 | ||||
2013 | /* Convert a Scheme integer to a C '___S16'. */ | |||
2014 | ||||
2015 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_S16)long ___SCMOBJ_to_S16 | |||
2016 | ___P((___SCMOBJ obj,(long obj, short *x, int arg_num) | |||
2017 | ___S16 *x,(long obj, short *x, int arg_num) | |||
2018 | int arg_num),(long obj, short *x, int arg_num) | |||
2019 | (obj,(long obj, short *x, int arg_num) | |||
2020 | x,(long obj, short *x, int arg_num) | |||
2021 | arg_num)(long obj, short *x, int arg_num) | |||
2022 | ___SCMOBJ obj;(long obj, short *x, int arg_num) | |||
2023 | ___S16 *x;(long obj, short *x, int arg_num) | |||
2024 | int arg_num;)(long obj, short *x, int arg_num) | |||
2025 | { | |||
2026 | ___S64long val; | |||
2027 | ||||
2028 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2029 | !___S64_fits_in_width (val, 16)((((val) >> ((16)-1)) == 0) || (((val) >> ((16)-1 )) == -1))) | |||
2030 | return ___FIX(___STOC_S16_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(3<<7))+arg_num))<<2); | |||
2031 | ||||
2032 | *x = ___CAST(___S16,___S64_to_LONGLONG (val))((short)(((long long)(val)))); | |||
2033 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2034 | } | |||
2035 | ||||
2036 | ||||
2037 | /* Convert a Scheme integer to a C '___U16'. */ | |||
2038 | ||||
2039 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_U16)long ___SCMOBJ_to_U16 | |||
2040 | ___P((___SCMOBJ obj,(long obj, unsigned short *x, int arg_num) | |||
2041 | ___U16 *x,(long obj, unsigned short *x, int arg_num) | |||
2042 | int arg_num),(long obj, unsigned short *x, int arg_num) | |||
2043 | (obj,(long obj, unsigned short *x, int arg_num) | |||
2044 | x,(long obj, unsigned short *x, int arg_num) | |||
2045 | arg_num)(long obj, unsigned short *x, int arg_num) | |||
2046 | ___SCMOBJ obj;(long obj, unsigned short *x, int arg_num) | |||
2047 | ___U16 *x;(long obj, unsigned short *x, int arg_num) | |||
2048 | int arg_num;)(long obj, unsigned short *x, int arg_num) | |||
2049 | { | |||
2050 | ___U64unsigned long val; | |||
2051 | ||||
2052 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2053 | !___U64_fits_in_width (val, 16)(((val) >> (16)) == 0)) | |||
2054 | return ___FIX(___STOC_U16_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(4<<7))+arg_num))<<2); | |||
2055 | ||||
2056 | *x = ___CAST(___U16,___U64_to_ULONGLONG (val))((unsigned short)(((unsigned long long)(val)))); | |||
2057 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2058 | } | |||
2059 | ||||
2060 | ||||
2061 | /* Convert a Scheme integer to a C '___S32'. */ | |||
2062 | ||||
2063 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_S32)long ___SCMOBJ_to_S32 | |||
2064 | ___P((___SCMOBJ obj,(long obj, int *x, int arg_num) | |||
2065 | ___S32 *x,(long obj, int *x, int arg_num) | |||
2066 | int arg_num),(long obj, int *x, int arg_num) | |||
2067 | (obj,(long obj, int *x, int arg_num) | |||
2068 | x,(long obj, int *x, int arg_num) | |||
2069 | arg_num)(long obj, int *x, int arg_num) | |||
2070 | ___SCMOBJ obj;(long obj, int *x, int arg_num) | |||
2071 | ___S32 *x;(long obj, int *x, int arg_num) | |||
2072 | int arg_num;)(long obj, int *x, int arg_num) | |||
2073 | { | |||
2074 | ___S64long val; | |||
2075 | ||||
2076 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2077 | !___S64_fits_in_width (val, 32)((((val) >> ((32)-1)) == 0) || (((val) >> ((32)-1 )) == -1))) | |||
2078 | return ___FIX(___STOC_S32_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(5<<7))+arg_num))<<2); | |||
2079 | ||||
2080 | *x = ___CAST(___S32,___S64_to_LONGLONG (val))((int)(((long long)(val)))); | |||
2081 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2082 | } | |||
2083 | ||||
2084 | ||||
2085 | /* Convert a Scheme integer to a C '___U32'. */ | |||
2086 | ||||
2087 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_U32)long ___SCMOBJ_to_U32 | |||
2088 | ___P((___SCMOBJ obj,(long obj, unsigned int *x, int arg_num) | |||
2089 | ___U32 *x,(long obj, unsigned int *x, int arg_num) | |||
2090 | int arg_num),(long obj, unsigned int *x, int arg_num) | |||
2091 | (obj,(long obj, unsigned int *x, int arg_num) | |||
2092 | x,(long obj, unsigned int *x, int arg_num) | |||
2093 | arg_num)(long obj, unsigned int *x, int arg_num) | |||
2094 | ___SCMOBJ obj;(long obj, unsigned int *x, int arg_num) | |||
2095 | ___U32 *x;(long obj, unsigned int *x, int arg_num) | |||
2096 | int arg_num;)(long obj, unsigned int *x, int arg_num) | |||
2097 | { | |||
2098 | ___U64unsigned long val; | |||
2099 | ||||
2100 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2101 | !___U64_fits_in_width (val, 32)(((val) >> (32)) == 0)) | |||
2102 | return ___FIX(___STOC_U32_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(6<<7))+arg_num))<<2); | |||
2103 | ||||
2104 | *x = ___CAST(___U32,___U64_to_ULONGLONG (val))((unsigned int)(((unsigned long long)(val)))); | |||
2105 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2106 | } | |||
2107 | ||||
2108 | ||||
2109 | /* Convert a Scheme integer to a C '___F32'. */ | |||
2110 | ||||
2111 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_F32)long ___SCMOBJ_to_F32 | |||
2112 | ___P((___SCMOBJ obj,(long obj, float *x, int arg_num) | |||
2113 | ___F32 *x,(long obj, float *x, int arg_num) | |||
2114 | int arg_num),(long obj, float *x, int arg_num) | |||
2115 | (obj,(long obj, float *x, int arg_num) | |||
2116 | x,(long obj, float *x, int arg_num) | |||
2117 | arg_num)(long obj, float *x, int arg_num) | |||
2118 | ___SCMOBJ obj;(long obj, float *x, int arg_num) | |||
2119 | ___F32 *x;(long obj, float *x, int arg_num) | |||
2120 | int arg_num;)(long obj, float *x, int arg_num) | |||
2121 | { | |||
2122 | if (!___FLONUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (30))<<3)))) | |||
2123 | return ___FIX(___STOC_F32_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(9<<7))+arg_num))<<2); | |||
2124 | ||||
2125 | *x = ___FLONUM_VAL(obj)*((double*)((((long*)((obj)-(1)))+1))); | |||
2126 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2127 | } | |||
2128 | ||||
2129 | ||||
2130 | /* Convert a Scheme integer to a C '___F64'. */ | |||
2131 | ||||
2132 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_F64)long ___SCMOBJ_to_F64 | |||
2133 | ___P((___SCMOBJ obj,(long obj, double *x, int arg_num) | |||
2134 | ___F64 *x,(long obj, double *x, int arg_num) | |||
2135 | int arg_num),(long obj, double *x, int arg_num) | |||
2136 | (obj,(long obj, double *x, int arg_num) | |||
2137 | x,(long obj, double *x, int arg_num) | |||
2138 | arg_num)(long obj, double *x, int arg_num) | |||
2139 | ___SCMOBJ obj;(long obj, double *x, int arg_num) | |||
2140 | ___F64 *x;(long obj, double *x, int arg_num) | |||
2141 | int arg_num;)(long obj, double *x, int arg_num) | |||
2142 | { | |||
2143 | if (!___FLONUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (30))<<3)))) | |||
2144 | return ___FIX(___STOC_F64_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(10<<7))+arg_num))<<2); | |||
2145 | ||||
2146 | *x = ___FLONUM_VAL(obj)*((double*)((((long*)((obj)-(1)))+1))); | |||
2147 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2148 | } | |||
2149 | ||||
2150 | ||||
2151 | /* Convert a Scheme character to a C 'char'. */ | |||
2152 | ||||
2153 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_CHAR)long ___SCMOBJ_to_CHAR | |||
2154 | ___P((___SCMOBJ obj,(long obj, char *x, int arg_num) | |||
2155 | char *x,(long obj, char *x, int arg_num) | |||
2156 | int arg_num),(long obj, char *x, int arg_num) | |||
2157 | (obj,(long obj, char *x, int arg_num) | |||
2158 | x,(long obj, char *x, int arg_num) | |||
2159 | arg_num)(long obj, char *x, int arg_num) | |||
2160 | ___SCMOBJ obj;(long obj, char *x, int arg_num) | |||
2161 | char *x;(long obj, char *x, int arg_num) | |||
2162 | int arg_num;)(long obj, char *x, int arg_num) | |||
2163 | { | |||
2164 | ___UCS_4unsigned int c; | |||
2165 | ||||
2166 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2167 | (c=UCS_4_to_uchar(___INT(obj))((obj)>>2)) > (1<<___CHAR_WIDTH8)-1) | |||
2168 | return ___FIX(___STOC_CHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(11<<7))+arg_num))<<2); | |||
2169 | ||||
2170 | *x = ___CAST(char,c)((char)(c)); | |||
2171 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2172 | } | |||
2173 | ||||
2174 | ||||
2175 | /* Convert a Scheme character to a C 'signed char'. */ | |||
2176 | ||||
2177 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_SCHAR)long ___SCMOBJ_to_SCHAR | |||
2178 | ___P((___SCMOBJ obj,(long obj, signed char *x, int arg_num) | |||
2179 | ___SCHAR *x,(long obj, signed char *x, int arg_num) | |||
2180 | int arg_num),(long obj, signed char *x, int arg_num) | |||
2181 | (obj,(long obj, signed char *x, int arg_num) | |||
2182 | x,(long obj, signed char *x, int arg_num) | |||
2183 | arg_num)(long obj, signed char *x, int arg_num) | |||
2184 | ___SCMOBJ obj;(long obj, signed char *x, int arg_num) | |||
2185 | ___SCHAR *x;(long obj, signed char *x, int arg_num) | |||
2186 | int arg_num;)(long obj, signed char *x, int arg_num) | |||
2187 | { | |||
2188 | ___UCS_4unsigned int c; | |||
2189 | ||||
2190 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2191 | (c=UCS_4_to_uchar(___INT(obj))((obj)>>2)) > (1<<___CHAR_WIDTH8)-1) | |||
2192 | return ___FIX(___STOC_SCHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(12<<7))+arg_num))<<2); | |||
2193 | ||||
2194 | *x = ___CAST(___SCHAR,c)((signed char)(c)); | |||
2195 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2196 | } | |||
2197 | ||||
2198 | ||||
2199 | /* Convert a Scheme character to a C 'unsigned char'. */ | |||
2200 | ||||
2201 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UCHAR)long ___SCMOBJ_to_UCHAR | |||
2202 | ___P((___SCMOBJ obj,(long obj, unsigned char *x, int arg_num) | |||
2203 | unsigned char *x,(long obj, unsigned char *x, int arg_num) | |||
2204 | int arg_num),(long obj, unsigned char *x, int arg_num) | |||
2205 | (obj,(long obj, unsigned char *x, int arg_num) | |||
2206 | x,(long obj, unsigned char *x, int arg_num) | |||
2207 | arg_num)(long obj, unsigned char *x, int arg_num) | |||
2208 | ___SCMOBJ obj;(long obj, unsigned char *x, int arg_num) | |||
2209 | unsigned char *x;(long obj, unsigned char *x, int arg_num) | |||
2210 | int arg_num;)(long obj, unsigned char *x, int arg_num) | |||
2211 | { | |||
2212 | ___UCS_4unsigned int c; | |||
2213 | ||||
2214 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2215 | (c=UCS_4_to_uchar(___INT(obj))((obj)>>2)) > (1<<___CHAR_WIDTH8)-1) | |||
2216 | return ___FIX(___STOC_UCHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(13<<7))+arg_num))<<2); | |||
2217 | ||||
2218 | *x = ___CAST(unsigned char,c)((unsigned char)(c)); | |||
2219 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2220 | } | |||
2221 | ||||
2222 | ||||
2223 | /* Convert a Scheme character to a C ISO-8859-1 encoded character. */ | |||
2224 | ||||
2225 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_ISO_8859_1)long ___SCMOBJ_to_ISO_8859_1 | |||
2226 | ___P((___SCMOBJ obj,(long obj, unsigned char *x, int arg_num) | |||
2227 | ___ISO_8859_1 *x,(long obj, unsigned char *x, int arg_num) | |||
2228 | int arg_num),(long obj, unsigned char *x, int arg_num) | |||
2229 | (obj,(long obj, unsigned char *x, int arg_num) | |||
2230 | x,(long obj, unsigned char *x, int arg_num) | |||
2231 | arg_num)(long obj, unsigned char *x, int arg_num) | |||
2232 | ___SCMOBJ obj;(long obj, unsigned char *x, int arg_num) | |||
2233 | ___ISO_8859_1 *x;(long obj, unsigned char *x, int arg_num) | |||
2234 | int arg_num;)(long obj, unsigned char *x, int arg_num) | |||
2235 | { | |||
2236 | ___UCS_4unsigned int c; | |||
2237 | ||||
2238 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2239 | (c=___INT(obj)((obj)>>2)) > 0xff) /* ISO-8859-1 is 8 bits */ | |||
2240 | return ___FIX(___STOC_ISO_8859_1_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(14<<7))+arg_num))<<2); | |||
2241 | ||||
2242 | *x = ___CAST(___ISO_8859_1,c)((unsigned char)(c)); | |||
2243 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2244 | } | |||
2245 | ||||
2246 | ||||
2247 | /* Convert a Scheme character to a C UCS-2 encoded character. */ | |||
2248 | ||||
2249 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UCS_2)long ___SCMOBJ_to_UCS_2 | |||
2250 | ___P((___SCMOBJ obj,(long obj, unsigned short *x, int arg_num) | |||
2251 | ___UCS_2 *x,(long obj, unsigned short *x, int arg_num) | |||
2252 | int arg_num),(long obj, unsigned short *x, int arg_num) | |||
2253 | (obj,(long obj, unsigned short *x, int arg_num) | |||
2254 | x,(long obj, unsigned short *x, int arg_num) | |||
2255 | arg_num)(long obj, unsigned short *x, int arg_num) | |||
2256 | ___SCMOBJ obj;(long obj, unsigned short *x, int arg_num) | |||
2257 | ___UCS_2 *x;(long obj, unsigned short *x, int arg_num) | |||
2258 | int arg_num;)(long obj, unsigned short *x, int arg_num) | |||
2259 | { | |||
2260 | ___UCS_4unsigned int c; | |||
2261 | ||||
2262 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2263 | (c=___INT(obj)((obj)>>2)) > 0xffff) /* UCS-2 is 16 bits */ | |||
2264 | return ___FIX(___STOC_UCS_2_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(15<<7))+arg_num))<<2); | |||
2265 | ||||
2266 | *x = ___CAST(___UCS_2,c)((unsigned short)(c)); | |||
2267 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2268 | } | |||
2269 | ||||
2270 | ||||
2271 | /* Convert a Scheme character to a C UCS-4 encoded character. */ | |||
2272 | ||||
2273 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UCS_4)long ___SCMOBJ_to_UCS_4 | |||
2274 | ___P((___SCMOBJ obj,(long obj, unsigned int *x, int arg_num) | |||
2275 | ___UCS_4 *x,(long obj, unsigned int *x, int arg_num) | |||
2276 | int arg_num),(long obj, unsigned int *x, int arg_num) | |||
2277 | (obj,(long obj, unsigned int *x, int arg_num) | |||
2278 | x,(long obj, unsigned int *x, int arg_num) | |||
2279 | arg_num)(long obj, unsigned int *x, int arg_num) | |||
2280 | ___SCMOBJ obj;(long obj, unsigned int *x, int arg_num) | |||
2281 | ___UCS_4 *x;(long obj, unsigned int *x, int arg_num) | |||
2282 | int arg_num;)(long obj, unsigned int *x, int arg_num) | |||
2283 | { | |||
2284 | ___UCS_4unsigned int c; | |||
2285 | ||||
2286 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0) || | |||
2287 | (c=___INT(obj)((obj)>>2)) > 0x7fffffff) /* UCS-4 is 31 bits */ | |||
2288 | return ___FIX(___STOC_UCS_4_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(16<<7))+arg_num))<<2); | |||
2289 | ||||
2290 | *x = ___CAST(___UCS_4,c)((unsigned int)(c)); | |||
2291 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2292 | } | |||
2293 | ||||
2294 | ||||
2295 | /* Convert a Scheme character to a C ___WCHAR encoded character. */ | |||
2296 | ||||
2297 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_WCHAR)long ___SCMOBJ_to_WCHAR | |||
2298 | ___P((___SCMOBJ obj,(long obj, wchar_t *x, int arg_num) | |||
2299 | ___WCHAR *x,(long obj, wchar_t *x, int arg_num) | |||
2300 | int arg_num),(long obj, wchar_t *x, int arg_num) | |||
2301 | (obj,(long obj, wchar_t *x, int arg_num) | |||
2302 | x,(long obj, wchar_t *x, int arg_num) | |||
2303 | arg_num)(long obj, wchar_t *x, int arg_num) | |||
2304 | ___SCMOBJ obj;(long obj, wchar_t *x, int arg_num) | |||
2305 | ___WCHAR *x;(long obj, wchar_t *x, int arg_num) | |||
2306 | int arg_num;)(long obj, wchar_t *x, int arg_num) | |||
2307 | { | |||
2308 | if (!___CHARP(obj)((((___temp=obj))&((1<<2)-1))==2&&___temp>= 0)) | |||
2309 | return ___FIX(___STOC_WCHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(17<<7))+arg_num))<<2); | |||
2310 | ||||
2311 | { | |||
2312 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 | |||
2313 | ___SM32int c = ___CAST(___SM32,___INT(obj))((int)(((obj)>>2))); | |||
2314 | #else | |||
2315 | ___UM32unsigned int c = ___CAST(___UM32,___INT(obj))((unsigned int)(((obj)>>2))); | |||
2316 | #endif | |||
2317 | ||||
2318 | #if 0 < ___WCHAR_MIN(-2147483647 - 1) || ___MAX_CHR0x10ffff > ___WCHAR_MAX2147483647 | |||
2319 | #if 0 < ___WCHAR_MIN(-2147483647 - 1) | |||
2320 | #if ___MAX_CHR0x10ffff > ___WCHAR_MAX2147483647 | |||
2321 | if (c < ___WCHAR_MIN(-2147483647 - 1) || c > ___WCHAR_MAX2147483647) | |||
2322 | #else | |||
2323 | if (c < ___WCHAR_MIN(-2147483647 - 1)) | |||
2324 | #endif | |||
2325 | #else | |||
2326 | if (c > ___WCHAR_MAX2147483647) | |||
2327 | #endif | |||
2328 | return ___FIX(___STOC_WCHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(17<<7))+arg_num))<<2); | |||
2329 | #endif | |||
2330 | ||||
2331 | *x = ___CAST(___WCHAR,c)((wchar_t)(c)); | |||
2332 | } | |||
2333 | ||||
2334 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2335 | } | |||
2336 | ||||
2337 | ||||
2338 | /* Convert a Scheme integer to a C 'size_t'. */ | |||
2339 | ||||
2340 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_SIZE_T)long ___SCMOBJ_to_SIZE_T | |||
2341 | ___P((___SCMOBJ obj,(long obj, unsigned long *x, int arg_num) | |||
2342 | ___SIZE_T *x,(long obj, unsigned long *x, int arg_num) | |||
2343 | int arg_num),(long obj, unsigned long *x, int arg_num) | |||
2344 | (obj,(long obj, unsigned long *x, int arg_num) | |||
2345 | x,(long obj, unsigned long *x, int arg_num) | |||
2346 | arg_num)(long obj, unsigned long *x, int arg_num) | |||
2347 | ___SCMOBJ obj;(long obj, unsigned long *x, int arg_num) | |||
2348 | ___SIZE_T *x;(long obj, unsigned long *x, int arg_num) | |||
2349 | int arg_num;)(long obj, unsigned long *x, int arg_num) | |||
2350 | { | |||
2351 | ___U64unsigned long val; | |||
2352 | ||||
2353 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2354 | return ___FIX(___STOC_SIZE_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(18<<7))+arg_num))<<2); | |||
2355 | ||||
2356 | #if ___WS8 == 4 | |||
2357 | if (!___U64_fits_in_width (val, 32)(((val) >> (32)) == 0)) | |||
2358 | return ___FIX(___STOC_SIZE_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(18<<7))+arg_num))<<2); | |||
2359 | #endif | |||
2360 | ||||
2361 | *x = ___CAST(___SIZE_T,___U64_to_ULONGLONG (val))((unsigned long)(((unsigned long long)(val)))); | |||
2362 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2363 | } | |||
2364 | ||||
2365 | ||||
2366 | /* Convert a Scheme integer to a C 'ssize_t'. */ | |||
2367 | ||||
2368 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_SSIZE_T)long ___SCMOBJ_to_SSIZE_T | |||
2369 | ___P((___SCMOBJ obj,(long obj, long *x, int arg_num) | |||
2370 | ___SSIZE_T *x,(long obj, long *x, int arg_num) | |||
2371 | int arg_num),(long obj, long *x, int arg_num) | |||
2372 | (obj,(long obj, long *x, int arg_num) | |||
2373 | x,(long obj, long *x, int arg_num) | |||
2374 | arg_num)(long obj, long *x, int arg_num) | |||
2375 | ___SCMOBJ obj;(long obj, long *x, int arg_num) | |||
2376 | ___SSIZE_T *x;(long obj, long *x, int arg_num) | |||
2377 | int arg_num;)(long obj, long *x, int arg_num) | |||
2378 | { | |||
2379 | ___S64long val; | |||
2380 | ||||
2381 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2382 | return ___FIX(___STOC_SSIZE_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(19<<7))+arg_num))<<2); | |||
2383 | ||||
2384 | #if ___WS8 == 4 | |||
2385 | if (!___S64_fits_in_width (val, 32)((((val) >> ((32)-1)) == 0) || (((val) >> ((32)-1 )) == -1))) | |||
2386 | return ___FIX(___STOC_SSIZE_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(19<<7))+arg_num))<<2); | |||
2387 | #endif | |||
2388 | ||||
2389 | *x = ___CAST(___SSIZE_T,___S64_to_LONGLONG (val))((long)(((long long)(val)))); | |||
2390 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2391 | } | |||
2392 | ||||
2393 | ||||
2394 | /* Convert a Scheme integer to a C 'ptrdiff_t'. */ | |||
2395 | ||||
2396 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_PTRDIFF_T)long ___SCMOBJ_to_PTRDIFF_T | |||
2397 | ___P((___SCMOBJ obj,(long obj, long *x, int arg_num) | |||
2398 | ___PTRDIFF_T *x,(long obj, long *x, int arg_num) | |||
2399 | int arg_num),(long obj, long *x, int arg_num) | |||
2400 | (obj,(long obj, long *x, int arg_num) | |||
2401 | x,(long obj, long *x, int arg_num) | |||
2402 | arg_num)(long obj, long *x, int arg_num) | |||
2403 | ___SCMOBJ obj;(long obj, long *x, int arg_num) | |||
2404 | ___PTRDIFF_T *x;(long obj, long *x, int arg_num) | |||
2405 | int arg_num;)(long obj, long *x, int arg_num) | |||
2406 | { | |||
2407 | ___S64long val; | |||
2408 | ||||
2409 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2410 | return ___FIX(___STOC_PTRDIFF_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(20<<7))+arg_num))<<2); | |||
2411 | ||||
2412 | #if ___WS8 == 4 | |||
2413 | if (!___S64_fits_in_width (val, 32)((((val) >> ((32)-1)) == 0) || (((val) >> ((32)-1 )) == -1))) | |||
2414 | return ___FIX(___STOC_PTRDIFF_T_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(20<<7))+arg_num))<<2); | |||
2415 | #endif | |||
2416 | ||||
2417 | *x = ___CAST(___PTRDIFF_T,___S64_to_LONGLONG (val))((long)(((long long)(val)))); | |||
2418 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2419 | } | |||
2420 | ||||
2421 | ||||
2422 | /* Convert a Scheme integer to a C 'short'. */ | |||
2423 | ||||
2424 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_SHORT)long ___SCMOBJ_to_SHORT | |||
2425 | ___P((___SCMOBJ obj,(long obj, short *x, int arg_num) | |||
2426 | short *x,(long obj, short *x, int arg_num) | |||
2427 | int arg_num),(long obj, short *x, int arg_num) | |||
2428 | (obj,(long obj, short *x, int arg_num) | |||
2429 | x,(long obj, short *x, int arg_num) | |||
2430 | arg_num)(long obj, short *x, int arg_num) | |||
2431 | ___SCMOBJ obj;(long obj, short *x, int arg_num) | |||
2432 | short *x;(long obj, short *x, int arg_num) | |||
2433 | int arg_num;)(long obj, short *x, int arg_num) | |||
2434 | { | |||
2435 | ___S64long val; | |||
2436 | ||||
2437 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2438 | return ___FIX(___STOC_SHORT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(21<<7))+arg_num))<<2); | |||
2439 | ||||
2440 | #if ___SHORT_WIDTH16 < 64 | |||
2441 | if (!___S64_fits_in_width (val, ___SHORT_WIDTH)((((val) >> ((16)-1)) == 0) || (((val) >> ((16)-1 )) == -1))) | |||
2442 | return ___FIX(___STOC_SHORT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(21<<7))+arg_num))<<2); | |||
2443 | #endif | |||
2444 | ||||
2445 | *x = ___CAST(short,___S64_to_LONGLONG (val))((short)(((long long)(val)))); | |||
2446 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2447 | } | |||
2448 | ||||
2449 | ||||
2450 | /* Convert a Scheme integer to a C 'unsigned short'. */ | |||
2451 | ||||
2452 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_USHORT)long ___SCMOBJ_to_USHORT | |||
2453 | ___P((___SCMOBJ obj,(long obj, unsigned short *x, int arg_num) | |||
2454 | unsigned short *x,(long obj, unsigned short *x, int arg_num) | |||
2455 | int arg_num),(long obj, unsigned short *x, int arg_num) | |||
2456 | (obj,(long obj, unsigned short *x, int arg_num) | |||
2457 | x,(long obj, unsigned short *x, int arg_num) | |||
2458 | arg_num)(long obj, unsigned short *x, int arg_num) | |||
2459 | ___SCMOBJ obj;(long obj, unsigned short *x, int arg_num) | |||
2460 | unsigned short *x;(long obj, unsigned short *x, int arg_num) | |||
2461 | int arg_num;)(long obj, unsigned short *x, int arg_num) | |||
2462 | { | |||
2463 | ___U64unsigned long val; | |||
2464 | ||||
2465 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2466 | return ___FIX(___STOC_USHORT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(22<<7))+arg_num))<<2); | |||
2467 | ||||
2468 | #if ___SHORT_WIDTH16 < 64 | |||
2469 | if (!___U64_fits_in_width (val, ___SHORT_WIDTH)(((val) >> (16)) == 0)) | |||
2470 | return ___FIX(___STOC_USHORT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(22<<7))+arg_num))<<2); | |||
2471 | #endif | |||
2472 | ||||
2473 | *x = ___CAST(unsigned short,___U64_to_ULONGLONG (val))((unsigned short)(((unsigned long long)(val)))); | |||
2474 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2475 | } | |||
2476 | ||||
2477 | ||||
2478 | /* Convert a Scheme integer to a C 'int'. */ | |||
2479 | ||||
2480 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_INT)long ___SCMOBJ_to_INT | |||
2481 | ___P((___SCMOBJ obj,(long obj, int *x, int arg_num) | |||
2482 | int *x,(long obj, int *x, int arg_num) | |||
2483 | int arg_num),(long obj, int *x, int arg_num) | |||
2484 | (obj,(long obj, int *x, int arg_num) | |||
2485 | x,(long obj, int *x, int arg_num) | |||
2486 | arg_num)(long obj, int *x, int arg_num) | |||
2487 | ___SCMOBJ obj;(long obj, int *x, int arg_num) | |||
2488 | int *x;(long obj, int *x, int arg_num) | |||
2489 | int arg_num;)(long obj, int *x, int arg_num) | |||
2490 | { | |||
2491 | ___S64long val; | |||
2492 | ||||
2493 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2494 | return ___FIX(___STOC_INT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(23<<7))+arg_num))<<2); | |||
2495 | ||||
2496 | #if ___INT_WIDTH32 < 64 | |||
2497 | if (!___S64_fits_in_width (val, ___INT_WIDTH)((((val) >> ((32)-1)) == 0) || (((val) >> ((32)-1 )) == -1))) | |||
2498 | return ___FIX(___STOC_INT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(23<<7))+arg_num))<<2); | |||
2499 | #endif | |||
2500 | ||||
2501 | *x = ___CAST(int,___S64_to_LONGLONG (val))((int)(((long long)(val)))); | |||
2502 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2503 | } | |||
2504 | ||||
2505 | ||||
2506 | /* Convert a Scheme integer to a C 'unsigned int'. */ | |||
2507 | ||||
2508 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UINT)long ___SCMOBJ_to_UINT | |||
2509 | ___P((___SCMOBJ obj,(long obj, unsigned int *x, int arg_num) | |||
2510 | unsigned int *x,(long obj, unsigned int *x, int arg_num) | |||
2511 | int arg_num),(long obj, unsigned int *x, int arg_num) | |||
2512 | (obj,(long obj, unsigned int *x, int arg_num) | |||
2513 | x,(long obj, unsigned int *x, int arg_num) | |||
2514 | arg_num)(long obj, unsigned int *x, int arg_num) | |||
2515 | ___SCMOBJ obj;(long obj, unsigned int *x, int arg_num) | |||
2516 | unsigned int *x;(long obj, unsigned int *x, int arg_num) | |||
2517 | int arg_num;)(long obj, unsigned int *x, int arg_num) | |||
2518 | { | |||
2519 | ___U64unsigned long val; | |||
2520 | ||||
2521 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2522 | return ___FIX(___STOC_UINT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(24<<7))+arg_num))<<2); | |||
2523 | ||||
2524 | #if ___INT_WIDTH32 < 64 | |||
2525 | if (!___U64_fits_in_width (val, ___INT_WIDTH)(((val) >> (32)) == 0)) | |||
2526 | return ___FIX(___STOC_UINT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(24<<7))+arg_num))<<2); | |||
2527 | #endif | |||
2528 | ||||
2529 | *x = ___CAST(unsigned int,___U64_to_ULONGLONG (val))((unsigned int)(((unsigned long long)(val)))); | |||
2530 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2531 | } | |||
2532 | ||||
2533 | ||||
2534 | /* Convert a Scheme integer to a C 'long'. */ | |||
2535 | ||||
2536 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_LONG)long ___SCMOBJ_to_LONG | |||
2537 | ___P((___SCMOBJ obj,(long obj, long *x, int arg_num) | |||
2538 | long *x,(long obj, long *x, int arg_num) | |||
2539 | int arg_num),(long obj, long *x, int arg_num) | |||
2540 | (obj,(long obj, long *x, int arg_num) | |||
2541 | x,(long obj, long *x, int arg_num) | |||
2542 | arg_num)(long obj, long *x, int arg_num) | |||
2543 | ___SCMOBJ obj;(long obj, long *x, int arg_num) | |||
2544 | long *x;(long obj, long *x, int arg_num) | |||
2545 | int arg_num;)(long obj, long *x, int arg_num) | |||
2546 | { | |||
2547 | ___S64long val; | |||
2548 | ||||
2549 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2550 | return ___FIX(___STOC_LONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(25<<7))+arg_num))<<2); | |||
2551 | ||||
2552 | #if ___LONG_WIDTH64 < 64 | |||
2553 | if (!___S64_fits_in_width (val, ___LONG_WIDTH)((((val) >> ((64)-1)) == 0) || (((val) >> ((64)-1 )) == -1))) | |||
2554 | return ___FIX(___STOC_LONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(25<<7))+arg_num))<<2); | |||
2555 | #endif | |||
2556 | ||||
2557 | *x = ___CAST(long,___S64_to_LONGLONG (val))((long)(((long long)(val)))); | |||
2558 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2559 | } | |||
2560 | ||||
2561 | ||||
2562 | /* Convert a Scheme integer to a C 'unsigned long'. */ | |||
2563 | ||||
2564 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_ULONG)long ___SCMOBJ_to_ULONG | |||
2565 | ___P((___SCMOBJ obj,(long obj, unsigned long *x, int arg_num) | |||
2566 | unsigned long *x,(long obj, unsigned long *x, int arg_num) | |||
2567 | int arg_num),(long obj, unsigned long *x, int arg_num) | |||
2568 | (obj,(long obj, unsigned long *x, int arg_num) | |||
2569 | x,(long obj, unsigned long *x, int arg_num) | |||
2570 | arg_num)(long obj, unsigned long *x, int arg_num) | |||
2571 | ___SCMOBJ obj;(long obj, unsigned long *x, int arg_num) | |||
2572 | unsigned long *x;(long obj, unsigned long *x, int arg_num) | |||
2573 | int arg_num;)(long obj, unsigned long *x, int arg_num) | |||
2574 | { | |||
2575 | ___U64unsigned long val; | |||
2576 | ||||
2577 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2578 | return ___FIX(___STOC_ULONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(26<<7))+arg_num))<<2); | |||
2579 | ||||
2580 | #if ___LONG_WIDTH64 < 64 | |||
2581 | if (!___U64_fits_in_width (val, ___LONG_WIDTH)(((val) >> (64)) == 0)) | |||
2582 | return ___FIX(___STOC_ULONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(26<<7))+arg_num))<<2); | |||
2583 | #endif | |||
2584 | ||||
2585 | *x = ___CAST(unsigned long,___U64_to_ULONGLONG (val))((unsigned long)(((unsigned long long)(val)))); | |||
2586 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2587 | } | |||
2588 | ||||
2589 | ||||
2590 | /* Convert a Scheme integer to a C 'long long'. */ | |||
2591 | ||||
2592 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_LONGLONG)long ___SCMOBJ_to_LONGLONG | |||
2593 | ___P((___SCMOBJ obj,(long obj, long long *x, int arg_num) | |||
2594 | ___LONGLONG *x,(long obj, long long *x, int arg_num) | |||
2595 | int arg_num),(long obj, long long *x, int arg_num) | |||
2596 | (obj,(long obj, long long *x, int arg_num) | |||
2597 | x,(long obj, long long *x, int arg_num) | |||
2598 | arg_num)(long obj, long long *x, int arg_num) | |||
2599 | ___SCMOBJ obj;(long obj, long long *x, int arg_num) | |||
2600 | ___LONGLONG *x;(long obj, long long *x, int arg_num) | |||
2601 | int arg_num;)(long obj, long long *x, int arg_num) | |||
2602 | { | |||
2603 | ___S64long val; | |||
2604 | ||||
2605 | if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2606 | return ___FIX(___STOC_LONGLONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(27<<7))+arg_num))<<2); | |||
2607 | ||||
2608 | #if ___LONGLONG_WIDTH64 < 64 | |||
2609 | if (!___S64_fits_in_width (val, ___LONGLONG_WIDTH)((((val) >> ((64)-1)) == 0) || (((val) >> ((64)-1 )) == -1))) | |||
2610 | return ___FIX(___STOC_LONGLONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(27<<7))+arg_num))<<2); | |||
2611 | #endif | |||
2612 | ||||
2613 | *x = ___S64_to_LONGLONG (val)((long long)(val)); | |||
2614 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2615 | } | |||
2616 | ||||
2617 | ||||
2618 | /* Convert a Scheme integer to a C 'unsigned long long'. */ | |||
2619 | ||||
2620 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_ULONGLONG)long ___SCMOBJ_to_ULONGLONG | |||
2621 | ___P((___SCMOBJ obj,(long obj, unsigned long long *x, int arg_num) | |||
2622 | ___ULONGLONG *x,(long obj, unsigned long long *x, int arg_num) | |||
2623 | int arg_num),(long obj, unsigned long long *x, int arg_num) | |||
2624 | (obj,(long obj, unsigned long long *x, int arg_num) | |||
2625 | x,(long obj, unsigned long long *x, int arg_num) | |||
2626 | arg_num)(long obj, unsigned long long *x, int arg_num) | |||
2627 | ___SCMOBJ obj;(long obj, unsigned long long *x, int arg_num) | |||
2628 | ___ULONGLONG *x;(long obj, unsigned long long *x, int arg_num) | |||
2629 | int arg_num;)(long obj, unsigned long long *x, int arg_num) | |||
2630 | { | |||
2631 | ___U64unsigned long val; | |||
2632 | ||||
2633 | if (___SCMOBJ_to_U64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
2634 | return ___FIX(___STOC_ULONGLONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(28<<7))+arg_num))<<2); | |||
2635 | ||||
2636 | #if ___LONGLONG_WIDTH64 < 64 | |||
2637 | if (!___U64_fits_in_width (val, ___LONGLONG_WIDTH)(((val) >> (64)) == 0)) | |||
2638 | return ___FIX(___STOC_ULONGLONG_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(28<<7))+arg_num))<<2); | |||
2639 | #endif | |||
2640 | ||||
2641 | *x = ___U64_to_ULONGLONG (val)((unsigned long long)(val)); | |||
2642 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2643 | } | |||
2644 | ||||
2645 | ||||
2646 | /* Convert a Scheme flonum to a C 'float'. */ | |||
2647 | ||||
2648 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_FLOAT)long ___SCMOBJ_to_FLOAT | |||
2649 | ___P((___SCMOBJ obj,(long obj, float *x, int arg_num) | |||
2650 | float *x,(long obj, float *x, int arg_num) | |||
2651 | int arg_num),(long obj, float *x, int arg_num) | |||
2652 | (obj,(long obj, float *x, int arg_num) | |||
2653 | x,(long obj, float *x, int arg_num) | |||
2654 | arg_num)(long obj, float *x, int arg_num) | |||
2655 | ___SCMOBJ obj;(long obj, float *x, int arg_num) | |||
2656 | float *x;(long obj, float *x, int arg_num) | |||
2657 | int arg_num;)(long obj, float *x, int arg_num) | |||
2658 | { | |||
2659 | if (!___FLONUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (30))<<3)))) | |||
2660 | return ___FIX(___STOC_FLOAT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(29<<7))+arg_num))<<2); | |||
2661 | ||||
2662 | *x = ___FLONUM_VAL(obj)*((double*)((((long*)((obj)-(1)))+1))); | |||
2663 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2664 | } | |||
2665 | ||||
2666 | ||||
2667 | /* Convert a Scheme flonum to a C 'double'. */ | |||
2668 | ||||
2669 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_DOUBLE)long ___SCMOBJ_to_DOUBLE | |||
2670 | ___P((___SCMOBJ obj,(long obj, double *x, int arg_num) | |||
2671 | double *x,(long obj, double *x, int arg_num) | |||
2672 | int arg_num),(long obj, double *x, int arg_num) | |||
2673 | (obj,(long obj, double *x, int arg_num) | |||
2674 | x,(long obj, double *x, int arg_num) | |||
2675 | arg_num)(long obj, double *x, int arg_num) | |||
2676 | ___SCMOBJ obj;(long obj, double *x, int arg_num) | |||
2677 | double *x;(long obj, double *x, int arg_num) | |||
2678 | int arg_num;)(long obj, double *x, int arg_num) | |||
2679 | { | |||
2680 | if (!___FLONUMP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (30))<<3)))) | |||
2681 | return ___FIX(___STOC_DOUBLE_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(30<<7))+arg_num))<<2); | |||
2682 | ||||
2683 | *x = ___FLONUM_VAL(obj)*((double*)((((long*)((obj)-(1)))+1))); | |||
2684 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2685 | } | |||
2686 | ||||
2687 | ||||
2688 | /* Convert a Scheme foreign object to a C pointer. */ | |||
2689 | ||||
2690 | ___HIDDENstatic int can_convert_foreign_type | |||
2691 | ___P((___SCMOBJ src_tags,(long src_tags, long dest_tags) | |||
2692 | ___SCMOBJ dest_tags),(long src_tags, long dest_tags) | |||
2693 | (src_tags,(long src_tags, long dest_tags) | |||
2694 | dest_tags)(long src_tags, long dest_tags) | |||
2695 | ___SCMOBJ src_tags;(long src_tags, long dest_tags) | |||
2696 | ___SCMOBJ dest_tags;)(long src_tags, long dest_tags) | |||
2697 | { | |||
2698 | ___SCMOBJlong tag; | |||
2699 | ___SCMOBJlong probe; | |||
2700 | ||||
2701 | if (src_tags == ___FAL((((long)(-1))<<2)+2) || /* source type == void* */ | |||
2702 | dest_tags == ___FAL((((long)(-1))<<2)+2)) /* destination type == void* */ | |||
2703 | return 1; | |||
2704 | ||||
2705 | tag = ___CAR(src_tags)(*((((long*)((src_tags)-(3)))+1)+1)); | |||
2706 | probe = dest_tags; | |||
2707 | ||||
2708 | while (probe != ___NUL((((long)(-3))<<2)+2)) | |||
2709 | { | |||
2710 | if (___EQP(tag,___CAR(probe))((tag)==((*((((long*)((probe)-(3)))+1)+1))))) | |||
2711 | return 1; | |||
2712 | probe = ___CDR(probe)(*((((long*)((probe)-(3)))+1)+0)); | |||
2713 | } | |||
2714 | ||||
2715 | return 0; | |||
2716 | } | |||
2717 | ||||
2718 | ||||
2719 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_POINTER)long ___SCMOBJ_to_POINTER | |||
2720 | ___P((___SCMOBJ obj,(long obj, void **x, long tags, int arg_num) | |||
2721 | void **x,(long obj, void **x, long tags, int arg_num) | |||
2722 | ___SCMOBJ tags,(long obj, void **x, long tags, int arg_num) | |||
2723 | int arg_num),(long obj, void **x, long tags, int arg_num) | |||
2724 | (obj,(long obj, void **x, long tags, int arg_num) | |||
2725 | x,(long obj, void **x, long tags, int arg_num) | |||
2726 | tags,(long obj, void **x, long tags, int arg_num) | |||
2727 | arg_num)(long obj, void **x, long tags, int arg_num) | |||
2728 | ___SCMOBJ obj;(long obj, void **x, long tags, int arg_num) | |||
2729 | void **x;(long obj, void **x, long tags, int arg_num) | |||
2730 | ___SCMOBJ tags;(long obj, void **x, long tags, int arg_num) | |||
2731 | int arg_num;)(long obj, void **x, long tags, int arg_num) | |||
2732 | { | |||
2733 | if (___FALSEP(obj)((obj)==((((long)(-1))<<2)+2))) /* #f counts as NULL */ | |||
2734 | { | |||
2735 | *x = 0; | |||
2736 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2737 | } | |||
2738 | ||||
2739 | if (!___TESTSUBTYPE(obj,___sFOREIGN)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (18))<<3))) || | |||
2740 | !can_convert_foreign_type (___FIELD(obj,___FOREIGN_TAGS)(*((((long*)((obj)-(1)))+1)+0)), tags)) | |||
2741 | return ___FIX(___STOC_POINTER_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(34<<7))+arg_num))<<2); | |||
2742 | ||||
2743 | *x = ___CAST(void*,___FIELD(obj,___FOREIGN_PTR))((void*)((*((((long*)((obj)-(1)))+1)+2)))); | |||
2744 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2745 | } | |||
2746 | ||||
2747 | ||||
2748 | /* Convert a Scheme foreign object to a nonnull C pointer. */ | |||
2749 | ||||
2750 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLPOINTER)long ___SCMOBJ_to_NONNULLPOINTER | |||
2751 | ___P((___SCMOBJ obj,(long obj, void **x, long tags, int arg_num) | |||
2752 | void **x,(long obj, void **x, long tags, int arg_num) | |||
2753 | ___SCMOBJ tags,(long obj, void **x, long tags, int arg_num) | |||
2754 | int arg_num),(long obj, void **x, long tags, int arg_num) | |||
2755 | (obj,(long obj, void **x, long tags, int arg_num) | |||
2756 | x,(long obj, void **x, long tags, int arg_num) | |||
2757 | tags,(long obj, void **x, long tags, int arg_num) | |||
2758 | arg_num)(long obj, void **x, long tags, int arg_num) | |||
2759 | ___SCMOBJ obj;(long obj, void **x, long tags, int arg_num) | |||
2760 | void **x;(long obj, void **x, long tags, int arg_num) | |||
2761 | ___SCMOBJ tags;(long obj, void **x, long tags, int arg_num) | |||
2762 | int arg_num;)(long obj, void **x, long tags, int arg_num) | |||
2763 | { | |||
2764 | if (___SCMOBJ_to_POINTER (obj, x, tags, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2765 | *x == 0) | |||
2766 | return ___FIX(___STOC_NONNULLPOINTER_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(35<<7))+arg_num))<<2); | |||
2767 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2768 | } | |||
2769 | ||||
2770 | ||||
2771 | /* Convert a Scheme procedure to a C function. */ | |||
2772 | ||||
2773 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_FUNCTION)long ___SCMOBJ_to_FUNCTION | |||
2774 | ___P((___SCMOBJ obj,(long obj, void *converter, void **x, int arg_num) | |||
2775 | void *converter,(long obj, void *converter, void **x, int arg_num) | |||
2776 | void **x,(long obj, void *converter, void **x, int arg_num) | |||
2777 | int arg_num),(long obj, void *converter, void **x, int arg_num) | |||
2778 | (obj,(long obj, void *converter, void **x, int arg_num) | |||
2779 | converter,(long obj, void *converter, void **x, int arg_num) | |||
2780 | x,(long obj, void *converter, void **x, int arg_num) | |||
2781 | arg_num)(long obj, void *converter, void **x, int arg_num) | |||
2782 | ___SCMOBJ obj;(long obj, void *converter, void **x, int arg_num) | |||
2783 | void *converter;(long obj, void *converter, void **x, int arg_num) | |||
2784 | void **x;(long obj, void *converter, void **x, int arg_num) | |||
2785 | int arg_num;)(long obj, void *converter, void **x, int arg_num) | |||
2786 | { | |||
2787 | if (___FALSEP(obj)((obj)==((((long)(-1))<<2)+2))) /* #f counts as NULL */ | |||
2788 | *x = 0; | |||
2789 | else if (!___PROCEDUREP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (14))<<3)))) | |||
2790 | return ___FIX(___STOC_FUNCTION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(36<<7))+arg_num))<<2); | |||
2791 | else | |||
2792 | { | |||
2793 | ___label_struct *lbl = | |||
2794 | ___CAST(___label_struct*,___UNTAG_AS(obj,___tSUBTYPED))((___label_struct*)(((long*)((obj)-(1))))); | |||
2795 | ||||
2796 | /* | |||
2797 | * Check if the Scheme procedure was defined with a c-define | |||
2798 | * form (in this case a statically allocated C function can be | |||
2799 | * used). | |||
2800 | */ | |||
2801 | ||||
2802 | if (lbl[0].entry_or_descr != obj /* closure? */ | |||
2803 | || !___TESTHEADERTAG(lbl[-1].header,___sVECTOR)(((lbl[-1].header)&(((1<<5)-1)<<3))==((0)<< 3))/* not INTRO label? */ | |||
2804 | || (*x = ___CAST(void*,___CAST_FAKEHOST_TO_HOST(lbl[-1].host))((void*)(lbl[-1].host))) | |||
2805 | == 0) /* not "c-define"d? */ | |||
2806 | { | |||
2807 | /* | |||
2808 | * The Scheme procedure was not defined with a c-define | |||
2809 | * form. To convert the Scheme procedure to a C function we | |||
2810 | * have to dynamically allocate a "C closure" (this dynamic | |||
2811 | * code generation only works on some platforms). | |||
2812 | */ | |||
2813 | ||||
2814 | if ((*x = ___make_c_closure (obj, converter)) == 0) | |||
2815 | return ___FIX(___STOC_FUNCTION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(36<<7))+arg_num))<<2); | |||
2816 | } | |||
2817 | } | |||
2818 | ||||
2819 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2820 | } | |||
2821 | ||||
2822 | ||||
2823 | /* Convert a Scheme procedure to a nonnull C function. */ | |||
2824 | ||||
2825 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLFUNCTION)long ___SCMOBJ_to_NONNULLFUNCTION | |||
2826 | ___P((___SCMOBJ obj,(long obj, void *converter, void **x, int arg_num) | |||
2827 | void *converter,(long obj, void *converter, void **x, int arg_num) | |||
2828 | void **x,(long obj, void *converter, void **x, int arg_num) | |||
2829 | int arg_num),(long obj, void *converter, void **x, int arg_num) | |||
2830 | (obj,(long obj, void *converter, void **x, int arg_num) | |||
2831 | converter,(long obj, void *converter, void **x, int arg_num) | |||
2832 | x,(long obj, void *converter, void **x, int arg_num) | |||
2833 | arg_num)(long obj, void *converter, void **x, int arg_num) | |||
2834 | ___SCMOBJ obj;(long obj, void *converter, void **x, int arg_num) | |||
2835 | void *converter;(long obj, void *converter, void **x, int arg_num) | |||
2836 | void **x;(long obj, void *converter, void **x, int arg_num) | |||
2837 | int arg_num;)(long obj, void *converter, void **x, int arg_num) | |||
2838 | { | |||
2839 | if (___SCMOBJ_to_FUNCTION (obj, converter, x, arg_num) | |||
2840 | != ___FIX(___NO_ERR)(((long)(0))<<2) || | |||
2841 | *x == 0) | |||
2842 | return ___FIX(___STOC_NONNULLFUNCTION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(37<<7))+arg_num))<<2); | |||
2843 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2844 | } | |||
2845 | ||||
2846 | ||||
2847 | /* Convert a Scheme extended boolean to a C boolean. */ | |||
2848 | ||||
2849 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_BOOL)long ___SCMOBJ_to_BOOL | |||
2850 | ___P((___SCMOBJ obj,(long obj, int *x, int arg_num) | |||
2851 | ___BOOL *x,(long obj, int *x, int arg_num) | |||
2852 | int arg_num),(long obj, int *x, int arg_num) | |||
2853 | (obj,(long obj, int *x, int arg_num) | |||
2854 | x,(long obj, int *x, int arg_num) | |||
2855 | arg_num)(long obj, int *x, int arg_num) | |||
2856 | ___SCMOBJ obj;(long obj, int *x, int arg_num) | |||
2857 | ___BOOL *x;(long obj, int *x, int arg_num) | |||
2858 | int arg_num;)(long obj, int *x, int arg_num) | |||
2859 | { | |||
2860 | *x = !___FALSEP(obj)((obj)==((((long)(-1))<<2)+2)); /* #f is false, everything else counts as true */ | |||
2861 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2862 | } | |||
2863 | ||||
2864 | ||||
2865 | /* Convert a Scheme foreign object to a C struct pointer. */ | |||
2866 | ||||
2867 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_STRUCT)long ___SCMOBJ_to_STRUCT | |||
2868 | ___P((___SCMOBJ obj,(long obj, void **x, long tags, int arg_num) | |||
2869 | void **x,(long obj, void **x, long tags, int arg_num) | |||
2870 | ___SCMOBJ tags,(long obj, void **x, long tags, int arg_num) | |||
2871 | int arg_num),(long obj, void **x, long tags, int arg_num) | |||
2872 | (obj,(long obj, void **x, long tags, int arg_num) | |||
2873 | x,(long obj, void **x, long tags, int arg_num) | |||
2874 | tags,(long obj, void **x, long tags, int arg_num) | |||
2875 | arg_num)(long obj, void **x, long tags, int arg_num) | |||
2876 | ___SCMOBJ obj;(long obj, void **x, long tags, int arg_num) | |||
2877 | void **x;(long obj, void **x, long tags, int arg_num) | |||
2878 | ___SCMOBJ tags;(long obj, void **x, long tags, int arg_num) | |||
2879 | int arg_num;)(long obj, void **x, long tags, int arg_num) | |||
2880 | { | |||
2881 | if (!___TESTSUBTYPE(obj,___sFOREIGN)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (18))<<3))) || | |||
2882 | !can_convert_foreign_type (___FIELD(obj,___FOREIGN_TAGS)(*((((long*)((obj)-(1)))+1)+0)), tags)) | |||
2883 | return ___FIX(___STOC_STRUCT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(31<<7))+arg_num))<<2); | |||
2884 | ||||
2885 | *x = ___CAST(void*,___FIELD(obj,___FOREIGN_PTR))((void*)((*((((long*)((obj)-(1)))+1)+2)))); | |||
2886 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2887 | } | |||
2888 | ||||
2889 | ||||
2890 | /* Convert a Scheme foreign object to a C union pointer. */ | |||
2891 | ||||
2892 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UNION)long ___SCMOBJ_to_UNION | |||
2893 | ___P((___SCMOBJ obj,(long obj, void **x, long tags, int arg_num) | |||
2894 | void **x,(long obj, void **x, long tags, int arg_num) | |||
2895 | ___SCMOBJ tags,(long obj, void **x, long tags, int arg_num) | |||
2896 | int arg_num),(long obj, void **x, long tags, int arg_num) | |||
2897 | (obj,(long obj, void **x, long tags, int arg_num) | |||
2898 | x,(long obj, void **x, long tags, int arg_num) | |||
2899 | tags,(long obj, void **x, long tags, int arg_num) | |||
2900 | arg_num)(long obj, void **x, long tags, int arg_num) | |||
2901 | ___SCMOBJ obj;(long obj, void **x, long tags, int arg_num) | |||
2902 | void **x;(long obj, void **x, long tags, int arg_num) | |||
2903 | ___SCMOBJ tags;(long obj, void **x, long tags, int arg_num) | |||
2904 | int arg_num;)(long obj, void **x, long tags, int arg_num) | |||
2905 | { | |||
2906 | if (!___TESTSUBTYPE(obj,___sFOREIGN)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (18))<<3))) || | |||
2907 | !can_convert_foreign_type (___FIELD(obj,___FOREIGN_TAGS)(*((((long*)((obj)-(1)))+1)+0)), tags)) | |||
2908 | return ___FIX(___STOC_UNION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(32<<7))+arg_num))<<2); | |||
2909 | ||||
2910 | *x = ___CAST(void*,___FIELD(obj,___FOREIGN_PTR))((void*)((*((((long*)((obj)-(1)))+1)+2)))); | |||
2911 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2912 | } | |||
2913 | ||||
2914 | ||||
2915 | /* Convert a Scheme foreign object to a C type pointer. */ | |||
2916 | ||||
2917 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_TYPE)long ___SCMOBJ_to_TYPE | |||
2918 | ___P((___SCMOBJ obj,(long obj, void **x, long tags, int arg_num) | |||
2919 | void **x,(long obj, void **x, long tags, int arg_num) | |||
2920 | ___SCMOBJ tags,(long obj, void **x, long tags, int arg_num) | |||
2921 | int arg_num),(long obj, void **x, long tags, int arg_num) | |||
2922 | (obj,(long obj, void **x, long tags, int arg_num) | |||
2923 | x,(long obj, void **x, long tags, int arg_num) | |||
2924 | tags,(long obj, void **x, long tags, int arg_num) | |||
2925 | arg_num)(long obj, void **x, long tags, int arg_num) | |||
2926 | ___SCMOBJ obj;(long obj, void **x, long tags, int arg_num) | |||
2927 | void **x;(long obj, void **x, long tags, int arg_num) | |||
2928 | ___SCMOBJ tags;(long obj, void **x, long tags, int arg_num) | |||
2929 | int arg_num;)(long obj, void **x, long tags, int arg_num) | |||
2930 | { | |||
2931 | if (!___TESTSUBTYPE(obj,___sFOREIGN)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (18))<<3))) || | |||
2932 | !can_convert_foreign_type (___FIELD(obj,___FOREIGN_TAGS)(*((((long*)((obj)-(1)))+1)+0)), tags)) | |||
2933 | return ___FIX(___STOC_TYPE_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(33<<7))+arg_num))<<2); | |||
2934 | ||||
2935 | *x = ___CAST(void*,___FIELD(obj,___FOREIGN_PTR))((void*)((*((((long*)((obj)-(1)))+1)+2)))); | |||
2936 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
2937 | } | |||
2938 | ||||
2939 | ||||
2940 | /* Error code generation. */ | |||
2941 | ||||
2942 | ___SCMOBJlong err_code_from_char_encoding | |||
2943 | ___P((int char_encoding,(int char_encoding, int ctos, int type, int arg_num) | |||
2944 | ___BOOL ctos,(int char_encoding, int ctos, int type, int arg_num) | |||
2945 | int type,(int char_encoding, int ctos, int type, int arg_num) | |||
2946 | int arg_num),(int char_encoding, int ctos, int type, int arg_num) | |||
2947 | (char_encoding,(int char_encoding, int ctos, int type, int arg_num) | |||
2948 | ctos,(int char_encoding, int ctos, int type, int arg_num) | |||
2949 | type,(int char_encoding, int ctos, int type, int arg_num) | |||
2950 | arg_num)(int char_encoding, int ctos, int type, int arg_num) | |||
2951 | int char_encoding;(int char_encoding, int ctos, int type, int arg_num) | |||
2952 | ___BOOL ctos;(int char_encoding, int ctos, int type, int arg_num) | |||
2953 | int type;(int char_encoding, int ctos, int type, int arg_num) | |||
2954 | int arg_num;)(int char_encoding, int ctos, int type, int arg_num) | |||
2955 | { | |||
2956 | ___SCMOBJlong *t; | |||
2957 | ||||
2958 | switch (char_encoding) | |||
2959 | { | |||
2960 | case ___CHAR_ENCODING_ISO_8859_1(2<<0): | |||
2961 | { | |||
2962 | static ___SCMOBJlong tbl[6] = | |||
2963 | { ___FIX(___STOC_ISO_8859_1STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(42<<7))))<<2), | |||
2964 | ___FIX(___STOC_NONNULLISO_8859_1STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(43<<7))))<<2), | |||
2965 | ___FIX(___STOC_NONNULLISO_8859_1STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(44<<7))))<<2), | |||
2966 | ___FIX(___CTOS_ISO_8859_1STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(106<<7))))<<2), | |||
2967 | ___FIX(___CTOS_NONNULLISO_8859_1STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(107<<7))))<<2), | |||
2968 | ___FIX(___CTOS_NONNULLISO_8859_1STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(108<<7))))<<2) | |||
2969 | }; | |||
2970 | t = tbl; | |||
2971 | break; | |||
2972 | } | |||
2973 | case ___CHAR_ENCODING_UTF_8(3<<0): | |||
2974 | { | |||
2975 | static ___SCMOBJlong tbl[6] = | |||
2976 | { ___FIX(___STOC_UTF_8STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(45<<7))))<<2), | |||
2977 | ___FIX(___STOC_NONNULLUTF_8STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(46<<7))))<<2), | |||
2978 | ___FIX(___STOC_NONNULLUTF_8STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(47<<7))))<<2), | |||
2979 | ___FIX(___CTOS_UTF_8STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(109<<7))))<<2), | |||
2980 | ___FIX(___CTOS_NONNULLUTF_8STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(110<<7))))<<2), | |||
2981 | ___FIX(___CTOS_NONNULLUTF_8STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(111<<7))))<<2) | |||
2982 | }; | |||
2983 | t = tbl; | |||
2984 | break; | |||
2985 | } | |||
2986 | case ___CHAR_ENCODING_UTF_16(4<<0): | |||
2987 | { | |||
2988 | static ___SCMOBJlong tbl[6] = | |||
2989 | { ___FIX(___STOC_UTF_16STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(48<<7))))<<2), | |||
2990 | ___FIX(___STOC_NONNULLUTF_16STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(49<<7))))<<2), | |||
2991 | ___FIX(___STOC_NONNULLUTF_16STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(50<<7))))<<2), | |||
2992 | ___FIX(___CTOS_UTF_16STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(112<<7))))<<2), | |||
2993 | ___FIX(___CTOS_NONNULLUTF_16STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(113<<7))))<<2), | |||
2994 | ___FIX(___CTOS_NONNULLUTF_16STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(114<<7))))<<2) | |||
2995 | }; | |||
2996 | t = tbl; | |||
2997 | break; | |||
2998 | } | |||
2999 | case ___CHAR_ENCODING_UCS_2(13<<0): | |||
3000 | { | |||
3001 | static ___SCMOBJlong tbl[6] = | |||
3002 | { ___FIX(___STOC_UCS_2STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(51<<7))))<<2), | |||
3003 | ___FIX(___STOC_NONNULLUCS_2STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(52<<7))))<<2), | |||
3004 | ___FIX(___STOC_NONNULLUCS_2STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(53<<7))))<<2), | |||
3005 | ___FIX(___CTOS_UCS_2STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(115<<7))))<<2), | |||
3006 | ___FIX(___CTOS_NONNULLUCS_2STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(116<<7))))<<2), | |||
3007 | ___FIX(___CTOS_NONNULLUCS_2STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(117<<7))))<<2) | |||
3008 | }; | |||
3009 | t = tbl; | |||
3010 | break; | |||
3011 | } | |||
3012 | case ___CHAR_ENCODING_UCS_4(16<<0): | |||
3013 | { | |||
3014 | static ___SCMOBJlong tbl[6] = | |||
3015 | { ___FIX(___STOC_UCS_4STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(54<<7))))<<2), | |||
3016 | ___FIX(___STOC_NONNULLUCS_4STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(55<<7))))<<2), | |||
3017 | ___FIX(___STOC_NONNULLUCS_4STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(56<<7))))<<2), | |||
3018 | ___FIX(___CTOS_UCS_4STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(118<<7))))<<2), | |||
3019 | ___FIX(___CTOS_NONNULLUCS_4STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(119<<7))))<<2), | |||
3020 | ___FIX(___CTOS_NONNULLUCS_4STRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(120<<7))))<<2) | |||
3021 | }; | |||
3022 | t = tbl; | |||
3023 | break; | |||
3024 | } | |||
3025 | case ___CHAR_ENCODING_WCHAR(19<<0): | |||
3026 | { | |||
3027 | static ___SCMOBJlong tbl[6] = | |||
3028 | { ___FIX(___STOC_WCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(57<<7))))<<2), | |||
3029 | ___FIX(___STOC_NONNULLWCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(58<<7))))<<2), | |||
3030 | ___FIX(___STOC_NONNULLWCHARSTRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(59<<7))))<<2), | |||
3031 | ___FIX(___CTOS_WCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(121<<7))))<<2), | |||
3032 | ___FIX(___CTOS_NONNULLWCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(122<<7))))<<2), | |||
3033 | ___FIX(___CTOS_NONNULLWCHARSTRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(123<<7))))<<2) | |||
3034 | }; | |||
3035 | t = tbl; | |||
3036 | break; | |||
3037 | } | |||
3038 | case ___CHAR_ENCODING_NATIVE(20<<0): | |||
3039 | default: | |||
3040 | { | |||
3041 | static ___SCMOBJlong tbl[6] = | |||
3042 | { ___FIX(___STOC_CHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(39<<7))))<<2), | |||
3043 | ___FIX(___STOC_NONNULLCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7))))<<2), | |||
3044 | ___FIX(___STOC_NONNULLCHARSTRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(41<<7))))<<2), | |||
3045 | ___FIX(___CTOS_CHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(103<<7))))<<2), | |||
3046 | ___FIX(___CTOS_NONNULLCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(104<<7))))<<2), | |||
3047 | ___FIX(___CTOS_NONNULLCHARSTRINGLIST_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(105<<7))))<<2) | |||
3048 | }; | |||
3049 | t = tbl; | |||
3050 | break; | |||
3051 | } | |||
3052 | } | |||
3053 | ||||
3054 | return ___FIXADD(t[ctos*3 + type], ___FIX(arg_num))((long)((t[ctos*3 + type])+((((long)(arg_num))<<2)))); | |||
3055 | } | |||
3056 | ||||
3057 | ||||
3058 | /* Convert a Scheme string to a nonnull C string. */ | |||
3059 | ||||
3060 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLSTRING)long ___SCMOBJ_to_NONNULLSTRING | |||
3061 | ___P((___SCMOBJ obj,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3062 | void **x,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3063 | int arg_num,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3064 | int char_encoding,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3065 | int fudge),(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3066 | (obj,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3067 | x,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3068 | arg_num,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3069 | char_encoding,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3070 | fudge)(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3071 | ___SCMOBJ obj;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3072 | void **x;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3073 | int arg_num;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3074 | int char_encoding;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3075 | int fudge;)(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3076 | { | |||
3077 | if (!___STRINGP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (19))<<3)))) | |||
3078 | return err_code_from_char_encoding (char_encoding, 0, 1, arg_num); | |||
3079 | ||||
3080 | switch (char_encoding) | |||
3081 | { | |||
3082 | case ___CHAR_ENCODING_ISO_8859_1(2<<0): | |||
3083 | { | |||
3084 | ___SIZE_Tunsigned long i, n; | |||
3085 | ___ISO_8859_1STRINGunsigned char* r; | |||
3086 | ||||
3087 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3088 | r = ___CAST(___ISO_8859_1STRING,((unsigned char*)(___alloc_rc (n + 1 + fudge))) | |||
3089 | ___alloc_rc (n + 1 + fudge))((unsigned char*)(___alloc_rc (n + 1 + fudge))); | |||
3090 | ||||
3091 | if (r == 0) | |||
3092 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3093 | ||||
3094 | for (i=0; i<n; i++) | |||
3095 | { | |||
3096 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3097 | if (c == 0 || c > 0xff) /* ISO-8859-1 is 8 bits */ | |||
3098 | { | |||
3099 | ___release_rc (r); | |||
3100 | return ___FIX(___STOC_ISO_8859_1STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(42<<7))+arg_num))<<2); | |||
3101 | } | |||
3102 | r[i] = c; | |||
3103 | } | |||
3104 | ||||
3105 | r[n] = 0; | |||
3106 | ||||
3107 | *x = ___CAST(void*,r)((void*)(r)); | |||
3108 | ||||
3109 | break; | |||
3110 | } | |||
3111 | ||||
3112 | case ___CHAR_ENCODING_UTF_8(3<<0): | |||
3113 | { | |||
3114 | ___SIZE_Tunsigned long i, bytes, n; | |||
3115 | ___UTF_8STRINGchar* r; | |||
3116 | ___UTF_8STRINGchar* p; | |||
3117 | ||||
3118 | bytes = 0; | |||
3119 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3120 | ||||
3121 | for (i=0; i<n; i++) | |||
3122 | { | |||
3123 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3124 | int c_bytes = ___UTF_8_bytes (c); | |||
3125 | if (c == 0 || c_bytes == 0) | |||
3126 | return ___FIX(___STOC_UTF_8STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(45<<7))+arg_num))<<2); | |||
3127 | bytes += c_bytes; | |||
3128 | } | |||
3129 | ||||
3130 | r = ___CAST(___UTF_8STRING,((char*)(___alloc_rc (bytes + 1 + fudge))) | |||
3131 | ___alloc_rc (bytes + 1 + fudge))((char*)(___alloc_rc (bytes + 1 + fudge))); | |||
3132 | ||||
3133 | if (r == 0) | |||
3134 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3135 | ||||
3136 | p = r; | |||
3137 | ||||
3138 | for (i=0; i<n; i++) | |||
3139 | ___UTF_8_put (&p, ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2)); | |||
3140 | ||||
3141 | *p = 0; | |||
3142 | ||||
3143 | *x = ___CAST(void*,r)((void*)(r)); | |||
3144 | ||||
3145 | break; | |||
3146 | } | |||
3147 | ||||
3148 | case ___CHAR_ENCODING_UTF_16(4<<0): | |||
3149 | { | |||
3150 | ___SIZE_Tunsigned long i, bytes, n; | |||
3151 | ___UTF_16STRINGunsigned short* r; | |||
3152 | ___UTF_16STRINGunsigned short* p; | |||
3153 | ||||
3154 | bytes = 0; | |||
3155 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3156 | ||||
3157 | for (i=0; i<n; i++) | |||
3158 | { | |||
3159 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3160 | if (c > 0xffff) | |||
3161 | bytes += 4; | |||
3162 | else if ((c > 0 && c <= 0xd7ff) || c > 0xdbff) | |||
3163 | bytes += 2; | |||
3164 | else | |||
3165 | return ___FIX(___STOC_UTF_16STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(48<<7))+arg_num))<<2); | |||
3166 | } | |||
3167 | ||||
3168 | r = ___CAST(___UTF_16STRING,((unsigned short*)(___alloc_rc (bytes + 2 + fudge))) | |||
3169 | ___alloc_rc (bytes + 2 + fudge))((unsigned short*)(___alloc_rc (bytes + 2 + fudge))); | |||
3170 | ||||
3171 | if (r == 0) | |||
3172 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3173 | ||||
3174 | p = r; | |||
3175 | ||||
3176 | for (i=0; i<n; i++) | |||
3177 | { | |||
3178 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3179 | if (c > 0xffff) | |||
3180 | { | |||
3181 | c -= 0x10000; | |||
3182 | *p++ = 0xd800 + ((c>>10)&0x3ff); | |||
3183 | *p++ = 0xdc00 + (c&0x3ff); | |||
3184 | } | |||
3185 | else | |||
3186 | *p++ = c; | |||
3187 | } | |||
3188 | ||||
3189 | *p = 0; | |||
3190 | ||||
3191 | *x = ___CAST(void*,r)((void*)(r)); | |||
3192 | ||||
3193 | break; | |||
3194 | } | |||
3195 | ||||
3196 | case ___CHAR_ENCODING_UCS_2(13<<0): | |||
3197 | { | |||
3198 | ___SIZE_Tunsigned long i, n; | |||
3199 | ___UCS_2STRINGunsigned short* r; | |||
3200 | ||||
3201 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3202 | r = ___CAST(___UCS_2STRING,((unsigned short*)(___alloc_rc ((n + 1 + fudge) * sizeof (unsigned short)))) | |||
3203 | ___alloc_rc ((n + 1 + fudge) * sizeof (___UCS_2)))((unsigned short*)(___alloc_rc ((n + 1 + fudge) * sizeof (unsigned short)))); | |||
3204 | ||||
3205 | if (r == 0) | |||
3206 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3207 | ||||
3208 | for (i=0; i<n; i++) | |||
3209 | { | |||
3210 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3211 | if (c == 0 || c > 0xffff) /* UCS-2 is 16 bits */ | |||
3212 | { | |||
3213 | ___release_rc (r); | |||
3214 | return ___FIX(___STOC_UCS_2STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(51<<7))+arg_num))<<2); | |||
3215 | } | |||
3216 | r[i] = c; | |||
3217 | } | |||
3218 | ||||
3219 | r[n] = 0; | |||
3220 | ||||
3221 | *x = ___CAST(void*,r)((void*)(r)); | |||
3222 | ||||
3223 | break; | |||
3224 | } | |||
3225 | ||||
3226 | case ___CHAR_ENCODING_UCS_4(16<<0): | |||
3227 | { | |||
3228 | ___SIZE_Tunsigned long i, n; | |||
3229 | ___UCS_4STRINGunsigned int* r; | |||
3230 | ||||
3231 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3232 | r = ___CAST(___UCS_4STRING,((unsigned int*)(___alloc_rc ((n + 1 + fudge) * sizeof (unsigned int)))) | |||
3233 | ___alloc_rc ((n + 1 + fudge) * sizeof (___UCS_4)))((unsigned int*)(___alloc_rc ((n + 1 + fudge) * sizeof (unsigned int)))); | |||
3234 | ||||
3235 | if (r == 0) | |||
3236 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3237 | ||||
3238 | for (i=0; i<n; i++) | |||
3239 | { | |||
3240 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3241 | if (c == 0 || c > 0x7fffffff) /* UCS-4 is 31 bits */ | |||
3242 | { | |||
3243 | ___release_rc (r); | |||
3244 | return ___FIX(___STOC_UCS_4STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(54<<7))+arg_num))<<2); | |||
3245 | } | |||
3246 | r[i] = c; | |||
3247 | } | |||
3248 | ||||
3249 | r[n] = 0; | |||
3250 | ||||
3251 | *x = ___CAST(void*,r)((void*)(r)); | |||
3252 | ||||
3253 | break; | |||
3254 | } | |||
3255 | ||||
3256 | case ___CHAR_ENCODING_WCHAR(19<<0): | |||
3257 | { | |||
3258 | ___SIZE_Tunsigned long i, n; | |||
3259 | ___WCHARSTRINGwchar_t* r; | |||
3260 | ||||
3261 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3262 | r = ___CAST(___WCHARSTRING,((wchar_t*)(___alloc_rc ((n + 1 + fudge) * sizeof (wchar_t))) ) | |||
3263 | ___alloc_rc ((n + 1 + fudge) * sizeof (___WCHAR)))((wchar_t*)(___alloc_rc ((n + 1 + fudge) * sizeof (wchar_t))) ); | |||
3264 | ||||
3265 | if (r == 0) | |||
3266 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3267 | ||||
3268 | for (i=0; i<n; i++) | |||
3269 | { | |||
3270 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 | |||
3271 | ___SM32int c = ___CAST(___SM32,___INT(___STRINGREF(obj,___FIX(i))))((int)(((((((long)(((unsigned int)(*(((unsigned int*)((((long *)((obj)-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2))); | |||
3272 | #else | |||
3273 | ___UM32unsigned int c = ___CAST(___UM32,___INT(___STRINGREF(obj,___FIX(i))))((unsigned int)(((((((long)(((unsigned int)(*(((unsigned int* )((((long*)((obj)-(1)))+1)))+(((((long)(i))<<2))>> 2))))))<<2)+2))>>2))); | |||
3274 | #endif | |||
3275 | ||||
3276 | if (c == 0 | |||
3277 | #if 0 < ___WCHAR_MIN(-2147483647 - 1) | |||
3278 | || c < ___WCHAR_MIN(-2147483647 - 1) | |||
3279 | #endif | |||
3280 | #if ___MAX_CHR0x10ffff > ___WCHAR_MAX2147483647 | |||
3281 | || c > ___WCHAR_MAX2147483647 | |||
3282 | #endif | |||
3283 | ) | |||
3284 | { | |||
3285 | ___release_rc (r); | |||
3286 | return ___FIX(___STOC_WCHARSTRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(57<<7))+arg_num))<<2); | |||
3287 | } | |||
3288 | ||||
3289 | r[i] = ___CAST(___WCHAR,c)((wchar_t)(c)); | |||
3290 | } | |||
3291 | ||||
3292 | r[n] = 0; | |||
3293 | ||||
3294 | *x = ___CAST(void*,r)((void*)(r)); | |||
3295 | ||||
3296 | break; | |||
3297 | } | |||
3298 | ||||
3299 | case ___CHAR_ENCODING_NATIVE(20<<0): | |||
3300 | { | |||
3301 | ___SIZE_Tunsigned long i, n; | |||
3302 | char *r; | |||
3303 | ||||
3304 | n = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); | |||
3305 | r = ___CAST(char*,((char*)(___alloc_rc (n + 1 + fudge))) | |||
3306 | ___alloc_rc (n + 1 + fudge))((char*)(___alloc_rc (n + 1 + fudge))); | |||
3307 | ||||
3308 | if (r == 0) | |||
3309 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3310 | ||||
3311 | for (i=0; i<n; i++) | |||
3312 | { | |||
3313 | ___UCS_4unsigned int c = UCS_4_to_uchar (___INT(___STRINGREF(obj,___FIX(i))))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); | |||
3314 | if (c == 0 || c > (1<<___CHAR_WIDTH8)-1) | |||
3315 | { | |||
3316 | ___release_rc (r); | |||
3317 | return ___FIX(___STOC_CHARSTRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(39<<7))+arg_num))<<2); | |||
3318 | } | |||
3319 | r[i] = c; | |||
3320 | } | |||
3321 | ||||
3322 | r[n] = 0; | |||
3323 | ||||
3324 | *x = ___CAST(void*,r)((void*)(r)); | |||
3325 | ||||
3326 | break; | |||
3327 | } | |||
3328 | ||||
3329 | default: | |||
3330 | return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2); | |||
3331 | } | |||
3332 | ||||
3333 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
3334 | } | |||
3335 | ||||
3336 | ||||
3337 | /* Convert a Scheme string to a C string. */ | |||
3338 | ||||
3339 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_STRING)long ___SCMOBJ_to_STRING | |||
3340 | ___P((___SCMOBJ obj,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3341 | void **x,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3342 | int arg_num,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3343 | int char_encoding,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3344 | int fudge),(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3345 | (obj,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3346 | x,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3347 | arg_num,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3348 | char_encoding,(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3349 | fudge)(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3350 | ___SCMOBJ obj;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3351 | void **x;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3352 | int arg_num;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3353 | int char_encoding;(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3354 | int fudge;)(long obj, void **x, int arg_num, int char_encoding, int fudge ) | |||
3355 | { | |||
3356 | ___SCMOBJlong e; | |||
3357 | ||||
3358 | if (___FALSEP(obj)((obj)==((((long)(-1))<<2)+2))) /* #f counts as NULL */ | |||
3359 | { | |||
3360 | *x = 0; | |||
3361 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
3362 | } | |||
3363 | ||||
3364 | if ((e = ___SCMOBJ_to_NONNULLSTRING (obj, x, arg_num, char_encoding, fudge)) | |||
3365 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3366 | if (e == err_code_from_char_encoding (char_encoding, 0, 1, arg_num)) | |||
3367 | e = err_code_from_char_encoding (char_encoding, 0, 0, arg_num); | |||
3368 | ||||
3369 | return e; | |||
3370 | } | |||
3371 | ||||
3372 | ||||
3373 | /* Convert a Scheme list of strings to a nonnull C string list. */ | |||
3374 | ||||
3375 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLSTRINGLIST)long ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3376 | ___P((___SCMOBJ obj,(long obj, void **x, int arg_num, int char_encoding) | |||
3377 | void **x,(long obj, void **x, int arg_num, int char_encoding) | |||
3378 | int arg_num,(long obj, void **x, int arg_num, int char_encoding) | |||
3379 | int char_encoding),(long obj, void **x, int arg_num, int char_encoding) | |||
3380 | (obj,(long obj, void **x, int arg_num, int char_encoding) | |||
3381 | x,(long obj, void **x, int arg_num, int char_encoding) | |||
3382 | arg_num,(long obj, void **x, int arg_num, int char_encoding) | |||
3383 | char_encoding)(long obj, void **x, int arg_num, int char_encoding) | |||
3384 | ___SCMOBJ obj;(long obj, void **x, int arg_num, int char_encoding) | |||
3385 | void **x;(long obj, void **x, int arg_num, int char_encoding) | |||
3386 | int arg_num;(long obj, void **x, int arg_num, int char_encoding) | |||
3387 | int char_encoding;)(long obj, void **x, int arg_num, int char_encoding) | |||
3388 | { | |||
3389 | ___SCMOBJlong e; | |||
3390 | void **string_list; | |||
3391 | ___SCMOBJlong list1; | |||
3392 | ___SCMOBJlong list2; | |||
3393 | int len; | |||
3394 | int i; | |||
3395 | ||||
3396 | list1 = obj; | |||
3397 | list2 = obj; | |||
3398 | len = 0; | |||
3399 | ||||
3400 | while (___PAIRP(list1)(((list1)&((1<<2)-1))==(3))) /* compute length, checking for circular lists */ | |||
3401 | { | |||
3402 | list1 = ___CDR(list1)(*((((long*)((list1)-(3)))+1)+0)); | |||
3403 | len++; | |||
3404 | if (___EQP(list1,list2)((list1)==(list2)) || !___PAIRP(list1)(((list1)&((1<<2)-1))==(3))) | |||
3405 | break; | |||
3406 | list1 = ___CDR(list1)(*((((long*)((list1)-(3)))+1)+0)); | |||
3407 | list2 = ___CDR(list2)(*((((long*)((list2)-(3)))+1)+0)); | |||
3408 | len++; | |||
3409 | } | |||
3410 | ||||
3411 | if (!___NULLP(list1)((list1)==((((long)(-3))<<2)+2))) | |||
3412 | return err_code_from_char_encoding (char_encoding, 0, 2, arg_num); | |||
3413 | ||||
3414 | string_list = ___CAST(void**,((void**)(___alloc_rc ((len + 1) * sizeof (void*)))) | |||
3415 | ___alloc_rc ((len + 1) * sizeof (void*)))((void**)(___alloc_rc ((len + 1) * sizeof (void*)))); | |||
3416 | ||||
3417 | if (string_list == 0) | |||
3418 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); | |||
3419 | ||||
3420 | e = ___FIX(___NO_ERR)(((long)(0))<<2); | |||
3421 | list1 = obj; | |||
3422 | i = 0; | |||
3423 | ||||
3424 | while (i < len) | |||
3425 | { | |||
3426 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3427 | (___CAR(list1)(*((((long*)((list1)-(3)))+1)+1)), | |||
3428 | &string_list[i], | |||
3429 | arg_num, | |||
3430 | char_encoding, | |||
3431 | 0)) | |||
3432 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3433 | { | |||
3434 | if (e == err_code_from_char_encoding (char_encoding, 0, 1, arg_num)) | |||
3435 | e = err_code_from_char_encoding (char_encoding, 0, 2, arg_num); | |||
3436 | break; | |||
3437 | } | |||
3438 | ||||
3439 | i++; | |||
3440 | list1 = ___CDR(list1)(*((((long*)((list1)-(3)))+1)+0)); | |||
3441 | } | |||
3442 | ||||
3443 | string_list[i] = 0; | |||
3444 | ||||
3445 | if (e != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3446 | { | |||
3447 | ___release_string_list (string_list); | |||
3448 | return e; | |||
3449 | } | |||
3450 | ||||
3451 | *x = string_list; | |||
3452 | ||||
3453 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
3454 | } | |||
3455 | ||||
3456 | ||||
3457 | /* Convert a Scheme string to a C 'char *'. */ | |||
3458 | ||||
3459 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_CHARSTRING)long ___SCMOBJ_to_CHARSTRING | |||
3460 | ___P((___SCMOBJ obj,(long obj, char **x, int arg_num) | |||
3461 | char **x,(long obj, char **x, int arg_num) | |||
3462 | int arg_num),(long obj, char **x, int arg_num) | |||
3463 | (obj,(long obj, char **x, int arg_num) | |||
3464 | x,(long obj, char **x, int arg_num) | |||
3465 | arg_num)(long obj, char **x, int arg_num) | |||
3466 | ___SCMOBJ obj;(long obj, char **x, int arg_num) | |||
3467 | char **x;(long obj, char **x, int arg_num) | |||
3468 | int arg_num;)(long obj, char **x, int arg_num) | |||
3469 | { | |||
3470 | void *result; | |||
3471 | ___SCMOBJlong e; | |||
3472 | ||||
3473 | if ((e = ___SCMOBJ_to_STRING | |||
3474 | (obj, | |||
3475 | &result, | |||
3476 | arg_num, | |||
3477 | ___CHAR_ENCODING_NATIVE(20<<0), | |||
3478 | 0)) | |||
3479 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3480 | *x = ___CAST(char*,result)((char*)(result)); | |||
3481 | ||||
3482 | return e; | |||
3483 | } | |||
3484 | ||||
3485 | ||||
3486 | /* Convert a Scheme string to a nonnull C 'char *'. */ | |||
3487 | ||||
3488 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLCHARSTRING)long ___SCMOBJ_to_NONNULLCHARSTRING | |||
3489 | ___P((___SCMOBJ obj,(long obj, char **x, int arg_num) | |||
3490 | char **x,(long obj, char **x, int arg_num) | |||
3491 | int arg_num),(long obj, char **x, int arg_num) | |||
3492 | (obj,(long obj, char **x, int arg_num) | |||
3493 | x,(long obj, char **x, int arg_num) | |||
3494 | arg_num)(long obj, char **x, int arg_num) | |||
3495 | ___SCMOBJ obj;(long obj, char **x, int arg_num) | |||
3496 | char **x;(long obj, char **x, int arg_num) | |||
3497 | int arg_num;)(long obj, char **x, int arg_num) | |||
3498 | { | |||
3499 | void *result; | |||
3500 | ___SCMOBJlong e; | |||
3501 | ||||
3502 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3503 | (obj, | |||
3504 | &result, | |||
3505 | arg_num, | |||
3506 | ___CHAR_ENCODING_NATIVE(20<<0), | |||
3507 | 0)) | |||
3508 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3509 | *x = ___CAST(char*,result)((char*)(result)); | |||
3510 | ||||
3511 | return e; | |||
3512 | } | |||
3513 | ||||
3514 | ||||
3515 | /* Convert a Scheme list of strings to a nonnull C 'char *' list. */ | |||
3516 | ||||
3517 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLCHARSTRINGLIST)long ___SCMOBJ_to_NONNULLCHARSTRINGLIST | |||
3518 | ___P((___SCMOBJ obj,(long obj, char ***x, int arg_num) | |||
3519 | char ***x,(long obj, char ***x, int arg_num) | |||
3520 | int arg_num),(long obj, char ***x, int arg_num) | |||
3521 | (obj,(long obj, char ***x, int arg_num) | |||
3522 | x,(long obj, char ***x, int arg_num) | |||
3523 | arg_num)(long obj, char ***x, int arg_num) | |||
3524 | ___SCMOBJ obj;(long obj, char ***x, int arg_num) | |||
3525 | char ***x;(long obj, char ***x, int arg_num) | |||
3526 | int arg_num;)(long obj, char ***x, int arg_num) | |||
3527 | { | |||
3528 | void *result; | |||
3529 | ___SCMOBJlong e; | |||
3530 | ||||
3531 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3532 | (obj, | |||
3533 | &result, | |||
3534 | arg_num, | |||
3535 | ___CHAR_ENCODING_NATIVE(20<<0))) | |||
3536 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3537 | *x = ___CAST(char**,result)((char**)(result)); | |||
3538 | ||||
3539 | return e; | |||
3540 | } | |||
3541 | ||||
3542 | ||||
3543 | /* Convert a Scheme string to a C ISO-8859-1 encoded character string. */ | |||
3544 | ||||
3545 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_ISO_8859_1STRING)long ___SCMOBJ_to_ISO_8859_1STRING | |||
3546 | ___P((___SCMOBJ obj,(long obj, unsigned char* *x, int arg_num) | |||
3547 | ___ISO_8859_1STRING *x,(long obj, unsigned char* *x, int arg_num) | |||
3548 | int arg_num),(long obj, unsigned char* *x, int arg_num) | |||
3549 | (obj,(long obj, unsigned char* *x, int arg_num) | |||
3550 | x,(long obj, unsigned char* *x, int arg_num) | |||
3551 | arg_num)(long obj, unsigned char* *x, int arg_num) | |||
3552 | ___SCMOBJ obj;(long obj, unsigned char* *x, int arg_num) | |||
3553 | ___ISO_8859_1STRING *x;(long obj, unsigned char* *x, int arg_num) | |||
3554 | int arg_num;)(long obj, unsigned char* *x, int arg_num) | |||
3555 | { | |||
3556 | void *result; | |||
3557 | ___SCMOBJlong e; | |||
3558 | ||||
3559 | if ((e = ___SCMOBJ_to_STRING | |||
3560 | (obj, | |||
3561 | &result, | |||
3562 | arg_num, | |||
3563 | ___CHAR_ENCODING_ISO_8859_1(2<<0), | |||
3564 | 0)) | |||
3565 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3566 | *x = ___CAST(___ISO_8859_1STRING,result)((unsigned char*)(result)); | |||
3567 | ||||
3568 | return e; | |||
3569 | } | |||
3570 | ||||
3571 | ||||
3572 | /* Convert a Scheme string to a nonnull C ISO-8859-1 encoded character string. */ | |||
3573 | ||||
3574 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLISO_8859_1STRING)long ___SCMOBJ_to_NONNULLISO_8859_1STRING | |||
3575 | ___P((___SCMOBJ obj,(long obj, unsigned char* *x, int arg_num) | |||
3576 | ___ISO_8859_1STRING *x,(long obj, unsigned char* *x, int arg_num) | |||
3577 | int arg_num),(long obj, unsigned char* *x, int arg_num) | |||
3578 | (obj,(long obj, unsigned char* *x, int arg_num) | |||
3579 | x,(long obj, unsigned char* *x, int arg_num) | |||
3580 | arg_num)(long obj, unsigned char* *x, int arg_num) | |||
3581 | ___SCMOBJ obj;(long obj, unsigned char* *x, int arg_num) | |||
3582 | ___ISO_8859_1STRING *x;(long obj, unsigned char* *x, int arg_num) | |||
3583 | int arg_num;)(long obj, unsigned char* *x, int arg_num) | |||
3584 | { | |||
3585 | void *result; | |||
3586 | ___SCMOBJlong e; | |||
3587 | ||||
3588 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3589 | (obj, | |||
3590 | &result, | |||
3591 | arg_num, | |||
3592 | ___CHAR_ENCODING_ISO_8859_1(2<<0), | |||
3593 | 0)) | |||
3594 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3595 | *x = ___CAST(___ISO_8859_1STRING,result)((unsigned char*)(result)); | |||
3596 | ||||
3597 | return e; | |||
3598 | } | |||
3599 | ||||
3600 | ||||
3601 | /* Convert a Scheme list of strings to a nonnull C ISO-8859-1 encoded character string list. */ | |||
3602 | ||||
3603 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLISO_8859_1STRINGLIST)long ___SCMOBJ_to_NONNULLISO_8859_1STRINGLIST | |||
3604 | ___P((___SCMOBJ obj,(long obj, unsigned char* **x, int arg_num) | |||
3605 | ___ISO_8859_1STRING **x,(long obj, unsigned char* **x, int arg_num) | |||
3606 | int arg_num),(long obj, unsigned char* **x, int arg_num) | |||
3607 | (obj,(long obj, unsigned char* **x, int arg_num) | |||
3608 | x,(long obj, unsigned char* **x, int arg_num) | |||
3609 | arg_num)(long obj, unsigned char* **x, int arg_num) | |||
3610 | ___SCMOBJ obj;(long obj, unsigned char* **x, int arg_num) | |||
3611 | ___ISO_8859_1STRING **x;(long obj, unsigned char* **x, int arg_num) | |||
3612 | int arg_num;)(long obj, unsigned char* **x, int arg_num) | |||
3613 | { | |||
3614 | void *result; | |||
3615 | ___SCMOBJlong e; | |||
3616 | ||||
3617 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3618 | (obj, | |||
3619 | &result, | |||
3620 | arg_num, | |||
3621 | ___CHAR_ENCODING_ISO_8859_1(2<<0))) | |||
3622 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3623 | *x = ___CAST(___ISO_8859_1STRING*,result)((unsigned char**)(result)); | |||
3624 | ||||
3625 | return e; | |||
3626 | } | |||
3627 | ||||
3628 | ||||
3629 | /* Convert a Scheme string to a C UTF-8 encoded character string. */ | |||
3630 | ||||
3631 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UTF_8STRING)long ___SCMOBJ_to_UTF_8STRING | |||
3632 | ___P((___SCMOBJ obj,(long obj, char* *x, int arg_num) | |||
3633 | ___UTF_8STRING *x,(long obj, char* *x, int arg_num) | |||
3634 | int arg_num),(long obj, char* *x, int arg_num) | |||
3635 | (obj,(long obj, char* *x, int arg_num) | |||
3636 | x,(long obj, char* *x, int arg_num) | |||
3637 | arg_num)(long obj, char* *x, int arg_num) | |||
3638 | ___SCMOBJ obj;(long obj, char* *x, int arg_num) | |||
3639 | ___UTF_8STRING *x;(long obj, char* *x, int arg_num) | |||
3640 | int arg_num;)(long obj, char* *x, int arg_num) | |||
3641 | { | |||
3642 | void *result; | |||
3643 | ___SCMOBJlong e; | |||
3644 | ||||
3645 | if ((e = ___SCMOBJ_to_STRING | |||
3646 | (obj, | |||
3647 | &result, | |||
3648 | arg_num, | |||
3649 | ___CHAR_ENCODING_UTF_8(3<<0), | |||
3650 | 0)) | |||
3651 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3652 | *x = ___CAST(___UTF_8STRING,result)((char*)(result)); | |||
3653 | ||||
3654 | return e; | |||
3655 | } | |||
3656 | ||||
3657 | ||||
3658 | /* Convert a Scheme string to a nonnull C UTF-8 encoded character string. */ | |||
3659 | ||||
3660 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUTF_8STRING)long ___SCMOBJ_to_NONNULLUTF_8STRING | |||
3661 | ___P((___SCMOBJ obj,(long obj, char* *x, int arg_num) | |||
3662 | ___UTF_8STRING *x,(long obj, char* *x, int arg_num) | |||
3663 | int arg_num),(long obj, char* *x, int arg_num) | |||
3664 | (obj,(long obj, char* *x, int arg_num) | |||
3665 | x,(long obj, char* *x, int arg_num) | |||
3666 | arg_num)(long obj, char* *x, int arg_num) | |||
3667 | ___SCMOBJ obj;(long obj, char* *x, int arg_num) | |||
3668 | ___UTF_8STRING *x;(long obj, char* *x, int arg_num) | |||
3669 | int arg_num;)(long obj, char* *x, int arg_num) | |||
3670 | { | |||
3671 | void *result; | |||
3672 | ___SCMOBJlong e; | |||
3673 | ||||
3674 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3675 | (obj, | |||
3676 | &result, | |||
3677 | arg_num, | |||
3678 | ___CHAR_ENCODING_UTF_8(3<<0), | |||
3679 | 0)) | |||
3680 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3681 | *x = ___CAST(___UTF_8STRING,result)((char*)(result)); | |||
3682 | ||||
3683 | return e; | |||
3684 | } | |||
3685 | ||||
3686 | ||||
3687 | /* Convert a Scheme list of strings to a nonnull C UTF-8 encoded character string list. */ | |||
3688 | ||||
3689 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUTF_8STRINGLIST)long ___SCMOBJ_to_NONNULLUTF_8STRINGLIST | |||
3690 | ___P((___SCMOBJ obj,(long obj, char* **x, int arg_num) | |||
3691 | ___UTF_8STRING **x,(long obj, char* **x, int arg_num) | |||
3692 | int arg_num),(long obj, char* **x, int arg_num) | |||
3693 | (obj,(long obj, char* **x, int arg_num) | |||
3694 | x,(long obj, char* **x, int arg_num) | |||
3695 | arg_num)(long obj, char* **x, int arg_num) | |||
3696 | ___SCMOBJ obj;(long obj, char* **x, int arg_num) | |||
3697 | ___UTF_8STRING **x;(long obj, char* **x, int arg_num) | |||
3698 | int arg_num;)(long obj, char* **x, int arg_num) | |||
3699 | { | |||
3700 | void *result; | |||
3701 | ___SCMOBJlong e; | |||
3702 | ||||
3703 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3704 | (obj, | |||
3705 | &result, | |||
3706 | arg_num, | |||
3707 | ___CHAR_ENCODING_UTF_8(3<<0))) | |||
3708 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3709 | *x = ___CAST(___UTF_8STRING*,result)((char**)(result)); | |||
3710 | ||||
3711 | return e; | |||
3712 | } | |||
3713 | ||||
3714 | ||||
3715 | /* Convert a Scheme string to a C UTF-16 encoded character string. */ | |||
3716 | ||||
3717 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UTF_16STRING)long ___SCMOBJ_to_UTF_16STRING | |||
3718 | ___P((___SCMOBJ obj,(long obj, unsigned short* *x, int arg_num) | |||
3719 | ___UTF_16STRING *x,(long obj, unsigned short* *x, int arg_num) | |||
3720 | int arg_num),(long obj, unsigned short* *x, int arg_num) | |||
3721 | (obj,(long obj, unsigned short* *x, int arg_num) | |||
3722 | x,(long obj, unsigned short* *x, int arg_num) | |||
3723 | arg_num)(long obj, unsigned short* *x, int arg_num) | |||
3724 | ___SCMOBJ obj;(long obj, unsigned short* *x, int arg_num) | |||
3725 | ___UTF_16STRING *x;(long obj, unsigned short* *x, int arg_num) | |||
3726 | int arg_num;)(long obj, unsigned short* *x, int arg_num) | |||
3727 | { | |||
3728 | void *result; | |||
3729 | ___SCMOBJlong e; | |||
3730 | ||||
3731 | if ((e = ___SCMOBJ_to_STRING | |||
3732 | (obj, | |||
3733 | &result, | |||
3734 | arg_num, | |||
3735 | ___CHAR_ENCODING_UTF_16(4<<0), | |||
3736 | 0)) | |||
3737 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3738 | *x = ___CAST(___UTF_16STRING,result)((unsigned short*)(result)); | |||
3739 | ||||
3740 | return e; | |||
3741 | } | |||
3742 | ||||
3743 | ||||
3744 | /* Convert a Scheme string to a nonnull C UTF-16 encoded character string. */ | |||
3745 | ||||
3746 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUTF_16STRING)long ___SCMOBJ_to_NONNULLUTF_16STRING | |||
3747 | ___P((___SCMOBJ obj,(long obj, unsigned short* *x, int arg_num) | |||
3748 | ___UTF_16STRING *x,(long obj, unsigned short* *x, int arg_num) | |||
3749 | int arg_num),(long obj, unsigned short* *x, int arg_num) | |||
3750 | (obj,(long obj, unsigned short* *x, int arg_num) | |||
3751 | x,(long obj, unsigned short* *x, int arg_num) | |||
3752 | arg_num)(long obj, unsigned short* *x, int arg_num) | |||
3753 | ___SCMOBJ obj;(long obj, unsigned short* *x, int arg_num) | |||
3754 | ___UTF_16STRING *x;(long obj, unsigned short* *x, int arg_num) | |||
3755 | int arg_num;)(long obj, unsigned short* *x, int arg_num) | |||
3756 | { | |||
3757 | void *result; | |||
3758 | ___SCMOBJlong e; | |||
3759 | ||||
3760 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3761 | (obj, | |||
3762 | &result, | |||
3763 | arg_num, | |||
3764 | ___CHAR_ENCODING_UTF_16(4<<0), | |||
3765 | 0)) | |||
3766 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3767 | *x = ___CAST(___UTF_16STRING,result)((unsigned short*)(result)); | |||
3768 | ||||
3769 | return e; | |||
3770 | } | |||
3771 | ||||
3772 | ||||
3773 | /* Convert a Scheme list of strings to a nonnull C UTF-16 encoded character string list. */ | |||
3774 | ||||
3775 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUTF_16STRINGLIST)long ___SCMOBJ_to_NONNULLUTF_16STRINGLIST | |||
3776 | ___P((___SCMOBJ obj,(long obj, unsigned short* **x, int arg_num) | |||
3777 | ___UTF_16STRING **x,(long obj, unsigned short* **x, int arg_num) | |||
3778 | int arg_num),(long obj, unsigned short* **x, int arg_num) | |||
3779 | (obj,(long obj, unsigned short* **x, int arg_num) | |||
3780 | x,(long obj, unsigned short* **x, int arg_num) | |||
3781 | arg_num)(long obj, unsigned short* **x, int arg_num) | |||
3782 | ___SCMOBJ obj;(long obj, unsigned short* **x, int arg_num) | |||
3783 | ___UTF_16STRING **x;(long obj, unsigned short* **x, int arg_num) | |||
3784 | int arg_num;)(long obj, unsigned short* **x, int arg_num) | |||
3785 | { | |||
3786 | void *result; | |||
3787 | ___SCMOBJlong e; | |||
3788 | ||||
3789 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3790 | (obj, | |||
3791 | &result, | |||
3792 | arg_num, | |||
3793 | ___CHAR_ENCODING_UTF_16(4<<0))) | |||
3794 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3795 | *x = ___CAST(___UTF_16STRING*,result)((unsigned short**)(result)); | |||
3796 | ||||
3797 | return e; | |||
3798 | } | |||
3799 | ||||
3800 | ||||
3801 | /* Convert a Scheme string to a C UCS-2 encoded character string. */ | |||
3802 | ||||
3803 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UCS_2STRING)long ___SCMOBJ_to_UCS_2STRING | |||
3804 | ___P((___SCMOBJ obj,(long obj, unsigned short* *x, int arg_num) | |||
3805 | ___UCS_2STRING *x,(long obj, unsigned short* *x, int arg_num) | |||
3806 | int arg_num),(long obj, unsigned short* *x, int arg_num) | |||
3807 | (obj,(long obj, unsigned short* *x, int arg_num) | |||
3808 | x,(long obj, unsigned short* *x, int arg_num) | |||
3809 | arg_num)(long obj, unsigned short* *x, int arg_num) | |||
3810 | ___SCMOBJ obj;(long obj, unsigned short* *x, int arg_num) | |||
3811 | ___UCS_2STRING *x;(long obj, unsigned short* *x, int arg_num) | |||
3812 | int arg_num;)(long obj, unsigned short* *x, int arg_num) | |||
3813 | { | |||
3814 | void *result; | |||
3815 | ___SCMOBJlong e; | |||
3816 | ||||
3817 | if ((e = ___SCMOBJ_to_STRING | |||
3818 | (obj, | |||
3819 | &result, | |||
3820 | arg_num, | |||
3821 | ___CHAR_ENCODING_UCS_2(13<<0), | |||
3822 | 0)) | |||
3823 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3824 | *x = ___CAST(___UCS_2STRING,result)((unsigned short*)(result)); | |||
3825 | ||||
3826 | return e; | |||
3827 | } | |||
3828 | ||||
3829 | ||||
3830 | /* Convert a Scheme string to a nonnull C UCS-2 encoded character string. */ | |||
3831 | ||||
3832 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUCS_2STRING)long ___SCMOBJ_to_NONNULLUCS_2STRING | |||
3833 | ___P((___SCMOBJ obj,(long obj, unsigned short* *x, int arg_num) | |||
3834 | ___UCS_2STRING *x,(long obj, unsigned short* *x, int arg_num) | |||
3835 | int arg_num),(long obj, unsigned short* *x, int arg_num) | |||
3836 | (obj,(long obj, unsigned short* *x, int arg_num) | |||
3837 | x,(long obj, unsigned short* *x, int arg_num) | |||
3838 | arg_num)(long obj, unsigned short* *x, int arg_num) | |||
3839 | ___SCMOBJ obj;(long obj, unsigned short* *x, int arg_num) | |||
3840 | ___UCS_2STRING *x;(long obj, unsigned short* *x, int arg_num) | |||
3841 | int arg_num;)(long obj, unsigned short* *x, int arg_num) | |||
3842 | { | |||
3843 | void *result; | |||
3844 | ___SCMOBJlong e; | |||
3845 | ||||
3846 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3847 | (obj, | |||
3848 | &result, | |||
3849 | arg_num, | |||
3850 | ___CHAR_ENCODING_UCS_2(13<<0), | |||
3851 | 0)) | |||
3852 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3853 | *x = ___CAST(___UCS_2STRING,result)((unsigned short*)(result)); | |||
3854 | ||||
3855 | return e; | |||
3856 | } | |||
3857 | ||||
3858 | ||||
3859 | /* Convert a Scheme list of strings to a nonnull C UCS-2 encoded character string list. */ | |||
3860 | ||||
3861 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUCS_2STRINGLIST)long ___SCMOBJ_to_NONNULLUCS_2STRINGLIST | |||
3862 | ___P((___SCMOBJ obj,(long obj, unsigned short* **x, int arg_num) | |||
3863 | ___UCS_2STRING **x,(long obj, unsigned short* **x, int arg_num) | |||
3864 | int arg_num),(long obj, unsigned short* **x, int arg_num) | |||
3865 | (obj,(long obj, unsigned short* **x, int arg_num) | |||
3866 | x,(long obj, unsigned short* **x, int arg_num) | |||
3867 | arg_num)(long obj, unsigned short* **x, int arg_num) | |||
3868 | ___SCMOBJ obj;(long obj, unsigned short* **x, int arg_num) | |||
3869 | ___UCS_2STRING **x;(long obj, unsigned short* **x, int arg_num) | |||
3870 | int arg_num;)(long obj, unsigned short* **x, int arg_num) | |||
3871 | { | |||
3872 | void *result; | |||
3873 | ___SCMOBJlong e; | |||
3874 | ||||
3875 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3876 | (obj, | |||
3877 | &result, | |||
3878 | arg_num, | |||
3879 | ___CHAR_ENCODING_UCS_2(13<<0))) | |||
3880 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3881 | *x = ___CAST(___UCS_2STRING*,result)((unsigned short**)(result)); | |||
3882 | ||||
3883 | return e; | |||
3884 | } | |||
3885 | ||||
3886 | ||||
3887 | /* Convert a Scheme string to a C UCS-4 encoded character string. */ | |||
3888 | ||||
3889 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_UCS_4STRING)long ___SCMOBJ_to_UCS_4STRING | |||
3890 | ___P((___SCMOBJ obj,(long obj, unsigned int* *x, int arg_num) | |||
3891 | ___UCS_4STRING *x,(long obj, unsigned int* *x, int arg_num) | |||
3892 | int arg_num),(long obj, unsigned int* *x, int arg_num) | |||
3893 | (obj,(long obj, unsigned int* *x, int arg_num) | |||
3894 | x,(long obj, unsigned int* *x, int arg_num) | |||
3895 | arg_num)(long obj, unsigned int* *x, int arg_num) | |||
3896 | ___SCMOBJ obj;(long obj, unsigned int* *x, int arg_num) | |||
3897 | ___UCS_4STRING *x;(long obj, unsigned int* *x, int arg_num) | |||
3898 | int arg_num;)(long obj, unsigned int* *x, int arg_num) | |||
3899 | { | |||
3900 | void *result; | |||
3901 | ___SCMOBJlong e; | |||
3902 | ||||
3903 | if ((e = ___SCMOBJ_to_STRING | |||
3904 | (obj, | |||
3905 | &result, | |||
3906 | arg_num, | |||
3907 | ___CHAR_ENCODING_UCS_4(16<<0), | |||
3908 | 0)) | |||
3909 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3910 | *x = ___CAST(___UCS_4STRING,result)((unsigned int*)(result)); | |||
3911 | ||||
3912 | return e; | |||
3913 | } | |||
3914 | ||||
3915 | ||||
3916 | /* Convert a Scheme string to a nonnull C UCS-4 encoded character string. */ | |||
3917 | ||||
3918 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUCS_4STRING)long ___SCMOBJ_to_NONNULLUCS_4STRING | |||
3919 | ___P((___SCMOBJ obj,(long obj, unsigned int* *x, int arg_num) | |||
3920 | ___UCS_4STRING *x,(long obj, unsigned int* *x, int arg_num) | |||
3921 | int arg_num),(long obj, unsigned int* *x, int arg_num) | |||
3922 | (obj,(long obj, unsigned int* *x, int arg_num) | |||
3923 | x,(long obj, unsigned int* *x, int arg_num) | |||
3924 | arg_num)(long obj, unsigned int* *x, int arg_num) | |||
3925 | ___SCMOBJ obj;(long obj, unsigned int* *x, int arg_num) | |||
3926 | ___UCS_4STRING *x;(long obj, unsigned int* *x, int arg_num) | |||
3927 | int arg_num;)(long obj, unsigned int* *x, int arg_num) | |||
3928 | { | |||
3929 | void *result; | |||
3930 | ___SCMOBJlong e; | |||
3931 | ||||
3932 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
3933 | (obj, | |||
3934 | &result, | |||
3935 | arg_num, | |||
3936 | ___CHAR_ENCODING_UCS_4(16<<0), | |||
3937 | 0)) | |||
3938 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3939 | *x = ___CAST(___UCS_4STRING,result)((unsigned int*)(result)); | |||
3940 | ||||
3941 | return e; | |||
3942 | } | |||
3943 | ||||
3944 | ||||
3945 | /* Convert a Scheme list of strings to a nonnull C UCS-4 encoded character string list. */ | |||
3946 | ||||
3947 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLUCS_4STRINGLIST)long ___SCMOBJ_to_NONNULLUCS_4STRINGLIST | |||
3948 | ___P((___SCMOBJ obj,(long obj, unsigned int* **x, int arg_num) | |||
3949 | ___UCS_4STRING **x,(long obj, unsigned int* **x, int arg_num) | |||
3950 | int arg_num),(long obj, unsigned int* **x, int arg_num) | |||
3951 | (obj,(long obj, unsigned int* **x, int arg_num) | |||
3952 | x,(long obj, unsigned int* **x, int arg_num) | |||
3953 | arg_num)(long obj, unsigned int* **x, int arg_num) | |||
3954 | ___SCMOBJ obj;(long obj, unsigned int* **x, int arg_num) | |||
3955 | ___UCS_4STRING **x;(long obj, unsigned int* **x, int arg_num) | |||
3956 | int arg_num;)(long obj, unsigned int* **x, int arg_num) | |||
3957 | { | |||
3958 | void *result; | |||
3959 | ___SCMOBJlong e; | |||
3960 | ||||
3961 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
3962 | (obj, | |||
3963 | &result, | |||
3964 | arg_num, | |||
3965 | ___CHAR_ENCODING_UCS_4(16<<0))) | |||
3966 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3967 | *x = ___CAST(___UCS_4STRING*,result)((unsigned int**)(result)); | |||
3968 | ||||
3969 | return e; | |||
3970 | } | |||
3971 | ||||
3972 | ||||
3973 | /* Convert a Scheme string to a C ___WCHAR encoded character string. */ | |||
3974 | ||||
3975 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_WCHARSTRING)long ___SCMOBJ_to_WCHARSTRING | |||
3976 | ___P((___SCMOBJ obj,(long obj, wchar_t* *x, int arg_num) | |||
3977 | ___WCHARSTRING *x,(long obj, wchar_t* *x, int arg_num) | |||
3978 | int arg_num),(long obj, wchar_t* *x, int arg_num) | |||
3979 | (obj,(long obj, wchar_t* *x, int arg_num) | |||
3980 | x,(long obj, wchar_t* *x, int arg_num) | |||
3981 | arg_num)(long obj, wchar_t* *x, int arg_num) | |||
3982 | ___SCMOBJ obj;(long obj, wchar_t* *x, int arg_num) | |||
3983 | ___WCHARSTRING *x;(long obj, wchar_t* *x, int arg_num) | |||
3984 | int arg_num;)(long obj, wchar_t* *x, int arg_num) | |||
3985 | { | |||
3986 | void *result; | |||
3987 | ___SCMOBJlong e; | |||
3988 | ||||
3989 | if ((e = ___SCMOBJ_to_STRING | |||
3990 | (obj, | |||
3991 | &result, | |||
3992 | arg_num, | |||
3993 | ___CHAR_ENCODING_WCHAR(19<<0), | |||
3994 | 0)) | |||
3995 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
3996 | *x = ___CAST(___WCHARSTRING,result)((wchar_t*)(result)); | |||
3997 | ||||
3998 | return e; | |||
3999 | } | |||
4000 | ||||
4001 | ||||
4002 | /* Convert a Scheme string to a nonnull C ___WCHAR encoded character string. */ | |||
4003 | ||||
4004 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLWCHARSTRING)long ___SCMOBJ_to_NONNULLWCHARSTRING | |||
4005 | ___P((___SCMOBJ obj,(long obj, wchar_t* *x, int arg_num) | |||
4006 | ___WCHARSTRING *x,(long obj, wchar_t* *x, int arg_num) | |||
4007 | int arg_num),(long obj, wchar_t* *x, int arg_num) | |||
4008 | (obj,(long obj, wchar_t* *x, int arg_num) | |||
4009 | x,(long obj, wchar_t* *x, int arg_num) | |||
4010 | arg_num)(long obj, wchar_t* *x, int arg_num) | |||
4011 | ___SCMOBJ obj;(long obj, wchar_t* *x, int arg_num) | |||
4012 | ___WCHARSTRING *x;(long obj, wchar_t* *x, int arg_num) | |||
4013 | int arg_num;)(long obj, wchar_t* *x, int arg_num) | |||
4014 | { | |||
4015 | void *result; | |||
4016 | ___SCMOBJlong e; | |||
4017 | ||||
4018 | if ((e = ___SCMOBJ_to_NONNULLSTRING | |||
4019 | (obj, | |||
4020 | &result, | |||
4021 | arg_num, | |||
4022 | ___CHAR_ENCODING_WCHAR(19<<0), | |||
4023 | 0)) | |||
4024 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
4025 | *x = ___CAST(___WCHARSTRING,result)((wchar_t*)(result)); | |||
4026 | ||||
4027 | return e; | |||
4028 | } | |||
4029 | ||||
4030 | ||||
4031 | /* Convert a Scheme list of strings to a nonnull C ___WCHAR encoded character string list. */ | |||
4032 | ||||
4033 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_NONNULLWCHARSTRINGLIST)long ___SCMOBJ_to_NONNULLWCHARSTRINGLIST | |||
4034 | ___P((___SCMOBJ obj,(long obj, wchar_t* **x, int arg_num) | |||
4035 | ___WCHARSTRING **x,(long obj, wchar_t* **x, int arg_num) | |||
4036 | int arg_num),(long obj, wchar_t* **x, int arg_num) | |||
4037 | (obj,(long obj, wchar_t* **x, int arg_num) | |||
4038 | x,(long obj, wchar_t* **x, int arg_num) | |||
4039 | arg_num)(long obj, wchar_t* **x, int arg_num) | |||
4040 | ___SCMOBJ obj;(long obj, wchar_t* **x, int arg_num) | |||
4041 | ___WCHARSTRING **x;(long obj, wchar_t* **x, int arg_num) | |||
4042 | int arg_num;)(long obj, wchar_t* **x, int arg_num) | |||
4043 | { | |||
4044 | void *result; | |||
| ||||
4045 | ___SCMOBJlong e; | |||
4046 | ||||
4047 | if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST | |||
4048 | (obj, | |||
4049 | &result, | |||
4050 | arg_num, | |||
4051 | ___CHAR_ENCODING_WCHAR(19<<0))) | |||
4052 | == ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
4053 | *x = ___CAST(___WCHARSTRING*,result)((wchar_t**)(result)); | |||
| ||||
4054 | ||||
4055 | return e; | |||
4056 | } | |||
4057 | ||||
4058 | ||||
4059 | /* Convert a Scheme object to a variant. */ | |||
4060 | ||||
4061 | ___EXP_FUNC(___SCMOBJ,___SCMOBJ_to_VARIANT)long ___SCMOBJ_to_VARIANT | |||
4062 | ___P((___SCMOBJ obj,(long obj, ___VARIANT *x, int arg_num) | |||
4063 | ___VARIANT *x,(long obj, ___VARIANT *x, int arg_num) | |||
4064 | int arg_num),(long obj, ___VARIANT *x, int arg_num) | |||
4065 | (obj,(long obj, ___VARIANT *x, int arg_num) | |||
4066 | x,(long obj, ___VARIANT *x, int arg_num) | |||
4067 | arg_num)(long obj, ___VARIANT *x, int arg_num) | |||
4068 | ___SCMOBJ obj;(long obj, ___VARIANT *x, int arg_num) | |||
4069 | ___VARIANT *x;(long obj, ___VARIANT *x, int arg_num) | |||
4070 | int arg_num;)(long obj, ___VARIANT *x, int arg_num) | |||
4071 | { | |||
4072 | /* | |||
4073 | * Not yet implemented. | |||
4074 | */ | |||
4075 | return ___FIX(___STOC_VARIANT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(60<<7))+arg_num))<<2); | |||
4076 | } | |||
4077 | ||||
4078 | ||||
4079 | /*---------------------------------------------------------------------------*/ | |||
4080 | ||||
4081 | /* C to Scheme conversion */ | |||
4082 | ||||
4083 | /* | |||
4084 | * The C to Scheme conversion functions may allocate memory in the | |||
4085 | * Scheme heap. However, all objects allocated are still objects with | |||
4086 | * a reference count of 1. The only special processing that must be | |||
4087 | * performed by the caller of a C to Scheme conversion function is a | |||
4088 | * call to '___release_scmobj' when the caller no longer needs a | |||
4089 | * reference to the object. This call is generated automatically by | |||
4090 | * the C-interface. | |||
4091 | */ | |||
4092 | ||||
4093 | ||||
4094 | /* Convert a C '___S64' to a Scheme integer. */ | |||
4095 | ||||
4096 | ___EXP_FUNC(___SCMOBJ,___S64_to_SCMOBJ)long ___S64_to_SCMOBJ | |||
4097 | ___P((___S64 x,(long x, long *obj, int arg_num) | |||
4098 | ___SCMOBJ *obj,(long x, long *obj, int arg_num) | |||
4099 | int arg_num),(long x, long *obj, int arg_num) | |||
4100 | (x,(long x, long *obj, int arg_num) | |||
4101 | obj,(long x, long *obj, int arg_num) | |||
4102 | arg_num)(long x, long *obj, int arg_num) | |||
4103 | ___S64 x;(long x, long *obj, int arg_num) | |||
4104 | ___SCMOBJ *obj;(long x, long *obj, int arg_num) | |||
4105 | int arg_num;)(long x, long *obj, int arg_num) | |||
4106 | { | |||
4107 | ___SCMOBJlong r; | |||
4108 | ||||
4109 | if (___S64_fits_in_width (x, ___SCMOBJ_WIDTH-___TB)((((x) >> ((64 -2)-1)) == 0) || (((x) >> ((64 -2) -1)) == -1))) | |||
4110 | r = ___FIX(___S64_to_LONGLONG (x))(((long)(((long long)(x))))<<2); | |||
4111 | else | |||
4112 | { | |||
4113 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
4114 | int n; | |||
4115 | ___BIGADIGITunsigned long d0 = ___S64_lo32 (x)((unsigned int)(x)); | |||
4116 | ___BIGADIGITunsigned long d1 = ___CAST_U32(___S64_hi32 (x))((unsigned int)(((int)((x) >> 32)))); | |||
4117 | ||||
4118 | if (___CAST(___BIGADIGITSIGNED,d0)((long)(d0)) < 0) | |||
4119 | n = 1 + (d1 != ___BIG_ABASE_MIN_1(~((unsigned long)(0)))); | |||
4120 | else | |||
4121 | n = 1 + (d1 != 0); | |||
4122 | ||||
4123 | r = ___alloc_scmobj (___sBIGNUM31, n<<2, ___STILL5); | |||
4124 | ||||
4125 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4126 | { | |||
4127 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4128 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4129 | } | |||
4130 | ||||
4131 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),0,d0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(0)) = (d0); | |||
4132 | if (n == 2) | |||
4133 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),1,d1)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(1)) = (d1); | |||
4134 | #else | |||
4135 | int n = 1; | |||
4136 | ___BIGADIGITunsigned long d0 = x; | |||
4137 | ||||
4138 | r = ___alloc_scmobj (___sBIGNUM31, n<<3, ___STILL5); | |||
4139 | ||||
4140 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4141 | { | |||
4142 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4143 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4144 | } | |||
4145 | ||||
4146 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),0,d0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(0)) = (d0); | |||
4147 | #endif | |||
4148 | } | |||
4149 | ||||
4150 | *obj = r; | |||
4151 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4152 | } | |||
4153 | ||||
4154 | ||||
4155 | /* Convert a C '___U64' to a Scheme integer. */ | |||
4156 | ||||
4157 | ___EXP_FUNC(___SCMOBJ,___U64_to_SCMOBJ)long ___U64_to_SCMOBJ | |||
4158 | ___P((___U64 x,(unsigned long x, long *obj, int arg_num) | |||
4159 | ___SCMOBJ *obj,(unsigned long x, long *obj, int arg_num) | |||
4160 | int arg_num),(unsigned long x, long *obj, int arg_num) | |||
4161 | (x,(unsigned long x, long *obj, int arg_num) | |||
4162 | obj,(unsigned long x, long *obj, int arg_num) | |||
4163 | arg_num)(unsigned long x, long *obj, int arg_num) | |||
4164 | ___U64 x;(unsigned long x, long *obj, int arg_num) | |||
4165 | ___SCMOBJ *obj;(unsigned long x, long *obj, int arg_num) | |||
4166 | int arg_num;)(unsigned long x, long *obj, int arg_num) | |||
4167 | { | |||
4168 | ___SCMOBJlong r; | |||
4169 | ||||
4170 | if (___U64_fits_in_width (x, ___SCMOBJ_WIDTH-___TB-1)(((x) >> (64 -2 -1)) == 0)) | |||
4171 | r = ___FIX(___U64_to_ULONGLONG (x))(((long)(((unsigned long long)(x))))<<2); | |||
4172 | else | |||
4173 | { | |||
4174 | #if ___BIG_ABASE_WIDTH64 == 32 | |||
4175 | int n; | |||
4176 | ___BIGADIGITunsigned long d0 = ___U64_lo32 (x)((unsigned int)(x)); | |||
4177 | ___BIGADIGITunsigned long d1 = ___U64_hi32 (x)((unsigned int)((x) >> 32)); | |||
4178 | ||||
4179 | if (d1 == 0) | |||
4180 | n = 1 + (___CAST(___BIGADIGITSIGNED,d0)((long)(d0)) < 0); | |||
4181 | else | |||
4182 | n = 2 + (___CAST(___BIGADIGITSIGNED,d1)((long)(d1)) < 0); | |||
4183 | ||||
4184 | r = ___alloc_scmobj (___sBIGNUM31, n<<2, ___STILL5); | |||
4185 | ||||
4186 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4187 | { | |||
4188 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4189 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4190 | } | |||
4191 | ||||
4192 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),0,d0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(0)) = (d0); | |||
4193 | if (n >= 2) | |||
4194 | { | |||
4195 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),1,d1)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(1)) = (d1); | |||
4196 | if (n >= 3) | |||
4197 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),2,0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(2)) = (0); | |||
4198 | } | |||
4199 | #else | |||
4200 | int n; | |||
4201 | ___BIGADIGITunsigned long d0 = x; | |||
4202 | ||||
4203 | n = 1 + (___CAST(___BIGADIGITSIGNED,d0)((long)(d0)) < 0); | |||
4204 | ||||
4205 | r = ___alloc_scmobj (___sBIGNUM31, n<<3, ___STILL5); | |||
4206 | ||||
4207 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4208 | { | |||
4209 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4210 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4211 | } | |||
4212 | ||||
4213 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),0,d0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(0)) = (d0); | |||
4214 | if (n == 2) | |||
4215 | ___BIGASTORE(___BODY_AS(r,___tSUBTYPED),1,0)*(((unsigned long*)((((long*)((r)-(1)))+1)))+(1)) = (0); | |||
4216 | #endif | |||
4217 | } | |||
4218 | ||||
4219 | *obj = r; | |||
4220 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4221 | } | |||
4222 | ||||
4223 | ||||
4224 | /* Convert a C '___S8' to a Scheme integer. */ | |||
4225 | ||||
4226 | ___EXP_FUNC(___SCMOBJ,___S8_to_SCMOBJ)long ___S8_to_SCMOBJ | |||
4227 | ___P((___S8 x,(signed char x, long *obj, int arg_num) | |||
4228 | ___SCMOBJ *obj,(signed char x, long *obj, int arg_num) | |||
4229 | int arg_num),(signed char x, long *obj, int arg_num) | |||
4230 | (x,(signed char x, long *obj, int arg_num) | |||
4231 | obj,(signed char x, long *obj, int arg_num) | |||
4232 | arg_num)(signed char x, long *obj, int arg_num) | |||
4233 | ___S8 x;(signed char x, long *obj, int arg_num) | |||
4234 | ___SCMOBJ *obj;(signed char x, long *obj, int arg_num) | |||
4235 | int arg_num;)(signed char x, long *obj, int arg_num) | |||
4236 | { | |||
4237 | /* | |||
4238 | * No error possible because a '___S8' always fits in a Scheme | |||
4239 | * fixnum. | |||
4240 | */ | |||
4241 | *obj = ___FIX(x)(((long)(x))<<2); | |||
4242 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4243 | } | |||
4244 | ||||
4245 | ||||
4246 | /* Convert a C '___U8' to a Scheme integer. */ | |||
4247 | ||||
4248 | ___EXP_FUNC(___SCMOBJ,___U8_to_SCMOBJ)long ___U8_to_SCMOBJ | |||
4249 | ___P((___U8 x,(unsigned char x, long *obj, int arg_num) | |||
4250 | ___SCMOBJ *obj,(unsigned char x, long *obj, int arg_num) | |||
4251 | int arg_num),(unsigned char x, long *obj, int arg_num) | |||
4252 | (x,(unsigned char x, long *obj, int arg_num) | |||
4253 | obj,(unsigned char x, long *obj, int arg_num) | |||
4254 | arg_num)(unsigned char x, long *obj, int arg_num) | |||
4255 | ___U8 x;(unsigned char x, long *obj, int arg_num) | |||
4256 | ___SCMOBJ *obj;(unsigned char x, long *obj, int arg_num) | |||
4257 | int arg_num;)(unsigned char x, long *obj, int arg_num) | |||
4258 | { | |||
4259 | /* | |||
4260 | * No error possible because a '___U8' always fits in a Scheme | |||
4261 | * fixnum. | |||
4262 | */ | |||
4263 | *obj = ___FIX(x)(((long)(x))<<2); | |||
4264 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4265 | } | |||
4266 | ||||
4267 | ||||
4268 | /* Convert a C '___S16' to a Scheme integer. */ | |||
4269 | ||||
4270 | ___EXP_FUNC(___SCMOBJ,___S16_to_SCMOBJ)long ___S16_to_SCMOBJ | |||
4271 | ___P((___S16 x,(short x, long *obj, int arg_num) | |||
4272 | ___SCMOBJ *obj,(short x, long *obj, int arg_num) | |||
4273 | int arg_num),(short x, long *obj, int arg_num) | |||
4274 | (x,(short x, long *obj, int arg_num) | |||
4275 | obj,(short x, long *obj, int arg_num) | |||
4276 | arg_num)(short x, long *obj, int arg_num) | |||
4277 | ___S16 x;(short x, long *obj, int arg_num) | |||
4278 | ___SCMOBJ *obj;(short x, long *obj, int arg_num) | |||
4279 | int arg_num;)(short x, long *obj, int arg_num) | |||
4280 | { | |||
4281 | /* | |||
4282 | * No error possible because a '___S16' always fits in a Scheme | |||
4283 | * fixnum. | |||
4284 | */ | |||
4285 | *obj = ___FIX(x)(((long)(x))<<2); | |||
4286 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4287 | } | |||
4288 | ||||
4289 | ||||
4290 | /* Convert a C '___U16' to a Scheme integer. */ | |||
4291 | ||||
4292 | ___EXP_FUNC(___SCMOBJ,___U16_to_SCMOBJ)long ___U16_to_SCMOBJ | |||
4293 | ___P((___U16 x,(unsigned short x, long *obj, int arg_num) | |||
4294 | ___SCMOBJ *obj,(unsigned short x, long *obj, int arg_num) | |||
4295 | int arg_num),(unsigned short x, long *obj, int arg_num) | |||
4296 | (x,(unsigned short x, long *obj, int arg_num) | |||
4297 | obj,(unsigned short x, long *obj, int arg_num) | |||
4298 | arg_num)(unsigned short x, long *obj, int arg_num) | |||
4299 | ___U16 x;(unsigned short x, long *obj, int arg_num) | |||
4300 | ___SCMOBJ *obj;(unsigned short x, long *obj, int arg_num) | |||
4301 | int arg_num;)(unsigned short x, long *obj, int arg_num) | |||
4302 | { | |||
4303 | /* | |||
4304 | * No error possible because a '___U16' always fits in a Scheme | |||
4305 | * fixnum. | |||
4306 | */ | |||
4307 | *obj = ___FIX(x)(((long)(x))<<2); | |||
4308 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4309 | } | |||
4310 | ||||
4311 | ||||
4312 | /* Convert a C '___S32' to a Scheme integer. */ | |||
4313 | ||||
4314 | ___EXP_FUNC(___SCMOBJ,___S32_to_SCMOBJ)long ___S32_to_SCMOBJ | |||
4315 | ___P((___S32 x,(int x, long *obj, int arg_num) | |||
4316 | ___SCMOBJ *obj,(int x, long *obj, int arg_num) | |||
4317 | int arg_num),(int x, long *obj, int arg_num) | |||
4318 | (x,(int x, long *obj, int arg_num) | |||
4319 | obj,(int x, long *obj, int arg_num) | |||
4320 | arg_num)(int x, long *obj, int arg_num) | |||
4321 | ___S32 x;(int x, long *obj, int arg_num) | |||
4322 | ___SCMOBJ *obj;(int x, long *obj, int arg_num) | |||
4323 | int arg_num;)(int x, long *obj, int arg_num) | |||
4324 | { | |||
4325 | return ___S64_to_SCMOBJ (___S64_from_SM32 (x)((long)(((int)(x)))), obj, arg_num); | |||
4326 | } | |||
4327 | ||||
4328 | ||||
4329 | /* Convert a C '___U32' to a Scheme integer. */ | |||
4330 | ||||
4331 | ___EXP_FUNC(___SCMOBJ,___U32_to_SCMOBJ)long ___U32_to_SCMOBJ | |||
4332 | ___P((___U32 x,(unsigned int x, long *obj, int arg_num) | |||
4333 | ___SCMOBJ *obj,(unsigned int x, long *obj, int arg_num) | |||
4334 | int arg_num),(unsigned int x, long *obj, int arg_num) | |||
4335 | (x,(unsigned int x, long *obj, int arg_num) | |||
4336 | obj,(unsigned int x, long *obj, int arg_num) | |||
4337 | arg_num)(unsigned int x, long *obj, int arg_num) | |||
4338 | ___U32 x;(unsigned int x, long *obj, int arg_num) | |||
4339 | ___SCMOBJ *obj;(unsigned int x, long *obj, int arg_num) | |||
4340 | int arg_num;)(unsigned int x, long *obj, int arg_num) | |||
4341 | { | |||
4342 | return ___U64_to_SCMOBJ (___U64_from_UM32 (x)((unsigned long)(((unsigned int)(x)))), obj, arg_num); | |||
4343 | } | |||
4344 | ||||
4345 | ||||
4346 | /* Convert a C '___F64' to a Scheme flonum. */ | |||
4347 | ||||
4348 | ___EXP_FUNC(___SCMOBJ,___F64_to_SCMOBJ)long ___F64_to_SCMOBJ | |||
4349 | ___P((___F64 x,(double x, long *obj, int arg_num) | |||
4350 | ___SCMOBJ *obj,(double x, long *obj, int arg_num) | |||
4351 | int arg_num),(double x, long *obj, int arg_num) | |||
4352 | (x,(double x, long *obj, int arg_num) | |||
4353 | obj,(double x, long *obj, int arg_num) | |||
4354 | arg_num)(double x, long *obj, int arg_num) | |||
4355 | ___F64 x;(double x, long *obj, int arg_num) | |||
4356 | ___SCMOBJ *obj;(double x, long *obj, int arg_num) | |||
4357 | int arg_num;)(double x, long *obj, int arg_num) | |||
4358 | { | |||
4359 | ___SCMOBJlong r = ___alloc_scmobj (___sFLONUM30, ___FLONUM_SIZE1<<___LWS3, ___STILL5); | |||
4360 | ||||
4361 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4362 | { | |||
4363 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4364 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4365 | } | |||
4366 | ||||
4367 | ___FLONUM_VAL(r)*((double*)((((long*)((r)-(1)))+1))) = x; | |||
4368 | ||||
4369 | *obj = r; | |||
4370 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4371 | } | |||
4372 | ||||
4373 | ||||
4374 | /* Convert a C '___F32' to a Scheme flonum. */ | |||
4375 | ||||
4376 | ___EXP_FUNC(___SCMOBJ,___F32_to_SCMOBJ)long ___F32_to_SCMOBJ | |||
4377 | ___P((___F32 x,(float x, long *obj, int arg_num) | |||
4378 | ___SCMOBJ *obj,(float x, long *obj, int arg_num) | |||
4379 | int arg_num),(float x, long *obj, int arg_num) | |||
4380 | (x,(float x, long *obj, int arg_num) | |||
4381 | obj,(float x, long *obj, int arg_num) | |||
4382 | arg_num)(float x, long *obj, int arg_num) | |||
4383 | ___F32 x;(float x, long *obj, int arg_num) | |||
4384 | ___SCMOBJ *obj;(float x, long *obj, int arg_num) | |||
4385 | int arg_num;)(float x, long *obj, int arg_num) | |||
4386 | { | |||
4387 | return ___F64_to_SCMOBJ (___CAST(___F64,x)((double)(x)), obj, arg_num); | |||
4388 | } | |||
4389 | ||||
4390 | ||||
4391 | /* Convert a C 'char' to a Scheme character. */ | |||
4392 | ||||
4393 | ___EXP_FUNC(___SCMOBJ,___CHAR_to_SCMOBJ)long ___CHAR_to_SCMOBJ | |||
4394 | ___P((char x,(char x, long *obj, int arg_num) | |||
4395 | ___SCMOBJ *obj,(char x, long *obj, int arg_num) | |||
4396 | int arg_num),(char x, long *obj, int arg_num) | |||
4397 | (x,(char x, long *obj, int arg_num) | |||
4398 | obj,(char x, long *obj, int arg_num) | |||
4399 | arg_num)(char x, long *obj, int arg_num) | |||
4400 | char x;(char x, long *obj, int arg_num) | |||
4401 | ___SCMOBJ *obj;(char x, long *obj, int arg_num) | |||
4402 | int arg_num;)(char x, long *obj, int arg_num) | |||
4403 | { | |||
4404 | /* | |||
4405 | * No error possible because a 'char' always fits in | |||
4406 | * a Scheme character. | |||
4407 | */ | |||
4408 | *obj = ___CHR(uchar_to_UCS_4 (___CAST(unsigned char,x)))((((long)(((unsigned int)(((unsigned char)(x))))))<<2)+ 2); | |||
4409 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4410 | } | |||
4411 | ||||
4412 | ||||
4413 | /* Convert a C 'signed char' to a Scheme character. */ | |||
4414 | ||||
4415 | ___EXP_FUNC(___SCMOBJ,___SCHAR_to_SCMOBJ)long ___SCHAR_to_SCMOBJ | |||
4416 | ___P((___SCHAR x,(signed char x, long *obj, int arg_num) | |||
4417 | ___SCMOBJ *obj,(signed char x, long *obj, int arg_num) | |||
4418 | int arg_num),(signed char x, long *obj, int arg_num) | |||
4419 | (x,(signed char x, long *obj, int arg_num) | |||
4420 | obj,(signed char x, long *obj, int arg_num) | |||
4421 | arg_num)(signed char x, long *obj, int arg_num) | |||
4422 | ___SCHAR x;(signed char x, long *obj, int arg_num) | |||
4423 | ___SCMOBJ *obj;(signed char x, long *obj, int arg_num) | |||
4424 | int arg_num;)(signed char x, long *obj, int arg_num) | |||
4425 | { | |||
4426 | /* | |||
4427 | * No error possible because a 'signed char' always fits in | |||
4428 | * a Scheme character. | |||
4429 | */ | |||
4430 | *obj = ___CHR(uchar_to_UCS_4 (___CAST(unsigned char,x)))((((long)(((unsigned int)(((unsigned char)(x))))))<<2)+ 2); | |||
4431 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4432 | } | |||
4433 | ||||
4434 | ||||
4435 | /* Convert a C 'unsigned char' to a Scheme character. */ | |||
4436 | ||||
4437 | ___EXP_FUNC(___SCMOBJ,___UCHAR_to_SCMOBJ)long ___UCHAR_to_SCMOBJ | |||
4438 | ___P((unsigned char x,(unsigned char x, long *obj, int arg_num) | |||
4439 | ___SCMOBJ *obj,(unsigned char x, long *obj, int arg_num) | |||
4440 | int arg_num),(unsigned char x, long *obj, int arg_num) | |||
4441 | (x,(unsigned char x, long *obj, int arg_num) | |||
4442 | obj,(unsigned char x, long *obj, int arg_num) | |||
4443 | arg_num)(unsigned char x, long *obj, int arg_num) | |||
4444 | unsigned char x;(unsigned char x, long *obj, int arg_num) | |||
4445 | ___SCMOBJ *obj;(unsigned char x, long *obj, int arg_num) | |||
4446 | int arg_num;)(unsigned char x, long *obj, int arg_num) | |||
4447 | { | |||
4448 | /* | |||
4449 | * No error possible because an 'unsigned char' always fits in | |||
4450 | * a Scheme character. | |||
4451 | */ | |||
4452 | *obj = ___CHR(uchar_to_UCS_4 (x))((((long)(((unsigned int)(x))))<<2)+2); | |||
4453 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4454 | } | |||
4455 | ||||
4456 | ||||
4457 | /* Convert a C ISO-8859-1 encoded character to a Scheme character. */ | |||
4458 | ||||
4459 | ___EXP_FUNC(___SCMOBJ,___ISO_8859_1_to_SCMOBJ)long ___ISO_8859_1_to_SCMOBJ | |||
4460 | ___P((___ISO_8859_1 x,(unsigned char x, long *obj, int arg_num) | |||
4461 | ___SCMOBJ *obj,(unsigned char x, long *obj, int arg_num) | |||
4462 | int arg_num),(unsigned char x, long *obj, int arg_num) | |||
4463 | (x,(unsigned char x, long *obj, int arg_num) | |||
4464 | obj,(unsigned char x, long *obj, int arg_num) | |||
4465 | arg_num)(unsigned char x, long *obj, int arg_num) | |||
4466 | ___ISO_8859_1 x;(unsigned char x, long *obj, int arg_num) | |||
4467 | ___SCMOBJ *obj;(unsigned char x, long *obj, int arg_num) | |||
4468 | int arg_num;)(unsigned char x, long *obj, int arg_num) | |||
4469 | { | |||
4470 | /* | |||
4471 | * No error possible because a ISO-8859-1 character always fits in | |||
4472 | * a Scheme character. | |||
4473 | */ | |||
4474 | *obj = ___CHR(x)((((long)(((unsigned int)(x))))<<2)+2); | |||
4475 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4476 | } | |||
4477 | ||||
4478 | ||||
4479 | /* Convert a C UCS-2 encoded character to a Scheme character. */ | |||
4480 | ||||
4481 | ___EXP_FUNC(___SCMOBJ,___UCS_2_to_SCMOBJ)long ___UCS_2_to_SCMOBJ | |||
4482 | ___P((___UCS_2 x,(unsigned short x, long *obj, int arg_num) | |||
4483 | ___SCMOBJ *obj,(unsigned short x, long *obj, int arg_num) | |||
4484 | int arg_num),(unsigned short x, long *obj, int arg_num) | |||
4485 | (x,(unsigned short x, long *obj, int arg_num) | |||
4486 | obj,(unsigned short x, long *obj, int arg_num) | |||
4487 | arg_num)(unsigned short x, long *obj, int arg_num) | |||
4488 | ___UCS_2 x;(unsigned short x, long *obj, int arg_num) | |||
4489 | ___SCMOBJ *obj;(unsigned short x, long *obj, int arg_num) | |||
4490 | int arg_num;)(unsigned short x, long *obj, int arg_num) | |||
4491 | { | |||
4492 | #if ___MAX_CHR0x10ffff < 0xffff | |||
4493 | if (x > ___MAX_CHR0x10ffff) /* check that we are not truncating the character */ | |||
4494 | { | |||
4495 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4496 | return ___FIX(___CTOS_UCS_2_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(79<<7))+arg_num))<<2); | |||
4497 | } | |||
4498 | #endif | |||
4499 | ||||
4500 | *obj = ___CHR(x)((((long)(((unsigned int)(x))))<<2)+2); | |||
4501 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4502 | } | |||
4503 | ||||
4504 | ||||
4505 | /* Convert a C UCS-4 encoded character to a Scheme character. */ | |||
4506 | ||||
4507 | ___EXP_FUNC(___SCMOBJ,___UCS_4_to_SCMOBJ)long ___UCS_4_to_SCMOBJ | |||
4508 | ___P((___UCS_4 x,(unsigned int x, long *obj, int arg_num) | |||
4509 | ___SCMOBJ *obj,(unsigned int x, long *obj, int arg_num) | |||
4510 | int arg_num),(unsigned int x, long *obj, int arg_num) | |||
4511 | (x,(unsigned int x, long *obj, int arg_num) | |||
4512 | obj,(unsigned int x, long *obj, int arg_num) | |||
4513 | arg_num)(unsigned int x, long *obj, int arg_num) | |||
4514 | ___UCS_4 x;(unsigned int x, long *obj, int arg_num) | |||
4515 | ___SCMOBJ *obj;(unsigned int x, long *obj, int arg_num) | |||
4516 | int arg_num;)(unsigned int x, long *obj, int arg_num) | |||
4517 | { | |||
4518 | if (x > ___MAX_CHR0x10ffff) /* check that we are not truncating the character */ | |||
4519 | { | |||
4520 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4521 | return ___FIX(___CTOS_UCS_4_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(80<<7))+arg_num))<<2); | |||
4522 | } | |||
4523 | ||||
4524 | *obj = ___CHR(x)((((long)(((unsigned int)(x))))<<2)+2); | |||
4525 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4526 | } | |||
4527 | ||||
4528 | ||||
4529 | /* Convert a C ___WCHAR encoded character to a Scheme character. */ | |||
4530 | ||||
4531 | ___EXP_FUNC(___SCMOBJ,___WCHAR_to_SCMOBJ)long ___WCHAR_to_SCMOBJ | |||
4532 | ___P((___WCHAR x,(wchar_t x, long *obj, int arg_num) | |||
4533 | ___SCMOBJ *obj,(wchar_t x, long *obj, int arg_num) | |||
4534 | int arg_num),(wchar_t x, long *obj, int arg_num) | |||
4535 | (x,(wchar_t x, long *obj, int arg_num) | |||
4536 | obj,(wchar_t x, long *obj, int arg_num) | |||
4537 | arg_num)(wchar_t x, long *obj, int arg_num) | |||
4538 | ___WCHAR x;(wchar_t x, long *obj, int arg_num) | |||
4539 | ___SCMOBJ *obj;(wchar_t x, long *obj, int arg_num) | |||
4540 | int arg_num;)(wchar_t x, long *obj, int arg_num) | |||
4541 | { | |||
4542 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 || ___WCHAR_MAX2147483647 > ___MAX_CHR0x10ffff | |||
4543 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 | |||
4544 | #if ___WCHAR_MAX2147483647 > ___MAX_CHR0x10ffff | |||
4545 | if (x < 0 || x > ___MAX_CHR0x10ffff) | |||
4546 | #else | |||
4547 | if (x < 0) | |||
4548 | #endif | |||
4549 | #else | |||
4550 | if (x > ___MAX_CHR0x10ffff) | |||
4551 | #endif | |||
4552 | { | |||
4553 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4554 | return ___FIX(___CTOS_WCHAR_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(81<<7))+arg_num))<<2); | |||
4555 | } | |||
4556 | #endif | |||
4557 | ||||
4558 | *obj = ___CHR(x)((((long)(((unsigned int)(x))))<<2)+2); | |||
4559 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4560 | } | |||
4561 | ||||
4562 | ||||
4563 | /* Convert a C 'size_t' to a Scheme integer. */ | |||
4564 | ||||
4565 | ___EXP_FUNC(___SCMOBJ,___SIZE_T_to_SCMOBJ)long ___SIZE_T_to_SCMOBJ | |||
4566 | ___P((___SIZE_T x,(unsigned long x, long *obj, int arg_num) | |||
4567 | ___SCMOBJ *obj,(unsigned long x, long *obj, int arg_num) | |||
4568 | int arg_num),(unsigned long x, long *obj, int arg_num) | |||
4569 | (x,(unsigned long x, long *obj, int arg_num) | |||
4570 | obj,(unsigned long x, long *obj, int arg_num) | |||
4571 | arg_num)(unsigned long x, long *obj, int arg_num) | |||
4572 | ___SIZE_T x;(unsigned long x, long *obj, int arg_num) | |||
4573 | ___SCMOBJ *obj;(unsigned long x, long *obj, int arg_num) | |||
4574 | int arg_num;)(unsigned long x, long *obj, int arg_num) | |||
4575 | { | |||
4576 | return ___U64_to_SCMOBJ (___U64_from_ULONGLONG (___CAST(___ULONGLONG,x))((unsigned long)(((unsigned long long)(x)))), obj, arg_num); | |||
4577 | } | |||
4578 | ||||
4579 | ||||
4580 | /* Convert a C 'ssize_t' to a Scheme integer. */ | |||
4581 | ||||
4582 | ___EXP_FUNC(___SCMOBJ,___SSIZE_T_to_SCMOBJ)long ___SSIZE_T_to_SCMOBJ | |||
4583 | ___P((___SSIZE_T x,(long x, long *obj, int arg_num) | |||
4584 | ___SCMOBJ *obj,(long x, long *obj, int arg_num) | |||
4585 | int arg_num),(long x, long *obj, int arg_num) | |||
4586 | (x,(long x, long *obj, int arg_num) | |||
4587 | obj,(long x, long *obj, int arg_num) | |||
4588 | arg_num)(long x, long *obj, int arg_num) | |||
4589 | ___SSIZE_T x;(long x, long *obj, int arg_num) | |||
4590 | ___SCMOBJ *obj;(long x, long *obj, int arg_num) | |||
4591 | int arg_num;)(long x, long *obj, int arg_num) | |||
4592 | { | |||
4593 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (___CAST(___LONGLONG,x))((long)(((long long)(x)))), obj, arg_num); | |||
4594 | } | |||
4595 | ||||
4596 | ||||
4597 | /* Convert a C 'ptrdiff_t' to a Scheme integer. */ | |||
4598 | ||||
4599 | ___EXP_FUNC(___SCMOBJ,___PTRDIFF_T_to_SCMOBJ)long ___PTRDIFF_T_to_SCMOBJ | |||
4600 | ___P((___PTRDIFF_T x,(long x, long *obj, int arg_num) | |||
4601 | ___SCMOBJ *obj,(long x, long *obj, int arg_num) | |||
4602 | int arg_num),(long x, long *obj, int arg_num) | |||
4603 | (x,(long x, long *obj, int arg_num) | |||
4604 | obj,(long x, long *obj, int arg_num) | |||
4605 | arg_num)(long x, long *obj, int arg_num) | |||
4606 | ___PTRDIFF_T x;(long x, long *obj, int arg_num) | |||
4607 | ___SCMOBJ *obj;(long x, long *obj, int arg_num) | |||
4608 | int arg_num;)(long x, long *obj, int arg_num) | |||
4609 | { | |||
4610 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (___CAST(___LONGLONG,x))((long)(((long long)(x)))), obj, arg_num); | |||
4611 | } | |||
4612 | ||||
4613 | ||||
4614 | /* Convert a C 'short' to a Scheme integer. */ | |||
4615 | ||||
4616 | ___EXP_FUNC(___SCMOBJ,___SHORT_to_SCMOBJ)long ___SHORT_to_SCMOBJ | |||
4617 | ___P((short x,(short x, long *obj, int arg_num) | |||
4618 | ___SCMOBJ *obj,(short x, long *obj, int arg_num) | |||
4619 | int arg_num),(short x, long *obj, int arg_num) | |||
4620 | (x,(short x, long *obj, int arg_num) | |||
4621 | obj,(short x, long *obj, int arg_num) | |||
4622 | arg_num)(short x, long *obj, int arg_num) | |||
4623 | short x;(short x, long *obj, int arg_num) | |||
4624 | ___SCMOBJ *obj;(short x, long *obj, int arg_num) | |||
4625 | int arg_num;)(short x, long *obj, int arg_num) | |||
4626 | { | |||
4627 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (___CAST(___LONGLONG,x))((long)(((long long)(x)))), obj, arg_num); | |||
4628 | } | |||
4629 | ||||
4630 | ||||
4631 | /* Convert a C 'unsigned short' to a Scheme integer. */ | |||
4632 | ||||
4633 | ___EXP_FUNC(___SCMOBJ,___USHORT_to_SCMOBJ)long ___USHORT_to_SCMOBJ | |||
4634 | ___P((unsigned short x,(unsigned short x, long *obj, int arg_num) | |||
4635 | ___SCMOBJ *obj,(unsigned short x, long *obj, int arg_num) | |||
4636 | int arg_num),(unsigned short x, long *obj, int arg_num) | |||
4637 | (x,(unsigned short x, long *obj, int arg_num) | |||
4638 | obj,(unsigned short x, long *obj, int arg_num) | |||
4639 | arg_num)(unsigned short x, long *obj, int arg_num) | |||
4640 | unsigned short x;(unsigned short x, long *obj, int arg_num) | |||
4641 | ___SCMOBJ *obj;(unsigned short x, long *obj, int arg_num) | |||
4642 | int arg_num;)(unsigned short x, long *obj, int arg_num) | |||
4643 | { | |||
4644 | return ___U64_to_SCMOBJ (___U64_from_ULONGLONG (___CAST(___ULONGLONG,x))((unsigned long)(((unsigned long long)(x)))), obj, arg_num); | |||
4645 | } | |||
4646 | ||||
4647 | ||||
4648 | /* Convert a C 'int' to a Scheme integer. */ | |||
4649 | ||||
4650 | ___EXP_FUNC(___SCMOBJ,___INT_to_SCMOBJ)long ___INT_to_SCMOBJ | |||
4651 | ___P((int x,(int x, long *obj, int arg_num) | |||
4652 | ___SCMOBJ *obj,(int x, long *obj, int arg_num) | |||
4653 | int arg_num),(int x, long *obj, int arg_num) | |||
4654 | (x,(int x, long *obj, int arg_num) | |||
4655 | obj,(int x, long *obj, int arg_num) | |||
4656 | arg_num)(int x, long *obj, int arg_num) | |||
4657 | int x;(int x, long *obj, int arg_num) | |||
4658 | ___SCMOBJ *obj;(int x, long *obj, int arg_num) | |||
4659 | int arg_num;)(int x, long *obj, int arg_num) | |||
4660 | { | |||
4661 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (___CAST(___LONGLONG,x))((long)(((long long)(x)))), obj, arg_num); | |||
4662 | } | |||
4663 | ||||
4664 | ||||
4665 | /* Convert a C 'unsigned int' to a Scheme integer. */ | |||
4666 | ||||
4667 | ___EXP_FUNC(___SCMOBJ,___UINT_to_SCMOBJ)long ___UINT_to_SCMOBJ | |||
4668 | ___P((unsigned int x,(unsigned int x, long *obj, int arg_num) | |||
4669 | ___SCMOBJ *obj,(unsigned int x, long *obj, int arg_num) | |||
4670 | int arg_num),(unsigned int x, long *obj, int arg_num) | |||
4671 | (x,(unsigned int x, long *obj, int arg_num) | |||
4672 | obj,(unsigned int x, long *obj, int arg_num) | |||
4673 | arg_num)(unsigned int x, long *obj, int arg_num) | |||
4674 | unsigned int x;(unsigned int x, long *obj, int arg_num) | |||
4675 | ___SCMOBJ *obj;(unsigned int x, long *obj, int arg_num) | |||
4676 | int arg_num;)(unsigned int x, long *obj, int arg_num) | |||
4677 | { | |||
4678 | return ___U64_to_SCMOBJ (___U64_from_ULONGLONG (___CAST(___ULONGLONG,x))((unsigned long)(((unsigned long long)(x)))), obj, arg_num); | |||
4679 | } | |||
4680 | ||||
4681 | ||||
4682 | /* Convert a C 'long' to a Scheme integer. */ | |||
4683 | ||||
4684 | ___EXP_FUNC(___SCMOBJ,___LONG_to_SCMOBJ)long ___LONG_to_SCMOBJ | |||
4685 | ___P((long x,(long x, long *obj, int arg_num) | |||
4686 | ___SCMOBJ *obj,(long x, long *obj, int arg_num) | |||
4687 | int arg_num),(long x, long *obj, int arg_num) | |||
4688 | (x,(long x, long *obj, int arg_num) | |||
4689 | obj,(long x, long *obj, int arg_num) | |||
4690 | arg_num)(long x, long *obj, int arg_num) | |||
4691 | long x;(long x, long *obj, int arg_num) | |||
4692 | ___SCMOBJ *obj;(long x, long *obj, int arg_num) | |||
4693 | int arg_num;)(long x, long *obj, int arg_num) | |||
4694 | { | |||
4695 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (___CAST(___LONGLONG,x))((long)(((long long)(x)))), obj, arg_num); | |||
4696 | } | |||
4697 | ||||
4698 | ||||
4699 | /* Convert a C 'unsigned long' to a Scheme integer. */ | |||
4700 | ||||
4701 | ___EXP_FUNC(___SCMOBJ,___ULONG_to_SCMOBJ)long ___ULONG_to_SCMOBJ | |||
4702 | ___P((unsigned long x,(unsigned long x, long *obj, int arg_num) | |||
4703 | ___SCMOBJ *obj,(unsigned long x, long *obj, int arg_num) | |||
4704 | int arg_num),(unsigned long x, long *obj, int arg_num) | |||
4705 | (x,(unsigned long x, long *obj, int arg_num) | |||
4706 | obj,(unsigned long x, long *obj, int arg_num) | |||
4707 | arg_num)(unsigned long x, long *obj, int arg_num) | |||
4708 | unsigned long x;(unsigned long x, long *obj, int arg_num) | |||
4709 | ___SCMOBJ *obj;(unsigned long x, long *obj, int arg_num) | |||
4710 | int arg_num;)(unsigned long x, long *obj, int arg_num) | |||
4711 | { | |||
4712 | return ___U64_to_SCMOBJ (___U64_from_ULONGLONG (___CAST(___ULONGLONG,x))((unsigned long)(((unsigned long long)(x)))), obj, arg_num); | |||
4713 | } | |||
4714 | ||||
4715 | ||||
4716 | /* Convert a C 'long long' to a Scheme integer. */ | |||
4717 | ||||
4718 | ___EXP_FUNC(___SCMOBJ,___LONGLONG_to_SCMOBJ)long ___LONGLONG_to_SCMOBJ | |||
4719 | ___P((___LONGLONG x,(long long x, long *obj, int arg_num) | |||
4720 | ___SCMOBJ *obj,(long long x, long *obj, int arg_num) | |||
4721 | int arg_num),(long long x, long *obj, int arg_num) | |||
4722 | (x,(long long x, long *obj, int arg_num) | |||
4723 | obj,(long long x, long *obj, int arg_num) | |||
4724 | arg_num)(long long x, long *obj, int arg_num) | |||
4725 | ___LONGLONG x;(long long x, long *obj, int arg_num) | |||
4726 | ___SCMOBJ *obj;(long long x, long *obj, int arg_num) | |||
4727 | int arg_num;)(long long x, long *obj, int arg_num) | |||
4728 | { | |||
4729 | return ___S64_to_SCMOBJ (___S64_from_LONGLONG (x)((long)(x)), obj, arg_num); | |||
4730 | } | |||
4731 | ||||
4732 | ||||
4733 | /* Convert a C 'unsigned long long' to a Scheme integer. */ | |||
4734 | ||||
4735 | ___EXP_FUNC(___SCMOBJ,___ULONGLONG_to_SCMOBJ)long ___ULONGLONG_to_SCMOBJ | |||
4736 | ___P((___ULONGLONG x,(unsigned long long x, long *obj, int arg_num) | |||
4737 | ___SCMOBJ *obj,(unsigned long long x, long *obj, int arg_num) | |||
4738 | int arg_num),(unsigned long long x, long *obj, int arg_num) | |||
4739 | (x,(unsigned long long x, long *obj, int arg_num) | |||
4740 | obj,(unsigned long long x, long *obj, int arg_num) | |||
4741 | arg_num)(unsigned long long x, long *obj, int arg_num) | |||
4742 | ___ULONGLONG x;(unsigned long long x, long *obj, int arg_num) | |||
4743 | ___SCMOBJ *obj;(unsigned long long x, long *obj, int arg_num) | |||
4744 | int arg_num;)(unsigned long long x, long *obj, int arg_num) | |||
4745 | { | |||
4746 | return ___U64_to_SCMOBJ (___U64_from_ULONGLONG (x)((unsigned long)(x)), obj, arg_num); | |||
4747 | } | |||
4748 | ||||
4749 | ||||
4750 | /* Convert a C 'float' to a Scheme flonum. */ | |||
4751 | ||||
4752 | ___EXP_FUNC(___SCMOBJ,___FLOAT_to_SCMOBJ)long ___FLOAT_to_SCMOBJ | |||
4753 | ___P((float x,(float x, long *obj, int arg_num) | |||
4754 | ___SCMOBJ *obj,(float x, long *obj, int arg_num) | |||
4755 | int arg_num),(float x, long *obj, int arg_num) | |||
4756 | (x,(float x, long *obj, int arg_num) | |||
4757 | obj,(float x, long *obj, int arg_num) | |||
4758 | arg_num)(float x, long *obj, int arg_num) | |||
4759 | float x;(float x, long *obj, int arg_num) | |||
4760 | ___SCMOBJ *obj;(float x, long *obj, int arg_num) | |||
4761 | int arg_num;)(float x, long *obj, int arg_num) | |||
4762 | { | |||
4763 | return ___F64_to_SCMOBJ (___CAST(___F64,x)((double)(x)), obj, arg_num); | |||
4764 | } | |||
4765 | ||||
4766 | ||||
4767 | /* Convert a C 'double' to a Scheme flonum. */ | |||
4768 | ||||
4769 | ___EXP_FUNC(___SCMOBJ,___DOUBLE_to_SCMOBJ)long ___DOUBLE_to_SCMOBJ | |||
4770 | ___P((double x,(double x, long *obj, int arg_num) | |||
4771 | ___SCMOBJ *obj,(double x, long *obj, int arg_num) | |||
4772 | int arg_num),(double x, long *obj, int arg_num) | |||
4773 | (x,(double x, long *obj, int arg_num) | |||
4774 | obj,(double x, long *obj, int arg_num) | |||
4775 | arg_num)(double x, long *obj, int arg_num) | |||
4776 | double x;(double x, long *obj, int arg_num) | |||
4777 | ___SCMOBJ *obj;(double x, long *obj, int arg_num) | |||
4778 | int arg_num;)(double x, long *obj, int arg_num) | |||
4779 | { | |||
4780 | return ___F64_to_SCMOBJ (___CAST(___F64,x)((double)(x)), obj, arg_num); | |||
4781 | } | |||
4782 | ||||
4783 | ||||
4784 | /* Convert a C pointer to a Scheme foreign object. */ | |||
4785 | ||||
4786 | ___EXP_FUNC(___SCMOBJ,___POINTER_to_SCMOBJ)long ___POINTER_to_SCMOBJ | |||
4787 | ___P((void *x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4788 | ___SCMOBJ tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4789 | ___SCMOBJ (*release_fn) ___P((void *ptr),()),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4790 | ___SCMOBJ *obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4791 | int arg_num),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4792 | (x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4793 | tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4794 | release_fn,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4795 | obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4796 | arg_num)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4797 | void *x;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4798 | ___SCMOBJ tags;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4799 | ___SCMOBJ (*release_fn) ___P((void *ptr),());(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4800 | ___SCMOBJ *obj;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4801 | int arg_num;)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4802 | { | |||
4803 | if (x == 0) | |||
4804 | *obj = ___FAL((((long)(-1))<<2)+2); /* #f counts as NULL */ | |||
4805 | else | |||
4806 | { | |||
4807 | ___SCMOBJlong r = ___alloc_scmobj (___sFOREIGN18, | |||
4808 | ___FOREIGN_SIZE3<<___LWS3, | |||
4809 | ___STILL5); | |||
4810 | if (___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) | |||
4811 | { | |||
4812 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4813 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
4814 | } | |||
4815 | ___FIELD(r,___FOREIGN_TAGS)(*((((long*)((r)-(1)))+1)+0)) = tags; | |||
4816 | ___FIELD(r,___FOREIGN_RELEASE_FN)(*((((long*)((r)-(1)))+1)+1)) = ___CAST(___SCMOBJ,release_fn)((long)(release_fn)); | |||
4817 | ___FIELD(r,___FOREIGN_PTR)(*((((long*)((r)-(1)))+1)+2)) = ___CAST(___SCMOBJ,x)((long)(x)); | |||
4818 | *obj = r; | |||
4819 | } | |||
4820 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4821 | } | |||
4822 | ||||
4823 | ||||
4824 | /* Convert a nonnull C pointer to a Scheme foreign object. */ | |||
4825 | ||||
4826 | ___EXP_FUNC(___SCMOBJ,___NONNULLPOINTER_to_SCMOBJ)long ___NONNULLPOINTER_to_SCMOBJ | |||
4827 | ___P((void *x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4828 | ___SCMOBJ tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4829 | ___SCMOBJ (*release_fn) ___P((void *ptr),()),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4830 | ___SCMOBJ *obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4831 | int arg_num),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4832 | (x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4833 | tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4834 | release_fn,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4835 | obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4836 | arg_num)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4837 | void *x;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4838 | ___SCMOBJ tags;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4839 | ___SCMOBJ (*release_fn) ___P((void *ptr),());(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4840 | ___SCMOBJ *obj;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4841 | int arg_num;)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4842 | { | |||
4843 | if (x == 0) | |||
4844 | { | |||
4845 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4846 | return ___FIX(___CTOS_NONNULLPOINTER_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(99<<7))+arg_num))<<2); | |||
4847 | } | |||
4848 | return ___POINTER_to_SCMOBJ (x, tags, release_fn, obj, arg_num); | |||
4849 | } | |||
4850 | ||||
4851 | ||||
4852 | /* Convert a C function to a Scheme procedure. */ | |||
4853 | ||||
4854 | ___EXP_FUNC(___SCMOBJ,___FUNCTION_to_SCMOBJ)long ___FUNCTION_to_SCMOBJ | |||
4855 | ___P((void *x,(void *x, long *obj, int arg_num) | |||
4856 | ___SCMOBJ *obj,(void *x, long *obj, int arg_num) | |||
4857 | int arg_num),(void *x, long *obj, int arg_num) | |||
4858 | (x,(void *x, long *obj, int arg_num) | |||
4859 | obj,(void *x, long *obj, int arg_num) | |||
4860 | arg_num)(void *x, long *obj, int arg_num) | |||
4861 | void *x;(void *x, long *obj, int arg_num) | |||
4862 | ___SCMOBJ *obj;(void *x, long *obj, int arg_num) | |||
4863 | int arg_num;)(void *x, long *obj, int arg_num) | |||
4864 | { | |||
4865 | if (x == 0) | |||
4866 | { | |||
4867 | *obj = ___FAL((((long)(-1))<<2)+2); /* #f counts as NULL */ | |||
4868 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
4869 | } | |||
4870 | /* | |||
4871 | * At present, arbitrary C functions cannot be converted to Scheme | |||
4872 | * functions. | |||
4873 | */ | |||
4874 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4875 | return ___FIX(___CTOS_FUNCTION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(100<<7))+arg_num))<<2); | |||
4876 | } | |||
4877 | ||||
4878 | ||||
4879 | /* Convert a nonnull C function to a Scheme procedure. */ | |||
4880 | ||||
4881 | ___EXP_FUNC(___SCMOBJ,___NONNULLFUNCTION_to_SCMOBJ)long ___NONNULLFUNCTION_to_SCMOBJ | |||
4882 | ___P((void *x,(void *x, long *obj, int arg_num) | |||
4883 | ___SCMOBJ *obj,(void *x, long *obj, int arg_num) | |||
4884 | int arg_num),(void *x, long *obj, int arg_num) | |||
4885 | (x,(void *x, long *obj, int arg_num) | |||
4886 | obj,(void *x, long *obj, int arg_num) | |||
4887 | arg_num)(void *x, long *obj, int arg_num) | |||
4888 | void *x;(void *x, long *obj, int arg_num) | |||
4889 | ___SCMOBJ *obj;(void *x, long *obj, int arg_num) | |||
4890 | int arg_num;)(void *x, long *obj, int arg_num) | |||
4891 | { | |||
4892 | if (x == 0) | |||
4893 | { | |||
4894 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4895 | return ___FIX(___CTOS_NONNULLFUNCTION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(101<<7))+arg_num))<<2); | |||
4896 | } | |||
4897 | return ___FUNCTION_to_SCMOBJ (x, obj, arg_num); | |||
4898 | } | |||
4899 | ||||
4900 | ||||
4901 | /* Convert a C struct pointer to a Scheme foreign object. */ | |||
4902 | ||||
4903 | ___EXP_FUNC(___SCMOBJ,___STRUCT_to_SCMOBJ)long ___STRUCT_to_SCMOBJ | |||
4904 | ___P((void *x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4905 | ___SCMOBJ tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4906 | ___SCMOBJ (*release_fn) ___P((void *ptr),()),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4907 | ___SCMOBJ *obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4908 | int arg_num),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4909 | (x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4910 | tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4911 | release_fn,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4912 | obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4913 | arg_num)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4914 | void *x;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4915 | ___SCMOBJ tags;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4916 | ___SCMOBJ (*release_fn) ___P((void *ptr),());(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4917 | ___SCMOBJ *obj;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4918 | int arg_num;)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4919 | { | |||
4920 | ___SCMOBJlong e; | |||
4921 | if (x == 0) | |||
4922 | { | |||
4923 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4924 | e = ___FIX(___CTOS_STRUCT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(95<<7))+arg_num))<<2); | |||
4925 | } | |||
4926 | else if ((e = ___POINTER_to_SCMOBJ (x, tags, release_fn, obj, arg_num)) | |||
4927 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
4928 | release_fn (x); | |||
4929 | return e; | |||
4930 | } | |||
4931 | ||||
4932 | ||||
4933 | /* Convert a C union pointer to a Scheme foreign object. */ | |||
4934 | ||||
4935 | ___EXP_FUNC(___SCMOBJ,___UNION_to_SCMOBJ)long ___UNION_to_SCMOBJ | |||
4936 | ___P((void *x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4937 | ___SCMOBJ tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4938 | ___SCMOBJ (*release_fn) ___P((void *ptr),()),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4939 | ___SCMOBJ *obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4940 | int arg_num),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4941 | (x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4942 | tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4943 | release_fn,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4944 | obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4945 | arg_num)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4946 | void *x;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4947 | ___SCMOBJ tags;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4948 | ___SCMOBJ (*release_fn) ___P((void *ptr),());(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4949 | ___SCMOBJ *obj;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4950 | int arg_num;)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4951 | { | |||
4952 | ___SCMOBJlong e; | |||
4953 | if (x == 0) | |||
4954 | { | |||
4955 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4956 | e = ___FIX(___CTOS_UNION_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(96<<7))+arg_num))<<2); | |||
4957 | } | |||
4958 | else if ((e = ___POINTER_to_SCMOBJ (x, tags, release_fn, obj, arg_num)) | |||
4959 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
4960 | release_fn (x); | |||
4961 | return e; | |||
4962 | } | |||
4963 | ||||
4964 | ||||
4965 | /* Convert a C type pointer to a Scheme foreign object. */ | |||
4966 | ||||
4967 | ___EXP_FUNC(___SCMOBJ,___TYPE_to_SCMOBJ)long ___TYPE_to_SCMOBJ | |||
4968 | ___P((void *x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4969 | ___SCMOBJ tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4970 | ___SCMOBJ (*release_fn) ___P((void *ptr),()),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4971 | ___SCMOBJ *obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4972 | int arg_num),(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4973 | (x,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4974 | tags,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4975 | release_fn,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4976 | obj,(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4977 | arg_num)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4978 | void *x;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4979 | ___SCMOBJ tags;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4980 | ___SCMOBJ (*release_fn) ___P((void *ptr),());(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4981 | ___SCMOBJ *obj;(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4982 | int arg_num;)(void *x, long tags, long (*release_fn) (void *ptr), long *obj , int arg_num) | |||
4983 | { | |||
4984 | ___SCMOBJlong e; | |||
4985 | if (x == 0) | |||
4986 | { | |||
4987 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
4988 | e = ___FIX(___CTOS_TYPE_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(97<<7))+arg_num))<<2); | |||
4989 | } | |||
4990 | else if ((e = ___POINTER_to_SCMOBJ (x, tags, release_fn, obj, arg_num)) | |||
4991 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
4992 | release_fn (x); | |||
4993 | return e; | |||
4994 | } | |||
4995 | ||||
4996 | ||||
4997 | /* Convert a C extended boolean to a Scheme boolean. */ | |||
4998 | ||||
4999 | ___EXP_FUNC(___SCMOBJ,___BOOL_to_SCMOBJ)long ___BOOL_to_SCMOBJ | |||
5000 | ___P((___BOOL x,(int x, long *obj, int arg_num) | |||
5001 | ___SCMOBJ *obj,(int x, long *obj, int arg_num) | |||
5002 | int arg_num),(int x, long *obj, int arg_num) | |||
5003 | (x,(int x, long *obj, int arg_num) | |||
5004 | obj,(int x, long *obj, int arg_num) | |||
5005 | arg_num)(int x, long *obj, int arg_num) | |||
5006 | ___BOOL x;(int x, long *obj, int arg_num) | |||
5007 | ___SCMOBJ *obj;(int x, long *obj, int arg_num) | |||
5008 | int arg_num;)(int x, long *obj, int arg_num) | |||
5009 | { | |||
5010 | *obj = x ? ___TRU((((long)(-2))<<2)+2) : ___FAL((((long)(-1))<<2)+2); | |||
5011 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
5012 | } | |||
5013 | ||||
5014 | ||||
5015 | /* Convert a nonnull C string to a Scheme string. */ | |||
5016 | ||||
5017 | ___EXP_FUNC(___SCMOBJ,___NONNULLSTRING_to_SCMOBJ)long ___NONNULLSTRING_to_SCMOBJ | |||
5018 | ___P((void *x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5019 | ___SCMOBJ *obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5020 | int arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5021 | int char_encoding),(void *x, long *obj, int arg_num, int char_encoding) | |||
5022 | (x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5023 | obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5024 | arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5025 | char_encoding)(void *x, long *obj, int arg_num, int char_encoding) | |||
5026 | void *x;(void *x, long *obj, int arg_num, int char_encoding) | |||
5027 | ___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding) | |||
5028 | int arg_num;(void *x, long *obj, int arg_num, int char_encoding) | |||
5029 | int char_encoding;)(void *x, long *obj, int arg_num, int char_encoding) | |||
5030 | { | |||
5031 | int kind = arg_num < 0 ? ___PERM6 : ___STILL5; | |||
5032 | ___SCMOBJlong result = ___FAL((((long)(-1))<<2)+2); | |||
5033 | ___SIZE_Tunsigned long i, n = 0; | |||
5034 | ||||
5035 | if (x == 0) | |||
5036 | return err_code_from_char_encoding (char_encoding, 1, 1, arg_num); | |||
5037 | ||||
5038 | switch (char_encoding) | |||
5039 | { | |||
5040 | case ___CHAR_ENCODING_ISO_8859_1(2<<0): | |||
5041 | { | |||
5042 | ___ISO_8859_1STRINGunsigned char* str = ___CAST(___ISO_8859_1STRING,x)((unsigned char*)(x)); | |||
5043 | ||||
5044 | while (str[n] != 0) | |||
5045 | n++; | |||
5046 | ||||
5047 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5048 | ||||
5049 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5050 | result = ___FAL((((long)(-1))<<2)+2); | |||
5051 | else | |||
5052 | { | |||
5053 | for (i=0; i<n; i++) | |||
5054 | { | |||
5055 | /* | |||
5056 | * No error possible because a ISO-8859-1 character | |||
5057 | * always fits in a Scheme character. | |||
5058 | */ | |||
5059 | ___UCS_4unsigned int c = str[i]; | |||
5060 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5061 | } | |||
5062 | } | |||
5063 | ||||
5064 | break; | |||
5065 | } | |||
5066 | ||||
5067 | case ___CHAR_ENCODING_UTF_8(3<<0): | |||
5068 | { | |||
5069 | ___UTF_8STRINGchar* str = ___CAST(___UTF_8STRING,x)((char*)(x)); | |||
5070 | ___UTF_8STRINGchar* p = str; | |||
5071 | ||||
5072 | while (___UTF_8_get (&p) != 0) /* advance until end or error */ | |||
5073 | n++; | |||
5074 | ||||
5075 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5076 | ||||
5077 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5078 | result = ___FAL((((long)(-1))<<2)+2); | |||
5079 | else | |||
5080 | { | |||
5081 | p = str; | |||
5082 | ||||
5083 | for (i=0; i<n; i++) | |||
5084 | { | |||
5085 | ___UTF_8STRINGchar* start = p; | |||
5086 | ___UCS_4unsigned int c = ___UTF_8_get (&p); | |||
5087 | if (p == start || c > ___MAX_CHR0x10ffff) | |||
5088 | { | |||
5089 | ___release_scmobj (result); | |||
5090 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5091 | return ___FIX(___CTOS_NONNULLUTF_8STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(110<<7))+arg_num))<<2); | |||
5092 | } | |||
5093 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5094 | } | |||
5095 | } | |||
5096 | ||||
5097 | break; | |||
5098 | } | |||
5099 | ||||
5100 | case ___CHAR_ENCODING_UTF_16(4<<0): | |||
5101 | { | |||
5102 | ___UTF_16STRINGunsigned short* str = ___CAST(___UTF_16STRING,x)((unsigned short*)(x)); | |||
5103 | ___UTF_16STRINGunsigned short* p = str; | |||
5104 | ||||
5105 | for (;;) | |||
5106 | { | |||
5107 | ___UCS_4unsigned int c = *p++; | |||
5108 | if (c == 0) | |||
5109 | break; | |||
5110 | if (c > 0xd7ff && c <= 0xdfff) | |||
5111 | { | |||
5112 | if (c > 0xdbff) | |||
5113 | return ___FIX(___CTOS_NONNULLUTF_16STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(113<<7))+arg_num))<<2); | |||
5114 | c = *p++; | |||
5115 | if (c <= 0xdbff || c > 0xdfff) | |||
5116 | return ___FIX(___CTOS_NONNULLUTF_16STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(113<<7))+arg_num))<<2); | |||
5117 | } | |||
5118 | n++; | |||
5119 | } | |||
5120 | ||||
5121 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5122 | ||||
5123 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5124 | result = ___FAL((((long)(-1))<<2)+2); | |||
5125 | else | |||
5126 | { | |||
5127 | p = str; | |||
5128 | ||||
5129 | for (i=0; i<n; i++) | |||
5130 | { | |||
5131 | ___UCS_4unsigned int c = *p++; | |||
5132 | if (c > 0xd7ff && c <= 0xdfff) | |||
5133 | c = (c << 10) + *p++ - | |||
5134 | ((0xd800 << 10) + 0xdc00 - 0x10000); | |||
5135 | if (c > ___MAX_CHR0x10ffff) | |||
5136 | { | |||
5137 | ___release_scmobj (result); | |||
5138 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5139 | return ___FIX(___CTOS_NONNULLUTF_16STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(113<<7))+arg_num))<<2); | |||
5140 | } | |||
5141 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5142 | } | |||
5143 | } | |||
5144 | ||||
5145 | break; | |||
5146 | } | |||
5147 | ||||
5148 | case ___CHAR_ENCODING_UCS_2(13<<0): | |||
5149 | { | |||
5150 | ___UCS_2STRINGunsigned short* str = ___CAST(___UCS_2STRING,x)((unsigned short*)(x)); | |||
5151 | ||||
5152 | while (str[n] != 0) | |||
5153 | n++; | |||
5154 | ||||
5155 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5156 | ||||
5157 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5158 | result = ___FAL((((long)(-1))<<2)+2); | |||
5159 | else | |||
5160 | { | |||
5161 | for (i=0; i<n; i++) | |||
5162 | { | |||
5163 | ___UCS_4unsigned int c = str[i]; | |||
5164 | if (c > ___MAX_CHR0x10ffff) | |||
5165 | { | |||
5166 | ___release_scmobj (result); | |||
5167 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5168 | return ___FIX(___CTOS_NONNULLUCS_2STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(116<<7))+arg_num))<<2); | |||
5169 | } | |||
5170 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5171 | } | |||
5172 | } | |||
5173 | ||||
5174 | break; | |||
5175 | } | |||
5176 | ||||
5177 | case ___CHAR_ENCODING_UCS_4(16<<0): | |||
5178 | { | |||
5179 | ___UCS_4STRINGunsigned int* str = ___CAST(___UCS_4STRING,x)((unsigned int*)(x)); | |||
5180 | ||||
5181 | while (str[n] != 0) | |||
5182 | n++; | |||
5183 | ||||
5184 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5185 | ||||
5186 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5187 | result = ___FAL((((long)(-1))<<2)+2); | |||
5188 | else | |||
5189 | { | |||
5190 | for (i=0; i<n; i++) | |||
5191 | { | |||
5192 | ___UCS_4unsigned int c = str[i]; | |||
5193 | if (c > ___MAX_CHR0x10ffff) | |||
5194 | { | |||
5195 | ___release_scmobj (result); | |||
5196 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5197 | return ___FIX(___CTOS_NONNULLUCS_4STRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(119<<7))+arg_num))<<2); | |||
5198 | } | |||
5199 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5200 | } | |||
5201 | } | |||
5202 | ||||
5203 | break; | |||
5204 | } | |||
5205 | ||||
5206 | case ___CHAR_ENCODING_WCHAR(19<<0): | |||
5207 | { | |||
5208 | ___WCHARSTRINGwchar_t* str = ___CAST(___WCHARSTRING,x)((wchar_t*)(x)); | |||
5209 | ||||
5210 | while (str[n] != 0) | |||
5211 | n++; | |||
5212 | ||||
5213 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5214 | ||||
5215 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5216 | result = ___FAL((((long)(-1))<<2)+2); | |||
5217 | else | |||
5218 | { | |||
5219 | for (i=0; i<n; i++) | |||
5220 | { | |||
5221 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 | |||
5222 | ___SM32int c = ___CAST(___SM32,str[i])((int)(str[i])); | |||
5223 | #else | |||
5224 | ___UM32unsigned int c = ___CAST(___UM32,str[i])((unsigned int)(str[i])); | |||
5225 | #endif | |||
5226 | ||||
5227 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 || ___WCHAR_MAX2147483647 > ___MAX_CHR0x10ffff | |||
5228 | #if ___WCHAR_MIN(-2147483647 - 1) < 0 | |||
5229 | #if ___WCHAR_MAX2147483647 > ___MAX_CHR0x10ffff | |||
5230 | if (c < 0 || c > ___MAX_CHR0x10ffff) | |||
5231 | #else | |||
5232 | if (c < 0) | |||
5233 | #endif | |||
5234 | #else | |||
5235 | if (c > ___MAX_CHR0x10ffff) | |||
5236 | #endif | |||
5237 | { | |||
5238 | ___release_scmobj (result); | |||
5239 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5240 | return ___FIX(___CTOS_NONNULLWCHARSTRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(122<<7))+arg_num))<<2); | |||
5241 | } | |||
5242 | #endif | |||
5243 | ||||
5244 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5245 | } | |||
5246 | } | |||
5247 | ||||
5248 | break; | |||
5249 | } | |||
5250 | ||||
5251 | case ___CHAR_ENCODING_NATIVE(20<<0): | |||
5252 | { | |||
5253 | char *str = ___CAST(char*,x)((char*)(x)); | |||
5254 | ||||
5255 | while (str[n] != 0) | |||
5256 | n++; | |||
5257 | ||||
5258 | result = ___alloc_scmobj (___sSTRING19, n<<___LCS2, kind); | |||
5259 | ||||
5260 | if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0))) | |||
5261 | result = ___FAL((((long)(-1))<<2)+2); | |||
5262 | else | |||
5263 | { | |||
5264 | for (i=0; i<n; i++) | |||
5265 | { | |||
5266 | ___UCS_4unsigned int c = uchar_to_UCS_4 (___CAST(unsigned char,str[i]))((unsigned char)(str[i])); | |||
5267 | if (c > ___MAX_CHR0x10ffff) | |||
5268 | { | |||
5269 | ___release_scmobj (result); | |||
5270 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5271 | return ___FIX(___CTOS_NONNULLCHARSTRING_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(104<<7))+arg_num))<<2); | |||
5272 | } | |||
5273 | ___STRINGSET(result,___FIX(i),___CHR(c))*(((unsigned int*)((((long*)((result)-(1)))+1)))+(((((long)(i ))<<2))>>2)) = (((((((long)(((unsigned int)(c)))) <<2)+2))>>2)); | |||
5274 | } | |||
5275 | } | |||
5276 | ||||
5277 | break; | |||
5278 | } | |||
5279 | ||||
5280 | default: | |||
5281 | return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2); | |||
5282 | } | |||
5283 | ||||
5284 | *obj = result; | |||
5285 | ||||
5286 | if (result == ___FAL((((long)(-1))<<2)+2)) | |||
5287 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
5288 | ||||
5289 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
5290 | } | |||
5291 | ||||
5292 | ||||
5293 | /* Convert a nonnull C string to a Scheme string. */ | |||
5294 | ||||
5295 | ___EXP_FUNC(___SCMOBJ,___STRING_to_SCMOBJ)long ___STRING_to_SCMOBJ | |||
5296 | ___P((void *x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5297 | ___SCMOBJ *obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5298 | int arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5299 | int char_encoding),(void *x, long *obj, int arg_num, int char_encoding) | |||
5300 | (x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5301 | obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5302 | arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5303 | char_encoding)(void *x, long *obj, int arg_num, int char_encoding) | |||
5304 | void *x;(void *x, long *obj, int arg_num, int char_encoding) | |||
5305 | ___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding) | |||
5306 | int arg_num;(void *x, long *obj, int arg_num, int char_encoding) | |||
5307 | int char_encoding;)(void *x, long *obj, int arg_num, int char_encoding) | |||
5308 | { | |||
5309 | ___SCMOBJlong e; | |||
5310 | ||||
5311 | if (x == 0) | |||
5312 | { | |||
5313 | *obj = ___FAL((((long)(-1))<<2)+2); /* #f counts as NULL */ | |||
5314 | e = ___FIX(___NO_ERR)(((long)(0))<<2); | |||
5315 | } | |||
5316 | else if ((e = ___NONNULLSTRING_to_SCMOBJ | |||
5317 | (x, | |||
5318 | obj, | |||
5319 | arg_num, | |||
5320 | char_encoding)) | |||
5321 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
5322 | { | |||
5323 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5324 | if (e == err_code_from_char_encoding (char_encoding, 1, 1, arg_num)) | |||
5325 | e = err_code_from_char_encoding (char_encoding, 1, 0, arg_num); | |||
5326 | } | |||
5327 | ||||
5328 | return e; | |||
5329 | } | |||
5330 | ||||
5331 | ||||
5332 | /* Convert a nonnull C string list to a Scheme string list. */ | |||
5333 | ||||
5334 | ___EXP_FUNC(___SCMOBJ,___NONNULLSTRINGLIST_to_SCMOBJ)long ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5335 | ___P((void *x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5336 | ___SCMOBJ *obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5337 | int arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5338 | int char_encoding),(void *x, long *obj, int arg_num, int char_encoding) | |||
5339 | (x,(void *x, long *obj, int arg_num, int char_encoding) | |||
5340 | obj,(void *x, long *obj, int arg_num, int char_encoding) | |||
5341 | arg_num,(void *x, long *obj, int arg_num, int char_encoding) | |||
5342 | char_encoding)(void *x, long *obj, int arg_num, int char_encoding) | |||
5343 | void *x;(void *x, long *obj, int arg_num, int char_encoding) | |||
5344 | ___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding) | |||
5345 | int arg_num;(void *x, long *obj, int arg_num, int char_encoding) | |||
5346 | int char_encoding;)(void *x, long *obj, int arg_num, int char_encoding) | |||
5347 | { | |||
5348 | ___SCMOBJlong lst; | |||
5349 | void **string_list = ___CAST(void**,x)((void**)(x)); | |||
5350 | int i; | |||
5351 | ||||
5352 | if (string_list == 0) | |||
5353 | return err_code_from_char_encoding (char_encoding, 1, 2, arg_num); | |||
5354 | ||||
5355 | i = 0; | |||
5356 | ||||
5357 | while (string_list[i] != 0) | |||
5358 | i++; | |||
5359 | ||||
5360 | lst = ___NUL((((long)(-3))<<2)+2); | |||
5361 | ||||
5362 | while (i-- > 0) | |||
5363 | { | |||
5364 | ___SCMOBJlong e; | |||
5365 | ___SCMOBJlong str; | |||
5366 | ___SCMOBJlong pair; | |||
5367 | ||||
5368 | if ((e = ___NONNULLSTRING_to_SCMOBJ | |||
5369 | (string_list[i], | |||
5370 | &str, | |||
5371 | arg_num, | |||
5372 | char_encoding)) | |||
5373 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
5374 | { | |||
5375 | ___release_scmobj (lst); | |||
5376 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5377 | if (e == err_code_from_char_encoding (char_encoding, 1, 1, arg_num)) | |||
5378 | e = err_code_from_char_encoding (char_encoding, 1, 2, arg_num); | |||
5379 | return e; | |||
5380 | } | |||
5381 | ||||
5382 | pair = ___make_pair (str, lst, ___STILL5); | |||
5383 | ||||
5384 | ___release_scmobj (str); | |||
5385 | ___release_scmobj (lst); | |||
5386 | ||||
5387 | if (___FIXNUMP(pair)(((pair)&((1<<2)-1))==(0))) | |||
5388 | { | |||
5389 | *obj = ___FAL((((long)(-1))<<2)+2); | |||
5390 | return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(125<<7))+arg_num))<<2); | |||
5391 | } | |||
5392 | ||||
5393 | lst = pair; | |||
5394 | } | |||
5395 | ||||
5396 | *obj = lst; | |||
5397 | ||||
5398 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
5399 | } | |||
5400 | ||||
5401 | ||||
5402 | /* Convert a C 'char *' to a Scheme string. */ | |||
5403 | ||||
5404 | ___EXP_FUNC(___SCMOBJ,___CHARSTRING_to_SCMOBJ)long ___CHARSTRING_to_SCMOBJ | |||
5405 | ___P((char *x,(char *x, long *obj, int arg_num) | |||
5406 | ___SCMOBJ *obj,(char *x, long *obj, int arg_num) | |||
5407 | int arg_num),(char *x, long *obj, int arg_num) | |||
5408 | (x,(char *x, long *obj, int arg_num) | |||
5409 | obj,(char *x, long *obj, int arg_num) | |||
5410 | arg_num)(char *x, long *obj, int arg_num) | |||
5411 | char *x;(char *x, long *obj, int arg_num) | |||
5412 | ___SCMOBJ *obj;(char *x, long *obj, int arg_num) | |||
5413 | int arg_num;)(char *x, long *obj, int arg_num) | |||
5414 | { | |||
5415 | return ___STRING_to_SCMOBJ | |||
5416 | (x, | |||
5417 | obj, | |||
5418 | arg_num, | |||
5419 | ___CHAR_ENCODING_NATIVE(20<<0)); | |||
5420 | } | |||
5421 | ||||
5422 | ||||
5423 | /* Convert a nonnull C 'char *' to a Scheme string. */ | |||
5424 | ||||
5425 | ___EXP_FUNC(___SCMOBJ,___NONNULLCHARSTRING_to_SCMOBJ)long ___NONNULLCHARSTRING_to_SCMOBJ | |||
5426 | ___P((char *x,(char *x, long *obj, int arg_num) | |||
5427 | ___SCMOBJ *obj,(char *x, long *obj, int arg_num) | |||
5428 | int arg_num),(char *x, long *obj, int arg_num) | |||
5429 | (x,(char *x, long *obj, int arg_num) | |||
5430 | obj,(char *x, long *obj, int arg_num) | |||
5431 | arg_num)(char *x, long *obj, int arg_num) | |||
5432 | char *x;(char *x, long *obj, int arg_num) | |||
5433 | ___SCMOBJ *obj;(char *x, long *obj, int arg_num) | |||
5434 | int arg_num;)(char *x, long *obj, int arg_num) | |||
5435 | { | |||
5436 | return ___NONNULLSTRING_to_SCMOBJ | |||
5437 | (x, | |||
5438 | obj, | |||
5439 | arg_num, | |||
5440 | ___CHAR_ENCODING_NATIVE(20<<0)); | |||
5441 | } | |||
5442 | ||||
5443 | ||||
5444 | /* Convert a nonnull C 'char *' list to a Scheme list of strings. */ | |||
5445 | ||||
5446 | ___EXP_FUNC(___SCMOBJ,___NONNULLCHARSTRINGLIST_to_SCMOBJ)long ___NONNULLCHARSTRINGLIST_to_SCMOBJ | |||
5447 | ___P((char **x,(char **x, long *obj, int arg_num) | |||
5448 | ___SCMOBJ *obj,(char **x, long *obj, int arg_num) | |||
5449 | int arg_num),(char **x, long *obj, int arg_num) | |||
5450 | (x,(char **x, long *obj, int arg_num) | |||
5451 | obj,(char **x, long *obj, int arg_num) | |||
5452 | arg_num)(char **x, long *obj, int arg_num) | |||
5453 | char **x;(char **x, long *obj, int arg_num) | |||
5454 | ___SCMOBJ *obj;(char **x, long *obj, int arg_num) | |||
5455 | int arg_num;)(char **x, long *obj, int arg_num) | |||
5456 | { | |||
5457 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5458 | (___CAST(void*,x)((void*)(x)), | |||
5459 | obj, | |||
5460 | arg_num, | |||
5461 | ___CHAR_ENCODING_NATIVE(20<<0)); | |||
5462 | } | |||
5463 | ||||
5464 | ||||
5465 | /* Convert a C ISO-8859-1 encoded character string to a Scheme string. */ | |||
5466 | ||||
5467 | ___EXP_FUNC(___SCMOBJ,___ISO_8859_1STRING_to_SCMOBJ)long ___ISO_8859_1STRING_to_SCMOBJ | |||
5468 | ___P((___ISO_8859_1STRING x,(unsigned char* x, long *obj, int arg_num) | |||
5469 | ___SCMOBJ *obj,(unsigned char* x, long *obj, int arg_num) | |||
5470 | int arg_num),(unsigned char* x, long *obj, int arg_num) | |||
5471 | (x,(unsigned char* x, long *obj, int arg_num) | |||
5472 | obj,(unsigned char* x, long *obj, int arg_num) | |||
5473 | arg_num)(unsigned char* x, long *obj, int arg_num) | |||
5474 | ___ISO_8859_1STRING x;(unsigned char* x, long *obj, int arg_num) | |||
5475 | ___SCMOBJ *obj;(unsigned char* x, long *obj, int arg_num) | |||
5476 | int arg_num;)(unsigned char* x, long *obj, int arg_num) | |||
5477 | { | |||
5478 | return ___STRING_to_SCMOBJ | |||
5479 | (x, | |||
5480 | obj, | |||
5481 | arg_num, | |||
5482 | ___CHAR_ENCODING_ISO_8859_1(2<<0)); | |||
5483 | } | |||
5484 | ||||
5485 | ||||
5486 | /* Convert a nonnull C ISO-8859-1 encoded character string to a Scheme string. */ | |||
5487 | ||||
5488 | ___EXP_FUNC(___SCMOBJ,___NONNULLISO_8859_1STRING_to_SCMOBJ)long ___NONNULLISO_8859_1STRING_to_SCMOBJ | |||
5489 | ___P((___ISO_8859_1STRING x,(unsigned char* x, long *obj, int arg_num) | |||
5490 | ___SCMOBJ *obj,(unsigned char* x, long *obj, int arg_num) | |||
5491 | int arg_num),(unsigned char* x, long *obj, int arg_num) | |||
5492 | (x,(unsigned char* x, long *obj, int arg_num) | |||
5493 | obj,(unsigned char* x, long *obj, int arg_num) | |||
5494 | arg_num)(unsigned char* x, long *obj, int arg_num) | |||
5495 | ___ISO_8859_1STRING x;(unsigned char* x, long *obj, int arg_num) | |||
5496 | ___SCMOBJ *obj;(unsigned char* x, long *obj, int arg_num) | |||
5497 | int arg_num;)(unsigned char* x, long *obj, int arg_num) | |||
5498 | { | |||
5499 | return ___NONNULLSTRING_to_SCMOBJ | |||
5500 | (x, | |||
5501 | obj, | |||
5502 | arg_num, | |||
5503 | ___CHAR_ENCODING_ISO_8859_1(2<<0)); | |||
5504 | } | |||
5505 | ||||
5506 | ||||
5507 | /* Convert a nonnull C ISO-8859-1 encoded character string list to a Scheme list of strings. */ | |||
5508 | ||||
5509 | ___EXP_FUNC(___SCMOBJ,___NONNULLISO_8859_1STRINGLIST_to_SCMOBJ)long ___NONNULLISO_8859_1STRINGLIST_to_SCMOBJ | |||
5510 | ___P((___ISO_8859_1STRING *x,(unsigned char* *x, long *obj, int arg_num) | |||
5511 | ___SCMOBJ *obj,(unsigned char* *x, long *obj, int arg_num) | |||
5512 | int arg_num),(unsigned char* *x, long *obj, int arg_num) | |||
5513 | (x,(unsigned char* *x, long *obj, int arg_num) | |||
5514 | obj,(unsigned char* *x, long *obj, int arg_num) | |||
5515 | arg_num)(unsigned char* *x, long *obj, int arg_num) | |||
5516 | ___ISO_8859_1STRING *x;(unsigned char* *x, long *obj, int arg_num) | |||
5517 | ___SCMOBJ *obj;(unsigned char* *x, long *obj, int arg_num) | |||
5518 | int arg_num;)(unsigned char* *x, long *obj, int arg_num) | |||
5519 | { | |||
5520 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5521 | (___CAST(void*,x)((void*)(x)), | |||
5522 | obj, | |||
5523 | arg_num, | |||
5524 | ___CHAR_ENCODING_ISO_8859_1(2<<0)); | |||
5525 | } | |||
5526 | ||||
5527 | ||||
5528 | /* Convert a C UTF-8 encoded character string to a Scheme string. */ | |||
5529 | ||||
5530 | ___EXP_FUNC(___SCMOBJ,___UTF_8STRING_to_SCMOBJ)long ___UTF_8STRING_to_SCMOBJ | |||
5531 | ___P((___UTF_8STRING x,(char* x, long *obj, int arg_num) | |||
5532 | ___SCMOBJ *obj,(char* x, long *obj, int arg_num) | |||
5533 | int arg_num),(char* x, long *obj, int arg_num) | |||
5534 | (x,(char* x, long *obj, int arg_num) | |||
5535 | obj,(char* x, long *obj, int arg_num) | |||
5536 | arg_num)(char* x, long *obj, int arg_num) | |||
5537 | ___UTF_8STRING x;(char* x, long *obj, int arg_num) | |||
5538 | ___SCMOBJ *obj;(char* x, long *obj, int arg_num) | |||
5539 | int arg_num;)(char* x, long *obj, int arg_num) | |||
5540 | { | |||
5541 | return ___STRING_to_SCMOBJ | |||
5542 | (x, | |||
5543 | obj, | |||
5544 | arg_num, | |||
5545 | ___CHAR_ENCODING_UTF_8(3<<0)); | |||
5546 | } | |||
5547 | ||||
5548 | ||||
5549 | /* Convert a nonnull C UTF-8 encoded character string to a Scheme string. */ | |||
5550 | ||||
5551 | ___EXP_FUNC(___SCMOBJ,___NONNULLUTF_8STRING_to_SCMOBJ)long ___NONNULLUTF_8STRING_to_SCMOBJ | |||
5552 | ___P((___UTF_8STRING x,(char* x, long *obj, int arg_num) | |||
5553 | ___SCMOBJ *obj,(char* x, long *obj, int arg_num) | |||
5554 | int arg_num),(char* x, long *obj, int arg_num) | |||
5555 | (x,(char* x, long *obj, int arg_num) | |||
5556 | obj,(char* x, long *obj, int arg_num) | |||
5557 | arg_num)(char* x, long *obj, int arg_num) | |||
5558 | ___UTF_8STRING x;(char* x, long *obj, int arg_num) | |||
5559 | ___SCMOBJ *obj;(char* x, long *obj, int arg_num) | |||
5560 | int arg_num;)(char* x, long *obj, int arg_num) | |||
5561 | { | |||
5562 | return ___NONNULLSTRING_to_SCMOBJ | |||
5563 | (x, | |||
5564 | obj, | |||
5565 | arg_num, | |||
5566 | ___CHAR_ENCODING_UTF_8(3<<0)); | |||
5567 | } | |||
5568 | ||||
5569 | ||||
5570 | /* Convert a nonnull C UTF-8 encoded character string list to a Scheme list of strings. */ | |||
5571 | ||||
5572 | ___EXP_FUNC(___SCMOBJ,___NONNULLUTF_8STRINGLIST_to_SCMOBJ)long ___NONNULLUTF_8STRINGLIST_to_SCMOBJ | |||
5573 | ___P((___UTF_8STRING *x,(char* *x, long *obj, int arg_num) | |||
5574 | ___SCMOBJ *obj,(char* *x, long *obj, int arg_num) | |||
5575 | int arg_num),(char* *x, long *obj, int arg_num) | |||
5576 | (x,(char* *x, long *obj, int arg_num) | |||
5577 | obj,(char* *x, long *obj, int arg_num) | |||
5578 | arg_num)(char* *x, long *obj, int arg_num) | |||
5579 | ___UTF_8STRING *x;(char* *x, long *obj, int arg_num) | |||
5580 | ___SCMOBJ *obj;(char* *x, long *obj, int arg_num) | |||
5581 | int arg_num;)(char* *x, long *obj, int arg_num) | |||
5582 | { | |||
5583 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5584 | (___CAST(void*,x)((void*)(x)), | |||
5585 | obj, | |||
5586 | arg_num, | |||
5587 | ___CHAR_ENCODING_UTF_8(3<<0)); | |||
5588 | } | |||
5589 | ||||
5590 | ||||
5591 | /* Convert a C UTF-16 encoded character string to a Scheme string. */ | |||
5592 | ||||
5593 | ___EXP_FUNC(___SCMOBJ,___UTF_16STRING_to_SCMOBJ)long ___UTF_16STRING_to_SCMOBJ | |||
5594 | ___P((___UTF_16STRING x,(unsigned short* x, long *obj, int arg_num) | |||
5595 | ___SCMOBJ *obj,(unsigned short* x, long *obj, int arg_num) | |||
5596 | int arg_num),(unsigned short* x, long *obj, int arg_num) | |||
5597 | (x,(unsigned short* x, long *obj, int arg_num) | |||
5598 | obj,(unsigned short* x, long *obj, int arg_num) | |||
5599 | arg_num)(unsigned short* x, long *obj, int arg_num) | |||
5600 | ___UTF_16STRING x;(unsigned short* x, long *obj, int arg_num) | |||
5601 | ___SCMOBJ *obj;(unsigned short* x, long *obj, int arg_num) | |||
5602 | int arg_num;)(unsigned short* x, long *obj, int arg_num) | |||
5603 | { | |||
5604 | return ___STRING_to_SCMOBJ | |||
5605 | (x, | |||
5606 | obj, | |||
5607 | arg_num, | |||
5608 | ___CHAR_ENCODING_UTF_16(4<<0)); | |||
5609 | } | |||
5610 | ||||
5611 | ||||
5612 | /* Convert a nonnull C UTF-16 encoded character string to a Scheme string. */ | |||
5613 | ||||
5614 | ___EXP_FUNC(___SCMOBJ,___NONNULLUTF_16STRING_to_SCMOBJ)long ___NONNULLUTF_16STRING_to_SCMOBJ | |||
5615 | ___P((___UTF_16STRING x,(unsigned short* x, long *obj, int arg_num) | |||
5616 | ___SCMOBJ *obj,(unsigned short* x, long *obj, int arg_num) | |||
5617 | int arg_num),(unsigned short* x, long *obj, int arg_num) | |||
5618 | (x,(unsigned short* x, long *obj, int arg_num) | |||
5619 | obj,(unsigned short* x, long *obj, int arg_num) | |||
5620 | arg_num)(unsigned short* x, long *obj, int arg_num) | |||
5621 | ___UTF_16STRING x;(unsigned short* x, long *obj, int arg_num) | |||
5622 | ___SCMOBJ *obj;(unsigned short* x, long *obj, int arg_num) | |||
5623 | int arg_num;)(unsigned short* x, long *obj, int arg_num) | |||
5624 | { | |||
5625 | return ___NONNULLSTRING_to_SCMOBJ | |||
5626 | (x, | |||
5627 | obj, | |||
5628 | arg_num, | |||
5629 | ___CHAR_ENCODING_UTF_16(4<<0)); | |||
5630 | } | |||
5631 | ||||
5632 | ||||
5633 | /* Convert a nonnull C UTF-16 encoded character string list to a Scheme list of strings. */ | |||
5634 | ||||
5635 | ___EXP_FUNC(___SCMOBJ,___NONNULLUTF_16STRINGLIST_to_SCMOBJ)long ___NONNULLUTF_16STRINGLIST_to_SCMOBJ | |||
5636 | ___P((___UTF_16STRING *x,(unsigned short* *x, long *obj, int arg_num) | |||
5637 | ___SCMOBJ *obj,(unsigned short* *x, long *obj, int arg_num) | |||
5638 | int arg_num),(unsigned short* *x, long *obj, int arg_num) | |||
5639 | (x,(unsigned short* *x, long *obj, int arg_num) | |||
5640 | obj,(unsigned short* *x, long *obj, int arg_num) | |||
5641 | arg_num)(unsigned short* *x, long *obj, int arg_num) | |||
5642 | ___UTF_16STRING *x;(unsigned short* *x, long *obj, int arg_num) | |||
5643 | ___SCMOBJ *obj;(unsigned short* *x, long *obj, int arg_num) | |||
5644 | int arg_num;)(unsigned short* *x, long *obj, int arg_num) | |||
5645 | { | |||
5646 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5647 | (___CAST(void*,x)((void*)(x)), | |||
5648 | obj, | |||
5649 | arg_num, | |||
5650 | ___CHAR_ENCODING_UTF_16(4<<0)); | |||
5651 | } | |||
5652 | ||||
5653 | ||||
5654 | /* Convert a C UCS-2 encoded character string to a Scheme string. */ | |||
5655 | ||||
5656 | ___EXP_FUNC(___SCMOBJ,___UCS_2STRING_to_SCMOBJ)long ___UCS_2STRING_to_SCMOBJ | |||
5657 | ___P((___UCS_2STRING x,(unsigned short* x, long *obj, int arg_num) | |||
5658 | ___SCMOBJ *obj,(unsigned short* x, long *obj, int arg_num) | |||
5659 | int arg_num),(unsigned short* x, long *obj, int arg_num) | |||
5660 | (x,(unsigned short* x, long *obj, int arg_num) | |||
5661 | obj,(unsigned short* x, long *obj, int arg_num) | |||
5662 | arg_num)(unsigned short* x, long *obj, int arg_num) | |||
5663 | ___UCS_2STRING x;(unsigned short* x, long *obj, int arg_num) | |||
5664 | ___SCMOBJ *obj;(unsigned short* x, long *obj, int arg_num) | |||
5665 | int arg_num;)(unsigned short* x, long *obj, int arg_num) | |||
5666 | { | |||
5667 | return ___STRING_to_SCMOBJ | |||
5668 | (x, | |||
5669 | obj, | |||
5670 | arg_num, | |||
5671 | ___CHAR_ENCODING_UCS_2(13<<0)); | |||
5672 | } | |||
5673 | ||||
5674 | ||||
5675 | /* Convert a nonnull C UCS-2 encoded character string to a Scheme string. */ | |||
5676 | ||||
5677 | ___EXP_FUNC(___SCMOBJ,___NONNULLUCS_2STRING_to_SCMOBJ)long ___NONNULLUCS_2STRING_to_SCMOBJ | |||
5678 | ___P((___UCS_2STRING x,(unsigned short* x, long *obj, int arg_num) | |||
5679 | ___SCMOBJ *obj,(unsigned short* x, long *obj, int arg_num) | |||
5680 | int arg_num),(unsigned short* x, long *obj, int arg_num) | |||
5681 | (x,(unsigned short* x, long *obj, int arg_num) | |||
5682 | obj,(unsigned short* x, long *obj, int arg_num) | |||
5683 | arg_num)(unsigned short* x, long *obj, int arg_num) | |||
5684 | ___UCS_2STRING x;(unsigned short* x, long *obj, int arg_num) | |||
5685 | ___SCMOBJ *obj;(unsigned short* x, long *obj, int arg_num) | |||
5686 | int arg_num;)(unsigned short* x, long *obj, int arg_num) | |||
5687 | { | |||
5688 | return ___NONNULLSTRING_to_SCMOBJ | |||
5689 | (x, | |||
5690 | obj, | |||
5691 | arg_num, | |||
5692 | ___CHAR_ENCODING_UCS_2(13<<0)); | |||
5693 | } | |||
5694 | ||||
5695 | /* Convert a nonnull C UCS-2 encoded character string list to a Scheme list of strings. */ | |||
5696 | ||||
5697 | ___EXP_FUNC(___SCMOBJ,___NONNULLUCS_2STRINGLIST_to_SCMOBJ)long ___NONNULLUCS_2STRINGLIST_to_SCMOBJ | |||
5698 | ___P((___UCS_2STRING *x,(unsigned short* *x, long *obj, int arg_num) | |||
5699 | ___SCMOBJ *obj,(unsigned short* *x, long *obj, int arg_num) | |||
5700 | int arg_num),(unsigned short* *x, long *obj, int arg_num) | |||
5701 | (x,(unsigned short* *x, long *obj, int arg_num) | |||
5702 | obj,(unsigned short* *x, long *obj, int arg_num) | |||
5703 | arg_num)(unsigned short* *x, long *obj, int arg_num) | |||
5704 | ___UCS_2STRING *x;(unsigned short* *x, long *obj, int arg_num) | |||
5705 | ___SCMOBJ *obj;(unsigned short* *x, long *obj, int arg_num) | |||
5706 | int arg_num;)(unsigned short* *x, long *obj, int arg_num) | |||
5707 | { | |||
5708 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5709 | (___CAST(void*,x)((void*)(x)), | |||
5710 | obj, | |||
5711 | arg_num, | |||
5712 | ___CHAR_ENCODING_UCS_2(13<<0)); | |||
5713 | } | |||
5714 | ||||
5715 | ||||
5716 | /* Convert a C UCS-4 encoded character string to a Scheme string. */ | |||
5717 | ||||
5718 | ___EXP_FUNC(___SCMOBJ,___UCS_4STRING_to_SCMOBJ)long ___UCS_4STRING_to_SCMOBJ | |||
5719 | ___P((___UCS_4STRING x,(unsigned int* x, long *obj, int arg_num) | |||
5720 | ___SCMOBJ *obj,(unsigned int* x, long *obj, int arg_num) | |||
5721 | int arg_num),(unsigned int* x, long *obj, int arg_num) | |||
5722 | (x,(unsigned int* x, long *obj, int arg_num) | |||
5723 | obj,(unsigned int* x, long *obj, int arg_num) | |||
5724 | arg_num)(unsigned int* x, long *obj, int arg_num) | |||
5725 | ___UCS_4STRING x;(unsigned int* x, long *obj, int arg_num) | |||
5726 | ___SCMOBJ *obj;(unsigned int* x, long *obj, int arg_num) | |||
5727 | int arg_num;)(unsigned int* x, long *obj, int arg_num) | |||
5728 | { | |||
5729 | return ___STRING_to_SCMOBJ | |||
5730 | (x, | |||
5731 | obj, | |||
5732 | arg_num, | |||
5733 | ___CHAR_ENCODING_UCS_4(16<<0)); | |||
5734 | } | |||
5735 | ||||
5736 | ||||
5737 | /* Convert a nonnull C UCS-4 encoded character string to a Scheme string. */ | |||
5738 | ||||
5739 | ___EXP_FUNC(___SCMOBJ,___NONNULLUCS_4STRING_to_SCMOBJ)long ___NONNULLUCS_4STRING_to_SCMOBJ | |||
5740 | ___P((___UCS_4STRING x,(unsigned int* x, long *obj, int arg_num) | |||
5741 | ___SCMOBJ *obj,(unsigned int* x, long *obj, int arg_num) | |||
5742 | int arg_num),(unsigned int* x, long *obj, int arg_num) | |||
5743 | (x,(unsigned int* x, long *obj, int arg_num) | |||
5744 | obj,(unsigned int* x, long *obj, int arg_num) | |||
5745 | arg_num)(unsigned int* x, long *obj, int arg_num) | |||
5746 | ___UCS_4STRING x;(unsigned int* x, long *obj, int arg_num) | |||
5747 | ___SCMOBJ *obj;(unsigned int* x, long *obj, int arg_num) | |||
5748 | int arg_num;)(unsigned int* x, long *obj, int arg_num) | |||
5749 | { | |||
5750 | return ___NONNULLSTRING_to_SCMOBJ | |||
5751 | (x, | |||
5752 | obj, | |||
5753 | arg_num, | |||
5754 | ___CHAR_ENCODING_UCS_4(16<<0)); | |||
5755 | } | |||
5756 | ||||
5757 | ||||
5758 | /* Convert a nonnull C UCS-4 encoded character string list to a Scheme list of strings. */ | |||
5759 | ||||
5760 | ___EXP_FUNC(___SCMOBJ,___NONNULLUCS_4STRINGLIST_to_SCMOBJ)long ___NONNULLUCS_4STRINGLIST_to_SCMOBJ | |||
5761 | ___P((___UCS_4STRING *x,(unsigned int* *x, long *obj, int arg_num) | |||
5762 | ___SCMOBJ *obj,(unsigned int* *x, long *obj, int arg_num) | |||
5763 | int arg_num),(unsigned int* *x, long *obj, int arg_num) | |||
5764 | (x,(unsigned int* *x, long *obj, int arg_num) | |||
5765 | obj,(unsigned int* *x, long *obj, int arg_num) | |||
5766 | arg_num)(unsigned int* *x, long *obj, int arg_num) | |||
5767 | ___UCS_4STRING *x;(unsigned int* *x, long *obj, int arg_num) | |||
5768 | ___SCMOBJ *obj;(unsigned int* *x, long *obj, int arg_num) | |||
5769 | int arg_num;)(unsigned int* *x, long *obj, int arg_num) | |||
5770 | { | |||
5771 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5772 | (___CAST(void*,x)((void*)(x)), | |||
5773 | obj, | |||
5774 | arg_num, | |||
5775 | ___CHAR_ENCODING_UCS_4(16<<0)); | |||
5776 | } | |||
5777 | ||||
5778 | ||||
5779 | /* Convert a C ___WCHAR encoded character string to a Scheme string. */ | |||
5780 | ||||
5781 | ___EXP_FUNC(___SCMOBJ,___WCHARSTRING_to_SCMOBJ)long ___WCHARSTRING_to_SCMOBJ | |||
5782 | ___P((___WCHARSTRING x,(wchar_t* x, long *obj, int arg_num) | |||
5783 | ___SCMOBJ *obj,(wchar_t* x, long *obj, int arg_num) | |||
5784 | int arg_num),(wchar_t* x, long *obj, int arg_num) | |||
5785 | (x,(wchar_t* x, long *obj, int arg_num) | |||
5786 | obj,(wchar_t* x, long *obj, int arg_num) | |||
5787 | arg_num)(wchar_t* x, long *obj, int arg_num) | |||
5788 | ___WCHARSTRING x;(wchar_t* x, long *obj, int arg_num) | |||
5789 | ___SCMOBJ *obj;(wchar_t* x, long *obj, int arg_num) | |||
5790 | int arg_num;)(wchar_t* x, long *obj, int arg_num) | |||
5791 | { | |||
5792 | return ___STRING_to_SCMOBJ | |||
5793 | (x, | |||
5794 | obj, | |||
5795 | arg_num, | |||
5796 | ___CHAR_ENCODING_WCHAR(19<<0)); | |||
5797 | } | |||
5798 | ||||
5799 | ||||
5800 | /* Convert a nonnull C ___WCHAR encoded character string to a Scheme string. */ | |||
5801 | ||||
5802 | ___EXP_FUNC(___SCMOBJ,___NONNULLWCHARSTRING_to_SCMOBJ)long ___NONNULLWCHARSTRING_to_SCMOBJ | |||
5803 | ___P((___WCHARSTRING x,(wchar_t* x, long *obj, int arg_num) | |||
5804 | ___SCMOBJ *obj,(wchar_t* x, long *obj, int arg_num) | |||
5805 | int arg_num),(wchar_t* x, long *obj, int arg_num) | |||
5806 | (x,(wchar_t* x, long *obj, int arg_num) | |||
5807 | obj,(wchar_t* x, long *obj, int arg_num) | |||
5808 | arg_num)(wchar_t* x, long *obj, int arg_num) | |||
5809 | ___WCHARSTRING x;(wchar_t* x, long *obj, int arg_num) | |||
5810 | ___SCMOBJ *obj;(wchar_t* x, long *obj, int arg_num) | |||
5811 | int arg_num;)(wchar_t* x, long *obj, int arg_num) | |||
5812 | { | |||
5813 | return ___NONNULLSTRING_to_SCMOBJ | |||
5814 | (x, | |||
5815 | obj, | |||
5816 | arg_num, | |||
5817 | ___CHAR_ENCODING_WCHAR(19<<0)); | |||
5818 | } | |||
5819 | ||||
5820 | ||||
5821 | /* Convert a nonnull C ___WCHAR encoded character string list to a Scheme list of strings. */ | |||
5822 | ||||
5823 | ___EXP_FUNC(___SCMOBJ,___NONNULLWCHARSTRINGLIST_to_SCMOBJ)long ___NONNULLWCHARSTRINGLIST_to_SCMOBJ | |||
5824 | ___P((___WCHARSTRING *x,(wchar_t* *x, long *obj, int arg_num) | |||
5825 | ___SCMOBJ *obj,(wchar_t* *x, long *obj, int arg_num) | |||
5826 | int arg_num),(wchar_t* *x, long *obj, int arg_num) | |||
5827 | (x,(wchar_t* *x, long *obj, int arg_num) | |||
5828 | obj,(wchar_t* *x, long *obj, int arg_num) | |||
5829 | arg_num)(wchar_t* *x, long *obj, int arg_num) | |||
5830 | ___WCHARSTRING *x;(wchar_t* *x, long *obj, int arg_num) | |||
5831 | ___SCMOBJ *obj;(wchar_t* *x, long *obj, int arg_num) | |||
5832 | int arg_num;)(wchar_t* *x, long *obj, int arg_num) | |||
5833 | { | |||
5834 | return ___NONNULLSTRINGLIST_to_SCMOBJ | |||
5835 | (___CAST(void*,x)((void*)(x)), | |||
5836 | obj, | |||
5837 | arg_num, | |||
5838 | ___CHAR_ENCODING_WCHAR(19<<0)); | |||
5839 | } | |||
5840 | ||||
5841 | ||||
5842 | /* Convert a variant to a Scheme object. */ | |||
5843 | ||||
5844 | ___EXP_FUNC(___SCMOBJ,___VARIANT_to_SCMOBJ)long ___VARIANT_to_SCMOBJ | |||
5845 | ___P((___VARIANT x,(___VARIANT x, long *obj, int arg_num) | |||
5846 | ___SCMOBJ *obj,(___VARIANT x, long *obj, int arg_num) | |||
5847 | int arg_num),(___VARIANT x, long *obj, int arg_num) | |||
5848 | (x,(___VARIANT x, long *obj, int arg_num) | |||
5849 | obj,(___VARIANT x, long *obj, int arg_num) | |||
5850 | arg_num)(___VARIANT x, long *obj, int arg_num) | |||
5851 | ___VARIANT x;(___VARIANT x, long *obj, int arg_num) | |||
5852 | ___SCMOBJ *obj;(___VARIANT x, long *obj, int arg_num) | |||
5853 | int arg_num;)(___VARIANT x, long *obj, int arg_num) | |||
5854 | { | |||
5855 | /* | |||
5856 | * Not yet implemented. | |||
5857 | */ | |||
5858 | return ___FIX(___CTOS_VARIANT_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(124<<7))+arg_num))<<2); | |||
5859 | } | |||
5860 | ||||
5861 | ||||
5862 | /* Convert a C 'char *' to a C UCS-2 encoded character string. */ | |||
5863 | ||||
5864 | ___EXP_FUNC(void,___free_UCS_2STRING)void ___free_UCS_2STRING | |||
5865 | ___P((___UCS_2STRING str_UCS_2),(unsigned short* str_UCS_2) | |||
5866 | (str_UCS_2)(unsigned short* str_UCS_2) | |||
5867 | ___UCS_2STRING str_UCS_2;)(unsigned short* str_UCS_2) | |||
5868 | { | |||
5869 | if (str_UCS_2 != 0) | |||
5870 | ___free_mem (str_UCS_2); | |||
5871 | } | |||
5872 | ||||
5873 | ||||
5874 | ___EXP_FUNC(___SCMOBJ,___CHARSTRING_to_UCS_2STRING)long ___CHARSTRING_to_UCS_2STRING | |||
5875 | ___P((char *str_char,(char *str_char, unsigned short* *str_UCS_2) | |||
5876 | ___UCS_2STRING *str_UCS_2),(char *str_char, unsigned short* *str_UCS_2) | |||
5877 | (str_char,(char *str_char, unsigned short* *str_UCS_2) | |||
5878 | str_UCS_2)(char *str_char, unsigned short* *str_UCS_2) | |||
5879 | char *str_char;(char *str_char, unsigned short* *str_UCS_2) | |||
5880 | ___UCS_2STRING *str_UCS_2;)(char *str_char, unsigned short* *str_UCS_2) | |||
5881 | { | |||
5882 | ___UCS_2STRINGunsigned short* s; | |||
5883 | ||||
5884 | if (str_char == 0) | |||
5885 | s = 0; | |||
5886 | else | |||
5887 | { | |||
5888 | char *p; | |||
5889 | int len = 0; | |||
5890 | ||||
5891 | while (str_char[len] != '\0') | |||
5892 | len++; | |||
5893 | ||||
5894 | s = ___CAST(___UCS_2STRING,((unsigned short*)(___alloc_mem ((len + 1) * sizeof (unsigned short)))) | |||
5895 | ___alloc_mem ((len + 1) * sizeof (___UCS_2)))((unsigned short*)(___alloc_mem ((len + 1) * sizeof (unsigned short)))); | |||
5896 | ||||
5897 | if (s == 0) | |||
5898 | return ___FIX(___HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+5)))<<2); | |||
5899 | ||||
5900 | s[len] = '\0'; | |||
5901 | ||||
5902 | while (len > 0) | |||
5903 | { | |||
5904 | len--; | |||
5905 | s[len] = ___CAST(___UCS_2,___CAST(unsigned char,str_char[len]))((unsigned short)(((unsigned char)(str_char[len])))); | |||
5906 | } | |||
5907 | } | |||
5908 | ||||
5909 | *str_UCS_2 = s; | |||
5910 | ||||
5911 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
5912 | } | |||
5913 | ||||
5914 | ||||
5915 | /* Convert a nonnull C 'char *' list to a nonnull C UCS-2 encoded character string list. */ | |||
5916 | ||||
5917 | ___EXP_FUNC(void,___free_NONNULLUCS_2STRINGLIST)void ___free_NONNULLUCS_2STRINGLIST | |||
5918 | ___P((___UCS_2STRING *str_list_UCS_2),(unsigned short* *str_list_UCS_2) | |||
5919 | (str_list_UCS_2)(unsigned short* *str_list_UCS_2) | |||
5920 | ___UCS_2STRING *str_list_UCS_2;)(unsigned short* *str_list_UCS_2) | |||
5921 | { | |||
5922 | ___UCS_2STRINGunsigned short* *probe = str_list_UCS_2; | |||
5923 | ___UCS_2STRINGunsigned short* str; | |||
5924 | ||||
5925 | while ((str = *probe++) != 0) | |||
5926 | ___free_UCS_2STRING (str); | |||
5927 | ||||
5928 | ___free_mem (str_list_UCS_2); | |||
5929 | } | |||
5930 | ||||
5931 | ||||
5932 | ___EXP_FUNC(___SCMOBJ,___NONNULLCHARSTRINGLIST_to_NONNULLUCS_2STRINGLIST)long ___NONNULLCHARSTRINGLIST_to_NONNULLUCS_2STRINGLIST | |||
5933 | ___P((char **str_list_char,(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5934 | ___UCS_2STRING **str_list_UCS_2),(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5935 | (str_list_char,(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5936 | str_list_UCS_2)(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5937 | char **str_list_char;(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5938 | ___UCS_2STRING **str_list_UCS_2;)(char **str_list_char, unsigned short* **str_list_UCS_2) | |||
5939 | { | |||
5940 | ___SCMOBJlong e = ___FIX(___HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+5)))<<2); | |||
5941 | ___UCS_2STRINGunsigned short* *lst; | |||
5942 | int len = 0; | |||
5943 | ||||
5944 | while (str_list_char[len] != 0) | |||
5945 | len++; | |||
5946 | ||||
5947 | lst = ___CAST(___UCS_2STRING*,((unsigned short**)(___alloc_mem ((len + 1) * sizeof (unsigned short*)))) | |||
5948 | ___alloc_mem ((len + 1) * sizeof (___UCS_2STRING)))((unsigned short**)(___alloc_mem ((len + 1) * sizeof (unsigned short*)))); | |||
5949 | ||||
5950 | if (lst != 0) | |||
5951 | { | |||
5952 | char **probe = str_list_char; | |||
5953 | char *str; | |||
5954 | int i = 0; | |||
5955 | ||||
5956 | while ((str = *probe++) != 0 && i < len) | |||
5957 | { | |||
5958 | if ((e = ___CHARSTRING_to_UCS_2STRING (str, &lst[i])) | |||
5959 | != ___FIX(___NO_ERR)(((long)(0))<<2)) | |||
5960 | { | |||
5961 | lst[i] = 0; | |||
5962 | ___free_NONNULLUCS_2STRINGLIST (lst); | |||
5963 | return e; | |||
5964 | } | |||
5965 | i++; | |||
5966 | } | |||
5967 | ||||
5968 | lst[i] = 0; | |||
5969 | ||||
5970 | *str_list_UCS_2 = lst; | |||
5971 | } | |||
5972 | ||||
5973 | return e; | |||
5974 | } | |||
5975 | ||||
5976 | ||||
5977 | /* Create a stack marker for a C to Scheme function call. */ | |||
5978 | ||||
5979 | ___EXP_FUNC(___SCMOBJ,___make_sfun_stack_marker)long ___make_sfun_stack_marker | |||
5980 | ___P((___SCMOBJ *marker,(long *marker, long proc_or_false) | |||
5981 | ___SCMOBJ proc_or_false),(long *marker, long proc_or_false) | |||
5982 | (marker,(long *marker, long proc_or_false) | |||
5983 | proc_or_false)(long *marker, long proc_or_false) | |||
5984 | ___SCMOBJ *marker;(long *marker, long proc_or_false) | |||
5985 | ___SCMOBJ proc_or_false;)(long *marker, long proc_or_false) | |||
5986 | { | |||
5987 | ___SCMOBJlong stack_marker; | |||
5988 | ||||
5989 | stack_marker = ___make_vector (1, ___FAL((((long)(-1))<<2)+2), ___STILL5); | |||
5990 | ||||
5991 | /************************ beware! proc_or_false may have been GC'd at this point! */ | |||
5992 | ||||
5993 | if (proc_or_false == ___FAL((((long)(-1))<<2)+2)) | |||
5994 | ___FIELD(stack_marker,0)(*((((long*)((stack_marker)-(1)))+1)+0)) = ___data_rc (___c_closure_self ()); | |||
5995 | else | |||
5996 | ___FIELD(stack_marker,0)(*((((long*)((stack_marker)-(1)))+1)+0)) = proc_or_false; | |||
5997 | ||||
5998 | if (___FIXNUMP(stack_marker)(((stack_marker)&((1<<2)-1))==(0))) | |||
5999 | return ___FIX(___SFUN_HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+1)))<<2); | |||
6000 | ||||
6001 | *marker = stack_marker; | |||
6002 | ||||
6003 | return ___FIX(___NO_ERR)(((long)(0))<<2); | |||
6004 | } | |||
6005 | ||||
6006 | ||||
6007 | /* | |||
6008 | * Invalidate a stack marker. This happens when a C to Scheme | |||
6009 | * function call returns. | |||
6010 | */ | |||
6011 | ||||
6012 | ___EXP_FUNC(void,___kill_sfun_stack_marker)void ___kill_sfun_stack_marker | |||
6013 | ___P((___SCMOBJ marker),(long marker) | |||
6014 | (marker)(long marker) | |||
6015 | ___SCMOBJ marker;)(long marker) | |||
6016 | { | |||
6017 | ___FIELD(marker,0)(*((((long*)((marker)-(1)))+1)+0)) = ___FAL((((long)(-1))<<2)+2); /* invalidate the C stack frame */ | |||
6018 | ___still_obj_refcount_dec (marker); /* allow GC of stack marker */ | |||
6019 | } | |||
6020 | ||||
6021 | ||||
6022 | /*---------------------------------------------------------------------------*/ |