Commit 18cb1b35 authored by Marius Gerbershagen's avatar Marius Gerbershagen Committed by Daniel Kochmański
Browse files

fix for calling conventions treating fixed and variadic arguments differently

Previously, we assumed that the fixed and variadic arguments of a
variadic function were passed to the function in the same way. The
arm64 calling convention used by iOS breaks this assumption by passing
fixed arguments in registers or on the stack, depending on the
position, while variadic arguments are always passed on the stack.

Solving this problem while still allowing function redefinition at
runtime requires introducing additional dispatch functions. These
dispatch functions take no fixed arguments and pass all their
arguments to the actual function. This dispatch is enabled by passing
-DECL_C_COMPATIBLE_VARIADIC_DISPATCH to the C compiler.

This problem was originally identified and a solution provided by
thewhimer@gmail.com. This commit based on his work with minor
improvements.
parent 234a1084
......@@ -108,7 +108,7 @@ mangle_name(cl_object output, unsigned char *source, int l)
output = cl_format(4, ECL_NIL,
ecl_make_constant_base_string("ECL_SYM(~S,~D)",-1),
name, ecl_make_fixnum(p));
@(return found output maxarg);
@(return found output);
}
} else if (!Null(symbol)) {
cl_object fun = symbol->symbol.gfdef;
......@@ -120,8 +120,12 @@ mangle_name(cl_object output, unsigned char *source, int l)
symbol = s;
found = ECL_T;
if (fun->cfun.narg >= 0) {
minarg =
maxarg = ecl_make_fixnum(fun->cfun.narg);
if (t == t_cfunfixed) {
minarg =
maxarg = ecl_make_fixnum(fun->cfunfixed.narg);
} else {
minarg = ecl_make_fixnum(fun->cfun.narg);
}
}
break;
}
......@@ -165,12 +169,12 @@ mangle_name(cl_object output, unsigned char *source, int l)
output->base_string.fillp = 0;
if (!Null(package)) {
if (!mangle_name(output, package->base_string.self, package->base_string.fillp)) {
@(return ECL_NIL ECL_NIL maxarg);
@(return ECL_NIL ECL_NIL minarg maxarg);
}
}
output->base_string.self[output->base_string.fillp++] = c;
if (!(dest = mangle_name(output, source, l))) {
@(return ECL_NIL ECL_NIL maxarg);
@(return ECL_NIL ECL_NIL minarg maxarg);
}
if (dest[-1] == '_')
dest[-1] = 'M';
......@@ -243,7 +247,7 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
if (narg >= 0) {
f = ecl_make_cfun((cl_objectfn_fixed)fun, s, NULL, narg);
} else {
f = ecl_make_cfun_va(fun, s, NULL);
f = ecl_make_cfun_va(fun, s, NULL, -narg - 1);
}
ECL_SYM_FUN(s) = f;
}
......
......@@ -96,7 +96,7 @@ static cl_object
make_setf_function_error(cl_object name)
{
return ecl_make_cclosure_va((cl_objectfn)unbound_setf_function_error,
name, ECL_NIL);
name, ECL_NIL, 0);
}
cl_object
......
......@@ -22,45 +22,75 @@ ecl_make_cfun(cl_objectfn_fixed c_function, cl_object name, cl_object cblock, in
{
cl_object cf;
if (ecl_unlikely(narg < 0 || narg > ECL_C_ARGUMENTS_LIMIT)) {
FEprogram_error("ecl_make_cfun: ~a", 1,
(narg < 0)
? ecl_make_constant_base_string("number of arguments must be greater than 0.",-1)
: ecl_make_constant_base_string("function requires too many arguments.",-1));
}
cf = ecl_alloc_object(t_cfunfixed);
cf->cfunfixed.entry = dispatch_table[narg];
cf->cfunfixed.entry = fixed_dispatch_table[narg];
cf->cfunfixed.entry_fixed = c_function;
cf->cfunfixed.name = name;
cf->cfunfixed.block = cblock;
cf->cfunfixed.file = ECL_NIL;
cf->cfunfixed.file_position = ecl_make_fixnum(-1);
cf->cfunfixed.narg = narg;
if (ecl_unlikely(narg < 0 || narg > ECL_C_ARGUMENTS_LIMIT))
FEprogram_error("ecl_make_cfun: function requires too many arguments.", 0);
return cf;
}
cl_object
ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object cblock)
ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object cblock, int narg_fixed)
{
cl_object cf;
if (ecl_unlikely(narg_fixed < 0 || narg_fixed > ECL_C_ARGUMENTS_LIMIT)) {
FEprogram_error("ecl_make_cfun_va: ~a", 1,
(narg_fixed < 0)
? ecl_make_constant_base_string("number of arguments must be greater than 0.",-1)
: ecl_make_constant_base_string("function requires too many arguments.",-1));
}
cf = ecl_alloc_object(t_cfun);
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
cf->cfun.entry = variadic_dispatch_table[narg_fixed];
cf->cfun.entry_variadic = c_function;
#else
cf->cfun.entry = c_function;
#endif
cf->cfun.name = name;
cf->cfun.block = cblock;
cf->cfun.narg = -1;
cf->cfun.file = ECL_NIL;
cf->cfun.file_position = ecl_make_fixnum(-1);
cf->cfun.narg = narg_fixed;
return cf;
}
cl_object
ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block)
ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block, int narg_fixed)
{
cl_object cc;
if (ecl_unlikely(narg_fixed < 0 || narg_fixed > ECL_C_ARGUMENTS_LIMIT)) {
FEprogram_error("ecl_make_cclosure_va: ~a", 1,
(narg_fixed < 0)
? ecl_make_constant_base_string("number of arguments must be greater than 0.",-1)
: ecl_make_constant_base_string("function requires too many arguments.",-1));
}
cc = ecl_alloc_object(t_cclosure);
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
cc->cclosure.entry = variadic_dispatch_table[narg_fixed];
cc->cclosure.entry_variadic = c_function;
#else
cc->cclosure.entry = c_function;
#endif
cc->cclosure.env = env;
cc->cclosure.block = block;
cc->cclosure.file = ECL_NIL;
cc->cclosure.file_position = ecl_make_fixnum(-1);
cc->cclosure.narg = narg_fixed;
return cc;
}
......@@ -80,18 +110,18 @@ ecl_def_c_macro(cl_object sym, cl_objectfn_fixed c_function, int narg)
}
void
ecl_def_c_macro_va(cl_object sym, cl_objectfn c_function)
ecl_def_c_macro_va(cl_object sym, cl_objectfn c_function, int narg_fixed)
{
si_fset(3, sym,
ecl_make_cfun_va(c_function, sym, ecl_symbol_value(@'si::*cblock*')),
ecl_make_cfun_va(c_function, sym, ecl_symbol_value(@'si::*cblock*'), narg_fixed),
ECL_T);
}
void
ecl_def_c_function_va(cl_object sym, cl_objectfn c_function)
ecl_def_c_function_va(cl_object sym, cl_objectfn c_function, int narg_fixed)
{
si_fset(2, sym,
ecl_make_cfun_va(c_function, sym, ecl_symbol_value(@'si::*cblock*')));
ecl_make_cfun_va(c_function, sym, ecl_symbol_value(@'si::*cblock*'), narg_fixed));
}
cl_object
......
This diff is collapsed.
......@@ -114,15 +114,23 @@ ensure_up_to_date_instance(cl_object instance)
}
cl_object
ecl_slot_reader_dispatch(cl_narg narg, cl_object instance)
ecl_slot_reader_dispatch(cl_narg narg, ... /* cl_object instance */)
{
const cl_env_ptr env = ecl_process_env();
cl_object gfun = env->function;
cl_object index, value;
ecl_cache_record_ptr e;
cl_object instance;
unlikely_if (narg != 1)
unlikely_if (narg != 1) {
FEwrong_num_arguments(gfun);
} else {
va_list args;
va_start(args, narg);
instance = va_arg(args, cl_object);
va_end(args);
}
unlikely_if (!ECL_INSTANCEP(instance)) {
no_applicable_method(env, gfun, ecl_list1(instance));
return env->values[0];
......@@ -159,16 +167,24 @@ ecl_slot_reader_dispatch(cl_narg narg, cl_object instance)
}
cl_object
ecl_slot_writer_dispatch(cl_narg narg, cl_object value, cl_object instance)
ecl_slot_writer_dispatch(cl_narg narg, ... /* cl_object value, cl_object instance */)
{
const cl_env_ptr env = ecl_process_env();
cl_object gfun = env->function;
ecl_cache_record_ptr e;
cl_object index;
cl_object value, instance;
unlikely_if (narg != 2) {
FEwrong_num_arguments(gfun);
} else {
va_list args;
va_start(args, narg);
value = va_arg(args, cl_object);
instance = va_arg(args, cl_object);
va_end(args);
}
unlikely_if (!ECL_INSTANCEP(instance)) {
no_applicable_method(env, gfun, cl_list(2, value, instance));
return env->values[0];
......
......@@ -86,13 +86,11 @@ clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
x->instance.isgf = ECL_NOT_FUNCALLABLE;
x->instance.entry = FEnot_funcallable_vararg;
} else if (function_or_t == @'clos::standard-optimized-reader-method') {
/* WARNING: We assume that f(a,...) behaves as f(a,b) */
x->instance.isgf = ECL_READER_DISPATCH;
x->instance.entry = (cl_objectfn)ecl_slot_reader_dispatch;
x->instance.entry = ecl_slot_reader_dispatch;
} else if (function_or_t == @'clos::standard-optimized-writer-method') {
/* WARNING: We assume that f(a,...) behaves as f(a,b) */
x->instance.isgf = ECL_WRITER_DISPATCH;
x->instance.entry = (cl_objectfn)ecl_slot_writer_dispatch;
x->instance.entry = ecl_slot_writer_dispatch;
} else if (Null(cl_functionp(function_or_t))) {
FEwrong_type_argument(@'function', function_or_t);
} else {
......
......@@ -1284,7 +1284,7 @@ cl_hash_table_count(cl_object ht)
}
static cl_object
si_hash_table_iterate(cl_narg narg)
si_hash_table_iterate(cl_narg narg, ...)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object env = the_env->function->cclosure.env;
......@@ -1313,9 +1313,10 @@ cl_object
si_hash_table_iterator(cl_object ht)
{
assert_type_hash_table(@[si::hash-table-iterator], 1, ht);
@(return ecl_make_cclosure_va((cl_objectfn)si_hash_table_iterate,
@(return ecl_make_cclosure_va(si_hash_table_iterate,
cl_list(2, ecl_make_fixnum(-1), ht),
@'si::hash-table-iterator'));
@'si::hash-table-iterator',
0));
}
cl_object
......
......@@ -523,6 +523,9 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
frame_aux.base);
break;
case t_cfun:
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
the_env->function = reg0;
#endif
reg0 = APPLY(narg, reg0->cfun.entry, frame_aux.base);
break;
case t_cclosure:
......
......@@ -2425,7 +2425,7 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
assert(block->cblock.cfuns_size == 0 || VV != NULL);
for (i = 0; i < block->cblock.cfuns_size; i++) {
const struct ecl_cfun *prototype = block->cblock.cfuns+i;
const struct ecl_cfunfixed *prototype = block->cblock.cfuns+i;
cl_index fname_location = ecl_fixnum(prototype->block);
cl_object fname = VV[fname_location];
cl_index location = ecl_fixnum(prototype->name);
......@@ -2433,7 +2433,7 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
int narg = prototype->narg;
VV[location] = narg<0?
ecl_make_cfun_va((cl_objectfn)prototype->entry,
fname, block) :
fname, block, -narg - 1) :
ecl_make_cfun((cl_objectfn_fixed)prototype->entry,
fname, block, narg);
/* Add source file info */
......
This diff is collapsed.
......@@ -177,11 +177,10 @@
(wt-h1 "cl_object"))
(wt-h1 ");"))
(progn
(wt-nl-h "#ifdef __cplusplus")
(wt-nl-h "extern cl_object " fun-c-name "(...);")
(wt-nl-h "#else")
(wt-nl-h "extern cl_object " fun-c-name "();")
(wt-nl-h "#endif")))
(wt-nl-h "extern cl_object " fun-c-name "(cl_narg")
(dotimes (i (min minarg si:c-arguments-limit))
(wt-h1 ",cl_object"))
(wt-h1 ",...);")))
(setf (gethash fun-c-name *compiler-declared-globals*) 1))))
(let ((fun (make-fun :name fname :global t :cfun fun-c-name :lambda 'NIL
:minarg minarg :maxarg maxarg)))
......
......@@ -310,9 +310,9 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
(maxarg call-arguments-limit))
(destructuring-bind (requireds optionals rest key-flag keywords a-o-k)
(c1form-arg 0 lambda)
(setf minarg (length requireds))
(when (and (null rest) (not key-flag) (not a-o-k))
(setf minarg (length requireds)
maxarg (+ minarg (/ (length optionals) 3)))))
(setf maxarg (+ minarg (/ (length optionals) 3)))))
(values minarg maxarg)))
#| Steps:
......
......@@ -184,10 +184,11 @@
(cond ((eq closure 'CLOSURE)
(wt "ecl_make_cclosure_va((cl_objectfn)" cfun ","
(environment-accessor fun)
",Cblock)"))
",Cblock," (min (fun-minarg fun) si:c-arguments-limit) ")"))
((eq closure 'LEXICAL)
(baboon :format-control "wt-make-closure: lexical closure detected."))
((setf narg (fun-fixed-narg fun)) ; empty environment fixed number of args
(wt "ecl_make_cfun((cl_objectfn_fixed)" cfun ",ECL_NIL,Cblock," narg ")"))
(t ; empty environment variable number of args
(wt "ecl_make_cfun_va((cl_objectfn)" cfun ",ECL_NIL,Cblock)")))))
(wt "ecl_make_cfun_va((cl_objectfn)" cfun ",ECL_NIL,Cblock,"
(min (fun-minarg fun) si:c-arguments-limit) ")")))))
......@@ -886,8 +886,8 @@
(if (zerop n-cfuns)
(wt-nl-h "#define compiler_cfuns NULL")
(progn
(format stream "~%static const struct ecl_cfun compiler_cfuns[] = {~
~%~t/*t,m,narg,padding,name,block,entry*/");
(format stream "~%static const struct ecl_cfunfixed compiler_cfuns[] = {~
~%~t/*t,m,narg,padding,name=function-location,block=name-location,entry,entry_fixed,file,file_position*/")
(loop for (loc fname-loc fun) in (nreverse *global-cfuns-array*)
do (let* ((cfun (fun-cfun fun))
(minarg (fun-minarg fun))
......@@ -895,8 +895,8 @@
(narg (if (and (= minarg maxarg)
(<= maxarg si:c-arguments-limit))
maxarg
-1)))
(format stream "~%{0,0,~D,0,ecl_make_fixnum(~D),ecl_make_fixnum(~D),(cl_objectfn)~A,ECL_NIL,ecl_make_fixnum(~D)},"
(1- (- (min minarg si:c-arguments-limit))))))
(format stream "~%{0,0,~D,0,ecl_make_fixnum(~D),ecl_make_fixnum(~D),(cl_objectfn)~A,NULL,ECL_NIL,ecl_make_fixnum(~D)},"
narg
(vv-location loc)
(vv-location fname-loc)
......
......@@ -196,6 +196,11 @@
(proclamation ext:constant-form-value (t &optional environment) t)
(proclamation ext:constantp-inner (t &optional environment) gen-bool)
(proclamation si::remove-documentation (t) t)
(proclamation si::find-declarations (t &optional gen-bool) t)
(proclamation si::search-keyword (t t) t)
(proclamation si::check-keyword (list list &optional gen-bool) t)
;;;
;;; 4. TYPES AND CLASSES
;;;
......@@ -313,6 +318,12 @@
(proclamation clos:extract-lambda-list (list) list)
#+clos
(proclamation clos:extract-specializer-names (list) list)
#+clos
(proclamation clos::install-method (t t t t t &rest t) t)
#+clos
(proclamation clos::find-slot-definition (t t) t)
#+clos
(proclamation clos::ensure-class (t &rest t) t)
#+(and threads clos) (proclamation mp::compare-and-swap-standard-instance (ext:instance t t t) t)
#+(and threads clos) (proclamation mp::compare-and-swap-slot-value (ext:instance symbol t t) t)
......@@ -332,6 +343,8 @@
(proclamation si:structure-set (structure-object t fixnum t) t)
(proclamation si:structurep (t) gen-bool :predicate)
(proclamation si:structure-subtype-p (t t) gen-bool :predicate)
(proclamation si::define-structure (t t t t t t t t t t t t t t t) t)
(proclamation si::structure-type-error (t t t t) t)
#+threads (proclamation mp:compare-and-swap-structure (structure-object t fixnum t t) t)
......@@ -452,6 +465,7 @@
(proclamation si:select-package (package-designator) package)
(proclamation si:package-hash-tables (package-designator)
(values hash-table hash-table list) :reader)
(proclamation si::packages-iterator (t list gen-bool) function)
(proclamation ext:package-lock (package-designator gen-bool) package)
(proclamation ext:package-locked-p (package-designator) boolean :no-side-effects)
(proclamation ext:package-local-nicknames
......@@ -992,6 +1006,7 @@
(t sequence sequence-index (or null sequence-index))
(values fixnum fixnum fixnum) :no-side-effects)
(proclamation si::sequence-count ((or null integer)) fixnum :no-side-effects)
(proclamation si::coerce-to-list (sequence) list)
;;;
;;; 18. HASH TABLES
......@@ -1222,6 +1237,10 @@
;; Slot accessor:
;; (proclamation print-not-readable-object (condition) t)
;; ECL extensions:
(proclamation si::pprint-logical-block-helper (t t t string gen-bool string) t)
(proclamation si::pprint-pop-helper (t t stream) t)
;;;
;;; 23. READER
;;;
......@@ -1383,6 +1402,10 @@
(proclamation si:unbound () t :pure)
(proclamation si:traced-old-definition (t) t :no-side-effects)
(proclamation si::expand-set-documentation (t t t) t)
(proclamation si::set-documentation (t t t) t)
(proclamation si::get-documentation (t t) t)
#+clos
(proclamation si:allocate-raw-instance (t t fixnum) ext:instance)
#+clos
......
......@@ -283,14 +283,14 @@ extern ECL_API cl_object si_make_weak_pointer(cl_object o);
extern ECL_API cl_object si_weak_pointer_value(cl_object o);
#else
extern ECL_API cl_object si_allocate _ECL_ARGS((cl_narg narg, cl_object type, cl_object qty, ...));
extern ECL_API cl_object si_maximum_allocatable_pages _ECL_ARGS((cl_narg narg, cl_object type));
extern ECL_API cl_object si_allocated_pages _ECL_ARGS((cl_narg narg, cl_object type));
extern ECL_API cl_object si_maximum_allocatable_pages _ECL_ARGS((cl_narg narg, cl_object type, ...));
extern ECL_API cl_object si_allocated_pages _ECL_ARGS((cl_narg narg, cl_object type, ...));
extern ECL_API cl_object si_alloc_contpage _ECL_ARGS((cl_narg narg, cl_object qty, ...));
extern ECL_API cl_object si_allocated_contiguous_pages _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_maximum_contiguous_pages _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_allocated_contiguous_pages _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_maximum_contiguous_pages _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_allocate_contiguous_pages _ECL_ARGS((cl_narg narg, cl_object qty, ...));
extern ECL_API cl_object si_get_hole_size _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_set_hole_size _ECL_ARGS((cl_narg narg, cl_object size));
extern ECL_API cl_object si_get_hole_size _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_set_hole_size _ECL_ARGS((cl_narg narg, cl_object size, ...));
extern ECL_API cl_object si_ignore_maximum_pages _ECL_ARGS((cl_narg narg, ...));
extern ECL_API void *ecl_alloc(cl_index n);
extern ECL_API void *ecl_alloc_align(cl_index size, cl_index align);
......@@ -431,12 +431,12 @@ extern ECL_API cl_object cl_function_lambda_expression(cl_object fun);
extern ECL_API cl_object si_compiled_function_file(cl_object fun);
extern ECL_API cl_object ecl_make_cfun(cl_objectfn_fixed c_function, cl_object name, cl_object block, int narg);
extern ECL_API cl_object ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object block);
extern ECL_API cl_object ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block);
extern ECL_API cl_object ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object block, int narg_fixed);
extern ECL_API cl_object ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block, int narg_fixed);
extern ECL_API void ecl_def_c_function(cl_object sym, cl_objectfn_fixed c_function, int narg);
extern ECL_API void ecl_def_c_macro(cl_object sym, cl_objectfn_fixed c_function, int narg);
extern ECL_API void ecl_def_c_macro_va(cl_object sym, cl_objectfn c_function);
extern ECL_API void ecl_def_c_function_va(cl_object sym, cl_objectfn c_function);
extern ECL_API void ecl_def_c_macro_va(cl_object sym, cl_objectfn c_function, int narg_fixed);
extern ECL_API void ecl_def_c_function_va(cl_object sym, cl_objectfn c_function, int narg_fixed);
extern ECL_API void ecl_set_function_source_file_info(cl_object fun, cl_object source, cl_object position);
extern ECL_API void ecl_cmp_defmacro(cl_object data);
extern ECL_API void ecl_cmp_defun(cl_object data);
......@@ -762,10 +762,10 @@ extern ECL_API cl_object cl_format _ECL_ARGS((cl_narg narg, cl_object stream, cl
/* gbc.c */
#if !defined(GBC_BOEHM)
extern ECL_API cl_object si_room_report _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_reset_gc_count _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_gc_time _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_gc(cl_object area);
extern ECL_API cl_object si_room_report _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_reset_gc_count _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_gc_time _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_gc(cl_object area, ...);
#define GC_enabled() GC_enable
#define GC_enable() GC_enable = TRUE;
#define GC_disable() GC_enable = FALSE;
......@@ -1503,9 +1503,9 @@ extern ECL_API cl_object si_print_unreadable_object_function(cl_object o, cl_obj
/* profile.c */
#ifdef PROFILE
extern ECL_API cl_object si_profile _ECL_ARGS((cl_narg narg, cl_object scale, cl_object start_address));
extern ECL_API cl_object si_clear_profile _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_display_profile _ECL_ARGS((cl_narg narg));
extern ECL_API cl_object si_profile _ECL_ARGS((cl_narg narg, cl_object scale, cl_object start_address, ...));
extern ECL_API cl_object si_clear_profile _ECL_ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_display_profile _ECL_ARGS((cl_narg narg, ...));
extern ECL_API int total_ticks(unsigned short *aar, unsigned int dim);
extern ECL_API int init_profile(void);
#endif
......@@ -2236,7 +2236,7 @@ extern ECL_API cl_object clos_method_specializers _ECL_ARGS((cl_narg narg, cl_ob
extern ECL_API cl_object cl_method_qualifiers _ECL_ARGS((cl_narg narg, cl_object V1, ...));
extern ECL_API cl_object clos_method_function _ECL_ARGS((cl_narg narg, cl_object V1, ...));
extern ECL_API cl_object clos_method_plist _ECL_ARGS((cl_narg narg, cl_object V1, ...));
extern ECL_API cl_object clos_install_method _ECL_ARGS((cl_narg narg, cl_object V1, cl_object V2, cl_object V3, cl_object V4, cl_object V5, cl_object V6, cl_object V7, ...));
extern ECL_API cl_object clos_install_method _ECL_ARGS((cl_narg narg, cl_object V1, cl_object V2, cl_object V3, cl_object V4, cl_object V5, ...));
#endif
......
......@@ -299,8 +299,8 @@ extern void ecl_reconstruct_serialized_hashtable(cl_object h);
#define GFUN_COMB(x) ((x)->instance.slots[2])
extern cl_object FEnot_funcallable_vararg(cl_narg narg, ...);
extern cl_object ecl_slot_reader_dispatch(cl_narg narg, cl_object instance);
extern cl_object ecl_slot_writer_dispatch(cl_narg narg, cl_object value, cl_object instance);
extern cl_object ecl_slot_reader_dispatch(cl_narg narg, ... /* cl_object instance */);
extern cl_object ecl_slot_writer_dispatch(cl_narg narg, ... /* cl_object value, cl_object instance */);
/* load.d */
......
......@@ -45,17 +45,6 @@
#define big_size big_num->_mp_size
#define big_limbs big_num->_mp_d
#define cl_def_c_function_va(sym,function) ecl_def_c_function_va(sym,function)
#define cl_def_c_function(sym,function,narg) ecl_def_c_function(sym,function,narg)
#define cl_def_c_macro(sym,function,narg) { \
int n = (narg); \
if (n < 0) \
ecl_def_c_macro_va((sym),(function)); \
else \
ecl_def_c_macro((sym),(function),n); }
#define cl_make_cfun(fun,name,block,narg) ecl_make_cfun(fun,name,block,narg)
#define cl_make_cfun_va(fun,name,block) ecl_make_cfun_va(fun,name,block)
#define cl_make_cclosure_va(fun,name,block) ecl_make_cclosure_va(fun,name,block)
#define si_bc_file(o) si_compiled_function_file(o)
#define ARRAYP ECL_ARRAYP
#define VECTORP ECL_VECTORP
......
......@@ -736,7 +736,7 @@ struct ecl_codeblock {
cl_object name;
cl_object links; /* list of symbols with linking calls */
cl_index cfuns_size; /* number of functions defined */
const struct ecl_cfun *cfuns;
const struct ecl_cfunfixed *cfuns;
cl_object source; /* common debug information for this block */
cl_object refs; /* reference counter for the library */
cl_object error; /* error message when loading */
......@@ -763,16 +763,26 @@ struct ecl_bclosure {
};
struct ecl_cfun { /* compiled function header */
_ECL_HDR1(narg);
_ECL_HDR1(narg); /* number of fixed arguments */
cl_object name; /* compiled function name */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address */
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
/* Some architectures (i.e. ARM64 on iOS) use a different
* calling convention for the fixed and variadic arguments of
* a variadic function. The only portable way to allow for
* function redefinitions during runtime in these
* architectures is to set entry to a dispatch function
* calling entry_variadic with the correct calling conventions
* (see cfun.d). -- mg 2019-12-02 */
cl_objectfn entry_variadic;
#endif
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_cfunfixed { /* compiled function header */
_ECL_HDR1(narg);
_ECL_HDR1(narg); /* number of arguments */
cl_object name; /* compiled function name */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address (must match the position of
......@@ -783,11 +793,14 @@ struct ecl_cfunfixed { /* compiled function header */
};
struct ecl_cclosure { /* compiled closure header */
_ECL_HDR;
_ECL_HDR1(narg); /* number of fixed arguments */
cl_object env; /* environment */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address (must match the position of
* the equivalent field in cfun) */
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
cl_objectfn entry_variadic; /* see struct ecl_cfun above */
#endif
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment