1 /* Copyright (C) 2001 Free Software Foundation, Inc.
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)
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.
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
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
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.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
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.
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. */
42 /* This file is included in vm.c multiple times */
44 #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
45 #define VM_USE_HOOKS 0 /* Various hooks */
46 #define VM_USE_CLOCK 0 /* Bogoclock */
47 #define VM_CHECK_EXTERNAL 1 /* Check external link */
48 #define VM_CHECK_OBJECT 1 /* Check object table */
49 #define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
50 #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
51 #define VM_USE_HOOKS 1
52 #define VM_USE_CLOCK 1
53 #define VM_CHECK_EXTERNAL 1
54 #define VM_CHECK_OBJECT 1
55 #define VM_PUSH_DEBUG_FRAMES 1
57 #error unknown debug engine VM_ENGINE
60 #include "vm-engine.h"
64 VM_NAME (struct scm_vm
*vp
, SCM program
, SCM
*argv
, int nargs
)
67 register scm_byte_t
*ip IP_REG
; /* instruction pointer */
68 register SCM
*sp SP_REG
; /* stack pointer */
69 register SCM
*fp FP_REG
; /* frame pointer */
72 struct scm_objcode
*bp
= NULL
; /* program base pointer */
73 SCM external
= SCM_EOL
; /* external environment */
74 SCM
*objects
= NULL
; /* constant objects */
75 size_t object_count
= 0; /* length of OBJECTS */
76 SCM
*stack_base
= vp
->stack_base
; /* stack base address */
77 SCM
*stack_limit
= vp
->stack_limit
; /* stack limit address */
79 /* Internal variables */
81 long start_time
= scm_c_get_internal_run_time ();
82 SCM finish_args
; /* used both for returns: both in error
83 and normal situations */
85 SCM hook_args
= SCM_EOL
;
88 #ifdef HAVE_LABELS_AS_VALUES
89 static void **jump_table
= NULL
;
92 #if VM_PUSH_DEBUG_FRAMES
93 scm_t_debug_frame debug
;
94 scm_t_debug_info debug_vect_body
;
95 debug
.status
= SCM_VOIDFRAME
;
98 #ifdef HAVE_LABELS_AS_VALUES
99 if (SCM_UNLIKELY (!jump_table
))
102 jump_table
= malloc (SCM_VM_NUM_INSTRUCTIONS
* sizeof(void*));
103 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
104 jump_table
[i
] = &&vm_error_bad_instruction
;
105 #define VM_INSTRUCTION_TO_LABEL 1
106 #include "vm-expand.h"
107 #include "vm-i-system.i"
108 #include "vm-i-scheme.i"
109 #include "vm-i-loader.i"
110 #undef VM_INSTRUCTION_TO_LABEL
119 program
= vm_make_boot_program (nargs
);
121 #if VM_PUSH_DEBUG_FRAMES
122 debug
.prev
= scm_i_last_debug_frame ();
123 debug
.status
= SCM_APPLYFRAME
;
124 debug
.vect
= &debug_vect_body
;
125 debug
.vect
[0].a
.proc
= program
; /* the boot program */
126 debug
.vect
[0].a
.args
= SCM_EOL
;
127 scm_i_set_last_debug_frame (&debug
);
136 /* Initial arguments */
138 if (SCM_UNLIKELY (sp
+ nargs
>= stack_limit
))
139 goto vm_error_too_many_args
;
148 #ifndef HAVE_LABELS_AS_VALUES
150 switch ((*ip
++) & SCM_VM_INSTRUCTION_MASK
) {
153 #include "vm-expand.h"
154 #include "vm-i-system.c"
155 #include "vm-i-scheme.c"
156 #include "vm-i-loader.c"
158 #ifndef HAVE_LABELS_AS_VALUES
160 goto vm_error_bad_instruction
;
167 #if VM_PUSH_DEBUG_FRAMES
168 scm_i_set_last_debug_frame (debug
.prev
);
176 vm_error_bad_instruction
:
177 err_msg
= scm_from_locale_string ("VM: Bad instruction: ~A");
178 finish_args
= SCM_LIST1 (scm_from_uchar (ip
[-1]));
182 err_msg
= scm_from_locale_string ("VM: Unbound variable: ~A");
185 vm_error_wrong_type_arg
:
186 err_msg
= scm_from_locale_string ("VM: Wrong type argument");
187 finish_args
= SCM_EOL
;
190 vm_error_too_many_args
:
191 err_msg
= scm_from_locale_string ("VM: Too many arguments");
192 finish_args
= SCM_LIST1 (scm_from_int (nargs
));
195 vm_error_wrong_num_args
:
196 /* nargs and program are valid */
198 scm_wrong_num_args (program
);
199 /* shouldn't get here */
202 vm_error_wrong_type_apply
:
203 err_msg
= scm_from_locale_string ("VM: Wrong type to apply: ~S "
205 finish_args
= SCM_LIST2 (program
,
206 SCM_I_MAKINUM (ip
- bp
->base
));
209 vm_error_stack_overflow
:
210 err_msg
= scm_from_locale_string ("VM: Stack overflow");
211 finish_args
= SCM_EOL
;
214 vm_error_stack_underflow
:
215 err_msg
= scm_from_locale_string ("VM: Stack underflow");
216 finish_args
= SCM_EOL
;
219 vm_error_improper_list
:
220 err_msg
= scm_from_locale_string ("VM: Attempt to unroll an improper list: tail is ~A");
225 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "pair");
226 /* shouldn't get here */
230 err_msg
= scm_from_locale_string ("VM: 0-valued return");
231 finish_args
= SCM_EOL
;
234 vm_error_not_enough_values
:
235 err_msg
= scm_from_locale_string ("VM: Not enough values for mv-bind");
236 finish_args
= SCM_EOL
;
239 vm_error_no_such_module
:
240 err_msg
= scm_from_locale_string ("VM: No such module: ~A");
244 vm_error_invalid_address
:
245 err_msg
= scm_from_locale_string ("VM: Invalid program address");
246 finish_args
= SCM_EOL
;
250 #if VM_CHECK_EXTERNAL
252 err_msg
= scm_from_locale_string ("VM: Invalid external access");
253 finish_args
= SCM_EOL
;
259 err_msg
= scm_from_locale_string ("VM: Invalid object table access");
260 finish_args
= SCM_EOL
;
267 scm_ithrow (sym_vm_error
, SCM_LIST3 (sym_vm_run
, err_msg
, finish_args
), 1);
270 abort (); /* never reached */
275 #undef VM_CHECK_EXTERNAL
276 #undef VM_CHECK_OBJECT
277 #undef VM_PUSH_DEBUG_FRAMES