/* -*-C-*-
-$Id: cmpint.c,v 1.54 1992/11/04 00:02:24 jinx Exp $
+$Id: cmpint.c,v 1.55 1992/11/18 05:18:24 gjr Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
# define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords)
#endif
-
/* Make noise words invisible to the C compiler. */
#define C_UTILITY
typedef char instruction;
+#ifndef CMPINT_USE_STRUCS
+
+typedef instruction * utility_result;
+
+/* Imports from assembly language */
+
+extern void EXFUN (C_to_interface, (void *));
+extern utility_result interface_to_C_hook;
+
+static long C_return_value;
+
+/* Convenience macros */
+
+#define RETURN_TO_C(code) do \
+{ \
+ C_return_value = (code); \
+ return (interface_to_C_hook); \
+} while (false)
+
+#define RETURN_TO_SCHEME(ep) return ((utility_result) (ep))
+
+#define ENTER_SCHEME(ep) do \
+{ \
+ C_to_interface ((void *) (ep)); \
+ return (C_return_value); \
+} while (false)
+
+#else /* CMPINT_USE_STRUCS */
+\f
#ifdef C_FUNC_PTR_IS_CLOSURE
# define REFENTRY(name) (name)
# define VARENTRY(name) instruction *name
/* Structure returned by SCHEME_UTILITYs */
-struct utility_result
+struct utility_result_s
{
VARENTRY (interface_dispatch);
union additional_info
} extra;
};
-/* utility table entries. */
+typedef struct utility_result_s utility_result;
-typedef struct utility_result EXFUN
- ((*utility_table_entry), (long, long, long, long));
-\f
-/* Some convenience macros */
+/* Imports from assembly language */
-#define RETURN_TO_C(code) \
-do { \
- struct utility_result temp; \
- \
+extern long EXFUN (C_to_interface, (void *));
+
+EXTENTRY (interface_to_C);
+EXTENTRY (interface_to_scheme);
+
+/* Convenience macros */
+
+#define RETURN_TO_C(code) do \
+{ \
+ struct utility_result_s temp; \
+ \
temp.interface_dispatch = (REFENTRY (interface_to_C)); \
- temp.extra.code_to_interpreter = (code); \
- \
- return (temp); \
+ temp.extra.code_to_interpreter = (code); \
+ \
+ return (temp); \
} while (false)
-#define RETURN_TO_SCHEME(ep) \
-do { \
- struct utility_result temp; \
- \
+#define RETURN_TO_SCHEME(ep) do \
+{ \
+ struct utility_result_s temp; \
+ \
temp.interface_dispatch = (REFENTRY (interface_to_scheme)); \
temp.extra.entry_point = ((instruction *) (ep)); \
- \
- return (temp); \
+ \
+ return (temp); \
} while (false)
+#define ENTER_SCHEME(ep) return (C_to_interface ((void *) (ep)))
+
+#endif /* CMPINT_USE_STRUCS */
+\f
+/* utility table entries. */
+
+typedef utility_result EXFUN
+ ((*utility_table_entry), (long, long, long, long));
+
#define RETURN_UNLESS_EXCEPTION(code, entry_point) \
{ \
int return_code; \
EXFUN (compiler_cache_global_operator, (void)),
EXFUN (compiler_cache_lookup, (void)),
EXFUN (compiler_cache_assignment, (void));
-
-/* Imports from assembly language */
-
-extern long
- EXFUN (C_to_interface, (void *));
-
-EXTENTRY (interface_to_C);
-EXTENTRY (interface_to_scheme);
\f
/* Exports to the rest of the "microcode" */
{
/* It self evaluates. */
Val = (Fetch_Expression ());
- return (C_to_interface ((instruction *) (OBJECT_ADDRESS (STACK_POP ()))));
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
#ifdef SPLIT_CACHES
}
#endif /* SPLIT_CACHES */
- return (C_to_interface (compiled_entry_address));
+ ENTER_SCHEME (compiled_entry_address);
}
\f
C_TO_SCHEME long
result = setup_compiled_invocation ((OBJECT_DATUM (nactuals)),
procedure_entry);
if (result == PRIM_DONE)
- {
/* Go into compiled code. */
- return (C_to_interface (procedure_entry));
- }
+ ENTER_SCHEME (procedure_entry);
else
- {
return (result);
- }
}
/* Note that this does not check that compiled_entry_address
compiled_entry_address =
((instruction *) (OBJECT_ADDRESS (STACK_POP ())));
- return (C_to_interface (compiled_entry_address));
+ ENTER_SCHEME (compiled_entry_address);
}
\f
C_UTILITY SCHEME_OBJECT
trampoline storage block (empty) to it.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_return_to_interpreter,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
trampoline storage block (empty) to it.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_apply_in_interpreter,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
of the stack.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_apply,
(primitive, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT primitive
of the register block.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_lexpr_apply,
(primitive, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT primitive
expects the procedure to invoke, and the number of arguments (+ 1).
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_apply,
(procedure, nactuals, ignore_3, ignore_4),
SCHEME_OBJECT procedure
stack, and is passed the number of arguments (+ 1).
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_error,
(nactuals, ignore_2, ignore_3, ignore_4),
long nactuals AND
number of arguments (the compiler checked it), and will not check.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_lexpr_apply,
(entry_address, nactuals, ignore_3, ignore_4),
register instruction * entry_address AND long nactuals
processing is done.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_link,
(ret_add, block_address, constant_address, sections),
instruction * ret_add
original_count,
ret_add));
if (code == PRIM_DONE)
- {
/* Return to the block being linked. */
- return (C_to_interface (ret_add));
- }
+ ENTER_SCHEME (ret_add);
else
{
/* Another GC or error. We should be ready for back-out. */
with.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_apply_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_arity_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_entity_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_interpreted_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_lexpr_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
return (comutil_primitive_lexpr_apply ((tramp_data[0]), 0, 0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_primitive_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
tramp_data contains extension, code_block, offset. TRAMPOLINE_K_LOOKUP
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_lookup_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
offset = (OBJECT_DATUM ((TRAMPOLINE_STORAGE (old_trampoline))[2]));
EXTRACT_EXECUTE_CACHE_ADDRESS (new_procedure,
(MEMORY_LOC (code_block, offset)));
- return (C_to_interface ((instruction *) new_procedure));
+ ENTER_SCHEME (new_procedure);
}
\f
/* ARITY Mismatch handling
Scheme stack.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_1_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_2_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_2_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_2_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_3_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_2_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
REQUEST_INTERRUPT (INT_Stack_Overflow); \
}
-static struct utility_result
+static utility_result
DEFUN (compiler_interrupt_common, (entry_point, state),
instruction * entry_point AND
SCHEME_OBJECT state)
RETURN_TO_C (PRIM_INTERRUPT);
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_closure, (ignore_1, ignore_2, ignore_3, ignore_4),
long ignore_1 AND
long ignore_2 AND
return (compiler_interrupt_common (0, SHARP_F));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_dlink, (entry_point, dlink, ignore_3, ignore_4),
instruction * entry_point AND
SCHEME_OBJECT * dlink AND
(entry_point, (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink))));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
instruction * entry_point AND
/* Val has live data, and there is no entry address on the stack */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_continuation,
(return_address, ignore_2, ignore_3, ignore_4),
instruction * return_address AND
/* Env has live data; no entry point on the stack */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_ic_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
instruction * entry_point AND
state = (STACK_POP ());
Store_Env (state);
Val = state;
- return (C_to_interface ((instruction *) (OBJECT_ADDRESS (STACK_POP ()))));
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
\f
/* Other TRAPS */
/* Assigning a variable that has a trap in it (except unassigned) */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_assignment_trap,
(return_address, extension_addr, value, ignore_4),
instruction * return_address
value = (STACK_POP ());
code = (Symbol_Lex_Set (environment, name, value));
if (code == PRIM_DONE)
- {
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ())));
- }
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
else
{
STACK_PUSH (value);
}
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_cache_lookup_apply,
(extension_addr, block_address, nactuals, ignore_4),
SCHEME_OBJECT * extension_addr
*/
#define CMPLR_REF_TRAP(name, c_trap, ret_code, restart, c_lookup) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (name, \
(return_address, extension_addr, ignore_3, ignore_4), \
instruction * return_address \
environment = (STACK_POP ()); \
code = (c_lookup (environment, name)); \
if (code == PRIM_DONE) \
- { \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
- } \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
else \
{ \
STACK_PUSH (environment); \
*/
#define COMPILER_ARITH_PRIM(name, fobj_index, arity) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (name, \
(ignore_1, ignore_2, ignore_3, ignore_4), \
long ignore_1 AND long ignore_2 \
*/
#define CMPLR_REFERENCE(util_name, c_proc, ret_code, restart_name) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (util_name, \
(ret_add, environment, variable, ignore_4), \
instruction * ret_add \
if (code == PRIM_DONE) \
{ \
Regs[REGBLOCK_ENV] = environment; \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
{ \
}
\f
#define CMPLR_ASSIGNMENT(util_name, c_proc, ret_code, restart_name) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (util_name, \
(ret_add, environment, variable, value), \
instruction * ret_add \
if (code == PRIM_DONE) \
{ \
Regs[REGBLOCK_ENV] = environment; \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
{ \
RC_COMP_DEFINITION_RESTART,
comp_definition_restart)
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_lookup_apply,
(environment, variable, nactuals, ignore_4),
SCHEME_OBJECT environment AND SCHEME_OBJECT variable
}
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_error,
(ret_add, primitive, ignore_3, ignore_4),
instruction * ret_add AND SCHEME_OBJECT primitive
STACK_POP (); /* primitive */
ret_add = ((instruction *) (OBJECT_ADDRESS (STACK_POP ())));
- return (C_to_interface (ret_add));
+ ENTER_SCHEME (ret_add);
}
\f
/* Procedures to destructure compiled entries and closures. */
/* -*-C-*-
-$Id: cmpint.c,v 1.54 1992/11/04 00:02:24 jinx Exp $
+$Id: cmpint.c,v 1.55 1992/11/18 05:18:24 gjr Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
# define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords)
#endif
-
/* Make noise words invisible to the C compiler. */
#define C_UTILITY
typedef char instruction;
+#ifndef CMPINT_USE_STRUCS
+
+typedef instruction * utility_result;
+
+/* Imports from assembly language */
+
+extern void EXFUN (C_to_interface, (void *));
+extern utility_result interface_to_C_hook;
+
+static long C_return_value;
+
+/* Convenience macros */
+
+#define RETURN_TO_C(code) do \
+{ \
+ C_return_value = (code); \
+ return (interface_to_C_hook); \
+} while (false)
+
+#define RETURN_TO_SCHEME(ep) return ((utility_result) (ep))
+
+#define ENTER_SCHEME(ep) do \
+{ \
+ C_to_interface ((void *) (ep)); \
+ return (C_return_value); \
+} while (false)
+
+#else /* CMPINT_USE_STRUCS */
+\f
#ifdef C_FUNC_PTR_IS_CLOSURE
# define REFENTRY(name) (name)
# define VARENTRY(name) instruction *name
/* Structure returned by SCHEME_UTILITYs */
-struct utility_result
+struct utility_result_s
{
VARENTRY (interface_dispatch);
union additional_info
} extra;
};
-/* utility table entries. */
+typedef struct utility_result_s utility_result;
-typedef struct utility_result EXFUN
- ((*utility_table_entry), (long, long, long, long));
-\f
-/* Some convenience macros */
+/* Imports from assembly language */
-#define RETURN_TO_C(code) \
-do { \
- struct utility_result temp; \
- \
+extern long EXFUN (C_to_interface, (void *));
+
+EXTENTRY (interface_to_C);
+EXTENTRY (interface_to_scheme);
+
+/* Convenience macros */
+
+#define RETURN_TO_C(code) do \
+{ \
+ struct utility_result_s temp; \
+ \
temp.interface_dispatch = (REFENTRY (interface_to_C)); \
- temp.extra.code_to_interpreter = (code); \
- \
- return (temp); \
+ temp.extra.code_to_interpreter = (code); \
+ \
+ return (temp); \
} while (false)
-#define RETURN_TO_SCHEME(ep) \
-do { \
- struct utility_result temp; \
- \
+#define RETURN_TO_SCHEME(ep) do \
+{ \
+ struct utility_result_s temp; \
+ \
temp.interface_dispatch = (REFENTRY (interface_to_scheme)); \
temp.extra.entry_point = ((instruction *) (ep)); \
- \
- return (temp); \
+ \
+ return (temp); \
} while (false)
+#define ENTER_SCHEME(ep) return (C_to_interface ((void *) (ep)))
+
+#endif /* CMPINT_USE_STRUCS */
+\f
+/* utility table entries. */
+
+typedef utility_result EXFUN
+ ((*utility_table_entry), (long, long, long, long));
+
#define RETURN_UNLESS_EXCEPTION(code, entry_point) \
{ \
int return_code; \
EXFUN (compiler_cache_global_operator, (void)),
EXFUN (compiler_cache_lookup, (void)),
EXFUN (compiler_cache_assignment, (void));
-
-/* Imports from assembly language */
-
-extern long
- EXFUN (C_to_interface, (void *));
-
-EXTENTRY (interface_to_C);
-EXTENTRY (interface_to_scheme);
\f
/* Exports to the rest of the "microcode" */
{
/* It self evaluates. */
Val = (Fetch_Expression ());
- return (C_to_interface ((instruction *) (OBJECT_ADDRESS (STACK_POP ()))));
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
#ifdef SPLIT_CACHES
}
#endif /* SPLIT_CACHES */
- return (C_to_interface (compiled_entry_address));
+ ENTER_SCHEME (compiled_entry_address);
}
\f
C_TO_SCHEME long
result = setup_compiled_invocation ((OBJECT_DATUM (nactuals)),
procedure_entry);
if (result == PRIM_DONE)
- {
/* Go into compiled code. */
- return (C_to_interface (procedure_entry));
- }
+ ENTER_SCHEME (procedure_entry);
else
- {
return (result);
- }
}
/* Note that this does not check that compiled_entry_address
compiled_entry_address =
((instruction *) (OBJECT_ADDRESS (STACK_POP ())));
- return (C_to_interface (compiled_entry_address));
+ ENTER_SCHEME (compiled_entry_address);
}
\f
C_UTILITY SCHEME_OBJECT
trampoline storage block (empty) to it.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_return_to_interpreter,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
trampoline storage block (empty) to it.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_apply_in_interpreter,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
of the stack.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_apply,
(primitive, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT primitive
of the register block.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_lexpr_apply,
(primitive, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT primitive
expects the procedure to invoke, and the number of arguments (+ 1).
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_apply,
(procedure, nactuals, ignore_3, ignore_4),
SCHEME_OBJECT procedure
stack, and is passed the number of arguments (+ 1).
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_error,
(nactuals, ignore_2, ignore_3, ignore_4),
long nactuals AND
number of arguments (the compiler checked it), and will not check.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_lexpr_apply,
(entry_address, nactuals, ignore_3, ignore_4),
register instruction * entry_address AND long nactuals
processing is done.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_link,
(ret_add, block_address, constant_address, sections),
instruction * ret_add
original_count,
ret_add));
if (code == PRIM_DONE)
- {
/* Return to the block being linked. */
- return (C_to_interface (ret_add));
- }
+ ENTER_SCHEME (ret_add);
else
{
/* Another GC or error. We should be ready for back-out. */
with.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_apply_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_arity_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_entity_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_interpreted_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_lexpr_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
return (comutil_primitive_lexpr_apply ((tramp_data[0]), 0, 0, 0));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_primitive_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
tramp_data contains extension, code_block, offset. TRAMPOLINE_K_LOOKUP
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_lookup_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
offset = (OBJECT_DATUM ((TRAMPOLINE_STORAGE (old_trampoline))[2]));
EXTRACT_EXECUTE_CACHE_ADDRESS (new_procedure,
(MEMORY_LOC (code_block, offset)));
- return (C_to_interface ((instruction *) new_procedure));
+ ENTER_SCHEME (new_procedure);
}
\f
/* ARITY Mismatch handling
Scheme stack.
*/
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_1_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_2_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_2_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_2_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_3_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_3_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_2_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_1_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_operator_4_0_trap,
(tramp_data, ignore_2, ignore_3, ignore_4),
SCHEME_OBJECT * tramp_data
REQUEST_INTERRUPT (INT_Stack_Overflow); \
}
-static struct utility_result
+static utility_result
DEFUN (compiler_interrupt_common, (entry_point, state),
instruction * entry_point AND
SCHEME_OBJECT state)
RETURN_TO_C (PRIM_INTERRUPT);
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_closure, (ignore_1, ignore_2, ignore_3, ignore_4),
long ignore_1 AND
long ignore_2 AND
return (compiler_interrupt_common (0, SHARP_F));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_dlink, (entry_point, dlink, ignore_3, ignore_4),
instruction * entry_point AND
SCHEME_OBJECT * dlink AND
(entry_point, (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink))));
}
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
instruction * entry_point AND
/* Val has live data, and there is no entry address on the stack */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_continuation,
(return_address, ignore_2, ignore_3, ignore_4),
instruction * return_address AND
/* Env has live data; no entry point on the stack */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_interrupt_ic_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
instruction * entry_point AND
state = (STACK_POP ());
Store_Env (state);
Val = state;
- return (C_to_interface ((instruction *) (OBJECT_ADDRESS (STACK_POP ()))));
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
\f
/* Other TRAPS */
/* Assigning a variable that has a trap in it (except unassigned) */
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_assignment_trap,
(return_address, extension_addr, value, ignore_4),
instruction * return_address
value = (STACK_POP ());
code = (Symbol_Lex_Set (environment, name, value));
if (code == PRIM_DONE)
- {
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ())));
- }
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
else
{
STACK_PUSH (value);
}
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_cache_lookup_apply,
(extension_addr, block_address, nactuals, ignore_4),
SCHEME_OBJECT * extension_addr
*/
#define CMPLR_REF_TRAP(name, c_trap, ret_code, restart, c_lookup) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (name, \
(return_address, extension_addr, ignore_3, ignore_4), \
instruction * return_address \
environment = (STACK_POP ()); \
code = (c_lookup (environment, name)); \
if (code == PRIM_DONE) \
- { \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
- } \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
else \
{ \
STACK_PUSH (environment); \
*/
#define COMPILER_ARITH_PRIM(name, fobj_index, arity) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (name, \
(ignore_1, ignore_2, ignore_3, ignore_4), \
long ignore_1 AND long ignore_2 \
*/
#define CMPLR_REFERENCE(util_name, c_proc, ret_code, restart_name) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (util_name, \
(ret_add, environment, variable, ignore_4), \
instruction * ret_add \
if (code == PRIM_DONE) \
{ \
Regs[REGBLOCK_ENV] = environment; \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
{ \
}
\f
#define CMPLR_ASSIGNMENT(util_name, c_proc, ret_code, restart_name) \
-SCHEME_UTILITY struct utility_result \
+SCHEME_UTILITY utility_result \
DEFUN (util_name, \
(ret_add, environment, variable, value), \
instruction * ret_add \
if (code == PRIM_DONE) \
{ \
Regs[REGBLOCK_ENV] = environment; \
- return (C_to_interface (OBJECT_ADDRESS (STACK_POP ()))); \
+ ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
{ \
RC_COMP_DEFINITION_RESTART,
comp_definition_restart)
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_lookup_apply,
(environment, variable, nactuals, ignore_4),
SCHEME_OBJECT environment AND SCHEME_OBJECT variable
}
}
\f
-SCHEME_UTILITY struct utility_result
+SCHEME_UTILITY utility_result
DEFUN (comutil_primitive_error,
(ret_add, primitive, ignore_3, ignore_4),
instruction * ret_add AND SCHEME_OBJECT primitive
STACK_POP (); /* primitive */
ret_add = ((instruction *) (OBJECT_ADDRESS (STACK_POP ())));
- return (C_to_interface (ret_add));
+ ENTER_SCHEME (ret_add);
}
\f
/* Procedures to destructure compiled entries and closures. */
projects / mit-scheme.git / commitdiff