suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cify: repair for big-endian platforms

Browse Source 
Relevant to #2018
This commit is contained in:
Matthew Flatt 2018-09-09 14:00:15 -06:00
parent 138e6c11c0
commit 292dac4e51
3 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
racket/src/cify/arg.rkt
View File

@ -36,16 +36,19 @@
[precise-cases? [precise-cases?
;; Get full arity to record for arity reporting ;; Get full arity to record for arity reporting
(define idss unsorted-idss) (define idss unsorted-idss)
(values (- (+ (length idss) 1)) (define (bytes->string-constant s)
(substring ;; Drop the leading `#`:
(format "~s" (substring (format "~s" s) 1))
(define (encode big-endian?)
(bytes->string-constant
(apply bytes-append (apply bytes-append
;; Encode individual arities as pairs of little-endian `int`s: ;; Encode individual arities as pairs of `int`s:
(for/list ([ids (in-list idss)]) (for/list ([ids (in-list idss)])
(define-values (min-a max-a) (lambda-arity `(lambda ,ids))) (define-values (min-a max-a) (lambda-arity `(lambda ,ids)))
(bytes-append (integer->integer-bytes min-a 4 #t #f) (bytes-append (integer->integer-bytes min-a 4 #t big-endian?)
(integer->integer-bytes max-a 4 #t #f))))) (integer->integer-bytes max-a 4 #t big-endian?))))))
1))] (values (- (+ (length idss) 1))
(format "c_SELECT_LITTLE_BIG_ENDIAN(~a, ~a)" (encode #f) (encode #t)))]
[else [else
;; Get approximate arity for predictions about calls ;; Get approximate arity for predictions about calls
(define idss (sort unsorted-idss < #:key args-length)) (define idss (sort unsorted-idss < #:key args-length))

4
racket/src/racket/src/port.c
View File

@ -33,6 +33,10 @@
#include "schmach.h" #include "schmach.h"
#include "schrktio.h" #include "schrktio.h"
#include <errno.h> #include <errno.h>
#ifdef OS_X
/* needed for old gcc to define `off_t` */
# include <unistd.h>
#endif
#ifndef DONT_IGNORE_PIPE_SIGNAL #ifndef DONT_IGNORE_PIPE_SIGNAL
# include <signal.h> # include <signal.h>
#endif #endif

21
racket/src/racket/src/startup-glue.inc
View File

@ -66,8 +66,13 @@ static void c_pop_mark_stack(c_saved_mark_stack_t s)
} }
#endif #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 #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; 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) static Scheme_Object *scheme_make_prim_w_case_arity(Scheme_Prim *prim, const char *name, mzshort mina, const char *arities)
{ {
Scheme_Object *p; Scheme_Object *p;
mzshort *a;
p = scheme_make_prim_w_arity(prim, name, 0, 0); p = scheme_make_prim_w_arity(prim, name, 0, 0);
((Scheme_Primitive_Proc *)p)->mina = mina; ((Scheme_Primitive_Proc *)p)->mina = mina;
a = convert_arities(mina, arities); ((Scheme_Primitive_Proc *)p)->mu.cases = (mzshort *)arities;
((Scheme_Primitive_Proc *)p)->mu.cases = a;
return p; return p;
} }
@ -235,11 +232,9 @@ static Scheme_Object *scheme_make_prim_closure_w_case_arity(Scheme_Primitive_Clo
mzshort mina, const char *arities) mzshort mina, const char *arities)
{ {
Scheme_Object *p; Scheme_Object *p;
mzshort *a;
p = scheme_make_prim_closure_w_arity(prim, size, vals, name, 0, 0); p = scheme_make_prim_closure_w_arity(prim, size, vals, name, 0, 0);
((Scheme_Primitive_Proc *)p)->mina = mina; ((Scheme_Primitive_Proc *)p)->mina = mina;
a = convert_arities(mina, arities); ((Scheme_Primitive_Proc *)p)->mu.cases = (mzshort *)arities;
((Scheme_Primitive_Proc *)p)->mu.cases = a;
return p; return p;
} }