libguile/vm-engine.h

   1 /* Copyright (C) 2001 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* This file is included in vm_engine.c */
  43
  44 \f
  45 /*
  46  * Registers
  47  */
  48
  49 /* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
  50
  51    Some compilers underestimate the use of the local variables representing
  52    the abstract machine registers, and don't put them in hardware registers,
  53    which slows down the interpreter considerably.
  54    For GCC, I have hand-assigned hardware registers for several architectures.
  55 */
  56
  57 #ifdef __GNUC__
  58 #ifdef __mips__
  59 #define IP_REG asm("$16")
  60 #define SP_REG asm("$17")
  61 #define FP_REG asm("$18")
  62 #endif
  63 #ifdef __sparc__
  64 #define IP_REG asm("%l0")
  65 #define SP_REG asm("%l1")
  66 #define FP_REG asm("%l2")
  67 #endif
  68 #ifdef __alpha__
  69 #ifdef __CRAY__
  70 #define IP_REG asm("r9")
  71 #define SP_REG asm("r10")
  72 #define FP_REG asm("r11")
  73 #else
  74 #define IP_REG asm("$9")
  75 #define SP_REG asm("$10")
  76 #define FP_REG asm("$11")
  77 #endif
  78 #endif
  79 #ifdef __i386__
  80 /* gcc on lenny actually crashes if we allocate these variables in registers.
  81    hopefully this is the only one of these. */
  82 #if !(__GNUC__==4 && __GNUC_MINOR__==1 && __GNUC_PATCHLEVEL__==2)
  83 #define IP_REG asm("%esi")
  84 #define SP_REG asm("%edi")
  85 #define FP_REG
  86 #endif
  87 #endif
  88 #if defined(PPC) || defined(_POWER) || defined(_IBMR2)
  89 #define IP_REG asm("26")
  90 #define SP_REG asm("27")
  91 #define FP_REG asm("28")
  92 #endif
  93 #ifdef __hppa__
  94 #define IP_REG asm("%r18")
  95 #define SP_REG asm("%r17")
  96 #define FP_REG asm("%r16")
  97 #endif
  98 #ifdef __mc68000__
  99 #define IP_REG asm("a5")
 100 #define SP_REG asm("a4")
 101 #define FP_REG
 102 #endif
 103 #ifdef __arm__
 104 #define IP_REG asm("r9")
 105 #define SP_REG asm("r8")
 106 #define FP_REG asm("r7")
 107 #endif
 108 #endif
 109
 110 #ifndef IP_REG
 111 #define IP_REG
 112 #endif
 113 #ifndef SP_REG
 114 #define SP_REG
 115 #endif
 116 #ifndef FP_REG
 117 #define FP_REG
 118 #endif
 119
 120 \f
 121 /*
 122  * Cache/Sync
 123  */
 124
 125 #ifdef VM_ENABLE_ASSERTIONS
 126 # define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
 127 #else
 128 # define ASSERT(condition)
 129 #endif
 130
 131
 132 #define CACHE_REGISTER()                        \
 133 {                                               \
 134   ip = vp->ip;                                  \
 135   sp = vp->sp;                                  \
 136   fp = vp->fp;                                  \
 137   stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
 138 }
 139
 140 #define SYNC_REGISTER()                         \
 141 {                                               \
 142   vp->ip = ip;                                  \
 143   vp->sp = sp;                                  \
 144   vp->fp = fp;                                  \
 145 }
 146
 147 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
 148 #define CHECK_IP() \
 149   do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
 150 #define ASSERT_BOUND(x) \
 151   do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
 152   } while (0)
 153 #else
 154 #define CHECK_IP()
 155 #define ASSERT_BOUND(x)
 156 #endif
 157
 158 /* Get a local copy of the program's "object table" (i.e. the vector of
 159    external bindings that are referenced by the program), initialized by
 160    `load-program'.  */
 161 /* XXX:  We could instead use the "simple vector macros", thus not having to
 162    call `scm_vector_writable_elements ()' and the likes.  */
 163 #define CACHE_PROGRAM()                                                 \
 164 {                                                                       \
 165   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 166     bp = SCM_PROGRAM_DATA (program);                                    \
 167     if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
 168       objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
 169       object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
 170     } else {                                                            \
 171       objects = NULL;                                                   \
 172       object_count = 0;                                                 \
 173     }                                                                   \
 174   }                                                                     \
 175 }
 176
 177 #define SYNC_BEFORE_GC()                        \
 178 {                                               \
 179   SYNC_REGISTER ();                             \
 180 }
 181
 182 #define SYNC_ALL()                              \
 183 {                                               \
 184   SYNC_REGISTER ();                             \
 185 }
 186
 187 \f
 188 /*
 189  * Error check
 190  */
 191
 192 #undef CHECK_EXTERNAL
 193 #if VM_CHECK_EXTERNAL
 194 #define CHECK_EXTERNAL(e) \
 195   do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0)
 196 #else
 197 #define CHECK_EXTERNAL(e)
 198 #endif
 199
 200 /* Accesses to a program's object table.  */
 201 #if VM_CHECK_OBJECT
 202 #define CHECK_OBJECT(_num) \
 203   do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
 204 #else
 205 #define CHECK_OBJECT(_num)
 206 #endif
 207
 208 \f
 209 /*
 210  * Hooks
 211  */
 212
 213 #undef RUN_HOOK
 214 #if VM_USE_HOOKS
 215 #define RUN_HOOK(h)                             \
 216 {                                               \
 217   if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
 218     {                                           \
 219       SYNC_REGISTER ();                         \
 220       vm_dispatch_hook (vp, vp->hooks[h], hook_args);      \
 221       CACHE_REGISTER ();                        \
 222     }                                           \
 223 }
 224 #else
 225 #define RUN_HOOK(h)
 226 #endif
 227
 228 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 229 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 230 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 231 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 232 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 233 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 234 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 235 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 236
 237 \f
 238 /*
 239  * Stack operation
 240  */
 241
 242 #ifdef VM_ENABLE_STACK_NULLING
 243 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 244 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 245 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 246 /* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
 247    inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
 248    that continuation doesn't have a chance to run. It's not important on a
 249    semantic level, but it does mess up our stack nulling -- so this macro is to
 250    fix that. */
 251 # define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
 252 #else
 253 # define CHECK_STACK_LEAKN(_n)
 254 # define CHECK_STACK_LEAK()
 255 # define NULLSTACK(_n)
 256 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 257 #endif
 258
 259 #define CHECK_OVERFLOW()                        \
 260   if (sp > stack_limit)                         \
 261     goto vm_error_stack_overflow
 262
 263 #define CHECK_UNDERFLOW()                       \
 264   if (sp < stack_base)                          \
 265     goto vm_error_stack_underflow;
 266
 267 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 268 #define DROP()  do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
 269 #define DROPN(_n)       do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
 270 #define POP(x)  do { x = *sp; DROP (); } while (0)
 271
 272 /* A fast CONS.  This has to be fast since its used, for instance, by
 273    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 274    inlined function in Guile 1.7.  Unfortunately, it calls
 275    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 276    heap.  XXX  */
 277 #define CONS(x,y,z)                                     \
 278 {                                                       \
 279   SYNC_BEFORE_GC ();                                    \
 280   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 281 }
 282
 283 /* Pop the N objects on top of the stack and push a list that contains
 284    them.  */
 285 #define POP_LIST(n)                             \
 286 do                                              \
 287 {                                               \
 288   int i;                                        \
 289   SCM l = SCM_EOL, x;                           \
 290   for (i = n; i; i--)                           \
 291     {                                           \
 292       POP (x);                                  \
 293       CONS (l, x, l);                           \
 294     }                                           \
 295   PUSH (l);                                     \
 296 } while (0)
 297
 298 /* The opposite: push all of the elements in L onto the list. */
 299 #define PUSH_LIST(l, NILP)                      \
 300 do                                              \
 301 {                                               \
 302   for (; scm_is_pair (l); l = SCM_CDR (l))      \
 303     PUSH (SCM_CAR (l));                         \
 304   if (SCM_UNLIKELY (!NILP (l))) {               \
 305     finish_args = scm_list_1 (l);               \
 306     goto vm_error_improper_list;                \
 307   }                                             \
 308 } while (0)
 309
 310 \f
 311 #define POP_LIST_MARK()                         \
 312 do {                                            \
 313   SCM o;                                        \
 314   SCM l = SCM_EOL;                              \
 315   POP (o);                                      \
 316   while (!SCM_UNBNDP (o))                       \
 317     {                                           \
 318       CONS (l, o, l);                           \
 319       POP (o);                                  \
 320     }                                           \
 321   PUSH (l);                                     \
 322 } while (0)
 323
 324 #define POP_CONS_MARK()                         \
 325 do {                                            \
 326   SCM o, l;                                     \
 327   POP (l);                                      \
 328   POP (o);                                      \
 329   while (!SCM_UNBNDP (o))                       \
 330     {                                           \
 331       CONS (l, o, l);                           \
 332       POP (o);                                  \
 333     }                                           \
 334   PUSH (l);                                     \
 335 } while (0)
 336
 337 \f
 338 /*
 339  * Instruction operation
 340  */
 341
 342 #define FETCH()         (*ip++)
 343 #define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
 344
 345 #undef CLOCK
 346 #if VM_USE_CLOCK
 347 #define CLOCK(n)        vp->clock += n
 348 #else
 349 #define CLOCK(n)
 350 #endif
 351
 352 #undef NEXT_JUMP
 353 #ifdef HAVE_LABELS_AS_VALUES
 354 #define NEXT_JUMP()             goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
 355 #else
 356 #define NEXT_JUMP()             goto vm_start
 357 #endif
 358
 359 #define NEXT                                    \
 360 {                                               \
 361   CLOCK (1);                                    \
 362   NEXT_HOOK ();                                 \
 363   CHECK_STACK_LEAK ();                          \
 364   NEXT_JUMP ();                                 \
 365 }
 366
 367 \f
 368 /*
 369  * Stack frame
 370  */
 371
 372 #define INIT_ARGS()                             \
 373 {                                               \
 374   if (SCM_UNLIKELY (bp->nrest))                 \
 375     {                                           \
 376       int n = nargs - (bp->nargs - 1);          \
 377       if (n < 0)                                \
 378         goto vm_error_wrong_num_args;           \
 379       /* NB, can cause GC while setting up the  \
 380          stack frame */                         \
 381       POP_LIST (n);                             \
 382     }                                           \
 383   else                                          \
 384     {                                           \
 385       if (SCM_UNLIKELY (nargs != bp->nargs))    \
 386         goto vm_error_wrong_num_args;           \
 387     }                                           \
 388 }
 389
 390 /* See frames.h for the layout of stack frames */
 391 /* When this is called, bp points to the new program data,
 392    and the arguments are already on the stack */
 393 #define NEW_FRAME()                             \
 394 {                                               \
 395   int i;                                        \
 396   SCM *dl, *data;                               \
 397   scm_byte_t *ra = ip;                          \
 398                                                 \
 399   /* Save old registers */                      \
 400   ra = ip;                                      \
 401   dl = fp;                                      \
 402                                                 \
 403   /* New registers */                           \
 404   fp = sp - bp->nargs + 1;                      \
 405   data = SCM_FRAME_DATA_ADDRESS (fp);           \
 406   sp = data + 3;                                \
 407   CHECK_OVERFLOW ();                            \
 408   stack_base = sp;                              \
 409   ip = bp->base;                                \
 410                                                 \
 411   /* Init local variables */                    \
 412   for (i=bp->nlocs; i; i--)                     \
 413     data[-i] = SCM_UNDEFINED;                   \
 414                                                 \
 415   /* Set frame data */                          \
 416   data[3] = (SCM)ra;                            \
 417   data[2] = 0x0;                                \
 418   data[1] = (SCM)dl;                            \
 419                                                 \
 420   /* Postpone initializing external vars,       \
 421      because if the CONS causes a GC, we        \
 422      want the stack marker to see the data      \
 423      array formatted as expected. */            \
 424   data[0] = SCM_UNDEFINED;                      \
 425   external = SCM_PROGRAM_EXTERNALS (fp[-1]);    \
 426   for (i = 0; i < bp->nexts; i++)               \
 427     CONS (external, SCM_UNDEFINED, external);   \
 428   data[0] = external;                           \
 429 }
 430
 431 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 432
 433 /*
 434   Local Variables:
 435   c-file-style: "gnu"
 436   End:
 437 */