Commit | Line | Data |
---|---|---|
53bdfcf0 | 1 | /* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
a98cef7e | 2 | * |
560b9c25 | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
a98cef7e | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
560b9c25 AW |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
a98cef7e | 12 | * |
560b9c25 AW |
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 | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
560b9c25 | 17 | */ |
a98cef7e | 18 | |
6d14383e AW |
19 | /* This file is included in vm.c multiple times */ |
20 | ||
21 | #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) | |
22 | #define VM_USE_HOOKS 0 /* Various hooks */ | |
eae2438d AW |
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 */ | |
6d14383e AW |
26 | #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) |
27 | #define VM_USE_HOOKS 1 | |
eae2438d AW |
28 | #define VM_CHECK_OBJECT 0 |
29 | #define VM_CHECK_FREE_VARIABLES 0 | |
30 | #define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */ | |
6d14383e AW |
31 | #else |
32 | #error unknown debug engine VM_ENGINE | |
33 | #endif | |
a98cef7e | 34 | |
83495480 | 35 | #include "vm-engine.h" |
a98cef7e | 36 | |
238e7a11 | 37 | |
a98cef7e | 38 | static SCM |
7656f194 | 39 | VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) |
a98cef7e | 40 | { |
17e90c5e | 41 | /* VM registers */ |
2fb924f6 | 42 | register scm_t_uint8 *ip IP_REG; /* instruction pointer */ |
17e90c5e KN |
43 | register SCM *sp SP_REG; /* stack pointer */ |
44 | register SCM *fp FP_REG; /* frame pointer */ | |
7656f194 | 45 | struct scm_vm *vp = SCM_VM_DATA (vm); |
a98cef7e | 46 | |
d608d68d | 47 | /* Cache variables */ |
53e28ed9 | 48 | struct scm_objcode *bp = NULL; /* program base pointer */ |
17e90c5e | 49 | SCM *objects = NULL; /* constant objects */ |
eae2438d | 50 | #if VM_CHECK_OBJECT |
2fda0242 | 51 | size_t object_count = 0; /* length of OBJECTS */ |
eae2438d | 52 | #endif |
3d5ee0cd | 53 | SCM *stack_limit = vp->stack_limit; /* stack limit address */ |
2d026f04 | 54 | |
a2a6c0e3 | 55 | scm_i_thread *current_thread = SCM_I_CURRENT_THREAD; |
2d026f04 | 56 | scm_t_int64 vm_cookie = vp->cookie++; |
a98cef7e | 57 | |
d608d68d | 58 | /* Internal variables */ |
ef24c01b | 59 | int nvalues = 0; |
53bdfcf0 | 60 | |
53e28ed9 | 61 | #ifdef HAVE_LABELS_AS_VALUES |
37a5970c | 62 | static const void **jump_table_pointer = NULL; |
e06e857c | 63 | #endif |
37a5970c | 64 | |
e06e857c | 65 | #ifdef HAVE_LABELS_AS_VALUES |
37a5970c LC |
66 | register const void **jump_table JT_REG; |
67 | ||
68 | if (SCM_UNLIKELY (!jump_table_pointer)) | |
53e28ed9 AW |
69 | { |
70 | int i; | |
37a5970c | 71 | jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*)); |
53e28ed9 | 72 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) |
37a5970c | 73 | jump_table_pointer[i] = &&vm_error_bad_instruction; |
53e28ed9 | 74 | #define VM_INSTRUCTION_TO_LABEL 1 |
37a5970c | 75 | #define jump_table jump_table_pointer |
aeeff258 AW |
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> | |
37a5970c | 80 | #undef jump_table |
53e28ed9 AW |
81 | #undef VM_INSTRUCTION_TO_LABEL |
82 | } | |
37a5970c LC |
83 | |
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; | |
53e28ed9 AW |
87 | #endif |
88 | ||
67b699cc AW |
89 | /* Initial frame */ |
90 | CACHE_REGISTER (); | |
91 | PUSH (SCM_PACK (fp)); /* dynamic link */ | |
92 | PUSH (SCM_PACK (0)); /* mvra */ | |
93 | PUSH (SCM_PACK (ip)); /* ra */ | |
94 | PUSH (boot_continuation); | |
95 | fp = sp + 1; | |
96 | ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation)); | |
97 | ||
98 | /* MV-call frame, function & arguments */ | |
99 | PUSH (SCM_PACK (fp)); /* dynamic link */ | |
100 | PUSH (SCM_PACK (ip + 1)); /* mvra */ | |
101 | PUSH (SCM_PACK (ip)); /* ra */ | |
102 | PUSH (program); | |
103 | fp = sp + 1; | |
104 | VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs)); | |
105 | while (nargs--) | |
106 | PUSH (*argv++); | |
107 | ||
108 | PUSH_CONTINUATION_HOOK (); | |
109 | ||
110 | apply: | |
111 | program = fp[-1]; | |
112 | if (!SCM_PROGRAM_P (program)) | |
113 | { | |
114 | if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) | |
115 | fp[-1] = SCM_STRUCT_PROCEDURE (program); | |
116 | else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob | |
117 | && SCM_SMOB_APPLICABLE_P (program)) | |
118 | { | |
119 | /* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */ | |
120 | int i; | |
121 | PUSH (SCM_BOOL_F); | |
122 | for (i = sp - fp; i >= 0; i--) | |
123 | fp[i] = fp[i - 1]; | |
124 | fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline_objcode; | |
125 | } | |
126 | else | |
127 | { | |
128 | SYNC_ALL(); | |
129 | vm_error_wrong_type_apply (program); | |
130 | } | |
131 | goto apply; | |
132 | } | |
133 | ||
134 | CACHE_PROGRAM (); | |
135 | ip = SCM_C_OBJCODE_BASE (bp); | |
136 | ||
137 | APPLY_HOOK (); | |
a98cef7e KN |
138 | |
139 | /* Let's go! */ | |
53e28ed9 | 140 | NEXT; |
a98cef7e KN |
141 | |
142 | #ifndef HAVE_LABELS_AS_VALUES | |
17e90c5e | 143 | vm_start: |
53e28ed9 | 144 | switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) { |
a98cef7e KN |
145 | #endif |
146 | ||
83495480 AW |
147 | #include "vm-expand.h" |
148 | #include "vm-i-system.c" | |
149 | #include "vm-i-scheme.c" | |
150 | #include "vm-i-loader.c" | |
a98cef7e KN |
151 | |
152 | #ifndef HAVE_LABELS_AS_VALUES | |
53e28ed9 AW |
153 | default: |
154 | goto vm_error_bad_instruction; | |
a98cef7e KN |
155 | } |
156 | #endif | |
157 | ||
53bdfcf0 | 158 | abort (); /* never reached */ |
a52b2d3d | 159 | |
53bdfcf0 AW |
160 | vm_error_bad_instruction: |
161 | vm_error_bad_instruction (ip[-1]); | |
162 | abort (); /* never reached */ | |
17e90c5e | 163 | |
53bdfcf0 AW |
164 | handle_overflow: |
165 | SYNC_ALL (); | |
166 | vm_error_stack_overflow (vp); | |
a98cef7e KN |
167 | abort (); /* never reached */ |
168 | } | |
6d14383e AW |
169 | |
170 | #undef VM_USE_HOOKS | |
6d14383e | 171 | #undef VM_CHECK_OBJECT |
57ab0671 | 172 | #undef VM_CHECK_FREE_VARIABLE |
eae2438d | 173 | #undef VM_CHECK_UNDERFLOW |
17e90c5e KN |
174 | |
175 | /* | |
176 | Local Variables: | |
177 | c-file-style: "gnu" | |
178 | End: | |
179 | */ |