-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathlibc.scm
1888 lines (1743 loc) · 106 KB
/
libc.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; libc.scm
;;;
;;; tie the C library into the *libc* environment
(provide 'libc.scm)
;; if loading from a different directory, pass that info to C
(let ((directory (let ((current-file (port-filename)))
(and (memv (current-file 0) '(#\/ #\~))
(substring current-file 0 (- (length current-file) 9))))))
(when (and directory (not (member directory *load-path*)))
(set! *load-path* (cons directory *load-path*)))
(with-let (rootlet)
(require cload.scm))
(when (and directory (not (string-position directory *cload-cflags*)))
(set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*))))
(unless (defined? '*libc*)
(define *libc*
(with-let (sublet (unlet))
(set! *cload-library-name* "*libc*")
(set! *libraries* (cons (cons "libc.scm" (curlet)) *libraries*))
;; -------- stddef.h --------
(define NULL (c-pointer 0 'void*))
;(define (c-null? p) (and (c-pointer? p) (zero? (car (c-pointer->list p)))))
;; -------- stdbool.h --------
;(define false #f)
;(define true #t)
;scheme objects like false or c-null in *libc* will not appear in *libc* normally: no s7_define -> shadow_rootlet,
; and this file itself is not loaded except when libc_s7.c is written (when libc_s7.so is out of date)
;; -------- iso646.h --------
;; spelled-out names for & = bitand et al
;; -------- stdarg.h --------
;; the varargs macros
;; -------- assert.h --------
;; assert macro
#|
(define-expansion (assert assertion)
(reader-cond ((not (defined? 'NDEBUG))
`(if (not ,assertion)
(error 'assert-failure "~S[~D]: ~A failed~%"
(port-filename) (port-line-number) ',assertion)))
(#t (values))))
(define (hiho a) (assert (> a 2)) (+ a 1))
|#
;; -------- setjmp.h --------
;; longjmp etc
;; -------- dlfn.h --------
;; see libdl.scm, similarly for pthreads see libpthread.scm
;; -------- sys/types.h inttypes.h getopt.h--------
;; C type declarations
(c-define
'(;; -------- limits.h --------
(C-macro (int (SCHAR_MIN SCHAR_MAX UCHAR_MAX CHAR_BIT CHAR_MIN CHAR_MAX __WORDSIZE
SHRT_MIN SHRT_MAX USHRT_MAX INT_MIN INT_MAX UINT_MAX LONG_MIN LONG_MAX ULONG_MAX
LLONG_MIN LLONG_MAX ULLONG_MAX
_POSIX_AIO_LISTIO_MAX _POSIX_AIO_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_DELAYTIMER_MAX _POSIX_HOST_NAME_MAX
_POSIX_LINK_MAX _POSIX_LOGIN_NAME_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_MQ_OPEN_MAX _POSIX_MQ_PRIO_MAX
_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_FD_SETSIZE _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_RE_DUP_MAX
_POSIX_RTSIG_MAX _POSIX_SEM_NSEMS_MAX _POSIX_SEM_VALUE_MAX _POSIX_SIGQUEUE_MAX _POSIX_SSIZE_MAX _POSIX_STREAM_MAX
_POSIX_SYMLINK_MAX _POSIX_SYMLOOP_MAX _POSIX_TIMER_MAX _POSIX_TTY_NAME_MAX _POSIX_TZNAME_MAX _POSIX_QLIMIT
_POSIX_HIWAT _POSIX_UIO_MAXIOV _POSIX_CLOCKRES_MIN SSIZE_MAX NGROUPS_MAX _POSIX2_BC_BASE_MAX _POSIX2_BC_DIM_MAX
_POSIX2_BC_SCALE_MAX _POSIX2_BC_STRING_MAX _POSIX2_COLL_WEIGHTS_MAX _POSIX2_EXPR_NEST_MAX _POSIX2_LINE_MAX
_POSIX2_RE_DUP_MAX _POSIX2_CHARCLASS_NAME_MAX BC_BASE_MAX BC_DIM_MAX BC_SCALE_MAX BC_STRING_MAX COLL_WEIGHTS_MAX
EXPR_NEST_MAX LINE_MAX CHARCLASS_NAME_MAX RE_DUP_MAX)))
;; -------- float.h --------
(C-macro (int (FLT_RADIX FLT_MANT_DIG DBL_MANT_DIG LDBL_MANT_DIG FLT_DIG DBL_DIG LDBL_DIG FLT_MIN_EXP DBL_MIN_EXP
LDBL_MIN_EXP FLT_MIN_10_EXP DBL_MIN_10_EXP LDBL_MIN_10_EXP FLT_MAX_EXP DBL_MAX_EXP LDBL_MAX_EXP
FLT_MAX_10_EXP DBL_MAX_10_EXP LDBL_MAX_10_EXP FLT_ROUNDS FLT_EVAL_METHOD)))
(C-macro (double (FLT_MAX DBL_MAX LDBL_MAX FLT_EPSILON DBL_EPSILON LDBL_EPSILON FLT_MIN DBL_MIN LDBL_MIN)))
;; -------- stdint.h --------
(C-macro (int (INT8_MIN INT16_MIN INT32_MIN INT64_MIN INT8_MAX INT16_MAX INT32_MAX INT64_MAX UINT8_MAX UINT16_MAX
UINT32_MAX UINT64_MAX INT_LEAST8_MIN INT_LEAST16_MIN INT_LEAST32_MIN INT_LEAST64_MIN INT_LEAST8_MAX
INT_LEAST16_MAX INT_LEAST32_MAX INT_LEAST64_MAX UINT_LEAST8_MAX UINT_LEAST16_MAX UINT_LEAST32_MAX
UINT_LEAST64_MAX INT_FAST8_MIN INT_FAST16_MIN INT_FAST32_MIN INT_FAST64_MIN INT_FAST8_MAX INT_FAST16_MAX
INT_FAST32_MAX INT_FAST64_MAX UINT_FAST8_MAX UINT_FAST16_MAX UINT_FAST32_MAX UINT_FAST64_MAX INTPTR_MIN
INTPTR_MAX UINTPTR_MAX INTMAX_MIN INTMAX_MAX UINTMAX_MAX PTRDIFF_MIN PTRDIFF_MAX SIG_ATOMIC_MIN SIG_ATOMIC_MAX
SIZE_MAX WCHAR_MIN WCHAR_MAX WINT_MIN WINT_MAX )))
(FILE* (stdin stdout stderr))
;; -------- endian.h --------
;; also has htobe16 etc
(C-macro (int (__BYTE_ORDER __BIG_ENDIAN __LITTLE_ENDIAN)))
(in-C "
static s7_pointer g_c_pointer_to_string(s7_scheme *sc, s7_pointer args)
{return(s7_make_string_with_length(sc, (const char *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args))));}
static s7_pointer g_string_to_c_pointer(s7_scheme *sc, s7_pointer args)
{
if (s7_is_string(s7_car(args)))
return(s7_make_c_pointer_with_type(sc, (void *)s7_string(s7_car(args)), s7_make_symbol(sc, \"void*\"), s7_F));
return(s7_car(args));
}")
(C-function ("c-pointer->string" g_c_pointer_to_string "" 2))
(C-function ("string->c-pointer" g_string_to_c_pointer "" 1))
;; -------- ctype.h --------
(int isalnum (int))
(int isalpha (int))
(int iscntrl (int))
(int isdigit (int))
(int islower (int))
(int isgraph (int))
(int isprint (int))
(int ispunct (int))
(int isspace (int))
(int isupper (int))
(int isxdigit (int))
(int tolower (int))
(int toupper (int))
;; -------- fcntl.h --------
(C-macro (int (S_IFMT S_IFDIR S_IFCHR S_IFBLK S_IFREG S_IFIFO __S_IFLNK S_IFSOCK S_ISUID S_ISGID S_IRUSR
S_IWUSR S_IXUSR S_IRWXU S_IRGRP S_IWGRP S_IXGRP S_IRWXG S_IROTH S_IWOTH S_IXOTH S_IRWXO R_OK W_OK X_OK
F_OK SEEK_SET SEEK_CUR SEEK_END F_ULOCK F_LOCK F_TLOCK F_TEST O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_CREAT
O_EXCL O_NOCTTY O_TRUNC O_APPEND O_NONBLOCK O_NDELAY O_SYNC O_FSYNC O_ASYNC O_DSYNC O_RSYNC O_LARGEFILE
F_DUPFD F_GETFD F_SETFD F_GETFL F_SETFL F_GETLK F_SETLK F_SETLKW F_GETLK64 F_SETLK64 F_SETLKW64
FD_CLOEXEC F_RDLCK F_WRLCK F_UNLCK POSIX_FADV_NORMAL POSIX_FADV_RANDOM POSIX_FADV_SEQUENTIAL
POSIX_FADV_WILLNEED POSIX_FADV_DONTNEED POSIX_FADV_NOREUSE)))
(int fcntl (int int))
(in-C "
static s7_pointer g_c_open(s7_scheme *sc, s7_pointer args)
{
s7_pointer arg;
char* name;
int flags, mode;
arg = args;
if (s7_is_string(s7_car(arg)))
name = (char*)s7_string(s7_car(arg));
else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 1, s7_car(arg), string_string));
arg = s7_cdr(arg);
if (s7_is_integer(s7_car(arg)))
flags = (int)s7_integer(s7_car(arg));
else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 2, s7_car(arg), integer_string));
if (s7_is_pair(s7_cdr(arg)))
{
arg = s7_cdr(arg);
if (s7_is_integer(s7_car(arg)))
mode = (int)s7_integer(s7_car(arg));
else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'open)\", 14), 3, s7_car(arg), integer_string));
return(s7_make_integer(sc, (s7_int)open(name, flags, mode)));
}
return(s7_make_integer(sc, (s7_int)open(name, flags)));
}")
(C-function ("open" g_c_open "" 2 1))
(int creat (char* (mode_t int)))
(int lockf (int int int))
(reader-cond ((provided? 'linux)
(int posix_fadvise (int int int int))
(int posix_fallocate (int int int))))
;; -------- fenv.h --------
(C-macro (int (FE_INEXACT FE_DIVBYZERO FE_UNDERFLOW FE_OVERFLOW FE_INVALID FE_ALL_EXCEPT
FE_TONEAREST FE_UPWARD FE_DOWNWARD FE_TOWARDZERO)))
(int feclearexcept (int))
(int fegetexceptflag (fexcept_t* int))
(int feraiseexcept (int))
(int fesetexceptflag (fexcept_t* int))
(int fetestexcept (int))
(int fegetround (void))
(int fesetround (int))
(int fegetenv (fenv_t*))
(int feholdexcept (fenv_t*))
(int fesetenv (fenv_t*))
(int feupdateenv (fenv_t*))
;(C-macro (fenv_t* (FE_DFL_ENV)))
(in-C "
static s7_pointer g_fenv_t_make(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(fenv_t)), s7_make_symbol(sc, \"fenv_t*\"), s7_F));}")
(C-function ("fenv_t.make" g_fenv_t_make "" 0))
;; -------- fnmatch.h --------
(C-macro (int (FNM_PATHNAME FNM_NOESCAPE FNM_PERIOD FNM_FILE_NAME FNM_LEADING_DIR FNM_CASEFOLD FNM_EXTMATCH FNM_NOMATCH)))
(int fnmatch (char* char* int))
;; -------- string.h --------
(void* memcpy (void* void* size_t))
(void* memmove (void* void* size_t))
(void* memset (void* int size_t))
(int memcmp (void* void* size_t))
(void* memchr (void* int size_t))
(char* strcpy (char* char*))
(char* strncpy (char* char* size_t))
(char* strcat (char* char*))
(char* strncat (char* char* size_t))
(int strcmp (char* char*))
(int strncmp (char* char* size_t))
(int strcoll (char* char*))
(size_t strxfrm (char* char* size_t))
(char* strchr (char* int))
(char* strrchr (char* int))
(size_t strcspn (char* char*))
(size_t strspn (char* char*))
(char* strpbrk (char* char*))
(char* strstr (char* char*))
(char* strtok (char* char*))
(size_t strlen (char*))
(reader-cond ((not (provided? 'osx)) (size_t strnlen (char* size_t))))
;; strnlen is in OSX 10.8, not 10.6
(char* strerror (int))
(int strcasecmp (char* char*))
(int strncasecmp (char* char* size_t))
#|
(reader-cond
((provided? 'linux)
;; -------- semaphore.h --------
(int sem_init (sem_t* int int))
(int sem_destroy (sem_t*))
(sem_t* sem_open (char* int int int))
(int sem_close (sem_t*))
(int sem_unlink (char*))
(int sem_wait (sem_t*))
(int sem_post (sem_t*))))
;; not in clang??
|#
;; -------- stdio.h --------
(C-macro (int (_IOFBF _IOLBF _IONBF BUFSIZ EOF L_tmpnam TMP_MAX FILENAME_MAX L_ctermid L_cuserid FOPEN_MAX IOV_MAX)))
(C-macro (char* P_tmpdir))
(int remove (char*))
(int rename (char* char*))
(FILE* tmpfile (void))
; (reader-cond ((not (provided? 'osx)) (char* tmpnam (char*)) (char* tempnam (char* char*))))
(int fclose (FILE*))
(int fflush (FILE*))
;; (reader-cond ((provided? 'linux) (int fcloseall (void))))
(FILE* fopen (char* char*))
(FILE* freopen (char* char* FILE*))
(FILE* fdopen (int char*))
(void setbuf (FILE* char*))
(int setvbuf (FILE* char* int size_t))
(void setlinebuf (FILE*))
(int fgetc (FILE*))
(int getc (FILE*))
(int getchar (void))
(int fputc (int FILE*))
(int putc (int FILE*))
(int putchar (int))
(char* fgets (char* int FILE*))
(int fputs (char* FILE*))
(int puts (char*))
(int ungetc (int FILE*))
(size_t fread (void* size_t size_t FILE*))
(size_t fwrite (void* size_t size_t FILE*))
(int fseek (FILE* int int))
(int ftell (FILE*))
(void rewind (FILE*))
(int fgetpos (FILE* fpos_t*))
(int fsetpos (FILE* fpos_t*))
(void clearerr (FILE*))
(int feof (FILE*))
(int ferror (FILE*))
(void perror (char*))
(int fileno (FILE*))
(FILE* popen (char* char*))
(int pclose (FILE*))
(char* ctermid (char*))
;; (reader-cond ((provided? 'linux) (char* cuserid (char*))))
(void flockfile (FILE*))
(int ftrylockfile (FILE*))
(void funlockfile (FILE*))
;; int fprintf (FILE* char* ...)
;; int printf (char* ...)
;; int sprintf (char* char* ...)
;; int vfprintf (FILE* char* va_list)
;; int vprintf (char* va_list)
;; int vsprintf (char* char* va_list)
;; int snprintf (char* size_t char* ...)
;; int vsnprintf (char* size_t char* va_list)
;; int vasprintf (char** char* va_list)
;; int asprintf (char** char* ...)
;; int fscanf (FILE* char* ...)
;; int scanf (char* ...)
;; int sscanf (char* char* ...)
;; int vfscanf (FILE* char* va_list)
;; int vscanf (char* va_list)
;; int vsscanf (char* char* va_list)
;; -------- stdlib.h --------
(C-macro (int (RAND_MAX EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX)))
(double atof (char*))
(int atoi (char*))
(int atol (char*))
(int atoll (char*))
(int random (void))
(void srandom (int))
(char* initstate (int char* size_t))
(char* setstate (char*))
(int rand (void))
(void srand (int))
(void* malloc (size_t))
(void* calloc (size_t size_t))
(void* realloc (void* size_t))
; (void free (void*))
(void abort (void))
(void exit (int))
(char* getenv (char*))
(int putenv (char*))
(int setenv (char* char* int))
(int unsetenv (char*))
; (char* mktemp (char*))
(int mkstemp (char*))
(int system (char*))
; (char* realpath (char* char*))
(int abs (int))
(int labs (int))
(in-C "
static s7_pointer g_llabs(s7_scheme *sc, s7_pointer args)
{
#if ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
return(s7_make_integer(sc, labs(s7_integer(s7_car(args)))));
#else
return(s7_make_integer(sc, llabs(s7_integer(s7_car(args)))));
#endif
}
static s7_pointer g_realpath(s7_scheme *sc, s7_pointer args)
{
char *s7_dl_realpath_0, *res;
if (s7_is_string(s7_car(args)))
s7_dl_realpath_0 = (char*)s7_string(s7_car(args));
else return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'realpath)\", 18), 1, s7_car(args), string_string));
res = realpath(s7_dl_realpath_0, NULL);
if (res) {s7_pointer str; str = s7_make_string(sc, res); free(res); return(str);}
return(s7_F);
}
static s7_pointer g_free(s7_scheme *sc, s7_pointer args)
{free(s7_c_pointer(s7_car(args))); return(s7_F);}
static s7_pointer g_strtod(s7_scheme *sc, s7_pointer args)
{return(s7_make_real(sc, strtod(s7_string(s7_car(args)), NULL)));}
static s7_pointer g_strtof(s7_scheme *sc, s7_pointer args)
{return(s7_make_real(sc, strtof(s7_string(s7_car(args)), NULL)));}
static s7_pointer g_strtol(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, strtol(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
static s7_pointer g_strtoll(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, strtoll(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
static s7_pointer g_ldiv(s7_scheme *sc, s7_pointer args)
{
ldiv_t d;
if (!s7_is_integer(s7_car(args))) return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'ldiv)\", 14), 1, s7_car(args), integer_string));
if (!s7_is_integer(s7_cadr(args))) return(s7_wrong_type_error(sc, s7_make_string_wrapper_with_length(sc, \"(*libc* 'ldiv)\", 14), 2, s7_cadr(args), integer_string));
d = ldiv(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
}
")
(C-function ("llabs" g_llabs "" 1))
(C-function ("free" g_free "" 1))
(C-function ("strtod" g_strtod "" 1))
(C-function ("strtof" g_strtof "" 1))
(C-function ("strtol" g_strtol "" 2))
(C-function ("strtoll" g_strtoll "" 2))
(C-function ("div" g_ldiv "" 2))
(C-function ("ldiv" g_ldiv "" 2))
(C-function ("realpath" g_realpath "" 2))
;; -------- errno.h --------
;; pws for errno?
(C-macro (int (__GLIBC__ __GLIBC_MINOR__ ; features.h from errno.h
ECANCELED EOWNERDEAD ENOTRECOVERABLE ERFKILL EILSEQ
;; asm-generic/errno-base.h
EPERM ENOENT ESRCH EINTR EIO ENXIO E2BIG ENOEXEC EBADF ECHILD EAGAIN ENOMEM EACCES EFAULT
ENOTBLK EBUSY EEXIST EXDEV ENODEV ENOTDIR EISDIR EINVAL ENFILE EMFILE ENOTTY ETXTBSY EFBIG
ENOSPC ESPIPE EROFS EMLINK EPIPE EDOM ERANGE
)))
(in-C "
static s7_pointer g_errno(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, errno));}
static s7_pointer g_set_errno(s7_scheme *sc, s7_pointer args) {errno = (int)s7_integer(s7_car(args)); return(s7_car(args));}")
(C-function ("errno" g_errno "" 0))
(C-function ("set_errno" g_set_errno "" 1))
;; -------- locale.h --------
(C-macro (int (LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL LC_PAPER LC_NAME
LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT LC_IDENTIFICATION)))
(char* setlocale (int char*))
(in-C "
static s7_pointer g_localeconv(s7_scheme *sc, s7_pointer args)
{
struct lconv *lc;
lc = localeconv();
return(s7_inlet(sc, s7_list(sc, 36,
s7_make_symbol(sc, \"decimal_point\"), s7_make_string(sc, lc->decimal_point),
s7_make_symbol(sc, \"thousands_sep\"), s7_make_string(sc, lc->thousands_sep),
s7_make_symbol(sc, \"grouping\"), s7_make_string(sc, lc->grouping),
s7_make_symbol(sc, \"int_curr_symbol\"), s7_make_string(sc, lc->int_curr_symbol),
s7_make_symbol(sc, \"currency_symbol\"), s7_make_string(sc, lc->currency_symbol),
s7_make_symbol(sc, \"mon_decimal_point\"), s7_make_string(sc, lc->mon_decimal_point),
s7_make_symbol(sc, \"mon_thousands_sep\"), s7_make_string(sc, lc->mon_thousands_sep),
s7_make_symbol(sc, \"mon_grouping\"), s7_make_string(sc, lc->mon_grouping),
s7_make_symbol(sc, \"positive_sign\"), s7_make_string(sc, lc->positive_sign),
s7_make_symbol(sc, \"negative_sign\"), s7_make_string(sc, lc->negative_sign),
s7_make_symbol(sc, \"int_frac_digits\"), s7_make_integer(sc, lc->int_frac_digits),
s7_make_symbol(sc, \"frac_digits\"), s7_make_integer(sc, lc->frac_digits),
s7_make_symbol(sc, \"p_cs_precedes\"), s7_make_integer(sc, lc->p_cs_precedes),
s7_make_symbol(sc, \"p_sep_by_space\"), s7_make_integer(sc, lc->p_sep_by_space),
s7_make_symbol(sc, \"n_cs_precedes\"), s7_make_integer(sc, lc->n_cs_precedes),
s7_make_symbol(sc, \"n_sep_by_space\"), s7_make_integer(sc, lc->n_sep_by_space),
s7_make_symbol(sc, \"p_sign_posn\"), s7_make_integer(sc, lc->p_sign_posn),
s7_make_symbol(sc, \"n_sign_posn\"), s7_make_integer(sc, lc->n_sign_posn))));
}")
(C-function ("localeconv" g_localeconv "" 0))
;; -------- sys/utsname.h --------
(in-C "
static s7_pointer g_uname(s7_scheme *sc, s7_pointer args)
{
struct utsname buf;
uname(&buf);
return(s7_list(sc, 5, s7_make_string(sc, buf.sysname),
s7_make_string(sc, buf.machine),
s7_make_string(sc, buf.nodename),
s7_make_string(sc, buf.version),
s7_make_string(sc, buf.release)));
}")
(C-function ("uname" g_uname "" 0))
;; -------- unistd.h --------
(C-macro (int (_POSIX_VERSION _POSIX2_VERSION _POSIX_JOB_CONTROL _POSIX_SAVED_IDS _POSIX_PRIORITY_SCHEDULING _POSIX_SYNCHRONIZED_IO
_POSIX_FSYNC _POSIX_MAPPED_FILES _POSIX_MEMLOCK _POSIX_MEMLOCK_RANGE _POSIX_MEMORY_PROTECTION _POSIX_CHOWN_RESTRICTED
_POSIX_VDISABLE _POSIX_NO_TRUNC _POSIX_THREADS _POSIX_REENTRANT_FUNCTIONS _POSIX_THREAD_SAFE_FUNCTIONS
_POSIX_THREAD_PRIORITY_SCHEDULING _POSIX_THREAD_ATTR_STACKSIZE _POSIX_THREAD_ATTR_STACKADDR _POSIX_THREAD_PRIO_INHERIT
_POSIX_THREAD_PRIO_PROTECT _POSIX_SEMAPHORES _POSIX_REALTIME_SIGNALS _POSIX_ASYNCHRONOUS_IO _POSIX_ASYNC_IO
_POSIX_PRIORITIZED_IO _POSIX_SHARED_MEMORY_OBJECTS _POSIX_CPUTIME _POSIX_THREAD_CPUTIME _POSIX_REGEXP
_POSIX_READER_WRITER_LOCKS _POSIX_SHELL _POSIX_TIMEOUTS _POSIX_SPIN_LOCKS _POSIX_SPAWN _POSIX_TIMERS
_POSIX_BARRIERS _POSIX_MESSAGE_PASSING _POSIX_THREAD_PROCESS_SHARED _POSIX_MONOTONIC_CLOCK _POSIX_CLOCK_SELECTION
_POSIX_ADVISORY_INFO _POSIX_IPV6 _POSIX_RAW_SOCKETS _POSIX2_CHAR_TERM _POSIX_SPORADIC_SERVER _POSIX_THREAD_SPORADIC_SERVER
_POSIX_TRACE _POSIX_TRACE_EVENT_FILTER _POSIX_TRACE_INHERIT _POSIX_TRACE_LOG _POSIX_TYPED_MEMORY_OBJECTS
STDIN_FILENO STDOUT_FILENO STDERR_FILENO)))
(C-macro
(int (_PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_PATH_MAX _PC_PIPE_BUF _PC_CHOWN_RESTRICTED _PC_NO_TRUNC
_PC_VDISABLE _PC_SYNC_IO _PC_ASYNC_IO _PC_PRIO_IO _PC_SOCK_MAXBUF _PC_FILESIZEBITS _PC_REC_INCR_XFER_SIZE _PC_REC_MAX_XFER_SIZE
_PC_REC_MIN_XFER_SIZE _PC_REC_XFER_ALIGN _PC_ALLOC_SIZE_MIN _PC_SYMLINK_MAX _PC_2_SYMLINKS _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK
_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_STREAM_MAX _SC_TZNAME_MAX _SC_JOB_CONTROL _SC_SAVED_IDS _SC_REALTIME_SIGNALS _SC_PRIORITY_SCHEDULING
_SC_TIMERS _SC_ASYNCHRONOUS_IO _SC_PRIORITIZED_IO _SC_SYNCHRONIZED_IO _SC_FSYNC _SC_MAPPED_FILES _SC_MEMLOCK _SC_MEMLOCK_RANGE
_SC_MEMORY_PROTECTION _SC_MESSAGE_PASSING _SC_SEMAPHORES _SC_SHARED_MEMORY_OBJECTS _SC_AIO_LISTIO_MAX _SC_AIO_MAX _SC_AIO_PRIO_DELTA_MAX
_SC_DELAYTIMER_MAX _SC_MQ_OPEN_MAX _SC_MQ_PRIO_MAX _SC_VERSION _SC_PAGESIZE _SC_PAGE_SIZE _SC_RTSIG_MAX _SC_SEM_NSEMS_MAX _SC_SEM_VALUE_MAX
_SC_SIGQUEUE_MAX _SC_TIMER_MAX _SC_BC_BASE_MAX _SC_BC_DIM_MAX _SC_BC_SCALE_MAX _SC_BC_STRING_MAX _SC_COLL_WEIGHTS_MAX _SC_EQUIV_CLASS_MAX
_SC_EXPR_NEST_MAX _SC_LINE_MAX _SC_RE_DUP_MAX _SC_CHARCLASS_NAME_MAX _SC_2_VERSION _SC_2_C_BIND _SC_2_C_DEV _SC_2_FORT_DEV _SC_2_FORT_RUN
_SC_2_SW_DEV _SC_2_LOCALEDEF _SC_PII _SC_PII_XTI _SC_PII_SOCKET _SC_PII_INTERNET _SC_PII_OSI _SC_POLL _SC_SELECT _SC_UIO_MAXIOV
_SC_IOV_MAX _SC_PII_INTERNET_STREAM _SC_PII_INTERNET_DGRAM _SC_PII_OSI_COTS _SC_PII_OSI_CLTS _SC_PII_OSI_M _SC_T_IOV_MAX _SC_THREADS
_SC_THREAD_SAFE_FUNCTIONS _SC_GETGR_R_SIZE_MAX _SC_GETPW_R_SIZE_MAX _SC_LOGIN_NAME_MAX _SC_TTY_NAME_MAX _SC_THREAD_DESTRUCTOR_ITERATIONS
_SC_THREAD_KEYS_MAX _SC_THREAD_STACK_MIN _SC_THREAD_THREADS_MAX _SC_THREAD_ATTR_STACKADDR _SC_THREAD_ATTR_STACKSIZE
_SC_THREAD_PRIO_INHERIT _SC_THREAD_PRIO_PROTECT _SC_THREAD_PROCESS_SHARED _SC_NPROCESSORS_CONF _SC_NPROCESSORS_ONLN _SC_PHYS_PAGES
_SC_AVPHYS_PAGES _SC_ATEXIT_MAX _SC_PASS_MAX _SC_2_CHAR_TERM _SC_2_C_VERSION _SC_2_UPE _SC_CHAR_BIT _SC_CHAR_MAX _SC_CHAR_MIN _SC_INT_MAX
_SC_INT_MIN _SC_LONG_BIT _SC_WORD_BIT _SC_MB_LEN_MAX _SC_NZERO _SC_SSIZE_MAX _SC_SCHAR_MAX _SC_SCHAR_MIN _SC_SHRT_MAX _SC_SHRT_MIN
_SC_UCHAR_MAX _SC_UINT_MAX _SC_ULONG_MAX _SC_USHRT_MAX _SC_NL_ARGMAX _SC_NL_LANGMAX _SC_NL_MSGMAX _SC_NL_NMAX _SC_NL_SETMAX
_SC_NL_TEXTMAX _SC_ADVISORY_INFO _SC_BARRIERS _SC_BASE _SC_C_LANG_SUPPORT _SC_C_LANG_SUPPORT_R _SC_CLOCK_SELECTION _SC_CPUTIME
_SC_THREAD_CPUTIME _SC_DEVICE_IO _SC_DEVICE_SPECIFIC _SC_DEVICE_SPECIFIC_R _SC_FD_MGMT _SC_FIFO _SC_PIPE _SC_FILE_ATTRIBUTES
_SC_FILE_LOCKING _SC_FILE_SYSTEM _SC_MONOTONIC_CLOCK _SC_MULTI_PROCESS _SC_SINGLE_PROCESS _SC_NETWORKING _SC_READER_WRITER_LOCKS
_SC_SPIN_LOCKS _SC_REGEXP _SC_REGEX_VERSION _SC_SHELL _SC_SIGNALS _SC_SPAWN _SC_SPORADIC_SERVER _SC_THREAD_SPORADIC_SERVER
_SC_SYSTEM_DATABASE _SC_SYSTEM_DATABASE_R _SC_TIMEOUTS _SC_TYPED_MEMORY_OBJECTS _SC_USER_GROUPS _SC_USER_GROUPS_R
_SC_2_PBS _SC_2_PBS_ACCOUNTING _SC_2_PBS_LOCATE _SC_2_PBS_MESSAGE _SC_2_PBS_TRACK _SC_SYMLOOP_MAX _SC_STREAMS _SC_2_PBS_CHECKPOINT
_SC_HOST_NAME_MAX _SC_TRACE _SC_TRACE_EVENT_FILTER _SC_TRACE_INHERIT _SC_TRACE_LOG _SC_LEVEL1_ICACHE_SIZE _SC_LEVEL1_ICACHE_ASSOC
_SC_LEVEL1_ICACHE_LINESIZE _SC_LEVEL1_DCACHE_SIZE _SC_LEVEL1_DCACHE_ASSOC _SC_LEVEL1_DCACHE_LINESIZE _SC_LEVEL2_CACHE_SIZE
_SC_LEVEL2_CACHE_LINESIZE _SC_LEVEL3_CACHE_SIZE _SC_LEVEL3_CACHE_ASSOC _SC_LEVEL3_CACHE_LINESIZE _SC_LEVEL4_CACHE_SIZE
_SC_LEVEL4_CACHE_LINESIZE _SC_IPV6 _SC_RAW_SOCKETS _SC_SS_REPL_MAX _SC_TRACE_EVENT_NAME_MAX _SC_TRACE_NAME_MAX _SC_TRACE_SYS_MAX
_SC_TRACE_USER_EVENT_MAX _SC_THREAD_ROBUST_PRIO_INHERIT _SC_THREAD_ROBUST_PRIO_PROTECT _CS_PATH _CS_GNU_LIBC_VERSION
_SC_THREAD_PRIORITY_SCHEDULING _SC_LEVEL2_CACHE_ASSOC _SC_LEVEL4_CACHE_ASSOC _CS_GNU_LIBPTHREAD_VERSION)))
(int access (char* int))
(int lseek (int int int))
(int close (int))
(ssize_t read (int void* size_t))
(ssize_t write (int void* size_t))
(ssize_t pread (int void* size_t int))
(ssize_t pwrite (int void* size_t int))
(int pipe (int*))
(int alarm (int))
(int sleep (int))
(int pause (void))
(int chown (char* int int))
(int chdir (char*))
(char* getcwd (char* size_t))
;; (deprecated) (char* getwd (char*))
(int dup (int))
(int dup2 (int int))
(void _exit (int))
(int pathconf (char* int))
(int fpathconf (int int))
(int sysconf (int))
(size_t confstr (int char* size_t))
(int getpid (void))
(int getppid (void))
(int getpgid (int))
(int setpgid (int int))
(int setsid (void))
(int getsid (int))
(int getuid (void))
(int geteuid (void))
(int getgid (void))
(int getegid (void))
(int setuid (int))
(int setgid (int))
(int fork (void))
(char* ttyname (int))
(int isatty (int))
(int link (char* char*))
(int unlink (char*))
(int rmdir (char*))
(int tcgetpgrp (int))
(int tcsetpgrp (int int))
(char* getlogin (void))
(int truncate (char* int))
(int ftruncate (int int))
(in-C "
extern char **environ;
static s7_pointer getenvs(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
int i;
p = s7_nil(sc);
for (i = 0; environ[i]; i++)
{
const char *eq;
s7_pointer name, value;
eq = strchr((const char *)environ[i], (int)'=');
name = s7_make_string_with_length(sc, environ[i], eq - environ[i]);
value = s7_make_string(sc, (char *)(eq + 1));
p = s7_cons(sc, s7_cons(sc, name, value), p);
}
return(p);
}
static s7_pointer g_getgroups(s7_scheme *sc, s7_pointer args)
{
gid_t *gds;
int i, size, res;
s7_pointer lst;
size = s7_integer(s7_car(args));
if (size == 0)
return(s7_make_integer(sc, getgroups(0, NULL)));
gds = (gid_t *)calloc(size, sizeof(gid_t));
res = getgroups(size, gds);
if (res != -1)
{
lst = s7_nil(sc);
for (i = 0; i < size; i++)
lst = s7_cons(sc, s7_make_integer(sc, gds[i]), lst);
}
else lst = s7_make_integer(sc, -1);
free(gds);
return(lst);
}
")
(C-function ("getenvs" getenvs "(getenvs) returns all the environment variables in an alist" 0))
(C-function ("getgroups" g_getgroups "" 1))
;; perhaps call these as (define* n (path ...) = args? and use execve for all?
;; but are these useful in this context? How is fork used here?
;; int execve (char* path char* argv[] char* envp[])
;; int execv (char* path char* argv[])
;; int execle (char* path char* arg ...)
;; int execl (char* path char* arg ...)
;; int execvp (char* file char* argv[])
;; int execlp (char* file char* arg ...)
;; -------- dirent.h --------
(DIR* opendir (char*))
(int closedir (DIR*))
(void rewinddir (DIR*))
(in-C "
static char *read_dir(DIR *p)
{
struct dirent *dirp;
dirp = readdir(p);
if (!dirp) return(NULL);
else return(dirp->d_name);
}")
(char* read_dir (DIR*))
;; int scandir (char* dirent*** func func)
;; int alphasort (dirent** dirent**)
;; -------- ftw.h --------
(C-macro (int (FTW_F FTW_D FTW_DNR FTW_NS)))
(in-C "
static s7_scheme *internal_ftw_sc = NULL;
static s7_pointer internal_ftw_closure = NULL, internal_ftw_arglist = NULL;
static int internal_ftw_function(const char *fpath, const struct stat *sb, int typeflag)
{
s7_list_set(internal_ftw_sc, internal_ftw_arglist, 0, s7_make_string(internal_ftw_sc, fpath));
s7_list_set(internal_ftw_sc, internal_ftw_arglist, 1,
s7_make_c_pointer_with_type(internal_ftw_sc, (void *)sb, /* need cast due to const */
s7_make_symbol(internal_ftw_sc, \"stat*\"), s7_f(internal_ftw_sc)));
s7_list_set(internal_ftw_sc, internal_ftw_arglist, 2, s7_make_integer(internal_ftw_sc, typeflag));
return((int)s7_integer(s7_call(internal_ftw_sc, internal_ftw_closure, internal_ftw_arglist)));
}
static s7_pointer g_ftw(s7_scheme *sc, s7_pointer args)
{
/* ftw(file-name, function(path, stat, type), nopenfd=max open dirs) */
internal_ftw_sc = sc;
internal_ftw_arglist = s7_list(sc, 3, s7_nil(sc), s7_nil(sc), s7_nil(sc));
s7_gc_protect_via_stack(sc, internal_ftw_arglist);
internal_ftw_closure = s7_cadr(args);
return(s7_make_integer(sc, ftw(s7_string(s7_car(args)), internal_ftw_function, s7_integer(s7_caddr(args)))));
}")
(C-function ("ftw" g_ftw "" 3))
;; -------- sys/stat.h --------
(C-macro (int S_IFLNK))
(in-C "
static s7_pointer g_stat(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, stat(s7_string(s7_car(args)),
(struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
static s7_pointer g_fstat(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, fstat(s7_integer(s7_car(args)),
(struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
static s7_pointer g_lstat(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, lstat(s7_string(s7_car(args)),
(struct stat *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))));}
")
(C-function ("stat" g_stat "" 2))
(C-function ("fstat" g_fstat "" 2))
(C-function ("lstat" g_lstat "" 2))
(int chmod (char* int))
(int mkdir (char* int))
(int mknod (char* int int))
(int mkfifo (char* int))
(in-C "
static s7_pointer g_isdir(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISDIR(s7_integer(s7_car(args)))));}
static s7_pointer g_ischr(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISCHR(s7_integer(s7_car(args)))));}
static s7_pointer g_isblk(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISBLK(s7_integer(s7_car(args)))));}
static s7_pointer g_isreg(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISREG(s7_integer(s7_car(args)))));}
static s7_pointer g_isfifo(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISFIFO(s7_integer(s7_car(args)))));}
static s7_pointer g_islnk(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISLNK(s7_integer(s7_car(args)))));}
static s7_pointer g_issock(s7_scheme *sc, s7_pointer args)
{return(s7_make_boolean(sc, S_ISSOCK(s7_integer(s7_car(args)))));}
static s7_pointer g_st_dev(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_dev));}
static s7_pointer g_st_ino(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_ino));}
static s7_pointer g_st_mode(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_mode));}
static s7_pointer g_st_nlink(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_nlink));}
static s7_pointer g_st_uid(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_uid));}
static s7_pointer g_st_gid(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_gid));}
static s7_pointer g_st_rdev(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_rdev));}
static s7_pointer g_st_size(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_size));}
static s7_pointer g_st_blksize(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_blksize));}
static s7_pointer g_st_blocks(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_blocks));}
static s7_pointer g_st_atime(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_atime));}
static s7_pointer g_st_mtime(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_mtime));}
static s7_pointer g_st_ctime(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"stat*\"), __func__, 1))->st_ctime));}
static s7_pointer g_stat_make(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct stat)), s7_make_symbol(sc, \"stat*\"), s7_F));}
static s7_pointer g_stat_free(s7_scheme *sc, s7_pointer args) {free(s7_c_pointer(s7_car(args))); return(s7_F);}
")
(C-function ("S_ISDIR" g_isdir "" 1))
(C-function ("S_ISCHR" g_ischr "" 1))
(C-function ("S_ISBLK" g_isblk "" 1))
(C-function ("S_ISREG" g_isreg "" 1))
(C-function ("S_ISFIFO" g_isfifo "" 1))
(C-function ("S_ISLNK" g_islnk "" 1))
(C-function ("S_ISSOCK" g_issock "" 1))
(C-function ("stat.st_dev" g_st_dev "" 1))
(C-function ("stat.st_ino" g_st_ino "" 1))
(C-function ("stat.st_mode" g_st_mode "" 1))
(C-function ("stat.st_nlink" g_st_nlink "" 1))
(C-function ("stat.st_uid" g_st_uid "" 1))
(C-function ("stat.st_gid" g_st_gid "" 1))
(C-function ("stat.st_rdev" g_st_rdev "" 1))
(C-function ("stat.st_size" g_st_size "" 1))
(C-function ("stat.st_blksize" g_st_blksize "" 1))
(C-function ("stat.st_blocks" g_st_blocks "" 1))
(C-function ("stat.st_atime" g_st_atime "" 1))
(C-function ("stat.st_mtime" g_st_mtime "" 1))
(C-function ("stat.st_ctime" g_st_ctime "" 1))
(C-function ("stat.free" g_stat_free "" 1))
(C-function ("stat.make" g_stat_make "" 0))
;; -------- time.h sys/time.h --------
(C-macro (int (CLOCKS_PER_SEC CLOCK_REALTIME CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID CLOCK_THREAD_CPUTIME_ID
CLOCK_MONOTONIC_RAW CLOCK_REALTIME_COARSE CLOCK_MONOTONIC_COARSE))) ; also CLOCK_TAI in linux
(int clock (void))
(int time (time_t*))
(double difftime ((time_t integer) (time_t integer)))
(tm* gmtime (time_t*))
(char* ctime (time_t*))
(tm* localtime (time_t*))
(in-C "
static s7_pointer g_mktime(s7_scheme *sc, s7_pointer args)
{
return(s7_make_integer(sc, (s7_int)mktime((struct tm *)s7_c_pointer(s7_car(args)))));
}
static s7_pointer g_time_make(s7_scheme *sc, s7_pointer args)
{
time_t *tm;
tm = (time_t *)calloc(1, sizeof(time_t));
(*tm) = (time_t)s7_integer(s7_car(args));
return(s7_make_c_pointer_with_type(sc, (void *)tm, s7_make_symbol(sc, \"time_t*\"), s7_F));
}
static s7_pointer g_time_free(s7_scheme *sc, s7_pointer args) {free(s7_c_pointer(s7_car(args))); return(s7_F);}
static s7_pointer g_strftime(s7_scheme *sc, s7_pointer args)
{
return(s7_make_integer(sc, (s7_int)strftime((char *)s7_string(s7_car(args)),
(size_t)s7_integer(s7_cadr(args)),
s7_string(s7_caddr(args)),
(const struct tm *)s7_c_pointer(s7_cadddr(args)))));
}
static s7_pointer g_gettimeofday(s7_scheme *sc, s7_pointer args)
{
struct timeval t0;
gettimeofday(&t0, NULL);
return(s7_list(sc, 2, s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_usec)));
}
static s7_pointer g_nanosleep(s7_scheme *sc, s7_pointer args)
{
struct timespec t0;
t0.tv_sec = (time_t)s7_integer(s7_car(args));
t0.tv_nsec = (long)s7_integer(s7_cadr(args));
return(s7_make_integer(sc, nanosleep(&t0, NULL)));
}
static s7_pointer g_clock_getres(s7_scheme *sc, s7_pointer args)
{
#if (!__APPLE__)
struct timespec t0;
int res;
res = clock_getres(s7_integer(s7_car(args)), &t0);
return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
#else
return(s7_make_integer(sc, -1));
#endif
}
static s7_pointer g_clock_gettime(s7_scheme *sc, s7_pointer args)
{
#if (!__APPLE__)
struct timespec t0;
int res;
res = clock_gettime(s7_integer(s7_car(args)), &t0);
return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
#else
return(s7_make_integer(sc, -1));
#endif
}
static s7_pointer g_clock_settime(s7_scheme *sc, s7_pointer args)
{
#if (!__APPLE__)
struct timespec t0;
t0.tv_sec = (time_t)s7_integer(s7_cadr(args));
t0.tv_nsec = (long)s7_integer(s7_caddr(args));
return(s7_make_integer(sc, clock_settime(s7_integer(s7_car(args)), &t0)));
#else
return(s7_make_integer(sc, -1));
#endif
}
static s7_pointer g_clock_getcpuclockid(s7_scheme *sc, s7_pointer args)
{
#if __linux__
clockid_t c = 0;
clock_getcpuclockid((pid_t)s7_integer(s7_car(args)), &c);
return(s7_make_integer(sc, (s7_int)c));
#else
return(s7_make_integer(sc, -1));
#endif
}
static s7_pointer g_clock_nanosleep(s7_scheme *sc, s7_pointer args)
{
#if __linux__
struct timespec t0;
t0.tv_sec = (time_t)s7_integer(s7_caddr(args));
t0.tv_nsec = (long)s7_integer(s7_cadddr(args));
return(s7_make_integer(sc, clock_nanosleep((clockid_t)s7_integer(s7_car(args)), (int)s7_integer(s7_cadr(args)), &t0, NULL)));
#else
return(s7_make_integer(sc, -1));
#endif
}
")
(C-function ("time.make" g_time_make "" 1))
(C-function ("time.free" g_time_free "" 1))
(C-function ("mktime" g_mktime "" 1))
(C-function ("strftime" g_strftime "" 4))
(C-function ("gettimeofday" g_gettimeofday "" 0))
(C-function ("nanosleep" g_nanosleep "" 2))
(C-function ("clock_getres" g_clock_getres "" 1))
(C-function ("clock_gettime" g_clock_gettime "" 1)) ; these need -lrt
(C-function ("clock_settime" g_clock_settime "" 3))
(reader-cond ((not (provided? 'solaris)) (C-function ("clock_getcpuclockid" g_clock_getcpuclockid "" 1))))
(C-function ("clock_nanosleep" g_clock_nanosleep "" 4))
;; -------- utime.h --------
(in-C "
static s7_pointer g_utime(s7_scheme *sc, s7_pointer args)
{
struct utimbuf tb;
tb.actime = (time_t)s7_integer(s7_cadr(args));
tb.modtime = (time_t)s7_integer(s7_caddr(args));
return(s7_make_integer(sc, utime(s7_string(s7_car(args)), &tb)));
}")
(C-function ("utime" g_utime "" 3))
;; -------- termios.h --------
(C-macro (int (VINTR VQUIT VERASE VKILL VEOF VTIME VMIN VSWTC VSTART VSTOP VSUSP VEOL VREPRINT
VDISCARD VWERASE VLNEXT VEOL2 IGNBRK BRKINT IGNPAR PARMRK INPCK ISTRIP INLCR
IGNCR ICRNL IUCLC IXON IXANY IXOFF IMAXBEL IUTF8 OPOST OLCUC ONLCR OCRNL ONOCR
ONLRET OFILL OFDEL ISIG ICANON ECHO ECHOE ECHOK ECHONL NOFLSH TOSTOP IEXTEN
TCOOFF TCOON TCIOFF TCION TCIFLUSH TCOFLUSH TCIOFLUSH TCSANOW TCSADRAIN TCSAFLUSH)))
(int tcsendbreak (int int))
(int tcdrain (int))
(int tcflush (int int))
(int tcflow (int int))
(in-C "
static s7_pointer g_cfgetospeed(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, (s7_int)cfgetospeed(p)));
}
static s7_pointer g_cfgetispeed(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, (s7_int)cfgetispeed(p)));
}
static s7_pointer g_cfsetospeed(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, cfsetospeed(p, (speed_t)s7_integer(s7_cadr(args)))));
}
static s7_pointer g_cfsetispeed(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, cfsetispeed(p, (speed_t)s7_integer(s7_cadr(args)))));
}
static s7_pointer g_tcgetattr(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_cadr(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, tcgetattr(s7_integer(s7_car(args)), p)));
}
static s7_pointer g_tcsetattr(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_caddr(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, tcsetattr(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), p)));
}
static s7_pointer g_termios_make(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct termios)), s7_make_symbol(sc, \"termios*\"), s7_F));}
static s7_pointer g_termios_c_lflag(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
return(s7_make_integer(sc, (s7_int)(p->c_lflag)));
}
static s7_pointer g_termios_set_c_lflag(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
p->c_lflag = (tcflag_t)s7_integer(s7_cadr(args));
return(s7_cadr(args));
}
static s7_pointer g_termios_set_c_cc(s7_scheme *sc, s7_pointer args)
{
struct termios *p;
p = (struct termios *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"termios*\"), __func__, 1);
p->c_cc[(int)s7_integer(s7_cadr(args))] = (cc_t)s7_integer(s7_caddr(args));
return(s7_caddr(args));
}
")
;; tcflag_t c_iflag, c_oflag, c_cflag; cc_t c_line;
;; cc_t c_cc[NCCS];
(C-function ("cfgetospeed" g_cfgetospeed "" 1))
(C-function ("cfgetispeed" g_cfgetispeed "" 1))
(C-function ("cfsetospeed" g_cfsetospeed "" 2))
(C-function ("cfsetispeed" g_cfsetispeed "" 2))
(C-function ("tcgetattr" g_tcgetattr "" 2))
(C-function ("tcsetattr" g_tcsetattr "" 3))
(C-function ("termios.make" g_termios_make "" 0))
(C-function ("termios.c_lflag" g_termios_c_lflag "" 1))
(C-function ("termios.set_c_lflag" g_termios_set_c_lflag "" 2))
(C-function ("termios.set_c_cc" g_termios_set_c_cc "" 3))
;; -------- grp.h --------
(in-C "
static s7_pointer g_getgrgid(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer_with_type(sc, getgrgid(s7_integer(s7_car(args))), s7_make_symbol(sc, \"group*\"), s7_F));}
static s7_pointer g_getgrnam(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer_with_type(sc, getgrnam(s7_string(s7_car(args))), s7_make_symbol(sc, \"group*\"), s7_F));}
static s7_pointer g_group_gr_name(s7_scheme *sc, s7_pointer args)
{
struct group *g;
g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
if (!g) return(s7_make_string(sc, \"\"));
return(s7_make_string(sc, ((struct group *)g)->gr_name));
}
static s7_pointer g_group_gr_passwd(s7_scheme *sc, s7_pointer args)
{
struct group *g;
g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
if (!g) return(s7_make_string(sc, \"\"));
return(s7_make_string(sc, ((struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1))->gr_passwd));
}
static s7_pointer g_group_gr_gid(s7_scheme *sc, s7_pointer args)
{
struct group *g;
g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
if (!g) return(s7_make_integer(sc, -1));
return(s7_make_integer(sc, (s7_int)(((struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1))->gr_gid)));
}
static s7_pointer g_group_gr_mem(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
int i;
struct group *g;
g = (struct group *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"group*\"), __func__, 1);
p = s7_nil(sc);
for (i = 0; g->gr_mem[i]; i++)
p = s7_cons(sc, s7_make_string(sc, g->gr_mem[i]), p);
return(p);
}
")
(C-function ("getgrgid" g_getgrgid "" 1))
(C-function ("getgrnam" g_getgrnam "" 1))
(C-function ("group.gr_name" g_group_gr_name "" 1))
(C-function ("group.gr_passwd" g_group_gr_passwd "" 1))
(C-function ("group.gr_gid" g_group_gr_gid "" 1))
(C-function ("group.gr_mem" g_group_gr_mem "" 1))
;; ((*libc* 'group.gr_name) ((*libc* 'getgrnam) "wheel")) -> "wheel" (if any)
;; ((*libc* 'group.gr_name) ((*libc* 'getgrgid) 0)) -> "root"
;; ((*libc* 'group.gr_gid) ((*libc* 'getgrnam) "root")) -> 0
;; -------- pwd.h --------
(C-macro (int NSS_BUFLEN_PASSWD))
(void setpwent (void))
(void endpwent (void))
(passwd* getpwent (void))
(passwd* getpwuid (int))
(passwd* getpwnam (char*))
(in-C "
static s7_pointer g_passwd_pw_name(s7_scheme *sc, s7_pointer args)
{return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_name));}
static s7_pointer g_passwd_pw_passwd(s7_scheme *sc, s7_pointer args)
{return(s7_make_string(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_passwd));}
static s7_pointer g_passwd_pw_uid(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct passwd *)s7_c_pointer_with_type(sc, s7_car(args), s7_make_symbol(sc, \"passwd*\"), __func__, 1))->pw_uid));}