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 #define CACHE_PROGRAM()                         \
 134 {                                               \
 135   bp = SCM_PROGRAM_DATA (program);              \
 136   objects = SCM_VELTS (bp->objs);               \
 137 }
 138
 139 #define SYNC_BEFORE_GC()                        \
 140 {                                               \
 141   SYNC_REGISTER ();                             \
 142 }
 143
 144 #define SYNC_ALL()                              \
 145 {                                               \
 146   SYNC_REGISTER ();                             \
 147 }
 148
 149 \f
 150 /*
 151  * Error check
 152  */
 153
 154 #undef CHECK_EXTERNAL
 155 #if VM_CHECK_EXTERNAL
 156 #define CHECK_EXTERNAL(e) \
 157   do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
 158 #else
 159 #define CHECK_EXTERNAL(e)
 160 #endif
 161
 162 \f
 163 /*
 164  * Hooks
 165  */
 166
 167 #undef RUN_HOOK
 168 #if VM_USE_HOOKS
 169 #define RUN_HOOK(h)                             \
 170 {                                               \
 171   if (!SCM_FALSEP (vp->hooks[h]))               \
 172     {                                           \
 173       SYNC_REGISTER ();                         \
 174       vm_heapify_frames (vm);                   \
 175       scm_c_run_hook (vp->hooks[h], hook_args); \
 176       CACHE_REGISTER ();                        \
 177     }                                           \
 178 }
 179 #else
 180 #define RUN_HOOK(h)
 181 #endif
 182
 183 #define BOOT_HOOK()     RUN_HOOK (SCM_VM_BOOT_HOOK)
 184 #define HALT_HOOK()     RUN_HOOK (SCM_VM_HALT_HOOK)
 185 #define NEXT_HOOK()     RUN_HOOK (SCM_VM_NEXT_HOOK)
 186 #define BREAK_HOOK()    RUN_HOOK (SCM_VM_BREAK_HOOK)
 187 #define ENTER_HOOK()    RUN_HOOK (SCM_VM_ENTER_HOOK)
 188 #define APPLY_HOOK()    RUN_HOOK (SCM_VM_APPLY_HOOK)
 189 #define EXIT_HOOK()     RUN_HOOK (SCM_VM_EXIT_HOOK)
 190 #define RETURN_HOOK()   RUN_HOOK (SCM_VM_RETURN_HOOK)
 191
 192 \f
 193 /*
 194  * Stack operation
 195  */
 196
 197 #define CHECK_OVERFLOW()                        \
 198   if (sp > stack_limit)                         \
 199     goto vm_error_stack_overflow
 200
 201 #define CHECK_UNDERFLOW()                       \
 202   if (sp < stack_base)                          \
 203     goto vm_error_stack_underflow
 204
 205 #define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
 206 #define DROP()  do { CHECK_UNDERFLOW (); sp--; } while (0)
 207 #define POP(x)  do { x = *sp; DROP (); } while (0)
 208
 209 #define CONS(x,y,z)                             \
 210 {                                               \
 211   SCM cell;                                     \
 212   SYNC_BEFORE_GC ();                            \
 213   SCM_NEWCELL (cell);                           \
 214   SCM_SET_CELL_OBJECT_0 (cell, y);              \
 215   SCM_SET_CELL_OBJECT_1 (cell, z);              \
 216   x = cell;                                     \
 217 }
 218
 219 #define POP_LIST(n)                             \
 220 do {                                            \
 221   int i;                                        \
 222   SCM l = SCM_EOL;                              \
 223   sp -= n;                                      \
 224   for (i = n; i; i--)                           \
 225     CONS (l, sp[i], l);                         \
 226   PUSH (l);                                     \
 227 } while (0)
 228
 229 #define POP_LIST_MARK()                         \
 230 do {                                            \
 231   SCM o;                                        \
 232   SCM l = SCM_EOL;                              \
 233   POP (o);                                      \
 234   while (!SCM_UNBNDP (o))                       \
 235     {                                           \
 236       CONS (l, o, l);                           \
 237       POP (o);                                  \
 238     }                                           \
 239   PUSH (l);                                     \
 240 } while (0)
 241
 242 \f
 243 /*
 244  * Instruction operation
 245  */
 246
 247 #define FETCH()         (*ip++)
 248 #define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
 249
 250 #undef CLOCK
 251 #if VM_USE_CLOCK
 252 #define CLOCK(n)        vp->clock += n
 253 #else
 254 #define CLOCK(n)
 255 #endif
 256
 257 #undef NEXT_JUMP
 258 #ifdef HAVE_LABELS_AS_VALUES
 259 #define NEXT_JUMP()             goto *jump_table[FETCH ()]
 260 #else
 261 #define NEXT_JUMP()             goto vm_start
 262 #endif
 263
 264 #define NEXT                                    \
 265 {                                               \
 266   CLOCK (1);                                    \
 267   NEXT_HOOK ();                                 \
 268   NEXT_JUMP ();                                 \
 269 }
 270
 271 \f
 272 /*
 273  * Stack frame
 274  */
 275
 276 #define INIT_ARGS()                             \
 277 {                                               \
 278   if (bp->nrest)                                \
 279     {                                           \
 280       int n = nargs - (bp->nargs - 1);          \
 281       if (n < 0)                                \
 282         goto vm_error_wrong_num_args;           \
 283       POP_LIST (n);                             \
 284     }                                           \
 285   else                                          \
 286     {                                           \
 287       if (nargs != bp->nargs)                   \
 288         goto vm_error_wrong_num_args;           \
 289     }                                           \
 290 }
 291
 292 /* See frames.h for the layout of stack frames */
 293
 294 #define NEW_FRAME()                             \
 295 {                                               \
 296   int i;                                        \
 297   SCM ra = SCM_PACK (ip);                       \
 298   SCM dl = SCM_PACK (fp);                       \
 299   SCM *p = sp + 1;                              \
 300   SCM *q = p + bp->nlocs;                       \
 301                                                 \
 302   /* New pointers */                            \
 303   ip = bp->base;                                \
 304   fp = p - bp->nargs;                           \
 305   sp = q + 3;                                   \
 306   CHECK_OVERFLOW ();                            \
 307                                                 \
 308   /* Init local variables */                    \
 309   for (; p < q; p++)                            \
 310     *p = SCM_UNDEFINED;                         \
 311                                                 \
 312   /* Create external variables */               \
 313   external = bp->external;                      \
 314   for (i = 0; i < bp->nexts; i++)               \
 315     CONS (external, SCM_UNDEFINED, external);   \
 316                                                 \
 317   /* Set frame data */                          \
 318   p[3] = ra;                                    \
 319   p[2] = dl;                                    \
 320   p[1] = SCM_BOOL_F;                            \
 321   p[0] = external;                              \
 322 }
 323
 324 #define FREE_FRAME()                            \
 325 {                                               \
 326   SCM *last_sp = sp;                            \
 327   SCM *last_fp = fp;                            \
 328   SCM *p = fp + bp->nargs + bp->nlocs;          \
 329                                                 \
 330   /* Restore pointers */                        \
 331   ip = SCM_FRAME_BYTE_CAST (p[3]);              \
 332   fp = SCM_FRAME_STACK_CAST (p[2]);             \
 333                                                 \
 334   if (!SCM_FALSEP (p[1]))                       \
 335     {                                           \
 336       /* Unlink the heap stack */               \
 337       vp->this_frame = p[1];                    \
 338     }                                           \
 339   else                                          \
 340     {                                           \
 341       /* Move stack items */                    \
 342       p += 4;                                   \
 343       sp = SCM_FRAME_LOWER_ADDRESS (last_fp);   \
 344       while (p <= last_sp)                      \
 345         *sp++ = *p++;                           \
 346       sp--;                                     \
 347     }                                           \
 348 }
 349
 350 #define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
 351
 352 \f
 353 /*
 354  * Function support
 355  */
 356
 357 #define ARGS1(a1)       SCM a1 = sp[0];
 358 #define ARGS2(a1,a2)    SCM a1 = sp[-1], a2 = sp[0]; sp--;
 359 #define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
 360
 361 #define RETURN(x)       do { *sp = x; NEXT; } while (0)
 362
 363 /*
 364   Local Variables:
 365   c-file-style: "gnu"
 366   End:
 367 */