libguile/vm-engine.h

   1 /* Copyright (C) 2001, 2009, 2010 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 #endif
  61 #if defined(PPC) || defined(_POWER) || defined(_IBMR2)
  62 #define IP_REG asm("26")
  63 #define SP_REG asm("27")
  64 #define FP_REG asm("28")
  65 #endif
  66 #ifdef __hppa__
  67 #define IP_REG asm("%r18")
  68 #define SP_REG asm("%r17")
  69 #define FP_REG asm("%r16")
  70 #endif
  71 #ifdef __mc68000__
  72 #define IP_REG asm("a5")
  73 #define SP_REG asm("a4")
  74 #define FP_REG
  75 #endif
  76 #ifdef __arm__
  77 #define IP_REG asm("r9")
  78 #define SP_REG asm("r8")
  79 #define FP_REG asm("r7")
  80 #endif
  81 #endif
  82
  83 #ifndef IP_REG
  84 #define IP_REG
  85 #endif
  86 #ifndef SP_REG
  87 #define SP_REG
  88 #endif
  89 #ifndef FP_REG
  90 #define FP_REG
  91 #endif
  92
  93 \f
  94 /*
  95  * Cache/Sync
  96  */
  97
  98 #ifdef VM_ENABLE_ASSERTIONS
  99 # define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
 100 #else
 101 # define ASSERT(condition)
 102 #endif
 103
 104
 105 /* Cache the VM's instruction, stack, and frame pointer in local variables.  */
 106 #define CACHE_REGISTER()                        \
 107 {                                               \
 108   ip = vp->ip;                                  \
 109   sp = vp->sp;                                  \
 110   fp = vp->fp;                                  \
 111 }
 112
 113 /* Update the registers in VP, a pointer to the current VM.  This must be done
 114    at least before any GC invocation so that `vp->sp' is up-to-date and the
 115    whole stack gets marked.  */
 116 #define SYNC_REGISTER()                         \
 117 {                                               \
 118   vp->ip = ip;                                  \
 119   vp->sp = sp;                                  \
 120   vp->fp = fp;                                  \
 121 }
 122
 123 /* FIXME */
 124 #define ASSERT_VARIABLE(x)                                              \
 125   do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
 126   } while (0)
 127 #define ASSERT_BOUND_VARIABLE(x)                                        \
 128   do { ASSERT_VARIABLE (x);                                             \
 129     if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED)                          \
 130       { SYNC_REGISTER (); abort(); }                                    \
 131   } while (0)
 132
 133 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
 134 #define CHECK_IP() \
 135   do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
 136 #define ASSERT_ALIGNED_PROCEDURE() \
 137   do { if ((scm_t_bits)bp % 8) abort (); } while (0)
 138 #define ASSERT_BOUND(x) \
 139   do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
 140   } while (0)
 141 #else
 142 #define CHECK_IP()
 143 #define ASSERT_ALIGNED_PROCEDURE()
 144 #define ASSERT_BOUND(x)
 145 #endif
 146
 147 /* Cache the object table and free variables.  */
 148 #define CACHE_PROGRAM()                                                 \
 149 {                                                                       \
 150   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 151     bp = SCM_PROGRAM_DATA (program);                                    \
 152     ASSERT_ALIGNED_PROCEDURE ();                                        \
 153     if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
 154       objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
 155       object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
 156     } else {                                                            \
 157       objects = NULL;                                                   \
 158       object_count = 0;                                                 \
 159     }                                                                   \
 160   }                                                                     \
 161 }
 162
 163 #define SYNC_BEFORE_GC()                        \
 164 {                                               \
 165   SYNC_REGISTER ();                             \
 166 }
 167
 168 #define SYNC_ALL()                              \
 169 {                                               \
 170   SYNC_REGISTER ();                             \
 171 }
 172
 173 \f
 174 /*
 175  * Error check
 176  */
 177
 178 /* Accesses to a program's object table.  */
 179 #if VM_CHECK_OBJECT
 180 #define CHECK_OBJECT(_num) \
 181   do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
 182 #else
 183 #define CHECK_OBJECT(_num)
 184 #endif
 185
 186 #if VM_CHECK_FREE_VARIABLES
 187 #define CHECK_FREE_VARIABLE(_num)                                       \
 188   do {                                                                  \
 189     if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
 190       goto vm_error_free_variable;                                      \
 191   } while (0)
 192 #else
 193 #define CHECK_FREE_VARIABLE(_num)
 194 #endif
 195
 196 \f
 197 /*
 198  * Hooks
 199  */
 200
 201 #undef RUN_HOOK
 202 #undef RUN_HOOK1
 203 #if VM_USE_HOOKS
 204 #define RUN_HOOK(h)                                     \
 205   {                                                     \
 206     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 207       {                                                 \
 208         SYNC_REGISTER ();                               \
 209         vm_dispatch_hook (vm, h);                       \
 210       }                                                 \
 211   }
 212 #define RUN_HOOK1(h, x)                                 \
 213   {                                                     \
 214     if (SCM_UNLIKELY (vp->trace_level > 0))             \
 215       {                                                 \
 216         PUSH (x);                                       \
 217         SYNC_REGISTER ();                               \
 218         vm_dispatch_hook (vm, h);                       \
 219         DROP();                                         \
 220       }                                                 \
 221   }
 222 #else
 223 #define RUN_HOOK(h)
 224 #define RUN_HOOK1(h, x)
 225 #endif
 226
 227 #define APPLY_HOOK()                            \
 228   RUN_HOOK (SCM_VM_APPLY_HOOK)
 229 #define PUSH_CONTINUATION_HOOK()                \
 230   RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
 231 #define POP_CONTINUATION_HOOK(n)                \
 232   RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
 233 #define NEXT_HOOK()                             \
 234   RUN_HOOK (SCM_VM_NEXT_HOOK)
 235
 236 #define VM_HANDLE_INTERRUPTS                     \
 237   SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())
 238
 239 \f
 240 /*
 241  * Stack operation
 242  */
 243
 244 #ifdef VM_ENABLE_STACK_NULLING
 245 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 246 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 247 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 248 /* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
 249    inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
 250    that continuation doesn't have a chance to run. It's not important on a
 251    semantic level, but it does mess up our stack nulling -- so this macro is to
 252    fix that. */
 253 # define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
 254 #else
 255 # define CHECK_STACK_LEAKN(_n)
 256 # define CHECK_STACK_LEAK()
 257 # define NULLSTACK(_n)
 258 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 259 #endif
 260
 261 #define CHECK_OVERFLOW()                        \
 262   if (SCM_UNLIKELY (sp >= stack_limit))         \
 263     goto vm_error_stack_overflow
 264
 265 #define CHECK_UNDERFLOW()                       \
 266   if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp)))        \
 267     goto vm_error_stack_underflow;
 268
 269 #define PRE_CHECK_UNDERFLOW(N)                  \
 270   if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp)))    \
 271     goto vm_error_stack_underflow;
 272
 273 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 274 #define DROP()  do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
 275 #define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
 276 #define POP(x)  do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
 277
 278 /* A fast CONS.  This has to be fast since its used, for instance, by
 279    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 280    inlined function in Guile 1.7.  Unfortunately, it calls
 281    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 282    heap.  XXX  */
 283 #define CONS(x,y,z)                                     \
 284 {                                                       \
 285   SYNC_BEFORE_GC ();                                    \
 286   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 287 }
 288
 289 /* Pop the N objects on top of the stack and push a list that contains
 290    them.  */
 291 #define POP_LIST(n)                             \
 292 do                                              \
 293 {                                               \
 294   int i;                                        \
 295   SCM l = SCM_EOL, x;                           \
 296   for (i = n; i; i--)                           \
 297     {                                           \
 298       POP (x);                                  \
 299       CONS (l, x, l);                           \
 300     }                                           \
 301   PUSH (l);                                     \
 302 } while (0)
 303
 304 /* The opposite: push all of the elements in L onto the list. */
 305 #define PUSH_LIST(l, NILP)                      \
 306 do                                              \
 307 {                                               \
 308   for (; scm_is_pair (l); l = SCM_CDR (l))      \
 309     PUSH (SCM_CAR (l));                         \
 310   if (SCM_UNLIKELY (!NILP (l))) {               \
 311     finish_args = scm_list_1 (l);               \
 312     goto vm_error_improper_list;                \
 313   }                                             \
 314 } while (0)
 315
 316 \f
 317 #define POP_LIST_MARK()                         \
 318 do {                                            \
 319   SCM o;                                        \
 320   SCM l = SCM_EOL;                              \
 321   POP (o);                                      \
 322   while (!SCM_UNBNDP (o))                       \
 323     {                                           \
 324       CONS (l, o, l);                           \
 325       POP (o);                                  \
 326     }                                           \
 327   PUSH (l);                                     \
 328 } while (0)
 329
 330 #define POP_CONS_MARK()                         \
 331 do {                                            \
 332   SCM o, l;                                     \
 333   POP (l);                                      \
 334   POP (o);                                      \
 335   while (!SCM_UNBNDP (o))                       \
 336     {                                           \
 337       CONS (l, o, l);                           \
 338       POP (o);                                  \
 339     }                                           \
 340   PUSH (l);                                     \
 341 } while (0)
 342
 343 \f
 344 /*
 345  * Instruction operation
 346  */
 347
 348 #define FETCH()         (*ip++)
 349 #define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
 350
 351 #undef NEXT_JUMP
 352 #ifdef HAVE_LABELS_AS_VALUES
 353 #define NEXT_JUMP()             goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
 354 #else
 355 #define NEXT_JUMP()             goto vm_start
 356 #endif
 357
 358 #define NEXT                                    \
 359 {                                               \
 360   NEXT_HOOK ();                                 \
 361   CHECK_STACK_LEAK ();                          \
 362   NEXT_JUMP ();                                 \
 363 }
 364
 365 \f
 366 /* See frames.h for the layout of stack frames */
 367 /* When this is called, bp points to the new program data,
 368    and the arguments are already on the stack */
 369 #define DROP_FRAME()                            \
 370   {                                             \
 371     sp -= 3;                                    \
 372     NULLSTACK (3);                              \
 373     CHECK_UNDERFLOW ();                         \
 374   }
 375
 376
 377 /*
 378   Local Variables:
 379   c-file-style: "gnu"
 380   End:
 381 */