-
Notifications
You must be signed in to change notification settings - Fork 1
/
lib.h
1600 lines (1461 loc) · 47.6 KB
/
lib.h
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
/* Copyright 2009-2024
* Kaz Kylheku <kaz@kylheku.com>
* Vancouver, Canada
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
#include "mpi/mpi.h"
typedef int_ptr_t cnum;
typedef uint_ptr_t ucnum;
#if HAVE_DOUBLE_INTPTR_T
typedef double_intptr_t dbl_cnum;
typedef double_uintptr_t dbl_ucnum;
#endif
#ifdef __cplusplus
#define strip_qual(TYPE, EXPR) (const_cast<TYPE>(EXPR))
#define convert(TYPE, EXPR) (static_cast<TYPE>(EXPR))
#define coerce(TYPE, EXPR) (reinterpret_cast<TYPE>(EXPR))
#else
#define strip_qual(TYPE, EXPR) ((TYPE) (EXPR))
#define convert(TYPE, EXPR) ((TYPE) (EXPR))
#define coerce(TYPE, EXPR) ((TYPE) (EXPR))
#endif
#define container(PTR, TYPE, MEMB) \
coerce(TYPE *, \
coerce(mem_t *, (PTR)) - offsetof(TYPE, MEMB))
#if __STDC_VERSION__ >= 199901L
#define FLEX_ARRAY
#else
#define FLEX_ARRAY 1
#endif
#define PTR_BIT (SIZEOF_PTR * CHAR_BIT)
#define TAG_PTR 0
#define TAG_NUM 1
#define TAG_CHR 2
#define TAG_LIT 3
#if CONFIG_NAN_BOXING
#define TAG_FLNUM 4 /* pseudo-tag */
#define TAG_WIDTH 2
#define TAG_PAIR(A, B) ((A) << TAG_WIDTH | (B))
#define NAN_TAG_BIT 14
#define NAN_TAG_MASK 0xFFFC000000000000U
#define TAG_BIGMASK 0xFFFF000000000000U
#define TAG_BIGSHIFT 48
#define NAN_FLNUM_DELTA 0x0004000000000000U
#define NUM_MAX (INT_PTR_MAX >> NAN_TAG_BIT)
#define NUM_MIN (INT_PTR_MIN >> NAN_TAG_BIT)
#define NUM_BIT (PTR_BIT - NAN_TAG_BIT)
#else
#define TAG_SHIFT 2
#define TAG_MASK ((convert(cnum, 1) << TAG_SHIFT) - 1)
#define TAG_PAIR(A, B) ((A) << TAG_SHIFT | (B))
#define NUM_MAX (INT_PTR_MAX >> TAG_SHIFT)
#define NUM_MIN (INT_PTR_MIN >> TAG_SHIFT)
#define NUM_BIT (PTR_BIT - TAG_SHIFT)
#endif
#ifdef __GNUC__
#define NORETURN __attribute__((noreturn))
#define NOINLINE __attribute__((noinline))
#define UNUSED __attribute__((unused))
#else
#define NORETURN
#define NOINLINE
#define UNUSED
#endif
typedef enum type {
NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, FLNUM,
CONS, STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
BGNUM, RNG, BUF, TNOD, DARG, MAXTYPE = DARG
/* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */
} type_t;
#define TYPE_SHIFT 5
#define TYPE_PAIR(A, B) ((A) << TYPE_SHIFT | (B))
typedef enum functype
{
FINTERP, /* Interpreted function. */
FVM, /* VM function. */
F0, F1, F2, F3, F4, /* Intrinsic functions with env. */
N0, N1, N2, N3, N4, N5, N6, N7, N8 /* No-env intrinsics. */
} functype_t;
typedef union obj obj_t;
typedef obj_t *val;
#ifndef MEM_T_DEFINED
typedef unsigned char mem_t;
#define MEM_T_DEFINED
#endif
#if CONFIG_GEN_GC
#define obj_common \
type_t type : PTR_BIT/2; \
unsigned fincount : PTR_BIT/4; \
int gen : PTR_BIT/4;
#else
#define obj_common \
type_t type
#endif
struct any {
obj_common;
mem_t *dummy[2];
val next; /* GC free list */
};
struct cons {
obj_common;
val car, cdr;
};
struct cons_hash_entry {
obj_common;
val car, cdr;
ucnum hash;
};
struct string {
obj_common;
wchar_t *str;
val len;
#if !HAVE_MALLOC_USABLE_SIZE
cnum alloc;
#endif
};
typedef struct {
cnum id;
cnum slot;
} slot_cache_entry_t;
typedef slot_cache_entry_t slot_cache_set_t[4];
struct sym {
obj_common;
val name;
val package;
slot_cache_set_t *slot_cache;
};
struct package {
obj_common;
val name;
val symhash;
val hidhash;
};
typedef struct args *varg;
#define FIXPARAM_BITS 7
#define FIXPARAM_MAX ((1 << FIXPARAM_BITS) - 1)
struct func {
obj_common;
unsigned fixparam : FIXPARAM_BITS; /* total non-variadic parameters */
unsigned optargs : FIXPARAM_BITS; /* fixparam - optargs = required args */
unsigned variadic : 1;
unsigned : 1;
unsigned functype : 16;
val env;
union {
val interp_fun;
val vm_desc;
val (*f0)(val);
val (*f1)(val, val);
val (*f2)(val, val, val);
val (*f3)(val, val, val, val);
val (*f4)(val, val, val, val, val);
val (*n0)(void);
val (*n1)(val);
val (*n2)(val, val);
val (*n3)(val, val, val);
val (*n4)(val, val, val, val);
val (*n5)(val, val, val, val, val);
val (*n6)(val, val, val, val, val, val);
val (*n7)(val, val, val, val, val, val, val);
val (*n8)(val, val, val, val, val, val, val, val);
val (*f0v)(val, varg);
val (*f1v)(val, val, varg);
val (*f2v)(val, val, val, varg);
val (*f3v)(val, val, val, val, varg);
val (*f4v)(val, val, val, val, val, varg);
val (*n0v)(varg);
val (*n1v)(val, varg);
val (*n2v)(val, val, varg);
val (*n3v)(val, val, val, varg);
val (*n4v)(val, val, val, val, varg);
val (*n5v)(val, val, val, val, val, varg);
val (*n6v)(val, val, val, val, val, val, varg);
val (*n7v)(val, val, val, val, val, val, val, varg);
val (*n8v)(val, val, val, val, val, val, val, val, varg);
} f;
};
enum vecindex { vec_alloc = -2, vec_length = -1 };
struct vec {
obj_common;
/* vec points two elements down */
/* vec[-2] is allocated size */
/* vec[-1] is fill pointer */
val *vec;
#if HAVE_VALGRIND
val *vec_true_start;
#endif
};
/*
* Lazy cons. When initially constructed, acts as a promise. The car and cdr
* cache pointers are nil, and func points to a function. The job of the
* function is to force the promise: fill car and cdr, and then flip func to
* nil. After that, the lazy cons resembles an ordinary cons. Of course, either
* car or cdr can point to more lazy conses.
*/
struct lazy_cons {
obj_common;
val car, cdr;
val func; /* when nil, car and cdr are valid */
};
/*
* Lazy string: virtual string which dynamically grows as a catentation
* of a list of strings.
*/
struct lazy_string_props {
val term;
val limit;
};
struct lazy_string {
obj_common;
val prefix; /* actual string part */
val list; /* remaining list */
struct lazy_string_props *props;
};
struct cobj_class {
val cls_sym;
struct cobj_class *super;
};
struct cobj {
obj_common;
mem_t *handle;
struct cobj_ops *ops;
struct cobj_class *cls;
};
struct cptr {
obj_common;
mem_t *handle;
struct cobj_ops *ops;
val cls;
};
struct dyn_args {
obj_common;
val car;
val cdr;
varg args;
};
struct strm_ctx;
struct cobj_ops {
val (*equal)(val self, val other);
void (*print)(val self, val stream, val pretty, struct strm_ctx *);
void (*destroy)(val self);
void (*mark)(val self);
ucnum (*hash)(val self, int *count, ucnum seed);
val (*clone)(val self);
val (*equalsub)(val self);
};
#define cobj_ops_init(equal, print, destroy, mark, hash, clone) \
{ equal, print, destroy, mark, hash, clone, 0 }
#define cobj_ops_init_ex(equal, print, destroy, mark, hash, \
clone, equalsub) \
{ equal, print, destroy, mark, hash, clone, equalsub }
/* Default operations for above structure.
* Default equal is eq
*/
void cobj_print_op(val, val, val, struct strm_ctx *);
void cptr_print_op(val, val, val, struct strm_ctx *);
val cobj_equal_handle_op(val left, val right);
void cobj_destroy_stub_op(val);
void cobj_destroy_free_op(val);
void cobj_mark_op(val);
ucnum cobj_eq_hash_op(val, int *, ucnum);
ucnum cobj_handle_hash_op(val, int *, ucnum);
struct env {
obj_common;
val vbindings;
val fbindings;
val up_env;
};
struct bignum {
obj_common;
mp_int mp;
};
#if !CONFIG_NAN_BOXING
struct flonum {
obj_common;
double n;
};
#endif
struct range {
obj_common;
val from, to;
};
struct buf {
obj_common;
mem_t *data;
val len;
val size;
};
struct tnod {
obj_common;
val left, right;
val key;
};
union obj {
struct any t;
struct cons c;
struct cons_hash_entry ch;
struct string st;
struct sym s;
struct package pk;
struct func f;
struct vec v;
struct lazy_cons lc;
struct lazy_string ls;
struct cobj co;
struct cptr cp;
struct env e;
struct bignum bn;
#if !CONFIG_NAN_BOXING
struct flonum fl;
#endif
struct range rn;
struct buf b;
struct tnod tn;
struct dyn_args a;
};
#if CONFIG_GEN_GC
typedef struct {
val *ptr;
val obj;
} loc;
val gc_set(loc, val);
INLINE loc mkloc_fun(val *ptr, val obj)
{
loc l = { ptr, obj };
return l;
}
#define mkloc(expr, obj) mkloc_fun(&(expr), obj)
#define mkcloc(expr) mkloc_fun(&(expr), 0)
#define nulloc mkloc_fun(0, 0)
#define nullocp(lo) (!(lo).ptr)
#define deref(lo) (*(lo).ptr)
#define valptr(lo) ((lo).ptr)
#define set(lo, val) (gc_set(lo, val))
#define setcheck(tgt, src) (gc_assign_check(tgt, src))
#define mut(obj) (gc_mutated(obj))
#define mpush(val, lo) (gc_push(val, lo))
#else
typedef val *loc;
#define mkloc(expr, obj) ((void) (obj), &(expr))
#define mkcloc(expr) (&(expr))
#define nulloc ((loc) 0)
#define nullocp(lo) (!(lo))
#define deref(lo) (*(lo))
#define valptr(lo) (lo)
#define set(lo, val) (*(lo) = (val))
#define setcheck(tgt, src) ((void) (tgt))
#define mut(obj) ((void) (obj))
#define mpush(val, lo) (push(val, lo))
#endif
typedef enum seq_kind {
SEQ_NIL, SEQ_LISTLIKE, SEQ_VECLIKE, SEQ_HASHLIKE, SEQ_TREELIKE, SEQ_NOTSEQ
} seq_kind_t;
typedef struct seq_info {
val obj;
type_t type;
seq_kind_t kind;
} seq_info_t;
typedef struct seq_iter {
seq_info_t inf;
union {
val iter;
cnum index;
val vn;
cnum cn;
} ui;
union {
cnum len;
val vbound;
cnum cbound;
val next;
val dargs;
} ul;
struct seq_iter_ops *ops;
} seq_iter_t;
struct seq_iter_ops {
int (*get)(struct seq_iter *, val *pval);
int (*peek)(struct seq_iter *, val *pval);
void (*mark)(struct seq_iter *);
void (*clone)(const struct seq_iter *, struct seq_iter *);
};
#define seq_iter_ops_init(get, peek) { get, peek, seq_iter_mark_op, 0 }
#define seq_iter_ops_init_nomark(get, peek) { get, peek, 0, 0 }
#define seq_iter_ops_init_mark(get, peek, mark) { get, peek, mark, 0 }
#define seq_iter_ops_init_clone(get, peek, clone) \
{ get, peek, seq_iter_mark_op, clone }
#define seq_iter_ops_init_full(get, peek, mark, clone) \
{ get, peek, mark, clone }
typedef struct seq_build {
val obj;
loc tail;
val self;
union {
val from_list_meth;
val carray_type;
} u;
struct seq_build_ops *ops;
} seq_build_t;
struct seq_build_ops {
void (*add)(struct seq_build *, val);
void (*pend)(struct seq_build *, val);
void (*nconc)(struct seq_build *, val);
void (*finish)(struct seq_build *);
void (*mark)(struct seq_build *);
};
#define seq_build_ops_init(add, pend, nconc, finish, mark) \
{ add, pend, nconc, finish, mark }
extern const seq_kind_t seq_kind_tab[MAXTYPE+1];
#define SEQ_KIND_PAIR(A, B) ((A) << 3 | (B))
#if CONFIG_NAN_BOXING
INLINE cnum tag(val obj)
{
ucnum word = coerce(ucnum, obj) >> TAG_BIGSHIFT;
if (word <= TAG_LIT)
return word;
if ((word & (NAN_TAG_MASK >> TAG_BIGSHIFT)) == (NAN_TAG_MASK >> TAG_BIGSHIFT))
return TAG_NUM;
return TAG_PTR;
}
INLINE cnum tag_ex(val obj)
{
ucnum word = coerce(ucnum, obj) >> TAG_BIGSHIFT;
if (word <= TAG_LIT)
return word;
if ((word & (NAN_TAG_MASK >> TAG_BIGSHIFT)) == (NAN_TAG_MASK >> TAG_BIGSHIFT))
return TAG_NUM;
return TAG_FLNUM;
}
INLINE int is_ptr(val obj)
{
return obj && coerce(ucnum, obj) >> TAG_BIGSHIFT == TAG_PTR;
}
INLINE int is_flo(val obj)
{
ucnum nantag = coerce(ucnum, obj) & NAN_TAG_MASK;
return nantag != 0 && nantag != NAN_TAG_MASK;
}
#else
INLINE cnum tag(val obj) { return coerce(cnum, obj) & TAG_MASK; }
INLINE cnum tag_ex(val obj) { return tag(obj); }
INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; }
#endif
INLINE int is_num(val obj) { return tag(obj) == TAG_NUM; }
INLINE int is_chr(val obj) { return tag(obj) == TAG_CHR; }
INLINE int is_lit(val obj) { return tag(obj) == TAG_LIT; }
INLINE type_t type(val obj)
{
cnum tg = tag_ex(obj);
return obj ? tg
? convert(type_t, tg)
: obj->t.type
: NIL;
}
typedef struct wli wchli_t;
#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
#define wli_noex(lit) (coerce(const wchli_t *,\
convert(const wchar_t *,\
L"\0" L ## lit L"\0" + 1)))
#define wini(ini) L"\0" L ## ini L"\0"
#define wref(arr) ((arr) + 1)
#else
#define wli_noex(lit) (coerce(const wchli_t *,\
convert(const wchar_t *,\
L ## lit)))
#define wini(ini) L ## ini
#define wref(arr) (arr)
#endif
#define wli(lit) wli_noex(lit)
INLINE val auto_str(const wchli_t *str)
{
#if CONFIG_NAN_BOXING
return coerce(val, coerce(cnum, str) |
(coerce(cnum, TAG_LIT) << TAG_BIGSHIFT));
#else
return coerce(val, coerce(cnum, str) | TAG_LIT);
#endif
}
INLINE val static_str(const wchli_t *str)
{
#if CONFIG_NAN_BOXING
return coerce(val, coerce(cnum, str) |
(coerce(cnum, TAG_LIT) << TAG_BIGSHIFT));
#else
return coerce(val, coerce(cnum, str) | TAG_LIT);
#endif
}
INLINE wchar_t *litptr(val obj)
{
#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
wchar_t *ret = coerce(wchar_t *, (coerce(cnum, obj) & ~TAG_MASK));
return (*ret == 0) ? ret + 1 : ret;
#elif CONFIG_NAN_BOXING
return coerce(wchar_t *, coerce(cnum, obj) & ~TAG_BIGMASK);
#else
return coerce(wchar_t *, coerce(cnum, obj) & ~TAG_MASK);
#endif
}
INLINE val num_fast(cnum n)
{
#if CONFIG_NAN_BOXING
return coerce(val, n | NAN_TAG_MASK);
#elif HAVE_UBSAN
return coerce(val, (n * (1 << TAG_SHIFT)) | TAG_NUM);
#else
return coerce(val, (n << TAG_SHIFT) | TAG_NUM);
#endif
}
INLINE mp_int *mp(val bign)
{
return &bign->bn.mp;
}
INLINE val chr(wchar_t ch)
{
#if CONFIG_NAN_BOXING
return coerce(val, ch | convert(cnum, TAG_CHR) << TAG_BIGSHIFT);
#else
return coerce(val, (convert(cnum, ch) << TAG_SHIFT) | TAG_CHR);
#endif
}
INLINE cnum c_ch(val num)
{
#if CONFIG_NAN_BOXING
return coerce(cnum, num) & ~TAG_BIGMASK;
#else
return coerce(cnum, num) >> TAG_SHIFT;
#endif
}
INLINE cnum c_n(val num)
{
#if CONFIG_NAN_BOXING
cnum n = coerce(cnum, num) & ~NAN_TAG_MASK;
return n << NAN_TAG_BIT >> NAN_TAG_BIT;
#else
return coerce(cnum, num) >> TAG_SHIFT;
#endif
}
INLINE ucnum c_u(val num)
{
#if CONFIG_NAN_BOXING
return coerce(ucnum, num) & ~NAN_TAG_MASK;
#else
return convert(ucnum, coerce(cnum, num) >> TAG_SHIFT);
#endif
}
#if CONFIG_NAN_BOXING && defined __GNUC__
#pragma GCC diagnostic ignored "-Wstrict-aliasing"
#pragma GCC diagnostic ignored "-Wuninitialized"
#endif
INLINE double c_f(val num)
{
#if CONFIG_NAN_BOXING
ucnum u = coerce(ucnum, num) - NAN_FLNUM_DELTA;
return *coerce(double *, &u);
#else
return num->fl.n;
#endif
}
#if CONFIG_NAN_BOXING && defined __GNUC__
#pragma GCC diagnostic warning "-Wstrict-aliasing"
#pragma GCC diagnostic warning "-Wuninitialized"
#endif
#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
#define lit_noex(strlit) coerce(obj_t *,\
coerce(cnum, L"\0" L ## strlit L"\0" + 1) | \
TAG_LIT)
#elif CONFIG_NAN_BOXING
#define lit_noex(strlit) coerce(val, coerce(cnum, L ## strlit) | \
(coerce(cnum, TAG_LIT) << TAG_BIGSHIFT))
#else
#define lit_noex(strlit) coerce(val, coerce(cnum, L ## strlit) | TAG_LIT)
#endif
#define lit(strlit) lit_noex(strlit)
#define cur_package (get_current_package())
#define cur_package_alist_loc (get_current_package_alist_loc())
extern val packages, system_package, keyword_package, user_package;
extern val public_package, package_alist_s;
extern val package_s, keyword_package_s, system_package_s, user_package_s;
extern val null_s, t, cons_s, str_s, chr_s, fixnum_sl;
extern val sym_s, pkg_s, fun_s, vec_s;
extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
extern val atom_s, integer_s, number_s, sequence_s, string_s;
extern val env_s, bignum_s, float_s, range_s, rcons_s, buf_s, tnode_s;
extern val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
extern val nongreedy_s;
extern val quote_s, qquote_s, unquote_s, splice_s;
extern val sys_qquote_s, sys_unquote_s, sys_splice_s;
extern val zeroplus_s, optional_s, compl_s, compound_s;
extern val or_s, and_s, quasi_s, quasilist_s;
extern val skip_s, trailer_s, block_s, next_s, freeform_s, fail_s, accept_s;
extern val all_s, some_s, none_s, maybe_s, cases_s, collect_s, until_s, coll_s;
extern val define_s, output_s, push_s, single_s, first_s, last_s, empty_s;
extern val repeat_s, rep_s, flatten_s, forget_s;
extern val local_s, merge_s, bind_s, rebind_s, cat_s;
extern val try_s, catch_s, finally_s, throw_s, defex_s, deffilter_s;
extern val eof_s, eol_s, assert_s, name_s;
extern val error_s, type_error_s, internal_error_s, panic_s;
extern val numeric_error_s, range_error_s;
extern val query_error_s, file_error_s, process_error_s, syntax_error_s;
extern val timeout_error_s, system_error_s, alloc_error_s, stack_overflow_s;
extern val path_not_found_s, path_exists_s, path_permission_s;
extern val warning_s, defr_warning_s, restart_s, continue_s;
extern val gensym_counter_s, length_s, length_lt_s;
extern val rplaca_s, rplacd_s, seq_iter_s;
extern val lazy_streams_s;
extern val plus_s;
#define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s)))
extern val nothrow_k, args_k, colon_k, auto_k, fun_k;
extern val null_string;
extern val identity_f, identity_star_f;
extern val equal_f, eql_f, eq_f, car_f, cdr_f, null_f;
extern val list_f, less_f, greater_f, gt_f;
extern val prog_string;
extern char dec_point;
#if HAVE_ULONGLONG_T
typedef ulonglong_t alloc_bytes_t;
#define SIZEOF_ALLOC_BYTES_T SIZEOF_LONGLONG_T
#else
typedef unsigned long alloc_bytes_t;
#define SIZEOF_ALLOC_BYTES_T SIZEOF_LONG
#endif
extern alloc_bytes_t malloc_bytes;
extern alloc_bytes_t gc_bytes;
extern struct cobj_class *seq_iter_cls;
extern struct cobj_ops seq_iter_cobj_ops;
val identity(val obj);
val built_in_type_p(val sym);
val typeof(val obj);
val subtypep(val sub, val sup);
val typep(val obj, val type);
seq_info_t seq_info(val cobj);
void seq_iter_mark_op(struct seq_iter *it);
void seq_iter_init_with_info(val self, seq_iter_t *it, seq_info_t si);
void seq_iter_init(val self, seq_iter_t *it, val obj);
INLINE int seq_get(seq_iter_t *it, val *pval) { return it->ops->get(it, pval); }
INLINE int seq_peek(seq_iter_t *it, val *pval) { return it->ops->peek(it, pval); }
val seq_geti(seq_iter_t *it);
val seq_getpos(val self, seq_iter_t *it);
void seq_setpos(val self, seq_iter_t *it, val pos);
val seq_begin(val obj);
val seq_next(val iter, val end_val);
val seq_reset(val iter, val obj);
val iter_begin(val obj);
val iter_more(val iter);
val iter_item(val iter);
val iter_step(val iter);
val iter_reset(val iter, val obj);
val iter_catv(varg iters);
val copy_iter(val iter);
void seq_build_init(val self, seq_build_t *bu, val likeobj);
void seq_build_strcat_init(seq_build_t *bu);
void seq_add(seq_build_t *bu, val item);
void seq_pend(seq_build_t *bu, val items);
void seq_nconc(seq_build_t *bu, val items);
val seq_finish(seq_build_t *bu);
val seq_append2(val self, val seq0, val seq1);
val seq_appendv(val self, varg seqs);
val seq_nconc2(val self, val seq0, val seq1);
val seq_nconcv(val self, varg seqs);
NORETURN val throw_mismatch(val self, val obj, type_t);
INLINE val type_check(val self, val obj, type_t typecode)
{
if (type(obj) != typecode)
throw_mismatch(self, obj, typecode);
return t;
}
val car(val cons);
val cdr(val cons);
INLINE val us_car(val cons) { return cons->c.car; }
INLINE val us_cdr(val cons) { return cons->c.cdr; }
INLINE val *us_car_p(val cons) { return &cons->c.car; }
INLINE val *us_cdr_p(val cons) { return &cons->c.cdr; }
val rplaca(val cons, val new_car);
val rplacd(val cons, val new_car);
val us_rplaca(val cons, val new_car);
val us_rplacd(val cons, val new_cdr);
val sys_rplaca(val cons, val new_car);
val sys_rplacd(val cons, val new_car);
loc car_l(val cons);
loc cdr_l(val cons);
val first(val cons);
val rest(val cons);
val second(val cons);
val third(val cons);
val fourth(val cons);
val fifth(val cons);
val sixth(val cons);
val seventh(val cons);
val eighth(val cons);
val ninth(val cons);
val tenth(val cons);
val cxr(val addr, val obj);
val cyr(val addr, val obj);
val conses(val list);
val lazy_conses(val list);
val listref(val list, val ind);
loc tail(val cons);
val lastcons(val list);
val last(val list, val n);
val nthlast(val pos, val list);
val nthcdr(val pos, val list);
val nth(val pos, val list);
val butlastn(val n, val list);
val pop(val *plist);
val upop(val *plist, val *pundo);
val rcyc_pop(val *plist);
val push(val v, val *plist);
val copy_list(val list);
val make_like(val list, val thatobj);
val tolist(val seq);
val nullify(val obj);
val empty(val seq);
val seqp(val obj);
val iterable(val obj);
val list_seq(val seq);
val vec_seq(val seq);
val str_seq(val seq);
val nreverse(val in);
val reverse(val in);
val us_nreverse(val in);
val append2(val list1, val list2);
val nappend2(val list1, val list2);
val revappend(val list1, val list2);
val nreconc(val list1, val list2);
val appendv(varg lists);
val nconcv(varg lists);
val sub_list(val list, val from, val to);
val replace_list(val list, val items, val from, val to);
val lazy_appendl(val lists);
val lazy_appendv(varg lists);
val ldiff(val list1, val list2);
val ldiff_old(val list1, val list2);
val flatten(val list);
val lazy_flatten(val list);
val flatcar(val list);
val lazy_flatcar(val tree);
val tuples(val n, val seq, val fill);
val tuples_star(val n, val seq, val fill);
val partition_by(val func, val seq);
val partition_if(val func, val seq, val count_in);
val partition(val seq, val indices);
val split(val seq, val indices);
val partition_star(val seq, val indices);
val split_star(val seq, val indices);
val tailp(val obj, val list);
val delcons(val cons, val list);
val memq(val obj, val list);
val rmemq(val obj, val list);
val memql(val obj, val list);
val rmemql(val obj, val list);
val memqual(val obj, val list);
val rmemqual(val obj, val list);
val member(val item, val list, val testfun, val keyfun);
val rmember(val item, val list, val testfun, val keyfun);
val member_if(val pred, val list, val key);
val rmember_if(val pred, val list, val key);
val remq(val obj, val seq, val keyfun);
val remql(val obj, val seq, val keyfun);
val remqual(val obj, val seq, val keyfun);
val remove_if(val pred, val seq, val keyfun_in, val mapfun_in);
val keepq(val obj, val seq, val keyfun);
val keepql(val obj, val seq, val keyfun);
val keepqual(val obj, val seq, val keyfun);
val keep_if(val pred, val seq, val keyfun_in, val mapfun_in);
val keep_keys_if(val pred, val seq_in, val keyfun_in, val mapfun_in);
val separate(val pred, val seq, val keyfun);
val separate_keys(val pred, val seq_in, val keyfun_in);
val remq_lazy(val obj, val list);
val remql_lazy(val obj, val list);
val remqual_lazy(val obj, val list);
val remove_if_lazy(val pred, val list, val key);
val keep_if_lazy(val pred, val list, val key);
val tree_find(val obj, val tree, val testfun);
val cons_find(val obj, val tree, val testfun);
val countqual(val obj, val list);
val countql(val obj, val list);
val countq(val obj, val list);
val count_if(val pred, val list, val key);
val count(val item, val seq, val testfun_in, val keyfun_in);
val cons_count(val item, val tree, val testfun_in);
val some_satisfy(val list, val pred, val key);
val all_satisfy(val list, val pred, val key);
val none_satisfy(val list, val pred, val key);
val multi(val func, varg lists);
val eql(val left, val right);
val equal(val left, val right);
val meq(val item, varg args);
val meql(val item, varg args);
val mequal(val item, varg args);
mem_t *chk_malloc(size_t size);
mem_t *chk_malloc_gc_more(size_t size);
mem_t *chk_calloc(size_t n, size_t size);
mem_t *chk_realloc(mem_t *, size_t size);
mem_t *chk_grow_vec(mem_t *old, size_t oldelems, size_t newelems,
size_t elsize);
mem_t *chk_manage_vec(mem_t *old, size_t oldfilled, size_t newfilled,
size_t elsize, mem_t *fillval);
wchar_t *chk_wmalloc(size_t nwchar);
wchar_t *chk_wrealloc(wchar_t *, size_t nwchar);
wchar_t *chk_strdup(const wchar_t *str);
wchar_t *chk_substrdup(const wchar_t *str, size_t off, size_t len);
char *chk_strdup_utf8(const char *str);
char *chk_substrdup_utf8(const char *str, size_t off, size_t len);
unsigned char *chk_strdup_8bit(const wchar_t *str);
mem_t *chk_copy_obj(mem_t *orig, size_t size);
mem_t *chk_xalloc(ucnum m, ucnum n, val self);
val cons(val car, val cdr);
val make_lazy_cons(val func);
val make_lazy_cons_car(val func, val car);
val make_lazy_cons_car_cdr(val func, val car, val cdr);
val make_lazy_cons_pub(val func, val car, val cdr);
val lcons_car(val lcons);
val lcons_cdr(val lcons);
void rcyc_cons(val cons);
void rcyc_empty(void);
val lcons_fun(val lcons);
INLINE val us_lcons_fun(val lcons) { return lcons->lc.func; }
val lcons_force(val lcons);
val list(val first, ...); /* terminated by nao */
val listv(varg );
val consp(val obj);
val lconsp(val obj);
val atom(val obj);
val listp(val obj);
val endp(val obj);
val proper_list_p(val obj);
val length_list(val list);
val length_list_lt(val list, val len);
val getplist(val list, val key);
val getplist_f(val list, val key, loc found);
val memp(val key, val plist);
val plist_to_alist(val list);
val improper_plist_to_alist(val list, val boolean_keys);
val num(cnum val);
val unum(ucnum u);
#define num_ex(x) if3((x) > INT_PTR_MAX, unum(x), num(x))
val flo(double val);
cnum c_num(val num, val self);
ucnum c_unum(val num, val self);
cnum c_fixnum(val num, val self);
double c_flo(val self, val num);
val fixnump(val num);
val bignump(val num);
val floatp(val num);
val integerp(val num);
val numberp(val num);
val arithp(val obj);
val nary_op(val self, val (*bfun)(val, val),
val (*ufun)(val self, val),
varg args, val emptyval);
val nary_simple_op(val (*bfun)(val, val),
varg args, val emptyval);
val plus(val anum, val bnum);
val plusv(varg );
val minus(val anum, val bnum);
val minusv(val minuend, varg nlist);
val neg(val num);
val abso(val num);
val mul(val anum, val bnum);
val mulv(varg );
val divv(val dividend, varg );
val trunc(val anum, val bnum);
val mod(val anum, val bnum);
val wrap_star(val start, val end, val num);
val wrap(val start, val end, val num);
val divi(val anum, val bnum);
val zerop(val num);