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