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 #define CACHE_REGISTER()                        \
 131 {                                               \
 132   ip = vp->ip;                                  \
 133   sp = vp->sp;                                  \
 134   fp = vp->fp;                                  \
 135 }
 136
 137 #define SYNC_REGISTER()                         \
 138 {                                               \
 139   vp->ip = ip;                                  \
 140   vp->sp = sp;                                  \
 141   vp->fp = fp;                                  \
 142 }
 143
 144 #ifdef IP_PARANOIA
 145 #define CHECK_IP() \
 146   do { if (ip < bp->base || ip - bp->base > bp->size) abort (); } while (0)
 147 #else
 148 #define CHECK_IP()
 149 #endif
 150
 151 /* Get a local copy of the program's "object table" (i.e. the vector of
 152    external bindings that are referenced by the program), initialized by
 153    `load-program'.  */
 154 /* XXX:  We could instead use the "simple vector macros", thus not having to
 155    call `scm_vector_writable_elements ()' and the likes.  */
 156 #define CACHE_PROGRAM()                                                 \
 157 {                                                                       \
 158   ssize_t _vincr;                                                       \
 159                                                                         \
 160   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 161     bp = SCM_PROGRAM_DATA (program);                                    \
 162     /* Was: objects = SCM_VELTS (bp->objs); */                          \
 163                                                                         \
 164     if (objects)                                                        \
 165       scm_array_handle_release (&objects_handle);                       \
 166                                                                         \
 167     objects = scm_vector_writable_elements (bp->objs, &objects_handle,  \
 168                                             &object_count, &_vincr);    \
 169   }                                                                     \
 170 }
 171
 172 #define SYNC_BEFORE_GC()                        \
 173 {                                               \
 174   SYNC_REGISTER ();                             \
 175 }
 176
 177 #define SYNC_ALL()                              \
 178 {                                               \
 179   SYNC_REGISTER ();                             \
 180 }
 181
 182 \f
 183 /*
 184  * Error check
 185  */
 186
 187 #undef CHECK_EXTERNAL
 188 #if VM_CHECK_EXTERNAL
 189 #define CHECK_EXTERNAL(e) \
 190   do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
 191 #else
 192 #define CHECK_EXTERNAL(e)
 193 #endif
 194
 195 /* Accesses to a program's object table.  */
 196 #if VM_CHECK_OBJECT
 197 #define CHECK_OBJECT(_num) \
 198   do { if ((_num) >= object_count) goto vm_error_object; } while (0)
 199 #else
 200 #define CHECK_OBJECT(_num)
 201 #endif
 202
 203 \f
 204 /*
 205  * Hooks
 206  */
 207
 208 #undef RUN_HOOK
 209 #if VM_USE_HOOKS
 210 #define RUN_HOOK(h)                             \
 211 {                                               \
 212   if (!SCM_FALSEP (vp->hooks[h]))               \
 213     {                                           \
 214       SYNC_REGISTER ();                         \
 215       vm_heapify_frames (vm);                   \
 216       scm_c_run_hook (vp->hooks[h], hook_args); \
 217       CACHE_REGISTER ();                        \
 218     }                                           \
 219 }
 220 #else
 221 #define RUN_HOOK(h)
 222 #endif
 223
 224 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 225 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 226 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 227 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 228 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 229 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 230 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 231 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 232
 233 \f
 234 /*
 235  * Stack operation
 236  */
 237
 238 #define CHECK_OVERFLOW()                        \
 239   if (sp > stack_limit)                         \
 240     goto vm_error_stack_overflow
 241
 242 #define CHECK_UNDERFLOW()                       \
 243   if (sp < stack_base)                          \
 244     goto vm_error_stack_underflow;
 245
 246 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 247 #define DROP()  do { sp--; CHECK_UNDERFLOW (); } while (0)
 248 #define DROPN(_n)       do { sp -= (_n); CHECK_UNDERFLOW (); } while (0)
 249 #define POP(x)  do { x = *sp; DROP (); } while (0)
 250
 251 /* A fast CONS.  This has to be fast since its used, for instance, by
 252    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 253    inlined function in Guile 1.7.  Unfortunately, it calls
 254    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 255    heap.  XXX  */
 256 #define CONS(x,y,z)                                     \
 257 {                                                       \
 258   SYNC_BEFORE_GC ();                                    \
 259   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 260 }
 261
 262 /* Pop the N objects on top of the stack and push a list that contains
 263    them.  */
 264 #define POP_LIST(n)                             \
 265 do                                              \
 266 {                                               \
 267   int i;                                        \
 268   SCM l = SCM_EOL;                              \
 269   sp -= n;                                      \
 270   for (i = n; i; i--)                           \
 271     CONS (l, sp[i], l);                         \
 272   PUSH (l);                                     \
 273 } while (0)
 274
 275 \f
 276 /* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
 277    allocate cells on the stack.  This is a significant improvement for
 278    programs which call a lot of procedures, since the procedure call
 279    mechanism uses POP_LIST which normally uses `scm_cons'.
 280
 281    What it does is that it creates a list whose cells are allocated on the
 282    VM's stack instead of being allocated on the heap via `scm_cell'.  This is
 283    much faster.  However, if the callee does something like:
 284
 285      (lambda (. args)
 286        (set! the-args args))
 287
 288    then terrible things may happen since the list of arguments may be
 289    overwritten later on.  */
 290
 291
 292 /* Awful hack that aligns PTR so that it can be considered as a non-immediate
 293    value by Guile.  */
 294 #define ALIGN_AS_NON_IMMEDIATE(_ptr)            \
 295 {                                               \
 296   if ((scm_t_bits)(_ptr) & 6)                   \
 297     {                                           \
 298       size_t _incr;                             \
 299                                                 \
 300       _incr = (scm_t_bits)(_ptr) & 6;           \
 301       _incr = (~_incr) & 7;                     \
 302       (_ptr) += _incr;                          \
 303     }                                           \
 304 }
 305
 306 #define POP_LIST_ON_STACK(n)                    \
 307 do                                              \
 308 {                                               \
 309   int i;                                        \
 310   if (n == 0)                                   \
 311     {                                           \
 312       sp -= n;                                  \
 313       PUSH (SCM_EOL);                           \
 314     }                                           \
 315   else                                          \
 316     {                                           \
 317       SCM *list_head, *list;                    \
 318                                                 \
 319       list_head = sp + 1;                       \
 320       ALIGN_AS_NON_IMMEDIATE (list_head);       \
 321       list = list_head;                         \
 322                                                 \
 323       sp -= n;                                  \
 324       for (i = 1; i <= n; i++)                  \
 325         {                                       \
 326           /* The cell's car and cdr.  */        \
 327           *(list) = sp[i];                      \
 328           *(list + 1) = PTR2SCM (list + 2);     \
 329           list += 2;                            \
 330         }                                       \
 331                                                 \
 332       /* The last pair's cdr is '().  */        \
 333       list--;                                   \
 334       *list = SCM_EOL;                          \
 335       /* Push the SCM object that points */     \
 336       /* to the first cell.  */                 \
 337       PUSH (PTR2SCM (list_head));               \
 338     }                                           \
 339 }                                               \
 340 while (0)
 341
 342 /* end of the experiment */
 343
 344 \f
 345 #define POP_LIST_MARK()                         \
 346 do {                                            \
 347   SCM o;                                        \
 348   SCM l = SCM_EOL;                              \
 349   POP (o);                                      \
 350   while (!SCM_UNBNDP (o))                       \
 351     {                                           \
 352       CONS (l, o, l);                           \
 353       POP (o);                                  \
 354     }                                           \
 355   PUSH (l);                                     \
 356 } while (0)
 357
 358 \f
 359 /*
 360  * Instruction operation
 361  */
 362
 363 #define FETCH()         (*ip++)
 364 #define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
 365
 366 #undef CLOCK
 367 #if VM_USE_CLOCK
 368 #define CLOCK(n)        vp->clock += n
 369 #else
 370 #define CLOCK(n)
 371 #endif
 372
 373 #undef NEXT_JUMP
 374 #ifdef HAVE_LABELS_AS_VALUES
 375 #define NEXT_JUMP()             goto *jump_table[FETCH ()]
 376 #else
 377 #define NEXT_JUMP()             goto vm_start
 378 #endif
 379
 380 #define NEXT                                    \
 381 {                                               \
 382   CLOCK (1);                                    \
 383   NEXT_HOOK ();                                 \
 384   NEXT_JUMP ();                                 \
 385 }
 386
 387 \f
 388 /*
 389  * Stack frame
 390  */
 391
 392 #define INIT_ARGS()                             \
 393 {                                               \
 394   if (bp->nrest)                                \
 395     {                                           \
 396       int n = nargs - (bp->nargs - 1);          \
 397       if (n < 0)                                \
 398         goto vm_error_wrong_num_args;           \
 399       POP_LIST (n);                             \
 400     }                                           \
 401   else                                          \
 402     {                                           \
 403       if (nargs != bp->nargs)                   \
 404         goto vm_error_wrong_num_args;           \
 405     }                                           \
 406 }
 407
 408 /* See frames.h for the layout of stack frames */
 409 /* When this is called, bp points to the new program data,
 410    and the arguments are already on the stack */
 411 #define NEW_FRAME()                             \
 412 {                                               \
 413   int i;                                        \
 414   SCM *dl, *data;                               \
 415   scm_byte_t *ra = ip;                          \
 416                                                 \
 417   /* Save old registers */                      \
 418   ra = ip;                                      \
 419   dl = fp;                                      \
 420                                                 \
 421   /* New registers */                           \
 422   fp = sp - bp->nargs + 1;                      \
 423   data = SCM_FRAME_DATA_ADDRESS (fp);           \
 424   sp = data + 3;                                \
 425   CHECK_OVERFLOW ();                            \
 426   stack_base = sp;                              \
 427   ip = bp->base;                                \
 428                                                 \
 429   /* Init local variables */                    \
 430   for (i=bp->nlocs; i; i--)                     \
 431     data[-i] = SCM_UNDEFINED;                   \
 432                                                 \
 433   /* Create external variables */               \
 434   external = bp->external;                      \
 435   for (i = 0; i < bp->nexts; i++)               \
 436     CONS (external, SCM_UNDEFINED, external);   \
 437                                                 \
 438   /* Set frame data */                          \
 439   data[3] = (SCM)ra;                            \
 440   data[2] = (SCM)dl;                            \
 441   data[1] = SCM_BOOL_F;                         \
 442   data[0] = external;                           \
 443 }
 444
 445 #define FREE_FRAME()                            \
 446 {                                               \
 447   SCM *last_sp = sp;                            \
 448   SCM *last_fp = fp;                            \
 449   SCM *p = fp + bp->nargs + bp->nlocs;          \
 450                                                 \
 451   /* Restore pointers */                        \
 452   ip = SCM_FRAME_BYTE_CAST (p[3]);              \
 453   fp = SCM_FRAME_STACK_CAST (p[2]);             \
 454                                                 \
 455   if (!SCM_FALSEP (p[1]))                       \
 456     {                                           \
 457       /* Unlink the heap stack */               \
 458       vp->this_frame = p[1];                    \
 459     }                                           \
 460   else                                          \
 461     {                                           \
 462       /* Move stack items */                    \
 463       p += 4;                                   \
 464       sp = SCM_FRAME_LOWER_ADDRESS (last_fp);   \
 465       while (p <= last_sp)                      \
 466         *sp++ = *p++;                           \
 467       sp--;                                     \
 468     }                                           \
 469   stack_base = fp ?                             \
 470     SCM_FRAME_UPPER_ADDRESS (fp) - 1            \
 471     : vp->stack_base;                           \
 472 }
 473
 474 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 475
 476 /*
 477   Local Variables:
 478   c-file-style: "gnu"
 479   End:
 480 */