root/src/gauche.h

/* [<][>][^][v][top][bottom][index][help] */

INCLUDED FROM


DEFINITIONS

This source file includes following definitions.
  1. ScmHeader
  2. ScmInstance
  3. ScmForeignPointer
  4. ScmStringBody
  5. ScmDStringChunk
  6. ScmDStringChain
  7. ScmStringPointer
  8. ScmPortBuffer
  9. ScmPortVTable
  10. ScmReadContext
  11. ScmReadReference
  12. ScmWeakVector
  13. ScmHashIter
  14. ScmSysSigset
  15. ScmSysStat
  16. ScmTime
  17. ScmSysTm
  18. ScmSysGroup
  19. ScmSysPasswd
  20. 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 */

/* [<][>][^][v][top][bottom][index][help] */