67d60620123713a13aa7d5fb8aacff49b68553d5
1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
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.
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.
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
19 /* This file is included in vm.c multiple times */
21 #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
22 #define VM_USE_HOOKS 0 /* Various hooks */
23 #define VM_CHECK_OBJECT 0 /* Check object table */
24 #define VM_CHECK_FREE_VARIABLES 0 /* Check free variable access */
25 #define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
26 #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
27 #define VM_USE_HOOKS 1
28 #define VM_CHECK_OBJECT 0
29 #define VM_CHECK_FREE_VARIABLES 0
30 #define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
32 #error unknown debug engine VM_ENGINE
35 #include "vm-engine.h"
39 VM_NAME (SCM vm
, SCM program
, SCM
*argv
, int nargs
)
42 register scm_t_uint8
*ip IP_REG
; /* instruction pointer */
43 register SCM
*sp SP_REG
; /* stack pointer */
44 register SCM
*fp FP_REG
; /* frame pointer */
45 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
48 struct scm_objcode
*bp
= NULL
; /* program base pointer */
49 SCM
*objects
= NULL
; /* constant objects */
51 size_t object_count
= 0; /* length of OBJECTS */
53 SCM
*stack_limit
= vp
->stack_limit
; /* stack limit address */
55 scm_i_thread
*current_thread
= SCM_I_CURRENT_THREAD
;
56 scm_t_int64 vm_cookie
= vp
->cookie
++;
58 /* Internal variables */
61 #ifdef HAVE_LABELS_AS_VALUES
62 static const void **jump_table_pointer
= NULL
;
65 #ifdef HAVE_LABELS_AS_VALUES
66 register const void **jump_table JT_REG
;
68 if (SCM_UNLIKELY (!jump_table_pointer
))
71 jump_table_pointer
= malloc (SCM_VM_NUM_INSTRUCTIONS
* sizeof (void*));
72 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
73 jump_table_pointer
[i
] = &&vm_error_bad_instruction
;
74 #define VM_INSTRUCTION_TO_LABEL 1
75 #define jump_table jump_table_pointer
76 #include <libguile/vm-expand.h>
77 #include <libguile/vm-i-system.i>
78 #include <libguile/vm-i-scheme.i>
79 #include <libguile/vm-i-loader.i>
81 #undef VM_INSTRUCTION_TO_LABEL
84 /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
85 load instruction at each instruction dispatch. */
86 jump_table
= jump_table_pointer
;
94 program
= vm_make_boot_program (nargs
);
98 PUSH (SCM_PACK (fp
)); /* dynamic link */
99 PUSH (SCM_PACK (0)); /* mvra */
100 PUSH (SCM_PACK (ip
)); /* ra */
104 ip
= SCM_C_OBJCODE_BASE (bp
);
105 /* MV-call frame, function & arguments */
106 PUSH (SCM_PACK (0)); /* dynamic link */
107 PUSH (SCM_PACK (0)); /* mvra */
108 PUSH (SCM_PACK (0)); /* ra */
110 VM_ASSERT (sp
+ nargs
< stack_limit
, vm_error_too_many_args (nargs
));
118 #ifndef HAVE_LABELS_AS_VALUES
120 switch ((*ip
++) & SCM_VM_INSTRUCTION_MASK
) {
123 #include "vm-expand.h"
124 #include "vm-i-system.c"
125 #include "vm-i-scheme.c"
126 #include "vm-i-loader.c"
128 #ifndef HAVE_LABELS_AS_VALUES
130 goto vm_error_bad_instruction
;
134 abort (); /* never reached */
136 vm_error_bad_instruction
:
137 vm_error_bad_instruction (ip
[-1]);
138 abort (); /* never reached */
142 vm_error_stack_overflow (vp
);
143 abort (); /* never reached */
147 #undef VM_CHECK_OBJECT
148 #undef VM_CHECK_FREE_VARIABLE
149 #undef VM_CHECK_UNDERFLOW