Bug Summary

File:os.c
Location:line 1580, column 37
Description:Access to field 'p_name' results in a dereference of a null pointer (loaded from variable 'pe')

Annotated Source Code

1/* File: "os.c" */
2
3/* Copyright (c) 1994-2013 by Marc Feeley, All Rights Reserved. */
4
5/*
6 * This module implements the operating system specific routines
7 * including:
8 *
9 * - OS specific initialization/finalization
10 * - process termination
11 * - error handling
12 * - conversion of error codes to error messages
13 * - low-level memory allocation
14 * - program startup
15 * - time management
16 * - process times (user time, system time and real time).
17 * - heartbeat interrupt handling
18 * - user interrupt handling
19 * - access to OS environment variables
20 * - shell command
21 * - dynamic loading
22 * - dynamic C compilation
23 * - floating point environment setup
24 * - processor count
25 * - processor cache size
26 * - virtual memory statistics
27 * - filesystem path expansion
28 * - formatting of source code position
29 * - operations on I/O devices
30 */
31
32#define ___INCLUDED_FROM_OS
33#define ___VERSION407000 407000
34#include "gambit.h"
35
36#include "os_base.h"
37#include "os_time.h"
38#include "os_shell.h"
39#include "os_files.h"
40#include "os_dyn.h"
41#include "os_tty.h"
42#include "os_io.h"
43#include "setup.h"
44#include "mem.h"
45#include "c_intf.h"
46
47/**********************************/
48#ifdef ___DEBUG
49#ifdef ___DEBUG_ALLOC_MEM_TRACE
50#define ___alloc_mem(bytes) ___alloc_mem_debug(bytes,__LINE__50,__FILE__"os.c")
51#endif
52#endif
53
54
55/*---------------------------------------------------------------------------*/
56
57#define NBELEMS(table)(sizeof (table) / sizeof (table[0]))(sizeof (table) / sizeof (table[0]))
58
59
60/*---------------------------------------------------------------------------*/
61
62
63___SCMOBJlong ___setup_os_interrupt_handling ___PVOID(void)
64{
65 ___SCMOBJlong e;
66
67 if ((e = ___setup_heartbeat_interrupt_handling ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
68 {
69 if ((e = ___setup_user_interrupt_handling ()) != ___FIX(___NO_ERR)(((long)(0))<<2))
70 ___cleanup_heartbeat_interrupt_handling ();
71 }
72
73 return e;
74}
75
76void ___cleanup_os_interrupt_handling ___PVOID(void)
77{
78 ___cleanup_user_interrupt_handling ();
79 ___cleanup_heartbeat_interrupt_handling ();
80}
81
82void ___disable_os_interrupts ___PVOID(void)
83{
84 ___disable_heartbeat_interrupts ();
85 ___disable_user_interrupts ();
86}
87
88void ___enable_os_interrupts ___PVOID(void)
89{
90 ___enable_user_interrupts ();
91 ___enable_heartbeat_interrupts ();
92}
93
94
95/*---------------------------------------------------------------------------*/
96
97/* Processor information. */
98
99int ___processor_count ___PVOID(void)
100{
101 int nb_processors = 0;
102
103#ifdef USE_sysconf
104
105#ifdef _SC_NPROCESSORS_ONLN_SC_NPROCESSORS_ONLN
106#define OP_SC_NPROCESSORS_SC_NPROCESSORS_ONLN _SC_NPROCESSORS_ONLN_SC_NPROCESSORS_ONLN
107#else
108#ifdef _SC_NPROCESSORS_CONF_SC_NPROCESSORS_CONF
109#define OP_SC_NPROCESSORS_SC_NPROCESSORS_ONLN _SC_NPROCESSORS_CONF_SC_NPROCESSORS_CONF
110#endif
111#endif
112
113#endif
114
115#ifdef OP_SC_NPROCESSORS_SC_NPROCESSORS_ONLN
116
117 nb_processors = sysconf (OP_SC_NPROCESSORS_SC_NPROCESSORS_ONLN);
118
119#else
120
121#ifdef USE_sysctl
122
123#ifdef CTL_HW
124#ifdef HW_AVAILCPU
125#define OP_NB_CPU HW_AVAILCPU
126#else
127#ifdef HW_NCPU
128#define OP_NB_CPU HW_NCPU
129#endif
130#endif
131#endif
132
133#ifdef OP_NB_CPU
134
135 size_t n = 0;
136 size_t sizeof_n = sizeof(n);
137 int mib[2];
138
139 mib[0] = CTL_HW;
140 mib[1] = OP_NB_CPU;
141
142 if (sysctl (mib, 2, &n, &sizeof_n, NULL((void*)0), 0) == 0) {
143 nb_processors = n;
144 }
145
146#endif
147
148#endif
149
150#endif
151
152#ifdef USE_GetSystemInfo
153
154 SYSTEM_INFO si;
155
156 GetSystemInfo (&si);
157
158 nb_processors = si.dwNumberOfProcessors;
159
160#endif
161
162 return nb_processors;
163}
164
165
166int ___processor_cache_size
167 ___P((___BOOL instruction_cache,(int instruction_cache, int level)
168 int level),(int instruction_cache, int level)
169 (instruction_cache,(int instruction_cache, int level)
170 level)(int instruction_cache, int level)
171___BOOL instruction_cache;(int instruction_cache, int level)
172int level;)(int instruction_cache, int level)
173{
174 int cache_size = 0;
175
176#ifdef USE_sysconf
177
178 {
179
180 static struct { int name; int level; int kind; } sysconf_info[] = {
181
182#ifdef _SC_LEVEL1_DCACHE_SIZE_SC_LEVEL1_DCACHE_SIZE
183 { _SC_LEVEL1_DCACHE_SIZE_SC_LEVEL1_DCACHE_SIZE, 1, 1 },
184#endif
185#ifdef _SC_LEVEL1_ICACHE_SIZE_SC_LEVEL1_ICACHE_SIZE
186 { _SC_LEVEL1_ICACHE_SIZE_SC_LEVEL1_ICACHE_SIZE, 1, 2 },
187#endif
188#ifdef _SC_LEVEL1_CACHE_SIZE
189 { _SC_LEVEL1_CACHE_SIZE, 1, 3 },
190#endif
191
192#ifdef _SC_LEVEL2_DCACHE_SIZE
193 { _SC_LEVEL2_DCACHE_SIZE, 2, 1 },
194#endif
195#ifdef _SC_LEVEL2_ICACHE_SIZE
196 { _SC_LEVEL2_ICACHE_SIZE, 2, 2 },
197#endif
198#ifdef _SC_LEVEL2_CACHE_SIZE_SC_LEVEL2_CACHE_SIZE
199 { _SC_LEVEL2_CACHE_SIZE_SC_LEVEL2_CACHE_SIZE, 2, 3 },
200#endif
201
202#ifdef _SC_LEVEL3_DCACHE_SIZE
203 { _SC_LEVEL3_DCACHE_SIZE, 3, 1 },
204#endif
205#ifdef _SC_LEVEL3_ICACHE_SIZE
206 { _SC_LEVEL3_ICACHE_SIZE, 3, 2 },
207#endif
208#ifdef _SC_LEVEL3_CACHE_SIZE_SC_LEVEL3_CACHE_SIZE
209 { _SC_LEVEL3_CACHE_SIZE_SC_LEVEL3_CACHE_SIZE, 3, 3 },
210#endif
211
212#ifdef _SC_LEVEL4_DCACHE_SIZE
213 { _SC_LEVEL4_DCACHE_SIZE, 4, 1 },
214#endif
215#ifdef _SC_LEVEL4_ICACHE_SIZE
216 { _SC_LEVEL4_ICACHE_SIZE, 4, 2 },
217#endif
218#ifdef _SC_LEVEL4_CACHE_SIZE_SC_LEVEL4_CACHE_SIZE
219 { _SC_LEVEL4_CACHE_SIZE_SC_LEVEL4_CACHE_SIZE, 4, 3 },
220#endif
221
222 { 0, 0, 0 }
223 };
224
225 int i = 0;
226
227 while (sysconf_info[i].kind != 0) {
228
229 if ((level == 0 || level == sysconf_info[i].level) &&
230 (sysconf_info[i].kind & (1<<instruction_cache))) {
231
232 int size = sysconf (sysconf_info[i].name);
233
234 if (level != 0) {
235 cache_size = size;
236 break;
237 }
238
239 if (size > cache_size) {
240 cache_size = size;
241 }
242 }
243
244 i++;
245 }
246
247 if (cache_size != 0) {
248 return cache_size;
249 }
250
251 }
252
253#endif
254
255#ifdef USE_sysctl
256
257#ifdef CTL_HW
258
259 {
260
261 static struct { int name; int level; int kind; } sysctl_info[] = {
262
263#ifdef HW_L1DCACHESIZE
264 { HW_L1DCACHESIZE, 1, 1 },
265#endif
266#ifdef HW_L1ICACHESIZE
267 { HW_L1ICACHESIZE, 1, 2 },
268#endif
269#ifdef HW_L1CACHESIZE
270 { HW_L1CACHESIZE, 1, 3 },
271#endif
272
273#ifdef HW_L2DCACHESIZE
274 { HW_L2DCACHESIZE, 2, 1 },
275#endif
276#ifdef HW_L2ICACHESIZE
277 { HW_L2ICACHESIZE, 2, 2 },
278#endif
279#ifdef HW_L2CACHESIZE
280 { HW_L2CACHESIZE, 2, 3 },
281#endif
282
283#ifdef HW_L3DCACHESIZE
284 { HW_L3DCACHESIZE, 3, 1 },
285#endif
286#ifdef HW_L3ICACHESIZE
287 { HW_L3ICACHESIZE, 3, 2 },
288#endif
289#ifdef HW_L3CACHESIZE
290 { HW_L3CACHESIZE, 3, 3 },
291#endif
292
293#ifdef HW_L4DCACHESIZE
294 { HW_L4DCACHESIZE, 4, 1 },
295#endif
296#ifdef HW_L4ICACHESIZE
297 { HW_L4ICACHESIZE, 4, 2 },
298#endif
299#ifdef HW_L4CACHESIZE
300 { HW_L4CACHESIZE, 4, 3 },
301#endif
302
303 { 0, 0, 0 }
304 };
305
306 int i = 0;
307
308 while (sysctl_info[i].kind != 0) {
309
310 if ((level == 0 || level == sysctl_info[i].level) &&
311 (sysctl_info[i].kind & (1<<instruction_cache))) {
312
313 size_t size = 0;
314 size_t sizeof_size = sizeof(size);
315 int mib[2];
316
317 mib[0] = CTL_HW;
318 mib[1] = sysctl_info[i].name;
319
320 if (sysctl (mib, 2, &size, &sizeof_size, NULL((void*)0), 0) == 0) {
321
322 if (level != 0) {
323 cache_size = size;
324 break;
325 }
326
327 if (size > cache_size) {
328 cache_size = size;
329 }
330 }
331 }
332
333 i++;
334 }
335
336 if (cache_size != 0) {
337 return cache_size;
338 }
339
340 }
341
342#endif
343
344#endif
345
346#ifdef USE_WIN32
347
348 /* TODO: use GetLogicalProcessorInformation */
349
350#endif
351
352 return cache_size;
353}
354
355
356/*---------------------------------------------------------------------------*/
357
358/* Virtual memory statistics. */
359
360void ___vm_stats
361 ___P((___SIZE_TS *minflt,(long *minflt, long *majflt)
362 ___SIZE_TS *majflt),(long *minflt, long *majflt)
363 (minflt,(long *minflt, long *majflt)
364 majflt)(long *minflt, long *majflt)
365___SIZE_TS *minflt;(long *minflt, long *majflt)
366___SIZE_TS *majflt;)(long *minflt, long *majflt)
367{
368#ifndef USE_getrusage
369
370 *minflt = 0; /* can't get statistics... result is 0 */
371 *majflt = 0;
372
373#endif
374
375#ifdef USE_getrusage
376
377 struct rusage ru;
378
379 if (getrusage (RUSAGE_SELFRUSAGE_SELF, &ru) == 0)
380 {
381 *minflt = ru.ru_minflt;
382 *majflt = ru.ru_majflt;
383 }
384 else
385 {
386 *minflt = 0; /* can't get statistics... result is 0 */
387 *majflt = 0;
388 }
389
390#endif
391}
392
393
394/*---------------------------------------------------------------------------*/
395
396/* Formatting of source code position. */
397
398char *___format_filepos
399 ___P((char *path,(char *path, long filepos, int pinpoint)
400 ___SIZE_TS filepos,(char *path, long filepos, int pinpoint)
401 ___BOOL pinpoint),(char *path, long filepos, int pinpoint)
402 (path,(char *path, long filepos, int pinpoint)
403 filepos,(char *path, long filepos, int pinpoint)
404 pinpoint)(char *path, long filepos, int pinpoint)
405char *path;(char *path, long filepos, int pinpoint)
406___SIZE_TS filepos;(char *path, long filepos, int pinpoint)
407___BOOL pinpoint;)(char *path, long filepos, int pinpoint)
408{
409#ifdef USE_MACOS
410
411#ifdef USE_mac_gui
412
413 if (pinpoint)
414 mac_gui_highlight (path, filepos);
415
416#endif
417
418#endif
419
420 return 0; /* Use default format for displaying location */
421}
422
423
424/* - - - - - - - - - - - - - - - - - - */
425
426/* Miscellaneous networking utilities. */
427
428#ifdef USE_NETWORKING
429
430#ifdef AF_INET610
431#define USE_IPV6
432#endif
433
434
435___HIDDENstatic int network_family_decode
436 ___P((int family),(int family)
437 (family)(int family)
438int family;)(int family)
439{
440 switch (family)
441 {
442#ifdef PF_INET2
443 case -1:
444 return PF_INET2;
445#endif
446
447#ifdef PF_INET610
448 case -2:
449 return PF_INET610;
450#endif
451 }
452
453 return 0;
454}
455
456
457___HIDDENstatic ___SCMOBJlong network_family_encode
458 ___P((int family),(int family)
459 (family)(int family)
460int family;)(int family)
461{
462 switch (family)
463 {
464#ifdef PF_INET2
465 case PF_INET2:
466 return ___FIX(-1)(((long)(-1))<<2);
467#endif
468
469#ifdef PF_INET610
470 case PF_INET610:
471 return ___FIX(-2)(((long)(-2))<<2);
472#endif
473 }
474
475 return ___FIX(family)(((long)(family))<<2);
476}
477
478
479___HIDDENstatic int network_socktype_decode
480 ___P((int socktype),(int socktype)
481 (socktype)(int socktype)
482int socktype;)(int socktype)
483{
484 switch (socktype)
485 {
486#ifdef SOCK_STREAMSOCK_STREAM
487 case -1:
488 return SOCK_STREAMSOCK_STREAM;
489#endif
490
491#ifdef SOCK_DGRAMSOCK_DGRAM
492 case -2:
493 return SOCK_DGRAMSOCK_DGRAM;
494#endif
495
496#ifdef SOCK_RAWSOCK_RAW
497 case -3:
498 return SOCK_RAWSOCK_RAW;
499#endif
500 }
501
502 return 0;
503}
504
505
506___HIDDENstatic ___SCMOBJlong network_socktype_encode
507 ___P((int socktype),(int socktype)
508 (socktype)(int socktype)
509int socktype;)(int socktype)
510{
511 switch (socktype)
512 {
513#ifdef SOCK_STREAMSOCK_STREAM
514 case SOCK_STREAMSOCK_STREAM:
515 return ___FIX(-1)(((long)(-1))<<2);
516#endif
517
518#ifdef SOCK_DGRAMSOCK_DGRAM
519 case SOCK_DGRAMSOCK_DGRAM:
520 return ___FIX(-2)(((long)(-2))<<2);
521#endif
522
523#ifdef SOCK_RAWSOCK_RAW
524 case SOCK_RAWSOCK_RAW:
525 return ___FIX(-3)(((long)(-3))<<2);
526#endif
527 }
528
529 return ___FIX(socktype)(((long)(socktype))<<2);
530}
531
532
533___HIDDENstatic int network_protocol_decode
534 ___P((int protocol),(int protocol)
535 (protocol)(int protocol)
536int protocol;)(int protocol)
537{
538 switch (protocol)
539 {
540#ifdef IPPROTO_UDPIPPROTO_UDP
541 case -1:
542 return IPPROTO_UDPIPPROTO_UDP;
543#endif
544
545#ifdef IPPROTO_TCPIPPROTO_TCP
546 case -2:
547 return IPPROTO_TCPIPPROTO_TCP;
548#endif
549 }
550
551 return 0;
552}
553
554
555___HIDDENstatic ___SCMOBJlong network_protocol_encode
556 ___P((int protocol),(int protocol)
557 (protocol)(int protocol)
558int protocol;)(int protocol)
559{
560 switch (protocol)
561 {
562#ifdef IPPROTO_UDPIPPROTO_UDP
563 case IPPROTO_UDPIPPROTO_UDP:
564 return ___FIX(-1)(((long)(-1))<<2);
565#endif
566
567#ifdef IPPROTO_TCPIPPROTO_TCP
568 case IPPROTO_TCPIPPROTO_TCP:
569 return ___FIX(-2)(((long)(-2))<<2);
570#endif
571 }
572
573 return ___FIX(protocol)(((long)(protocol))<<2);
574}
575
576
577___SCMOBJlong ___SCMOBJ_to_in_addr
578 ___P((___SCMOBJ addr,(long addr, struct in_addr *ia, int arg_num)
579 struct in_addr *ia,(long addr, struct in_addr *ia, int arg_num)
580 int arg_num),(long addr, struct in_addr *ia, int arg_num)
581 (addr,(long addr, struct in_addr *ia, int arg_num)
582 ia,(long addr, struct in_addr *ia, int arg_num)
583 arg_num)(long addr, struct in_addr *ia, int arg_num)
584___SCMOBJ addr;(long addr, struct in_addr *ia, int arg_num)
585struct in_addr *ia;(long addr, struct in_addr *ia, int arg_num)
586int arg_num;)(long addr, struct in_addr *ia, int arg_num)
587{
588 if (addr == ___FAL((((long)(-1))<<2)+2))
589 ia->s_addr = htonl (INADDR_ANY((in_addr_t) 0x00000000)); /* wildcard address */
590 else
591 ia->s_addr = htonl ((___INT(___U8VECTORREF(addr,___FIX(0)))(((((long)(*(((unsigned char*)((((long*)((addr)-(1)))+1)))+((
(((long)(0))<<2))>>2))))<<2))>>2)<<24) +
592 (___INT(___U8VECTORREF(addr,___FIX(1)))(((((long)(*(((unsigned char*)((((long*)((addr)-(1)))+1)))+((
(((long)(1))<<2))>>2))))<<2))>>2)<<16) +
593 (___INT(___U8VECTORREF(addr,___FIX(2)))(((((long)(*(((unsigned char*)((((long*)((addr)-(1)))+1)))+((
(((long)(2))<<2))>>2))))<<2))>>2)<<8) +
594 ___INT(___U8VECTORREF(addr,___FIX(3)))(((((long)(*(((unsigned char*)((((long*)((addr)-(1)))+1)))+((
(((long)(3))<<2))>>2))))<<2))>>2));
595
596 return ___FIX(___NO_ERR)(((long)(0))<<2);
597}
598
599
600___SCMOBJlong ___in_addr_to_SCMOBJ
601 ___P((struct in_addr *ia,(struct in_addr *ia, int arg_num)
602 int arg_num),(struct in_addr *ia, int arg_num)
603 (ia,(struct in_addr *ia, int arg_num)
604 arg_num)(struct in_addr *ia, int arg_num)
605struct in_addr *ia;(struct in_addr *ia, int arg_num)
606int arg_num;)(struct in_addr *ia, int arg_num)
607{
608 ___U32unsigned int a;
609 ___SCMOBJlong result;
610
611 a = ntohl (ia->s_addr);
612
613 if (a == INADDR_ANY((in_addr_t) 0x00000000))
614 result = ___FAL((((long)(-1))<<2)+2); /* wildcard address */
615 else
616 {
617 result = ___alloc_scmobj (___sU8VECTOR21, 4, ___STILL5);
618
619 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
620 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+arg_num))<<2);
621
622
623 ___U8VECTORSET(result,___FIX(0),___FIX((a>>24) & 0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
0))<<2))>>2)) = ((((((long)((a>>24) & 0xff
))<<2))>>2));
624 ___U8VECTORSET(result,___FIX(1),___FIX((a>>16) & 0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
1))<<2))>>2)) = ((((((long)((a>>16) & 0xff
))<<2))>>2));
625 ___U8VECTORSET(result,___FIX(2),___FIX((a>>8) & 0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
2))<<2))>>2)) = ((((((long)((a>>8) & 0xff
))<<2))>>2));
626 ___U8VECTORSET(result,___FIX(3),___FIX(a & 0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
3))<<2))>>2)) = ((((((long)(a & 0xff))<<
2))>>2));
627 }
628
629 return result;
630}
631
632
633#ifdef USE_IPV6
634
635___SCMOBJlong ___SCMOBJ_to_in6_addr
636 ___P((___SCMOBJ addr,(long addr, struct in6_addr *ia, int arg_num)
637 struct in6_addr *ia,(long addr, struct in6_addr *ia, int arg_num)
638 int arg_num),(long addr, struct in6_addr *ia, int arg_num)
639 (addr,(long addr, struct in6_addr *ia, int arg_num)
640 ia,(long addr, struct in6_addr *ia, int arg_num)
641 arg_num)(long addr, struct in6_addr *ia, int arg_num)
642___SCMOBJ addr;(long addr, struct in6_addr *ia, int arg_num)
643struct in6_addr *ia;(long addr, struct in6_addr *ia, int arg_num)
644int arg_num;)(long addr, struct in6_addr *ia, int arg_num)
645{
646 int i;
647
648 if (addr == ___FAL((((long)(-1))<<2)+2))
649 {
650 /* wildcard address */
651
652 for (i=0; i<8; i++)
653 {
654 ia->s6_addr__in6_u.__u6_addr8[i<<1] = 0;
655 ia->s6_addr__in6_u.__u6_addr8[(i<<1)+1] = 0;
656 }
657 }
658 else
659 {
660 for (i=0; i<8; i++)
661 {
662 ___U16unsigned short x = ___INT(___U16VECTORREF(addr,___FIX(i)))(((((long)(*(((unsigned short*)((((long*)((addr)-(1)))+1)))+(
((((long)(i))<<2))>>2))))<<2))>>2);
663 ia->s6_addr__in6_u.__u6_addr8[i<<1] = (x>>8) & 0xff;
664 ia->s6_addr__in6_u.__u6_addr8[(i<<1)+1] = x & 0xff;
665 }
666 }
667
668 return ___FIX(___NO_ERR)(((long)(0))<<2);
669}
670
671
672___SCMOBJlong ___in6_addr_to_SCMOBJ
673 ___P((struct in6_addr *ia,(struct in6_addr *ia, int arg_num)
674 int arg_num),(struct in6_addr *ia, int arg_num)
675 (ia,(struct in6_addr *ia, int arg_num)
676 arg_num)(struct in6_addr *ia, int arg_num)
677struct in6_addr *ia;(struct in6_addr *ia, int arg_num)
678int arg_num;)(struct in6_addr *ia, int arg_num)
679{
680 int i;
681 ___SCMOBJlong result;
682
683 for (i=0; i<16; i++)
684 if (ia->s6_addr__in6_u.__u6_addr8[i] != 0)
685 break;
686
687 if (i == 16)
688 result = ___FAL((((long)(-1))<<2)+2); /* wildcard address */
689 else
690 {
691 result = ___alloc_scmobj (___sU16VECTOR23, 8<<1, ___STILL5);
692
693 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
694 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+arg_num))<<2);
695
696 for (i=0; i<8; i++)
697 ___U16VECTORSET*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) + ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
698 (result,*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) + ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
699 ___FIX(i),*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) + ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
700 ___FIX((___CAST(___U16,ia->s6_addr[i<<1])<<8) +*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) + ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
701 ia->s6_addr[(i<<1)+1]))*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) + ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
702 }
703
704 return result;
705}
706
707#endif
708
709
710___SCMOBJlong ___SCMOBJ_to_sockaddr
711 ___P((___SCMOBJ addr,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
712 ___SCMOBJ port_num,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
713 struct sockaddr *sa,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
714 int *salen,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
715 int arg_num),(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
716 (addr,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
717 port_num,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
718 sa,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
719 salen,(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
720 arg_num)(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
721___SCMOBJ addr;(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
722___SCMOBJ port_num;(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
723struct sockaddr *sa;(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
724int *salen;(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
725int arg_num;)(long addr, long port_num, struct sockaddr *sa, int *salen, int
arg_num)
726{
727 ___SCMOBJlong result;
728 ___SCMOBJlong ___temp; /* needed by the ___U8VECTORP and ___U16VECTORP macros */
729
730 if (addr == ___FAL((((long)(-1))<<2)+2) || ___U8VECTORP(addr)((((___temp=(addr)))&((1<<2)-1))==1&&((((*(
(long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(
((21))<<3))))
731 {
732 struct sockaddr_in *sa_in = ___CAST(struct sockaddr_in*,sa)((struct sockaddr_in*)(sa));
733 *salen = sizeof (*sa_in);
734 memset (sa_in, 0, sizeof (*sa_in));
735 sa_in->sin_family = AF_INET2;
736 sa_in->sin_port = htons (___INT(port_num)((port_num)>>2));
737 result = ___SCMOBJ_to_in_addr (addr, &sa_in->sin_addr, arg_num);
738 }
739#ifdef USE_IPV6
740 else if (___U16VECTORP(addr)((((___temp=(addr)))&((1<<2)-1))==1&&((((*(
(long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(
((23))<<3))))
741 {
742 struct sockaddr_in6 *sa_in6 = ___CAST(struct sockaddr_in6*,sa)((struct sockaddr_in6*)(sa));
743 *salen = sizeof (*sa_in6);
744 memset (sa_in6, 0, sizeof (*sa_in6));
745 sa_in6->sin6_family = AF_INET610;
746 sa_in6->sin6_port = htons (___INT(port_num)((port_num)>>2));
747 result = ___SCMOBJ_to_in6_addr (addr, &sa_in6->sin6_addr, arg_num);
748 }
749#endif
750 else
751 result = ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+3)))<<2);
752
753 return result;
754}
755
756
757___SCMOBJlong ___sockaddr_to_SCMOBJ
758 ___P((struct sockaddr *sa,(struct sockaddr *sa, int salen, int arg_num)
759 int salen,(struct sockaddr *sa, int salen, int arg_num)
760 int arg_num),(struct sockaddr *sa, int salen, int arg_num)
761 (sa,(struct sockaddr *sa, int salen, int arg_num)
762 salen,(struct sockaddr *sa, int salen, int arg_num)
763 arg_num)(struct sockaddr *sa, int salen, int arg_num)
764struct sockaddr *sa;(struct sockaddr *sa, int salen, int arg_num)
765int salen;(struct sockaddr *sa, int salen, int arg_num)
766int arg_num;)(struct sockaddr *sa, int salen, int arg_num)
767{
768 ___SCMOBJlong result;
769
770 result = ___make_vector (4, ___FAL((((long)(-1))<<2)+2), ___STILL5);
771
772 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
773 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+arg_num))<<2);
774
775 if (salen == sizeof (struct sockaddr_in))
776 {
777 struct sockaddr_in *sa_in = ___CAST(struct sockaddr_in*,sa)((struct sockaddr_in*)(sa));
778 ___SCMOBJlong addr = ___in_addr_to_SCMOBJ (&sa_in->sin_addr, arg_num);
779
780 if (___FIXNUMP(addr)(((addr)&((1<<2)-1))==(0)))
781 {
782 ___release_scmobj (result);
783 return addr;
784 }
785
786 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = network_family_encode (sa_in->sin_family);
787 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(ntohs (sa_in->sin_port))(((long)(ntohs (sa_in->sin_port)))<<2);
788 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = addr;
789 ___release_scmobj (addr);
790 }
791#ifdef USE_IPV6
792 else if (salen == sizeof (struct sockaddr_in6))
793 {
794 struct sockaddr_in6 *sa_in6 = ___CAST(struct sockaddr_in6*,sa)((struct sockaddr_in6*)(sa));
795 ___SCMOBJlong addr = ___in6_addr_to_SCMOBJ (&sa_in6->sin6_addr, arg_num);
796
797 if (___FIXNUMP(addr)(((addr)&((1<<2)-1))==(0)))
798 {
799 ___release_scmobj (result);
800 return addr;
801 }
802
803 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = network_family_encode (sa_in6->sin6_family);
804 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(ntohs (sa_in6->sin6_port))(((long)(ntohs (sa_in6->sin6_port)))<<2);
805 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = addr;
806 ___release_scmobj (addr);
807 }
808#endif
809 else
810 result = ___FAL((((long)(-1))<<2)+2);
811
812 ___release_scmobj (result);
813
814 return result;
815}
816
817
818___SCMOBJlong ___addr_to_SCMOBJ
819 ___P((void *sa,(void *sa, int salen, int arg_num)
820 int salen,(void *sa, int salen, int arg_num)
821 int arg_num),(void *sa, int salen, int arg_num)
822 (sa,(void *sa, int salen, int arg_num)
823 salen,(void *sa, int salen, int arg_num)
824 arg_num)(void *sa, int salen, int arg_num)
825void *sa;(void *sa, int salen, int arg_num)
826int salen;(void *sa, int salen, int arg_num)
827int arg_num;)(void *sa, int salen, int arg_num)
828{
829 ___SCMOBJlong result;
830
831 if (salen == 4)
832 {
833 struct in_addr *ia = ___CAST(struct in_addr*,sa)((struct in_addr*)(sa));
834 ___U32unsigned int a;
835
836 result = ___alloc_scmobj (___sU8VECTOR21, 4, ___STILL5);
837
838 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
839 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+arg_num))<<2);
840
841 a = ntohl (ia->s_addr);
842
843 ___U8VECTORSET(result,___FIX(0),___FIX((a>>24)&0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
0))<<2))>>2)) = ((((((long)((a>>24)&0xff
))<<2))>>2));
844 ___U8VECTORSET(result,___FIX(1),___FIX((a>>16)&0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
1))<<2))>>2)) = ((((((long)((a>>16)&0xff
))<<2))>>2));
845 ___U8VECTORSET(result,___FIX(2),___FIX((a>>8)&0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
2))<<2))>>2)) = ((((((long)((a>>8)&0xff
))<<2))>>2));
846 ___U8VECTORSET(result,___FIX(3),___FIX(a&0xff))*(((unsigned char*)((((long*)((result)-(1)))+1)))+(((((long)(
3))<<2))>>2)) = ((((((long)(a&0xff))<<2
))>>2));
847 }
848#ifdef USE_IPV6
849 else if (salen == 16)
850 {
851 struct in6_addr *ia = ___CAST(struct in6_addr*,sa)((struct in6_addr*)(sa));
852 int i;
853
854 result = ___alloc_scmobj (___sU16VECTOR23, 8<<1, ___STILL5);
855
856 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
857 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+arg_num))<<2);
858
859 for (i=0; i<8; i++)
860 ___U16VECTORSET(result,*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) +ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
861 ___FIX(i),*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) +ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
862 ___FIX((___CAST(___U16,ia->s6_addr[i<<1])<<8)*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) +ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
863 +ia->s6_addr[(i<<1)+1]))*(((unsigned short*)((((long*)((result)-(1)))+1)))+(((((long)
(i))<<2))>>2)) = ((((((long)((((unsigned short)(ia
->__in6_u.__u6_addr8[i<<1]))<<8) +ia->__in6_u
.__u6_addr8[(i<<1)+1]))<<2))>>2));
864 }
865#endif
866 else
867 result = ___FAL((((long)(-1))<<2)+2);
868
869 ___release_scmobj (result);
870
871 return result;
872}
873
874#endif
875
876
877/* - - - - - - - - - - - - - - - - - - */
878
879/* Access to host information. */
880
881#ifdef USE_getaddrinfo
882
883___HIDDENstatic int ai_flags_decode
884 ___P((int flags),(int flags)
885 (flags)(int flags)
886int flags;)(int flags)
887{
888 int ai_flags = 0;
889
890#ifdef AI_PASSIVE0x0001
891 if (flags & 1)
892 ai_flags |= AI_PASSIVE0x0001;
893#endif
894
895#ifdef AI_CANONNAME0x0002
896 if (flags & 2)
897 ai_flags |= AI_CANONNAME0x0002;
898#endif
899
900#ifdef AI_NUMERICHOST0x0004
901 if (flags & 4)
902 ai_flags |= AI_NUMERICHOST0x0004;
903#endif
904
905#ifdef AI_NUMERICSERV0x0400
906 if (flags & 8)
907 ai_flags |= AI_NUMERICSERV0x0400;
908#endif
909
910#ifdef AI_ALL0x0010
911 if (flags & 16)
912 ai_flags |= AI_ALL0x0010;
913#endif
914
915#ifdef AI_ADDRCONFIG0x0020
916 if (flags & 32)
917 ai_flags |= AI_ADDRCONFIG0x0020;
918#endif
919
920#ifdef AI_V4MAPPED0x0008
921 if (flags & 64)
922 ai_flags |= AI_V4MAPPED0x0008;
923#endif
924
925 return ai_flags;
926}
927
928#endif
929
930
931___SCMOBJlong ___os_address_infos
932 ___P((___SCMOBJ host,(long host, long serv, long flags, long family, long socktype
, long protocol)
933 ___SCMOBJ serv,(long host, long serv, long flags, long family, long socktype
, long protocol)
934 ___SCMOBJ flags,(long host, long serv, long flags, long family, long socktype
, long protocol)
935 ___SCMOBJ family,(long host, long serv, long flags, long family, long socktype
, long protocol)
936 ___SCMOBJ socktype,(long host, long serv, long flags, long family, long socktype
, long protocol)
937 ___SCMOBJ protocol),(long host, long serv, long flags, long family, long socktype
, long protocol)
938 (host,(long host, long serv, long flags, long family, long socktype
, long protocol)
939 serv,(long host, long serv, long flags, long family, long socktype
, long protocol)
940 flags,(long host, long serv, long flags, long family, long socktype
, long protocol)
941 family,(long host, long serv, long flags, long family, long socktype
, long protocol)
942 socktype,(long host, long serv, long flags, long family, long socktype
, long protocol)
943 protocol)(long host, long serv, long flags, long family, long socktype
, long protocol)
944___SCMOBJ host;(long host, long serv, long flags, long family, long socktype
, long protocol)
945___SCMOBJ serv;(long host, long serv, long flags, long family, long socktype
, long protocol)
946___SCMOBJ flags;(long host, long serv, long flags, long family, long socktype
, long protocol)
947___SCMOBJ family;(long host, long serv, long flags, long family, long socktype
, long protocol)
948___SCMOBJ socktype;(long host, long serv, long flags, long family, long socktype
, long protocol)
949___SCMOBJ protocol;)(long host, long serv, long flags, long family, long socktype
, long protocol)
950{
951#ifndef USE_getaddrinfo
952
953 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
954
955#endif
956
957#ifdef USE_getaddrinfo
958
959 ___SCMOBJlong e;
960 ___SCMOBJlong vect;
961 ___SCMOBJlong lst;
962 ___SCMOBJlong tail;
963 ___SCMOBJlong x;
964 ___SCMOBJlong p;
965 int i;
966 char *chost = 0;
967 char *cserv = 0;
968
969 struct addrinfo hints, *res, *res0;
970 int code;
971
972 if ((e = ___SCMOBJ_to_CHARSTRING (host, &chost, 1))
973 != ___FIX(___NO_ERR)(((long)(0))<<2))
974 return e;
975
976 if ((e = ___SCMOBJ_to_CHARSTRING (serv, &cserv, 2))
977 != ___FIX(___NO_ERR)(((long)(0))<<2))
978 {
979 ___release_string (chost);
980 return e;
981 }
982
983 memset (&hints, 0, sizeof (hints));
984
985 hints.ai_flags = ai_flags_decode (___INT(flags)((flags)>>2));
986 hints.ai_family = network_family_decode (___INT(family)((family)>>2));
987 hints.ai_socktype = network_socktype_decode (___INT(socktype)((socktype)>>2));
988 hints.ai_protocol = network_protocol_decode (___INT(protocol)((protocol)>>2));
989
990 code = getaddrinfo (chost, cserv, &hints, &res0);
991
992 if (code != 0)
993 {
994 e = err_code_from_gai_code (code)___err_code_from_gai_code(code);
995 ___release_string (chost);
996 ___release_string (cserv);
997 return e;
998 }
999
1000 lst = ___NUL((((long)(-3))<<2)+2);
1001 tail = ___FAL((((long)(-1))<<2)+2);
1002
1003 for (res = res0; res != NULL((void*)0); res = res->ai_next)
1004 {
1005 x = ___sockaddr_to_SCMOBJ (res->ai_addr,
1006 res->ai_addrlen,
1007 ___RETURN_POS127);
1008
1009 if (___FIXNUMP(x)(((x)&((1<<2)-1))==(0)))
1010 {
1011 ___release_scmobj (lst);
1012 freeaddrinfo (res0);
1013 return x;
1014 }
1015
1016 if (x != ___FAL((((long)(-1))<<2)+2))
1017 {
1018 vect = ___make_vector (5, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1019
1020 if (___FIXNUMP(vect)(((vect)&((1<<2)-1))==(0)))
1021 {
1022 ___release_scmobj (x);
1023 ___release_scmobj (lst);
1024 freeaddrinfo (res0);
1025 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);
1026 }
1027
1028 ___FIELD(vect,1)(*((((long*)((vect)-(1)))+1)+1)) = network_family_encode (res->ai_family);
1029 ___FIELD(vect,2)(*((((long*)((vect)-(1)))+1)+2)) = network_socktype_encode (res->ai_socktype);
1030 ___FIELD(vect,3)(*((((long*)((vect)-(1)))+1)+3)) = network_protocol_encode (res->ai_protocol);
1031 ___FIELD(vect,4)(*((((long*)((vect)-(1)))+1)+4)) = x;
1032
1033 ___release_scmobj (x);
1034
1035 p = ___make_pair (vect, ___NUL((((long)(-3))<<2)+2), ___STILL5);
1036
1037 ___release_scmobj (vect);
1038
1039 if (___FIXNUMP(p)(((p)&((1<<2)-1))==(0)))
1040 {
1041 ___release_scmobj (lst);
1042 freeaddrinfo (res0);
1043 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);
1044 }
1045
1046 if (lst == ___NUL((((long)(-3))<<2)+2))
1047 lst = p;
1048 else
1049 ___SETCDR(tail,p)(*((((long*)((tail)-(3)))+1)+0))=p;;
1050
1051 tail = p;
1052 }
1053 }
1054
1055 ___release_scmobj (lst);
1056
1057 freeaddrinfo (res0);
1058
1059 ___release_string (chost);
1060 ___release_string (cserv);
1061
1062 return lst;
1063
1064#endif
1065}
1066
1067
1068___SCMOBJlong ___os_host_info
1069 ___P((___SCMOBJ host),(long host)
1070 (host)(long host)
1071___SCMOBJ host;)(long host)
1072{
1073#ifndef USE_gethostbyname
1074
1075 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1076
1077#endif
1078
1079#ifdef USE_gethostbyname
1080
1081 ___SCMOBJlong e;
1082 ___SCMOBJlong vect;
1083 ___SCMOBJlong lst;
1084 ___SCMOBJlong x;
1085 ___SCMOBJlong p;
1086 int i;
1087 struct hostent *he = 0;
1088 char *chost = 0;
1089
1090 ___SCMOBJlong ___temp; /* needed by the ___U8VECTORP and ___U16VECTORP macros */
1091
1092#ifdef USE_POSIX
1093
1094 errno(*__errno_location ()) = 0; /* in case the h_errno ends up being NETDB_SUCCESS
1095 * incorrectly which will be treated as NETDB_INTERNAL
1096 * (see err_code_from_h_errno)
1097 */
1098
1099#endif
1100
1101#ifdef USE_gethostbyaddr
1102
1103 if (___U8VECTORP(host)((((___temp=(host)))&((1<<2)-1))==1&&((((*(
(long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(
((21))<<3))))
1104 {
1105 struct in_addr ia;
1106
1107 if ((e = ___SCMOBJ_to_in_addr (host, &ia, 1)) != ___FIX(___NO_ERR)(((long)(0))<<2))
1108 return e;
1109
1110 he = gethostbyaddr (___CAST(char*,&ia)((char*)(&ia)), 4, AF_INET2);
1111 }
1112#ifdef USE_IPV6
1113 else if (___U16VECTORP(host)((((___temp=(host)))&((1<<2)-1))==1&&((((*(
(long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(
((23))<<3))))
1114 {
1115 struct in6_addr ia;
1116
1117 if ((e = ___SCMOBJ_to_in6_addr (host, &ia, 1)) != ___FIX(___NO_ERR)(((long)(0))<<2))
1118 return e;
1119
1120 he = gethostbyaddr (___CAST(char*,&ia)((char*)(&ia)), 16, AF_INET610);
1121 }
1122#endif
1123 else
1124
1125#endif
1126
1127 {
1128 /*
1129 * Convert the Scheme string to a C "char*" string. If an
1130 * invalid character is seen then return an error.
1131 */
1132
1133 if ((e = ___SCMOBJ_to_NONNULLCHARSTRING (host, &chost, 1))
1134 != ___FIX(___NO_ERR)(((long)(0))<<2))
1135 return e;
1136
1137#ifdef USE_inet_pton
1138
1139 {
1140 struct in_addr ia;
1141
1142 if (inet_pton (AF_INET2, chost, &ia) == 1)
1143 he = gethostbyaddr (___CAST(char*,&ia)((char*)(&ia)), 4, AF_INET2);
1144 }
1145
1146#ifdef USE_IPV6
1147
1148 if (he == 0)
1149 {
1150 struct in6_addr ia;
1151
1152 if (inet_pton (AF_INET610, chost, &ia) == 1)
1153 he = gethostbyaddr (___CAST(char*,&ia)((char*)(&ia)), 16, AF_INET610);
1154 }
1155
1156#endif
1157
1158 if (he == 0)
1159
1160#endif
1161
1162 {
1163 he = gethostbyname (chost);
1164 }
1165 }
1166
1167 if (he == 0)
1168 {
1169#ifdef USE_POSIX
1170 e = err_code_from_h_errno ()___err_code_from_h_errno();
1171#endif
1172
1173#ifdef USE_WIN32
1174 e = err_code_from_WSAGetLastError ()___err_code_from_WSAGetLastError();
1175#endif
1176 }
1177
1178 ___release_string (chost);
1179
1180 if (e != ___FIX(___NO_ERR)(((long)(0))<<2))
1181 return e;
1182
1183 vect = ___make_vector (4, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1184
1185 if (___FIXNUMP(vect)(((vect)&((1<<2)-1))==(0)))
1186 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);
1187
1188 /* convert h_name to string */
1189
1190 if ((e = ___CHARSTRING_to_SCMOBJ
1191 (___CAST(char*,he->h_name)((char*)(he->h_name)),
1192 &x,
1193 ___RETURN_POS127))
1194 != ___FIX(___NO_ERR)(((long)(0))<<2))
1195 {
1196 ___release_scmobj (vect);
1197 return e;
1198 }
1199
1200 ___FIELD(vect,1)(*((((long*)((vect)-(1)))+1)+1)) = x;
1201 ___release_scmobj (x);
1202
1203 /* convert h_aliases to strings */
1204
1205 i = 0;
1206 while (he->h_aliases[i] != 0)
1207 i++;
1208
1209 lst = ___NUL((((long)(-3))<<2)+2);
1210 while (i-- > 0)
1211 {
1212 if ((e = ___CHARSTRING_to_SCMOBJ
1213 (___CAST(char*,he->h_aliases[i])((char*)(he->h_aliases[i])),
1214 &x,
1215 ___RETURN_POS127))
1216 != ___FIX(___NO_ERR)(((long)(0))<<2))
1217 {
1218 ___release_scmobj (lst);
1219 ___release_scmobj (vect);
1220 return e;
1221 }
1222
1223 p = ___make_pair (x, lst, ___STILL5);
1224
1225 ___release_scmobj (x);
1226 ___release_scmobj (lst);
1227
1228 if (___FIXNUMP(p)(((p)&((1<<2)-1))==(0)))
1229 {
1230 ___release_scmobj (vect);
1231 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);
1232 }
1233
1234 lst = p;
1235 }
1236
1237 ___FIELD(vect,2)(*((((long*)((vect)-(1)))+1)+2)) = lst;
1238 ___release_scmobj (lst);
1239
1240 /* convert h_addr_list to u8/u16vectors */
1241
1242 i = 0;
1243 while (he->h_addr_list[i] != 0)
1244 i++;
1245
1246 lst = ___NUL((((long)(-3))<<2)+2);
1247 while (i-- > 0)
1248 {
1249 switch (he->h_addrtype)
1250 {
1251 case AF_INET2:
1252 {
1253 x = ___in_addr_to_SCMOBJ
1254 (___CAST(struct in_addr*,he->h_addr_list[i])((struct in_addr*)(he->h_addr_list[i])),
1255 ___RETURN_POS127);
1256 break;
1257 }
1258
1259#ifdef USE_IPV6
1260 case AF_INET610:
1261 {
1262 x = ___in6_addr_to_SCMOBJ
1263 (___CAST(struct in6_addr*,he->h_addr_list[i])((struct in6_addr*)(he->h_addr_list[i])),
1264 ___RETURN_POS127);
1265 break;
1266 }
1267
1268#endif
1269
1270 default:
1271 continue; /* ignore unknown address families */
1272 }
1273
1274 if (___FIXNUMP(x)(((x)&((1<<2)-1))==(0)))
1275 {
1276 ___release_scmobj (lst);
1277 ___release_scmobj (vect);
1278 return x;
1279 }
1280
1281 p = ___make_pair (x, lst, ___STILL5);
1282
1283 ___release_scmobj (x);
1284 ___release_scmobj (lst);
1285
1286 if (___FIXNUMP(p)(((p)&((1<<2)-1))==(0)))
1287 {
1288 ___release_scmobj (vect);
1289 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);
1290 }
1291
1292 lst = p;
1293 }
1294
1295 ___FIELD(vect,3)(*((((long*)((vect)-(1)))+1)+3)) = lst;
1296 ___release_scmobj (lst);
1297 ___release_scmobj (vect);
1298
1299 /* guarantee that at least one address is returned */
1300
1301 if (lst == ___NUL((((long)(-3))<<2)+2))
1302 return ___FIX(___H_ERRNO_ERR(NO_ADDRESS))(((long)(((4)==0?0:((((int)(-1))<<29)+(((int)(319))<<
16)+((4))))))<<2);
1303
1304 return vect;
1305
1306#endif
1307}
1308
1309
1310___SCMOBJlong ___os_host_name ___PVOID(void)
1311{
1312#ifndef USE_gethostname
1313
1314 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1315
1316#endif
1317
1318#ifdef USE_gethostname
1319
1320#define HOSTNAME_MAX_LEN1024 1024
1321
1322 ___SCMOBJlong e;
1323 ___SCMOBJlong result;
1324 char name[HOSTNAME_MAX_LEN1024];
1325
1326 if (gethostname (name, HOSTNAME_MAX_LEN1024) < 0)
1327 return err_code_from_errno ()___err_code_from_errno();
1328
1329 if ((e = ___NONNULLCHARSTRING_to_SCMOBJ (name, &result, ___RETURN_POS127))
1330 != ___FIX(___NO_ERR)(((long)(0))<<2))
1331 return e;
1332
1333 ___release_scmobj (result);
1334
1335 return result;
1336
1337#endif
1338}
1339
1340
1341/* - - - - - - - - - - - - - - - - - - */
1342
1343/* Access to service information. */
1344
1345___SCMOBJlong ___os_service_info
1346 ___P((___SCMOBJ service,(long service, long protocol)
1347 ___SCMOBJ protocol),(long service, long protocol)
1348 (service,(long service, long protocol)
1349 protocol)(long service, long protocol)
1350___SCMOBJ service;(long service, long protocol)
1351___SCMOBJ protocol;)(long service, long protocol)
1352{
1353#ifndef USE_getservbyname
1354
1355 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1356
1357#endif
1358
1359#ifdef USE_getservbyname
1360
1361 ___SCMOBJlong e;
1362 ___SCMOBJlong vect;
1363 ___SCMOBJlong lst;
1364 ___SCMOBJlong x;
1365 ___SCMOBJlong p;
1366 int i;
1367 struct servent *se;
1368 char *cservice;
1369 char *cprotocol;
1370
1371 /*
1372 * Convert the Scheme string to a C "char*" string. If an invalid
1373 * character is seen then return an error.
1374 */
1375
1376 if (!___FIXNUMP(service)(((service)&((1<<2)-1))==(0)))
1377 if ((e = ___SCMOBJ_to_NONNULLCHARSTRING (service, &cservice, 1))
1378 != ___FIX(___NO_ERR)(((long)(0))<<2))
1379 return e;
1380
1381 if ((e = ___SCMOBJ_to_CHARSTRING (protocol, &cprotocol, 2))
1382 != ___FIX(___NO_ERR)(((long)(0))<<2))
1383 {
1384 if (!___FIXNUMP(service)(((service)&((1<<2)-1))==(0)))
1385 ___release_string (cservice);
1386 return e;
1387 }
1388
1389#ifdef USE_POSIX
1390
1391 errno(*__errno_location ()) = 0; /* in case the h_errno ends up being NETDB_SUCCESS
1392 * incorrectly which will be treated as NETDB_INTERNAL
1393 * (see err_code_from_h_errno)
1394 */
1395
1396#endif
1397
1398 if (___FIXNUMP(service)(((service)&((1<<2)-1))==(0)))
1399 se = getservbyport (htons (___INT(service)((service)>>2)), cprotocol);
1400 else
1401 se = getservbyname (cservice, cprotocol);
1402
1403 if (se == 0)
1404 {
1405#ifdef USE_POSIX
1406
1407 e = err_code_from_h_errno ()___err_code_from_h_errno();
1408
1409#endif
1410
1411#ifdef USE_WIN32
1412
1413 e = err_code_from_WSAGetLastError ()___err_code_from_WSAGetLastError();
1414
1415#endif
1416 }
1417
1418 if (cprotocol != 0)
1419 ___release_string (cprotocol);
1420
1421 if (!___FIXNUMP(service)(((service)&((1<<2)-1))==(0)))
1422 ___release_string (cservice);
1423
1424 if (e != ___FIX(___NO_ERR)(((long)(0))<<2))
1425 return e;
1426
1427 vect = ___make_vector (5, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1428
1429 if (___FIXNUMP(vect)(((vect)&((1<<2)-1))==(0)))
1430 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/************/
1431
1432 /* convert s_name to string */
1433
1434 if ((e = ___CHARSTRING_to_SCMOBJ (se->s_name, &x, ___RETURN_POS127))
1435 != ___FIX(___NO_ERR)(((long)(0))<<2))
1436 {
1437 ___release_scmobj (vect);
1438 return e;
1439 }
1440
1441 ___FIELD(vect,1)(*((((long*)((vect)-(1)))+1)+1)) = x;
1442 ___release_scmobj (x);
1443
1444 /* convert s_aliases to strings */
1445
1446 i = 0;
1447 while (se->s_aliases[i] != 0)
1448 i++;
1449
1450 lst = ___NUL((((long)(-3))<<2)+2);
1451 while (i-- > 0)
1452 {
1453 if ((e = ___CHARSTRING_to_SCMOBJ (se->s_aliases[i], &x, ___RETURN_POS127))
1454 != ___FIX(___NO_ERR)(((long)(0))<<2))
1455 {
1456 ___release_scmobj (lst);
1457 ___release_scmobj (vect);
1458 return e;
1459 }
1460
1461 p = ___make_pair (x, lst, ___STILL5);
1462
1463 ___release_scmobj (x);
1464 ___release_scmobj (lst);
1465
1466 if (___FIXNUMP(p)(((p)&((1<<2)-1))==(0)))
1467 {
1468 ___release_scmobj (vect);
1469 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/*******************/
1470 }
1471
1472 lst = p;
1473 }
1474
1475 ___FIELD(vect,2)(*((((long*)((vect)-(1)))+1)+2)) = lst;
1476 ___release_scmobj (lst);
1477
1478 /* convert s_port to integer */
1479
1480 ___FIELD(vect,3)(*((((long*)((vect)-(1)))+1)+3)) = ___FIX(ntohs (se->s_port))(((long)(ntohs (se->s_port)))<<2);
1481
1482 /* convert s_name to string */
1483
1484 if ((e = ___CHARSTRING_to_SCMOBJ (se->s_proto, &x, ___RETURN_POS127))
1485 != ___FIX(___NO_ERR)(((long)(0))<<2))
1486 {
1487 ___release_scmobj (vect);
1488 return e;
1489 }
1490
1491 ___FIELD(vect,4)(*((((long*)((vect)-(1)))+1)+4)) = x;
1492 ___release_scmobj (x);
1493
1494 ___release_scmobj (vect);
1495
1496 return vect;
1497
1498#endif
1499}
1500
1501
1502/* - - - - - - - - - - - - - - - - - - */
1503
1504/* Access to protocol information. */
1505
1506___SCMOBJlong ___os_protocol_info
1507 ___P((___SCMOBJ protocol),(long protocol)
1508 (protocol)(long protocol)
1509___SCMOBJ protocol;)(long protocol)
1510{
1511#ifndef USE_getprotobyname
1512
1513 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1514
1515#endif
1516
1517#ifdef USE_getprotobyname
1518
1519 ___SCMOBJlong e = ___FIX(___NO_ERR)(((long)(0))<<2);
1520 ___SCMOBJlong vect;
1521 ___SCMOBJlong lst;
1522 ___SCMOBJlong x;
1523 ___SCMOBJlong p;
1524 int i;
1525 struct protoent *pe;
1526 char *cprotocol;
1527
1528 /*
1529 * Convert the Scheme string to a C "char*" string. If an invalid
1530 * character is seen then return an error.
1531 */
1532
1533 if (!___FIXNUMP(protocol)(((protocol)&((1<<2)-1))==(0)))
1
Taking true branch
→
1534 if ((e = ___SCMOBJ_to_NONNULLCHARSTRING (protocol, &cprotocol, 1))
2
←
Taking false branch
→
1535 != ___FIX(___NO_ERR)(((long)(0))<<2))
1536 return e;
1537
1538#ifdef USE_POSIX
1539
1540 errno(*__errno_location ()) = 0; /* in case the h_errno ends up being NETDB_SUCCESS
1541 * incorrectly which will be treated as NETDB_INTERNAL
1542 * (see err_code_from_h_errno)
1543 */
1544
1545#endif
1546
1547 if (___FIXNUMP(protocol)(((protocol)&((1<<2)-1))==(0)))
3
←
Taking false branch
→
1548 pe = getprotobynumber (___INT(protocol)((protocol)>>2));
1549 else
1550 pe = getprotobyname (cprotocol);
4
←
Value assigned to 'pe'
→
1551
1552 if (pe == 0)
5
←
Assuming 'pe' is equal to null
→
6
←
Taking true branch
→
1553 {
1554#ifdef USE_POSIX
1555
1556 e = err_code_from_h_errno ()___err_code_from_h_errno();
1557
1558#endif
1559
1560#ifdef USE_WIN32
1561
1562 e = err_code_from_WSAGetLastError ()___err_code_from_WSAGetLastError();
1563
1564#endif
1565 }
1566
1567 if (!___FIXNUMP(protocol)(((protocol)&((1<<2)-1))==(0)))
7
←
Taking true branch
→
1568 ___release_string (cprotocol);
1569
1570 if (e != ___FIX(___NO_ERR)(((long)(0))<<2))
8
←
Taking false branch
→
1571 return e;
1572
1573 vect = ___make_vector (4, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1574
1575 if (___FIXNUMP(vect)(((vect)&((1<<2)-1))==(0)))
9
←
Taking false branch
→
1576 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/************/
1577
1578 /* convert p_name to string */
1579
1580 if ((e = ___CHARSTRING_to_SCMOBJ (pe->p_name, &x, ___RETURN_POS127))
10
←
Access to field 'p_name' results in a dereference of a null pointer (loaded from variable 'pe')
1581 != ___FIX(___NO_ERR)(((long)(0))<<2))
1582 {
1583 ___release_scmobj (vect);
1584 return e;
1585 }
1586
1587 ___FIELD(vect,1)(*((((long*)((vect)-(1)))+1)+1)) = x;
1588 ___release_scmobj (x);
1589
1590 /* convert p_aliases to strings */
1591
1592 i = 0;
1593 while (pe->p_aliases[i] != 0)
1594 i++;
1595
1596 lst = ___NUL((((long)(-3))<<2)+2);
1597 while (i-- > 0)
1598 {
1599 if ((e = ___CHARSTRING_to_SCMOBJ (pe->p_aliases[i], &x, ___RETURN_POS127))
1600 != ___FIX(___NO_ERR)(((long)(0))<<2))
1601 {
1602 ___release_scmobj (lst);
1603 ___release_scmobj (vect);
1604 return e;
1605 }
1606
1607 p = ___make_pair (x, lst, ___STILL5);
1608
1609 ___release_scmobj (x);
1610 ___release_scmobj (lst);
1611
1612 if (___FIXNUMP(p)(((p)&((1<<2)-1))==(0)))
1613 {
1614 ___release_scmobj (vect);
1615 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/*******************/
1616 }
1617
1618 lst = p;
1619 }
1620
1621 ___FIELD(vect,2)(*((((long*)((vect)-(1)))+1)+2)) = lst;
1622 ___release_scmobj (lst);
1623
1624 /* convert p_proto to integer */
1625
1626 ___FIELD(vect,3)(*((((long*)((vect)-(1)))+1)+3)) = ___FIX(pe->p_proto)(((long)(pe->p_proto))<<2);
1627
1628 ___release_scmobj (vect);
1629
1630 return vect;
1631
1632#endif
1633}
1634
1635
1636/* - - - - - - - - - - - - - - - - - - */
1637
1638/* Access to network information. */
1639
1640___SCMOBJlong ___os_network_info
1641 ___P((___SCMOBJ network),(long network)
1642 (network)(long network)
1643___SCMOBJ network;)(long network)
1644{
1645#ifndef USE_getnetbyname
1646
1647 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1648
1649#else
1650
1651 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
1652
1653#endif
1654}
1655
1656
1657/* - - - - - - - - - - - - - - - - - - */
1658
1659/* Access to file information. */
1660
1661___SCMOBJlong ___os_file_info
1662 ___P((___SCMOBJ path,(long path, long chase)
1663 ___SCMOBJ chase),(long path, long chase)
1664 (path,(long path, long chase)
1665 chase)(long path, long chase)
1666___SCMOBJ path;(long path, long chase)
1667___SCMOBJ chase;)(long path, long chase)
1668{
1669 ___SCMOBJlong e;
1670 ___SCMOBJlong result;
1671 ___SCMOBJlong x;
1672 void *cpath;
1673
1674#ifndef USE_stat
1675#ifndef USE_GetFileAttributesEx
1676
1677#define ___INFO_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native native
1678
1679 if ((e = ___SCMOBJ_to_NONNULLSTRING
1680 (path,
1681 &cpath,
1682 1,
1683 ___CE(___INFO_PATH_CE_SELECT)(20<<0),
1684 0))
1685 == ___FIX(___NO_ERR)(((long)(0))<<2))
1686 {
1687 ___FILE *check_exist = ___fopen (cpath, "r");
1688
1689 if (check_exist == 0)
1690 {
1691 e = fnf_or_err_code_from_errno ()___err_code_from_errno();
1692 ___release_string (cpath);
1693 return e;
1694 }
1695
1696 ___fclose (check_exist);
1697
1698 ___release_string (cpath);
1699
1700 result = ___make_vector (14, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1701
1702 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1703 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/**********/
1704
1705 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(0)(((long)(0))<<2); /* unknown type */
1706 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(0)(((long)(0))<<2);
1707 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = ___FIX(0)(((long)(0))<<2);
1708 ___FIELD(result,4)(*((((long*)((result)-(1)))+1)+4)) = ___FIX(0)(((long)(0))<<2);
1709 ___FIELD(result,5)(*((((long*)((result)-(1)))+1)+5)) = ___FIX(0)(((long)(0))<<2);
1710 ___FIELD(result,6)(*((((long*)((result)-(1)))+1)+6)) = ___FIX(0)(((long)(0))<<2);
1711 ___FIELD(result,7)(*((((long*)((result)-(1)))+1)+7)) = ___FIX(0)(((long)(0))<<2);
1712 ___FIELD(result,8)(*((((long*)((result)-(1)))+1)+8)) = ___FIX(0)(((long)(0))<<2);
1713
1714 if ((e = ___F64_to_SCMOBJ (___CAST(___F64,NEG_INFINITY)((double)((-1.7976931348623157e308))),
1715 &x,
1716 ___RETURN_POS127))
1717 != ___FIX(___NO_ERR)(((long)(0))<<2))
1718 {
1719 ___release_scmobj (result);
1720 return e;
1721 }
1722
1723 ___FIELD(result,9)(*((((long*)((result)-(1)))+1)+9)) = x;
1724 ___FIELD(result,10)(*((((long*)((result)-(1)))+1)+10)) = x;
1725 ___FIELD(result,11)(*((((long*)((result)-(1)))+1)+11)) = x;
1726 ___FIELD(result,12)(*((((long*)((result)-(1)))+1)+12)) = ___FIX(0)(((long)(0))<<2);
1727 ___FIELD(result,13)(*((((long*)((result)-(1)))+1)+13)) = x;
1728
1729 ___release_scmobj (x);
1730
1731 ___release_scmobj (result);
1732
1733 return result;
1734 }
1735
1736#endif
1737#endif
1738
1739#ifdef USE_stat
1740
1741#define ___INFO_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native native
1742
1743 if ((e = ___SCMOBJ_to_NONNULLSTRING
1744 (path,
1745 &cpath,
1746 1,
1747 ___CE(___INFO_PATH_CE_SELECT)(20<<0),
1748 0))
1749 == ___FIX(___NO_ERR)(((long)(0))<<2))
1750 {
1751 ___struct_statstruct stat s;
1752
1753 if (((chase == ___FAL((((long)(-1))<<2)+2))
1754 ? ___lstatlstat (___CAST(___STRING_TYPE(___INFO_PATH_CE_SELECT),cpath)((char*)(cpath)), &s)
1755 : ___statstat (___CAST(___STRING_TYPE(___INFO_PATH_CE_SELECT),cpath)((char*)(cpath)), &s))
1756 < 0)
1757 {
1758 e = fnf_or_err_code_from_errno ()___err_code_from_errno();
1759 ___release_string (cpath);
1760 return e;
1761 }
1762
1763 ___release_string (cpath);
1764
1765 result = ___make_vector (14, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1766
1767 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1768 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/**********/
1769
1770 if (S_ISREG(s.st_mode)((((s.st_mode)) & 0170000) == (0100000)))
1771 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(1)(((long)(1))<<2);
1772 else if (S_ISDIR(s.st_mode)((((s.st_mode)) & 0170000) == (0040000)))
1773 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(2)(((long)(2))<<2);
1774 else if (S_ISCHR(s.st_mode)((((s.st_mode)) & 0170000) == (0020000)))
1775 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(3)(((long)(3))<<2);
1776 else if (S_ISBLK(s.st_mode)((((s.st_mode)) & 0170000) == (0060000)))
1777 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(4)(((long)(4))<<2);
1778 else if (S_ISFIFO(s.st_mode)((((s.st_mode)) & 0170000) == (0010000)))
1779 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(5)(((long)(5))<<2);
1780 else if (S_ISLNK(s.st_mode)((((s.st_mode)) & 0170000) == (0120000)))
1781 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(6)(((long)(6))<<2);
1782 else if (S_ISSOCK(s.st_mode)((((s.st_mode)) & 0170000) == (0140000)))
1783 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(7)(((long)(7))<<2);
1784 else
1785 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(0)(((long)(0))<<2);
1786
1787 if ((e = ___ULONGLONG_to_SCMOBJ (___CAST(___ULONGLONG,s.st_dev)((unsigned long long)(s.st_dev)),
1788 &x,
1789 ___RETURN_POS127))
1790 != ___FIX(___NO_ERR)(((long)(0))<<2))
1791 {
1792 ___release_scmobj (result);
1793 return e;
1794 }
1795
1796 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = x;
1797 ___release_scmobj (x);
1798
1799 if ((e = ___LONGLONG_to_SCMOBJ (___CAST(___LONGLONG,s.st_ino)((long long)(s.st_ino)),
1800 &x,
1801 ___RETURN_POS127))
1802 != ___FIX(___NO_ERR)(((long)(0))<<2))
1803 {
1804 ___release_scmobj (result);
1805 return e;
1806 }
1807
1808 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = x;
1809 ___release_scmobj (x);
1810
1811 ___FIELD(result,4)(*((((long*)((result)-(1)))+1)+4)) =
1812 ___FIX(s.st_mode & (S_ISUID|S_ISGID|S_ISVTX|S_IRWXU|S_IRWXG|S_IRWXO))(((long)(s.st_mode & (04000|02000|01000|(0400|0200|0100)|
((0400|0200|0100) >> 3)|(((0400|0200|0100) >> 3) >>
3))))<<2);
1813
1814 if ((e = ___ULONGLONG_to_SCMOBJ (___CAST(___ULONGLONG,s.st_nlink)((unsigned long long)(s.st_nlink)),
1815 &x,
1816 ___RETURN_POS127))
1817 != ___FIX(___NO_ERR)(((long)(0))<<2))
1818 {
1819 ___release_scmobj (result);
1820 return e;
1821 }
1822
1823 ___FIELD(result,5)(*((((long*)((result)-(1)))+1)+5)) = x;
1824 ___release_scmobj (x);
1825
1826 ___FIELD(result,6)(*((((long*)((result)-(1)))+1)+6)) = ___FIX(s.st_uid)(((long)(s.st_uid))<<2);
1827
1828 ___FIELD(result,7)(*((((long*)((result)-(1)))+1)+7)) = ___FIX(s.st_gid)(((long)(s.st_gid))<<2);
1829
1830 if ((e = ___LONGLONG_to_SCMOBJ (___CAST(___LONGLONG,s.st_size)((long long)(s.st_size)),
1831 &x,
1832 ___RETURN_POS127))
1833 != ___FIX(___NO_ERR)(((long)(0))<<2))
1834 {
1835 ___release_scmobj (result);
1836 return e;
1837 }
1838
1839 ___FIELD(result,8)(*((((long*)((result)-(1)))+1)+8)) = x;
1840 ___release_scmobj (x);
1841
1842 if ((e = ___F64_to_SCMOBJ (___CAST(___F64,s.st_atime)((double)(s.st_atim.tv_sec)), &x, ___RETURN_POS127))
1843 != ___FIX(___NO_ERR)(((long)(0))<<2))
1844 {
1845 ___release_scmobj (result);
1846 return e;
1847 }
1848
1849 ___FIELD(result,9)(*((((long*)((result)-(1)))+1)+9)) = x;
1850 ___release_scmobj (x);
1851
1852 if ((e = ___F64_to_SCMOBJ (___CAST(___F64,s.st_mtime)((double)(s.st_mtim.tv_sec)), &x, ___RETURN_POS127))
1853 != ___FIX(___NO_ERR)(((long)(0))<<2))
1854 {
1855 ___release_scmobj (result);
1856 return e;
1857 }
1858
1859 ___FIELD(result,10)(*((((long*)((result)-(1)))+1)+10)) = x;
1860 ___release_scmobj (x);
1861
1862 if ((e = ___F64_to_SCMOBJ (___CAST(___F64,s.st_ctime)((double)(s.st_ctim.tv_sec)), &x, ___RETURN_POS127))
1863 != ___FIX(___NO_ERR)(((long)(0))<<2))
1864 {
1865 ___release_scmobj (result);
1866 return e;
1867 }
1868
1869 ___FIELD(result,11)(*((((long*)((result)-(1)))+1)+11)) = x;
1870 ___release_scmobj (x);
1871
1872#ifndef FILE_ATTRIBUTE_READ_ONLY1
1873#define FILE_ATTRIBUTE_READ_ONLY1 1
1874#endif
1875
1876#ifndef FILE_ATTRIBUTE_DIRECTORY16
1877#define FILE_ATTRIBUTE_DIRECTORY16 16
1878#endif
1879
1880#ifndef FILE_ATTRIBUTE_NORMAL128
1881#define FILE_ATTRIBUTE_NORMAL128 128
1882#endif
1883
1884 ___FIELD(result,12)(*((((long*)((result)-(1)))+1)+12)) =
1885 ___FIX(S_ISDIR(s.st_mode)(((long)(((((s.st_mode)) & 0170000) == (0040000)) ? 16 : 128
))<<2)
1886 ? FILE_ATTRIBUTE_DIRECTORY(((long)(((((s.st_mode)) & 0170000) == (0040000)) ? 16 : 128
))<<2)
1887 : FILE_ATTRIBUTE_NORMAL)(((long)(((((s.st_mode)) & 0170000) == (0040000)) ? 16 : 128
))<<2);
1888
1889 if ((e = ___F64_to_SCMOBJ (___CAST(___F64,NEG_INFINITY)((double)((-1.7976931348623157e308))),
1890 &x,
1891 ___RETURN_POS127))
1892 != ___FIX(___NO_ERR)(((long)(0))<<2))
1893 {
1894 ___release_scmobj (result);
1895 return e;
1896 }
1897
1898 ___FIELD(result,13)(*((((long*)((result)-(1)))+1)+13)) = x;
1899 ___release_scmobj (x);
1900
1901 ___release_scmobj (result);
1902
1903 return result;
1904 }
1905
1906#endif
1907
1908#ifdef USE_GetFileAttributesEx
1909
1910#ifdef _UNICODE
1911#define ___INFO_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native ucs2
1912#else
1913#define ___INFO_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native native
1914#endif
1915
1916 if ((e = ___SCMOBJ_to_NONNULLSTRING
1917 (path,
1918 &cpath,
1919 1,
1920 ___CE(___INFO_PATH_CE_SELECT)(20<<0),
1921 0))
1922 == ___FIX(___NO_ERR)(((long)(0))<<2))
1923 {
1924 WIN32_FILE_ATTRIBUTE_DATA fad;
1925
1926 if (!GetFileAttributesEx
1927 (___CAST(___STRING_TYPE(___INFO_PATH_CE_SELECT),cpath)((char*)(cpath)),
1928 GetFileExInfoStandard,
1929 &fad))
1930 {
1931 e = err_code_from_GetLastError ()___err_code_from_GetLastError();
1932 ___release_string (cpath);
1933 return e;
1934 }
1935
1936 ___release_string (cpath);
1937
1938 result = ___make_vector (14, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1939
1940 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1941 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/**********/
1942
1943 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY16)
1944 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(2)(((long)(2))<<2);
1945 else
1946 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = ___FIX(1)(((long)(1))<<2);
1947
1948 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(0)(((long)(0))<<2);
1949 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = ___FIX(0)(((long)(0))<<2);
1950
1951 if (fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
1952 ___FIELD(result,4)(*((((long*)((result)-(1)))+1)+4)) = ___FIX(0333)(((long)(0333))<<2);
1953 else
1954 ___FIELD(result,4)(*((((long*)((result)-(1)))+1)+4)) = ___FIX(0777)(((long)(0777))<<2);
1955
1956 ___FIELD(result,5)(*((((long*)((result)-(1)))+1)+5)) = ___FIX(1)(((long)(1))<<2);
1957 ___FIELD(result,6)(*((((long*)((result)-(1)))+1)+6)) = ___FIX(0)(((long)(0))<<2);
1958 ___FIELD(result,7)(*((((long*)((result)-(1)))+1)+7)) = ___FIX(0)(((long)(0))<<2);
1959
1960 if ((e = ___U64_to_SCMOBJ
1961 (___U64_from_UM32_UM32(fad.nFileSizeHigh,fad.nFileSizeLow)((((unsigned long)(((unsigned int)(fad.nFileSizeHigh)))) <<
32) + ((unsigned long)(((unsigned int)(fad.nFileSizeLow))))),
1962 &x,
1963 ___RETURN_POS127))
1964 != ___FIX(___NO_ERR)(((long)(0))<<2))
1965 {
1966 ___release_scmobj (result);
1967 return e;
1968 }
1969
1970 ___FIELD(result,8)(*((((long*)((result)-(1)))+1)+8)) = x;
1971 ___release_scmobj (x);
1972
1973 if ((e = ___F64_to_SCMOBJ
1974 (___CAST(___F64,FILETIME_TO_TIME(fad.ftLastAccessTime))((double)(((((fad.ftLastAccessTime).dwHighDateTime * 4294967296.0
+ (fad.ftLastAccessTime).dwLowDateTime) / 1.0e7) - (((730119
- ((1601LL)-1)*365 - ((1601LL)-1)/4 + ((1601LL)-1)/100 - ((1601LL
)-1)/400) - (730119 - ((1970)-1)*365 - ((1970)-1)/4 + ((1970)
-1)/100 - ((1970)-1)/400)) * 24 * 60 * 60)))),
1975 &x,
1976 ___RETURN_POS127))
1977 != ___FIX(___NO_ERR)(((long)(0))<<2))
1978 {
1979 ___release_scmobj (result);
1980 return e;
1981 }
1982
1983 ___FIELD(result,9)(*((((long*)((result)-(1)))+1)+9)) = x;
1984 ___release_scmobj (x);
1985
1986 if ((e = ___F64_to_SCMOBJ
1987 (___CAST(___F64,FILETIME_TO_TIME(fad.ftLastWriteTime))((double)(((((fad.ftLastWriteTime).dwHighDateTime * 4294967296.0
+ (fad.ftLastWriteTime).dwLowDateTime) / 1.0e7) - (((730119 -
((1601LL)-1)*365 - ((1601LL)-1)/4 + ((1601LL)-1)/100 - ((1601LL
)-1)/400) - (730119 - ((1970)-1)*365 - ((1970)-1)/4 + ((1970)
-1)/100 - ((1970)-1)/400)) * 24 * 60 * 60)))),
1988 &x,
1989 ___RETURN_POS127))
1990 != ___FIX(___NO_ERR)(((long)(0))<<2))
1991 {
1992 ___release_scmobj (result);
1993 return e;
1994 }
1995
1996 ___FIELD(result,10)(*((((long*)((result)-(1)))+1)+10)) = x;
1997 ___FIELD(result,11)(*((((long*)((result)-(1)))+1)+11)) = x;
1998 ___release_scmobj (x);
1999
2000 ___FIELD(result,12)(*((((long*)((result)-(1)))+1)+12)) = ___FIX(fad.dwFileAttributes)(((long)(fad.dwFileAttributes))<<2);
2001
2002 if ((e = ___F64_to_SCMOBJ
2003 (___CAST(___F64,FILETIME_TO_TIME(fad.ftCreationTime))((double)(((((fad.ftCreationTime).dwHighDateTime * 4294967296.0
+ (fad.ftCreationTime).dwLowDateTime) / 1.0e7) - (((730119 -
((1601LL)-1)*365 - ((1601LL)-1)/4 + ((1601LL)-1)/100 - ((1601LL
)-1)/400) - (730119 - ((1970)-1)*365 - ((1970)-1)/4 + ((1970)
-1)/100 - ((1970)-1)/400)) * 24 * 60 * 60)))),
2004 &x,
2005 ___RETURN_POS127))
2006 != ___FIX(___NO_ERR)(((long)(0))<<2))
2007 {
2008 ___release_scmobj (result);
2009 return e;
2010 }
2011
2012 ___FIELD(result,13)(*((((long*)((result)-(1)))+1)+13)) = x;
2013 ___release_scmobj (x);
2014
2015 ___release_scmobj (result);
2016
2017 return result;
2018 }
2019
2020#endif
2021
2022 return e;
2023}
2024
2025
2026/* - - - - - - - - - - - - - - - - - - */
2027
2028/* Access to user information. */
2029
2030___SCMOBJlong ___os_user_info
2031 ___P((___SCMOBJ user),(long user)
2032 (user)(long user)
2033___SCMOBJ user;)(long user)
2034{
2035 ___SCMOBJlong e = ___FIX(___NO_ERR)(((long)(0))<<2);
2036 ___SCMOBJlong result;
2037 ___SCMOBJlong x;
2038 void *cuser = 0;
2039
2040#ifndef USE_getpwnam
2041
2042 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
2043
2044#endif
2045
2046#ifdef USE_getpwnam
2047
2048 struct passwd *p;
2049
2050#define ___USER_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native native
2051
2052 if (___FIXNUMP(user)(((user)&((1<<2)-1))==(0)) ||
2053 (e = ___SCMOBJ_to_NONNULLSTRING
2054 (user,
2055 &cuser,
2056 1,
2057 ___CE(___USER_CE_SELECT)(20<<0),
2058 0))
2059 == ___FIX(___NO_ERR)(((long)(0))<<2))
2060 {
2061 if (___FIXNUMP(user)(((user)&((1<<2)-1))==(0)))
2062 {
2063 if ((p = getpwuid (___INT(user)((user)>>2)))
2064 == 0)
2065 {
2066 e = err_code_from_errno ()___err_code_from_errno();
2067 return e;
2068 }
2069 }
2070 else
2071 {
2072 if ((p = getpwnam (___CAST(___STRING_TYPE(___USER_CE_SELECT),cuser)((char*)(cuser))))
2073 == 0)
2074 {
2075 e = err_code_from_errno ()___err_code_from_errno();
2076 ___release_string (cuser);
2077 return e;
2078 }
2079
2080 ___release_string (cuser);
2081 }
2082
2083 result = ___make_vector (6, ___FAL((((long)(-1))<<2)+2), ___STILL5);
2084
2085 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
2086 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/**********/
2087
2088 if ((e = ___NONNULLCHARSTRING_to_SCMOBJ
2089 (p->pw_name,
2090 &x,
2091 ___RETURN_POS127))
2092 != ___FIX(___NO_ERR)(((long)(0))<<2))
2093 {
2094 ___release_scmobj (result);
2095 return e;
2096 }
2097
2098 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = x;
2099 ___release_scmobj (x);
2100
2101 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(p->pw_uid)(((long)(p->pw_uid))<<2);
2102
2103 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = ___FIX(p->pw_gid)(((long)(p->pw_gid))<<2);
2104
2105 if ((e = ___NONNULLCHARSTRING_to_SCMOBJ
2106 (p->pw_dir,
2107 &x,
2108 ___RETURN_POS127))
2109 != ___FIX(___NO_ERR)(((long)(0))<<2))
2110 {
2111 ___release_scmobj (result);
2112 return e;
2113 }
2114
2115 ___FIELD(result,4)(*((((long*)((result)-(1)))+1)+4)) = x;
2116 ___release_scmobj (x);
2117
2118 if ((e = ___NONNULLCHARSTRING_to_SCMOBJ
2119 (p->pw_shell,
2120 &x,
2121 ___RETURN_POS127))
2122 != ___FIX(___NO_ERR)(((long)(0))<<2))
2123 {
2124 ___release_scmobj (result);
2125 return e;
2126 }
2127
2128 ___FIELD(result,5)(*((((long*)((result)-(1)))+1)+5)) = x;
2129 ___release_scmobj (x);
2130
2131 ___release_scmobj (result);
2132
2133 return result;
2134 }
2135
2136#endif
2137
2138 return e;
2139}
2140
2141
2142___SCMOBJlong ___os_user_name ___PVOID(void)
2143{
2144 ___SCMOBJlong e;
2145 ___SCMOBJlong result;
2146 ___UCS_2STRINGunsigned short* cstr;
2147
2148#ifdef USE_WIN32
2149
2150 static ___UCS_2unsigned short cvar[] =
2151 { 'U', 'S', 'E', 'R', 'N', 'A', 'M', 'E', '\0' };
2152
2153#else
2154
2155 static ___UCS_2unsigned short cvar[] =
2156 { 'U', 'S', 'E', 'R', '\0' };
2157
2158#endif
2159
2160 if ((e = ___getenv_UCS_2 (cvar, &cstr)) != ___FIX(___NO_ERR)(((long)(0))<<2))
2161 result = e;
2162 else
2163 {
2164 if ((e = ___UCS_2STRING_to_SCMOBJ
2165 (cstr,
2166 &result,
2167 ___RETURN_POS127))
2168 != ___FIX(___NO_ERR)(((long)(0))<<2))
2169 result = e;
2170 else
2171 ___release_scmobj (result);
2172
2173 if (cstr != 0)
2174 ___free_mem (cstr);
2175 }
2176
2177 return result;
2178}
2179
2180
2181/* - - - - - - - - - - - - - - - - - - */
2182
2183/* Access to group information. */
2184
2185___SCMOBJlong ___os_group_info
2186 ___P((___SCMOBJ group),(long group)
2187 (group)(long group)
2188___SCMOBJ group;)(long group)
2189{
2190 ___SCMOBJlong e = ___FIX(___NO_ERR)(((long)(0))<<2);
2191 ___SCMOBJlong result;
2192 ___SCMOBJlong x;
2193 void *cgroup = 0;
2194
2195#ifndef USE_getgrnam
2196
2197 return ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+4)))<<2);
2198
2199#endif
2200
2201#ifdef USE_getgrnam
2202
2203 struct group *g;
2204
2205#define ___GROUP_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native)native native
2206
2207 if (___FIXNUMP(group)(((group)&((1<<2)-1))==(0)) ||
2208 (e = ___SCMOBJ_to_NONNULLSTRING
2209 (group,
2210 &cgroup,
2211 1,
2212 ___CE(___GROUP_CE_SELECT)(20<<0),
2213 0))
2214 == ___FIX(___NO_ERR)(((long)(0))<<2))
2215 {
2216 if (___FIXNUMP(group)(((group)&((1<<2)-1))==(0)))
2217 {
2218 if ((g = getgrgid (___INT(group)((group)>>2)))
2219 == 0)
2220 {
2221 e = err_code_from_errno ()___err_code_from_errno();
2222 return e;
2223 }
2224 }
2225 else
2226 {
2227 if ((g = getgrnam (___CAST(___STRING_TYPE(___GROUP_CE_SELECT),cgroup)((char*)(cgroup))))
2228 == 0)
2229 {
2230 e = err_code_from_errno ()___err_code_from_errno();
2231 ___release_string (cgroup);
2232 return e;
2233 }
2234
2235 ___release_string (cgroup);
2236 }
2237
2238 result = ___make_vector (3, ___FAL((((long)(-1))<<2)+2), ___STILL5);
2239
2240 if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
2241 return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+___RETURN_POS)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+(
0))+(125<<7))+127))<<2);/**********/
2242
2243 if ((e = ___NONNULLCHARSTRING_to_SCMOBJ
2244 (g->gr_name,
2245 &x,
2246 ___RETURN_POS127))
2247 != ___FIX(___NO_ERR)(((long)(0))<<2))
2248 {
2249 ___release_scmobj (result);
2250 return e;
2251 }
2252
2253 ___FIELD(result,1)(*((((long*)((result)-(1)))+1)+1)) = x;
2254 ___release_scmobj (x);
2255
2256 ___FIELD(result,2)(*((((long*)((result)-(1)))+1)+2)) = ___FIX(g->gr_gid)(((long)(g->gr_gid))<<2);
2257
2258 if ((e = ___NONNULLCHARSTRINGLIST_to_SCMOBJ
2259 (g->gr_mem,
2260 &x,
2261 ___RETURN_POS127))
2262 != ___FIX(___NO_ERR)(((long)(0))<<2))
2263 {
2264 ___release_scmobj (result);
2265 return e;
2266 }
2267
2268 ___FIELD(result,3)(*((((long*)((result)-(1)))+1)+3)) = x;
2269 ___release_scmobj (x);
2270
2271 ___release_scmobj (result);
2272
2273 return result;
2274 }
2275
2276#endif
2277
2278 return e;
2279}
2280
2281
2282/* - - - - - - - - - - - - - - - - - - */
2283
2284/* Access to process information. */
2285
2286___SCMOBJlong ___os_getpid ___PVOID(void)
2287{
2288#ifndef USE_getpid
2289#ifndef USE_GetCurrentProcessId
2290
2291 return ___FIX(0)(((long)(0))<<2);
2292
2293#endif
2294#endif
2295
2296#ifdef USE_getpid
2297
2298 return ___FIX(getpid())(((long)(getpid()))<<2);
2299
2300#endif
2301
2302#ifdef USE_GetCurrentProcessId
2303
2304 return ___FIX(GetCurrentProcessId())(((long)(GetCurrentProcessId()))<<2);
2305
2306#endif
2307}
2308
2309
2310___SCMOBJlong ___os_getppid ___PVOID(void)
2311{
2312#ifndef USE_getppid
2313
2314 return ___FIX(0)(((long)(0))<<2);
2315
2316#endif
2317
2318#ifdef USE_getppid
2319
2320 return ___FIX(getppid())(((long)(getppid()))<<2);
2321
2322#endif
2323}
2324
2325
2326/*---------------------------------------------------------------------------*/
2327
2328/* System type information. */
2329
2330
2331#ifndef ___SYS_TYPE_CPU"x86_64"
2332#define ___SYS_TYPE_CPU"x86_64" "unknown"
2333#endif
2334
2335#ifndef ___SYS_TYPE_VENDOR"unknown"
2336#define ___SYS_TYPE_VENDOR"unknown" "unknown"
2337#endif
2338
2339#ifndef ___SYS_TYPE_OS"linux-gnu"
2340#define ___SYS_TYPE_OS"linux-gnu" "unknown"
2341#endif
2342
2343#ifndef ___CONFIGURE_COMMAND"./configure '--enable-single-host' '--enable-multiple-versions' 'CC=/usr/share/clang/scan-build/ccc-analyzer' 'CXX=/usr/share/clang/scan-build/c++-analyzer'"
2344#define ___CONFIGURE_COMMAND"./configure '--enable-single-host' '--enable-multiple-versions' 'CC=/usr/share/clang/scan-build/ccc-analyzer' 'CXX=/usr/share/clang/scan-build/c++-analyzer'" "unknown"
2345#endif
2346
2347
2348___HIDDENstatic char *os_sys_type[] =
2349{ ___SYS_TYPE_CPU"x86_64", ___SYS_TYPE_VENDOR"unknown", ___SYS_TYPE_OS"linux-gnu", NULL((void*)0) };
2350
2351
2352___HIDDENstatic char *os_sys_type_string =
2353___SYS_TYPE_CPU"x86_64" "-" ___SYS_TYPE_VENDOR"unknown" "-" ___SYS_TYPE_OS"linux-gnu";
2354
2355
2356___HIDDENstatic char *configure_command_string = ___CONFIGURE_COMMAND"./configure '--enable-single-host' '--enable-multiple-versions' 'CC=/usr/share/clang/scan-build/ccc-analyzer' 'CXX=/usr/share/clang/scan-build/c++-analyzer'";
2357
2358
2359char **___os_system_type ___PVOID(void)
2360{
2361 return os_sys_type;
2362}
2363
2364
2365char *___os_system_type_string ___PVOID(void)
2366{
2367 return os_sys_type_string;
2368}
2369
2370
2371char *___os_configure_command_string ___PVOID(void)
2372{
2373 return configure_command_string;
2374}
2375
2376
2377/*---------------------------------------------------------------------------*/
2378
2379/* C compilation environment information. */
2380
2381
2382#ifndef ___OBJ_EXTENSION".o"
2383#define ___OBJ_EXTENSION".o" ".obj"
2384#endif
2385
2386#ifndef ___EXE_EXTENSION""
2387#define ___EXE_EXTENSION"" ".exe"
2388#endif
2389
2390#ifndef ___BAT_EXTENSION""
2391#define ___BAT_EXTENSION"" ".bat"
2392#endif
2393
2394
2395___HIDDENstatic char *os_obj_extension_string = ___OBJ_EXTENSION".o";
2396
2397___HIDDENstatic char *os_exe_extension_string = ___EXE_EXTENSION"";
2398
2399___HIDDENstatic char *os_bat_extension_string = ___BAT_EXTENSION"";
2400
2401
2402char *___os_obj_extension_string ___PVOID(void)
2403{
2404 return os_obj_extension_string;
2405}
2406
2407
2408char *___os_exe_extension_string ___PVOID(void)
2409{
2410 return os_exe_extension_string;
2411}
2412
2413
2414char *___os_bat_extension_string ___PVOID(void)
2415{
2416 return os_bat_extension_string;
2417}
2418
2419
2420/*---------------------------------------------------------------------------*/
2421
2422
2423___HIDDENstatic void heartbeat_intr ___PVOID(void)
2424{
2425 /**** belongs elsewhere */
2426 ___raise_interrupt (___INTR_HEARTBEAT1);
2427}
2428
2429
2430___HIDDENstatic void user_intr ___PVOID(void)
2431{
2432 /**** belongs elsewhere */
2433 ___raise_interrupt (___INTR_USER0);
2434}
2435
2436
2437___HIDDENstatic void terminate_intr ___PVOID(void)
2438{
2439 /**** belongs elsewhere */
2440 ___raise_interrupt (___INTR_TERMINATE3);
2441}
2442
2443
2444___SCMOBJlong ___setup_os ___PVOID(void)
2445{
2446 ___SCMOBJlong e;
2447
2448 /*
2449 * To perform correct cleanup when the program terminates an
2450 * "atexit (___cleanup)" is performed in "setup_io" in certain
2451 * environments. There must not be any possibility of program
2452 * termination through "exit (...)" between the "atexit (...)"
2453 * and the entry of "___setup_mem". This guarantees that
2454 * "___cleanup" does not access dangling pointers.
2455 */
2456
2457 if ((e = ___setup_base_module ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
2458 {
2459 if ((e = ___setup_time_module (heartbeat_intr)) == ___FIX(___NO_ERR)(((long)(0))<<2))
2460 {
2461 if ((e = ___setup_shell_module ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
2462 {
2463 if ((e = ___setup_files_module ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
2464 {
2465 if ((e = ___setup_dyn_module ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
2466 {
2467 if ((e = ___setup_tty_module (user_intr, terminate_intr)) == ___FIX(___NO_ERR)(((long)(0))<<2))
2468 {
2469 if ((e = ___setup_io_module ()) == ___FIX(___NO_ERR)(((long)(0))<<2))
2470 {
2471#ifdef USE_POSIX
2472 ___set_signal_handler (SIGPIPE13, SIG_IGN((__sighandler_t) 1)); /***** belongs elsewhere */
2473#endif
2474 return ___FIX(___NO_ERR)(((long)(0))<<2);
2475 }
2476 ___cleanup_tty_module ();
2477 }
2478 ___cleanup_dyn_module ();
2479 }
2480 ___cleanup_files_module ();
2481 }
2482 ___cleanup_shell_module ();
2483 }
2484 ___cleanup_time_module ();
2485 }
2486 ___cleanup_base_module ();
2487 }
2488
2489 return e;
2490}
2491
2492
2493void ___cleanup_os ___PVOID(void)
2494{
2495 ___cleanup_io_module ();
2496 ___cleanup_tty_module ();
2497 ___cleanup_dyn_module ();
2498 ___cleanup_files_module ();
2499 ___cleanup_shell_module ();
2500 ___cleanup_time_module ();
2501 ___cleanup_base_module ();
2502}
2503
2504
2505/*---------------------------------------------------------------------------*/