1 /* 2 * vm.h - Virtual machine 3 * 4 * Copyright (c) 2000-2020 Shiro Kawai <shiro@acm.org> 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 34 #ifndef GAUCHE_VM_H 35 #define GAUCHE_VM_H 36 37 /* Size of stack per VM (in words). */ 38 #define SCM_VM_STACK_SIZE 10000 39 40 /* Maximum # of values allowed for multiple value return */ 41 #define SCM_VM_MAX_VALUES 20 42 43 /* Finalizer queue size */ 44 #define SCM_VM_FINQ_SIZE 32 45 46 #define SCM_PCTYPE ScmWord* 47 48 #if (defined(ITIMER_PROF) && defined(SIGPROF)) || defined(GAUCHE_WINDOWS) 49 /* define if you want to use profiler */ 50 #define GAUCHE_PROFILE 51 #endif /* (defined(ITIMER_PROF) && defined(SIGPROF)) || defined(GAUCHE_WINDOWS) */ 52 53 #ifdef __GNUC__ 54 /* in GNUC, we inline Scm_VMReturnFlonum using statement expressions. */ 55 # if GAUCHE_FFX 56 SCM_EXTERN void Scm_VMFlushFPStack(ScmVM *vm); 57 # define Scm_VMReturnFlonum(_val) \ 58 ({ ScmVM *vm__ = Scm_VM(); ScmFlonum *fp; \ 59 if (vm__->fpsp == vm__->fpstackEnd) Scm_VMFlushFPStack(vm__);\ 60 fp = vm__->fpsp++; \ 61 SCM_FLONUM_VALUE(fp) = (_val); \ 62 SCM_MAKE_FLONUM_REG(fp); \ 63 }) 64 # else /* !GAUCHE_FFX */ 65 # define Scm_VMReturnFlonum(val) Scm_MakeFlonum(val) 66 # endif /* !GAUCHE_FFX */ 67 #else /* !__GNUC__ */ 68 # define Scm_VMReturnFlonum(val) Scm_MakeFlonum(val) 69 #endif /* !__GNUC__ */ 70 71 /* Actual structure is defined in code.h */ 72 typedef struct ScmCompiledCodeRec ScmCompiledCode; 73 74 /* Actual structure is defined in priv/vmP.h */ 75 typedef struct ScmCallTraceRec ScmCallTrace; 76 77 /* Actual structure is defined in priv/parameterP.h */ 78 typedef struct ScmVMParameterTableRec ScmVMParameterTable; 79 80 /* 81 * Environment frame 82 * 83 * : : 84 * +--------+ 85 * | size=N | 86 * | info | 87 * |...up...|<--- ScmEnvFrame* envp 88 * |arg[N-1]| 89 * |arg[N-2]| 90 * : : 91 * | arg[0] | 92 * +--------+ 93 * : : 94 */ 95 96 typedef struct ScmEnvFrameRec { 97 struct ScmEnvFrameRec *up; /* static link */ 98 ScmObj info; /* reserved */ 99 ScmWord size; /* size of the frame (excluding header) */ 100 } ScmEnvFrame; 101 102 #define ENV_HDR_SIZE 3 /* envframe header size */ 103 #define ENV_SIZE(size) ((size)+ENV_HDR_SIZE) 104 #define ENV_FP(env) (((ScmObj*)(env))-((env)->size)) 105 #define ENV_DATA(env, num) (*(((ScmObj*)(env))-(num)-1)) 106 107 /* 108 * Continuation frame 109 * 110 * Continuation is represented as a chain of ScmContFrames. 111 * 112 * : : 113 * +--------+ 114 * | base | 115 * | pc | 116 * | cpc | 117 * | marker | 118 * | size=N | 119 * | env | 120 * |..prev..|<--- ScmContFrame* cont 121 * |arg[N-1]| 122 * |arg[N-2]| 123 * : : 124 * | arg[0] | 125 * +--------+ 126 * : : 127 * 128 * If env is a special value (&ccEnvMark), this is a C continuation 129 * and pc contains a C function pointer. 130 */ 131 132 typedef struct ScmContFrameRec { 133 struct ScmContFrameRec *prev; /* previous frame */ 134 ScmEnvFrame *env; /* saved environment */ 135 int size; /* size of argument frame */ 136 int marker; /* end marker of partial continuation */ 137 SCM_PCTYPE cpc; /* current PC (for debugging info) */ 138 SCM_PCTYPE pc; /* next PC */ 139 ScmCompiledCode *base; /* base register value */ 140 } ScmContFrame; 141 142 #define CONT_FRAME_SIZE (sizeof(ScmContFrame)/sizeof(ScmObj)) 143 144 SCM_EXTERN void Scm_CallCC(ScmObj body); 145 146 SCM_EXTERN int Scm__VMProtectStack(ScmVM *vm); 147 SCM_EXTERN void Scm__VMUnprotectStack(ScmVM *vm); 148 149 /* 150 * Syntactic closure 151 * 152 * Syntactic closure encapsulates compile-time environment for 153 * hygienic macro expansion. 154 * See Bawden & Rees, Syntactic Closures, MIT AI Memo 1049, June 1988. 155 */ 156 157 typedef struct ScmSyntacticClosureRec { 158 ScmObj env; /* compile-time environment */ 159 ScmObj literals; /* literal symbols */ 160 ScmObj expr; /* expression */ 161 } ScmSyntacticClosure; 162 163 SCM_CLASS_DECL(Scm_SyntacticClosureClass); 164 #define SCM_CLASS_SYNTACTIC_CLOSURE (&Scm_SyntacticClosureClass) 165 166 #define SCM_SYNTACTIC_CLOSURE(obj) ((ScmSyntacticClosure*)(obj)) 167 #define SCM_SYNTACTIC_CLOSURE_P(obj) SCM_XTYPEP(obj, SCM_CLASS_SYNTACTIC_CLOSURE) 168 169 SCM_EXTERN ScmObj Scm_MakeSyntacticClosure(ScmObj env, 170 ScmObj literals, 171 ScmObj expr); 172 173 /* 174 * Identifier 175 * 176 * Identifier wraps a symbol with its lexical environment. This 177 * object is used in hygienic macro expansion (see macro.c), and 178 * also used as a placeholder in a global variable reference/assignment 179 * (see compile.c). 180 * 181 * NB: Identifier's API and usage will likely be changed in future. 182 * It shouldn't be used directly from applications. 183 */ 184 185 /* The definition is in gauche/priv/identifierP.h (hidden) */ 186 typedef struct ScmIdentifierRec ScmIdentifier; 187 188 SCM_CLASS_DECL(Scm_IdentifierClass); 189 #define SCM_CLASS_IDENTIFIER (&Scm_IdentifierClass) 190 191 #define SCM_IDENTIFIER(obj) ((ScmIdentifier*)(obj)) 192 #define SCM_IDENTIFIERP(obj) SCM_XTYPEP(obj, SCM_CLASS_IDENTIFIER) 193 194 /* Create an identifier. 195 NAME can be a symbol or an identifier. 196 MOD is the toplevel module to close; can be NULL to use the current module. 197 ENV is the local local environment (list of frames) to close. */ 198 SCM_EXTERN ScmObj Scm_MakeIdentifier(ScmObj name, 199 ScmModule *mod, 200 ScmObj env); 201 /* Returns the minimal local environment (list of frames) where this 202 identifier is bound. If the identifier isn't bound locally, it would be (). 203 The returned value may not be the same as ENV argument passed to the 204 constructor; we truncate irrelevant frames. */ 205 SCM_EXTERN ScmObj Scm_IdentifierEnv(ScmIdentifier *id); 206 SCM_EXTERN ScmObj Scm_WrapIdentifier(ScmIdentifier *id); 207 SCM_EXTERN int Scm_IdentifierBindingEqv(ScmIdentifier *id, 208 ScmSymbol *sym, 209 ScmObj env); 210 211 SCM_EXTERN ScmIdentifier *Scm_OutermostIdentifier(ScmIdentifier *id); 212 SCM_EXTERN ScmSymbol *Scm_UnwrapIdentifier(ScmIdentifier *id); 213 SCM_EXTERN ScmGloc *Scm_IdentifierGlobalBinding(ScmIdentifier *id); 214 215 /* 216 * Escape handling 217 */ 218 219 /* 220 * C stack record 221 * 222 * A chain of C stack to rewind. C stack is captured by Scm_Sigsetjmp 223 * and rewound by Scm_Siglongjmp; see signal.c. 224 */ 225 typedef struct ScmCStackRec { 226 struct ScmCStackRec *prev; 227 ScmContFrame *cont; 228 sigjmp_buf jbuf; 229 sigset_t mask; 230 } ScmCStack; 231 232 /* ScmEscapePoint definition is in vmP.h */ 233 typedef struct ScmEscapePointRec ScmEscapePoint; 234 235 /* 236 * Signal queue 237 * 238 * Following the Unix tradition, gauche doesn't really queue the signals; 239 * the C-level signal handler only records the fact that a specific 240 * signal has been delivered. VM loop examines the record and invoke 241 * appropriate Scheme-level signal handlers. Even if the same signal 242 * arrives more than one time before VM loop checks the record, the handler 243 * is invoked only once. 244 * 245 * The C-level signal handler does count each signal until it is cleared 246 * by VM loop. If one kind of signal arrives more than a certain limit 247 * (set/get by Scm_{Set|Get}SignalPendingLimit), Gauche thinks something 248 * went wrong and bail out. It is useful, for example, to interrupt 249 * unresponsive program from the terminal. 250 */ 251 252 /* NB: AT least on FreeBSD, RT signals are not counted in NSIG. We should 253 use _SIG_MAXSIG+1 instead to track all signals. */ 254 #if defined(_SIG_MAXSIG) && (_SIG_MAXSIG+1 > NSIG) 255 #define SCM_NSIG (_SIG_MAXSIG+1) 256 #else /*!_SIG_MAXSIG*/ 257 #define SCM_NSIG NSIG 258 #endif /*!_SIG_MAXSIG*/ 259 260 typedef struct ScmSignalQueueRec { 261 union { 262 unsigned char dummy[NSIG]; 263 unsigned char *sigcounts; 264 }; 265 ScmObj pending; /* pending signal handlers */ 266 } ScmSignalQueue; 267 268 SCM_EXTERN void Scm_SignalQueueInit(ScmSignalQueue* q); 269 SCM_EXTERN int Scm_GetSignalPendingLimit(void); 270 SCM_EXTERN void Scm_SetSignalPendingLimit(int val); 271 272 /* NB: Obsoleted macro, but kept for backward compatibility. 273 Better API should be provided in future. */ 274 #define SCM_SIGPENDING(vm) \ 275 ((vm)->queueNotEmpty&SCM_VM_SIGQ_MASK) 276 277 #define SCM_SIGCHECK(vm) \ 278 do { if (vm->signalPending) Scm_SigCheck(vm); } while (0) 279 280 SCM_EXTERN void Scm_SigCheck(ScmVM *vm); 281 282 /* 283 * Finalizers 284 * 285 * Finalizers are queued inside GC. We disable automatic finalizer 286 * invocation of GC and only set the flag on VM when finalizers are 287 * queued. VM loop check the flag and calls Scm_VMFinalizerRun() 288 * to run the finalizers. (If VM is not running, C library must 289 * call it explicitly to run finalizers). 290 */ 291 292 SCM_EXTERN ScmObj Scm_VMFinalizerRun(ScmVM *vm); 293 294 /* 295 * Statistics 296 * 297 * Not much stats are collected yet, but will grow in future. 298 * Stats collections are only active if SCM_COLLECT_VM_STATS 299 * runtime flag is TRUE. 300 * Stats are collected per-VM (i.e. per-thread), but currently 301 * we don't have an API to gather them. 302 */ 303 304 typedef struct ScmVMStatRec { 305 /* Stack overflow handler */ 306 u_long sovCount; /* # of stack overflow */ 307 double sovTime; /* cumulated time of stack ov handling */ 308 309 /* Load statistics chain */ 310 ScmObj loadStat; 311 } ScmVMStat; 312 313 /* The profiler structure is defined in prof.h */ 314 typedef struct ScmVMProfilerRec ScmVMProfiler; 315 316 /* 317 * VM structure 318 * 319 * In Gauche, each thread has a VM. Indeed, the Scheme object 320 * <thread> is ScmVM in C. 321 * 322 * Most fields of VM are private to the thread that owns the VM. 323 * Only the fields marked as "PUBLIC" should be modified by other 324 * thread, and only with obtaining the lock by VMLOCK mutex. 325 * (Note that some fields like "name" and "specific" are not marked 326 * as PUBLIC although they can be referenced or modified by other 327 * thread (via Scheme call thread-specific-set! etc.) It is the 328 * user program's responsibility to use a mutex.) 329 * 330 * When you need inspect other thread's private data (like stack 331 * trace), make the thread is either stopped or terminated, or 332 * you may get inconsistent result. 333 */ 334 335 struct ScmVMRec { 336 SCM_HEADER; 337 ScmInternalThread thread; /* the system thread executing this VM. */ 338 int state; /* thread state. PUBLIC. */ 339 ScmInternalMutex vmlock; /* mutex to be used to lock this VM 340 structure. PUBLIC. */ 341 ScmInternalCond cond; /* the condition variable to wait for state 342 change of this VM. PUBLIC. */ 343 ScmVM *canceller; /* the thread which called thread-terminate! 344 on this thread. PUBLIC. */ 345 ScmVM *inspector; /* the thread which requested to stop this 346 thread. PUBLIC. */ 347 ScmObj name; /* Scheme thread name. */ 348 ScmObj specific; /* Scheme thread specific data. */ 349 ScmProcedure *thunk; /* Entry point of this VM. */ 350 ScmObj result; /* Result of thunk. */ 351 ScmObj resultException; /* Exception that causes the thread to terminate.*/ 352 ScmModule *module; /* current global namespace. note that this 353 is used only in compilation. */ 354 ScmCStack *cstack; /* current escape point. see the comment of 355 "C stack rewinding" below. */ 356 /* TRANSIENT: Change these flags to u_long in 1.0 */ 357 #if GAUCHE_API_VERSION < 1000 358 unsigned int runtimeFlags; /* Runtime flags */ 359 unsigned int compilerFlags; /* Compiler flags */ 360 #else /*GAUCHE_API_VERSION >= 1000*/ 361 u_long runtimeFlags; /* Runtime flags */ 362 u_long compilerFlags; /* Compiler flags */ 363 #endif /*GAUCHE_API_VERSION >= 1000*/ 364 intptr_t attentionRequest; /* Flag if VM needs to check signal queue, 365 finalizer queue, or stop request. 366 This flag can be turned on asynchronously. 367 Only this VM can turn off this flag. */ 368 intptr_t signalPending; /* Flag if there are pending signals. 369 Turned on by sig_handle(), turned off 370 by Scm_SigCheck(), both in signal.c. */ 371 intptr_t finalizerPending; /* Flag if there are pending finalizers. 372 Turned on by finalizable() callback, 373 and turned off by Scm_VMFinalizerRun(), 374 both in core.c */ 375 intptr_t stopRequest; /* Flag if there is a pending stop request. 376 See enum ScmThreadStopRequest below 377 for the possible values. 378 Turned on by Scm_ThreadStop() or 379 Scm_ThreadTerminate in 380 ext/threads/threads.c, and turned off by 381 process_queued_requests() in vm.c */ 382 383 ScmPort *curin; /* current input port */ 384 ScmPort *curout; /* current output port */ 385 ScmPort *curerr; /* current error port */ 386 ScmVMParameterTable *parameters; /* parameter table */ 387 388 /* Registers */ 389 ScmCompiledCode *base; /* Current executing closure's code packet. */ 390 SCM_PCTYPE pc; /* Program pointer. Points into the code 391 vector. (base->code) */ 392 ScmEnvFrame *env; /* Current environment. */ 393 ScmContFrame *cont; /* Current continuation. */ 394 ScmObj *argp; /* Current argument pointer. Points 395 to the incomplete environment frame 396 being accumulated. This is a part of 397 continuation. */ 398 ScmObj val0; /* Value register. */ 399 ScmObj vals[SCM_VM_MAX_VALUES]; /* Value register for multiple values */ 400 int numVals; /* # of values */ 401 402 ScmObj handlers; /* chain of active dynamic handlers */ 403 404 ScmObj *sp; /* stack pointer */ 405 ScmObj *stack; /* bottom of allocated stack area */ 406 ScmObj *stackBase; /* base of current stack area */ 407 ScmObj *stackEnd; /* end of current stack area */ 408 #if GAUCHE_SPLIT_STACK 409 /* EXPERIMENTAL: Save the continuation when an error occurs, used for 410 better error diagnostics. Reset by the "cross the border" APIs 411 such as Scm_Eval(). This can point into the stack, but must be 412 saved when save_cont() is called. 413 */ 414 ScmContFrame *lastErrorCont; 415 #endif /*GAUCHE_SPLIT_STACK*/ 416 417 #if GAUCHE_FFX 418 ScmFlonum *fpsp; /* flonum stack pointer. we call it 'stack' 419 for historical reasons, but it's more like 420 a nursery. */ 421 ScmFlonum *fpstack; /* flonum stack */ 422 ScmFlonum *fpstackEnd; /* flonum stack limit */ 423 #endif 424 425 /* Escape handling */ 426 ScmObj exceptionHandler; /* the current exception handler installed by 427 with-exception-handler. */ 428 ScmEscapePoint *escapePoint;/* chain of escape points (a kind of one-shot 429 continuation). used by system's default 430 exception handler to escape from the error 431 handlers. */ 432 ScmEscapePoint *escapePointFloating; 433 /* reverse link of escape point chain 434 to keep 'active' EPs. 435 See ScmEscapePoint definition above. */ 436 int escapeReason; /* temporary storage to pass data across 437 longjmp(). */ 438 void *escapeData[2]; /* ditto. */ 439 440 /* Custom debugger or error reporter */ 441 ScmObj customErrorReporter; /* If set, Scm_ReportError (report-error) calls 442 this procedure with an exception object. 443 The default behavior is to show the error 444 type, message, and the stack trace. 445 Alter this only if you want to customize 446 it per thread. 447 */ 448 449 /* Program information */ 450 int evalSituation; /* eval situation (related to eval-when) */ 451 452 /* Signal information */ 453 ScmSignalQueue sigq; 454 sigset_t sigMask; /* current signal mask */ 455 456 /* Statistics */ 457 ScmVMStat stat; 458 int profilerRunning; 459 ScmVMProfiler *prof; 460 461 #if defined(GAUCHE_USE_WTHREADS) 462 ScmWinCleanup *winCleanup; /* mimic pthread_cleanup_* */ 463 #endif /*defined(GAUCHE_USE_WTHREADS)*/ 464 465 u_long vmid; /* Numerical ID, mainly for debugging aid. 466 Can be recycled, so don't use this to 467 identify thread programtically. 468 Set by vm_register. */ 469 470 ScmCallTrace *callTrace; 471 472 /* for reset/shift */ 473 ScmObj resetChain; /* list of reset information, 474 where reset information is 475 (delimited . <dynamic handlers chain>). 476 the delimited flag is set when 'shift' 477 appears in 'reset' and the end marker of 478 partial continuation is set. */ 479 480 }; 481 482 SCM_EXTERN ScmVM *Scm_NewVM(ScmVM *proto, ScmObj name); 483 SCM_EXTERN int Scm_AttachVM(ScmVM *vm); 484 SCM_EXTERN void Scm_DetachVM(ScmVM *vm); 485 SCM_EXTERN void Scm_VMDump(ScmVM *vm); 486 SCM_EXTERN ScmObj Scm_VMDefaultExceptionHandler(ScmObj exc); 487 SCM_EXTERN ScmObj Scm_VMThrowException(ScmVM *vm, ScmObj exc, u_long flags); 488 SCM_EXTERN ScmObj Scm_VMGetSourceInfo(ScmCompiledCode *code, SCM_PCTYPE pc); 489 SCM_EXTERN ScmObj Scm_VMGetBindInfo(ScmCompiledCode *code, SCM_PCTYPE pc); 490 SCM_EXTERN void Scm_VMSetResult(ScmObj obj); 491 492 SCM_CLASS_DECL(Scm_VMClass); 493 #define SCM_CLASS_VM (&Scm_VMClass) 494 495 #if defined(GAUCHE_USE_PTHREADS) 496 SCM_EXTERN pthread_key_t Scm_VMKey(void); 497 #elif defined(GAUCHE_USE_WTHREADS) 498 SCM_EXTERN DWORD Scm_VMKey(void); 499 #endif 500 501 /* Value of vm->state */ 502 enum { 503 SCM_VM_NEW, /* This VM is just created and not attached 504 to the running thread. vm->thread is not 505 initialized. */ 506 SCM_VM_RUNNABLE, /* This VM is attached to a thread which is 507 runnable or blocked. */ 508 SCM_VM_STOPPED, /* The thread attached to this VM is stopped 509 by the inspector thread for debugging. */ 510 SCM_VM_TERMINATED /* The thread attached to this VM is 511 terminated. */ 512 }; 513 514 /* Value of vm->evalSituation */ 515 enum { 516 SCM_VM_EXECUTING, /* we're evaluating the form interactively. */ 517 SCM_VM_LOADING, /* we're loading the forms */ 518 SCM_VM_COMPILING /* we're batch-compiling the forms */ 519 }; 520 521 /* Value of vm->stopRequest. Zero means no request. */ 522 typedef enum { 523 SCM_VM_REQUEST_SUSPEND = 1L, /* Set by Scm_ThreadStop */ 524 SCM_VM_REQUEST_TERMINATE = 2L, /* Set by Scm_ThreadTerminate */ 525 } ScmVMStopRequest; 526 527 /* 528 * C stack rewinding 529 * (These macros interacts with VM internals, so must be used 530 * with care.) 531 * 532 * These macros should be used if you want to guarantee certain 533 * cleanup is called when the C-stack is "rewind". So it's like 534 * C-version of dynamic-wind. The typical usage will be like 535 * the following: 536 * 537 * SCM_UNWIND_PROTECT { 538 * preprocess 539 * main operation 540 * } SCM_WHEN_ERROR { 541 * clean up code on abnormal situation 542 * SCM_NEXT_HANDLER; 543 * } SCM_END_PROTECT; 544 * clean up code on normal situation 545 * 546 * Note that this construct does not install exception handler or 547 * error handler by itself. The handler installed by with-error-handler 548 * or with-exception-handler is invoked, and then the SCM_WHEN_ERROR 549 * part is called while the C stack is rewind. 550 * If you want to handle error as well, you should install error handler 551 * by yourself (and deinstall it in the cleanup code). 552 * 553 * In general, you MUST call SCM_NEXT_HANDLER in the SCM_WHEN_ERROR clause. 554 * In other words, you shouldn't use SCM_UNWIND_PROTECT as "ignore-errors" 555 * construct. The C stack is rewind not only at the error situation, but 556 * also when acontinuation is thrown in the main operation. Except certain 557 * special occasions, stopping C-stack rewinding may cause semantic 558 * inconsistency. Besides, we don't save signal mask in SCM_UNWIND_PROTECT 559 * for the performance reason; assuming the mask is eventually recovered 560 * by the core exception handling mechanism (see vm.c). 561 */ 562 563 #define SCM_UNWIND_PROTECT \ 564 do { \ 565 ScmCStack cstack; \ 566 cstack.prev = Scm_VM()->cstack; \ 567 cstack.cont = NULL; \ 568 Scm_VM()->cstack = &cstack; \ 569 if (sigsetjmp(cstack.jbuf, FALSE) == 0) { 570 571 #define SCM_WHEN_ERROR \ 572 } else { 573 574 #define SCM_NEXT_HANDLER \ 575 do { \ 576 if (Scm_VM()->cstack->prev) { \ 577 Scm_VM()->cstack = Scm_VM()->cstack->prev; \ 578 siglongjmp(Scm_VM()->cstack->jbuf, 1); \ 579 } \ 580 else Scm_Exit(1); \ 581 } while (0) 582 583 #define SCM_END_PROTECT \ 584 } \ 585 Scm_VM()->cstack = Scm_VM()->cstack->prev; \ 586 } while (0) 587 588 SCM_EXTERN long Scm_VMUnwindProtect(ScmVM *vm, ScmCStack *cstack); 589 SCM_EXTERN void Scm_VMNextHandler(ScmVM *vm); 590 SCM_EXTERN void Scm_VMRewindProtect(ScmVM *vm); 591 592 /* 593 * Runtime flags 594 */ 595 enum { 596 SCM_ERROR_BEING_HANDLED = (1L<<0), /* we're in an error handler */ 597 SCM_ERROR_BEING_REPORTED = (1L<<1), /* we're in an error reporter */ 598 SCM_LOAD_VERBOSE = (1L<<2), /* report loading files */ 599 SCM_CASE_FOLD = (1L<<3), /* symbols are case insensitive */ 600 SCM_LIMIT_MODULE_MUTATION = (1L<<4),/* disable set! to modify the 601 global binding in the other 602 module */ 603 SCM_COLLECT_VM_STATS = (1L<<5), /* enable statistics collection 604 (incurs runtime overhead) */ 605 SCM_COLLECT_LOAD_STATS = (1L<<6), /* log the stats of file load 606 timings (incurs runtime overhead) */ 607 SCM_CHECK_UNDEFINED_TEST = (1L<<7), /* check if #<undef> appears as 608 the test value in branch */ 609 SCM_SAFE_STRING_CURSORS = (1L<<8) /* Always use large cursors for 610 extra validation. */ 611 }; 612 613 #define SCM_VM_RUNTIME_FLAG_IS_SET(vm, flag) ((vm)->runtimeFlags & (flag)) 614 #define SCM_VM_RUNTIME_FLAG_SET(vm, flag) ((vm)->runtimeFlags |= (flag)) 615 #define SCM_VM_RUNTIME_FLAG_CLEAR(vm, flag) ((vm)->runtimeFlags &= ~(flag)) 616 617 /* 618 * C-continuation 619 */ 620 621 typedef ScmObj ScmCContinuationProc(ScmObj result, void **data); 622 623 SCM_EXTERN void Scm_VMPushCC(ScmCContinuationProc *func, 624 void **data, 625 int datasize); 626 627 #define SCM_CCONT_DATA_SIZE 6 /* Maximum datasize for VMPushCC */ 628 629 /* 630 * Compiler flags 631 */ 632 633 enum { 634 SCM_COMPILE_NOINLINE_GLOBALS = (1L<<0),/* Do not inline global procs */ 635 SCM_COMPILE_NOINLINE_LOCALS = (1L<<1), /* Do not inline local procs */ 636 SCM_COMPILE_NOINLINE_CONSTS = (1L<<2), /* Do not inline constants */ 637 SCM_COMPILE_NOSOURCE = (1L<<3), /* Do not insert source info */ 638 SCM_COMPILE_SHOWRESULT = (1L<<4), /* Display each result of 639 compilation */ 640 SCM_COMPILE_NOCOMBINE = (1L<<5), /* Do not combine instructions */ 641 SCM_COMPILE_NO_POST_INLINE_OPT = (1L<<6), /* Do not run post-inline 642 optimization (pass3). */ 643 SCM_COMPILE_NO_LIFTING = (1L<<7), /* Do not run lambda lifting pass 644 (pass4). */ 645 SCM_COMPILE_INCLUDE_VERBOSE = (1L<<8), /* Report expansion of 'include' */ 646 SCM_COMPILE_NOINLINE_SETTERS = (1L<<9), /* Do not inline setters */ 647 SCM_COMPILE_NODISSOLVE_APPLY = (1L<<10),/* Do not dissolve APPLY 648 (pass2/dissolve-apply) */ 649 SCM_COMPILE_LEGACY_DEFINE = (1L<<11), /* Do not insert toplevel binding 650 at compile-time. */ 651 SCM_COMPILE_MUTABLE_LITERALS = (1L<<12),/* Literal pairs are mutable */ 652 SCM_COMPILE_SRFI_FEATURE_ID = (1L<<13) /* Allow srfi-N feature id in 653 cond-expand */ 654 }; 655 656 #define SCM_VM_COMPILER_FLAG_IS_SET(vm, flag) ((vm)->compilerFlags & (flag)) 657 #define SCM_VM_COMPILER_FLAG_SET(vm, flag) ((vm)->compilerFlags |= (flag)) 658 #define SCM_VM_COMPILER_FLAG_CLEAR(vm, flag) ((vm)->compilerFlags &= ~(flag)) 659 660 /* 661 * Compiler internal APIs 662 */ 663 664 SCM_EXTERN ScmObj Scm_Compile(ScmObj program, ScmObj mod); 665 666 SCM_EXTERN ScmObj Scm_CallSyntaxCompiler(ScmObj syn, ScmObj from, ScmObj env); 667 SCM_EXTERN ScmObj Scm_CallMacroExpander(ScmMacro *mac, ScmObj expr, ScmObj env); 668 SCM_EXTERN ScmObj Scm_CallMacroExpanderOld(ScmMacro *mac, ScmObj expr, ScmObj env); 669 SCM_EXTERN int Scm_HasInlinerP(ScmObj obj); 670 SCM_EXTERN ScmObj Scm_CallProcedureInliner(ScmObj obj, ScmObj form, ScmObj env); 671 672 /* This is in module.c, but it's not for public, so declaration is here. */ 673 SCM_EXTERN ScmModule* Scm_GaucheInternalModule(void); 674 675 SCM_EXTERN ScmObj Scm__VMInsnOffsets(void); 676 677 #endif /* GAUCHE_VM_H */ 678