src/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
  52 \f
  53 /*
  54  * Registers
  55  */
  56
  57 /* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
  58
  59    Some compilers underestimate the use of the local variables representing
  60    the abstract machine registers, and don't put them in hardware registers,
  61    which slows down the interpreter considerably.
  62    For GCC, I have hand-assigned hardware registers for several architectures.
  63 */
  64
  65 #ifdef __GNUC__
  66 #ifdef __mips__
  67 #define IP_REG asm("$16")
  68 #define SP_REG asm("$17")
  69 #define FP_REG asm("$18")
  70 #endif
  71 #ifdef __sparc__
  72 #define IP_REG asm("%l0")
  73 #define SP_REG asm("%l1")
  74 #define FP_REG asm("%l2")
  75 #endif
  76 #ifdef __alpha__
  77 #ifdef __CRAY__
  78 #define IP_REG asm("r9")
  79 #define SP_REG asm("r10")
  80 #define FP_REG asm("r11")
  81 #else
  82 #define IP_REG asm("$9")
  83 #define SP_REG asm("$10")
  84 #define FP_REG asm("$11")
  85 #endif
  86 #endif
  87 #ifdef __i386__
  88 #define IP_REG asm("%esi")
  89 #define SP_REG asm("%edi")
  90 #define FP_REG
  91 #endif
  92 #if defined(PPC) || defined(_POWER) || defined(_IBMR2)
  93 #define IP_REG asm("26")
  94 #define SP_REG asm("27")
  95 #define FP_REG asm("28")
  96 #endif
  97 #ifdef __hppa__
  98 #define IP_REG asm("%r18")
  99 #define SP_REG asm("%r17")
 100 #define FP_REG asm("%r16")
 101 #endif
 102 #ifdef __mc68000__
 103 #define IP_REG asm("a5")
 104 #define SP_REG asm("a4")
 105 #define FP_REG
 106 #endif
 107 #ifdef __arm__
 108 #define IP_REG asm("r9")
 109 #define SP_REG asm("r8")
 110 #define FP_REG asm("r7")
 111 #endif
 112 #endif
 113
 114 \f
 115 /*
 116  * Cache/Sync
 117  */
 118
 119 #define CACHE_REGISTER()                        \
 120 {                                               \
 121   ip = vp->ip;                                  \
 122   sp = vp->sp;                                  \
 123   fp = vp->fp;                                  \
 124 }
 125
 126 #define SYNC_REGISTER()                         \
 127 {                                               \
 128   vp->ip = ip;                                  \
 129   vp->sp = sp;                                  \
 130   vp->fp = fp;                                  \
 131 }
 132
 133 /* Get a local copy of the program's "object table" (i.e. the vector of
 134    external bindings that are referenced by the program), initialized by
 135    `load-program'.  */
 136 #define CACHE_PROGRAM()                                 \
 137 {                                                       \
 138   size_t _vsize;                                        \
 139   ssize_t _vincr;                                       \
 140   scm_t_array_handle _vhandle;                          \
 141                                                         \
 142   bp = SCM_PROGRAM_DATA (program);                      \
 143   /* Was: objects = SCM_VELTS (bp->objs); */            \
 144   objects = scm_vector_elements (bp->objs, &_vhandle,   \
 145                                  &_vsize, &_vincr);     \
 146   scm_array_handle_release (&_vhandle);                 \
 147 }
 148
 149 #define SYNC_BEFORE_GC()                        \
 150 {                                               \
 151   SYNC_REGISTER ();                             \
 152 }
 153
 154 #define SYNC_ALL()                              \
 155 {                                               \
 156   SYNC_REGISTER ();                             \
 157 }
 158
 159 \f
 160 /*
 161  * Error check
 162  */
 163
 164 #undef CHECK_EXTERNAL
 165 #if VM_CHECK_EXTERNAL
 166 #define CHECK_EXTERNAL(e) \
 167   do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
 168 #else
 169 #define CHECK_EXTERNAL(e)
 170 #endif
 171
 172 \f
 173 /*
 174  * Hooks
 175  */
 176
 177 #undef RUN_HOOK
 178 #if VM_USE_HOOKS
 179 #define RUN_HOOK(h)                             \
 180 {                                               \
 181   if (!SCM_FALSEP (vp->hooks[h]))               \
 182     {                                           \
 183       SYNC_REGISTER ();                         \
 184       vm_heapify_frames (vm);                   \
 185       scm_c_run_hook (vp->hooks[h], hook_args); \
 186       CACHE_REGISTER ();                        \
 187     }                                           \
 188 }
 189 #else
 190 #define RUN_HOOK(h)
 191 #endif
 192
 193 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 194 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 195 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 196 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 197 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 198 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 199 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 200 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 201
 202 \f
 203 /*
 204  * Stack operation
 205  */
 206
 207 #define CHECK_OVERFLOW()                        \
 208   if (sp > stack_limit)                         \
 209     goto vm_error_stack_overflow
 210
 211 #define CHECK_UNDERFLOW()                       \
 212   if (sp < stack_base)                          \
 213     goto vm_error_stack_underflow
 214
 215 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 216 #define DROP()  do { CHECK_UNDERFLOW (); sp--; } while (0)
 217 #define DROPN(_n)       do { CHECK_UNDERFLOW (); sp -= (_n); } while (0)
 218 #define POP(x)  do { x = *sp; DROP (); } while (0)
 219
 220 /* A fast CONS.  This has to be fast since its used, for instance, by
 221    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 222    inlined function in Guile 1.7.  Unfortunately, it calls
 223    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 224    heap.  XXX  */
 225 #define CONS(x,y,z)                                     \
 226 {                                                       \
 227   SYNC_BEFORE_GC ();                                    \
 228   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 229 }
 230
 231 /* Pop the N objects on top of the stack and push a list that contains
 232    them.  */
 233 #define POP_LIST(n)                             \
 234 do                                              \
 235 {                                               \
 236   int i;                                        \
 237   SCM l = SCM_EOL;                              \
 238   sp -= n;                                      \
 239   for (i = n; i; i--)                           \
 240     CONS (l, sp[i], l);                         \
 241   PUSH (l);                                     \
 242 } while (0)
 243
 244 \f
 245 /* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
 246    allocate cells on the stack.  This is a significant improvement for
 247    programs which call a lot of procedures, since the procedure call
 248    mechanism uses POP_LIST which normally uses `scm_cons'.
 249
 250    What it does is that it creates a list whose cells are allocated on the
 251    VM's stack instead of being allocated on the heap via `scm_cell'.  This is
 252    much faster.  However, if the callee does something like:
 253
 254      (lambda (. args)
 255        (set! the-args args))
 256
 257    then terrible things may happen since the list of arguments may be
 258    overwritten later on.  */
 259
 260
 261 /* Awful hack that aligns PTR so that it can be considered as a non-immediate
 262    value by Guile.  */
 263 #define ALIGN_AS_NON_IMMEDIATE(_ptr)            \
 264 {                                               \
 265   if ((scm_t_bits)(_ptr) & 6)                   \
 266     {                                           \
 267       size_t _incr;                             \
 268                                                 \
 269       _incr = (scm_t_bits)(_ptr) & 6;           \
 270       _incr = (~_incr) & 7;                     \
 271       (_ptr) += _incr;                          \
 272     }                                           \
 273 }
 274
 275 #define POP_LIST_ON_STACK(n)                    \
 276 do                                              \
 277 {                                               \
 278   int i;                                        \
 279   if (n == 0)                                   \
 280     {                                           \
 281       sp -= n;                                  \
 282       PUSH (SCM_EOL);                           \
 283     }                                           \
 284   else                                          \
 285     {                                           \
 286       SCM *list_head, *list;                    \
 287                                                 \
 288       list_head = sp + 1;                       \
 289       ALIGN_AS_NON_IMMEDIATE (list_head);       \
 290       list = list_head;                         \
 291                                                 \
 292       sp -= n;                                  \
 293       for (i = 1; i <= n; i++)                  \
 294         {                                       \
 295           /* The cell's car and cdr.  */        \
 296           *(list) = sp[i];                      \
 297           *(list + 1) = PTR2SCM (list + 2);     \
 298           list += 2;                            \
 299         }                                       \
 300                                                 \
 301       /* The last pair's cdr is '().  */        \
 302       list--;                                   \
 303       *list = SCM_EOL;                          \
 304       /* Push the SCM object that points */     \
 305       /* to the first cell.  */                 \
 306       PUSH (PTR2SCM (list_head));               \
 307     }                                           \
 308 }                                               \
 309 while (0)
 310
 311 /* end of the experiment */
 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 \f
 328 /*
 329  * Instruction operation
 330  */
 331
 332 #define FETCH()         (*ip++)
 333 #define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
 334
 335 #undef CLOCK
 336 #if VM_USE_CLOCK
 337 #define CLOCK(n)        vp->clock += n
 338 #else
 339 #define CLOCK(n)
 340 #endif
 341
 342 #undef NEXT_JUMP
 343 #ifdef HAVE_LABELS_AS_VALUES
 344 #define NEXT_JUMP()             goto *jump_table[FETCH ()]
 345 #else
 346 #define NEXT_JUMP()             goto vm_start
 347 #endif
 348
 349 #define NEXT                                    \
 350 {                                               \
 351   CLOCK (1);                                    \
 352   NEXT_HOOK ();                                 \
 353   NEXT_JUMP ();                                 \
 354 }
 355
 356 \f
 357 /*
 358  * Stack frame
 359  */
 360
 361 #define INIT_ARGS()                             \
 362 {                                               \
 363   if (bp->nrest)                                \
 364     {                                           \
 365       int n = nargs - (bp->nargs - 1);          \
 366       if (n < 0)                                \
 367         goto vm_error_wrong_num_args;           \
 368       POP_LIST (n);                             \
 369     }                                           \
 370   else                                          \
 371     {                                           \
 372       if (nargs != bp->nargs)                   \
 373         goto vm_error_wrong_num_args;           \
 374     }                                           \
 375 }
 376
 377 /* See frames.h for the layout of stack frames */
 378
 379 #define NEW_FRAME()                             \
 380 {                                               \
 381   int i;                                        \
 382   SCM ra = SCM_PACK (ip);                       \
 383   SCM dl = SCM_PACK (fp);                       \
 384   SCM *p = sp + 1;                              \
 385   SCM *q = p + bp->nlocs;                       \
 386                                                 \
 387   /* New pointers */                            \
 388   ip = bp->base;                                \
 389   fp = p - bp->nargs;                           \
 390   sp = q + 3;                                   \
 391   CHECK_OVERFLOW ();                            \
 392                                                 \
 393   /* Init local variables */                    \
 394   for (; p < q; p++)                            \
 395     *p = SCM_UNDEFINED;                         \
 396                                                 \
 397   /* Create external variables */               \
 398   external = bp->external;                      \
 399   for (i = 0; i < bp->nexts; i++)               \
 400     CONS (external, SCM_UNDEFINED, external);   \
 401                                                 \
 402   /* Set frame data */                          \
 403   p[3] = ra;                                    \
 404   p[2] = dl;                                    \
 405   p[1] = SCM_BOOL_F;                            \
 406   p[0] = external;                              \
 407 }
 408
 409 #define FREE_FRAME()                            \
 410 {                                               \
 411   SCM *last_sp = sp;                            \
 412   SCM *last_fp = fp;                            \
 413   SCM *p = fp + bp->nargs + bp->nlocs;          \
 414                                                 \
 415   /* Restore pointers */                        \
 416   ip = SCM_FRAME_BYTE_CAST (p[3]);              \
 417   fp = SCM_FRAME_STACK_CAST (p[2]);             \
 418                                                 \
 419   if (!SCM_FALSEP (p[1]))                       \
 420     {                                           \
 421       /* Unlink the heap stack */               \
 422       vp->this_frame = p[1];                    \
 423     }                                           \
 424   else                                          \
 425     {                                           \
 426       /* Move stack items */                    \
 427       p += 4;                                   \
 428       sp = SCM_FRAME_LOWER_ADDRESS (last_fp);   \
 429       while (p <= last_sp)                      \
 430         *sp++ = *p++;                           \
 431       sp--;                                     \
 432     }                                           \
 433 }
 434
 435 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 436
 437 \f
 438 /*
 439  * Function support
 440  */
 441
 442 #define ARGS1(a1)       SCM a1 = sp[0];
 443 #define ARGS2(a1,a2)    SCM a1 = sp[-1], a2 = sp[0]; sp--;
 444 #define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
 445
 446 #define RETURN(x)       do { *sp = x; NEXT; } while (0)
 447
 448 /*
 449   Local Variables:
 450   c-file-style: "gnu"
 451   End:
 452 */