libguile/vm-engine.h

   1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012 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 #define VM_ASSERT(condition, handler) \
 107   do { if (SCM_UNLIKELY (!(condition))) { SYNC_ALL(); handler; } } while (0)
 108
 109 #ifdef VM_ENABLE_ASSERTIONS
 110 # define ASSERT(condition) VM_ASSERT (condition, abort())
 111 #else
 112 # define ASSERT(condition)
 113 #endif
 114
 115
 116 /* Cache the VM's instruction, stack, and frame pointer in local variables.  */
 117 #define CACHE_REGISTER()                        \
 118 {                                               \
 119   ip = vp->ip;                                  \
 120   sp = vp->sp;                                  \
 121   fp = vp->fp;                                  \
 122 }
 123
 124 /* Update the registers in VP, a pointer to the current VM.  This must be done
 125    at least before any GC invocation so that `vp->sp' is up-to-date and the
 126    whole stack gets marked.  */
 127 #define SYNC_REGISTER()                         \
 128 {                                               \
 129   vp->ip = ip;                                  \
 130   vp->sp = sp;                                  \
 131   vp->fp = fp;                                  \
 132 }
 133
 134 /* FIXME */
 135 #define ASSERT_VARIABLE(x)                                              \
 136   do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
 137   } while (0)
 138 #define ASSERT_BOUND_VARIABLE(x)                                        \
 139   do { ASSERT_VARIABLE (x);                                             \
 140     if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED))                \
 141       { SYNC_REGISTER (); abort(); }                                    \
 142   } while (0)
 143
 144 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
 145 #define CHECK_IP() \
 146   do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
 147 #define ASSERT_ALIGNED_PROCEDURE() \
 148   do { if ((scm_t_bits)bp % 8) abort (); } while (0)
 149 #define ASSERT_BOUND(x) \
 150   do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
 151   } while (0)
 152 #else
 153 #define CHECK_IP()
 154 #define ASSERT_ALIGNED_PROCEDURE()
 155 #define ASSERT_BOUND(x)
 156 #endif
 157
 158 #if VM_CHECK_OBJECT
 159 #define SET_OBJECT_COUNT(n) object_count = n
 160 #else
 161 #define SET_OBJECT_COUNT(n) /* nop */
 162 #endif
 163
 164 /* Cache the object table and free variables.  */
 165 #define CACHE_PROGRAM()                                                 \
 166 {                                                                       \
 167   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 168     bp = SCM_PROGRAM_DATA (program);                                    \
 169     ASSERT_ALIGNED_PROCEDURE ();                                        \
 170     if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
 171       objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
 172       SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
 173     } else {                                                            \
 174       objects = NULL;                                                   \
 175       SET_OBJECT_COUNT (0);                                             \
 176     }                                                                   \
 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 /* Accesses to a program's object table.  */
 196 #if VM_CHECK_OBJECT
 197 #define CHECK_OBJECT(_num)                              \
 198   VM_ASSERT ((_num) < object_count, vm_error_object ())
 199 #else
 200 #define CHECK_OBJECT(_num)
 201 #endif
 202
 203 #if VM_CHECK_FREE_VARIABLES
 204 #define CHECK_FREE_VARIABLE(_num)                               \
 205   VM_ASSERT ((_num) < SCM_PROGRAM_NUM_FREE_VARIABLES (program), \
 206              vm_error_free_variable ())
 207 #else
 208 #define CHECK_FREE_VARIABLE(_num)
 209 #endif
 210
 211 \f
 212 /*
 213  * Hooks
 214  */
 215
 216 #undef RUN_HOOK
 217 #undef RUN_HOOK1
 218 #if VM_USE_HOOKS
 219 #define RUN_HOOK(h)                                     \
 220   {                                                     \
 221     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 222       {                                                 \
 223         SYNC_REGISTER ();                               \
 224         vm_dispatch_hook (vm, h);                       \
 225       }                                                 \
 226   }
 227 #define RUN_HOOK1(h, x)                                 \
 228   {                                                     \
 229     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 230       {                                                 \
 231         PUSH (x);                                       \
 232         SYNC_REGISTER ();                               \
 233         vm_dispatch_hook (vm, h);                       \
 234         DROP();                                         \
 235       }                                                 \
 236   }
 237 #else
 238 #define RUN_HOOK(h)
 239 #define RUN_HOOK1(h, x)
 240 #endif
 241
 242 #define APPLY_HOOK()                            \
 243   RUN_HOOK (SCM_VM_APPLY_HOOK)
 244 #define PUSH_CONTINUATION_HOOK()                \
 245   RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
 246 #define POP_CONTINUATION_HOOK(n)                \
 247   RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
 248 #define NEXT_HOOK()                             \
 249   RUN_HOOK (SCM_VM_NEXT_HOOK)
 250 #define ABORT_CONTINUATION_HOOK()               \
 251   RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
 252 #define RESTORE_CONTINUATION_HOOK()            \
 253   RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
 254
 255 #define VM_HANDLE_INTERRUPTS                     \
 256   SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
 257
 258 \f
 259 /*
 260  * Stack operation
 261  */
 262
 263 #ifdef VM_ENABLE_STACK_NULLING
 264 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 265 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 266 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 267 /* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
 268    inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
 269    that continuation doesn't have a chance to run. It's not important on a
 270    semantic level, but it does mess up our stack nulling -- so this macro is to
 271    fix that. */
 272 # define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
 273 #else
 274 # define CHECK_STACK_LEAKN(_n)
 275 # define CHECK_STACK_LEAK()
 276 # define NULLSTACK(_n)
 277 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 278 #endif
 279
 280 /* For this check, we don't use VM_ASSERT, because that leads to a
 281    per-site SYNC_ALL, which is too much code growth.  The real problem
 282    of course is having to check for overflow all the time... */
 283 #define CHECK_OVERFLOW()                                                \
 284   do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
 285
 286
 287 #ifdef VM_CHECK_UNDERFLOW
 288 #define PRE_CHECK_UNDERFLOW(N)                  \
 289   VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
 290 #define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
 291 #else
 292 #define PRE_CHECK_UNDERFLOW(N) /* nop */
 293 #define CHECK_UNDERFLOW() /* 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   VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
 337 } while (0)
 338
 339 \f
 340 #define POP_LIST_MARK()                         \
 341 do {                                            \
 342   SCM o;                                        \
 343   SCM l = SCM_EOL;                              \
 344   POP (o);                                      \
 345   while (!SCM_UNBNDP (o))                       \
 346     {                                           \
 347       CONS (l, o, l);                           \
 348       POP (o);                                  \
 349     }                                           \
 350   PUSH (l);                                     \
 351 } while (0)
 352
 353 #define POP_CONS_MARK()                         \
 354 do {                                            \
 355   SCM o, l;                                     \
 356   POP (l);                                      \
 357   POP (o);                                      \
 358   while (!SCM_UNBNDP (o))                       \
 359     {                                           \
 360       CONS (l, o, l);                           \
 361       POP (o);                                  \
 362     }                                           \
 363   PUSH (l);                                     \
 364 } while (0)
 365
 366 \f
 367 /*
 368  * Instruction operation
 369  */
 370
 371 #define FETCH()         (*ip++)
 372 #define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
 373
 374 #undef NEXT_JUMP
 375 #ifdef HAVE_LABELS_AS_VALUES
 376 #define NEXT_JUMP()             goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
 377 #else
 378 #define NEXT_JUMP()             goto vm_start
 379 #endif
 380
 381 #define NEXT                                    \
 382 {                                               \
 383   NEXT_HOOK ();                                 \
 384   CHECK_STACK_LEAK ();                          \
 385   NEXT_JUMP ();                                 \
 386 }
 387
 388 \f
 389 /* See frames.h for the layout of stack frames */
 390 /* When this is called, bp points to the new program data,
 391    and the arguments are already on the stack */
 392 #define DROP_FRAME()                            \
 393   {                                             \
 394     sp -= 3;                                    \
 395     NULLSTACK (3);                              \
 396     CHECK_UNDERFLOW ();                         \
 397   }
 398
 399
 400 /*
 401   Local Variables:
 402   c-file-style: "gnu"
 403   End:
 404 */