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 POP(x)  do { x = *sp; DROP (); } while (0)
 218
 219 /* A fast CONS.  This has to be fast since its used, for instance, by
 220    POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
 221    inlined function in Guile 1.7.  Unfortunately, it calls
 222    `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
 223    heap.  XXX  */
 224 #define CONS(x,y,z)                                     \
 225 {                                                       \
 226   SYNC_BEFORE_GC ();                                    \
 227   x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));        \
 228 }
 229
 230 #define POP_LIST(n)                             \
 231 do {                                            \
 232   int i;                                        \
 233   SCM l = SCM_EOL;                              \
 234   sp -= n;                                      \
 235   for (i = n; i; i--)                           \
 236     CONS (l, sp[i], l);                         \
 237   PUSH (l);                                     \
 238 } while (0)
 239
 240 #define POP_LIST_MARK()                         \
 241 do {                                            \
 242   SCM o;                                        \
 243   SCM l = SCM_EOL;                              \
 244   POP (o);                                      \
 245   while (!SCM_UNBNDP (o))                       \
 246     {                                           \
 247       CONS (l, o, l);                           \
 248       POP (o);                                  \
 249     }                                           \
 250   PUSH (l);                                     \
 251 } while (0)
 252
 253 \f
 254 /*
 255  * Instruction operation
 256  */
 257
 258 #define FETCH()         (*ip++)
 259 #define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
 260
 261 #undef CLOCK
 262 #if VM_USE_CLOCK
 263 #define CLOCK(n)        vp->clock += n
 264 #else
 265 #define CLOCK(n)
 266 #endif
 267
 268 #undef NEXT_JUMP
 269 #ifdef HAVE_LABELS_AS_VALUES
 270 #define NEXT_JUMP()             goto *jump_table[FETCH ()]
 271 #else
 272 #define NEXT_JUMP()             goto vm_start
 273 #endif
 274
 275 #define NEXT                                    \
 276 {                                               \
 277   CLOCK (1);                                    \
 278   NEXT_HOOK ();                                 \
 279   NEXT_JUMP ();                                 \
 280 }
 281
 282 \f
 283 /*
 284  * Stack frame
 285  */
 286
 287 #define INIT_ARGS()                             \
 288 {                                               \
 289   if (bp->nrest)                                \
 290     {                                           \
 291       int n = nargs - (bp->nargs - 1);          \
 292       if (n < 0)                                \
 293         goto vm_error_wrong_num_args;           \
 294       POP_LIST (n);                             \
 295     }                                           \
 296   else                                          \
 297     {                                           \
 298       if (nargs != bp->nargs)                   \
 299         goto vm_error_wrong_num_args;           \
 300     }                                           \
 301 }
 302
 303 /* See frames.h for the layout of stack frames */
 304
 305 #define NEW_FRAME()                             \
 306 {                                               \
 307   int i;                                        \
 308   SCM ra = SCM_PACK (ip);                       \
 309   SCM dl = SCM_PACK (fp);                       \
 310   SCM *p = sp + 1;                              \
 311   SCM *q = p + bp->nlocs;                       \
 312                                                 \
 313   /* New pointers */                            \
 314   ip = bp->base;                                \
 315   fp = p - bp->nargs;                           \
 316   sp = q + 3;                                   \
 317   CHECK_OVERFLOW ();                            \
 318                                                 \
 319   /* Init local variables */                    \
 320   for (; p < q; p++)                            \
 321     *p = SCM_UNDEFINED;                         \
 322                                                 \
 323   /* Create external variables */               \
 324   external = bp->external;                      \
 325   for (i = 0; i < bp->nexts; i++)               \
 326     CONS (external, SCM_UNDEFINED, external);   \
 327                                                 \
 328   /* Set frame data */                          \
 329   p[3] = ra;                                    \
 330   p[2] = dl;                                    \
 331   p[1] = SCM_BOOL_F;                            \
 332   p[0] = external;                              \
 333 }
 334
 335 #define FREE_FRAME()                            \
 336 {                                               \
 337   SCM *last_sp = sp;                            \
 338   SCM *last_fp = fp;                            \
 339   SCM *p = fp + bp->nargs + bp->nlocs;          \
 340                                                 \
 341   /* Restore pointers */                        \
 342   ip = SCM_FRAME_BYTE_CAST (p[3]);              \
 343   fp = SCM_FRAME_STACK_CAST (p[2]);             \
 344                                                 \
 345   if (!SCM_FALSEP (p[1]))                       \
 346     {                                           \
 347       /* Unlink the heap stack */               \
 348       vp->this_frame = p[1];                    \
 349     }                                           \
 350   else                                          \
 351     {                                           \
 352       /* Move stack items */                    \
 353       p += 4;                                   \
 354       sp = SCM_FRAME_LOWER_ADDRESS (last_fp);   \
 355       while (p <= last_sp)                      \
 356         *sp++ = *p++;                           \
 357       sp--;                                     \
 358     }                                           \
 359 }
 360
 361 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 362
 363 \f
 364 /*
 365  * Function support
 366  */
 367
 368 #define ARGS1(a1)       SCM a1 = sp[0];
 369 #define ARGS2(a1,a2)    SCM a1 = sp[-1], a2 = sp[0]; sp--;
 370 #define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
 371
 372 #define RETURN(x)       do { *sp = x; NEXT; } while (0)
 373
 374 /*
 375   Local Variables:
 376   c-file-style: "gnu"
 377   End:
 378 */