Bug Summary

File:c_intf.c
Location:line 2077, column 8
Description:The left operand of '>>' is a garbage value

Annotated Source Code

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)
89int 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)
140int 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)
237int 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)
313int 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
376int ___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
407void ___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
; } \
528if (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 } \
559else \
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; \
583loop_label: \
584blo += bytes_per_char; \
585if (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 } \
598else \
599 { \
600 blo -= bytes_per_char; \
601 if (bytes_per_char > 1 && \
602 blo == byte_buf) \
603 result = ___INCOMPLETE_CHAR1; \
604 } \
605break;
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; \
609switch (___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 } \
627if (!___FULLY_BUFFERED(state)(((state)&(3<<9))>=(3<<9))) \
628 goto encode_chars_end; /* must empty byte buffer */ \
629else 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; \
634loop_label: \
635c = *clo++; \
636if (___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 } \
660else \
661 { \
662 clo--; \
663 if (clo == char_buf) \
664 result = ___ILLEGAL_CHAR2; \
665 goto encode_chars_end; \
666 } \
667break;
668
669
670#define get_ISO_8859_1(i)blo[(i)*1] \
671blo[(i)*bytes_per_ISO_8859_11]
672
673#define get_UTF_8(i)blo[(i)*1] \
674blo[(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); \
705blo[(i)*bytes_per_ISO_8859_11] = (c);
706
707#define put_UTF_8(i,c)blo[(i)*1] = (c); \
708blo[(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; \
711blo[(i)*bytes_per_UTF_162+1] = (c) & 0xff; \
712blo[(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; \
715blo[(i)*bytes_per_UTF_162+0] = (c) & 0xff; \
716blo[(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; \
719blo[(i)*bytes_per_UCS_22+1] = (c) & 0xff; \
720blo[(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; \
723blo[(i)*bytes_per_UCS_22+0] = (c) & 0xff; \
724blo[(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; \
727blo[(i)*bytes_per_UCS_44+3] = (c) & 0xff; \
728blo[(i)*bytes_per_UCS_44+2] = ((c)>>8) & 0xff; \
729blo[(i)*bytes_per_UCS_44+1] = ((c)>>16) & 0xff; \
730blo[(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; \
733blo[(i)*bytes_per_UCS_44+0] = (c) & 0xff; \
734blo[(i)*bytes_per_UCS_44+1] = ((c)>>8) & 0xff; \
735blo[(i)*bytes_per_UCS_44+2] = ((c)>>16) & 0xff; \
736blo[(i)*bytes_per_UCS_44+3] = ((c)>>24) & 0xff;
737
738
739int 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)
751int *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)
753int *byte_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char *
byte_buf, int *byte_buf_avail, int *decoding_state)
754int *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
1263int 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)
1275int *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)
1277int *byte_buf_avail;(unsigned int *char_buf, int *char_buf_avail, unsigned char *
byte_buf, int *byte_buf_avail, int *encoding_state)
1278int *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)
1727void *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)
1742void *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)
1755void *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)
1767void *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)
1778void *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)
1789void *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)
1810void *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)
1853int arg_num;)(long obj, long *x, int arg_num)
1854{
1855 ___S64long val;
1856
1857 if (___FIXNUMP(obj)(((obj)&((1<<2)-1))==(0)))
3
←
Taking false branch
→
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))))
4
←
Taking true branch
→
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)
1906int 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)
1976int 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)
2000int 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)
2024int 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)
2048int 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)
2072int arg_num;)(long obj, int *x, int arg_num)
2073{
2074 ___S64long val;
1
Within the expansion of the macro '___S64':
→
a
'val' declared without an initial value
2075
2076 if (___SCMOBJ_to_S64 (obj, &val, arg_num) != ___FIX(___NO_ERR)(((long)(0))<<2) ||
2
←
Calling '___SCMOBJ_to_S64'
→
5
←
Returning from '___SCMOBJ_to_S64'
→
2077 !___S64_fits_in_width (val, 32)((((val) >> ((32)-1)) == 0) || (((val) >> ((32)-1
)) == -1)))
6
←
Within the expansion of the macro '___S64_fits_in_width':
a
The left operand of '>>' is a garbage value
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)
2096int 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)
2120int 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)
2141int 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)
2161char *x;(long obj, char *x, int arg_num)
2162int 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)
2186int 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)
2209unsigned char *x;(long obj, unsigned char *x, int arg_num)
2210int 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)
2234int 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)
2258int 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)
2282int 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)
2306int 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)
2349int 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)
2377int 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)
2405int 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)
2432short *x;(long obj, short *x, int arg_num)
2433int 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)
2460unsigned short *x;(long obj, unsigned short *x, int arg_num)
2461int 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)
2488int *x;(long obj, int *x, int arg_num)
2489int 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)
2516unsigned int *x;(long obj, unsigned int *x, int arg_num)
2517int 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)
2544long *x;(long obj, long *x, int arg_num)
2545int 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)
2572unsigned long *x;(long obj, unsigned long *x, int arg_num)
2573int 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)
2601int 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)
2629int 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)
2656float *x;(long obj, float *x, int arg_num)
2657int 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)
2677double *x;(long obj, double *x, int arg_num)
2678int 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)
2729void **x;(long obj, void **x, long tags, int arg_num)
2730___SCMOBJ tags;(long obj, void **x, long tags, int arg_num)
2731int 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)
2760void **x;(long obj, void **x, long tags, int arg_num)
2761___SCMOBJ tags;(long obj, void **x, long tags, int arg_num)
2762int 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)
2783void *converter;(long obj, void *converter, void **x, int arg_num)
2784void **x;(long obj, void *converter, void **x, int arg_num)
2785int 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)
2835void *converter;(long obj, void *converter, void **x, int arg_num)
2836void **x;(long obj, void *converter, void **x, int arg_num)
2837int 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)
2858int 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)
2877void **x;(long obj, void **x, long tags, int arg_num)
2878___SCMOBJ tags;(long obj, void **x, long tags, int arg_num)
2879int 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)
2902void **x;(long obj, void **x, long tags, int arg_num)
2903___SCMOBJ tags;(long obj, void **x, long tags, int arg_num)
2904int 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)
2927void **x;(long obj, void **x, long tags, int arg_num)
2928___SCMOBJ tags;(long obj, void **x, long tags, int arg_num)
2929int 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)
2951int 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)
2953int type;(int char_encoding, int ctos, int type, int arg_num)
2954int 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
)
3072void **x;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3073int arg_num;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3074int char_encoding;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3075int 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
)
3351void **x;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3352int arg_num;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3353int char_encoding;(long obj, void **x, int arg_num, int char_encoding, int fudge
)
3354int 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)
3385void **x;(long obj, void **x, int arg_num, int char_encoding)
3386int arg_num;(long obj, void **x, int arg_num, int char_encoding)
3387int 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)
3467char **x;(long obj, char **x, int arg_num)
3468int 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)
3496char **x;(long obj, char **x, int arg_num)
3497int 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)
3525char ***x;(long obj, char ***x, int arg_num)
3526int 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)
3554int 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)
3583int 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)
3612int 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)
3640int 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)
3669int 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)
3698int 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)
3726int 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)
3755int 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)
3784int 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)
3812int 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)
3841int 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)
3870int 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)
3898int 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)
3927int 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)
3956int 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)
3984int 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)
4013int 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)
4042int 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)
4070int 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)
4105int 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)
4166int 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)
4235int 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)
4257int 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)
4279int 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)
4301int 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)
4323int 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)
4340int 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)
4357int 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)
4385int 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)
4400char x;(char x, long *obj, int arg_num)
4401___SCMOBJ *obj;(char x, long *obj, int arg_num)
4402int 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)
4424int 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)
4444unsigned char x;(unsigned char x, long *obj, int arg_num)
4445___SCMOBJ *obj;(unsigned char x, long *obj, int arg_num)
4446int 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)
4468int 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)
4490int 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)
4516int 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)
4540int 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)
4574int 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)
4591int 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)
4608int 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)
4623short x;(short x, long *obj, int arg_num)
4624___SCMOBJ *obj;(short x, long *obj, int arg_num)
4625int 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)
4640unsigned short x;(unsigned short x, long *obj, int arg_num)
4641___SCMOBJ *obj;(unsigned short x, long *obj, int arg_num)
4642int 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)
4657int x;(int x, long *obj, int arg_num)
4658___SCMOBJ *obj;(int x, long *obj, int arg_num)
4659int 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)
4674unsigned int x;(unsigned int x, long *obj, int arg_num)
4675___SCMOBJ *obj;(unsigned int x, long *obj, int arg_num)
4676int 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)
4691long x;(long x, long *obj, int arg_num)
4692___SCMOBJ *obj;(long x, long *obj, int arg_num)
4693int 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)
4708unsigned long x;(unsigned long x, long *obj, int arg_num)
4709___SCMOBJ *obj;(unsigned long x, long *obj, int arg_num)
4710int 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)
4727int 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)
4744int 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)
4759float x;(float x, long *obj, int arg_num)
4760___SCMOBJ *obj;(float x, long *obj, int arg_num)
4761int 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)
4776double x;(double x, long *obj, int arg_num)
4777___SCMOBJ *obj;(double x, long *obj, int arg_num)
4778int 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)
4797void *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)
4801int 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)
4837void *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)
4841int 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)
4861void *x;(void *x, long *obj, int arg_num)
4862___SCMOBJ *obj;(void *x, long *obj, int arg_num)
4863int 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)
4888void *x;(void *x, long *obj, int arg_num)
4889___SCMOBJ *obj;(void *x, long *obj, int arg_num)
4890int 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)
4914void *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)
4918int 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)
4946void *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)
4950int 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)
4978void *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)
4982int 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)
5008int 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)
5026void *x;(void *x, long *obj, int arg_num, int char_encoding)
5027___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding)
5028int arg_num;(void *x, long *obj, int arg_num, int char_encoding)
5029int 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)
5304void *x;(void *x, long *obj, int arg_num, int char_encoding)
5305___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding)
5306int arg_num;(void *x, long *obj, int arg_num, int char_encoding)
5307int 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)
5343void *x;(void *x, long *obj, int arg_num, int char_encoding)
5344___SCMOBJ *obj;(void *x, long *obj, int arg_num, int char_encoding)
5345int arg_num;(void *x, long *obj, int arg_num, int char_encoding)
5346int 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)
5411char *x;(char *x, long *obj, int arg_num)
5412___SCMOBJ *obj;(char *x, long *obj, int arg_num)
5413int 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)
5432char *x;(char *x, long *obj, int arg_num)
5433___SCMOBJ *obj;(char *x, long *obj, int arg_num)
5434int 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)
5453char **x;(char **x, long *obj, int arg_num)
5454___SCMOBJ *obj;(char **x, long *obj, int arg_num)
5455int 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)
5476int 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)
5497int 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)
5518int 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)
5539int 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)
5560int 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)
5581int 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)
5602int 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)
5623int 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)
5644int 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)
5665int 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)
5686int 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)
5706int 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)
5727int 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)
5748int 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)
5769int 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)
5790int 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)
5811int 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)
5832int 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)
5853int 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)
5879char *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)
5937char **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/*---------------------------------------------------------------------------*/