1
/*===========================================================================
2
* FileName : sigschemeinternal.h
3
* About : variable and function definitions for internal use
5
* Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
9
* Redistribution and use in source and binary forms, with or without
10
* modification, are permitted provided that the following conditions
13
* 1. Redistributions of source code must retain the above copyright
14
* notice, this list of conditions and the following disclaimer.
15
* 2. Redistributions in binary form must reproduce the above copyright
16
* notice, this list of conditions and the following disclaimer in the
17
* documentation and/or other materials provided with the distribution.
18
* 3. Neither the name of authors nor the names of its contributors
19
* may be used to endorse or promote products derived from this software
20
* without specific prior written permission.
22
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23
* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26
* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27
* EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
29
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
30
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
31
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
32
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
===========================================================================*/
34
#ifndef __SIGSCHEMEINTERNAL_H
35
#define __SIGSCHEMEINTERNAL_H
37
/*=======================================
39
=======================================*/
43
/*=======================================
45
=======================================*/
46
#include "sigscheme.h"
49
/*=======================================
51
=======================================*/
52
typedef struct ScmSpecialCharInfo_ ScmSpecialCharInfo;
53
struct ScmSpecialCharInfo_ {
54
scm_ichar_t code; /* character code as ASCII/Unicode */
55
const char *esc_seq; /* escape sequence as string */
56
const char *lex_rep; /* lexical representation as character object */
59
typedef void (*ScmRegisterFunc)(const char *name, ScmFuncType func);
61
struct scm_func_registration_info {
64
ScmRegisterFunc reg_func;
67
/*=======================================
69
=======================================*/
71
extern ScmCharCodec *scm_identifier_codec;
75
extern ScmObj scm_out;
76
extern ScmObj scm_err;
77
extern const ScmSpecialCharInfo scm_special_char_table[];
80
extern void (*scm_write_ss_func)(ScmObj port, ScmObj obj);
84
extern ScmObj scm_null_values;
87
/*=======================================
89
=======================================*/
92
* Port I/O Handling macros
94
#define SCM_CHARPORT_ERROR(cport, msg) (scm_plain_error(msg))
95
#define SCM_BYTEPORT_ERROR(bport, msg) (scm_plain_error(msg))
96
#define SCM_PORT_MALLOC(size) (scm_malloc(size))
97
#define SCM_PORT_CALLOC(number, size) (scm_calloc(number, size))
98
#define SCM_PORT_REALLOC(ptr, size) (scm_realloc(ptr, size))
99
/* Above five macros must be defined before this inclusion. */
100
#include "baseport.h"
101
#endif /* SCM_USE_PORT */
103
/* trace stack for debugging */
104
#define MAKE_TRACE_FRAME(obj, env) CONS((obj), (env))
105
#define TRACE_FRAME_OBJ CAR
106
#define TRACE_FRAME_ENV CDR
108
#define SCM_ENTYPE_INT(o) SCM_SAL_ENTYPE_INT(o)
109
#define SCM_ENTYPE_CONS(o) SCM_SAL_ENTYPE_CONS(o)
110
#define SCM_ENTYPE_SYMBOL(o) SCM_SAL_ENTYPE_SYMBOL(o)
111
#define SCM_ENTYPE_CHAR(o) SCM_SAL_ENTYPE_CHAR(o)
112
#define SCM_ENTYPE_STRING(o) SCM_SAL_ENTYPE_STRING(o)
113
#define SCM_ENTYPE_FUNC(o) SCM_SAL_ENTYPE_FUNC(o)
114
#define SCM_ENTYPE_CLOSURE(o) SCM_SAL_ENTYPE_CLOSURE(o)
115
#define SCM_ENTYPE_VECTOR(o) SCM_SAL_ENTYPE_VECTOR(o)
116
#define SCM_ENTYPE_PORT(o) SCM_SAL_ENTYPE_PORT(o)
117
#define SCM_ENTYPE_CONTINUATION(o) SCM_SAL_ENTYPE_CONTINUATION(o)
118
#define SCM_ENTYPE_C_POINTER(o) SCM_SAL_ENTYPE_C_POINTER(o)
119
#define SCM_ENTYPE_C_FUNCPOINTER(o) SCM_SAL_ENTYPE_C_FUNCPOINTER(o)
121
/* Extraction of a valuepacket is granted only for SigScheme-internals */
122
#define SCM_ENTYPE_VALUEPACKET(o) SCM_SAL_ENTYPE_VALUEPACKET(o)
123
#define SCM_VALUEPACKET_VALUES(o) SCM_SAL_VALUEPACKET_VALUES(o)
124
#if SCM_USE_VALUECONS
125
#define SCM_NULLVALUESP(o) SCM_SAL_NULLVALUESP(o)
126
#define SCM_VALUECONS_CAR(o) SCM_SAL_VALUECONS_CAR(o)
127
#define SCM_VALUECONS_CDR(o) SCM_SAL_VALUECONS_CDR(o)
128
#else /* SCM_USE_VALUECONS */
129
#define SCM_VALUEPACKET_SET_VALUES(o, vals) \
130
SCM_SAL_VALUEPACKET_SET_VALUES((o), (vals))
131
#endif /* SCM_USE_VALUECONS */
133
#define SCM_ENTYPE_FREECELL(o) SCM_SAL_ENTYPE_FREECELL(o)
134
#define SCM_AS_FREECELL(o) SCM_SAL_AS_FREECELL(o)
136
#define SCM_FREECELLP(o) SCM_SAL_FREECELLP(o)
137
#define SCM_FREECELL_NEXT(o) SCM_SAL_FREECELL_NEXT(o)
138
#define SCM_FREECELL_FREESLOT(o) SCM_SAL_FREECELL_FREESLOT(o)
139
#define SCM_FREECELL_SET_NEXT(o, next) SCM_SAL_FREECELL_SET_NEXT((o), (next))
140
#define SCM_FREECELL_SET_FREESLOT(o, v) SCM_SAL_FREECELL_SET_FREESLOT((o), (v))
141
#define SCM_FREECELL_CLEAR_FREESLOT(o) SCM_SAL_FREECELL_CLEAR_FREESLOT((o))
143
/* For optimized operation: Cleanup a destructed ScmCell *cell to a freecell
144
* and chain it into freelist. */
145
#define SCM_RECLAIM_CELL(cell, next) SCM_SAL_RECLAIM_CELL((cell), (next))
147
#define SCM_MARKEDP(o) SCM_SAL_MARKEDP(o)
148
#define SCM_UNMARKEDP(o) SCM_SAL_UNMARKEDP(o)
149
#define SCM_MARK(o) SCM_SAL_MARK(o)
150
#define SCM_UNMARK(o) SCM_SAL_UNMARK(o)
152
/* Prefix-less Abbreviation Names For Convenient Internal Use */
153
#define SYM_QUOTE SCM_SYM_QUOTE
154
#define SYM_QUASIQUOTE SCM_SYM_QUASIQUOTE
155
#define SYM_UNQUOTE SCM_SYM_UNQUOTE
156
#define SYM_UNQUOTE_SPLICING SCM_SYM_UNQUOTE_SPLICING
159
#define NULLP SCM_NULLP
160
#define FALSEP SCM_FALSEP
161
#define NFALSEP SCM_NFALSEP
162
#define EOFP SCM_EOFP
166
#define SET_CAR SCM_CONS_SET_CAR
167
#define SET_CDR SCM_CONS_SET_CDR
168
#define CAAR SCM_CAAR
169
#define CADR SCM_CADR
170
#define CDAR SCM_CDAR
171
#define CDDR SCM_CDDR
173
#define CONS SCM_CONS
174
#define IMMUTABLE_CONS SCM_IMMUTABLE_CONS
175
#define LIST_1 SCM_LIST_1
176
#define LIST_2 SCM_LIST_2
177
#define LIST_3 SCM_LIST_3
178
#define LIST_4 SCM_LIST_4
179
#define LIST_5 SCM_LIST_5
181
#define DEREF SCM_DEREF
183
#define REF_CAR SCM_REF_CAR
184
#define REF_CDR SCM_REF_CDR
185
#define REF_OFF_HEAP SCM_REF_OFF_HEAP
187
#define EVAL SCM_EVAL
189
#define MAKE_BOOL SCM_MAKE_BOOL
190
#define MAKE_INT SCM_MAKE_INT
191
#define MAKE_CONS SCM_MAKE_CONS
192
#define MAKE_IMMUTABLE_CONS SCM_MAKE_IMMUTABLE_CONS
193
#define MAKE_SYMBOL SCM_MAKE_SYMBOL
194
#define MAKE_CHAR SCM_MAKE_CHAR
196
#define MAKE_STRING SCM_MAKE_STRING
197
#define MAKE_STRING_COPYING SCM_MAKE_STRING_COPYING
198
#define MAKE_IMMUTABLE_STRING SCM_MAKE_IMMUTABLE_STRING
199
#define MAKE_IMMUTABLE_STRING_COPYING SCM_MAKE_IMMUTABLE_STRING_COPYING
200
#define CONST_STRING SCM_CONST_STRING
201
#define STRLEN_UNKNOWN SCM_STRLEN_UNKNOWN
203
#define MAKE_FUNC SCM_MAKE_FUNC
204
#define MAKE_CLOSURE SCM_MAKE_CLOSURE
205
#define MAKE_VECTOR SCM_MAKE_VECTOR
206
#define MAKE_IMMUTABLE_VECTOR SCM_MAKE_IMMUTABLE_VECTOR
207
#define MAKE_PORT SCM_MAKE_PORT
208
#define MAKE_CONTINUATION SCM_MAKE_CONTINUATION
209
#if SCM_USE_SSCM_EXTENSIONS
210
#define MAKE_C_POINTER SCM_MAKE_C_POINTER
211
#define MAKE_C_FUNCPOINTER SCM_MAKE_C_FUNCPOINTER
212
#endif /* SCM_USE_SSCM_EXTENSIONS */
213
#define MAKE_VALUEPACKET SCM_MAKE_VALUEPACKET
215
#define NUMBERP SCM_NUMBERP
216
#define INTP SCM_INTP
217
#define CONSP SCM_CONSP
218
#define SYMBOLP SCM_SYMBOLP
219
#define CHARP SCM_CHARP
220
#define STRINGP SCM_STRINGP
221
#define FUNCP SCM_FUNCP
222
#define SYNTAXP SCM_SYNTAXP
223
#define CLOSUREP SCM_CLOSUREP
224
#define PROCEDUREP SCM_PROCEDUREP
225
#define VECTORP SCM_VECTORP
226
#define PORTP SCM_PORTP
227
#define CONTINUATIONP SCM_CONTINUATIONP
228
#if SCM_USE_VALUECONS
229
#define NULLVALUESP SCM_NULLVALUESP
230
#endif /* SCM_USE_VALUECONS */
231
#define VALUEPACKETP SCM_VALUEPACKETP
232
#define FREECELLP SCM_FREECELLP
233
#define C_POINTERP SCM_C_POINTERP
234
#define C_FUNCPOINTERP SCM_C_FUNCPOINTERP
235
#define ENVP SCM_ENVP
236
#define VALID_ENVP SCM_VALID_ENVP
237
#define ERROBJP SCM_ERROBJP
239
#define LISTP SCM_LISTP
240
#define LIST_1_P SCM_LIST_1_P
241
#define LIST_2_P SCM_LIST_2_P
242
#define LIST_3_P SCM_LIST_3_P
243
#define LIST_4_P SCM_LIST_4_P
244
#define LIST_5_P SCM_LIST_5_P
245
#define PROPER_LISTP SCM_PROPER_LISTP
246
#define DOTTED_LISTP SCM_DOTTED_LISTP
247
#define CIRCULAR_LISTP SCM_CIRCULAR_LISTP
249
#define CDBG SCM_CDBG
252
#define ENSURE_PROPER_LIST_TERMINATION SCM_ENSURE_PROPER_LIST_TERMINATION
253
#define CHECK_PROPER_LIST_TERMINATION SCM_CHECK_PROPER_LIST_TERMINATION
257
* Abbrev name for these constants are not provided since it involves some
258
* consistency problems and confusions. Use the canonical names always.
268
/* Obscures identifier ID. */
269
#define SCM_MANGLE(id) scm_internal_##id
271
#define VALIDP(obj) (!EQ((obj), SCM_INVALID))
273
/* Declares the current function name as seen by Scheme codes. TYPE
274
* is ignored, but we may use it in the future to implement a stub
275
* generator. This macro can be invoked only at the beginning of a
276
* function body, right after local variable declarations. */
277
#define DECLARE_FUNCTION(func_name, type) \
278
const char *SCM_MANGLE(name); \
279
ScmObj SCM_MANGLE(tmp); \
280
SCM_MANGLE(name) = func_name; \
281
SCM_MANGLE(tmp) = SCM_INVALID /* No semicolon here. */
283
/* DECLARE_FUNCTION without the functype.
284
* FIXME: is there a better name? */
285
#define DECLARE_INTERNAL_FUNCTION(name) DECLARE_FUNCTION((name), ignored)
287
/* Signals an error without function name. The message is formatted by
289
#define PLAIN_ERR scm_plain_error
291
/* Signals an error. The current function name and the message are
292
sent to the error port. The message is formatted by vfprintf(). */
293
/* FIXME: check variadic macro availability with autoconf */
294
#if HAVE_C99_VARIADIC_MACRO
295
#define ERR(fmt, ...) (scm_error(SCM_MANGLE(name), fmt, __VA_ARGS__))
296
#elif HAVE_GNU_VARIADIC_MACRO
297
#define ERR(fmt, args...) (scm_error(SCM_MANGLE(name), fmt, args))
299
extern const char *scm_err_funcname;
300
void scm_error_with_implicit_func(const char *msg, ...) SCM_NORETURN;
301
#define ERR (scm_err_funcname = SCM_MANGLE(name)), scm_error_with_implicit_func
305
/* Signals an error that occured on an object. The current function
306
* name, the message, then the object, are written (with `write') to
308
#define ERR_OBJ(msg, obj) scm_error_obj(SCM_MANGLE(name), (msg), (obj))
310
/* ASSERT_NO_MORE_ARG() asserts that the variadic argument list has
311
* been exhausted. The assertion is implicit in NO_MORE_ARG(), so
312
* usually you don't have to call it explicitly.
313
* ASSERT_PROPER_ARG_LIST() should be used when scanning is ended
314
* prematurely, e.g. if an argument to "and" evaluates to #f. Both
315
* macros expand to no-ops #if !SCM_STRICT_ARGCHECK.
317
#define ENSURE_NO_MORE_ARG(args) \
318
(NO_MORE_ARG(args) || (ERR_OBJ("superfluous argument(s)", (args)), 1))
319
#define ENSURE_PROPER_ARG_LIST(args) \
320
(PROPER_LISTP(args) || (ERR_OBJ("bad argument list", (args)), 1))
321
#if SCM_STRICT_ARGCHECK
322
#define NO_MORE_ARG(args) \
325
|| (ERR_OBJ("improper argument list terminator", (args)), 1)))
326
#define ASSERT_NO_MORE_ARG(args) ENSURE_NO_MORE_ARG(args)
327
#define ASSERT_PROPER_ARG_LIST(args) ENSURE_PROPER_ARG_LIST(args)
328
#else /* not SCM_STRICT_ARGCHECK */
329
#define NO_MORE_ARG(args) (!CONSP(args))
330
#define ASSERT_NO_MORE_ARG(args)
331
#define ASSERT_PROPER_ARG_LIST(args)
332
#endif /* not SCM_STRICT_ARGCHECK */
334
/* Destructively retreives the first element of a list. */
336
(SCM_MANGLE(tmp) = CAR(_lst), (_lst) = CDR(_lst), SCM_MANGLE(tmp))
338
/* POP() with safety check. */
339
#define SAFE_POP(_lst) \
340
(CONSP((_lst)) ? POP((_lst)) : SCM_INVALID)
342
/* Like POP(), but signals an error if no argument is available. */
343
#define MUST_POP_ARG(_lst) \
344
(CONSP(_lst) ? POP(_lst) : (ERR("missing argument(s)"), NULL))
346
#define FOR_EACH_WHILE(_kar, _lst, _cond) \
347
while ((_cond) && ((_kar) = POP((_lst)), 1))
349
#define FOR_EACH(_kar, _lst) FOR_EACH_WHILE((_kar), (_lst), CONSP(_lst))
351
#define FOR_EACH_PAIR(_subls, _lst) \
352
for ((_subls) = (_lst); CONSP((_subls)); (_subls) = CDR(_subls))
355
* - expression part for the syntax is evaluated for each element except for
357
* - _elm holds the last element after an overall iteration
358
* - _lst holds the terminal cdr after an overall iteration
360
#define FOR_EACH_BUTLAST(_elm, _lst) \
361
SCM_ASSERT(CONSP(_lst)); \
362
while ((_elm) = POP(_lst), CONSP(_lst))
364
#define ENSURE_TYPE(pred, typename, obj) \
365
(pred(obj) || (ERR_OBJ(typename " required but got", (obj)), 1))
367
#define ENSURE_INT(obj) ENSURE_TYPE(INTP, "integer", (obj))
368
#define ENSURE_CONS(obj) ENSURE_TYPE(CONSP, "pair", (obj))
369
#define ENSURE_SYMBOL(obj) ENSURE_TYPE(SYMBOLP, "symbol", (obj))
370
#define ENSURE_CHAR(obj) ENSURE_TYPE(CHARP, "character", (obj))
371
#define ENSURE_STRING(obj) ENSURE_TYPE(STRINGP, "string", (obj))
372
#define ENSURE_FUNC(obj) ENSURE_TYPE(FUNCP, "function", (obj))
373
#define ENSURE_CLOSURE(obj) ENSURE_TYPE(CLOSUREP, "closure", (obj))
374
#define ENSURE_VECTOR(obj) ENSURE_TYPE(VECTORP, "vector", (obj))
375
#define ENSURE_PORT(obj) ENSURE_TYPE(PORTP, "port", (obj))
376
#define ENSURE_CONTINUATION(obj) ENSURE_TYPE(CONTINUATIONP, "continuation", (obj))
377
#define ENSURE_PROCEDURE(obj) ENSURE_TYPE(PROCEDUREP, "procedure", (obj))
378
#define ENSURE_ENV(obj) ENSURE_TYPE(ENVP, "environment specifier", (obj))
379
#define ENSURE_VALID_ENV(obj) \
380
ENSURE_TYPE(VALID_ENVP, "valid environment specifier", (obj))
381
#define ENSURE_ERROBJ(obj) ENSURE_TYPE(ERROBJP, "error object", (obj))
382
#define ENSURE_LIST(obj) ENSURE_TYPE(LISTP, "list", (obj))
384
#define ENSURE_MUTABLE_CONS(kons) \
385
(SCM_CONS_MUTABLEP(kons) \
386
|| (ERR_OBJ("attempted to modify immutable pair", kons), 1))
388
#define ENSURE_MUTABLE_STRING(str) \
389
(SCM_STRING_MUTABLEP(str) \
390
|| (ERR_OBJ("attempted to modify immutable string", str), 1))
392
#define ENSURE_MUTABLE_VECTOR(vec) \
393
(SCM_VECTOR_MUTABLEP(vec) \
394
|| (ERR_OBJ("attempted to modify immutable vector", vec), 1))
396
#if SCM_USE_MULTIBYTE_CHAR
397
#define ENSURE_STATEFUL_CODEC(codec) \
398
(SCM_CHARCODEC_STATEFULP(codec) \
399
|| (ERR("stateful character codec required but got: %s", \
400
SCM_CHARCODEC_ENCODING(codec)), 0))
401
#define ENSURE_STATELESS_CODEC(codec) \
402
(!SCM_CHARCODEC_STATEFULP(codec) \
403
|| (ERR("stateless character codec required but got: %s", \
404
SCM_CHARCODEC_ENCODING(codec)), 0))
405
#endif /* SCM_USE_MULTIBYTE_CHAR */
407
#define ENSURE_ALLOCATED SCM_ENSURE_ALLOCATED
409
/* Macros For Handling Continuation Object */
410
#define INVALID_CONTINUATION_OPAQUE NULL
412
/* error handlings */
413
#define SCM_ERR_HEADER "ERROR: "
415
#define EQVP(a, b) (NFALSEP(scm_p_eqvp((a), (b))))
416
#define EQUALP(a, b) (NFALSEP(scm_p_equalp((a), (b))))
417
#define STRING_EQUALP(str1, str2) \
418
(EQ((str1), (str2)) \
419
|| (SCM_STRING_LEN(str1) == SCM_STRING_LEN(str2) /* rough rejection */ \
420
&& strcmp(SCM_STRING_STR(str1), SCM_STRING_STR(str2)) == 0))
422
/* result encoders for scm_length() */
423
#define SCM_LISTLEN_ENCODE_DOTTED(len) (-(len))
424
#define SCM_LISTLEN_ENCODE_CIRCULAR(len) (SCM_INT_T_MIN)
425
#define SCM_LISTLEN_ENCODE_ERROR SCM_LISTLEN_ENCODE_CIRCULAR
427
/*=======================================
429
=======================================*/
431
#define ICHAR_ASCIIP(c) (0 <= (c) && (c) <= 127)
432
#define ICHAR_CONTROLP(c) ((0 <= (c) && (c) <= 31) || (c) == 127)
433
#define ICHAR_WHITESPACEP(c) ((c) == ' ' || ('\t' <= (c) && (c) <= '\r'))
434
#define ICHAR_NUMERICP(c) ('0' <= (c) && (c) <= '9')
435
#define ICHAR_HEXA_NUMERICP(c) (ICHAR_NUMERICP(c) \
436
|| ('a' <= (c) && (c) <= 'f') \
437
|| ('A' <= (c) && (c) <= 'F'))
438
#define ICHAR_ALPHABETICP(c) (ICHAR_UPPER_CASEP(c) || ICHAR_LOWER_CASEP(c))
439
#define ICHAR_UPPER_CASEP(c) ('A' <= (c) && (c) <= 'Z')
440
#define ICHAR_LOWER_CASEP(c) ('a' <= (c) && (c) <= 'z')
443
* SigScheme's case-insensitive character comparison conforms to the
444
* foldcase'ed comparison described in SRFI-75 and SRFI-13, although R5RS does
445
* not define comparison between alphabetic and non-alphabetic char.
447
* This specification is needed to produce natural result on sort functions
448
* with these case-insensitive predicates as comparator.
450
* (a-sort '(#\a #\c #\B #\D #\1 #\[ #\$ #\_) char-ci<?)
451
* => (#\$ #\1 #\a #\B #\c #\D #\[ #\_) ;; the "natural result"
453
* => (#\$ #\1 #\B #\D #\[ #\_ #\a #\c) ;; "unnatural result"
457
* - Description around 'char-foldcase' in SRFI-75
458
* - "Case mapping and case-folding" and "Comparison" section of SRFI-13
460
/* FIXME: support SRFI-75 */
461
#define ICHAR_DOWNCASE(c) (ICHAR_UPPER_CASEP(c) ? (c) + ('a' - 'A') : (c))
462
#define ICHAR_UPCASE(c) (ICHAR_LOWER_CASEP(c) ? (c) - ('a' - 'A') : (c))
463
/* foldcase for case-insensitive character comparison is done by downcase as
464
* described in SRFI-75. Although SRFI-13 expects (char-downcase (char-upcase
465
* c)), this implementation is sufficient for ASCII range. */
466
#define ICHAR_FOLDCASE(c) (ICHAR_DOWNCASE(c))
468
/*=======================================
470
=======================================*/
471
typedef ScmRef ScmQueue;
472
#define SCM_QUEUE_INVALIDATE(_q) ((_q) = NULL)
473
#define SCM_QUEUE_VALIDP(_q) (_q)
474
#define SCM_QUEUE_POINT_TO(_q, _out) ((_q) = SCM_REF_OFF_HEAP(_out))
475
#define SCM_QUEUE_ADD(_q, _dat) (SET((_q), LIST_1(_dat)), \
476
(_q) = REF_CDR(DEREF(_q)))
477
#define SCM_QUEUE_CONST_ADD(_q, _dat) \
478
(SET((_q), IMMUTABLE_CONS((_dat), SCM_NULL)), \
479
(_q) = REF_CDR(DEREF(_q)))
480
#define SCM_QUEUE_APPEND(_q, _lst) \
483
while (CONSP(DEREF(_q))) \
484
(_q) = REF_CDR(DEREF(_q)); \
485
} while (/* CONSTCOND */ 0)
486
#define SCM_QUEUE_TERMINATOR(_q) (DEREF(_q))
487
#define SCM_QUEUE_SLOPPY_APPEND(_q, _lst) (SET((_q), (_lst)))
489
/*=======================================
490
Local Buffer Allocator
491
=======================================*/
492
/* don't touch inside directly */
494
struct ScmLBuf_##T##_ { \
499
size_t extended_cnt; \
504
/* lvalue access is permitted */
505
#define LBUF_BUF(lbuf) ((lbuf).buf)
507
/* lvalue access is not permitted */
508
#define LBUF_END(lbuf) (&LBUF_BUF(lbuf)[LBUF_SIZE(lbuf)])
509
#define LBUF_SIZE(lbuf) ((lbuf).size)
510
#define LBUF_INIT_SIZE(lbuf) ((lbuf).init_size)
511
#define LBUF_EXT_CNT(lbuf) ((lbuf).extended_cnt)
513
#define LBUF_INIT(lbuf, init_buf, init_size) \
514
scm_lbuf_init((void *)&(lbuf), (init_buf), (init_size))
516
#define LBUF_FREE(lbuf) \
517
scm_lbuf_free((void *)&(lbuf))
519
#define LBUF_ALLOC(lbuf, size) \
520
scm_lbuf_alloc((void *)&(lbuf), (size))
522
#define LBUF_REALLOC(lbuf, size) \
523
scm_lbuf_realloc((void *)&(lbuf), (size))
525
#define LBUF_EXTEND(lbuf, f, least_size) \
526
scm_lbuf_extend((void *)&(lbuf), (f), (least_size))
528
void scm_lbuf_init(struct ScmLBuf_void_ *lbuf,
529
void *init_buf, size_t init_size);
530
void scm_lbuf_free(struct ScmLBuf_void_ *lbuf);
531
void scm_lbuf_alloc(struct ScmLBuf_void_ *lbuf, size_t size);
532
void scm_lbuf_realloc(struct ScmLBuf_void_ *lbuf, size_t size);
533
void scm_lbuf_extend(struct ScmLBuf_void_ *lbuf,
534
size_t (*f)(struct ScmLBuf_void_ *), size_t least_size);
537
* extended size functions:
538
* define your own version if more optimized version is needed
540
size_t scm_lbuf_f_linear(struct ScmLBuf_void_ *lbuf);
541
size_t scm_lbuf_f_exponential(struct ScmLBuf_void_ *lbuf);
543
/*=======================================
544
Function Declarations
545
=======================================*/
547
void scm_init_storage(const ScmStorageConf *conf);
548
void scm_finalize_storage(void);
551
void scm_init_gc(const ScmStorageConf *conf);
552
void scm_finalize_gc(void);
553
ScmObj scm_alloc_cell(void);
555
/* storage-continuation.c */
556
void scm_init_continuation(void);
557
void scm_finalize_continuation(void);
558
void scm_destruct_continuation(ScmObj cont);
559
ScmObj scm_call_with_current_continuation(ScmObj proc,
560
ScmEvalState *eval_state);
561
void scm_call_continuation(ScmObj cont, ScmObj ret) SCM_NORETURN;
562
ScmObj scm_dynamic_wind(ScmObj before, ScmObj thunk, ScmObj after);
563
void scm_push_trace_frame(ScmObj obj, ScmObj env);
564
void scm_pop_trace_frame(void);
565
ScmObj scm_trace_stack(void);
567
/* storage-symbol.c */
568
void scm_init_symbol(const ScmStorageConf *conf);
569
void scm_finalize_symbol(void);
572
scm_bool scm_toplevel_environmentp(ScmObj env);
573
ScmObj scm_extend_environment(ScmObj formals, ScmObj actuals, ScmObj env);
574
ScmObj scm_replace_environment(ScmObj formals, ScmObj actuals, ScmObj env);
575
ScmObj scm_update_environment(ScmObj actuals, ScmObj env);
576
ScmObj scm_add_environment(ScmObj var, ScmObj val, ScmObj env);
577
ScmRef scm_lookup_environment(ScmObj var, ScmObj env);
579
scm_bool scm_valid_environmentp(ScmObj env);
580
scm_bool scm_valid_environment_extensionp(ScmObj formals, ScmObj actuals);
581
scm_bool scm_valid_environment_extension_lengthp(scm_int_t formals_len,
582
scm_int_t actuals_len);
583
scm_int_t scm_validate_formals(ScmObj formals);
584
scm_int_t scm_validate_actuals(ScmObj actuals);
587
ScmObj scm_symbol_value(ScmObj var, ScmObj env);
588
ScmObj scm_tailcall(ScmObj proc, ScmObj args, ScmEvalState *eval_state);
589
ScmObj scm_eval(ScmObj obj, ScmObj env);
592
void scm_init_syntax(void);
593
ScmObj scm_s_body(ScmObj body, ScmEvalState *eval_state);
594
ScmObj scm_s_cond_internal(ScmObj args, ScmObj case_key,
595
ScmEvalState *eval_state);
598
void scm_init_error(void);
601
scm_int_t scm_finite_length(ScmObj lst);
602
scm_int_t scm_length(ScmObj lst);
605
scm_int_t scm_string2number(const char *str, int radix, scm_bool *err);
608
void scm_init_port(void);
609
ScmObj scm_prepare_port(ScmObj args, ScmObj default_port);
610
ScmCharPort *scm_make_char_port(ScmBytePort *bport);
613
void scm_display_errobj_ss(ScmObj port, ScmObj errobj);
616
void scm_init_module(void);
617
void scm_register_funcs(struct scm_func_registration_info *table);
620
char **scm_interpret_argv(char **argv);
621
void scm_free_argv(char **argv);
623
#endif /* __SIGSCHEMEINTERNAL_H */
added
removed
src/sigschemeinternal.h
