libguile/vm-engine.h

   1 /* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19 /* This file is included in vm_engine.c */
  20
  21 \f
  22 /*
  23  * Registers
  24  */
  25
  26 /* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
  27
  28    Some compilers underestimate the use of the local variables representing
  29    the abstract machine registers, and don't put them in hardware registers,
  30    which slows down the interpreter considerably.
  31    For GCC, I have hand-assigned hardware registers for several architectures.
  32 */
  33
  34 #ifdef __GNUC__
  35 #ifdef __mips__
  36 #define IP_REG asm("$16")
  37 #define SP_REG asm("$17")
  38 #define FP_REG asm("$18")
  39 #endif
  40 #ifdef __sparc__
  41 #define IP_REG asm("%l0")
  42 #define SP_REG asm("%l1")
  43 #define FP_REG asm("%l2")
  44 #endif
  45 #ifdef __alpha__
  46 #ifdef __CRAY__
  47 #define IP_REG asm("r9")
  48 #define SP_REG asm("r10")
  49 #define FP_REG asm("r11")
  50 #else
  51 #define IP_REG asm("$9")
  52 #define SP_REG asm("$10")
  53 #define FP_REG asm("$11")
  54 #endif
  55 #endif
  56 #ifdef __i386__
  57 /* too few registers! because of register allocation errors with various gcs,
  58    just punt on explicit assignments on i386, hoping that the "register"
  59    declaration will be sufficient. */
  60 #elif defined __x86_64__
  61 /* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
  62    well.  Tell it to keep the jump table in a r12, which is
  63    callee-saved.  */
  64 #define JT_REG asm ("r12")
  65 #endif
  66 #if defined(PPC) || defined(_POWER) || defined(_IBMR2)
  67 #define IP_REG asm("26")
  68 #define SP_REG asm("27")
  69 #define FP_REG asm("28")
  70 #endif
  71 #ifdef __hppa__
  72 #define IP_REG asm("%r18")
  73 #define SP_REG asm("%r17")
  74 #define FP_REG asm("%r16")
  75 #endif
  76 #ifdef __mc68000__
  77 #define IP_REG asm("a5")
  78 #define SP_REG asm("a4")
  79 #define FP_REG
  80 #endif
  81 #ifdef __arm__
  82 #define IP_REG asm("r9")
  83 #define SP_REG asm("r8")
  84 #define FP_REG asm("r7")
  85 #endif
  86 #endif
  87
  88 #ifndef IP_REG
  89 #define IP_REG
  90 #endif
  91 #ifndef SP_REG
  92 #define SP_REG
  93 #endif
  94 #ifndef FP_REG
  95 #define FP_REG
  96 #endif
  97 #ifndef JT_REG
  98 #define JT_REG
  99 #endif
 100
 101 \f
 102 /*
 103  * Cache/Sync
 104  */
 105
 106 #ifdef VM_ENABLE_ASSERTIONS
 107 # define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
 108 #else
 109 # define ASSERT(condition)
 110 #endif
 111
 112
 113 /* Cache the VM's instruction, stack, and frame pointer in local variables.  */
 114 #define CACHE_REGISTER()                        \
 115 {                                               \
 116   ip = vp->ip;                                  \
 117   sp = vp->sp;                                  \
 118   fp = vp->fp;                                  \
 119 }
 120
 121 /* Update the registers in VP, a pointer to the current VM.  This must be done
 122    at least before any GC invocation so that `vp->sp' is up-to-date and the
 123    whole stack gets marked.  */
 124 #define SYNC_REGISTER()                         \
 125 {                                               \
 126   vp->ip = ip;                                  \
 127   vp->sp = sp;                                  \
 128   vp->fp = fp;                                  \
 129 }
 130
 131 /* FIXME */
 132 #define ASSERT_VARIABLE(x)                                              \
 133   do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
 134   } while (0)
 135 #define ASSERT_BOUND_VARIABLE(x)                                        \
 136   do { ASSERT_VARIABLE (x);                                             \
 137     if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED))                \
 138       { SYNC_REGISTER (); abort(); }                                    \
 139   } while (0)
 140
 141 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
 142 #define CHECK_IP() \
 143   do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
 144 #define ASSERT_ALIGNED_PROCEDURE() \
 145   do { if ((scm_t_bits)bp % 8) abort (); } while (0)
 146 #define ASSERT_BOUND(x) \
 147   do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
 148   } while (0)
 149 #else
 150 #define CHECK_IP()
 151 #define ASSERT_ALIGNED_PROCEDURE()
 152 #define ASSERT_BOUND(x)
 153 #endif
 154
 155 #if VM_CHECK_OBJECT
 156 #define SET_OBJECT_COUNT(n) object_count = n
 157 #else
 158 #define SET_OBJECT_COUNT(n) /* nop */
 159 #endif
 160
 161 /* Cache the object table and free variables.  */
 162 #define CACHE_PROGRAM()                                                 \
 163 {                                                                       \
 164   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 165     bp = SCM_PROGRAM_DATA (program);                                    \
 166     ASSERT_ALIGNED_PROCEDURE ();                                        \
 167     if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
 168       objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
 169       SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
 170     } else {                                                            \
 171       objects = NULL;                                                   \
 172       SET_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 /* Accesses to a program's object table.  */
 193 #if VM_CHECK_OBJECT
 194 #define CHECK_OBJECT(_num) \
 195   do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
 196 #else
 197 #define CHECK_OBJECT(_num)
 198 #endif
 199
 200 #if VM_CHECK_FREE_VARIABLES
 201 #define CHECK_FREE_VARIABLE(_num)                                       \
 202   do {                                                                  \
 203     if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
 204       goto vm_error_free_variable;                                      \
 205   } while (0)
 206 #else
 207 #define CHECK_FREE_VARIABLE(_num)
 208 #endif
 209
 210 \f
 211 /*
 212  * Hooks
 213  */
 214
 215 #undef RUN_HOOK
 216 #undef RUN_HOOK1
 217 #if VM_USE_HOOKS
 218 #define RUN_HOOK(h)                                     \
 219   {                                                     \
 220     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 221       {                                                 \
 222         SYNC_REGISTER ();                               \
 223         vm_dispatch_hook (vm, h);                       \
 224       }                                                 \
 225   }
 226 #define RUN_HOOK1(h, x)                                 \
 227   {                                                     \
 228     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 229       {                                                 \
 230         PUSH (x);                                       \
 231         SYNC_REGISTER ();                               \
 232         vm_dispatch_hook (vm, h);                       \
 233         DROP();                                         \
 234       }                                                 \
 235   }
 236 #else
 237 #define RUN_HOOK(h)
 238 #define RUN_HOOK1(h, x)
 239 #endif
 240
 241 #define APPLY_HOOK()                            \
 242   RUN_HOOK (SCM_VM_APPLY_HOOK)
 243 #define PUSH_CONTINUATION_HOOK()                \
 244   RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
 245 #define POP_CONTINUATION_HOOK(n)                \
 246   RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
 247 #define NEXT_HOOK()                             \
 248   RUN_HOOK (SCM_VM_NEXT_HOOK)
 249 #define ABORT_CONTINUATION_HOOK()               \
 250   RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
 251 #define RESTORE_CONTINUATION_HOOK()            \
 252   RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
 253
 254 #define VM_HANDLE_INTERRUPTS                     \
 255   SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
 256
 257 \f
 258 /*
 259  * Stack operation
 260  */
 261
 262 #ifdef VM_ENABLE_STACK_NULLING
 263 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 264 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 265 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 266 /* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
 267    inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
 268    that continuation doesn't have a chance to run. It's not important on a
 269    semantic level, but it does mess up our stack nulling -- so this macro is to
 270    fix that. */
 271 # define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
 272 #else
 273 # define CHECK_STACK_LEAKN(_n)
 274 # define CHECK_STACK_LEAK()
 275 # define NULLSTACK(_n)
 276 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 277 #endif
 278
 279 #define CHECK_OVERFLOW()                        \
 280   if (SCM_UNLIKELY (sp >= stack_limit))         \
 281     goto vm_error_stack_overflow
 282
 283
 284 #ifdef VM_CHECK_UNDERFLOW
 285 #define CHECK_UNDERFLOW()                       \
 286   if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp)))        \
 287     goto vm_error_stack_underflow
 288 #define PRE_CHECK_UNDERFLOW(N)                  \
 289   if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp)))    \
 290     goto vm_error_stack_underflow
 291 #else
 292 #define CHECK_UNDERFLOW() /* nop */
 293 #define PRE_CHECK_UNDERFLOW(N) /* nop */
 294 #endif
 295
 296
 297 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 298 #define DROP()  do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
 299 #define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
 300 #define POP(x)  do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
 301 #define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
 302 #define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } while (0)
 303
 304 /* A fast CONS.  This has to be fast since its used, for instance, by
 305    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 306    inlined function in Guile 1.7.  Unfortunately, it calls
 307    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 308    heap.  XXX  */
 309 #define CONS(x,y,z)                                     \
 310 {                                                       \
 311   SYNC_BEFORE_GC ();                                    \
 312   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 313 }
 314
 315 /* Pop the N objects on top of the stack and push a list that contains
 316    them.  */
 317 #define POP_LIST(n)                             \
 318 do                                              \
 319 {                                               \
 320   int i;                                        \
 321   SCM l = SCM_EOL, x;                           \
 322   for (i = n; i; i--)                           \
 323     {                                           \
 324       POP (x);                                  \
 325       CONS (l, x, l);                           \
 326     }                                           \
 327   PUSH (l);                                     \
 328 } while (0)
 329
 330 /* The opposite: push all of the elements in L onto the list. */
 331 #define PUSH_LIST(l, NILP)                      \
 332 do                                              \
 333 {                                               \
 334   for (; scm_is_pair (l); l = SCM_CDR (l))      \
 335     PUSH (SCM_CAR (l));                         \
 336   if (SCM_UNLIKELY (!NILP (l))) {               \
 337     finish_args = scm_list_1 (l);               \
 338     goto vm_error_improper_list;                \
 339   }                                             \
 340 } while (0)
 341
 342 \f
 343 #define POP_LIST_MARK()                         \
 344 do {                                            \
 345   SCM o;                                        \
 346   SCM l = SCM_EOL;                              \
 347   POP (o);                                      \
 348   while (!SCM_UNBNDP (o))                       \
 349     {                                           \
 350       CONS (l, o, l);                           \
 351       POP (o);                                  \
 352     }                                           \
 353   PUSH (l);                                     \
 354 } while (0)
 355
 356 #define POP_CONS_MARK()                         \
 357 do {                                            \
 358   SCM o, l;                                     \
 359   POP (l);                                      \
 360   POP (o);                                      \
 361   while (!SCM_UNBNDP (o))                       \
 362     {                                           \
 363       CONS (l, o, l);                           \
 364       POP (o);                                  \
 365     }                                           \
 366   PUSH (l);                                     \
 367 } while (0)
 368
 369 \f
 370 /*
 371  * Instruction operation
 372  */
 373
 374 #define FETCH()         (*ip++)
 375 #define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
 376
 377 #undef NEXT_JUMP
 378 #ifdef HAVE_LABELS_AS_VALUES
 379 #define NEXT_JUMP()             goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
 380 #else
 381 #define NEXT_JUMP()             goto vm_start
 382 #endif
 383
 384 #define NEXT                                    \
 385 {                                               \
 386   NEXT_HOOK ();                                 \
 387   CHECK_STACK_LEAK ();                          \
 388   NEXT_JUMP ();                                 \
 389 }
 390
 391 \f
 392 /* See frames.h for the layout of stack frames */
 393 /* When this is called, bp points to the new program data,
 394    and the arguments are already on the stack */
 395 #define DROP_FRAME()                            \
 396   {                                             \
 397     sp -= 3;                                    \
 398     NULLSTACK (3);                              \
 399     CHECK_UNDERFLOW ();                         \
 400   }
 401
 402
 403 /*
 404   Local Variables:
 405   c-file-style: "gnu"
 406   End:
 407 */