parent
138e6c11c0
commit
292dac4e51
|
@ -36,16 +36,19 @@
|
|||
[precise-cases?
|
||||
;; Get full arity to record for arity reporting
|
||||
(define idss unsorted-idss)
|
||||
(define (bytes->string-constant s)
|
||||
;; Drop the leading `#`:
|
||||
(substring (format "~s" s) 1))
|
||||
(define (encode big-endian?)
|
||||
(bytes->string-constant
|
||||
(apply bytes-append
|
||||
;; Encode individual arities as pairs of `int`s:
|
||||
(for/list ([ids (in-list idss)])
|
||||
(define-values (min-a max-a) (lambda-arity `(lambda ,ids)))
|
||||
(bytes-append (integer->integer-bytes min-a 4 #t big-endian?)
|
||||
(integer->integer-bytes max-a 4 #t big-endian?))))))
|
||||
(values (- (+ (length idss) 1))
|
||||
(substring
|
||||
(format "~s"
|
||||
(apply bytes-append
|
||||
;; Encode individual arities as pairs of little-endian `int`s:
|
||||
(for/list ([ids (in-list idss)])
|
||||
(define-values (min-a max-a) (lambda-arity `(lambda ,ids)))
|
||||
(bytes-append (integer->integer-bytes min-a 4 #t #f)
|
||||
(integer->integer-bytes max-a 4 #t #f)))))
|
||||
1))]
|
||||
(format "c_SELECT_LITTLE_BIG_ENDIAN(~a, ~a)" (encode #f) (encode #t)))]
|
||||
[else
|
||||
;; Get approximate arity for predictions about calls
|
||||
(define idss (sort unsorted-idss < #:key args-length))
|
||||
|
|
|
@ -33,6 +33,10 @@
|
|||
#include "schmach.h"
|
||||
#include "schrktio.h"
|
||||
#include <errno.h>
|
||||
#ifdef OS_X
|
||||
/* needed for old gcc to define `off_t` */
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
#ifndef DONT_IGNORE_PIPE_SIGNAL
|
||||
# include <signal.h>
|
||||
#endif
|
||||
|
|
|
@ -66,8 +66,13 @@ static void c_pop_mark_stack(c_saved_mark_stack_t s)
|
|||
}
|
||||
#endif
|
||||
|
||||
#define c_use_fuel() if (DECREMENT_FUEL(c_scheme_fuel_counter, 1) <= 0) scheme_out_of_fuel();
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
# define c_SELECT_LITTLE_BIG_ENDIAN(l, b) b
|
||||
#else
|
||||
# define c_SELECT_LITTLE_BIG_ENDIAN(l, b) l
|
||||
#endif
|
||||
|
||||
#define c_use_fuel() if (DECREMENT_FUEL(c_scheme_fuel_counter, 1) <= 0) scheme_out_of_fuel();
|
||||
|
||||
#define c_RUNSTACK_INIT_VAL NULL
|
||||
|
||||
|
@ -212,20 +217,12 @@ static Scheme_Object *c_wrong_arity(const char *name, int argc, Scheme_Object **
|
|||
return NULL;
|
||||
}
|
||||
|
||||
static mzshort *convert_arities(int mina, const char *a)
|
||||
{
|
||||
/* FIXME: On a big-endian machine, we need to reverse the byte order in arities */
|
||||
return (mzshort *)a;
|
||||
}
|
||||
|
||||
static Scheme_Object *scheme_make_prim_w_case_arity(Scheme_Prim *prim, const char *name, mzshort mina, const char *arities)
|
||||
{
|
||||
Scheme_Object *p;
|
||||
mzshort *a;
|
||||
p = scheme_make_prim_w_arity(prim, name, 0, 0);
|
||||
((Scheme_Primitive_Proc *)p)->mina = mina;
|
||||
a = convert_arities(mina, arities);
|
||||
((Scheme_Primitive_Proc *)p)->mu.cases = a;
|
||||
((Scheme_Primitive_Proc *)p)->mu.cases = (mzshort *)arities;
|
||||
return p;
|
||||
}
|
||||
|
||||
|
@ -235,11 +232,9 @@ static Scheme_Object *scheme_make_prim_closure_w_case_arity(Scheme_Primitive_Clo
|
|||
mzshort mina, const char *arities)
|
||||
{
|
||||
Scheme_Object *p;
|
||||
mzshort *a;
|
||||
p = scheme_make_prim_closure_w_arity(prim, size, vals, name, 0, 0);
|
||||
((Scheme_Primitive_Proc *)p)->mina = mina;
|
||||
a = convert_arities(mina, arities);
|
||||
((Scheme_Primitive_Proc *)p)->mu.cases = a;
|
||||
((Scheme_Primitive_Proc *)p)->mu.cases = (mzshort *)arities;
|
||||
return p;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user