libguile/vm-engine.h

   1 /* Copyright (C) 2001, 2009 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 #define CACHE_REGISTER()                        \
 106 {                                               \
 107   ip = vp->ip;                                  \
 108   sp = vp->sp;                                  \
 109   fp = vp->fp;                                  \
 110 }
 111
 112 #define SYNC_REGISTER()                         \
 113 {                                               \
 114   vp->ip = ip;                                  \
 115   vp->sp = sp;                                  \
 116   vp->fp = fp;                                  \
 117 }
 118
 119 /* FIXME */
 120 #define ASSERT_VARIABLE(x)                                              \
 121   do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
 122   } while (0)
 123 #define ASSERT_BOUND_VARIABLE(x)                                        \
 124   do { ASSERT_VARIABLE (x);                                             \
 125     if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED)                          \
 126       { SYNC_REGISTER (); abort(); }                                    \
 127   } while (0)
 128
 129 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
 130 #define CHECK_IP() \
 131   do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
 132 #define ASSERT_ALIGNED_PROCEDURE() \
 133   do { if ((scm_t_bits)bp % 8) abort (); } while (0)
 134 #define ASSERT_BOUND(x) \
 135   do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
 136   } while (0)
 137 #else
 138 #define CHECK_IP()
 139 #define ASSERT_ALIGNED_PROCEDURE()
 140 #define ASSERT_BOUND(x)
 141 #endif
 142
 143 /* Cache the object table and free variables.  */
 144 #define CACHE_PROGRAM()                                                 \
 145 {                                                                       \
 146   if (bp != SCM_PROGRAM_DATA (program)) {                               \
 147     bp = SCM_PROGRAM_DATA (program);                                    \
 148     ASSERT_ALIGNED_PROCEDURE ();                                        \
 149     if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
 150       objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
 151       object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
 152     } else {                                                            \
 153       objects = NULL;                                                   \
 154       object_count = 0;                                                 \
 155     }                                                                   \
 156   }                                                                     \
 157   {                                                                     \
 158     SCM c = SCM_PROGRAM_FREE_VARIABLES (program);                       \
 159     if (SCM_I_IS_VECTOR (c))                                            \
 160       {                                                                 \
 161         free_vars = SCM_I_VECTOR_WELTS (c);                             \
 162         free_vars_count = SCM_I_VECTOR_LENGTH (c);                      \
 163       }                                                                 \
 164     else                                                                \
 165       {                                                                 \
 166         free_vars = NULL;                                               \
 167         free_vars_count = 0;                                            \
 168       }                                                                 \
 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 /* Accesses to a program's object table.  */
 188 #if VM_CHECK_OBJECT
 189 #define CHECK_OBJECT(_num) \
 190   do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
 191 #else
 192 #define CHECK_OBJECT(_num)
 193 #endif
 194
 195 #if VM_CHECK_FREE_VARIABLES
 196 #define CHECK_FREE_VARIABLE(_num) \
 197   do { if (SCM_UNLIKELY ((_num) >= free_vars_count)) goto vm_error_free_variable; } while (0)
 198 #else
 199 #define CHECK_FREE_VARIABLE(_num)
 200 #endif
 201
 202 \f
 203 /*
 204  * Hooks
 205  */
 206
 207 #undef RUN_HOOK
 208 #if VM_USE_HOOKS
 209 #define RUN_HOOK(h)                             \
 210 {                                               \
 211   if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
 212     {                                           \
 213       SYNC_REGISTER ();                         \
 214       vm_dispatch_hook (vp, vp->hooks[h], hook_args);      \
 215       CACHE_REGISTER ();                        \
 216     }                                           \
 217 }
 218 #else
 219 #define RUN_HOOK(h)
 220 #endif
 221
 222 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 223 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 224 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 225 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 226 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 227 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 228 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 229 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 230
 231 \f
 232 /*
 233  * Stack operation
 234  */
 235
 236 #ifdef VM_ENABLE_STACK_NULLING
 237 # define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
 238 # define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
 239 # define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
 240 /* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
 241    inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
 242    that continuation doesn't have a chance to run. It's not important on a
 243    semantic level, but it does mess up our stack nulling -- so this macro is to
 244    fix that. */
 245 # define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
 246 #else
 247 # define CHECK_STACK_LEAKN(_n)
 248 # define CHECK_STACK_LEAK()
 249 # define NULLSTACK(_n)
 250 # define NULLSTACK_FOR_NONLOCAL_EXIT()
 251 #endif
 252
 253 #define CHECK_OVERFLOW()                        \
 254   if (sp >= stack_limit)                        \
 255     goto vm_error_stack_overflow
 256
 257 #define CHECK_UNDERFLOW()                       \
 258   if (sp < SCM_FRAME_UPPER_ADDRESS (fp))        \
 259     goto vm_error_stack_underflow;
 260
 261 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 262 #define DROP()  do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
 263 #define DROPN(_n)       do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
 264 #define POP(x)  do { x = *sp; DROP (); } while (0)
 265
 266 /* A fast CONS.  This has to be fast since its used, for instance, by
 267    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 268    inlined function in Guile 1.7.  Unfortunately, it calls
 269    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 270    heap.  XXX  */
 271 #define CONS(x,y,z)                                     \
 272 {                                                       \
 273   SYNC_BEFORE_GC ();                                    \
 274   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 275 }
 276
 277 /* Pop the N objects on top of the stack and push a list that contains
 278    them.  */
 279 #define POP_LIST(n)                             \
 280 do                                              \
 281 {                                               \
 282   int i;                                        \
 283   SCM l = SCM_EOL, x;                           \
 284   for (i = n; i; i--)                           \
 285     {                                           \
 286       POP (x);                                  \
 287       CONS (l, x, l);                           \
 288     }                                           \
 289   PUSH (l);                                     \
 290 } while (0)
 291
 292 /* The opposite: push all of the elements in L onto the list. */
 293 #define PUSH_LIST(l, NILP)                      \
 294 do                                              \
 295 {                                               \
 296   for (; scm_is_pair (l); l = SCM_CDR (l))      \
 297     PUSH (SCM_CAR (l));                         \
 298   if (SCM_UNLIKELY (!NILP (l))) {               \
 299     finish_args = scm_list_1 (l);               \
 300     goto vm_error_improper_list;                \
 301   }                                             \
 302 } while (0)
 303
 304 \f
 305 #define POP_LIST_MARK()                         \
 306 do {                                            \
 307   SCM o;                                        \
 308   SCM l = SCM_EOL;                              \
 309   POP (o);                                      \
 310   while (!SCM_UNBNDP (o))                       \
 311     {                                           \
 312       CONS (l, o, l);                           \
 313       POP (o);                                  \
 314     }                                           \
 315   PUSH (l);                                     \
 316 } while (0)
 317
 318 #define POP_CONS_MARK()                         \
 319 do {                                            \
 320   SCM o, l;                                     \
 321   POP (l);                                      \
 322   POP (o);                                      \
 323   while (!SCM_UNBNDP (o))                       \
 324     {                                           \
 325       CONS (l, o, l);                           \
 326       POP (o);                                  \
 327     }                                           \
 328   PUSH (l);                                     \
 329 } while (0)
 330
 331 \f
 332 /*
 333  * Instruction operation
 334  */
 335
 336 #define FETCH()         (*ip++)
 337 #define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
 338
 339 #undef CLOCK
 340 #if VM_USE_CLOCK
 341 #define CLOCK(n)        vp->clock += n
 342 #else
 343 #define CLOCK(n)
 344 #endif
 345
 346 #undef NEXT_JUMP
 347 #ifdef HAVE_LABELS_AS_VALUES
 348 #define NEXT_JUMP()             goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
 349 #else
 350 #define NEXT_JUMP()             goto vm_start
 351 #endif
 352
 353 #define NEXT                                    \
 354 {                                               \
 355   CLOCK (1);                                    \
 356   NEXT_HOOK ();                                 \
 357   CHECK_STACK_LEAK ();                          \
 358   NEXT_JUMP ();                                 \
 359 }
 360
 361 \f
 362 /* See frames.h for the layout of stack frames */
 363 /* When this is called, bp points to the new program data,
 364    and the arguments are already on the stack */
 365 #define DROP_FRAME()                            \
 366   {                                             \
 367     sp -= 3;                                    \
 368     NULLSTACK (3);                              \
 369     CHECK_UNDERFLOW ();                         \
 370   }
 371
 372
 373 /*
 374   Local Variables:
 375   c-file-style: "gnu"
 376   End:
 377 */