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_FALSEP (vp->hooks[h]))               \
 221     {                                           \
 222       SYNC_REGISTER ();                         \
 223       vm_heapify_frames (vm);                   \
 224       scm_c_run_hook (vp->hooks[h], hook_args); \
 225       CACHE_REGISTER ();                        \
 226     }                                           \
 227 }
 228 #else
 229 #define RUN_HOOK(h)
 230 #endif
 231
 232 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 233 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 234 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 235 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 236 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 237 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 238 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 239 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 240
 241 \f
 242 /*
 243  * Stack operation
 244  */
 245
 246 #ifdef VM_ENABLE_STACK_NULLING
 247 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 248 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 249 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 250 #else
 251 # define CHECK_STACK_LEAKN(_n)
 252 # define CHECK_STACK_LEAK()
 253 # define NULLSTACK(_n)
 254 #endif
 255
 256 #define CHECK_OVERFLOW()                        \
 257   if (sp > stack_limit)                         \
 258     goto vm_error_stack_overflow
 259
 260 #define CHECK_UNDERFLOW()                       \
 261   if (sp < stack_base)                          \
 262     goto vm_error_stack_underflow;
 263
 264 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 265 #define DROP()  do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
 266 #define DROPN(_n)       do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
 267 #define POP(x)  do { x = *sp; DROP (); } while (0)
 268
 269 /* A fast CONS.  This has to be fast since its used, for instance, by
 270    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 271    inlined function in Guile 1.7.  Unfortunately, it calls
 272    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 273    heap.  XXX  */
 274 #define CONS(x,y,z)                                     \
 275 {                                                       \
 276   SYNC_BEFORE_GC ();                                    \
 277   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 278 }
 279
 280 /* Pop the N objects on top of the stack and push a list that contains
 281    them.  */
 282 #define POP_LIST(n)                             \
 283 do                                              \
 284 {                                               \
 285   int i;                                        \
 286   SCM l = SCM_EOL, x;                           \
 287   for (i = n; i; i--)                           \
 288     {                                           \
 289       POP (x);                                  \
 290       CONS (l, x, l);                           \
 291     }                                           \
 292   PUSH (l);                                     \
 293 } while (0)
 294
 295 \f
 296 /* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
 297    allocate cells on the stack.  This is a significant improvement for
 298    programs which call a lot of procedures, since the procedure call
 299    mechanism uses POP_LIST which normally uses `scm_cons'.
 300
 301    What it does is that it creates a list whose cells are allocated on the
 302    VM's stack instead of being allocated on the heap via `scm_cell'.  This is
 303    much faster.  However, if the callee does something like:
 304
 305      (lambda (. args)
 306        (set! the-args args))
 307
 308    then terrible things may happen since the list of arguments may be
 309    overwritten later on.  */
 310
 311
 312 /* Awful hack that aligns PTR so that it can be considered as a non-immediate
 313    value by Guile.  */
 314 #define ALIGN_AS_NON_IMMEDIATE(_ptr)            \
 315 {                                               \
 316   if ((scm_t_bits)(_ptr) & 6)                   \
 317     {                                           \
 318       size_t _incr;                             \
 319                                                 \
 320       _incr = (scm_t_bits)(_ptr) & 6;           \
 321       _incr = (~_incr) & 7;                     \
 322       (_ptr) += _incr;                          \
 323     }                                           \
 324 }
 325
 326 #define POP_LIST_ON_STACK(n)                    \
 327 do                                              \
 328 {                                               \
 329   int i;                                        \
 330   if (n == 0)                                   \
 331     {                                           \
 332       sp -= n;                                  \
 333       PUSH (SCM_EOL);                           \
 334     }                                           \
 335   else                                          \
 336     {                                           \
 337       SCM *list_head, *list;                    \
 338                                                 \
 339       list_head = sp + 1;                       \
 340       ALIGN_AS_NON_IMMEDIATE (list_head);       \
 341       list = list_head;                         \
 342                                                 \
 343       sp -= n;                                  \
 344       for (i = 1; i <= n; i++)                  \
 345         {                                       \
 346           /* The cell's car and cdr.  */        \
 347           *(list) = sp[i];                      \
 348           *(list + 1) = PTR2SCM (list + 2);     \
 349           list += 2;                            \
 350         }                                       \
 351                                                 \
 352       /* The last pair's cdr is '().  */        \
 353       list--;                                   \
 354       *list = SCM_EOL;                          \
 355       /* Push the SCM object that points */     \
 356       /* to the first cell.  */                 \
 357       PUSH (PTR2SCM (list_head));               \
 358     }                                           \
 359 }                                               \
 360 while (0)
 361
 362 /* end of the experiment */
 363
 364 \f
 365 #define POP_LIST_MARK()                         \
 366 do {                                            \
 367   SCM o;                                        \
 368   SCM l = SCM_EOL;                              \
 369   POP (o);                                      \
 370   while (!SCM_UNBNDP (o))                       \
 371     {                                           \
 372       CONS (l, o, l);                           \
 373       POP (o);                                  \
 374     }                                           \
 375   PUSH (l);                                     \
 376 } while (0)
 377
 378 #define POP_CONS_MARK()                         \
 379 do {                                            \
 380   SCM o, l;                                     \
 381   POP (l);                                      \
 382   POP (o);                                      \
 383   while (!SCM_UNBNDP (o))                       \
 384     {                                           \
 385       CONS (l, o, l);                           \
 386       POP (o);                                  \
 387     }                                           \
 388   PUSH (l);                                     \
 389 } while (0)
 390
 391 \f
 392 /*
 393  * Instruction operation
 394  */
 395
 396 #define FETCH()         (*ip++)
 397 #define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
 398
 399 #undef CLOCK
 400 #if VM_USE_CLOCK
 401 #define CLOCK(n)        vp->clock += n
 402 #else
 403 #define CLOCK(n)
 404 #endif
 405
 406 #undef NEXT_JUMP
 407 #ifdef HAVE_LABELS_AS_VALUES
 408 #define NEXT_JUMP()             goto *jump_table[FETCH ()]
 409 #else
 410 #define NEXT_JUMP()             goto vm_start
 411 #endif
 412
 413 #define NEXT                                    \
 414 {                                               \
 415   CLOCK (1);                                    \
 416   NEXT_HOOK ();                                 \
 417   CHECK_STACK_LEAK ();                          \
 418   NEXT_JUMP ();                                 \
 419 }
 420
 421 \f
 422 /*
 423  * Stack frame
 424  */
 425
 426 #define INIT_ARGS()                             \
 427 {                                               \
 428   if (bp->nrest)                                \
 429     {                                           \
 430       int n = nargs - (bp->nargs - 1);          \
 431       if (n < 0)                                \
 432         goto vm_error_wrong_num_args;           \
 433       /* NB, can cause GC while setting up the  \
 434          stack frame */                         \
 435       POP_LIST (n);                             \
 436     }                                           \
 437   else                                          \
 438     {                                           \
 439       if (nargs != bp->nargs)                   \
 440         goto vm_error_wrong_num_args;           \
 441     }                                           \
 442 }
 443
 444 /* See frames.h for the layout of stack frames */
 445 /* When this is called, bp points to the new program data,
 446    and the arguments are already on the stack */
 447 #define NEW_FRAME()                             \
 448 {                                               \
 449   int i;                                        \
 450   SCM *dl, *data;                               \
 451   scm_byte_t *ra = ip;                          \
 452                                                 \
 453   /* Save old registers */                      \
 454   ra = ip;                                      \
 455   dl = fp;                                      \
 456                                                 \
 457   /* New registers */                           \
 458   fp = sp - bp->nargs + 1;                      \
 459   data = SCM_FRAME_DATA_ADDRESS (fp);           \
 460   sp = data + 4;                                \
 461   CHECK_OVERFLOW ();                            \
 462   stack_base = sp;                              \
 463   ip = bp->base;                                \
 464                                                 \
 465   /* Init local variables */                    \
 466   for (i=bp->nlocs; i; i--)                     \
 467     data[-i] = SCM_UNDEFINED;                   \
 468                                                 \
 469   /* Set frame data */                          \
 470   data[4] = (SCM)ra;                            \
 471   data[3] = 0x0;                                \
 472   data[2] = (SCM)dl;                            \
 473   data[1] = SCM_BOOL_F;                         \
 474                                                 \
 475   /* Postpone initializing external vars,       \
 476      because if the CONS causes a GC, we        \
 477      want the stack marker to see the data      \
 478      array formatted as expected. */            \
 479   data[0] = SCM_UNDEFINED;                      \
 480   external = bp->external;                      \
 481   for (i = 0; i < bp->nexts; i++)               \
 482     CONS (external, SCM_UNDEFINED, external);   \
 483   data[0] = external;                           \
 484 }
 485
 486 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 487
 488 /*
 489   Local Variables:
 490   c-file-style: "gnu"
 491   End:
 492 */