File: | c_intf.c |
Location: | line 2585, column 6 |
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 | /*---------------------------------------------------------------------------*/ |