/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- ScmHeader
- ScmInstance
- ScmForeignPointer
- ScmStringBody
- ScmDStringChunk
- ScmDStringChain
- ScmStringPointer
- ScmPortBuffer
- ScmPortVTable
- ScmReadContext
- ScmReadReference
- ScmWeakVector
- ScmHashIter
- ScmSysSigset
- ScmSysStat
- ScmTime
- ScmSysTm
- ScmSysGroup
- ScmSysPasswd
- ScmSysFdset
1 /*
2 * gauche.h - Gauche scheme system header
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: gauche.h,v 1.442 2005/10/13 08:14:13 shirok Exp $
34 */
35
36 #ifndef GAUCHE_H
37 #define GAUCHE_H
38
39 #include <stdio.h>
40 #include <sys/types.h>
41 #include <sys/stat.h>
42 #include <stdarg.h>
43 #include <setjmp.h>
44 #include <limits.h>
45 #include <signal.h>
46 #include <string.h>
47 #include <errno.h>
48 #include <gauche/config.h> /* read config.h _before_ gc.h */
49 #include <gauche/int64.h>
50
51 #if defined(LIBGAUCHE_BODY)
52 #define GC_DLL /* for gc.h to handle Win32 crazyness */
53 #define GC_BUILD /* ditto */
54 #endif
55 #include <gc.h>
56
57 #ifndef SCM_DECL_BEGIN
58 #ifdef __cplusplus
59 #define SCM_DECL_BEGIN extern "C" {
60 #define SCM_DECL_END }
61 #else /*! __cplusplus */
62 #define SCM_DECL_BEGIN
63 #define SCM_DECL_END
64 #endif /*! __cplusplus */
65 #endif /*!defined(SCM_DECL_BEGIN)*/
66
67 SCM_DECL_BEGIN
68
69 #ifdef TIME_WITH_SYS_TIME
70 # include <sys/time.h>
71 # include <time.h>
72 #else
73 # ifdef HAVE_SYS_TIME_H
74 # include <sys/time.h>
75 # else
76 # include <time.h>
77 # endif
78 #endif
79
80 /* Ugly cliche for Win32. */
81 #if defined(__CYGWIN__) || defined(__MINGW32__)
82 # if defined(LIBGAUCHE_BODY)
83 # define SCM_EXTERN extern
84 # else
85 # define SCM_EXTERN extern __declspec(dllimport)
86 # endif
87 #else /*!(__CYGWIN__ || __MINGW32__)*/
88 # define SCM_EXTERN extern
89 #endif /*!(__CYGWIN__ || __MINGW32__)*/
90
91 /* For Mingw32, we need some tricks */
92 #if defined(__MINGW32__)
93 #include <gauche/mingw-compat.h>
94 #endif /*__MINGW32__*/
95
96 /* Some useful macros */
97
98 #ifndef FALSE
99 #define FALSE 0
100 #endif
101 #ifndef TRUE
102 #define TRUE (!FALSE)
103 #endif
104
105 /* This defines several auxiliary routines that are useful for debugging */
106 #ifndef SCM_DEBUG_HELPER
107 #define SCM_DEBUG_HELPER TRUE
108 #endif
109
110 #define SCM_INLINE_MALLOC_PRIMITIVES
111
112 #ifdef GAUCHE_USE_PTHREADS
113 # include <gauche/pthread.h>
114 #else /* !GAUCHE_USE_PTHREADS */
115 # include <gauche/uthread.h>
116 #endif /* !GAUCHE_USE_PTHREADS */
117
118 /*-------------------------------------------------------------
119 * BASIC TYPES
120 */
121
122 /*
123 * A word large enough to hold a pointer
124 */
125 typedef unsigned long ScmWord;
126
127 /*
128 * A byte
129 */
130 typedef unsigned char ScmByte;
131
132 /*
133 * A character.
134 */
135 typedef long ScmChar;
136
137 /*
138 * An opaque pointer. All Scheme objects are represented by
139 * this type.
140 */
141 typedef struct ScmHeaderRec *ScmObj;
142
143 /*
144 * The class structure. ScmClass is actually a subclass of ScmObj.
145 */
146 typedef struct ScmClassRec ScmClass;
147
148 /* TAG STRUCTURE
149 *
150 * [Pointer]
151 * -------- -------- -------- ------00
152 * Points to a pair or other heap-allocated objects.
153 *
154 * [Fixnum]
155 * -------- -------- -------- ------01
156 * 30-bit signed integer
157 *
158 * [Character]
159 * -------- -------- -------- -----010
160 * 29-bit
161 *
162 * [Miscellaneous]
163 * -------- -------- -------- ----0110
164 * #f, #t, '(), eof-object, undefined
165 *
166 * [Pattern variable]
167 * -------- -------- -------- ----1110
168 * Used in macro expander.
169 *
170 * [Heap object]
171 * -------- -------- -------- ------11
172 * Only appears at the first word of heap-allocated
173 * objects except pairs. Masking lower 2bits gives
174 * a pointer to ScmClass.
175 */
176
177 /* Type coercer */
178
179 #define SCM_OBJ(obj) ((ScmObj)(obj))
180 #define SCM_WORD(obj) ((ScmWord)(obj))
181
182 /*
183 * PRIMARY TAG IDENTIFICATION
184 */
185
186 #define SCM_TAG(obj) (SCM_WORD(obj) & 0x03)
187 #define SCM_PTRP(obj) (SCM_TAG(obj) == 0)
188
189 /*
190 * IMMEDIATE OBJECTS
191 */
192
193 #define SCM_IMMEDIATEP(obj) ((SCM_WORD(obj)&0x0f) == 6)
194 #define SCM_ITAG(obj) (SCM_WORD(obj)>>4)
195
196 #define SCM__MAKE_ITAG(num) (((num)<<4) + 6)
197 #define SCM_FALSE SCM_OBJ(SCM__MAKE_ITAG(0)) /* #f */
198 #define SCM_TRUE SCM_OBJ(SCM__MAKE_ITAG(1)) /* #t */
199 #define SCM_NIL SCM_OBJ(SCM__MAKE_ITAG(2)) /* '() */
200 #define SCM_EOF SCM_OBJ(SCM__MAKE_ITAG(3)) /* eof-object */
201 #define SCM_UNDEFINED SCM_OBJ(SCM__MAKE_ITAG(4)) /* #undefined */
202 #define SCM_UNBOUND SCM_OBJ(SCM__MAKE_ITAG(5)) /* unbound value */
203
204 #define SCM_FALSEP(obj) ((obj) == SCM_FALSE)
205 #define SCM_TRUEP(obj) ((obj) == SCM_TRUE)
206 #define SCM_NULLP(obj) ((obj) == SCM_NIL)
207 #define SCM_EOFP(obj) ((obj) == SCM_EOF)
208 #define SCM_UNDEFINEDP(obj) ((obj) == SCM_UNDEFINED)
209 #define SCM_UNBOUNDP(obj) ((obj) == SCM_UNBOUND)
210
211 /*
212 * BOOLEAN
213 */
214 #define SCM_BOOLP(obj) ((obj) == SCM_TRUE || (obj) == SCM_FALSE)
215 #define SCM_BOOL_VALUE(obj) (!SCM_FALSEP(obj))
216 #define SCM_MAKE_BOOL(obj) ((obj)? SCM_TRUE:SCM_FALSE)
217
218 #define SCM_EQ(x, y) ((x) == (y))
219
220 SCM_EXTERN int Scm_EqP(ScmObj x, ScmObj y);
221 SCM_EXTERN int Scm_EqvP(ScmObj x, ScmObj y);
222 SCM_EXTERN int Scm_EqualP(ScmObj x, ScmObj y);
223
224 /* comparison mode */
225 enum {
226 SCM_CMP_EQ,
227 SCM_CMP_EQV,
228 SCM_CMP_EQUAL
229 };
230
231 SCM_EXTERN int Scm_EqualM(ScmObj x, ScmObj y, int mode);
232
233 /*
234 * FIXNUM
235 */
236
237 #define SCM_INTP(obj) (SCM_TAG(obj) == 1)
238 #define SCM_INT_VALUE(obj) (((signed long int)(obj)) >> 2)
239 #define SCM_MAKE_INT(obj) SCM_OBJ(((long)(obj) << 2) + 1)
240
241 #define SCM_UINTP(obj) (SCM_INTP(obj)&&((signed long int)(obj)>=0))
242
243 /*
244 * CHARACTERS
245 *
246 * A character is represented by (up to) 29-bit integer. The actual
247 * encoding depends on compile-time flags.
248 *
249 * For character cases, I only care about ASCII chars (at least for now)
250 */
251
252 #define SCM_CHAR(obj) ((ScmChar)(obj))
253 #define SCM_CHARP(obj) ((SCM_WORD(obj)&0x07L) == 2)
254 #define SCM_CHAR_VALUE(obj) SCM_CHAR(SCM_WORD(obj) >> 3)
255 #define SCM_MAKE_CHAR(ch) SCM_OBJ((long)((ch) << 3) + 2)
256
257 #define SCM_CHAR_INVALID ((ScmChar)(-1)) /* indicate invalid char */
258 #define SCM_CHAR_MAX (0x1fffffff)
259
260 #define SCM_CHAR_ASCII_P(ch) ((ch) < 0x80)
261 #define SCM_CHAR_UPPER_P(ch) (('A' <= (ch)) && ((ch) <= 'Z'))
262 #define SCM_CHAR_LOWER_P(ch) (('a' <= (ch)) && ((ch) <= 'z'))
263 #define SCM_CHAR_UPCASE(ch) (SCM_CHAR_LOWER_P(ch)?((ch)-('a'-'A')):(ch))
264 #define SCM_CHAR_DOWNCASE(ch) (SCM_CHAR_UPPER_P(ch)?((ch)+('a'-'A')):(ch))
265
266 SCM_EXTERN int Scm_DigitToInt(ScmChar ch, int radix);
267 SCM_EXTERN ScmChar Scm_IntToDigit(int n, int radix);
268 SCM_EXTERN int Scm_CharToUcs(ScmChar ch);
269 SCM_EXTERN ScmChar Scm_UcsToChar(int ucs);
270 SCM_EXTERN ScmObj Scm_CharEncodingName(void);
271 SCM_EXTERN const char **Scm_SupportedCharacterEncodings(void);
272 SCM_EXTERN int Scm_SupportedCharacterEncodingP(const char *encoding);
273
274 #if defined(GAUCHE_CHAR_ENCODING_EUC_JP)
275 #include "gauche/char_euc_jp.h"
276 #elif defined(GAUCHE_CHAR_ENCODING_UTF_8)
277 #include "gauche/char_utf_8.h"
278 #elif defined(GAUCHE_CHAR_ENCODING_SJIS)
279 #include "gauche/char_sjis.h"
280 #else
281 #include "gauche/char_none.h"
282 #endif
283
284 /*
285 * HEAP ALLOCATED OBJECTS
286 *
287 * A heap allocated object has its class tag in the first word
288 * (except pairs). Masking the lower two bits of class tag
289 * gives a pointer to the class object.
290 */
291
292 #define SCM_HOBJP(obj) (SCM_PTRP(obj)&&SCM_TAG(SCM_OBJ(obj)->tag)==3)
293
294 #define SCM_CPP_CAT(a, b) a ## b
295 #define SCM_CPP_CAT3(a, b, c) a ## b ## c
296
297 #define SCM_CLASS_DECL(klass) extern ScmClass klass
298 #define SCM_CLASS_STATIC_PTR(klass) (&klass)
299 #define SCM_CLASS2TAG(klass) ((ScmByte*)(klass) + 3)
300
301 /* A common header for heap-allocated objects */
302 typedef struct ScmHeaderRec {
303 ScmByte *tag; /* private. should be accessed
304 only via macros. */
305 } ScmHeader;
306
307 #define SCM_HEADER ScmHeader hdr /* for declaration */
308
309 /* Extract the class pointer from the tag.
310 You can use these only if SCM_HOBJP(obj) != FALSE */
311 #define SCM_CLASS_OF(obj) SCM_CLASS((SCM_OBJ(obj)->tag - 3))
312 #define SCM_SET_CLASS(obj, k) (SCM_OBJ(obj)->tag = (ScmByte*)(k) + 3)
313
314 /* Check if classof(OBJ) equals to an extended class KLASS */
315 #define SCM_XTYPEP(obj, klass) \
316 (SCM_PTRP(obj)&&(SCM_OBJ(obj)->tag == SCM_CLASS2TAG(klass)))
317
318 /* Check if classof(OBJ) is a subtype of an extended class KLASS */
319 #define SCM_ISA(obj, klass) (SCM_XTYPEP(obj,klass)||Scm_TypeP(SCM_OBJ(obj),klass))
320
321 /* A common header for objects whose class is defined in Scheme */
322 typedef struct ScmInstanceRec {
323 ScmByte *tag; /* private */
324 ScmObj *slots; /* private */
325 } ScmInstance;
326
327 #define SCM_INSTANCE_HEADER ScmInstance hdr /* for declaration */
328
329 #define SCM_INSTANCE(obj) ((ScmInstance*)(obj))
330 #define SCM_INSTANCE_SLOTS(obj) (SCM_INSTANCE(obj)->slots)
331
332 /* Fundamental allocators */
333 #define SCM_MALLOC(size) GC_MALLOC(size)
334 #define SCM_MALLOC_ATOMIC(size) GC_MALLOC_ATOMIC(size)
335
336 #define SCM_NEW(type) ((type*)(SCM_MALLOC(sizeof(type))))
337 #define SCM_NEW_ARRAY(type, nelts) ((type*)(SCM_MALLOC(sizeof(type)*(nelts))))
338 #define SCM_NEW2(type, size) ((type)(SCM_MALLOC(size)))
339 #define SCM_NEW_ATOMIC(type) ((type*)(SCM_MALLOC_ATOMIC(sizeof(type))))
340 #define SCM_NEW_ATOMIC2(type, size) ((type)(SCM_MALLOC_ATOMIC(size)))
341
342 typedef void (*ScmFinalizerProc)(ScmObj z, void *data);
343 SCM_EXTERN void Scm_RegisterFinalizer(ScmObj z, ScmFinalizerProc finalizer,
344 void *data);
345 SCM_EXTERN void Scm_UnregisterFinalizer(ScmObj z);
346
347 /* Safe coercer */
348 #define SCM_OBJ_SAFE(obj) ((obj)?SCM_OBJ(obj):SCM_UNDEFINED)
349
350 typedef struct ScmVMRec ScmVM;
351 typedef struct ScmPairRec ScmPair;
352 typedef struct ScmExtendedPairRec ScmExtendedPair;
353 typedef struct ScmCharSetRec ScmCharSet;
354 typedef struct ScmStringRec ScmString;
355 typedef struct ScmDStringRec ScmDString;
356 typedef struct ScmVectorRec ScmVector;
357 typedef struct ScmBignumRec ScmBignum;
358 typedef struct ScmFlonumRec ScmFlonum;
359 typedef struct ScmComplexRec ScmComplex;
360 typedef struct ScmPortRec ScmPort;
361 typedef struct ScmHashTableRec ScmHashTable;
362 typedef struct ScmModuleRec ScmModule;
363 typedef struct ScmSymbolRec ScmSymbol;
364 typedef struct ScmGlocRec ScmGloc;
365 typedef struct ScmKeywordRec ScmKeyword;
366 typedef struct ScmProcedureRec ScmProcedure;
367 typedef struct ScmClosureRec ScmClosure;
368 typedef struct ScmSubrRec ScmSubr;
369 typedef struct ScmGenericRec ScmGeneric;
370 typedef struct ScmMethodRec ScmMethod;
371 typedef struct ScmNextMethodRec ScmNextMethod;
372 typedef struct ScmSyntaxRec ScmSyntax;
373 typedef struct ScmMacroRec ScmMacro;
374 typedef struct ScmPromiseRec ScmPromise;
375 typedef struct ScmRegexpRec ScmRegexp;
376 typedef struct ScmRegMatchRec ScmRegMatch;
377 typedef struct ScmWriteContextRec ScmWriteContext;
378 typedef struct ScmAutoloadRec ScmAutoload;
379
380 /*---------------------------------------------------------
381 * VM STUFF
382 */
383
384 /* Detailed definitions are in vm.h. Here I expose external interface */
385
386 #include <gauche/vm.h>
387
388 #define SCM_VM(obj) ((ScmVM *)(obj))
389 #define SCM_VMP(obj) SCM_XTYPEP(obj, SCM_CLASS_VM)
390
391 #define SCM_VM_CURRENT_INPUT_PORT(vm) (SCM_VM(vm)->curin)
392 #define SCM_VM_CURRENT_OUTPUT_PORT(vm) (SCM_VM(vm)->curout)
393 #define SCM_VM_CURRENT_ERROR_PORT(vm) (SCM_VM(vm)->curerr)
394
395 SCM_EXTERN ScmVM *Scm_VM(void); /* Returns the current VM */
396
397 SCM_EXTERN ScmObj Scm_Eval(ScmObj form, ScmObj env);
398 SCM_EXTERN ScmObj Scm_EvalCString(const char *form, ScmObj env);
399 SCM_EXTERN ScmObj Scm_Apply(ScmObj proc, ScmObj args);
400 SCM_EXTERN ScmObj Scm_Values(ScmObj args);
401 SCM_EXTERN ScmObj Scm_Values2(ScmObj val0, ScmObj val1);
402 SCM_EXTERN ScmObj Scm_Values3(ScmObj val0, ScmObj val1, ScmObj val2);
403 SCM_EXTERN ScmObj Scm_Values4(ScmObj val0, ScmObj val1, ScmObj val2,
404 ScmObj val3);
405 SCM_EXTERN ScmObj Scm_Values5(ScmObj val0, ScmObj val1, ScmObj val2,
406 ScmObj val3, ScmObj val4);
407
408 SCM_EXTERN ScmObj Scm_MakeMacroTransformer(ScmSymbol *name,
409 ScmObj proc);
410 SCM_EXTERN ScmObj Scm_MakeMacroAutoload(ScmSymbol *name,
411 ScmAutoload *al);
412
413 SCM_EXTERN ScmObj Scm_UnwrapSyntax(ScmObj form);
414
415 SCM_EXTERN ScmObj Scm_VMGetResult(ScmVM *vm);
416 SCM_EXTERN ScmObj Scm_VMGetStackLite(ScmVM *vm);
417 SCM_EXTERN ScmObj Scm_VMGetStack(ScmVM *vm);
418
419 SCM_EXTERN ScmObj Scm_VMApply(ScmObj proc, ScmObj args);
420 SCM_EXTERN ScmObj Scm_VMApply0(ScmObj proc);
421 SCM_EXTERN ScmObj Scm_VMApply1(ScmObj proc, ScmObj arg);
422 SCM_EXTERN ScmObj Scm_VMApply2(ScmObj proc, ScmObj arg1, ScmObj arg2);
423 SCM_EXTERN ScmObj Scm_VMApply3(ScmObj proc, ScmObj arg1, ScmObj arg2,
424 ScmObj arg3);
425 SCM_EXTERN ScmObj Scm_VMApply4(ScmObj proc, ScmObj arg1, ScmObj arg2,
426 ScmObj arg3, ScmObj arg4);
427 SCM_EXTERN ScmObj Scm_VMEval(ScmObj expr, ScmObj env);
428 SCM_EXTERN ScmObj Scm_VMCall(ScmObj *args, int argcnt, void *data);
429
430 SCM_EXTERN ScmObj Scm_VMCallCC(ScmObj proc);
431 SCM_EXTERN ScmObj Scm_VMDynamicWind(ScmObj pre, ScmObj body, ScmObj post);
432 SCM_EXTERN ScmObj Scm_VMDynamicWindC(ScmObj (*before)(ScmObj *, int, void *),
433 ScmObj (*body)(ScmObj *, int, void *),
434 ScmObj (*after)(ScmObj *, int, void *),
435 void *data);
436
437 SCM_EXTERN ScmObj Scm_VMWithErrorHandler(ScmObj handler, ScmObj thunk);
438 SCM_EXTERN ScmObj Scm_VMWithExceptionHandler(ScmObj handler, ScmObj thunk);
439
440 /*---------------------------------------------------------
441 * CLASS
442 */
443
444 typedef void (*ScmClassPrintProc)(ScmObj obj,
445 ScmPort *sink,
446 ScmWriteContext *mode);
447 typedef int (*ScmClassCompareProc)(ScmObj x, ScmObj y, int equalp);
448 typedef int (*ScmClassSerializeProc)(ScmObj obj,
449 ScmPort *sink,
450 ScmObj context);
451 typedef ScmObj (*ScmClassAllocateProc)(ScmClass *klass, ScmObj initargs);
452
453 /* See class.c for the description of function pointer members.
454 There's a lot of voodoo magic in class structure, so don't touch
455 those fields casually. Also, the order of these fields must be
456 reflected to the class definition macros below */
457 struct ScmClassRec {
458 SCM_INSTANCE_HEADER;
459 ScmClassPrintProc print;
460 ScmClassCompareProc compare;
461 ScmClassSerializeProc serialize;
462 ScmClassAllocateProc allocate;
463 ScmClass **cpa; /* class precedence array, NULL terminated */
464 int numInstanceSlots; /* # of instance slots */
465 int coreSize; /* size of core structure; 0 == unknown */
466 unsigned int flags;
467 ScmObj name; /* scheme name */
468 ScmObj directSupers; /* list of classes */
469 ScmObj cpl; /* list of classes */
470 ScmObj accessors; /* alist of slot-name & slot-accessor */
471 ScmObj directSlots; /* alist of slot-name & slot-definition */
472 ScmObj slots; /* alist of slot-name & slot-definition */
473 ScmObj directSubclasses; /* list of direct subclasses */
474 ScmObj directMethods; /* list of methods that has this class in
475 its specializer */
476 ScmObj initargs; /* saved key-value list for redefinition */
477 ScmObj modules; /* modules where this class is defined */
478 ScmObj redefined; /* if this class is obsoleted by class
479 redefinition, points to the new class.
480 if this class is being redefined, points
481 to a thread that is handling the
482 redefinition. (it won't be seen by
483 Scheme; see class.c)
484 otherwise #f */
485 ScmInternalMutex mutex; /* to protect from MT hazard */
486 ScmInternalCond cv; /* wait on this while a class being updated */
487 void *data; /* extra data to do nasty trick */
488 };
489
490 typedef struct ScmClassStaticSlotSpecRec ScmClassStaticSlotSpec;
491
492 #define SCM_CLASS(obj) ((ScmClass*)(obj))
493 #define SCM_CLASSP(obj) SCM_ISA(obj, SCM_CLASS_CLASS)
494
495 /* Class categories
496
497 In C level, there are four categories of classes. The category of
498 class can be obtained by masking the lower two bits of flags field.
499
500 SCM_CLASS_BUILTIN
501 An instance of this class doesn't have "slots" member (thus
502 cannot be casted to ScmInstance). From Scheme level, this
503 class cannot be inherited, nor redefined. In C you can create
504 subclasses, by making sure the subclass' instance structure
505 to include this class's instance structure. Such "hard-wired"
506 inheritance only forms a tree, i.e. no multiple inheritance.
507
508 SCM_CLASS_ABSTRACT
509 This class is defined in C, but doesn't allowed to create an
510 instance by its own. It is intended to be used as a mixin from
511 both C and Scheme-defined class. This class shouldn't have
512 C members other than SCM_HEADER. This class cannot be redefined.
513
514 SCM_CLASS_BASE
515 This class is defined in C, and can be subclassed in Scheme.
516 An instance of this class must have "slots" member and be
517 able to be casted to ScmInstance. The instance may have other
518 C members. This class cannot be redefined.
519
520 SCM_CLASS_SCHEME
521 A Scheme-defined class. This class should have at most one
522 SCM_CLASS_BASE class in its CPL, except the <object> class,
523 which is always in the CPL of Scheme-defined class. All other
524 classes in CPL must be either SCM_CLASS_ABSTRACT or
525 SCM_CLASS_SCHEME. This class can be redefined.
526 */
527
528 enum {
529 SCM_CLASS_BUILTIN = 0,
530 SCM_CLASS_ABSTRACT = 1,
531 SCM_CLASS_BASE = 2,
532 SCM_CLASS_SCHEME = 3,
533
534 /* A special flag that only be used for "natively applicable"
535 objects, which basically inherits ScmProcedure. */
536 SCM_CLASS_APPLICABLE = 0x04
537 };
538
539 #define SCM_CLASS_FLAGS(obj) (SCM_CLASS(obj)->flags)
540 #define SCM_CLASS_APPLICABLE_P(obj) (SCM_CLASS_FLAGS(obj)&SCM_CLASS_APPLICABLE)
541
542 #define SCM_CLASS_CATEGORY(obj) (SCM_CLASS_FLAGS(obj)&3)
543
544 SCM_EXTERN void Scm_InitStaticClass(ScmClass *klass, const char *name,
545 ScmModule *mod,
546 ScmClassStaticSlotSpec *slots,
547 int flags);
548 SCM_EXTERN void Scm_InitStaticClassWithSupers(ScmClass *klass,
549 const char *name,
550 ScmModule *mod,
551 ScmObj supers,
552 ScmClassStaticSlotSpec *slots,
553 int flags);
554 SCM_EXTERN void Scm_InitStaticClassWithMeta(ScmClass *klass,
555 const char *name,
556 ScmModule *mod,
557 ScmClass *meta,
558 ScmObj supers,
559 ScmClassStaticSlotSpec *slots,
560 int flags);
561
562 /* OBSOLETE */
563 SCM_EXTERN void Scm_InitBuiltinClass(ScmClass *c, const char *name,
564 ScmClassStaticSlotSpec *slots,
565 int withMeta,
566 ScmModule *m);
567
568 SCM_EXTERN ScmClass *Scm_ClassOf(ScmObj obj);
569 SCM_EXTERN int Scm_SubtypeP(ScmClass *sub, ScmClass *type);
570 SCM_EXTERN int Scm_TypeP(ScmObj obj, ScmClass *type);
571 SCM_EXTERN ScmClass *Scm_BaseClassOf(ScmClass *klass);
572
573 SCM_EXTERN ScmObj Scm_VMSlotRef(ScmObj obj, ScmObj slot, int boundp);
574 SCM_EXTERN ScmObj Scm_VMSlotSet(ScmObj obj, ScmObj slot, ScmObj value);
575 SCM_EXTERN ScmObj Scm_VMSlotBoundP(ScmObj obj, ScmObj slot);
576
577 /* built-in classes */
578 SCM_CLASS_DECL(Scm_TopClass);
579 SCM_CLASS_DECL(Scm_BoolClass);
580 SCM_CLASS_DECL(Scm_CharClass);
581 SCM_CLASS_DECL(Scm_ClassClass);
582 SCM_CLASS_DECL(Scm_EOFObjectClass);
583 SCM_CLASS_DECL(Scm_UndefinedObjectClass);
584 SCM_CLASS_DECL(Scm_UnknownClass);
585 SCM_CLASS_DECL(Scm_CollectionClass);
586 SCM_CLASS_DECL(Scm_SequenceClass);
587 SCM_CLASS_DECL(Scm_ObjectClass); /* base of Scheme-defined objects */
588 SCM_CLASS_DECL(Scm_ForeignPointerClass);
589
590
591 #define SCM_CLASS_TOP (&Scm_TopClass)
592 #define SCM_CLASS_BOOL (&Scm_BoolClass)
593 #define SCM_CLASS_CHAR (&Scm_CharClass)
594 #define SCM_CLASS_CLASS (&Scm_ClassClass)
595 #define SCM_CLASS_EOF_OBJECT (&Scm_EOFObjectClass)
596 #define SCM_CLASS_UNDEFINED_OBJECT (&Scm_UndefinedObjectClass)
597 #define SCM_CLASS_UNKNOWN (&Scm_UnknownClass)
598 #define SCM_CLASS_COLLECTION (&Scm_CollectionClass)
599 #define SCM_CLASS_SEQUENCE (&Scm_SequenceClass)
600 #define SCM_CLASS_OBJECT (&Scm_ObjectClass)
601 #define SCM_CLASS_FOREIGN_POINTER (&Scm_ForeignPointerClass)
602
603 SCM_EXTERN ScmClass *Scm_DefaultCPL[];
604 SCM_EXTERN ScmClass *Scm_CollectionCPL[];
605 SCM_EXTERN ScmClass *Scm_SequenceCPL[];
606 SCM_EXTERN ScmClass *Scm_ObjectCPL[];
607
608 #define SCM_CLASS_DEFAULT_CPL (Scm_DefaultCPL)
609 #define SCM_CLASS_COLLECTION_CPL (Scm_CollectionCPL)
610 #define SCM_CLASS_SEQUENCE_CPL (Scm_SequenceCPL)
611 #define SCM_CLASS_OBJECT_CPL (Scm_ObjectCPL)
612
613 /* Static definition of classes
614 * SCM_DEFINE_BUILTIN_CLASS
615 * SCM_DEFINE_BUILTIN_CLASS_SIMPLE
616 * SCM_DEFINE_ABSTRACT_CLASS
617 * SCM_DEFINE_BASE_CLASS
618 */
619
620 #define SCM__DEFINE_CLASS_COMMON(cname, coreSize, flag, printer, compare, serialize, allocate, cpa) \
621 ScmClass cname = { \
622 { SCM_CLASS2TAG(SCM_CLASS_CLASS), NULL },\
623 printer, \
624 compare, \
625 serialize, \
626 allocate, \
627 cpa, \
628 0, /*numInstanceSlots*/ \
629 coreSize, /*coreSize*/ \
630 flag, /*flags*/ \
631 SCM_FALSE,/*name*/ \
632 SCM_NIL, /*directSupers*/ \
633 SCM_NIL, /*cpl*/ \
634 SCM_NIL, /*accessors*/ \
635 SCM_NIL, /*directSlots*/ \
636 SCM_NIL, /*slots*/ \
637 SCM_NIL, /*directSubclasses*/ \
638 SCM_NIL, /*directMethods*/ \
639 SCM_NIL, /*initargs*/ \
640 SCM_NIL, /*modules*/ \
641 SCM_FALSE /*redefined*/ \
642 }
643
644 /* Define built-in class statically -- full-featured version */
645 #define SCM_DEFINE_BUILTIN_CLASS(cname, printer, compare, serialize, allocate, cpa) \
646 SCM__DEFINE_CLASS_COMMON(cname, 0, \
647 SCM_CLASS_BUILTIN, \
648 printer, compare, serialize, allocate, cpa)
649
650 /* Define built-in class statically -- simpler version */
651 #define SCM_DEFINE_BUILTIN_CLASS_SIMPLE(cname, printer) \
652 SCM_DEFINE_BUILTIN_CLASS(cname, printer, NULL, NULL, NULL, NULL)
653
654 /* define an abstract class */
655 #define SCM_DEFINE_ABSTRACT_CLASS(cname, cpa) \
656 SCM__DEFINE_CLASS_COMMON(cname, 0, \
657 SCM_CLASS_ABSTRACT, \
658 NULL, NULL, NULL, NULL, cpa)
659
660 /* define a class that can be subclassed by Scheme */
661 #define SCM_DEFINE_BASE_CLASS(cname, ctype, printer, compare, serialize, allocate, cpa) \
662 SCM__DEFINE_CLASS_COMMON(cname, sizeof(ctype), \
663 SCM_CLASS_BASE, \
664 printer, compare, serialize, allocate, cpa)
665
666 /*
667 * A simple class and instance API to wrap C pointer.
668 * This is for C programs that want to define a visible class from Scheme
669 * but don't want to go through full-fledged class mechanism.
670 */
671 typedef struct ScmForeignPointerRec {
672 SCM_HEADER;
673 void *ptr; /* foreign object. this pointer shouldn't
674 be modified once <foreign-pointer> is
675 constructed by Scm_MakeForeignPointer. */
676 ScmObj attributes; /* alist. useful to store e.g. callbacks.
677 use accessor procedures. */
678 } ScmForeignPointer;
679
680 #define SCM_FOREIGN_POINTER_P(obj) SCM_ISA(obj, SCM_CLASS_FOREIGN_POINTER)
681 #define SCM_FOREIGN_POINTER(obj) ((ScmForeignPointer*)(obj))
682 #define SCM_FOREIGN_POINTER_REF(type, obj) \
683 ((type)(SCM_FOREIGN_POINTER(obj)->ptr))
684
685 typedef void (*ScmForeignCleanupProc)(ScmObj);
686
687 SCM_EXTERN ScmClass *Scm_MakeForeignPointerClass(ScmModule *module,
688 const char *name,
689 ScmClassPrintProc print,
690 ScmForeignCleanupProc cleanup,
691 int flags);
692 SCM_EXTERN ScmObj Scm_MakeForeignPointer(ScmClass *klass, void *ptr);
693
694 /* foreign pointer flags */
695 enum {
696 SCM_FOREIGN_POINTER_KEEP_IDENTITY = (1L<<0),
697 /* If set, a foreign pointer class keeps a weak hash table that maps
698 PTR to the wrapping ScmObj, so Scm_MakeForeignPointer returns
699 eq? object if the same PTR is given. This incurs some overhead,
700 but cleanup procedure can safely free the foreign object without
701 worring if there's other ScmObj that's pointing to PTR.
702 Do not use this flag if PTR is also allocated by GC_malloc. The
703 used hash table is only weak for its value, so PTR wouldn't be
704 GCed. */
705 SCM_FOREIGN_POINTER_MAP_NULL = (1L<<1)
706 /* If set, Scm_MakeForeignPointer returns SCM_FALSE whenever the
707 given PTR is NULL. It is the only case that
708 Scm_MakeForeignPointer returns non-ForeignPointer object. */
709 };
710
711 /* foreign pointer attributes. you can attach info to each foreign pointer.
712 possible applications:
713 - Keep Scheme objects that are set in the foreign object, preventing
714 them from begin GCed.
715 - Keep mutex to use the foreign object from multiple threads */
716
717 SCM_EXTERN ScmObj Scm_ForeignPointerAttr(ScmForeignPointer *fp);
718 SCM_EXTERN ScmObj Scm_ForeignPointerAttrGet(ScmForeignPointer *fp,
719 ScmObj key, ScmObj fallback);
720 SCM_EXTERN ScmObj Scm_ForeignPointerAttrSet(ScmForeignPointer *fp,
721 ScmObj key, ScmObj value);
722
723 /*--------------------------------------------------------
724 * PAIR AND LIST
725 */
726
727 /* Ordinary pair uses two words. It can be distinguished from
728 * other heap allocated objects by checking the first word doesn't
729 * have "11" in the lower bits.
730 */
731 struct ScmPairRec {
732 ScmObj car; /* should be accessed via macros */
733 ScmObj cdr; /* ditto */
734 };
735
736 /* To keep extra information such as source-code info, some pairs
737 * actually have one extra word for attribute assoc-list. Checking
738 * whether a pair is an extended one or not isn't a very lightweight
739 * operation, so the use of extended pair should be kept minimal.
740 */
741 struct ScmExtendedPairRec {
742 ScmObj car; /* should be accessed via macros */
743 ScmObj cdr; /* ditto */
744 ScmObj attributes; /* should be accessed via API func. */
745 };
746
747 #define SCM_PAIRP(obj) (SCM_PTRP(obj)&&SCM_TAG(SCM_OBJ(obj)->tag)!=0x03)
748
749 #define SCM_PAIR(obj) ((ScmPair*)(obj))
750 #define SCM_CAR(obj) (SCM_PAIR(obj)->car)
751 #define SCM_CDR(obj) (SCM_PAIR(obj)->cdr)
752 #define SCM_CAAR(obj) (SCM_CAR(SCM_CAR(obj)))
753 #define SCM_CADR(obj) (SCM_CAR(SCM_CDR(obj)))
754 #define SCM_CDAR(obj) (SCM_CDR(SCM_CAR(obj)))
755 #define SCM_CDDR(obj) (SCM_CDR(SCM_CDR(obj)))
756
757 #define SCM_SET_CAR(obj, value) (SCM_CAR(obj) = (value))
758 #define SCM_SET_CDR(obj, value) (SCM_CDR(obj) = (value))
759
760 #define SCM_EXTENDED_PAIR_P(obj) \
761 (SCM_PAIRP(obj)&&GC_base(obj)&&GC_size(obj)>=sizeof(ScmExtendedPair))
762 #define SCM_EXTENDED_PAIR(obj) ((ScmExtendedPair*)(obj))
763
764
765 SCM_CLASS_DECL(Scm_ListClass);
766 SCM_CLASS_DECL(Scm_PairClass);
767 SCM_CLASS_DECL(Scm_NullClass);
768 #define SCM_CLASS_LIST (&Scm_ListClass)
769 #define SCM_CLASS_PAIR (&Scm_PairClass)
770 #define SCM_CLASS_NULL (&Scm_NullClass)
771
772 #define SCM_LISTP(obj) (SCM_NULLP(obj) || SCM_PAIRP(obj))
773
774 /* Useful macros to manipulate lists. */
775
776 #define SCM_FOR_EACH(p, list) \
777 for((p) = (list); SCM_PAIRP(p); (p) = SCM_CDR(p))
778
779 #define SCM_APPEND1(start, last, obj) \
780 do { \
781 if (SCM_NULLP(start)) { \
782 (start) = (last) = Scm_Cons((obj), SCM_NIL); \
783 } else { \
784 SCM_SET_CDR((last), Scm_Cons((obj), SCM_NIL)); \
785 (last) = SCM_CDR(last); \
786 } \
787 } while (0)
788
789 #define SCM_APPEND(start, last, obj) \
790 do { \
791 ScmObj list_SCM_GLS = (obj); \
792 if (SCM_NULLP(start)) { \
793 (start) = (list_SCM_GLS); \
794 if (!SCM_NULLP(list_SCM_GLS)) { \
795 (last) = Scm_LastPair(list_SCM_GLS); \
796 } \
797 } else { \
798 SCM_SET_CDR((last), (list_SCM_GLS)); \
799 (last) = Scm_LastPair(last); \
800 } \
801 } while (0)
802
803 #define SCM_LIST1(a) Scm_Cons(a, SCM_NIL)
804 #define SCM_LIST2(a,b) Scm_Cons(a, SCM_LIST1(b))
805 #define SCM_LIST3(a,b,c) Scm_Cons(a, SCM_LIST2(b, c))
806 #define SCM_LIST4(a,b,c,d) Scm_Cons(a, SCM_LIST3(b, c, d))
807 #define SCM_LIST5(a,b,c,d,e) Scm_Cons(a, SCM_LIST4(b, c, d, e))
808
809 /* special return value of Scm_Length */
810 enum {
811 SCM_LIST_DOTTED = -1, /* dotted list */
812 SCM_LIST_CIRCULAR = -2 /* circular list */
813 };
814
815 #define SCM_PROPER_LIST_P(obj) (Scm_Length(obj) >= 0)
816 #define SCM_DOTTED_LIST_P(obj) (Scm_Length(obj) == SCM_LIST_DOTTED)
817 #define SCM_CIRCULAR_LIST_P(obj) (Scm_Length(obj) == SCM_LIST_CIRCULAR)
818
819 SCM_EXTERN ScmObj Scm_Cons(ScmObj car, ScmObj cdr);
820 SCM_EXTERN ScmObj Scm_Acons(ScmObj caar, ScmObj cdar, ScmObj cdr);
821 SCM_EXTERN ScmObj Scm_List(ScmObj elt, ...);
822 SCM_EXTERN ScmObj Scm_Conses(ScmObj elt, ...);
823 SCM_EXTERN ScmObj Scm_VaList(va_list elts);
824 SCM_EXTERN ScmObj Scm_VaCons(va_list elts);
825 SCM_EXTERN ScmObj Scm_ArrayToList(ScmObj *elts, int nelts);
826 SCM_EXTERN ScmObj *Scm_ListToArray(ScmObj list, int *nelts, ScmObj *store,
827 int alloc);
828
829 SCM_EXTERN ScmObj Scm_Car(ScmObj obj);
830 SCM_EXTERN ScmObj Scm_Cdr(ScmObj obj);
831 SCM_EXTERN ScmObj Scm_Caar(ScmObj obj);
832 SCM_EXTERN ScmObj Scm_Cadr(ScmObj obj);
833 SCM_EXTERN ScmObj Scm_Cdar(ScmObj obj);
834 SCM_EXTERN ScmObj Scm_Cddr(ScmObj obj);
835
836 SCM_EXTERN int Scm_Length(ScmObj obj);
837 SCM_EXTERN ScmObj Scm_CopyList(ScmObj list);
838 SCM_EXTERN ScmObj Scm_MakeList(int len, ScmObj fill);
839 SCM_EXTERN ScmObj Scm_Append2X(ScmObj list, ScmObj obj);
840 SCM_EXTERN ScmObj Scm_Append2(ScmObj list, ScmObj obj);
841 SCM_EXTERN ScmObj Scm_Append(ScmObj args);
842 SCM_EXTERN ScmObj Scm_ReverseX(ScmObj list);
843 SCM_EXTERN ScmObj Scm_Reverse(ScmObj list);
844 SCM_EXTERN ScmObj Scm_ListTail(ScmObj list, int i, ScmObj fallback);
845 SCM_EXTERN ScmObj Scm_ListRef(ScmObj list, int i, ScmObj fallback);
846 SCM_EXTERN ScmObj Scm_LastPair(ScmObj list);
847
848 SCM_EXTERN ScmObj Scm_Memq(ScmObj obj, ScmObj list);
849 SCM_EXTERN ScmObj Scm_Memv(ScmObj obj, ScmObj list);
850 SCM_EXTERN ScmObj Scm_Member(ScmObj obj, ScmObj list, int cmpmode);
851 SCM_EXTERN ScmObj Scm_Assq(ScmObj obj, ScmObj alist);
852 SCM_EXTERN ScmObj Scm_Assv(ScmObj obj, ScmObj alist);
853 SCM_EXTERN ScmObj Scm_Assoc(ScmObj obj, ScmObj alist, int cmpmode);
854
855 SCM_EXTERN ScmObj Scm_Delete(ScmObj obj, ScmObj list, int cmpmode);
856 SCM_EXTERN ScmObj Scm_DeleteX(ScmObj obj, ScmObj list, int cmpmode);
857 SCM_EXTERN ScmObj Scm_AssocDelete(ScmObj elt, ScmObj alist, int cmpmode);
858 SCM_EXTERN ScmObj Scm_AssocDeleteX(ScmObj elt, ScmObj alist, int cmpmode);
859
860 SCM_EXTERN ScmObj Scm_DeleteDuplicates(ScmObj list, int cmpmode);
861 SCM_EXTERN ScmObj Scm_DeleteDuplicatesX(ScmObj list, int cmpmode);
862
863 SCM_EXTERN ScmObj Scm_MonotonicMerge(ScmObj start, ScmObj sequences);
864 SCM_EXTERN ScmObj Scm_Union(ScmObj list1, ScmObj list2);
865 SCM_EXTERN ScmObj Scm_Intersection(ScmObj list1, ScmObj list2);
866
867 SCM_EXTERN ScmObj Scm_ExtendedCons(ScmObj car, ScmObj cdr);
868 SCM_EXTERN ScmObj Scm_PairAttr(ScmPair *pair);
869 SCM_EXTERN ScmObj Scm_PairAttrGet(ScmPair *pair, ScmObj key, ScmObj fallback);
870 SCM_EXTERN ScmObj Scm_PairAttrSet(ScmPair *pair, ScmObj key, ScmObj value);
871
872 /*--------------------------------------------------------
873 * CHAR and CHAR-SET
874 */
875
876 SCM_EXTERN ScmChar Scm_ReadXdigitsFromString(const char *, int, const char **);
877 SCM_EXTERN ScmChar Scm_ReadXdigitsFromPort(ScmPort *port, int ndigits,
878 char *buf, int *nread);
879
880 #define SCM_CHARSET_MASK_CHARS 128
881 #define SCM_CHARSET_MASK_SIZE (SCM_CHARSET_MASK_CHARS/(SIZEOF_LONG*8))
882
883 struct ScmCharSetRec {
884 SCM_HEADER;
885 unsigned long mask[SCM_CHARSET_MASK_SIZE];
886 struct ScmCharSetRange {
887 struct ScmCharSetRange *next;
888 ScmChar lo; /* lower boundary of range (inclusive) */
889 ScmChar hi; /* higher boundary of range (inclusive) */
890 } *ranges;
891 };
892
893 SCM_CLASS_DECL(Scm_CharSetClass);
894 #define SCM_CLASS_CHARSET (&Scm_CharSetClass)
895 #define SCM_CHARSET(obj) ((ScmCharSet*)obj)
896 #define SCM_CHARSETP(obj) SCM_XTYPEP(obj, SCM_CLASS_CHARSET)
897
898 #define SCM_CHARSET_SMALLP(obj) (SCM_CHARSET(obj)->ranges == NULL)
899
900 SCM_EXTERN ScmObj Scm_MakeEmptyCharSet(void);
901 SCM_EXTERN ScmObj Scm_CopyCharSet(ScmCharSet *src);
902 SCM_EXTERN int Scm_CharSetEq(ScmCharSet *x, ScmCharSet *y);
903 SCM_EXTERN int Scm_CharSetLE(ScmCharSet *x, ScmCharSet *y);
904 SCM_EXTERN ScmObj Scm_CharSetAddRange(ScmCharSet *cs,
905 ScmChar from, ScmChar to);
906 SCM_EXTERN ScmObj Scm_CharSetAdd(ScmCharSet *dest, ScmCharSet *src);
907 SCM_EXTERN ScmObj Scm_CharSetComplement(ScmCharSet *cs);
908 SCM_EXTERN ScmObj Scm_CharSetCaseFold(ScmCharSet *cs);
909 SCM_EXTERN ScmObj Scm_CharSetRanges(ScmCharSet *cs);
910 SCM_EXTERN ScmObj Scm_CharSetRead(ScmPort *input, int *complement_p,
911 int error_p, int bracket_syntax);
912
913 SCM_EXTERN int Scm_CharSetContains(ScmCharSet *cs, ScmChar c);
914
915 /* predefined character set API */
916 enum {
917 SCM_CHARSET_ALNUM,
918 SCM_CHARSET_ALPHA,
919 SCM_CHARSET_BLANK,
920 SCM_CHARSET_CNTRL,
921 SCM_CHARSET_DIGIT,
922 SCM_CHARSET_GRAPH,
923 SCM_CHARSET_LOWER,
924 SCM_CHARSET_PRINT,
925 SCM_CHARSET_PUNCT,
926 SCM_CHARSET_SPACE,
927 SCM_CHARSET_UPPER,
928 SCM_CHARSET_XDIGIT,
929 SCM_CHARSET_WORD, /* internal use: word constituent char. */
930 SCM_CHARSET_NUM_PREDEFINED_SETS
931 };
932 SCM_EXTERN ScmObj Scm_GetStandardCharSet(int id);
933
934 /*--------------------------------------------------------
935 * STRING
936 */
937
938 /* [String mutation and MT safety]
939 * Scheme String is mutable (unfortunately). The fields of a string
940 * may be altered by another thread while you're reading it. For MT
941 * safety, it is important that we ensure the atomicity in retrieving
942 * string length/size and content.
943 *
944 * It isn't practical to use mutex for every string access, so we use
945 * atomicity of pointer dereference and assignments. The actual string
946 * fields are stored in immutable structure, ScmStringBody, and a Scheme
947 * string, ScmString, has a pointer to it. When mutation occurs, a new
948 * ScmStringBody is allocated, and the pointer is altered. So, as far
949 * as the client retrieves ScmStringBody first, then use its field values,
950 * the client won't see inconsistent state.
951 * Alternatively, the client can use Scm_GetStringContent(), which
952 * retrieves length, size and char array atomically.
953 *
954 * We further use an assumption that mutation of strings is rare.
955 * So ScmString is allocated with initial body. The 'body' pointer
956 * of ScmString is NULL when it is created, which indicates the initial
957 * body is used (this convention allows static definition of ScmString).
958 * Once the string is mutated, a new the 'body' pointer points to a
959 * fresh ScmStringBody. Note that it means the initial content of the
960 * string, pointed by initialBody.start, won't be GC-ed as far as the
961 * ScmString is alive, even if its content is mutated and the initial
962 * content isn't used.
963 */
964
965 typedef struct ScmStringBodyRec {
966 unsigned int flags;
967 unsigned int length;
968 unsigned int size;
969 const char *start;
970 } ScmStringBody;
971
972 struct ScmStringRec {
973 SCM_HEADER;
974 const ScmStringBody *body; /* may be NULL if we use initial body. */
975 ScmStringBody initialBody; /* initial body */
976 };
977
978 /* The flag value. Runtime strings can have flag bits reserved by
979 SCM_STRING_FLAG_MASK. (The rest of the bits are used in Scm_MakeString */
980 enum {
981 SCM_STRING_IMMUTABLE = (1L<<0),
982 SCM_STRING_INCOMPLETE = (1L<<1)
983 };
984 #define SCM_STRING_FLAG_MASK (0xffff)
985
986 #define SCM_STRINGP(obj) SCM_XTYPEP(obj, SCM_CLASS_STRING)
987 #define SCM_STRING(obj) ((ScmString*)(obj))
988 #define SCM_STRING_BODY(obj) \
989 ((const ScmStringBody*)(SCM_STRING(obj)->body?SCM_STRING(obj)->body:&SCM_STRING(obj)->initialBody))
990
991 /* Accessor macros for string body */
992 #define SCM_STRING_BODY_LENGTH(body) ((body)->length)
993 #define SCM_STRING_BODY_SIZE(body) ((body)->size)
994 #define SCM_STRING_BODY_START(body) ((body)->start)
995 #define SCM_STRING_BODY_FLAGS(body) ((body)->flags)
996
997 #define SCM_STRING_BODY_HAS_FLAG(body, flag) \
998 (SCM_STRING_BODY_FLAGS(body)&(flag))
999 #define SCM_STRING_BODY_INCOMPLETE_P(body) \
1000 SCM_STRING_BODY_HAS_FLAG(body, SCM_STRING_INCOMPLETE)
1001 #define SCM_STRING_BODY_IMMUTABLE_P(body) \
1002 SCM_STRING_BODY_HAS_FLAG(body, SCM_STRING_IMMUTABLE)
1003 #define SCM_STRING_BODY_SINGLE_BYTE_P(body) \
1004 (SCM_STRING_BODY_SIZE(body)==SCM_STRING_BODY_LENGTH(body))
1005
1006 /* This is MT-safe, for string immutability won't change */
1007 #define SCM_STRING_IMMUTABLE_P(obj) \
1008 SCM_STRING_BODY_IMMUTABLE_P(SCM_STRING_BODY(obj))
1009
1010 #define SCM_STRING_NULL_P(obj) \
1011 (SCM_STRING_BODY_SIZE(SCM_STRING_BODY(obj)) == 0)
1012
1013 /* Macros for backward compatibility. Use of these are deprecated,
1014 since they are not MT-safe. Use SCM_STRING_BODY_* macros or
1015 Scm_GetString* API. */
1016 #define SCM_STRING_LENGTH(obj) (SCM_STRING_BODY(obj)->length)
1017 #define SCM_STRING_SIZE(obj) (SCM_STRING_BODY(obj)->size)
1018 #define SCM_STRING_START(obj) (SCM_STRING_BODY(obj)->start)
1019 #define SCM_STRING_INCOMPLETE_P(obj) \
1020 (SCM_STRING_BODY_INCOMPLETE_P(SCM_STRING_BODY(obj)))
1021 #define SCM_STRING_SINGLE_BYTE_P(obj) \
1022 (SCM_STRING_SIZE(obj)==SCM_STRING_LENGTH(obj))
1023
1024
1025 /* Constructor flags */
1026 #define SCM_MAKSTR_INCOMPLETE SCM_STRING_INCOMPLETE
1027 #define SCM_MAKSTR_IMMUTABLE SCM_STRING_IMMUTABLE
1028 #define SCM_MAKSTR_COPYING (1L<<16) /* FIXME */
1029
1030 #define SCM_MAKE_STR(cstr) \
1031 Scm_MakeString(cstr, -1, -1, 0)
1032 #define SCM_MAKE_STR_COPYING(cstr) \
1033 Scm_MakeString(cstr, -1, -1, SCM_MAKSTR_COPYING)
1034 #define SCM_MAKE_STR_IMMUTABLE(cstr) \
1035 Scm_MakeString(cstr, -1, -1, SCM_MAKSTR_IMMUTABLE)
1036
1037 #define SCM_STRING_CONST_CSTRING(obj) Scm_GetStringConst(SCM_STRING(obj))
1038
1039 SCM_CLASS_DECL(Scm_StringClass);
1040 #define SCM_CLASS_STRING (&Scm_StringClass)
1041
1042 /* grammer spec for StringJoin (see SRFI-13) */
1043 enum {
1044 SCM_STRING_JOIN_INFIX,
1045 SCM_STRING_JOIN_STRICT_INFIX,
1046 SCM_STRING_JOIN_SUFFIX,
1047 SCM_STRING_JOIN_PREFIX
1048 };
1049
1050 SCM_EXTERN int Scm_MBLen(const char *str, const char *stop);
1051
1052 SCM_EXTERN ScmObj Scm_MakeString(const char *str, int size, int len,
1053 int flags);
1054 SCM_EXTERN ScmObj Scm_MakeFillString(int len, ScmChar fill);
1055 SCM_EXTERN ScmObj Scm_CopyStringWithFlags(ScmString *str, int flags, int mask);
1056 #define Scm_CopyString(str) \
1057 Scm_CopyStringWithFlags(str, 0, SCM_STRING_IMMUTABLE)
1058
1059 SCM_EXTERN char* Scm_GetString(ScmString *str);
1060 SCM_EXTERN const char* Scm_GetStringConst(ScmString *str);
1061 SCM_EXTERN const char* Scm_GetStringContent(ScmString *str,
1062 unsigned int *psize,
1063 unsigned int *plen,
1064 unsigned int *pflags);
1065
1066 SCM_EXTERN ScmObj Scm_StringCompleteToIncompleteX(ScmString *str);
1067 SCM_EXTERN ScmObj Scm_StringIncompleteToCompleteX(ScmString *str);
1068 SCM_EXTERN ScmObj Scm_StringCompleteToIncomplete(ScmString *str);
1069 SCM_EXTERN ScmObj Scm_StringIncompleteToComplete(ScmString *str);
1070
1071 SCM_EXTERN int Scm_StringEqual(ScmString *x, ScmString *y);
1072 SCM_EXTERN int Scm_StringCmp(ScmString *x, ScmString *y);
1073 SCM_EXTERN int Scm_StringCiCmp(ScmString *x, ScmString *y);
1074
1075 SCM_EXTERN const char *Scm_StringPosition(ScmString *str, int k);
1076 SCM_EXTERN ScmChar Scm_StringRef(ScmString *str, int k, int range_error);
1077 SCM_EXTERN ScmObj Scm_StringSet(ScmString *str, int k, ScmChar sc);
1078 SCM_EXTERN int Scm_StringByteRef(ScmString *str, int k, int range_error);
1079 SCM_EXTERN ScmObj Scm_StringByteSet(ScmString *str, int k, ScmByte b);
1080 SCM_EXTERN ScmObj Scm_StringSubstitute(ScmString *target, int start,
1081 ScmString *str);
1082
1083 SCM_EXTERN ScmObj Scm_Substring(ScmString *x, int start, int end);
1084 SCM_EXTERN ScmObj Scm_MaybeSubstring(ScmString *x, ScmObj start, ScmObj end);
1085 SCM_EXTERN ScmObj Scm_StringTake(ScmString *x, int nchars, int takefirst,
1086 int fromright);
1087
1088 SCM_EXTERN ScmObj Scm_StringAppend2(ScmString *x, ScmString *y);
1089 SCM_EXTERN ScmObj Scm_StringAppendC(ScmString *x, const char *s, int size,
1090 int len);
1091 SCM_EXTERN ScmObj Scm_StringAppend(ScmObj strs);
1092 SCM_EXTERN ScmObj Scm_StringJoin(ScmObj strs, ScmString *delim, int grammer);
1093
1094 SCM_EXTERN ScmObj Scm_StringSplitByChar(ScmString *str, ScmChar ch);
1095 SCM_EXTERN ScmObj Scm_StringScan(ScmString *s1, ScmString *s2, int retmode);
1096 SCM_EXTERN ScmObj Scm_StringScanChar(ScmString *s1, ScmChar ch, int retmode);
1097
1098 /* "retmode" argument for string scan */
1099 enum {
1100 SCM_STRING_SCAN_INDEX, /* return index */
1101 SCM_STRING_SCAN_BEFORE, /* return substring of s1 before s2 */
1102 SCM_STRING_SCAN_AFTER, /* return substring of s1 after s2 */
1103 SCM_STRING_SCAN_BEFORE2, /* return substr of s1 before s2 and rest */
1104 SCM_STRING_SCAN_AFTER2, /* return substr of s1 up to s2 and rest */
1105 SCM_STRING_SCAN_BOTH /* return substr of s1 before and after s2 */
1106 };
1107
1108 SCM_EXTERN ScmObj Scm_StringToList(ScmString *str);
1109 SCM_EXTERN ScmObj Scm_ListToString(ScmObj chars);
1110 SCM_EXTERN ScmObj Scm_StringFill(ScmString *str, ScmChar c,
1111 ScmObj maybeStart, ScmObj maybeEnd);
1112
1113 SCM_EXTERN ScmObj Scm_ConstCStringArrayToList(const char **array, int size);
1114 SCM_EXTERN ScmObj Scm_CStringArrayToList(char **array, int size);
1115
1116 /* You can allocate a constant string statically, if you calculate
1117 the length by yourself. These macros are mainly used in machine-
1118 generated code.
1119 SCM_DEFINE_STRING_CONST can be used to define a static string,
1120 and SCM_STRING_CONST_INITIALIZER can be used inside static array
1121 of strings. */
1122
1123 #define SCM_STRING_CONST_INITIALIZER(str, len, siz) \
1124 { { SCM_CLASS2TAG(SCM_CLASS_STRING) }, NULL, \
1125 { SCM_STRING_IMMUTABLE, (len), (siz), (str) } }
1126
1127 #define SCM_DEFINE_STRING_CONST(name, str, len, siz) \
1128 ScmString name = SCM_STRING_CONST_INITIALIZER(str, len, siz)
1129
1130 /* Auxiliary structure to construct a string of unknown length.
1131 This is not an ScmObj. See string.c for details. */
1132 #define SCM_DSTRING_INIT_CHUNK_SIZE 32
1133
1134 typedef struct ScmDStringChunkRec {
1135 int bytes; /* actual bytes stored in this chunk.
1136 Note that this is set when the next
1137 chunk is allocated. */
1138 char data[SCM_DSTRING_INIT_CHUNK_SIZE]; /* variable length, indeed. */
1139 } ScmDStringChunk;
1140
1141 typedef struct ScmDStringChainRec {
1142 struct ScmDStringChainRec *next;
1143 ScmDStringChunk *chunk;
1144 } ScmDStringChain;
1145
1146 struct ScmDStringRec {
1147 ScmDStringChunk init; /* initial chunk */
1148 ScmDStringChain *anchor; /* chain of extra chunks */
1149 ScmDStringChain *tail; /* current chunk */
1150 char *current; /* current ptr */
1151 char *end; /* end of current chunk */
1152 int lastChunkSize; /* size of the last chunk */
1153 int length; /* # of chars written */
1154 };
1155
1156 SCM_EXTERN void Scm_DStringInit(ScmDString *dstr);
1157 SCM_EXTERN int Scm_DStringSize(ScmDString *dstr);
1158 SCM_EXTERN ScmObj Scm_DStringGet(ScmDString *dstr, int flags);
1159 SCM_EXTERN const char *Scm_DStringGetz(ScmDString *dstr);
1160 SCM_EXTERN void Scm_DStringPutz(ScmDString *dstr, const char *str,
1161 int siz);
1162 SCM_EXTERN void Scm_DStringAdd(ScmDString *dstr, ScmString *str);
1163 SCM_EXTERN void Scm_DStringPutb(ScmDString *dstr, char byte);
1164 SCM_EXTERN void Scm_DStringPutc(ScmDString *dstr, ScmChar ch);
1165
1166 #define SCM_DSTRING_SIZE(dstr) Scm_DStringSize(dstr);
1167
1168 #define SCM_DSTRING_PUTB(dstr, byte) \
1169 do { \
1170 if ((dstr)->current >= (dstr)->end) Scm__DStringRealloc(dstr, 1);\
1171 *(dstr)->current++ = (char)(byte); \
1172 (dstr)->length = -1; /* may be incomplete */ \
1173 } while (0)
1174
1175 #define SCM_DSTRING_PUTC(dstr, ch) \
1176 do { \
1177 ScmChar ch_DSTR = (ch); \
1178 ScmDString *d_DSTR = (dstr); \
1179 int siz_DSTR = SCM_CHAR_NBYTES(ch_DSTR); \
1180 if (d_DSTR->current + siz_DSTR > d_DSTR->end) \
1181 Scm__DStringRealloc(d_DSTR, siz_DSTR); \
1182 SCM_CHAR_PUT(d_DSTR->current, ch_DSTR); \
1183 d_DSTR->current += siz_DSTR; \
1184 if (d_DSTR->length >= 0) d_DSTR->length++; \
1185 } while (0)
1186
1187 SCM_EXTERN void Scm__DStringRealloc(ScmDString *dstr, int min_incr);
1188
1189 /* Efficient way to access string from Scheme */
1190 typedef struct ScmStringPointerRec {
1191 SCM_HEADER;
1192 int length;
1193 int size;
1194 const char *start;
1195 int index;
1196 const char *current;
1197 } ScmStringPointer;
1198
1199 SCM_CLASS_DECL(Scm_StringPointerClass);
1200 #define SCM_CLASS_STRING_POINTER (&Scm_StringPointerClass)
1201 #define SCM_STRING_POINTERP(obj) SCM_XTYPEP(obj, SCM_CLASS_STRING_POINTER)
1202 #define SCM_STRING_POINTER(obj) ((ScmStringPointer*)obj)
1203
1204 SCM_EXTERN ScmObj Scm_MakeStringPointer(ScmString *src, int index,
1205 int start, int end);
1206 SCM_EXTERN ScmObj Scm_StringPointerRef(ScmStringPointer *sp);
1207 SCM_EXTERN ScmObj Scm_StringPointerNext(ScmStringPointer *sp);
1208 SCM_EXTERN ScmObj Scm_StringPointerPrev(ScmStringPointer *sp);
1209 SCM_EXTERN ScmObj Scm_StringPointerSet(ScmStringPointer *sp, int index);
1210 SCM_EXTERN ScmObj Scm_StringPointerSubstring(ScmStringPointer *sp, int beforep);
1211 SCM_EXTERN ScmObj Scm_StringPointerCopy(ScmStringPointer *sp);
1212
1213 #ifdef SCM_DEBUG_HELPER
1214 SCM_EXTERN void Scm_StringPointerDump(ScmStringPointer *sp);
1215 #endif
1216
1217 /*--------------------------------------------------------
1218 * VECTOR
1219 */
1220
1221 struct ScmVectorRec {
1222 SCM_HEADER;
1223 int size;
1224 ScmObj elements[1];
1225 };
1226
1227 #define SCM_VECTOR(obj) ((ScmVector*)(obj))
1228 #define SCM_VECTORP(obj) SCM_XTYPEP(obj, SCM_CLASS_VECTOR)
1229 #define SCM_VECTOR_SIZE(obj) (SCM_VECTOR(obj)->size)
1230 #define SCM_VECTOR_ELEMENTS(obj) (SCM_VECTOR(obj)->elements)
1231 #define SCM_VECTOR_ELEMENT(obj, i) (SCM_VECTOR(obj)->elements[i])
1232
1233 SCM_CLASS_DECL(Scm_VectorClass);
1234 #define SCM_CLASS_VECTOR (&Scm_VectorClass)
1235
1236 /* Utility to check start/end range in string and vector operation */
1237 #define SCM_CHECK_START_END(start, end, len) \
1238 do { \
1239 if ((start) < 0 || (start) > (len)) { \
1240 Scm_Error("start argument out of range: %d\n", (start)); \
1241 } \
1242 if ((end) < 0) (end) = (len); \
1243 else if ((end) > (len)) { \
1244 Scm_Error("end argument out of range: %d\n", (end)); \
1245 } else if ((end) < (start)) { \
1246 Scm_Error("end argument (%d) must be greater than or " \
1247 "equal to the start argument (%d)", \
1248 (end), (start)); \
1249 } \
1250 } while (0)
1251
1252 SCM_EXTERN ScmObj Scm_MakeVector(int size, ScmObj fill);
1253 SCM_EXTERN ScmObj Scm_VectorRef(ScmVector *vec, int i, ScmObj fallback);
1254 SCM_EXTERN ScmObj Scm_VectorSet(ScmVector *vec, int i, ScmObj obj);
1255 SCM_EXTERN ScmObj Scm_VectorFill(ScmVector *vec, ScmObj fill, int start, int end);
1256
1257 SCM_EXTERN ScmObj Scm_ListToVector(ScmObj l, int start, int end);
1258 SCM_EXTERN ScmObj Scm_VectorToList(ScmVector *v, int start, int end);
1259 SCM_EXTERN ScmObj Scm_VectorCopy(ScmVector *vec, int start, int end,
1260 ScmObj fill);
1261
1262 #define SCM_VECTOR_FOR_EACH(cnt, obj, vec) \
1263 for (cnt = 0, obj = SCM_VECTOR_ELEMENT(vec, 0); \
1264 cnt < SCM_VECTOR_SIZE(vec); \
1265 obj = SCM_VECTOR_ELEMENT(vec, ++cnt))
1266
1267 /*--------------------------------------------------------
1268 * PORT
1269 */
1270
1271 /* Port is the Scheme way of I/O abstraction. R5RS's definition of
1272 * of the port is very simple and straightforward. Practical
1273 * applications, however, require far more detailed control over
1274 * the I/O channel, as well as the reasonable performance.
1275 *
1276 * Current implementation is a bit messy, trying to achieve both
1277 * performance and feature requirements. In the core API level,
1278 * ports are categorized in one of three types: file ports, string
1279 * ports and procedural ports. A port may be an input port or
1280 * an output port. A port may handle byte (binary) streams, as
1281 * well as character streams. Some port may interchange byte (binary)
1282 * I/O versus character I/O, while some may signal an error if you
1283 * mix those operations.
1284 *
1285 * You shouldn't rely on the underlying port implementation, for
1286 * it is likely to be changed in future. There are enough macros
1287 * and API functions provided to use and extend the port mechanism.
1288 * See also ext/vport for the way to extend the port from Scheme.
1289 */
1290
1291 /* Substructures */
1292
1293 /* The alternative of FILE* structure, used by buffered (file) port.
1294 The members are owned by the port, and client shouldn't change the
1295 elements. You can create your own custom buffered port by using
1296 Scm_MakeBufferedPort() --- with it, you pass ScmPortBuffer with
1297 the function pointers filled in, which is copied to the port's
1298 internal ScmPortBuffer structure.
1299 See port.c for the details of function pointers. */
1300
1301 typedef struct ScmPortBufferRec {
1302 char *buffer; /* ptr to the buffer area */
1303 char *current; /* current buffer position */
1304 char *end; /* the end of the current valid data */
1305 int size; /* buffer size */
1306 int mode; /* buffering mode (ScmPortBufferMode) */
1307 int (*filler)(ScmPort *p, int min);
1308 int (*flusher)(ScmPort *p, int cnt, int forcep);
1309 void (*closer)(ScmPort *p);
1310 int (*ready)(ScmPort *p);
1311 int (*filenum)(ScmPort *p);
1312 off_t (*seeker)(ScmPort *p, off_t offset, int whence);
1313 void *data;
1314 } ScmPortBuffer;
1315
1316 /* For input buffered port, returns the size of room that can be filled
1317 by the filler */
1318 #define SCM_PORT_BUFFER_ROOM(p) \
1319 (int)((p)->src.buf.buffer+(p)->src.buf.size-(p)->src.buf.end)
1320
1321 /* For output buffered port, returns the size of available data that can
1322 be flushed by the flusher */
1323 #define SCM_PORT_BUFFER_AVAIL(p) \
1324 (int)((p)->src.buf.current-(p)->src.buf.buffer)
1325
1326 /* The funtion table of procedural port. */
1327
1328 typedef struct ScmPortVTableRec {
1329 int (*Getb)(ScmPort *p);
1330 int (*Getc)(ScmPort *p);
1331 int (*Getz)(char *buf, int buflen, ScmPort *p);
1332 int (*Ready)(ScmPort *p, int charp);
1333 void (*Putb)(ScmByte b, ScmPort *p);
1334 void (*Putc)(ScmChar c, ScmPort *p);
1335 void (*Putz)(const char *buf, int size, ScmPort *p);
1336 void (*Puts)(ScmString *s, ScmPort *p);
1337 void (*Flush)(ScmPort *p);
1338 void (*Close)(ScmPort *p);
1339 off_t (*Seek)(ScmPort *p, off_t off, int whence);
1340 void *data;
1341 } ScmPortVTable;
1342
1343 /* The main port structure.
1344 * Regardless of the port type, the port structure caches at most
1345 * one character, in order to realize `peek-char' (Scheme) or `Ungetc' (C)
1346 * operation. 'scratch', 'scrcnt', and 'ungotten' fields are used for
1347 * that purpose, and outside routine shouldn't touch these fields.
1348 * See portapi.c for the detailed semantics.
1349 */
1350
1351 struct ScmPortRec {
1352 SCM_INSTANCE_HEADER;
1353 unsigned int direction : 2; /* SCM_PORT_INPUT or SCM_PORT_OUTPUT.
1354 There may be I/O port in future. */
1355 unsigned int type : 2; /* SCM_PORT_{FILE|ISTR|OSTR|PROC} */
1356 unsigned int scrcnt : 3; /* # of bytes in the scratch buffer */
1357
1358 unsigned int ownerp : 1; /* TRUE if this port owns underlying
1359 file pointer */
1360 unsigned int closed : 1; /* TRUE if this port is closed */
1361 unsigned int error : 1; /* Error has been occurred */
1362
1363 unsigned int flags : 5; /* see ScmPortFlags below */
1364
1365 char scratch[SCM_CHAR_MAX_BYTES]; /* incomplete buffer */
1366
1367 ScmChar ungotten; /* ungotten character.
1368 SCM_CHAR_INVALID if empty. */
1369 ScmObj name; /* port's name. Can be any Scheme object. */
1370
1371 ScmInternalMutex mutex; /* for port mutex */
1372 ScmInternalCond cv; /* for port mutex */
1373 ScmVM *lockOwner; /* for port mutex; owner of the lock */
1374 int lockCount; /* for port mutex; # of recursive locks */
1375
1376 ScmObj data; /* used internally */
1377
1378 unsigned int line; /* line counter */
1379
1380 union {
1381 ScmPortBuffer buf; /* buffered port */
1382 struct {
1383 const char *start;
1384 const char *current;
1385 const char *end;
1386 } istr; /* input string port */
1387 ScmDString ostr; /* output string port */
1388 ScmPortVTable vt; /* virtual port */
1389 } src;
1390 };
1391
1392 /* Port direction. Bidirectional port is not supported yet. */
1393 enum ScmPortDirection {
1394 SCM_PORT_INPUT = 1,
1395 SCM_PORT_OUTPUT = 2
1396 };
1397
1398 /* Port types. The type is also represented by a port's class, but
1399 C routine can dispatch quicker using these flags. */
1400 enum ScmPortType {
1401 SCM_PORT_FILE, /* file (buffered) port */
1402 SCM_PORT_ISTR, /* input string port */
1403 SCM_PORT_OSTR, /* output string port */
1404 SCM_PORT_PROC /* virtual port */
1405 };
1406
1407 /* Port buffering mode */
1408 enum ScmPortBufferMode {
1409 SCM_PORT_BUFFER_FULL, /* full buffering */
1410 SCM_PORT_BUFFER_LINE, /* flush the buffer for each line */
1411 SCM_PORT_BUFFER_NONE /* flush the buffer for every output */
1412 };
1413
1414 /* Return value from Scm_FdReady */
1415 enum ScmFdReadyResult {
1416 SCM_FD_WOULDBLOCK,
1417 SCM_FD_READY,
1418 SCM_FD_UNKNOWN
1419 };
1420
1421 /* Other flags used internally */
1422 enum ScmPortFlags {
1423 SCM_PORT_WRITESS = (1L<<0), /* write/ss on by default? */
1424 SCM_PORT_WALKING = (1L<<1), /* this port is a special port only used in
1425 the 'walk' phase of write/ss. */
1426 SCM_PORT_PRIVATE = (1L<<2) /* this port is for 'private' use within
1427 a thread, so never need to be locked. */
1428 };
1429
1430 #if 0 /* not implemented */
1431 /* Incomplete character handling policy.
1432 When Scm_Getc encounters a byte sequence that doesn't consist a valid
1433 multibyte character, it may take one of the following actions,
1434 according to the port's icpolicy field. */
1435 enum ScmPortICPolicy {
1436 SCM_PORT_IC_ERROR, /* signal an error */
1437 SCM_PORT_IC_IGNORE, /* ignore bytes until Getc finds a
1438 valid multibyte character */
1439 SCM_PORT_IC_REPLACE, /* replace invalid byte to a designated
1440 character. */
1441 };
1442 #endif
1443
1444 /* Predicates & accessors */
1445 #define SCM_PORTP(obj) (SCM_ISA(obj, SCM_CLASS_PORT))
1446
1447 #define SCM_PORT(obj) ((ScmPort *)(obj))
1448 #define SCM_PORT_TYPE(obj) (SCM_PORT(obj)->type)
1449 #define SCM_PORT_DIR(obj) (SCM_PORT(obj)->direction)
1450 #define SCM_PORT_FLAGS(obj) (SCM_PORT(obj)->flags)
1451 #define SCM_PORT_ICPOLICY(obj) (SCM_PORT(obj)->icpolicy)
1452
1453 #define SCM_PORT_CLOSED_P(obj) (SCM_PORT(obj)->closed)
1454 #define SCM_PORT_OWNER_P(obj) (SCM_PORT(obj)->ownerp)
1455 #define SCM_PORT_ERROR_OCCURRED_P(obj) (SCM_PORT(obj)->error)
1456
1457 #define SCM_IPORTP(obj) (SCM_PORTP(obj)&&(SCM_PORT_DIR(obj)&SCM_PORT_INPUT))
1458 #define SCM_OPORTP(obj) (SCM_PORTP(obj)&&(SCM_PORT_DIR(obj)&SCM_PORT_OUTPUT))
1459
1460 SCM_CLASS_DECL(Scm_PortClass);
1461 #define SCM_CLASS_PORT (&Scm_PortClass)
1462
1463 SCM_CLASS_DECL(Scm_CodingAwarePortClass);
1464 #define SCM_CLASS_CODING_AWARE_PORT (&Scm_CodingAwarePortClass)
1465
1466 SCM_EXTERN ScmObj Scm_Stdin(void);
1467 SCM_EXTERN ScmObj Scm_Stdout(void);
1468 SCM_EXTERN ScmObj Scm_Stderr(void);
1469
1470 SCM_EXTERN ScmObj Scm_GetBufferingMode(ScmPort *port);
1471 SCM_EXTERN int Scm_BufferingMode(ScmObj flag, int direction, int fallback);
1472
1473 SCM_EXTERN ScmObj Scm_OpenFilePort(const char *path, int flags,
1474 int buffering, int perm);
1475
1476 SCM_EXTERN void Scm_FlushAllPorts(int exitting);
1477
1478 SCM_EXTERN ScmObj Scm_MakeInputStringPort(ScmString *str, int privatep);
1479 SCM_EXTERN ScmObj Scm_MakeOutputStringPort(int privatep);
1480 SCM_EXTERN ScmObj Scm_GetOutputString(ScmPort *port);
1481 SCM_EXTERN ScmObj Scm_GetOutputStringUnsafe(ScmPort *port);
1482 SCM_EXTERN ScmObj Scm_GetRemainingInputString(ScmPort *port);
1483
1484 SCM_EXTERN ScmObj Scm_MakeVirtualPort(ScmClass *klass,
1485 int direction,
1486 ScmPortVTable *vtable);
1487 SCM_EXTERN ScmObj Scm_MakeBufferedPort(ScmClass *klass,
1488 ScmObj name, int direction,
1489 int ownerp,
1490 ScmPortBuffer *bufrec);
1491 SCM_EXTERN ScmObj Scm_MakePortWithFd(ScmObj name,
1492 int direction,
1493 int fd,
1494 int bufmode,
1495 int ownerp);
1496 SCM_EXTERN ScmObj Scm_MakeCodingAwarePort(ScmPort *iport);
1497
1498 SCM_EXTERN ScmObj Scm_PortName(ScmPort *port);
1499 SCM_EXTERN int Scm_PortLine(ScmPort *port);
1500 SCM_EXTERN ScmObj Scm_PortSeek(ScmPort *port, ScmObj off, int whence);
1501 SCM_EXTERN ScmObj Scm_PortSeekUnsafe(ScmPort *port, ScmObj off, int whence);
1502 SCM_EXTERN int Scm_PortFileNo(ScmPort *port);
1503 SCM_EXTERN int Scm_FdReady(int fd, int dir);
1504 SCM_EXTERN int Scm_ByteReady(ScmPort *port);
1505 SCM_EXTERN int Scm_ByteReadyUnsafe(ScmPort *port);
1506 SCM_EXTERN int Scm_CharReady(ScmPort *port);
1507 SCM_EXTERN int Scm_CharReadyUnsafe(ScmPort *port);
1508
1509 SCM_EXTERN void Scm_ClosePort(ScmPort *port);
1510
1511 SCM_EXTERN ScmObj Scm_VMWithPortLocking(ScmPort *port,
1512 ScmObj closure);
1513
1514 SCM_EXTERN void Scm_Putb(ScmByte b, ScmPort *port);
1515 SCM_EXTERN void Scm_Putc(ScmChar c, ScmPort *port);
1516 SCM_EXTERN void Scm_Puts(ScmString *s, ScmPort *port);
1517 SCM_EXTERN void Scm_Putz(const char *s, int len, ScmPort *port);
1518 SCM_EXTERN void Scm_Flush(ScmPort *port);
1519
1520 SCM_EXTERN void Scm_PutbUnsafe(ScmByte b, ScmPort *port);
1521 SCM_EXTERN void Scm_PutcUnsafe(ScmChar c, ScmPort *port);
1522 SCM_EXTERN void Scm_PutsUnsafe(ScmString *s, ScmPort *port);
1523 SCM_EXTERN void Scm_PutzUnsafe(const char *s, int len, ScmPort *port);
1524 SCM_EXTERN void Scm_FlushUnsafe(ScmPort *port);
1525
1526 SCM_EXTERN void Scm_Ungetc(ScmChar ch, ScmPort *port);
1527 SCM_EXTERN void Scm_Ungetb(int b, ScmPort *port);
1528 SCM_EXTERN int Scm_Getb(ScmPort *port);
1529 SCM_EXTERN int Scm_Getc(ScmPort *port);
1530 SCM_EXTERN int Scm_Getz(char *buf, int buflen, ScmPort *port);
1531 SCM_EXTERN ScmChar Scm_Peekc(ScmPort *port);
1532 SCM_EXTERN int Scm_Peekb(ScmPort *port);
1533
1534 SCM_EXTERN void Scm_UngetcUnsafe(ScmChar ch, ScmPort *port);
1535 SCM_EXTERN void Scm_UngetbUnsafe(int b, ScmPort *port);
1536 SCM_EXTERN int Scm_GetbUnsafe(ScmPort *port);
1537 SCM_EXTERN int Scm_GetcUnsafe(ScmPort *port);
1538 SCM_EXTERN int Scm_GetzUnsafe(char *buf, int buflen, ScmPort *port);
1539 SCM_EXTERN ScmChar Scm_PeekcUnsafe(ScmPort *port);
1540 SCM_EXTERN int Scm_PeekbUnsafe(ScmPort *port);
1541
1542 SCM_EXTERN ScmObj Scm_ReadLine(ScmPort *port);
1543 SCM_EXTERN ScmObj Scm_ReadLineUnsafe(ScmPort *port);
1544
1545 SCM_EXTERN ScmObj Scm_WithPort(ScmPort *port[], ScmObj thunk,
1546 int mask, int closep);
1547 #define SCM_PORT_CURIN (1<<0)
1548 #define SCM_PORT_CUROUT (1<<1)
1549 #define SCM_PORT_CURERR (1<<2)
1550
1551 #define SCM_CURIN SCM_VM_CURRENT_INPUT_PORT(Scm_VM())
1552 #define SCM_CUROUT SCM_VM_CURRENT_OUTPUT_PORT(Scm_VM())
1553 #define SCM_CURERR SCM_VM_CURRENT_ERROR_PORT(Scm_VM())
1554
1555 #define SCM_PUTB(b, p) Scm_Putb(b, SCM_PORT(p))
1556 #define SCM_PUTC(c, p) Scm_Putc(c, SCM_PORT(p))
1557 #define SCM_PUTZ(s, l, p) Scm_Putz(s, l, SCM_PORT(p))
1558 #define SCM_PUTS(s, p) Scm_Puts(SCM_STRING(s), SCM_PORT(p))
1559 #define SCM_FLUSH(p) Scm_Flush(SCM_PORT(p))
1560 #define SCM_PUTNL(p) SCM_PUTC('\n', p)
1561
1562 #define SCM_UNGETC(c, port) Scm_Ungetc(c, SCM_PORT(port))
1563 #define SCM_GETB(b, p) (b = Scm_Getb(SCM_PORT(p)))
1564 #define SCM_GETC(c, p) (c = Scm_Getc(SCM_PORT(p)))
1565
1566 /*--------------------------------------------------------
1567 * WRITE
1568 */
1569
1570 struct ScmWriteContextRec {
1571 short mode; /* print mode */
1572 short flags; /* internal */
1573 int limit; /* internal */
1574 int ncirc; /* internal */
1575 ScmHashTable *table; /* internal */
1576 ScmObj obj; /* internal */
1577 };
1578
1579 /* Print mode flags */
1580 enum {
1581 SCM_WRITE_WRITE = 0, /* write mode */
1582 SCM_WRITE_DISPLAY = 1, /* display mode */
1583 SCM_WRITE_SHARED = 2, /* write/ss mode */
1584 SCM_WRITE_WALK = 3, /* this is a special mode in write/ss */
1585 SCM_WRITE_MODE_MASK = 0x3,
1586
1587 SCM_WRITE_CASE_FOLD = 4, /* case-fold mode. need to escape capital
1588 letters. */
1589 SCM_WRITE_CASE_NOFOLD = 8, /* case-sensitive mode. no need to escape
1590 capital letters */
1591 SCM_WRITE_CASE_MASK = 0x0c
1592 };
1593
1594 #define SCM_WRITE_MODE(ctx) ((ctx)->mode & SCM_WRITE_MODE_MASK)
1595 #define SCM_WRITE_CASE(ctx) ((ctx)->mode & SCM_WRITE_CASE_MASK)
1596
1597 SCM_EXTERN void Scm_Write(ScmObj obj, ScmObj port, int mode);
1598 SCM_EXTERN int Scm_WriteCircular(ScmObj obj, ScmObj port, int mode, int width);
1599 SCM_EXTERN int Scm_WriteLimited(ScmObj obj, ScmObj port, int mode, int width);
1600 SCM_EXTERN void Scm_Format(ScmPort *port, ScmString *fmt, ScmObj args, int ss);
1601 SCM_EXTERN void Scm_Printf(ScmPort *port, const char *fmt, ...);
1602 SCM_EXTERN void Scm_PrintfShared(ScmPort *port, const char *fmt, ...);
1603 SCM_EXTERN void Scm_Vprintf(ScmPort *port, const char *fmt, va_list args,
1604 int sharedp);
1605
1606 /*---------------------------------------------------------
1607 * READ
1608 */
1609
1610 typedef struct ScmReadContextRec {
1611 int flags; /* see below */
1612 ScmHashTable *table; /* used internally. */
1613 ScmObj pending; /* used internally. */
1614 } ScmReadContext;
1615
1616 enum {
1617 SCM_READ_SOURCE_INFO = (1L<<0), /* preserving souce file information */
1618 SCM_READ_CASE_FOLD = (1L<<1), /* case-fold read */
1619 SCM_READ_LITERAL_IMMUTABLE = (1L<<2), /* literal should be read as immutable */
1620 SCM_READ_RECURSIVELY = (1L<<3) /* used internally. */
1621 };
1622
1623 #define SCM_READ_CONTEXT_INIT(ctx) \
1624 do { (ctx)->flags = 0; } while (0)
1625
1626 /* An object to keep unrealized circular reference (e.g. #N=) during
1627 * 'read'. It is replaced by the reference value before exitting 'read',
1628 * and it shouldn't leak out to the normal Scheme program, except the
1629 * code that handles it explicitly (like read-time constructor).
1630 */
1631 typedef struct ScmReadReferenceRec {
1632 SCM_HEADER;
1633 ScmObj value; /* realized reference. initially UNBOUND */
1634 } ScmReadReference;
1635
1636 SCM_CLASS_DECL(Scm_ReadReferenceClass);
1637 #define SCM_CLASS_READ_REFERENCE (&Scm_ReadReferenceClass)
1638 #define SCM_READ_REFERENCE(obj) ((ScmReadReference*)(obj))
1639 #define SCM_READ_REFERENCE_P(obj) SCM_XTYPEP(obj, SCM_CLASS_READ_REFERENCE)
1640 #define SCM_READ_REFERENCE_REALIZED(obj) \
1641 (!SCM_EQ(SCM_READ_REFERENCE(obj)->value, SCM_UNBOUND))
1642
1643 SCM_EXTERN ScmObj Scm_Read(ScmObj port);
1644 SCM_EXTERN ScmObj Scm_ReadWithContext(ScmObj port, ScmReadContext *ctx);
1645 SCM_EXTERN ScmObj Scm_ReadList(ScmObj port, ScmChar closer);
1646 SCM_EXTERN ScmObj Scm_ReadListWithContext(ScmObj port, ScmChar closer,
1647 ScmReadContext *ctx);
1648 SCM_EXTERN ScmObj Scm_ReadFromString(ScmString *string);
1649 SCM_EXTERN ScmObj Scm_ReadFromCString(const char *string);
1650
1651 SCM_EXTERN void Scm_ReadError(ScmPort *port, const char *fmt, ...);
1652
1653 SCM_EXTERN ScmObj Scm_DefineReaderCtor(ScmObj symbol, ScmObj proc,
1654 ScmObj finisher);
1655
1656 /*--------------------------------------------------------
1657 * WEAK VECTOR & WEAK BOX
1658 */
1659
1660 typedef struct ScmWeakVectorRec {
1661 SCM_HEADER;
1662 int size;
1663 void *pointers; /* opaque */
1664 } ScmWeakVector;
1665
1666 #define SCM_WEAK_VECTOR(obj) ((ScmWeakVector*)(obj))
1667 #define SCM_WEAK_VECTOR_P(obj) SCM_XTYPEP(obj, SCM_CLASS_WEAK_VECTOR)
1668 SCM_CLASS_DECL(Scm_WeakVectorClass);
1669 #define SCM_CLASS_WEAK_VECTOR (&Scm_WeakVectorClass)
1670
1671 SCM_EXTERN ScmObj Scm_MakeWeakVector(int size);
1672 SCM_EXTERN ScmObj Scm_WeakVectorRef(ScmWeakVector *v, int index, ScmObj fallback);
1673 SCM_EXTERN ScmObj Scm_WeakVectorSet(ScmWeakVector *v, int index, ScmObj val);
1674
1675 typedef struct ScmWeakBoxRec ScmWeakBox; /* opaque */
1676
1677 SCM_EXTERN ScmWeakBox *Scm_MakeWeakBox(void *value);
1678 SCM_EXTERN int Scm_WeakBoxEmptyP(ScmWeakBox *wbox);
1679 SCM_EXTERN void Scm_WeakBoxSet(ScmWeakBox *wbox, void *value);
1680 SCM_EXTERN void *Scm_WeakBoxRef(ScmWeakBox *wbox);
1681
1682 /*--------------------------------------------------------
1683 * HASHTABLE
1684 */
1685
1686 typedef struct ScmHashEntryRec ScmHashEntry;
1687
1688 typedef ScmHashEntry *(*ScmHashAccessProc)(ScmHashTable *ht,
1689 void *key, int op, void *val);
1690 typedef unsigned long (*ScmHashProc)(ScmHashTable *ht, void *key);
1691 typedef int (*ScmHashCmpProc)(ScmHashTable *ht, void *key, ScmHashEntry *e);
1692
1693 struct ScmHashTableRec {
1694 SCM_HEADER;
1695 ScmHashEntry **buckets;
1696 int numBuckets;
1697 int numEntries;
1698 int numBucketsLog2;
1699 int type;
1700 ScmHashAccessProc accessfn;
1701 ScmHashProc hashfn;
1702 ScmHashCmpProc cmpfn;
1703 void *data;
1704 };
1705
1706 SCM_CLASS_DECL(Scm_HashTableClass);
1707 #define SCM_CLASS_HASH_TABLE (&Scm_HashTableClass)
1708 #define SCM_HASH_TABLE(obj) ((ScmHashTable*)(obj))
1709 #define SCM_HASH_TABLE_P(obj) SCM_ISA(obj, SCM_CLASS_HASH_TABLE)
1710
1711 /* Hash types */
1712 enum {
1713 /* ScmObj hashtables */
1714 SCM_HASH_EQ,
1715 SCM_HASH_EQV,
1716 SCM_HASH_EQUAL,
1717 SCM_HASH_STRING,
1718 SCM_HASH_GENERAL,
1719
1720 /* Raw hashtables */
1721 SCM_HASH_WORD,
1722 SCM_HASH_MULTIWORD,
1723 SCM_HASH_RAW
1724 };
1725
1726 #define SCM_HASH_TABLE_RAW_P(ht) (SCM_HASH_TABLE(ht)->type >= SCM_HASH_WORD)
1727
1728 /* 'weakness' type */
1729 enum {
1730 SCM_HASH_WEAK_KEY = 0x01,
1731 SCM_HASH_WEAK_VALUE = 0x02,
1732 SCM_HASH_WEAK_BOTH = (SCM_HASH_WEAK_KEY|SCM_HASH_WEAK_VALUE)
1733 };
1734
1735 /* auxiliary structure; not an ScmObj. */
1736 struct ScmHashEntryRec {
1737 void *key;
1738 void *value;
1739 struct ScmHashEntryRec *next;
1740 };
1741
1742 typedef struct ScmHashIterRec {
1743 ScmHashTable *table;
1744 int currentBucket;
1745 ScmHashEntry *currentEntry;
1746 } ScmHashIter;
1747
1748 /* Constructors */
1749 SCM_EXTERN ScmObj Scm_MakeHashTableSimple(int type, int initSize);
1750 SCM_EXTERN ScmObj Scm_MakeHashTableMultiWord(int keySize, int initSize);
1751 SCM_EXTERN ScmObj Scm_MakeHashTableFull(ScmClass *klass,
1752 int type,
1753 ScmHashProc hashfn,
1754 ScmHashCmpProc cmpfn,
1755 int initSize,
1756 void *data);
1757
1758 SCM_EXTERN ScmObj Scm_CopyHashTable(ScmHashTable *tab);
1759
1760 /* Accessor API: the 'Raw' versions are base ones, to be used for
1761 any type of hashtables. The versions without 'Raw' do checks
1762 to make sure the given hashtable is the ScmObj one. */
1763 SCM_EXTERN ScmHashEntry *Scm_HashTableGetRaw(ScmHashTable *hash, void *key);
1764 SCM_EXTERN ScmHashEntry *Scm_HashTableAddRaw(ScmHashTable *hash,
1765 void *key, void *value);
1766 SCM_EXTERN ScmHashEntry *Scm_HashTablePutRaw(ScmHashTable *hash,
1767 void *key, void *value);
1768 SCM_EXTERN ScmHashEntry *Scm_HashTableDeleteRaw(ScmHashTable *hash, void *key);
1769
1770 SCM_EXTERN ScmHashEntry *Scm_HashTableGet(ScmHashTable *hash, ScmObj key);
1771 SCM_EXTERN ScmHashEntry *Scm_HashTableAdd(ScmHashTable *hash,
1772 ScmObj key, ScmObj value);
1773 SCM_EXTERN ScmHashEntry *Scm_HashTablePut(ScmHashTable *hash,
1774 ScmObj key, ScmObj value);
1775 SCM_EXTERN ScmHashEntry *Scm_HashTableDelete(ScmHashTable *hash, ScmObj key);
1776
1777 SCM_EXTERN ScmObj Scm_HashTableKeys(ScmHashTable *table);
1778 SCM_EXTERN ScmObj Scm_HashTableValues(ScmHashTable *table);
1779
1780 SCM_EXTERN void Scm_HashIterInitRaw(ScmHashTable *hash, ScmHashIter *iter);
1781 SCM_EXTERN void Scm_HashIterInit(ScmHashTable *hash, ScmHashIter *iter);
1782 SCM_EXTERN ScmHashEntry *Scm_HashIterNext(ScmHashIter *iter);
1783
1784 /* Miscellaneous utils*/
1785 SCM_EXTERN ScmObj Scm_HashTableStat(ScmHashTable *table);
1786
1787 /* Hash functions */
1788 SCM_EXTERN unsigned long Scm_EqHash(ScmObj obj);
1789 SCM_EXTERN unsigned long Scm_EqvHash(ScmObj obj);
1790 SCM_EXTERN unsigned long Scm_Hash(ScmObj obj);
1791 SCM_EXTERN unsigned long Scm_HashString(ScmString *str, unsigned long bound);
1792
1793 /* Compatibility stuff
1794 Use of these APIs are deprecated. They'll go away in a few releases. */
1795
1796 #define SCM_HASHTABLE SCM_HASH_TABLE
1797 #define SCM_HASHTABLEP SCM_HASH_TABLE_P
1798 #define SCM_CLASS_HASHTABLE SCM_CLASS_HASH_TABLE
1799 #define SCM_HASH_ADDRESS SCM_HASH_EQ
1800
1801 SCM_EXTERN ScmObj Scm_MakeHashTable(ScmHashProc hashfn,
1802 ScmHashCmpProc cmpfn,
1803 unsigned int initSize);
1804
1805 /*--------------------------------------------------------
1806 * MODULE
1807 */
1808
1809 struct ScmModuleRec {
1810 SCM_HEADER;
1811 ScmSymbol *name;
1812 ScmObj imported; /* list of imported modules */
1813 ScmObj exported; /* list of exported symbols */
1814 int exportAll; /* TRUE if (export-all) */
1815 ScmObj parents; /* direct parent modules */
1816 ScmObj mpl; /* module precedence list */
1817 ScmHashTable *table;
1818 };
1819
1820 #define SCM_MODULE(obj) ((ScmModule*)(obj))
1821 #define SCM_MODULEP(obj) SCM_XTYPEP(obj, SCM_CLASS_MODULE)
1822
1823 SCM_CLASS_DECL(Scm_ModuleClass);
1824 #define SCM_CLASS_MODULE (&Scm_ModuleClass)
1825
1826 SCM_EXTERN ScmGloc *Scm_FindBinding(ScmModule *module, ScmSymbol *symbol,
1827 int stay_in_module);
1828 SCM_EXTERN ScmObj Scm_MakeModule(ScmSymbol *name, int error_if_exists);
1829 SCM_EXTERN ScmObj Scm_SymbolValue(ScmModule *module, ScmSymbol *symbol);
1830 SCM_EXTERN ScmObj Scm_Define(ScmModule *module, ScmSymbol *symbol,
1831 ScmObj value);
1832 SCM_EXTERN ScmObj Scm_DefineConst(ScmModule *module, ScmSymbol *symbol,
1833 ScmObj value);
1834
1835 SCM_EXTERN ScmObj Scm_ExtendModule(ScmModule *module, ScmObj supers);
1836 SCM_EXTERN ScmObj Scm_ImportModules(ScmModule *module, ScmObj list);
1837 SCM_EXTERN ScmObj Scm_ExportSymbols(ScmModule *module, ScmObj list);
1838 SCM_EXTERN ScmObj Scm_ExportAll(ScmModule *module);
1839 SCM_EXTERN ScmModule *Scm_FindModule(ScmSymbol *name, int flags);
1840 SCM_EXTERN ScmObj Scm_AllModules(void);
1841 SCM_EXTERN void Scm_SelectModule(ScmModule *mod);
1842
1843 /* Flags for Scm_FindModule
1844 NB: Scm_FindModule's second arg has been changed since 0.8.6;
1845 before, it was just a boolean value to indicate whether a new
1846 module should be created (TRUE) or not (FALSE). We added a
1847 new flag value to make Scm_FindModule raises an error if the named
1848 module doesn't exist. This change should be transparent as far
1849 as the caller's using Gauche's definition of TRUE. */
1850 enum {
1851 SCM_FIND_MODULE_CREATE = 1, /* Create if there's no named module */
1852 SCM_FIND_MODULE_QUIET = 2 /* Do not signal an error if there's no
1853 named module, but return NULL instead. */
1854 };
1855
1856 #define SCM_FIND_MODULE(name, flags) \
1857 Scm_FindModule(SCM_SYMBOL(SCM_INTERN(name)), flags)
1858
1859 SCM_EXTERN ScmObj Scm_ModuleNameToPath(ScmSymbol *name);
1860 SCM_EXTERN ScmObj Scm_PathToModuleName(ScmString *path);
1861
1862 SCM_EXTERN ScmModule *Scm_NullModule(void);
1863 SCM_EXTERN ScmModule *Scm_SchemeModule(void);
1864 SCM_EXTERN ScmModule *Scm_GaucheModule(void);
1865 SCM_EXTERN ScmModule *Scm_UserModule(void);
1866 SCM_EXTERN ScmModule *Scm_CurrentModule(void);
1867
1868 #define SCM_DEFINE(module, cstr, val) \
1869 Scm_Define(SCM_MODULE(module), \
1870 SCM_SYMBOL(SCM_INTERN(cstr)), \
1871 SCM_OBJ(val))
1872
1873 #define SCM_SYMBOL_VALUE(module_name, symbol_name) \
1874 Scm_SymbolValue(SCM_FIND_MODULE(module_name, 0), \
1875 SCM_SYMBOL(SCM_INTERN(symbol_name)))
1876
1877 /*--------------------------------------------------------
1878 * SYMBOL
1879 */
1880
1881 struct ScmSymbolRec {
1882 SCM_HEADER;
1883 ScmString *name;
1884 };
1885
1886 #define SCM_SYMBOL(obj) ((ScmSymbol*)(obj))
1887 #define SCM_SYMBOLP(obj) SCM_XTYPEP(obj, SCM_CLASS_SYMBOL)
1888 #define SCM_SYMBOL_NAME(obj) (SCM_SYMBOL(obj)->name)
1889
1890 SCM_EXTERN ScmObj Scm_Intern(ScmString *name);
1891 #define SCM_INTERN(cstr) Scm_Intern(SCM_STRING(SCM_MAKE_STR_IMMUTABLE(cstr)))
1892 SCM_EXTERN ScmObj Scm_Gensym(ScmString *prefix);
1893
1894 SCM_CLASS_DECL(Scm_SymbolClass);
1895 #define SCM_CLASS_SYMBOL (&Scm_SymbolClass)
1896
1897 /* Gloc (global location) */
1898 struct ScmGlocRec {
1899 SCM_HEADER;
1900 ScmSymbol *name;
1901 ScmModule *module;
1902 ScmObj value;
1903 int exported;
1904 ScmObj (*getter)(ScmGloc *);
1905 ScmObj (*setter)(ScmGloc *, ScmObj);
1906 };
1907
1908 #define SCM_GLOC(obj) ((ScmGloc*)(obj))
1909 #define SCM_GLOCP(obj) SCM_XTYPEP(obj, SCM_CLASS_GLOC)
1910 SCM_CLASS_DECL(Scm_GlocClass);
1911 #define SCM_CLASS_GLOC (&Scm_GlocClass)
1912
1913 #define SCM_GLOC_GET(gloc) \
1914 ((gloc)->getter? (gloc)->getter(gloc) : (gloc)->value)
1915 #define SCM_GLOC_SET(gloc, val) \
1916 ((gloc)->setter? (gloc)->setter((gloc), (val)) : ((gloc)->value = (val)))
1917
1918 SCM_EXTERN ScmObj Scm_MakeGloc(ScmSymbol *sym, ScmModule *module);
1919 SCM_EXTERN ScmObj Scm_MakeConstGloc(ScmSymbol *sym, ScmModule *module);
1920 SCM_EXTERN ScmObj Scm_GlocConstSetter(ScmGloc *g, ScmObj val);
1921
1922 #define SCM_GLOC_CONST_P(gloc) \
1923 ((gloc)->setter == Scm_GlocConstSetter)
1924
1925 /*--------------------------------------------------------
1926 * KEYWORD
1927 */
1928
1929 struct ScmKeywordRec {
1930 SCM_HEADER;
1931 ScmString *name;
1932 };
1933
1934 SCM_CLASS_DECL(Scm_KeywordClass);
1935 #define SCM_CLASS_KEYWORD (&Scm_KeywordClass)
1936
1937 #define SCM_KEYWORD(obj) ((ScmKeyword*)(obj))
1938 #define SCM_KEYWORDP(obj) SCM_XTYPEP(obj, SCM_CLASS_KEYWORD)
1939 #define SCM_KEYWORD_NAME(obj) (SCM_KEYWORD(obj)->name)
1940
1941 SCM_EXTERN ScmObj Scm_MakeKeyword(ScmString *name);
1942 SCM_EXTERN ScmObj Scm_GetKeyword(ScmObj key, ScmObj list, ScmObj fallback);
1943 SCM_EXTERN ScmObj Scm_DeleteKeyword(ScmObj key, ScmObj list);
1944 SCM_EXTERN ScmObj Scm_DeleteKeywordX(ScmObj key, ScmObj list);
1945
1946 #define SCM_MAKE_KEYWORD(cstr) \
1947 Scm_MakeKeyword(SCM_STRING(SCM_MAKE_STR_IMMUTABLE(cstr)))
1948 #define SCM_GET_KEYWORD(cstr, list, fallback) \
1949 Scm_GetKeyword(SCM_MAKE_KEYWORD(cstr), list, fallback)
1950
1951 /*--------------------------------------------------------
1952 * NUMBER
1953 */
1954
1955 /* "Normalized" numbers
1956 *
1957 * In Scheme world, numbers should be always in normalized form.
1958 *
1959 * - Exact integers that can be representable in fixnum should be in
1960 * the fixnum form, not in the bignum form.
1961 * - Complex numbers whose imaginary part is 0.0 should be in the flonum
1962 * form, not in the complexnum form.
1963 *
1964 * Some C API returns anormalized numbers to avoid unnecessary
1965 * conversion overhead. These anormalized numbers shuold be used
1966 * strictly in the intermediate form within C world. Anything that
1967 * is passed back to Scheme world must be normalized.
1968 */
1969
1970 #define SCM_SMALL_INT_SIZE (SIZEOF_LONG*8-3)
1971 #define SCM_SMALL_INT_MAX ((1L << SCM_SMALL_INT_SIZE) - 1)
1972 #define SCM_SMALL_INT_MIN (-SCM_SMALL_INT_MAX-1)
1973 #define SCM_SMALL_INT_FITS(k) \
1974 (((k)<=SCM_SMALL_INT_MAX)&&((k)>=SCM_SMALL_INT_MIN))
1975
1976 #define SCM_RADIX_MAX 36
1977
1978 #define SCM_INTEGERP(obj) (SCM_INTP(obj) || SCM_BIGNUMP(obj))
1979 #define SCM_REALP(obj) (SCM_INTEGERP(obj)||SCM_FLONUMP(obj))
1980 #define SCM_NUMBERP(obj) (SCM_REALP(obj)||SCM_COMPLEXP(obj))
1981 #define SCM_EXACTP(obj) SCM_INTEGERP(obj)
1982 #define SCM_INEXACTP(obj) (SCM_FLONUMP(obj)||SCM_COMPLEXP(obj))
1983
1984 #define SCM_UINTEGERP(obj) \
1985 (SCM_UINTP(obj) || (SCM_BIGNUMP(obj)&&SCM_BIGNUM_SIGN(obj)>=0))
1986
1987 SCM_CLASS_DECL(Scm_NumberClass);
1988 SCM_CLASS_DECL(Scm_ComplexClass);
1989 SCM_CLASS_DECL(Scm_RealClass);
1990 SCM_CLASS_DECL(Scm_IntegerClass);
1991
1992 #define SCM_CLASS_NUMBER (&Scm_NumberClass)
1993 #define SCM_CLASS_COMPLEX (&Scm_ComplexClass)
1994 #define SCM_CLASS_REAL (&Scm_RealClass)
1995 #define SCM_CLASS_INTEGER (&Scm_IntegerClass)
1996
1997 struct ScmBignumRec {
1998 SCM_HEADER;
1999 int sign : 2;
2000 unsigned int size : (SIZEOF_INT*CHAR_BIT-2);
2001 unsigned long values[1]; /* variable length */
2002 };
2003
2004 #define SCM_BIGNUM(obj) ((ScmBignum*)(obj))
2005 #define SCM_BIGNUMP(obj) SCM_XTYPEP(obj, SCM_CLASS_INTEGER)
2006 #define SCM_BIGNUM_SIZE(obj) SCM_BIGNUM(obj)->size
2007 #define SCM_BIGNUM_SIGN(obj) SCM_BIGNUM(obj)->sign
2008
2009 #define SCM_BIGNUM_MAX_DIGITS ((1UL<<(SIZEOF_INT*CHAR_BIT-2))-1)
2010
2011 /* Converting a Scheme number to a C number:
2012 *
2013 * It's a tricky business. It's always possible that the Scheme number
2014 * you got may not fit into the desired C variable. There are several
2015 * options you can choose.
2016 *
2017 * - Error. Throws an error.
2018 * - Clamping. If the Scheme value falls out of the supported range
2019 * of C variable, use the closest representable value.
2020 * - Convert only when possible. If conversion is not possible, use
2021 * the Scheme value as-is. It is useful to provide a shortcut path
2022 * to improve performance.
2023 *
2024 * Some APIs take 'clamp' argument to specify the behavior. The value
2025 * can be one of the SCM_CLAMP_* enums. If an API supports SCM_CLAMP_NONE,
2026 * it also takes an output argument to return a flag whether the argument
2027 * is out of range or not. This output argument can be NULL if the caller
2028 * doesn't specify SCM_CLAMP_NONE flag.
2029 */
2030
2031 enum {
2032 SCM_CLAMP_ERROR = 0, /* throws an error when out-of-range */
2033 SCM_CLAMP_HI = 1,
2034 SCM_CLAMP_LO = 2,
2035 SCM_CLAMP_BOTH = 3,
2036 SCM_CLAMP_NONE = 4 /* do not convert when out-of-range */
2037 };
2038
2039 SCM_EXTERN ScmObj Scm_MakeBignumFromSI(long val);
2040 SCM_EXTERN ScmObj Scm_MakeBignumFromUI(u_long val);
2041 SCM_EXTERN ScmObj Scm_MakeBignumFromUIArray(int sign, u_long *values, int size);
2042 SCM_EXTERN ScmObj Scm_MakeBignumFromDouble(double val);
2043 SCM_EXTERN ScmObj Scm_BignumCopy(ScmBignum *b);
2044 SCM_EXTERN ScmObj Scm_BignumToString(ScmBignum *b, int radix, int use_upper);
2045
2046 SCM_EXTERN long Scm_BignumToSI(ScmBignum *b, int clamp, int* oor);
2047 SCM_EXTERN u_long Scm_BignumToUI(ScmBignum *b, int clamp, int* oor);
2048 #if SIZEOF_LONG == 4
2049 SCM_EXTERN ScmInt64 Scm_BignumToSI64(ScmBignum *b, int clamp, int *oor);
2050 SCM_EXTERN ScmUInt64 Scm_BignumToUI64(ScmBignum *b, int clamp, int *oor);
2051 #else /* SIZEOF_LONG >= 8 */
2052 #define Scm_BignumToSI64 Scm_BignumToSI
2053 #define Scm_BignumToUI64 Scm_BignumToUI
2054 #endif /* SIZEOF_LONG >= 8 */
2055 SCM_EXTERN double Scm_BignumToDouble(ScmBignum *b);
2056 SCM_EXTERN ScmObj Scm_NormalizeBignum(ScmBignum *b);
2057 SCM_EXTERN ScmObj Scm_BignumNegate(ScmBignum *b);
2058 SCM_EXTERN int Scm_BignumCmp(ScmBignum *bx, ScmBignum *by);
2059 SCM_EXTERN int Scm_BignumAbsCmp(ScmBignum *bx, ScmBignum *by);
2060 SCM_EXTERN int Scm_BignumCmp3U(ScmBignum *bx, ScmBignum *off, ScmBignum *by);
2061 SCM_EXTERN ScmObj Scm_BignumComplement(ScmBignum *bx);
2062
2063 SCM_EXTERN ScmObj Scm_BignumAdd(ScmBignum *bx, ScmBignum *by);
2064 SCM_EXTERN ScmObj Scm_BignumAddSI(ScmBignum *bx, long y);
2065 SCM_EXTERN ScmObj Scm_BignumAddN(ScmBignum *bx, ScmObj args);
2066 SCM_EXTERN ScmObj Scm_BignumSub(ScmBignum *bx, ScmBignum *by);
2067 SCM_EXTERN ScmObj Scm_BignumSubSI(ScmBignum *bx, long y);
2068 SCM_EXTERN ScmObj Scm_BignumSubN(ScmBignum *bx, ScmObj args);
2069 SCM_EXTERN ScmObj Scm_BignumMul(ScmBignum *bx, ScmBignum *by);
2070 SCM_EXTERN ScmObj Scm_BignumMulSI(ScmBignum *bx, long y);
2071 SCM_EXTERN ScmObj Scm_BignumMulN(ScmBignum *bx, ScmObj args);
2072 SCM_EXTERN ScmObj Scm_BignumDivSI(ScmBignum *bx, long y, long *r);
2073 SCM_EXTERN ScmObj Scm_BignumDivRem(ScmBignum *bx, ScmBignum *by);
2074
2075 SCM_EXTERN ScmObj Scm_BignumLogAndSI(ScmBignum *bx, long y);
2076 SCM_EXTERN ScmObj Scm_BignumLogAnd(ScmBignum *bx, ScmBignum *by);
2077 SCM_EXTERN ScmObj Scm_BignumLogIor(ScmBignum *bx, ScmBignum *by);
2078 SCM_EXTERN ScmObj Scm_BignumLogXor(ScmBignum *bx, ScmBignum *by);
2079 SCM_EXTERN ScmObj Scm_BignumLogNot(ScmBignum *bx);
2080 SCM_EXTERN ScmObj Scm_BignumLogBit(ScmBignum *bx, int bit);
2081 SCM_EXTERN ScmObj Scm_BignumAsh(ScmBignum *bx, int cnt);
2082
2083 SCM_EXTERN ScmBignum *Scm_MakeBignumWithSize(int size, u_long init);
2084 SCM_EXTERN ScmBignum *Scm_BignumAccMultAddUI(ScmBignum *acc,
2085 u_long coef, u_long c);
2086
2087 struct ScmFlonumRec {
2088 SCM_HEADER;
2089 double value;
2090 };
2091
2092 #define SCM_FLONUM(obj) ((ScmFlonum*)(obj))
2093 #define SCM_FLONUMP(obj) SCM_XTYPEP(obj, SCM_CLASS_REAL)
2094 #define SCM_FLONUM_VALUE(obj) (SCM_FLONUM(obj)->value)
2095
2096 struct ScmComplexRec {
2097 SCM_HEADER;
2098 double real;
2099 double imag;
2100 };
2101
2102 #define SCM_COMPLEX(obj) ((ScmComplex*)(obj))
2103 #define SCM_COMPLEXP(obj) SCM_XTYPEP(obj, SCM_CLASS_COMPLEX)
2104 #define SCM_COMPLEX_REAL(obj) SCM_COMPLEX(obj)->real
2105 #define SCM_COMPLEX_IMAG(obj) SCM_COMPLEX(obj)->imag
2106
2107 SCM_EXTERN ScmObj Scm_MakeInteger(long i);
2108 SCM_EXTERN ScmObj Scm_MakeIntegerU(u_long i);
2109
2110 SCM_EXTERN long Scm_GetIntegerClamp(ScmObj obj, int clamp, int *oor);
2111 SCM_EXTERN u_long Scm_GetIntegerUClamp(ScmObj obj, int clamp, int *oor);
2112 #define Scm_GetInteger(x) Scm_GetIntegerClamp(x, SCM_CLAMP_BOTH, NULL)
2113 #define Scm_GetIntegerU(x) Scm_GetIntegerUClamp(x, SCM_CLAMP_BOTH, NULL)
2114
2115 SCM_EXTERN ScmInt32 Scm_GetInteger32Clamp(ScmObj obj, int clamp, int *oor);
2116 SCM_EXTERN ScmUInt32 Scm_GetIntegerU32Clamp(ScmObj obj, int clamp, int *oor);
2117
2118 /* 64bit integer stuff */
2119 #if SIZEOF_LONG == 4
2120 SCM_EXTERN ScmObj Scm_MakeInteger64(ScmInt64 i);
2121 SCM_EXTERN ScmObj Scm_MakeIntegerU64(ScmUInt64 i);
2122 SCM_EXTERN ScmInt64 Scm_GetInteger64Clamp(ScmObj obj, int clamp, int *oor);
2123 SCM_EXTERN ScmUInt64 Scm_GetIntegerU64Clamp(ScmObj obj, int clamp, int *oor);
2124 #else /* SIZEOF_LONG >= 8 */
2125 #define Scm_MakeInteger64 Scm_MakeInteger
2126 #define Scm_MakeIntegerU64 Scm_MakeIntegerU
2127 #define Scm_GetInteger64Clamp Scm_GetIntegerClamp
2128 #define Scm_GetIntegerU64Clamp Scm_GetIntegerUClamp
2129 #endif /* SIZEOF_LONG >= 8 */
2130 #define Scm_GetInteger64(x) Scm_GetInteger64Clamp(x, SCM_CLAMP_BOTH, NULL)
2131 #define Scm_GetIntegerU64(x) Scm_GetIntegerU64Clamp(x, SCM_CLAMP_BOTH, NULL)
2132
2133 /* for backward compatibility -- will be gone soon */
2134 #define Scm_MakeIntegerFromUI Scm_MakeIntegerU
2135 #define Scm_GetUInteger Scm_GetIntegerU
2136
2137 SCM_EXTERN ScmObj Scm_MakeFlonum(double d);
2138 SCM_EXTERN double Scm_GetDouble(ScmObj obj);
2139 SCM_EXTERN ScmObj Scm_DecodeFlonum(double d, int *exp, int *sign);
2140 SCM_EXTERN ScmObj Scm_MakeFlonumToNumber(double d, int exactp);
2141
2142 SCM_EXTERN ScmObj Scm_MakeComplex(double real, double imag);
2143 SCM_EXTERN ScmObj Scm_MakeComplexPolar(double magnitude, double angle);
2144 SCM_EXTERN ScmObj Scm_MakeComplexNormalized(double real, double imag);
2145
2146 SCM_EXTERN ScmObj Scm_PromoteToBignum(ScmObj obj);
2147 SCM_EXTERN ScmObj Scm_PromoteToComplex(ScmObj obj);
2148 SCM_EXTERN ScmObj Scm_PromoteToFlonum(ScmObj obj);
2149
2150 SCM_EXTERN int Scm_IntegerP(ScmObj obj);
2151 SCM_EXTERN int Scm_OddP(ScmObj obj);
2152 SCM_EXTERN ScmObj Scm_Abs(ScmObj obj);
2153 SCM_EXTERN int Scm_Sign(ScmObj obj);
2154 SCM_EXTERN ScmObj Scm_Negate(ScmObj obj);
2155 SCM_EXTERN ScmObj Scm_Reciprocal(ScmObj obj);
2156 SCM_EXTERN ScmObj Scm_ExactToInexact(ScmObj obj);
2157 SCM_EXTERN ScmObj Scm_InexactToExact(ScmObj obj);
2158
2159 SCM_EXTERN ScmObj Scm_Add(ScmObj arg1, ScmObj arg2, ScmObj args);
2160 SCM_EXTERN ScmObj Scm_Subtract(ScmObj arg1, ScmObj arg2, ScmObj args);
2161 SCM_EXTERN ScmObj Scm_Multiply(ScmObj arg1, ScmObj arg2, ScmObj args);
2162 SCM_EXTERN ScmObj Scm_Divide(ScmObj arg1, ScmObj arg2, ScmObj args);
2163
2164 #define Scm_Add2(a, b) Scm_Add((a), (b), SCM_NIL)
2165 #define Scm_Subtract2(a, b) Scm_Subtract((a), (b), SCM_NIL)
2166 #define Scm_Multiply2(a, b) Scm_Multiply((a), (b), SCM_NIL)
2167 #define Scm_Divide2(a, b) Scm_Divide((a), (b), SCM_NIL)
2168
2169 SCM_EXTERN ScmObj Scm_Quotient(ScmObj arg1, ScmObj arg2, ScmObj *rem);
2170 SCM_EXTERN ScmObj Scm_Modulo(ScmObj arg1, ScmObj arg2, int remainder);
2171
2172 SCM_EXTERN ScmObj Scm_Expt(ScmObj x, ScmObj y);
2173
2174 SCM_EXTERN int Scm_NumEq(ScmObj x, ScmObj y);
2175 SCM_EXTERN int Scm_NumCmp(ScmObj x, ScmObj y);
2176 SCM_EXTERN void Scm_MinMax(ScmObj arg0, ScmObj args, ScmObj *min, ScmObj *max);
2177
2178 SCM_EXTERN ScmObj Scm_LogAnd(ScmObj x, ScmObj y);
2179 SCM_EXTERN ScmObj Scm_LogIor(ScmObj x, ScmObj y);
2180 SCM_EXTERN ScmObj Scm_LogXor(ScmObj x, ScmObj y);
2181 SCM_EXTERN ScmObj Scm_LogNot(ScmObj x);
2182 SCM_EXTERN int Scm_LogTest(ScmObj x, ScmObj y);
2183 SCM_EXTERN int Scm_LogBit(ScmObj x, int bit);
2184 SCM_EXTERN ScmObj Scm_Ash(ScmObj x, int cnt);
2185
2186 enum {
2187 SCM_ROUND_FLOOR,
2188 SCM_ROUND_CEIL,
2189 SCM_ROUND_TRUNC,
2190 SCM_ROUND_ROUND
2191 };
2192 SCM_EXTERN ScmObj Scm_Round(ScmObj num, int mode);
2193
2194 SCM_EXTERN ScmObj Scm_Magnitude(ScmObj z);
2195 SCM_EXTERN ScmObj Scm_Angle(ScmObj z);
2196
2197 SCM_EXTERN ScmObj Scm_NumberToString(ScmObj num, int radix, int use_upper);
2198 SCM_EXTERN ScmObj Scm_StringToNumber(ScmString *str, int radix, int strict);
2199
2200 SCM_EXTERN void Scm_PrintDouble(ScmPort *port, double d, int flags);
2201
2202 /*--------------------------------------------------------
2203 * PROCEDURE (APPLICABLE OBJECT)
2204 */
2205
2206
2207 typedef ScmObj (*ScmTransformerProc)(ScmObj self, ScmObj form, ScmObj env,
2208 void *data);
2209
2210 /* Base structure */
2211 struct ScmProcedureRec {
2212 SCM_INSTANCE_HEADER;
2213 unsigned char required; /* # of required args */
2214 unsigned char optional; /* 1 if it takes rest args */
2215 unsigned char type; /* procedure type */
2216 unsigned char locked; /* setter locked? */
2217 ScmObj info; /* source code info */
2218 ScmObj setter; /* setter, if exists. */
2219 ScmObj inliner; /* inliner. NB: for backward compatibility,
2220 this may be initialized by NULL. */
2221 };
2222
2223 /* procedure type */
2224 enum {
2225 SCM_PROC_SUBR,
2226 SCM_PROC_CLOSURE,
2227 SCM_PROC_GENERIC,
2228 SCM_PROC_METHOD,
2229 SCM_PROC_NEXT_METHOD
2230 };
2231
2232 #define SCM_PROCEDURE(obj) ((ScmProcedure*)(obj))
2233 #define SCM_PROCEDURE_REQUIRED(obj) SCM_PROCEDURE(obj)->required
2234 #define SCM_PROCEDURE_OPTIONAL(obj) SCM_PROCEDURE(obj)->optional
2235 #define SCM_PROCEDURE_TYPE(obj) SCM_PROCEDURE(obj)->type
2236 #define SCM_PROCEDURE_INFO(obj) SCM_PROCEDURE(obj)->info
2237 #define SCM_PROCEDURE_SETTER(obj) SCM_PROCEDURE(obj)->setter
2238 #define SCM_PROCEDURE_INLINER(obj) SCM_PROCEDURE(obj)->inliner
2239
2240 SCM_CLASS_DECL(Scm_ProcedureClass);
2241 #define SCM_CLASS_PROCEDURE (&Scm_ProcedureClass)
2242 #define SCM_PROCEDUREP(obj) \
2243 (SCM_HOBJP(obj) && SCM_CLASS_APPLICABLE_P(SCM_CLASS_OF(obj)))
2244 #define SCM_PROCEDURE_TAKE_NARG_P(obj, narg) \
2245 (SCM_PROCEDUREP(obj)&& \
2246 ( (!SCM_PROCEDURE_OPTIONAL(obj)&&SCM_PROCEDURE_REQUIRED(obj)==(narg)) \
2247 ||(SCM_PROCEDURE_OPTIONAL(obj)&&SCM_PROCEDURE_REQUIRED(obj)<=(narg))))
2248 #define SCM_PROCEDURE_THUNK_P(obj) \
2249 (SCM_PROCEDUREP(obj)&& \
2250 ( (!SCM_PROCEDURE_OPTIONAL(obj)&&SCM_PROCEDURE_REQUIRED(obj)==0) \
2251 ||(SCM_PROCEDURE_OPTIONAL(obj))))
2252 #define SCM_PROCEDURE_INIT(obj, req, opt, typ, inf) \
2253 SCM_PROCEDURE(obj)->required = req, \
2254 SCM_PROCEDURE(obj)->optional = opt, \
2255 SCM_PROCEDURE(obj)->type = typ, \
2256 SCM_PROCEDURE(obj)->info = inf, \
2257 SCM_PROCEDURE(obj)->setter = SCM_FALSE, \
2258 SCM_PROCEDURE(obj)->inliner = SCM_FALSE
2259
2260 #define SCM__PROCEDURE_INITIALIZER(klass, req, opt, typ, inf, inl) \
2261 { { klass }, (req), (opt), (typ), FALSE, (inf), SCM_FALSE, (inl) }
2262
2263 /* Closure - Scheme defined procedure */
2264 struct ScmClosureRec {
2265 ScmProcedure common;
2266 ScmObj code; /* compiled code */
2267 ScmEnvFrame *env; /* environment */
2268 };
2269
2270 #define SCM_CLOSUREP(obj) \
2271 (SCM_PROCEDUREP(obj)&&(SCM_PROCEDURE_TYPE(obj)==SCM_PROC_CLOSURE))
2272 #define SCM_CLOSURE(obj) ((ScmClosure*)(obj))
2273
2274 SCM_EXTERN ScmObj Scm_MakeClosure(ScmObj code, ScmEnvFrame *env);
2275
2276 /* Subr - C defined procedure */
2277 struct ScmSubrRec {
2278 ScmProcedure common;
2279 ScmObj (*func)(ScmObj *, int, void*);
2280 void *data;
2281 };
2282
2283 #define SCM_SUBRP(obj) \
2284 (SCM_PROCEDUREP(obj)&&(SCM_PROCEDURE_TYPE(obj)==SCM_PROC_SUBR))
2285 #define SCM_SUBR(obj) ((ScmSubr*)(obj))
2286 #define SCM_SUBR_FUNC(obj) SCM_SUBR(obj)->func
2287 #define SCM_SUBR_DATA(obj) SCM_SUBR(obj)->data
2288
2289 #define SCM_DEFINE_SUBR(cvar, req, opt, inf, func, inliner, data) \
2290 ScmSubr cvar = { \
2291 SCM__PROCEDURE_INITIALIZER(SCM_CLASS2TAG(SCM_CLASS_PROCEDURE), \
2292 req, opt, SCM_PROC_SUBR, inf, inliner), \
2293 (func), (data) \
2294 }
2295
2296 SCM_EXTERN ScmObj Scm_MakeSubr(ScmObj (*func)(ScmObj*, int, void*),
2297 void *data,
2298 int required, int optional,
2299 ScmObj info);
2300 SCM_EXTERN ScmObj Scm_NullProc(void);
2301
2302 SCM_EXTERN ScmObj Scm_SetterSet(ScmProcedure *proc, ScmProcedure *setter,
2303 int lock);
2304 SCM_EXTERN ScmObj Scm_Setter(ScmObj proc);
2305 SCM_EXTERN int Scm_HasSetter(ScmObj proc);
2306
2307 /* Generic - Generic function */
2308 struct ScmGenericRec {
2309 ScmProcedure common;
2310 ScmObj methods;
2311 ScmObj (*fallback)(ScmObj *args, int nargs, ScmGeneric *gf);
2312 void *data;
2313 ScmInternalMutex lock;
2314 };
2315
2316 SCM_CLASS_DECL(Scm_GenericClass);
2317 #define SCM_CLASS_GENERIC (&Scm_GenericClass)
2318 #define SCM_GENERICP(obj) SCM_XTYPEP(obj, SCM_CLASS_GENERIC)
2319 #define SCM_GENERIC(obj) ((ScmGeneric*)obj)
2320 #define SCM_GENERIC_DATA(obj) (SCM_GENERIC(obj)->data)
2321
2322 #define SCM_DEFINE_GENERIC(cvar, cfunc, data) \
2323 ScmGeneric cvar = { \
2324 SCM__PROCEDURE_INITIALIZER(SCM_CLASS2TAG(SCM_CLASS_GENERIC), \
2325 0, 0, SCM_PROC_GENERIC, SCM_FALSE, \
2326 NULL), \
2327 SCM_NIL, cfunc, data \
2328 }
2329
2330 SCM_EXTERN void Scm_InitBuiltinGeneric(ScmGeneric *gf, const char *name,
2331 ScmModule *mod);
2332 SCM_EXTERN ScmObj Scm_MakeBaseGeneric(ScmObj name,
2333 ScmObj (*fallback)(ScmObj *, int, ScmGeneric*),
2334 void *data);
2335 SCM_EXTERN ScmObj Scm_NoNextMethod(ScmObj *args, int nargs, ScmGeneric *gf);
2336 SCM_EXTERN ScmObj Scm_NoOperation(ScmObj *args, int nargs, ScmGeneric *gf);
2337 SCM_EXTERN ScmObj Scm_InvalidApply(ScmObj *args, int nargs, ScmGeneric *gf);
2338
2339 /* Method - method
2340 A method can be defined either by C or by Scheme. C-defined method
2341 have func ptr, with optional data. Scheme-define method has NULL
2342 in func, code in data, and optional environment in env. */
2343 struct ScmMethodRec {
2344 ScmProcedure common;
2345 ScmGeneric *generic;
2346 ScmClass **specializers; /* array of specializers, size==required */
2347 ScmObj (*func)(ScmNextMethod *nm, ScmObj *args, int nargs, void * data);
2348 void *data; /* closure, or code */
2349 ScmEnvFrame *env; /* environment (for Scheme created method) */
2350 };
2351
2352 SCM_CLASS_DECL(Scm_MethodClass);
2353 #define SCM_CLASS_METHOD (&Scm_MethodClass)
2354 #define SCM_METHODP(obj) SCM_ISA(obj, SCM_CLASS_METHOD)
2355 #define SCM_METHOD(obj) ((ScmMethod*)obj)
2356
2357 #define SCM_DEFINE_METHOD(cvar, gf, req, opt, specs, func, data) \
2358 ScmMethod cvar = { \
2359 SCM__PROCEDURE_INITIALIZER(SCM_CLASS2TAG(SCM_CLASS_METHOD), \
2360 req, opt, SCM_PROC_METHOD, \
2361 SCM_FALSE, NULL), \
2362 gf, specs, func, data, NULL \
2363 }
2364
2365 SCM_EXTERN void Scm_InitBuiltinMethod(ScmMethod *m);
2366
2367 /* Next method object
2368 Next method is just another callable entity, with memoizing
2369 the arguments. */
2370 struct ScmNextMethodRec {
2371 ScmProcedure common;
2372 ScmGeneric *generic;
2373 ScmObj methods; /* list of applicable methods */
2374 ScmObj *args; /* original arguments */
2375 int nargs; /* # of original arguments */
2376 };
2377
2378 SCM_CLASS_DECL(Scm_NextMethodClass);
2379 #define SCM_CLASS_NEXT_METHOD (&Scm_NextMethodClass)
2380 #define SCM_NEXT_METHODP(obj) SCM_XTYPEP(obj, SCM_CLASS_NEXT_METHOD)
2381 #define SCM_NEXT_METHOD(obj) ((ScmNextMethod*)obj)
2382
2383 /* Other APIs */
2384 SCM_EXTERN ScmObj Scm_ForEach1(ScmObj proc, ScmObj args);
2385 SCM_EXTERN ScmObj Scm_ForEach(ScmObj proc, ScmObj arg1, ScmObj args);
2386 SCM_EXTERN ScmObj Scm_Map1(ScmObj proc, ScmObj args);
2387 SCM_EXTERN ScmObj Scm_Map(ScmObj proc, ScmObj arg1, ScmObj args);
2388
2389 /*--------------------------------------------------------
2390 * MACROS AND SYNTAX
2391 */
2392
2393 /* Syntax is a built-in procedure to compile given form. */
2394 struct ScmSyntaxRec {
2395 SCM_HEADER;
2396 ScmSymbol *name; /* for debugging */
2397 ScmObj handler; /* syntax handler. (Sexpr, Env) -> IForm */
2398 };
2399
2400 #define SCM_SYNTAX(obj) ((ScmSyntax*)(obj))
2401 #define SCM_SYNTAXP(obj) SCM_XTYPEP(obj, SCM_CLASS_SYNTAX)
2402
2403 SCM_CLASS_DECL(Scm_SyntaxClass);
2404 #define SCM_CLASS_SYNTAX (&Scm_SyntaxClass)
2405
2406 SCM_EXTERN ScmObj Scm_MakeSyntax(ScmSymbol *name, ScmObj handler);
2407
2408 /* Macro */
2409 struct ScmMacroRec {
2410 SCM_HEADER;
2411 ScmSymbol *name; /* for debug */
2412 ScmTransformerProc transformer; /* (Self, Sexpr, Env) -> Sexpr */
2413 void *data;
2414 };
2415
2416 #define SCM_MACRO(obj) ((ScmMacro*)(obj))
2417 #define SCM_MACROP(obj) SCM_XTYPEP(obj, SCM_CLASS_MACRO)
2418
2419 SCM_CLASS_DECL(Scm_MacroClass);
2420 #define SCM_CLASS_MACRO (&Scm_MacroClass)
2421
2422 SCM_EXTERN ScmObj Scm_MakeMacro(ScmSymbol *name,
2423 ScmTransformerProc transformer,
2424 void *data);
2425
2426 SCM_EXTERN ScmObj Scm_VMMacroExpand(ScmObj expr, ScmObj env, int oncep);
2427
2428 /*--------------------------------------------------------
2429 * PROMISE
2430 */
2431
2432 struct ScmPromiseRec {
2433 SCM_HEADER;
2434 ScmObj kind; /* promise kind */
2435 struct ScmPromiseContentRec *content; /* opaque */
2436 };
2437
2438 SCM_CLASS_DECL(Scm_PromiseClass);
2439 #define SCM_CLASS_PROMISE (&Scm_PromiseClass)
2440 #define SCM_PROMISE(obj) ((ScmPromise*)(obj))
2441 #define SCM_PROMISEP(obj) SCM_XTYPEP(obj, SCM_CLASS_PROMISE)
2442
2443 SCM_EXTERN ScmObj Scm_MakePromise(int forced, ScmObj code);
2444 SCM_EXTERN ScmObj Scm_Force(ScmObj p);
2445
2446 /*--------------------------------------------------------
2447 * CONDITION
2448 */
2449
2450 /* Condition classes are defined in a separate file */
2451 #include <gauche/exception.h>
2452
2453 /* 'reason' flag for Scm_PortError */
2454 enum {
2455 SCM_PORT_ERROR_INPUT,
2456 SCM_PORT_ERROR_OUTPUT,
2457 SCM_PORT_ERROR_CLOSED,
2458 SCM_PORT_ERROR_UNIT,
2459 SCM_PORT_ERROR_OTHER
2460 };
2461
2462 /* Throwing error */
2463 SCM_EXTERN void Scm_Error(const char *msg, ...);
2464 SCM_EXTERN void Scm_SysError(const char *msg, ...);
2465 SCM_EXTERN void Scm_PortError(ScmPort *port, int reason, const char *msg, ...);
2466
2467 SCM_EXTERN void Scm_Warn(const char *msg, ...);
2468 SCM_EXTERN void Scm_FWarn(ScmString *fmt, ScmObj args);
2469
2470 SCM_EXTERN ScmObj Scm_Raise(ScmObj exception);
2471 SCM_EXTERN ScmObj Scm_RaiseCondition(ScmObj conditionType, ...);
2472
2473 /* A marker to insert between key-value pair and formatting string
2474 in Scm_RaiseCondition. */
2475 #define SCM_RAISE_CONDITION_MESSAGE ((const char *)1)
2476
2477 SCM_EXTERN int Scm_ConditionHasType(ScmObj c, ScmObj k);
2478 SCM_EXTERN ScmObj Scm_ConditionMessage(ScmObj c);
2479 SCM_EXTERN ScmObj Scm_ConditionTypeName(ScmObj c);
2480
2481 enum {
2482 /* predefined stack trace formats. EXPERIMENTAL. */
2483 SCM_STACK_TRACE_FORMAT_ORIGINAL, /* original format */
2484 SCM_STACK_TRACE_FORMAT_CC /* compiler-message-like format */
2485 };
2486
2487 SCM_EXTERN void Scm_ShowStackTrace(ScmPort *out, ScmObj stacklite,
2488 int maxdepth, int skip, int offset,
2489 int format);
2490
2491 SCM_EXTERN void Scm_ReportError(ScmObj e);
2492
2493 /*--------------------------------------------------------
2494 * REGEXP
2495 */
2496
2497 struct ScmRegexpRec {
2498 SCM_HEADER;
2499 ScmString *pattern;
2500 const unsigned char *code;
2501 int numGroups;
2502 int numCodes;
2503 ScmCharSet **sets;
2504 int numSets;
2505 int flags;
2506 ScmString *mustMatch;
2507 };
2508
2509 SCM_CLASS_DECL(Scm_RegexpClass);
2510 #define SCM_CLASS_REGEXP (&Scm_RegexpClass)
2511 #define SCM_REGEXP(obj) ((ScmRegexp*)obj)
2512 #define SCM_REGEXPP(obj) SCM_XTYPEP(obj, SCM_CLASS_REGEXP)
2513
2514 /* flags */
2515 #define SCM_REGEXP_CASE_FOLD (1L<<0)
2516 #define SCM_REGEXP_PARSE_ONLY (1L<<1)
2517
2518 SCM_EXTERN ScmObj Scm_RegComp(ScmString *pattern, int flags);
2519 SCM_EXTERN ScmObj Scm_RegCompFromAST(ScmObj ast);
2520 SCM_EXTERN ScmObj Scm_RegOptimizeAST(ScmObj ast);
2521 SCM_EXTERN ScmObj Scm_RegExec(ScmRegexp *rx, ScmString *input);
2522 SCM_EXTERN void Scm_RegDump(ScmRegexp *rx);
2523
2524 struct ScmRegMatchRec {
2525 SCM_HEADER;
2526 const char *input;
2527 int inputSize;
2528 int inputLen;
2529 int numMatches;
2530 struct ScmRegMatchSub {
2531 int start;
2532 int length;
2533 const char *startp;
2534 const char *endp;
2535 } *matches;
2536 };
2537
2538 SCM_CLASS_DECL(Scm_RegMatchClass);
2539 #define SCM_CLASS_REGMATCH (&Scm_RegMatchClass)
2540 #define SCM_REGMATCH(obj) ((ScmRegMatch*)obj)
2541 #define SCM_REGMATCHP(obj) SCM_XTYPEP(obj, SCM_CLASS_REGMATCH)
2542
2543 SCM_EXTERN ScmObj Scm_RegMatchSubstr(ScmRegMatch *rm, int i);
2544 SCM_EXTERN ScmObj Scm_RegMatchStart(ScmRegMatch *rm, int i);
2545 SCM_EXTERN ScmObj Scm_RegMatchEnd(ScmRegMatch *rm, int i);
2546 SCM_EXTERN ScmObj Scm_RegMatchAfter(ScmRegMatch *rm, int i);
2547 SCM_EXTERN ScmObj Scm_RegMatchBefore(ScmRegMatch *rm, int i);
2548 SCM_EXTERN void Scm_RegMatchDump(ScmRegMatch *match);
2549
2550 /*-------------------------------------------------------
2551 * STUB MACROS
2552 */
2553 #define SCM_ENTER_SUBR(name)
2554
2555 #define SCM_ARGREF(count) (SCM_FP[count])
2556 #define SCM_RETURN(value) return value
2557 #define SCM_CURRENT_MODULE() (Scm_VM()->module)
2558 #define SCM_VOID_RETURN_VALUE(expr) ((void)(expr), SCM_UNDEFINED)
2559
2560 #define SCM_MAYBE_P(pred, obj) (SCM_FALSEP(obj)||(pred(obj)))
2561 #define SCM_MAYBE(unboxer, obj) (SCM_FALSEP(obj)?NULL:(unboxer(obj)))
2562 #define SCM_MAKE_MAYBE(boxer, obj) ((obj)?(boxer(obj)):SCM_FALSE)
2563
2564 /*---------------------------------------------------
2565 * SIGNAL
2566 */
2567
2568 typedef struct ScmSysSigsetRec {
2569 SCM_HEADER;
2570 sigset_t set;
2571 } ScmSysSigset;
2572
2573 SCM_CLASS_DECL(Scm_SysSigsetClass);
2574 #define SCM_CLASS_SYS_SIGSET (&Scm_SysSigsetClass)
2575 #define SCM_SYS_SIGSET(obj) ((ScmSysSigset*)(obj))
2576 #define SCM_SYS_SIGSET_P(obj) SCM_XTYPEP(obj, SCM_CLASS_SYS_SIGSET)
2577
2578 SCM_EXTERN ScmObj Scm_SysSigsetOp(ScmSysSigset*, ScmObj, int);
2579 SCM_EXTERN ScmObj Scm_SysSigsetFill(ScmSysSigset*, int);
2580 SCM_EXTERN ScmObj Scm_GetSignalHandler(int);
2581 SCM_EXTERN ScmObj Scm_GetSignalHandlers(void);
2582 SCM_EXTERN ScmObj Scm_SetSignalHandler(ScmObj, ScmObj);
2583 SCM_EXTERN ScmObj Scm_SysSigmask(int how, ScmSysSigset *newmask);
2584 SCM_EXTERN ScmObj Scm_Pause(void);
2585 SCM_EXTERN ScmObj Scm_SigSuspend(ScmSysSigset *mask);
2586 SCM_EXTERN sigset_t Scm_GetMasterSigmask(void);
2587 SCM_EXTERN void Scm_SetMasterSigmask(sigset_t *set);
2588 SCM_EXTERN ScmObj Scm_SignalName(int signum);
2589
2590 /*---------------------------------------------------
2591 * SYSTEM
2592 */
2593
2594 SCM_EXTERN off_t Scm_IntegerToOffset(ScmObj i);
2595 SCM_EXTERN ScmObj Scm_OffsetToInteger(off_t o);
2596
2597 /* System call wrapper */
2598 #define SCM_SYSCALL3(result, expr, check) \
2599 do { \
2600 (result) = (expr); \
2601 if ((check) && errno == EINTR) { \
2602 ScmVM *vm__ = Scm_VM(); \
2603 errno = 0; \
2604 SCM_SIGCHECK(vm__); \
2605 } else { \
2606 break; \
2607 } \
2608 } while (1)
2609
2610 #define SCM_SYSCALL(result, expr) \
2611 SCM_SYSCALL3(result, expr, (result < 0))
2612
2613 SCM_EXTERN int Scm_GetPortFd(ScmObj port_or_fd, int needfd);
2614
2615 SCM_EXTERN ScmObj Scm_ReadDirectory(ScmString *pathname);
2616 SCM_EXTERN ScmObj Scm_GlobDirectory(ScmString *pattern);
2617
2618 #define SCM_PATH_ABSOLUTE (1L<<0)
2619 #define SCM_PATH_EXPAND (1L<<1)
2620 #define SCM_PATH_CANONICALIZE (1L<<2)
2621 #define SCM_PATH_FOLLOWLINK (1L<<3) /* not supported yet */
2622 SCM_EXTERN ScmObj Scm_NormalizePathname(ScmString *pathname, int flags);
2623 SCM_EXTERN ScmObj Scm_DirName(ScmString *filename);
2624 SCM_EXTERN ScmObj Scm_BaseName(ScmString *filename);
2625
2626 /* struct stat */
2627 typedef struct ScmSysStatRec {
2628 SCM_HEADER;
2629 struct stat statrec;
2630 } ScmSysStat;
2631
2632 SCM_CLASS_DECL(Scm_SysStatClass);
2633 #define SCM_CLASS_SYS_STAT (&Scm_SysStatClass)
2634 #define SCM_SYS_STAT(obj) ((ScmSysStat*)(obj))
2635 #define SCM_SYS_STAT_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_SYS_STAT))
2636
2637 SCM_EXTERN ScmObj Scm_MakeSysStat(void); /* returns empty SysStat */
2638
2639 /* time_t
2640 * NB: POSIX defines time_t to be a type to represent number of seconds
2641 * since Epoch. It may be a structure. In Gauche we just convert it
2642 * to a number.
2643 */
2644 SCM_EXTERN ScmObj Scm_MakeSysTime(time_t time);
2645 SCM_EXTERN time_t Scm_GetSysTime(ScmObj val);
2646
2647 /* Gauche also has a <time> object, as specified in SRFI-18, SRFI-19
2648 * and SRFI-21. It can be constructed from the basic system interface
2649 * such as sys-time or sys-gettimeofday.
2650 */
2651 typedef struct ScmTimeRec {
2652 SCM_HEADER;
2653 ScmObj type; /* 'time-utc by default. see SRFI-19 */
2654 long sec; /* seconds */
2655 long nsec; /* nanoseconds */
2656 } ScmTime;
2657
2658 SCM_CLASS_DECL(Scm_TimeClass);
2659 #define SCM_CLASS_TIME (&Scm_TimeClass)
2660 #define SCM_TIME(obj) ((ScmTime*)obj)
2661 #define SCM_TIMEP(obj) SCM_XTYPEP(obj, SCM_CLASS_TIME)
2662
2663 SCM_EXTERN ScmObj Scm_CurrentTime(void);
2664 SCM_EXTERN ScmObj Scm_MakeTime(ScmObj type, long sec, long nsec);
2665 SCM_EXTERN ScmObj Scm_IntSecondsToTime(long sec);
2666 SCM_EXTERN ScmObj Scm_RealSecondsToTime(double sec);
2667 SCM_EXTERN ScmObj Scm_TimeToSeconds(ScmTime *t);
2668 #if defined(HAVE_STRUCT_TIMESPEC) || defined(GAUCHE_USE_PTHREADS)
2669 SCM_EXTERN struct timespec *Scm_GetTimeSpec(ScmObj t, struct timespec *spec);
2670 #endif /*HAVE_STRUCT_TIMESPEC||GAUCHE_USE_PTHREADS*/
2671
2672 /* struct tm */
2673 typedef struct ScmSysTmRec {
2674 SCM_HEADER;
2675 struct tm tm;
2676 } ScmSysTm;
2677
2678 SCM_CLASS_DECL(Scm_SysTmClass);
2679 #define SCM_CLASS_SYS_TM (&Scm_SysTmClass)
2680 #define SCM_SYS_TM(obj) ((ScmSysTm*)(obj))
2681 #define SCM_SYS_TM_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_SYS_TM))
2682 #define SCM_SYS_TM_TM(obj) SCM_SYS_TM(obj)->tm
2683
2684 SCM_EXTERN ScmObj Scm_MakeSysTm(struct tm *);
2685
2686 /* struct group */
2687 typedef struct ScmSysGroupRec {
2688 SCM_HEADER;
2689 ScmObj name;
2690 ScmObj gid;
2691 ScmObj passwd;
2692 ScmObj mem;
2693 } ScmSysGroup;
2694
2695 SCM_CLASS_DECL(Scm_SysGroupClass);
2696 #define SCM_CLASS_SYS_GROUP (&Scm_SysGroupClass)
2697 #define SCM_SYS_GROUP(obj) ((ScmSysGroup*)(obj))
2698 #define SCM_SYS_GROUP_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_SYS_GROUP))
2699
2700 SCM_EXTERN ScmObj Scm_GetGroupById(gid_t gid);
2701 SCM_EXTERN ScmObj Scm_GetGroupByName(ScmString *name);
2702
2703 /* struct passwd */
2704 typedef struct ScmSysPasswdRec {
2705 SCM_HEADER;
2706 ScmObj name;
2707 ScmObj passwd;
2708 ScmObj uid;
2709 ScmObj gid;
2710 ScmObj gecos;
2711 ScmObj dir;
2712 ScmObj shell;
2713 ScmObj pwclass;
2714 } ScmSysPasswd;
2715
2716 SCM_CLASS_DECL(Scm_SysPasswdClass);
2717 #define SCM_CLASS_SYS_PASSWD (&Scm_SysPasswdClass)
2718 #define SCM_SYS_PASSWD(obj) ((ScmSysPasswd*)(obj))
2719 #define SCM_SYS_PASSWD_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_SYS_PASSWD))
2720
2721 SCM_EXTERN ScmObj Scm_GetPasswdById(uid_t uid);
2722 SCM_EXTERN ScmObj Scm_GetPasswdByName(ScmString *name);
2723
2724 SCM_EXTERN int Scm_IsSugid(void);
2725
2726 SCM_EXTERN ScmObj Scm_SysExec(ScmString *file, ScmObj args,
2727 ScmObj iomap, int forkp);
2728
2729 /* select */
2730 #ifdef HAVE_SELECT
2731 typedef struct ScmSysFdsetRec {
2732 SCM_HEADER;
2733 int maxfd;
2734 fd_set fdset;
2735 } ScmSysFdset;
2736
2737 SCM_CLASS_DECL(Scm_SysFdsetClass);
2738 #define SCM_CLASS_SYS_FDSET (&Scm_SysFdsetClass)
2739 #define SCM_SYS_FDSET(obj) ((ScmSysFdset*)(obj))
2740 #define SCM_SYS_FDSET_P(obj) (SCM_XTYPEP(obj, SCM_CLASS_SYS_FDSET))
2741
2742 SCM_EXTERN ScmObj Scm_SysSelect(ScmObj rfds, ScmObj wfds, ScmObj efds,
2743 ScmObj timeout);
2744 SCM_EXTERN ScmObj Scm_SysSelectX(ScmObj rfds, ScmObj wfds, ScmObj efds,
2745 ScmObj timeout);
2746 #else /*!HAVE_SELECT*/
2747 /* dummy definitions */
2748 typedef struct ScmHeaderRec ScmSysFdset;
2749 #define SCM_SYS_FDSET(obj) (obj)
2750 #define SCM_SYS_FDSET_P(obj) (FALSE)
2751 #endif /*!HAVE_SELECT*/
2752
2753 /* other stuff */
2754 SCM_EXTERN int Scm_Mkstemp(char *tmpl);
2755 SCM_EXTERN ScmObj Scm_SysMkstemp(ScmString *tmpl);
2756
2757 /*---------------------------------------------------
2758 * LOAD AND DYNAMIC LINK
2759 */
2760
2761 /* Flags for Scm_VMLoad and Scm_Load. (not for Scm_VMLoadPort) */
2762 enum ScmLoadFlags {
2763 SCM_LOAD_QUIET_NOFILE = (1L<<0), /* do not signal an error if the file
2764 does not exist; just return #f. */
2765 SCM_LOAD_IGNORE_CODING = (1L<<1) /* do not use coding-aware port to honor
2766 'coding' magic comment */
2767 };
2768
2769 SCM_EXTERN ScmObj Scm_VMLoadFromPort(ScmPort *port, ScmObj next_paths,
2770 ScmObj env, int flags);
2771 SCM_EXTERN ScmObj Scm_VMLoad(ScmString *file, ScmObj paths, ScmObj env,
2772 int flags);
2773 SCM_EXTERN void Scm_LoadFromPort(ScmPort *port, int flags);
2774 SCM_EXTERN int Scm_Load(const char *file, int flags);
2775
2776 SCM_EXTERN ScmObj Scm_GetLoadPath(void);
2777 SCM_EXTERN ScmObj Scm_AddLoadPath(const char *cpath, int afterp);
2778
2779 SCM_EXTERN ScmObj Scm_DynLoad(ScmString *path, ScmObj initfn, int export_);
2780
2781 SCM_EXTERN ScmObj Scm_Require(ScmObj feature);
2782 SCM_EXTERN ScmObj Scm_Provide(ScmObj feature);
2783 SCM_EXTERN int Scm_ProvidedP(ScmObj feature);
2784
2785 struct ScmAutoloadRec {
2786 SCM_HEADER;
2787 ScmSymbol *name; /* variable to be autoloaded */
2788 ScmModule *module; /* where the binding should be inserted.
2789 this is where autoload is defined. */
2790 ScmString *path; /* file to load */
2791 ScmSymbol *import_from; /* module to be imported after loading */
2792 ScmModule *import_to; /* module to where import_from should be
2793 imported */
2794 /* The fields above will be set up when
2795 the autoload object is created, and never
2796 be modified. */
2797
2798 int loaded; /* The flag that indicates this autoload
2799 is resolved, and value field contains
2800 the resolved value. Once the autoload
2801 goes into "loaded" status, no field
2802 should be changed. */
2803 ScmObj value; /* The resolved value */
2804 ScmInternalMutex mutex; /* mutex to resolve this autoload */
2805 ScmInternalCond cv; /* ... and condition variable. */
2806 ScmVM *locker; /* The thread that is resolving the autoload.*/
2807 };
2808
2809 SCM_CLASS_DECL(Scm_AutoloadClass);
2810 #define SCM_CLASS_AUTOLOAD (&Scm_AutoloadClass)
2811 #define SCM_AUTOLOADP(obj) SCM_XTYPEP(obj, SCM_CLASS_AUTOLOAD)
2812 #define SCM_AUTOLOAD(obj) ((ScmAutoload*)(obj))
2813
2814 SCM_EXTERN ScmObj Scm_MakeAutoload(ScmModule *where,
2815 ScmSymbol *name, ScmString *path,
2816 ScmSymbol *import_from);
2817 SCM_EXTERN void Scm_DefineAutoload(ScmModule *where, ScmObj file_or_module,
2818 ScmObj list);
2819 SCM_EXTERN ScmObj Scm_LoadAutoload(ScmAutoload *autoload);
2820
2821 /*---------------------------------------------------
2822 * PROFILER INTERFACE
2823 */
2824
2825 SCM_EXTERN void Scm_ProfilerStart(void);
2826 SCM_EXTERN int Scm_ProfilerStop(void);
2827 SCM_EXTERN void Scm_ProfilerReset(void);
2828
2829 /*---------------------------------------------------
2830 * UTILITY STUFF
2831 */
2832
2833 /* Program start and termination */
2834
2835 SCM_EXTERN void Scm_Init(const char *signature);
2836 SCM_EXTERN void Scm_Cleanup(void);
2837 SCM_EXTERN void Scm_Exit(int code);
2838 SCM_EXTERN void Scm_Abort(const char *msg);
2839 SCM_EXTERN void Scm_Panic(const char *msg, ...);
2840
2841 SCM_EXTERN void Scm_RegisterDL(void *data_start, void *data_end,
2842 void *bss_start, void *bss_end);
2843 SCM_EXTERN void Scm_GCSentinel(void *obj, const char *name);
2844
2845 SCM_EXTERN void *Scm_AddCleanupHandler(void (*proc)(void *data), void *data);
2846 SCM_EXTERN void Scm_DeleteCleanupHandler(void *handle);
2847
2848 /* repl */
2849 SCM_EXTERN void Scm_Repl(ScmObj reader, ScmObj evaluator, ScmObj printer,
2850 ScmObj prompter);
2851
2852 /* Inspect the configuration */
2853 SCM_EXTERN const char *Scm_HostArchitecture(void);
2854
2855 SCM_EXTERN ScmObj Scm_LibraryDirectory(void);
2856 SCM_EXTERN ScmObj Scm_ArchitectureDirectory(void);
2857 SCM_EXTERN ScmObj Scm_SiteLibraryDirectory(void);
2858 SCM_EXTERN ScmObj Scm_SiteArchitectureDirectory(void);
2859
2860 /* Compare and Sort */
2861 SCM_EXTERN int Scm_Compare(ScmObj x, ScmObj y);
2862 SCM_EXTERN void Scm_SortArray(ScmObj *elts, int nelts, ScmObj cmpfn);
2863 SCM_EXTERN ScmObj Scm_SortList(ScmObj objs, ScmObj fn);
2864 SCM_EXTERN ScmObj Scm_SortListX(ScmObj objs, ScmObj fn);
2865
2866 /* Assertion */
2867
2868 #ifdef GAUCHE_RECKLESS
2869 #define SCM_ASSERT(expr) /* nothing */
2870 #else
2871
2872 #ifdef __GNUC__
2873
2874 #define SCM_ASSERT(expr) \
2875 do { \
2876 if (!(expr)) \
2877 Scm_Panic("\"%s\", line %d (%s): Assertion failed: %s", \
2878 __FILE__, __LINE__, __PRETTY_FUNCTION__, #expr); \
2879 } while (0)
2880
2881 #else
2882
2883 #define SCM_ASSERT(expr) \
2884 do { \
2885 if (!(expr)) \
2886 Scm_Panic("\"%s\", line %d: Assertion failed: %s", \
2887 __FILE__, __LINE__, #expr); \
2888 } while (0)
2889
2890 #endif /* !__GNUC__ */
2891
2892 #endif /* !GAUCHE_RECKLESS */
2893
2894
2895 SCM_DECL_END
2896
2897 #endif /* GAUCHE_H */