From 331b1043455425bb98c69cd08955f5f9dfbda821 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 2 Jul 2015 13:32:38 -0600 Subject: [PATCH] JIT: inline `ptr-ref` and `ptr-set!` Special treatment of `ptr-ref` and `ptr-set!` applies when the second argument is one of a few primitive C types: `_int`, `_double`, etc. --- .../scribblings/guide/performance.scrbl | 28 +- .../tests/racket/foreign-test.rktl | 116 +++++++ racket/collects/ffi/unsafe.rkt | 26 +- racket/src/foreign/foreign.c | 73 ++++- racket/src/foreign/foreign.rktc | 53 ++- racket/src/racket/src/gen-jit-ts.rkt | 3 +- racket/src/racket/src/jit.h | 4 + racket/src/racket/src/jit_ts.c | 4 + racket/src/racket/src/jit_ts_def.c | 189 +++++------ racket/src/racket/src/jit_ts_future_glue.c | 192 ++++++----- racket/src/racket/src/jit_ts_protos.h | 55 ++-- racket/src/racket/src/jit_ts_runtime_glue.c | 14 + racket/src/racket/src/jitcall.c | 2 +- racket/src/racket/src/jitcommon.c | 29 ++ racket/src/racket/src/jitinline.c | 303 ++++++++++++++++++ .../src/racket/src/lightning/i386/fp-extfpu.h | 5 + racket/src/racket/src/lightning/i386/fp-sse.h | 2 + racket/src/racket/src/lightning/i386/fp.h | 5 + racket/src/racket/src/lightning/ppc/fp.h | 4 +- racket/src/racket/src/optimize.c | 3 +- racket/src/racket/src/schpriv.h | 15 + 21 files changed, 904 insertions(+), 221 deletions(-) diff --git a/pkgs/racket-doc/scribblings/guide/performance.scrbl b/pkgs/racket-doc/scribblings/guide/performance.scrbl index 037dea2b2c..a827026c7f 100644 --- a/pkgs/racket-doc/scribblings/guide/performance.scrbl +++ b/pkgs/racket-doc/scribblings/guide/performance.scrbl @@ -2,7 +2,8 @@ @(require scribble/manual "guide-utils.rkt" (for-label racket/flonum racket/unsafe/ops - racket/performance-hint)) + racket/performance-hint + ffi/unsafe)) @title[#:tag "performance"]{Performance} @@ -358,6 +359,31 @@ crashes or memory corruption. @; ---------------------------------------------------------------------- +@section[#:tag "ffi-pointer-access"]{Foreign Pointers} + +The @racketmodname[ffi/unsafe] library provides functions for unsafely +reading and writing arbitrary pointer values. The JIT recognizes uses +of @racket[ptr-ref] and @racket[ptr-set!] where the second argument is +a direct reference to one of the following built-in C types: +@racket[_int8], @racket[_int16], @racket[_int32], @racket[_int64], +@racket[_double], @racket[_float], and @racket[_pointer]. Then, if the +first argument to @racket[ptr-ref] or @racket[ptr-set!] is a C pointer +(not a byte string), then the pointer read or write is performed +inline in the generated code. + +The bytecode compiler will optimize references to integer +abbreviations like @racket[_int] to C types like +@racket[_int32]---where the representation sizes are constant across +platforms---so the JIT can specialize access with those C types. C +types such as @racket[_long] or @racket[_intptr] are not constant +across platforms, so their uses are currently not specialized by the +JIT. + +Pointer reads and writes using @racket[_float] or @racket[_double] are +not currently subject to unboxing optimizations. + +@; ---------------------------------------------------------------------- + @section[#:tag "regexp-perf"]{Regular Expression Performance} When a string or byte string is provided to a function like diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 7f84e55b8b..33b904889f 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -966,6 +966,122 @@ (define-cpointer-type _foo) (test 'foo? object-name foo?) +;; ---------------------------------------- +;; Test JIT inlining + +(define bstr (cast (make-bytes 64) _pointer _pointer)) + +(for/fold ([v 1.0]) ([i (in-range 100)]) + (ptr-set! bstr _float v) + (ptr-set! bstr _float 1 (+ v 0.5)) + (ptr-set! bstr _float 'abs 8 (+ v 0.25)) + (unless (= v (ptr-ref bstr _float)) + (error 'float "failed")) + (unless (= (+ v 0.5) (ptr-ref bstr _float 'abs 4)) + (error 'float "failed(2) ~s ~s" (+ v 0.5) (ptr-ref bstr _float 'abs 4))) + (unless (= (+ v 0.25) (ptr-ref bstr _float 2)) + (error 'float "failed(3)")) + (+ 1.0 v)) + +(for/fold ([v 1.0]) ([i (in-range 100)]) + (ptr-set! bstr _double v) + (ptr-set! bstr _double 1 (+ v 0.5)) + (ptr-set! bstr _double 'abs 16 (+ v 0.25)) + (unless (= v (ptr-ref bstr _double)) + (error 'double "failed")) + (unless (= (+ v 0.5) (ptr-ref bstr _double 'abs 8)) + (error 'double "failed(2)")) + (unless (= (+ v 0.25) (ptr-ref bstr _double 2)) + (error 'double "failed(3)")) + (+ 1.0 v)) + +(for ([i (in-range 256)]) + (ptr-set! bstr _uint8 i) + (ptr-set! bstr _uint8 1 (- 255 i)) + (unless (= i (ptr-ref bstr _uint8)) + (error 'uint8 "fail ~s vs. ~s" i (ptr-ref bstr _uint8))) + (unless (= (- 255 i) (ptr-ref bstr _uint8 'abs 1)) + (error 'uint8 "fail(2) ~s vs. ~s" (- 255 i) (ptr-ref bstr _uint8 'abs 1)))) + +(for ([i (in-range -128 128)]) + (ptr-set! bstr _int8 i) + (unless (= i (ptr-ref bstr _int8)) + (error 'int8 "fail ~s vs. ~s" i (ptr-ref bstr _int8)))) + +(for ([i (in-range (expt 2 16))]) + (ptr-set! bstr _uint16 i) + (ptr-set! bstr _uint16 3 (- (sub1 (expt 2 16)) i)) + (unless (= i (ptr-ref bstr _uint16)) + (error 'uint16 "fail ~s vs. ~s" i (ptr-ref bstr _uint16))) + (unless (= (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)) + (error 'uint16 "fail(2) ~s vs. ~s" (- (sub1 (expt 2 16)) i) (ptr-ref bstr _uint16 'abs 6)))) + +(for ([j (in-range 100)]) + (for ([i (in-range (- (expt 2 15)) (sub1 (expt 2 15)))]) + (ptr-set! bstr _int16 i) + (unless (= i (ptr-ref bstr _int16)) + (error 'int16 "fail ~s vs. ~s" i (ptr-ref bstr _int16))))) + +(let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _uint32 i) + (ptr-set! bstr _uint32 1 (- hi (- i lo) 1)) + (unless (= i (ptr-ref bstr _uint32)) + (error 'uint32 "fail ~s vs. ~s" i (ptr-ref bstr _uint32))) + (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint32 'abs 4)) + (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint32))))) + (go 0 256) + (go (- (expt 2 31) 256) (+ (expt 2 31) 256)) + (go (- (expt 2 32) 256) (expt 2 32))) + +(let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _int32 i) + (unless (= i (ptr-ref bstr _int32)) + (error 'int32 "fail ~s vs. ~s" i (ptr-ref bstr _int32))))) + (go -256 256) + (go (- (expt 2 31) 256) (sub1 (expt 2 31))) + (go (- (expt 2 31)) (- 256 (expt 2 31)))) + +(let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _uint64 i) + (ptr-set! bstr _uint64 1 (- hi (- i lo) 1)) + (unless (= i (ptr-ref bstr _uint64)) + (error 'uint64 "fail ~s vs. ~s" i (ptr-ref bstr _uint64))) + (unless (= (- hi (- i lo) 1) (ptr-ref bstr _uint64 'abs 8)) + (error 'uint32 "fail ~s vs. ~s" (- hi (- i lo) 1) (ptr-ref bstr _uint64))))) + (go 0 256) + (go (- (expt 2 63) 256) (+ (expt 2 63) 256)) + (go (- (expt 2 64) 256) (expt 2 64))) + +(let () + (define (go lo hi) + (for ([i (in-range lo hi)]) + (ptr-set! bstr _int64 i) + (unless (= i (ptr-ref bstr _int64)) + (error 'int64 "fail ~s vs. ~s" i (ptr-ref bstr _int64))))) + (go -256 256) + (go (- (expt 2 63) 256) (sub1 (expt 2 63))) + (go (- (expt 2 63)) (- 256 (expt 2 63)))) + +(let () + (define p (cast bstr _pointer _pointer)) + (for ([i (in-range 100)]) + (ptr-set! bstr _pointer (ptr-add p i)) + (ptr-set! bstr _pointer 2 p) + (unless (ptr-equal? p (ptr-add (ptr-ref bstr _pointer) (- i))) + (error 'pointer "fail ~s vs. ~s" + (cast p _pointer _intptr) + (cast (ptr-ref bstr _pointer) _pointer _intptr))) + (unless (ptr-equal? p (ptr-ref bstr _pointer 'abs (* 2 (ctype-sizeof _pointer)))) + (error 'pointer "fail ~s vs. ~s" + (cast p _pointer _intptr) + (cast (ptr-ref bstr _pointer 'abs (ctype-sizeof _pointer)) _pointer _intptr))))) + ;; ---------------------------------------- (report-errs) diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index b033b3d287..e4364b11d7 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -67,29 +67,33 @@ [else (error 'foreign "internal error: bad compiler size for `~s'" c-type)])) -;; _short etc is a convenient name for whatever is the compiler's `short' -;; (_short is signed) +;; _short etc is a convenient name for the compiler's `short', +;; which is always a 16-bit value for Racket: (provide _short _ushort _sshort) -(define-values (_short _ushort _sshort) (sizeof->3ints 'short)) +(define _short _int16) +(define _ushort _uint16) +(define _sshort _short) -;; _int etc is a convenient name for whatever is the compiler's `int' -;; (_int is signed) +;; _int etc is a convenient name for whatever is the compiler's `int', +;; which is always a 32-byte value for Racket: (provide _int _uint _sint) -(define-values (_int _uint _sint) (sizeof->3ints 'int)) +(define _int _int32) +(define _uint _uint32) +(define _sint _int) -;; _long etc is a convenient name for whatever is the compiler's `long' -;; (_long is signed) +;; _long etc is a convenient name for whatever is the compiler's `long', +;; which varies among platforms: (provide _long _ulong _slong) (define-values (_long _ulong _slong) (sizeof->3ints 'long)) ;; _llong etc is a convenient name for whatever is the compiler's `long long' -;; (_llong is signed) +;; which varies among platforms: (provide _llong _ullong _sllong) (define-values (_llong _ullong _sllong) (sizeof->3ints '(long long))) ;; _intptr etc is a convenient name for whatever is the integer -;; equivalent of the compiler's pointer (see `intptr_t') (_intptr is -;; signed) +;; equivalent of the compiler's pointer (see `intptr_t'), +;; which varies among platforms: (provide _intptr _uintptr _sintptr) (define-values (_intptr _uintptr _sintptr) (sizeof->3ints '(void *))) diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c index 9760243211..1a4772686b 100644 --- a/racket/src/foreign/foreign.c +++ b/racket/src/foreign/foreign.c @@ -3100,6 +3100,11 @@ static Scheme_Object *foreign_ptr_ref(int argc, Scheme_Object *argv[]) } #undef MYNAME +Scheme_Object *scheme_foreign_ptr_ref(int argc, Scheme_Object **argv) +{ + return foreign_ptr_ref(argc, argv); +} + /* (ptr-set! cpointer type [['abs] n] value) -> void */ /* n defaults to 0 which is the only value that should be used with ffi_objs */ /* if n is given, an 'abs flag can precede it to make n be a byte offset */ @@ -3148,6 +3153,11 @@ static Scheme_Object *foreign_ptr_set_bang(int argc, Scheme_Object *argv[]) } #undef MYNAME +void scheme_foreign_ptr_set(int argc, Scheme_Object **argv) +{ + (void)foreign_ptr_set_bang(argc, argv); +} + /* (ptr-equal? cpointer cpointer) -> boolean */ #define MYNAME "ptr-equal?" static Scheme_Object *foreign_ptr_equal_p(int argc, Scheme_Object *argv[]) @@ -4363,6 +4373,39 @@ void scheme_init_foreign_places() { #endif } +static Scheme_Object *scheme_make_inline_noncm_prim(Scheme_Prim *prim, + const char *name, + mzshort mina, mzshort maxa) +{ + Scheme_Object *p; + int flags = 0; + + p = scheme_make_noncm_prim(prim, name, mina, maxa); + + if ((mina <= 1) && (maxa >= 1)) + flags |= SCHEME_PRIM_IS_UNARY_INLINED; + if ((mina <= 2) && (maxa >= 2)) + flags |= SCHEME_PRIM_IS_BINARY_INLINED; + if ((mina <= 0) || (maxa > 2)) + flags |= SCHEME_PRIM_IS_NARY_INLINED; + + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags); + + return p; +} + +Scheme_Object *scheme_pointer_ctype; +Scheme_Object *scheme_float_ctype; +Scheme_Object *scheme_double_ctype; +Scheme_Object *scheme_int8_ctype; +Scheme_Object *scheme_uint8_ctype; +Scheme_Object *scheme_int16_ctype; +Scheme_Object *scheme_uint16_ctype; +Scheme_Object *scheme_int32_ctype; +Scheme_Object *scheme_uint32_ctype; +Scheme_Object *scheme_int64_ctype; +Scheme_Object *scheme_uint64_ctype; + void scheme_init_foreign(Scheme_Env *env) { Scheme_Env *menv; @@ -4449,9 +4492,9 @@ void scheme_init_foreign(Scheme_Env *env) scheme_add_global_constant("memcpy", scheme_make_noncm_prim(foreign_memcpy, "memcpy", 3, 6), menv); scheme_add_global_constant("ptr-ref", - scheme_make_noncm_prim(foreign_ptr_ref, "ptr-ref", 2, 4), menv); + scheme_make_inline_noncm_prim(foreign_ptr_ref, "ptr-ref", 2, 4), menv); scheme_add_global_constant("ptr-set!", - scheme_make_noncm_prim(foreign_ptr_set_bang, "ptr-set!", 3, 5), menv); + scheme_make_inline_noncm_prim(foreign_ptr_set_bang, "ptr-set!", 3, 5), menv); scheme_add_global_constant("ptr-equal?", scheme_make_noncm_prim(foreign_ptr_equal_p, "ptr-equal?", 2, 2), menv); scheme_add_global_constant("make-sized-byte-string", @@ -4483,6 +4526,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint8)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_int8); + REGISTER_SO(scheme_int8_ctype); + scheme_int8_ctype = (Scheme_Object *)t; scheme_add_global_constant("_int8", (Scheme_Object*)t, menv); s = scheme_intern_symbol("uint8"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4490,6 +4535,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_uint8)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_uint8); + REGISTER_SO(scheme_uint8_ctype); + scheme_uint8_ctype = (Scheme_Object *)t; scheme_add_global_constant("_uint8", (Scheme_Object*)t, menv); s = scheme_intern_symbol("int16"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4497,6 +4544,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint16)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_int16); + REGISTER_SO(scheme_int16_ctype); + scheme_int16_ctype = (Scheme_Object *)t; scheme_add_global_constant("_int16", (Scheme_Object*)t, menv); s = scheme_intern_symbol("uint16"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4504,6 +4553,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_uint16)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_uint16); + REGISTER_SO(scheme_uint16_ctype); + scheme_uint16_ctype = (Scheme_Object *)t; scheme_add_global_constant("_uint16", (Scheme_Object*)t, menv); s = scheme_intern_symbol("int32"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4511,6 +4562,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint32)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_int32); + REGISTER_SO(scheme_int32_ctype); + scheme_int32_ctype = (Scheme_Object *)t; scheme_add_global_constant("_int32", (Scheme_Object*)t, menv); s = scheme_intern_symbol("uint32"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4518,6 +4571,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_uint32)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_uint32); + REGISTER_SO(scheme_uint32_ctype); + scheme_uint32_ctype = (Scheme_Object *)t; scheme_add_global_constant("_uint32", (Scheme_Object*)t, menv); s = scheme_intern_symbol("int64"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4525,6 +4580,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint64)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_int64); + REGISTER_SO(scheme_int64_ctype); + scheme_int64_ctype = (Scheme_Object *)t; scheme_add_global_constant("_int64", (Scheme_Object*)t, menv); s = scheme_intern_symbol("uint64"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4532,6 +4589,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_uint64)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_uint64); + REGISTER_SO(scheme_uint64_ctype); + scheme_uint64_ctype = (Scheme_Object *)t; scheme_add_global_constant("_uint64", (Scheme_Object*)t, menv); s = scheme_intern_symbol("fixint"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4567,6 +4626,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_float)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_float); + REGISTER_SO(scheme_float_ctype); + scheme_float_ctype = (Scheme_Object *)t; scheme_add_global_constant("_float", (Scheme_Object*)t, menv); s = scheme_intern_symbol("double"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4574,6 +4635,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_double)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_double); + REGISTER_SO(scheme_double_ctype); + scheme_double_ctype = (Scheme_Object *)t; scheme_add_global_constant("_double", (Scheme_Object*)t, menv); s = scheme_intern_symbol("longdouble"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4644,6 +4707,8 @@ void scheme_init_foreign(Scheme_Env *env) t->basetype = (s); t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_pointer)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_pointer); + REGISTER_SO(scheme_pointer_ctype); + scheme_pointer_ctype = (Scheme_Object *)t; scheme_add_global_constant("_pointer", (Scheme_Object*)t, menv); s = scheme_intern_symbol("gcpointer"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); @@ -4798,9 +4863,9 @@ void scheme_init_foreign(Scheme_Env *env) scheme_add_global_constant("memcpy", scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "memcpy", 3, 6), menv); scheme_add_global_constant("ptr-ref", - scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ptr-ref", 2, 4), menv); + scheme_make_inline_noncm_prim((Scheme_Prim *)unimplemented, "ptr-ref", 2, 4), menv); scheme_add_global_constant("ptr-set!", - scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ptr-set!", 3, 5), menv); + scheme_make_inline_noncm_prim((Scheme_Prim *)unimplemented, "ptr-set!", 3, 5), menv); scheme_add_global_constant("ptr-equal?", scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ptr-equal?", 2, 2), menv); scheme_add_global_constant("make-sized-byte-string", diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc index bf56eec10e..135742e75c 100755 --- a/racket/src/foreign/foreign.rktc +++ b/racket/src/foreign/foreign.rktc @@ -2218,7 +2218,7 @@ static Scheme_Object *do_memop(const char *who, int mode, /* if n is given, an 'abs flag can precede it to make n be a byte offset */ /* rather than some multiple of sizeof(type). */ /* WARNING: there are *NO* checks at all, this is raw C level code. */ -@cdefine[ptr-ref 2 4]{ +@cdefine[ptr-ref 2 4 #:kind inline_noncm]{ intptr_t size=0; void *ptr; Scheme_Object *base; intptr_t delta; int gcsrc=1; Scheme_Object *cp, *already_ptr = NULL; @@ -2274,12 +2274,17 @@ static Scheme_Object *do_memop(const char *who, int mode, return C2SCHEME(already_ptr, argv[1], ptr, delta, 0, gcsrc); } +Scheme_Object *scheme_foreign_ptr_ref(int argc, Scheme_Object **argv) +{ + return foreign_ptr_ref(argc, argv); +} + /* (ptr-set! cpointer type [['abs] n] value) -> void */ /* n defaults to 0 which is the only value that should be used with ffi_objs */ /* if n is given, an 'abs flag can precede it to make n be a byte offset */ /* rather than some multiple of sizeof(type). */ /* WARNING: there are *NO* checks at all, this is raw C level code. */ -@cdefine[ptr-set! 3 5]{ +@cdefine[ptr-set! 3 5 #:kind inline_noncm]{ intptr_t size=0; void *ptr; intptr_t delta; Scheme_Object *val = argv[argc-1], *base; @@ -2319,6 +2324,11 @@ static Scheme_Object *do_memop(const char *who, int mode, return scheme_void; } +void scheme_foreign_ptr_set(int argc, Scheme_Object **argv) +{ + (void)foreign_ptr_set_bang(argc, argv); +} + /* (ptr-equal? cpointer cpointer) -> boolean */ @cdefine[ptr-equal? 2 2]{ Scheme_Object *cp1, *cp2; @@ -3492,6 +3502,39 @@ void scheme_init_foreign_places() { #endif } +static Scheme_Object *scheme_make_inline_noncm_prim(Scheme_Prim *prim, + const char *name, + mzshort mina, mzshort maxa) +{ + Scheme_Object *p; + int flags = 0; + + p = scheme_make_noncm_prim(prim, name, mina, maxa); + + if ((mina <= 1) && (maxa >= 1)) + flags |= SCHEME_PRIM_IS_UNARY_INLINED; + if ((mina <= 2) && (maxa >= 2)) + flags |= SCHEME_PRIM_IS_BINARY_INLINED; + if ((mina <= 0) || (maxa > 2)) + flags |= SCHEME_PRIM_IS_NARY_INLINED; + + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags); + + return p; +} + +@(define exported-types '("pointer" + "float" "double" + "int8" "uint8" + "int16" "uint16" + "int32" "uint32" + "int64" "uint64")) + +@(maplines + (lambda (exported) + @list{Scheme_Object *scheme_@|exported|_ctype}) + exported-types) + void scheme_init_foreign(Scheme_Env *env) { Scheme_Env *menv; @@ -3513,6 +3556,12 @@ void scheme_init_foreign(Scheme_Env *env) @cmake["t" ctype "s" @list{(Scheme_Object*)(void*)(&ffi_type_@ftype)} @list{(Scheme_Object*)FOREIGN_@cname}] + @(if (member stype exported-types) + (append + @list{REGISTER_SO(scheme_@|stype|_ctype); + scheme_@|stype|_ctype = (Scheme_Object *)t;} + '("\n")) + null)@; scheme_add_global_constant("_@stype", (Scheme_Object*)t, menv)}) scheme_add_global_constant("prop:cpointer", scheme_cpointer_property, menv); scheme_finish_primitive_module(menv); diff --git a/racket/src/racket/src/gen-jit-ts.rkt b/racket/src/racket/src/gen-jit-ts.rkt index 42412aaebe..f6cb5f6174 100644 --- a/racket/src/racket/src/gen-jit-ts.rkt +++ b/racket/src/racket/src/gen-jit-ts.rkt @@ -197,7 +197,8 @@ ss_i iSp_v sss_s - _v)) + _v + iS_v)) (with-output-to-file "jit_ts_def.c" #:exists 'replace diff --git a/racket/src/racket/src/jit.h b/racket/src/racket/src/jit.h index 31a77ab7ab..5ec13dbe61 100644 --- a/racket/src/racket/src/jit.h +++ b/racket/src/racket/src/jit.h @@ -369,6 +369,7 @@ struct scheme_jit_common_record { void *make_rest_list_code, *make_rest_list_clear_code; void *call_check_not_defined_code, *call_check_assign_not_defined_code; void *force_value_same_mark_code; + void *slow_ptr_set_code, *slow_ptr_ref_code; Continuation_Apply_Indirect continuation_apply_indirect_code; #ifdef MZ_USE_LWC @@ -1160,7 +1161,9 @@ static void emit_indentation(mz_jit_state *jitter) #define jit_movi_d_fppush(rd,immd) jit_movi_d(rd,immd) #define jit_ldi_d_fppush(rd, is) jit_ldi_d(rd, is) #define jit_ldr_d_fppush(rd, rs) jit_ldr_d(rd, rs) +#define jit_ldr_f_fppush(rd, rs) jit_ldr_f(rd, rs) #define jit_ldxi_d_fppush(rd, rs, is) jit_ldxi_d(rd, rs, is) +#define jit_ldxi_f_fppush(rd, rs, is) jit_ldxi_f(rd, rs, is) #define jit_ldxr_d_fppush(rd, rs, is) jit_ldxr_d(rd, rs, is) #define jit_addr_d_fppop(rd,s1,s2) jit_addr_d(rd,s1,s2) #define jit_subr_d_fppop(rd,s1,s2) jit_subr_d(rd,s1,s2) @@ -1173,6 +1176,7 @@ static void emit_indentation(mz_jit_state *jitter) #define jit_sqrt_d_fppop(rd,rs) jit_sqrt_d(rd,rs) #define jit_sti_d_fppop(id, rs) jit_sti_d(id, rs) #define jit_str_d_fppop(id, rd) jit_str_d(id, rd) +#define jit_str_f_fppop(id, rd) jit_str_f(id, rd) #define jit_stxi_d_fppop(id, rd, rs) jit_stxi_d(id, rd, rs) #define jit_stxr_d_fppop(id, rd, rs) jit_stxr_d(id, rd, rs) #define jit_bger_d_fppop(d, s1, s2) jit_bger_d(d, s1, s2) diff --git a/racket/src/racket/src/jit_ts.c b/racket/src/racket/src/jit_ts.c index 0037cf88cd..220652b83e 100644 --- a/racket/src/racket/src/jit_ts.c +++ b/racket/src/racket/src/jit_ts.c @@ -108,6 +108,8 @@ define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER) # endif define_ts_iS_s(scheme_check_not_undefined, FSRC_MARKS) define_ts_iS_s(scheme_check_assign_not_undefined, FSRC_MARKS) +define_ts_iS_s(scheme_foreign_ptr_ref, FSRC_MARKS) +define_ts_iS_v(scheme_foreign_ptr_set, FSRC_MARKS) #endif #ifdef JITCALL_TS_PROCS @@ -242,4 +244,6 @@ define_ts_s_s(scheme_box, FSRC_OTHER) # define ts_scheme_checked_integer_to_char scheme_checked_integer_to_char # define ts_scheme_check_not_undefined scheme_check_not_undefined # define ts_scheme_check_assign_not_undefined scheme_check_assign_not_undefined +# define ts_scheme_foreign_ptr_ref scheme_foreign_ptr_ref +# define ts_scheme_foreign_ptr_set scheme_foreign_ptr_set #endif diff --git a/racket/src/racket/src/jit_ts_def.c b/racket/src/racket/src/jit_ts_def.c index fb56ce4ecc..bc7c1dc009 100644 --- a/racket/src/racket/src/jit_ts_def.c +++ b/racket/src/racket/src/jit_ts_def.c @@ -1,38 +1,38 @@ #define define_ts_siS_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g8, int g9, Scheme_Object** g10) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g12, int g13, Scheme_Object** g14) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_siS_s("[" #id "]", src_type, id, g8, g9, g10); \ + return scheme_rtcall_siS_s("[" #id "]", src_type, id, g12, g13, g14); \ else \ - return id(g8, g9, g10); \ + return id(g12, g13, g14); \ } #define define_ts_iSs_s(id, src_type) \ -static Scheme_Object* ts_ ## id(int g11, Scheme_Object** g12, Scheme_Object* g13) \ +static Scheme_Object* ts_ ## id(int g15, Scheme_Object** g16, Scheme_Object* g17) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g11, g12, g13); \ + return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g15, g16, g17); \ else \ - return id(g11, g12, g13); \ + return id(g15, g16, g17); \ } #define define_ts_s_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g14) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g18) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_s_s("[" #id "]", src_type, id, g14); \ + return scheme_rtcall_s_s("[" #id "]", src_type, id, g18); \ else \ - return id(g14); \ + return id(g18); \ } #define define_ts_n_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g15) \ +static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g19) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_n_s("[" #id "]", src_type, id, g15); \ + return scheme_rtcall_n_s("[" #id "]", src_type, id, g19); \ else \ - return id(g15); \ + return id(g19); \ } #define define_ts__s(id, src_type) \ static Scheme_Object* ts_ ## id() \ @@ -44,202 +44,202 @@ static Scheme_Object* ts_ ## id() \ return id(); \ } #define define_ts_ss_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g16, Scheme_Object* g17) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g20, Scheme_Object* g21) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_ss_s("[" #id "]", src_type, id, g16, g17); \ + return scheme_rtcall_ss_s("[" #id "]", src_type, id, g20, g21); \ else \ - return id(g16, g17); \ + return id(g20, g21); \ } #define define_ts_ssi_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g18, Scheme_Object* g19, int g20) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g22, Scheme_Object* g23, int g24) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_ssi_s("[" #id "]", src_type, id, g18, g19, g20); \ + return scheme_rtcall_ssi_s("[" #id "]", src_type, id, g22, g23, g24); \ else \ - return id(g18, g19, g20); \ + return id(g22, g23, g24); \ } #define define_ts_tt_s(id, src_type) \ -static Scheme_Object* ts_ ## id(const Scheme_Object* g21, const Scheme_Object* g22) \ +static Scheme_Object* ts_ ## id(const Scheme_Object* g25, const Scheme_Object* g26) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_tt_s("[" #id "]", src_type, id, g21, g22); \ - else \ - return id(g21, g22); \ -} -#define define_ts_ss_m(id, src_type) \ -static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g23, Scheme_Object* g24) \ - XFORM_SKIP_PROC \ -{ \ - if (scheme_use_rtcall) \ - return scheme_rtcall_ss_m("[" #id "]", src_type, id, g23, g24); \ - else \ - return id(g23, g24); \ -} -#define define_ts_Sl_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object** g25, intptr_t g26) \ - XFORM_SKIP_PROC \ -{ \ - if (scheme_use_rtcall) \ - return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g25, g26); \ + return scheme_rtcall_tt_s("[" #id "]", src_type, id, g25, g26); \ else \ return id(g25, g26); \ } -#define define_ts_l_s(id, src_type) \ -static Scheme_Object* ts_ ## id(intptr_t g27) \ +#define define_ts_ss_m(id, src_type) \ +static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g27, Scheme_Object* g28) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_l_s("[" #id "]", src_type, id, g27); \ + return scheme_rtcall_ss_m("[" #id "]", src_type, id, g27, g28); \ else \ - return id(g27); \ + return id(g27, g28); \ +} +#define define_ts_Sl_s(id, src_type) \ +static Scheme_Object* ts_ ## id(Scheme_Object** g29, intptr_t g30) \ + XFORM_SKIP_PROC \ +{ \ + if (scheme_use_rtcall) \ + return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g29, g30); \ + else \ + return id(g29, g30); \ +} +#define define_ts_l_s(id, src_type) \ +static Scheme_Object* ts_ ## id(intptr_t g31) \ + XFORM_SKIP_PROC \ +{ \ + if (scheme_use_rtcall) \ + return scheme_rtcall_l_s("[" #id "]", src_type, id, g31); \ + else \ + return id(g31); \ } #define define_ts_bsi_v(id, src_type) \ -static void ts_ ## id(Scheme_Bucket* g28, Scheme_Object* g29, int g30) \ +static void ts_ ## id(Scheme_Bucket* g32, Scheme_Object* g33, int g34) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_bsi_v("[" #id "]", src_type, id, g28, g29, g30); \ + scheme_rtcall_bsi_v("[" #id "]", src_type, id, g32, g33, g34); \ else \ - id(g28, g29, g30); \ + id(g32, g33, g34); \ } #define define_ts_iiS_v(id, src_type) \ -static void ts_ ## id(int g31, int g32, Scheme_Object** g33) \ +static void ts_ ## id(int g35, int g36, Scheme_Object** g37) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_iiS_v("[" #id "]", src_type, id, g31, g32, g33); \ + scheme_rtcall_iiS_v("[" #id "]", src_type, id, g35, g36, g37); \ else \ - id(g31, g32, g33); \ + id(g35, g36, g37); \ } #define define_ts_ss_v(id, src_type) \ -static void ts_ ## id(Scheme_Object* g34, Scheme_Object* g35) \ +static void ts_ ## id(Scheme_Object* g38, Scheme_Object* g39) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_ss_v("[" #id "]", src_type, id, g34, g35); \ + scheme_rtcall_ss_v("[" #id "]", src_type, id, g38, g39); \ else \ - id(g34, g35); \ + id(g38, g39); \ } #define define_ts_b_v(id, src_type) \ -static void ts_ ## id(Scheme_Bucket* g36) \ +static void ts_ ## id(Scheme_Bucket* g40) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_b_v("[" #id "]", src_type, id, g36); \ + scheme_rtcall_b_v("[" #id "]", src_type, id, g40); \ else \ - id(g36); \ + id(g40); \ } #define define_ts_sl_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g37, intptr_t g38) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g41, intptr_t g42) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_sl_s("[" #id "]", src_type, id, g37, g38); \ + return scheme_rtcall_sl_s("[" #id "]", src_type, id, g41, g42); \ else \ - return id(g37, g38); \ + return id(g41, g42); \ } #define define_ts_iS_s(id, src_type) \ -static Scheme_Object* ts_ ## id(int g39, Scheme_Object** g40) \ +static Scheme_Object* ts_ ## id(int g43, Scheme_Object** g44) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_iS_s("[" #id "]", src_type, id, g39, g40); \ + return scheme_rtcall_iS_s("[" #id "]", src_type, id, g43, g44); \ else \ - return id(g39, g40); \ + return id(g43, g44); \ } #define define_ts_S_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object** g41) \ +static Scheme_Object* ts_ ## id(Scheme_Object** g45) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_S_s("[" #id "]", src_type, id, g41); \ + return scheme_rtcall_S_s("[" #id "]", src_type, id, g45); \ else \ - return id(g41); \ + return id(g45); \ } #define define_ts_s_v(id, src_type) \ -static void ts_ ## id(Scheme_Object* g42) \ +static void ts_ ## id(Scheme_Object* g46) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_s_v("[" #id "]", src_type, id, g42); \ + scheme_rtcall_s_v("[" #id "]", src_type, id, g46); \ else \ - id(g42); \ + id(g46); \ } #define define_ts_iSi_s(id, src_type) \ -static Scheme_Object* ts_ ## id(int g43, Scheme_Object** g44, int g45) \ +static Scheme_Object* ts_ ## id(int g47, Scheme_Object** g48, int g49) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g43, g44, g45); \ + return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g47, g48, g49); \ else \ - return id(g43, g44, g45); \ + return id(g47, g48, g49); \ } #define define_ts_siS_v(id, src_type) \ -static void ts_ ## id(Scheme_Object* g46, int g47, Scheme_Object** g48) \ +static void ts_ ## id(Scheme_Object* g50, int g51, Scheme_Object** g52) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_siS_v("[" #id "]", src_type, id, g46, g47, g48); \ + scheme_rtcall_siS_v("[" #id "]", src_type, id, g50, g51, g52); \ else \ - id(g46, g47, g48); \ + id(g50, g51, g52); \ } #define define_ts_z_p(id, src_type) \ -static void* ts_ ## id(size_t g49) \ +static void* ts_ ## id(size_t g53) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_z_p("[" #id "]", src_type, id, g49); \ + return scheme_rtcall_z_p("[" #id "]", src_type, id, g53); \ else \ - return id(g49); \ + return id(g53); \ } #define define_ts_si_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g50, int g51) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g54, int g55) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_si_s("[" #id "]", src_type, id, g50, g51); \ + return scheme_rtcall_si_s("[" #id "]", src_type, id, g54, g55); \ else \ - return id(g50, g51); \ + return id(g54, g55); \ } #define define_ts_sis_v(id, src_type) \ -static void ts_ ## id(Scheme_Object* g52, int g53, Scheme_Object* g54) \ +static void ts_ ## id(Scheme_Object* g56, int g57, Scheme_Object* g58) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_sis_v("[" #id "]", src_type, id, g52, g53, g54); \ + scheme_rtcall_sis_v("[" #id "]", src_type, id, g56, g57, g58); \ else \ - id(g52, g53, g54); \ + id(g56, g57, g58); \ } #define define_ts_ss_i(id, src_type) \ -static int ts_ ## id(Scheme_Object* g55, Scheme_Object* g56) \ +static int ts_ ## id(Scheme_Object* g59, Scheme_Object* g60) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_ss_i("[" #id "]", src_type, id, g55, g56); \ + return scheme_rtcall_ss_i("[" #id "]", src_type, id, g59, g60); \ else \ - return id(g55, g56); \ + return id(g59, g60); \ } #define define_ts_iSp_v(id, src_type) \ -static void ts_ ## id(int g57, Scheme_Object** g58, void* g59) \ +static void ts_ ## id(int g61, Scheme_Object** g62, void* g63) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - scheme_rtcall_iSp_v("[" #id "]", src_type, id, g57, g58, g59); \ + scheme_rtcall_iSp_v("[" #id "]", src_type, id, g61, g62, g63); \ else \ - id(g57, g58, g59); \ + id(g61, g62, g63); \ } #define define_ts_sss_s(id, src_type) \ -static Scheme_Object* ts_ ## id(Scheme_Object* g60, Scheme_Object* g61, Scheme_Object* g62) \ +static Scheme_Object* ts_ ## id(Scheme_Object* g64, Scheme_Object* g65, Scheme_Object* g66) \ XFORM_SKIP_PROC \ { \ if (scheme_use_rtcall) \ - return scheme_rtcall_sss_s("[" #id "]", src_type, id, g60, g61, g62); \ + return scheme_rtcall_sss_s("[" #id "]", src_type, id, g64, g65, g66); \ else \ - return id(g60, g61, g62); \ + return id(g64, g65, g66); \ } #define define_ts__v(id, src_type) \ static void ts_ ## id() \ @@ -250,3 +250,12 @@ static void ts_ ## id() \ else \ id(); \ } +#define define_ts_iS_v(id, src_type) \ +static void ts_ ## id(int g67, Scheme_Object** g68) \ + XFORM_SKIP_PROC \ +{ \ + if (scheme_use_rtcall) \ + scheme_rtcall_iS_v("[" #id "]", src_type, id, g67, g68); \ + else \ + id(g67, g68); \ +} diff --git a/racket/src/racket/src/jit_ts_future_glue.c b/racket/src/racket/src/jit_ts_future_glue.c index 2644c0ea7f..dce1f3e0ae 100644 --- a/racket/src/racket/src/jit_ts_future_glue.c +++ b/racket/src/racket/src/jit_ts_future_glue.c @@ -1,4 +1,4 @@ - Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g63, int g64, Scheme_Object** g65) + Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g69, int g70, Scheme_Object** g71) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -13,9 +13,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g63; - future->arg_i1 = g64; - future->arg_S2 = g65; + future->arg_s0 = g69; + future->arg_i1 = g70; + future->arg_S2 = g71; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -25,7 +25,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g66, Scheme_Object** g67, Scheme_Object* g68) + Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g72, Scheme_Object** g73, Scheme_Object* g74) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -40,9 +40,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g66; - future->arg_S1 = g67; - future->arg_s2 = g68; + future->arg_i0 = g72; + future->arg_S1 = g73; + future->arg_s2 = g74; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -52,7 +52,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g69) + Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g75) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -67,8 +67,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g69; - send_special_result(future, g69); + future->arg_s0 = g75; + send_special_result(future, g75); future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; future = fts->thread->current_ft; @@ -77,7 +77,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g70) + Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g76) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -92,7 +92,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_n0 = g70; + future->arg_n0 = g76; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -127,7 +127,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g71, Scheme_Object* g72) + Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g77, Scheme_Object* g78) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -142,8 +142,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g71; - future->arg_s1 = g72; + future->arg_s0 = g77; + future->arg_s1 = g78; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -153,7 +153,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g73, Scheme_Object* g74, int g75) + Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g79, Scheme_Object* g80, int g81) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -168,9 +168,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g73; - future->arg_s1 = g74; - future->arg_i2 = g75; + future->arg_s0 = g79; + future->arg_s1 = g80; + future->arg_i2 = g81; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -180,7 +180,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g76, const Scheme_Object* g77) + Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g82, const Scheme_Object* g83) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -195,8 +195,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_t0 = g76; - future->arg_t1 = g77; + future->arg_t0 = g82; + future->arg_t1 = g83; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -206,7 +206,7 @@ receive_special_result(future, retval, 1); return retval; } - MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g78, Scheme_Object* g79) + MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g84, Scheme_Object* g85) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -221,8 +221,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g78; - future->arg_s1 = g79; + future->arg_s0 = g84; + future->arg_s1 = g85; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -232,7 +232,7 @@ return retval; } - Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g80, intptr_t g81) + Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g86, intptr_t g87) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -247,8 +247,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_S0 = g80; - future->arg_l1 = g81; + future->arg_S0 = g86; + future->arg_l1 = g87; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -258,7 +258,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g82) + Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g88) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -273,7 +273,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_l0 = g82; + future->arg_l0 = g88; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -283,7 +283,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g83, Scheme_Object* g84, int g85) + void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g89, Scheme_Object* g90, int g91) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -298,9 +298,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_b0 = g83; - future->arg_s1 = g84; - future->arg_i2 = g85; + future->arg_b0 = g89; + future->arg_s1 = g90; + future->arg_i2 = g91; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -310,7 +310,7 @@ } - void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g86, int g87, Scheme_Object** g88) + void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g92, int g93, Scheme_Object** g94) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -325,9 +325,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g86; - future->arg_i1 = g87; - future->arg_S2 = g88; + future->arg_i0 = g92; + future->arg_i1 = g93; + future->arg_S2 = g94; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -337,7 +337,7 @@ } - void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g89, Scheme_Object* g90) + void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g95, Scheme_Object* g96) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -352,8 +352,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g89; - future->arg_s1 = g90; + future->arg_s0 = g95; + future->arg_s1 = g96; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -363,7 +363,7 @@ } - void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g91) + void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g97) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -378,7 +378,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_b0 = g91; + future->arg_b0 = g97; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -388,7 +388,7 @@ } - Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g92, intptr_t g93) + Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g98, intptr_t g99) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -403,8 +403,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g92; - future->arg_l1 = g93; + future->arg_s0 = g98; + future->arg_l1 = g99; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -414,7 +414,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g94, Scheme_Object** g95) + Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g100, Scheme_Object** g101) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -429,8 +429,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g94; - future->arg_S1 = g95; + future->arg_i0 = g100; + future->arg_S1 = g101; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -440,7 +440,7 @@ receive_special_result(future, retval, 1); return retval; } - Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g96) + Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g102) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -455,7 +455,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_S0 = g96; + future->arg_S0 = g102; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -465,7 +465,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g97) + void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g103) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -480,8 +480,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g97; - send_special_result(future, g97); + future->arg_s0 = g103; + send_special_result(future, g103); future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; future = fts->thread->current_ft; @@ -490,7 +490,7 @@ } - Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g98, Scheme_Object** g99, int g100) + Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g104, Scheme_Object** g105, int g106) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -505,9 +505,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g98; - future->arg_S1 = g99; - future->arg_i2 = g100; + future->arg_i0 = g104; + future->arg_S1 = g105; + future->arg_i2 = g106; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -517,7 +517,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g101, int g102, Scheme_Object** g103) + void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g107, int g108, Scheme_Object** g109) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -532,9 +532,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g101; - future->arg_i1 = g102; - future->arg_S2 = g103; + future->arg_s0 = g107; + future->arg_i1 = g108; + future->arg_S2 = g109; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -544,7 +544,7 @@ } - void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g104) + void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g110) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -559,7 +559,7 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_z0 = g104; + future->arg_z0 = g110; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -569,7 +569,7 @@ return retval; } - Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g105, int g106) + Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g111, int g112) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -584,8 +584,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g105; - future->arg_i1 = g106; + future->arg_s0 = g111; + future->arg_i1 = g112; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -595,7 +595,7 @@ receive_special_result(future, retval, 1); return retval; } - void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g107, int g108, Scheme_Object* g109) + void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g113, int g114, Scheme_Object* g115) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -610,9 +610,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g107; - future->arg_i1 = g108; - future->arg_s2 = g109; + future->arg_s0 = g113; + future->arg_i1 = g114; + future->arg_s2 = g115; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -622,7 +622,7 @@ } - int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g110, Scheme_Object* g111) + int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g116, Scheme_Object* g117) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -637,8 +637,8 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g110; - future->arg_s1 = g111; + future->arg_s0 = g116; + future->arg_s1 = g117; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -648,7 +648,7 @@ return retval; } - void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g112, Scheme_Object** g113, void* g114) + void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g118, Scheme_Object** g119, void* g120) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -663,9 +663,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_i0 = g112; - future->arg_S1 = g113; - future->arg_p2 = g114; + future->arg_i0 = g118; + future->arg_S1 = g119; + future->arg_p2 = g120; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -675,7 +675,7 @@ } - Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g115, Scheme_Object* g116, Scheme_Object* g117) + Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g121, Scheme_Object* g122, Scheme_Object* g123) XFORM_SKIP_PROC { Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -690,9 +690,9 @@ future->time_of_request = tm; future->source_of_request = who; future->source_type = src_type; - future->arg_s0 = g115; - future->arg_s1 = g116; - future->arg_s2 = g117; + future->arg_s0 = g121; + future->arg_s1 = g122; + future->arg_s2 = g123; future_do_runtimecall(fts, (void*)f, 0, 1, 0); fts->thread = scheme_current_thread; @@ -726,4 +726,30 @@ +} + void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g124, Scheme_Object** g125) + XFORM_SKIP_PROC +{ + Scheme_Future_Thread_State *fts = scheme_future_thread_state; + future_t *future; + double tm; + + + future = fts->thread->current_ft; + future->prim_protocol = SIG_iS_v; + future->prim_func = f; + tm = get_future_timestamp(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; + future->arg_i0 = g124; + future->arg_S1 = g125; + + future_do_runtimecall(fts, (void*)f, 0, 1, 0); + fts->thread = scheme_current_thread; + future = fts->thread->current_ft; + + + + } diff --git a/racket/src/racket/src/jit_ts_protos.h b/racket/src/racket/src/jit_ts_protos.h index 425c9d5e59..9bccc71519 100644 --- a/racket/src/racket/src/jit_ts_protos.h +++ b/racket/src/racket/src/jit_ts_protos.h @@ -1,84 +1,87 @@ #define SIG_siS_s 11 typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**); -Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g173, int g174, Scheme_Object** g175); +Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g183, int g184, Scheme_Object** g185); #define SIG_iSs_s 12 typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*); -Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g176, Scheme_Object** g177, Scheme_Object* g178); +Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g186, Scheme_Object** g187, Scheme_Object* g188); #define SIG_s_s 13 typedef Scheme_Object* (*prim_s_s)(Scheme_Object*); -Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g179); +Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g189); #define SIG_n_s 14 typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Closure_Data*); -Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g180); +Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g190); #define SIG__s 15 typedef Scheme_Object* (*prim__s)(); Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ); #define SIG_ss_s 16 typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*); -Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g181, Scheme_Object* g182); +Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g191, Scheme_Object* g192); #define SIG_ssi_s 17 typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int); -Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g183, Scheme_Object* g184, int g185); +Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g193, Scheme_Object* g194, int g195); #define SIG_tt_s 18 typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*); -Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g186, const Scheme_Object* g187); +Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g196, const Scheme_Object* g197); #define SIG_ss_m 19 typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*); -MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g188, Scheme_Object* g189); +MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g198, Scheme_Object* g199); #define SIG_Sl_s 20 typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t); -Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g190, intptr_t g191); +Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g200, intptr_t g201); #define SIG_l_s 21 typedef Scheme_Object* (*prim_l_s)(intptr_t); -Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g192); +Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g202); #define SIG_bsi_v 22 typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int); -void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g193, Scheme_Object* g194, int g195); +void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g203, Scheme_Object* g204, int g205); #define SIG_iiS_v 23 typedef void (*prim_iiS_v)(int, int, Scheme_Object**); -void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g196, int g197, Scheme_Object** g198); +void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g206, int g207, Scheme_Object** g208); #define SIG_ss_v 24 typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*); -void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g199, Scheme_Object* g200); +void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g209, Scheme_Object* g210); #define SIG_b_v 25 typedef void (*prim_b_v)(Scheme_Bucket*); -void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g201); +void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g211); #define SIG_sl_s 26 typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t); -Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g202, intptr_t g203); +Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g212, intptr_t g213); #define SIG_iS_s 27 typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**); -Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g204, Scheme_Object** g205); +Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g214, Scheme_Object** g215); #define SIG_S_s 28 typedef Scheme_Object* (*prim_S_s)(Scheme_Object**); -Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g206); +Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g216); #define SIG_s_v 29 typedef void (*prim_s_v)(Scheme_Object*); -void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g207); +void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g217); #define SIG_iSi_s 30 typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int); -Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g208, Scheme_Object** g209, int g210); +Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g218, Scheme_Object** g219, int g220); #define SIG_siS_v 31 typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**); -void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g211, int g212, Scheme_Object** g213); +void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g221, int g222, Scheme_Object** g223); #define SIG_z_p 32 typedef void* (*prim_z_p)(size_t); -void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g214); +void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g224); #define SIG_si_s 33 typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int); -Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g215, int g216); +Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g225, int g226); #define SIG_sis_v 34 typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*); -void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g217, int g218, Scheme_Object* g219); +void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g227, int g228, Scheme_Object* g229); #define SIG_ss_i 35 typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*); -int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g220, Scheme_Object* g221); +int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g230, Scheme_Object* g231); #define SIG_iSp_v 36 typedef void (*prim_iSp_v)(int, Scheme_Object**, void*); -void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g222, Scheme_Object** g223, void* g224); +void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g232, Scheme_Object** g233, void* g234); #define SIG_sss_s 37 typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*); -Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g225, Scheme_Object* g226, Scheme_Object* g227); +Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g235, Scheme_Object* g236, Scheme_Object* g237); #define SIG__v 38 typedef void (*prim__v)(); void scheme_rtcall__v(const char *who, int src_type, prim__v f ); +#define SIG_iS_v 39 +typedef void (*prim_iS_v)(int, Scheme_Object**); +void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g238, Scheme_Object** g239); diff --git a/racket/src/racket/src/jit_ts_runtime_glue.c b/racket/src/racket/src/jit_ts_runtime_glue.c index cbbf2c1ce1..bdfd8ad467 100644 --- a/racket/src/racket/src/jit_ts_runtime_glue.c +++ b/racket/src/racket/src/jit_ts_runtime_glue.c @@ -388,5 +388,19 @@ case SIG__v: f(); + break; + } +case SIG_iS_v: + { + prim_iS_v f = (prim_iS_v)future->prim_func; + + JIT_TS_LOCALIZE(int, arg_i0); JIT_TS_LOCALIZE(Scheme_Object**, arg_S1); + + future->arg_S1 = NULL; + ADJUST_RS_ARG(future, arg_S1); + + f(arg_i0, arg_S1); + + break; } diff --git a/racket/src/racket/src/jitcall.c b/racket/src/racket/src/jitcall.c index 72b9bc2d5b..4d472dfa5f 100644 --- a/racket/src/racket/src/jitcall.c +++ b/racket/src/racket/src/jitcall.c @@ -545,7 +545,7 @@ int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_na int scheme_generate_force_value_same_mark(mz_jit_state *jitter) { GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES; - jit_movi_p(JIT_R0, SCHEME_TAIL_CALL_WAITING); + (void)jit_movi_p(JIT_R0, SCHEME_TAIL_CALL_WAITING); mz_prepare(1); jit_pusharg_p(JIT_R0); (void)mz_finish_lwe(ts_scheme_force_value_same_mark, refr); diff --git a/racket/src/racket/src/jitcommon.c b/racket/src/racket/src/jitcommon.c index 23bf0a220a..900b93e000 100644 --- a/racket/src/racket/src/jitcommon.c +++ b/racket/src/racket/src/jitcommon.c @@ -3279,6 +3279,33 @@ static int common12(mz_jit_state *jitter, void *_data) static int common13(mz_jit_state *jitter, void *_data) { + GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES; + + /* *** slow_ptr_ref_code *** */ + sjc.slow_ptr_ref_code = jit_get_ip(); + mz_prolog(JIT_R2); + JIT_UPDATE_THREAD_RSPTR(); + mz_prepare(2); + jit_pusharg_p(JIT_RUNSTACK); + jit_pusharg_i(JIT_R0); + mz_finish_prim_lwe(ts_scheme_foreign_ptr_ref, refr); + jit_retval(JIT_R0); + mz_epilog(JIT_R2); + scheme_jit_register_sub_func(jitter, sjc.slow_ptr_ref_code, scheme_false); + CHECK_LIMIT(); + + /* *** slow_ptr_set_code *** */ + sjc.slow_ptr_set_code = jit_get_ip(); + mz_prolog(JIT_R2); + JIT_UPDATE_THREAD_RSPTR(); + mz_prepare(2); + jit_pusharg_p(JIT_RUNSTACK); + jit_pusharg_i(JIT_R0); + mz_finish_prim_lwe(ts_scheme_foreign_ptr_set, refr); + mz_epilog(JIT_R2); + scheme_jit_register_sub_func(jitter, sjc.slow_ptr_set_code, scheme_false); + CHECK_LIMIT(); + /* *** force_value_same_mark_code *** */ /* Helper for futures: a synthetic functon that just forces values, which will bounce back to the runtime thread (but with lightweight @@ -3293,9 +3320,11 @@ static int common13(mz_jit_state *jitter, void *_data) mz_pop_threadlocal(); mz_pop_locals(); jit_ret(); + return 1; } + int scheme_do_generate_common(mz_jit_state *jitter, void *_data) { if (!common0(jitter, _data)) return 0; diff --git a/racket/src/racket/src/jitinline.c b/racket/src/racket/src/jitinline.c index 5ac98d64e4..6623927105 100644 --- a/racket/src/racket/src/jitinline.c +++ b/racket/src/racket/src/jitinline.c @@ -2394,6 +2394,18 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i { Scheme_Object *rator = app->rator; + if (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "ptr-ref")) { + Scheme_App_Rec *app2; + if (need_sync) mz_rs_sync(); + app2 = scheme_malloc_application(3); + app2->args[0] = app->rator; + app2->args[1] = app->rand1; + app2->args[2] = app->rand2; + return scheme_generate_inlined_nary(jitter, app2, is_tail, multi_ok, + for_branch, branch_short, result_ignored, + dest); + } + if (!for_branch) { int k; k = inlineable_struct_prim(rator, jitter, 2, 2); @@ -4311,6 +4323,297 @@ int scheme_generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int mz_rs_inc(5); mz_runstack_popped(jitter, 5); + return 1; + } else if (IS_NAMED_PRIM(rator, "ptr-ref") + || IS_NAMED_PRIM(rator, "ptr-set!")) { + int n = app->num_args, is_ref, step_shift = 0, want_int_min = 0, want_int_max = 0; + int abs_offset; + Scheme_Type want_type; + Scheme_Object *ctype; + GC_CAN_IGNORE jit_insn *refslow, *reffast = NULL; + + is_ref = IS_NAMED_PRIM(rator, "ptr-ref"); + abs_offset = (n == (is_ref ? 4 : 5)); + + scheme_generate_app(app, NULL, n, jitter, 0, 0, 0, 2); /* sync'd below */ + CHECK_LIMIT(); + mz_rs_sync(); + + ctype = app->args[2]; + + if (abs_offset + && (!SCHEME_SYMBOLP(app->args[3]) + || SCHEME_SYM_WEIRDP(app->args[3]) + || strcmp("abs", SCHEME_SYM_VAL(app->args[3])))) { + want_type = 0; + } else if (ctype == scheme_pointer_ctype) { + if (is_ref) { + want_type = 0; + } else { + want_type = scheme_cpointer_type; + step_shift = JIT_LOG_WORD_SIZE; + } + } else if (ctype == scheme_double_ctype) { + want_type = scheme_double_type; + step_shift = 3; +#ifndef CAN_INLINE_ALLOC + if (is_ref) want_type = 0; +#endif + } else if (ctype == scheme_float_ctype) { + want_type = scheme_double_type; + step_shift = 2; +#ifndef CAN_INLINE_ALLOC + if (is_ref) want_type = 0; +#endif + } else if ((ctype == scheme_int8_ctype) + || (ctype == scheme_uint8_ctype)) { + want_type = scheme_integer_type; + step_shift = 0; + if (app->args[2] == scheme_int8_ctype) { + want_int_min = -128; + want_int_max = 127; + } else { + want_int_max = 255; + } + } else if ((ctype == scheme_int16_ctype) + || (ctype == scheme_uint16_ctype)) { + want_type = scheme_integer_type; + step_shift = 1; + if (app->args[2] == scheme_int16_ctype) { + want_int_min = -32768; + want_int_max = 32767; + } else { + want_int_max = 65535; + } + } else if ((ctype == scheme_int32_ctype) + || (ctype == scheme_uint32_ctype)) { + want_type = scheme_integer_type; + step_shift = 2; +#ifdef SIXTY_FOUR_BIT_INTEGERS + } else if ((ctype == scheme_int64_ctype) + || (ctype == scheme_uint64_ctype)) { + want_type = scheme_integer_type; + step_shift = 3; +#endif + } else + want_type = 0; + + __START_SHORT_JUMPS__(1); + + if (want_type) { + mz_rs_ldr(JIT_R0); + reffast = jit_bmci_ul(jit_forward(), JIT_R0, 0x1); + } + + refslow = jit_get_ip(); + jit_movi_i(JIT_R0, n); + if (is_ref) { + (void)jit_calli(sjc.slow_ptr_ref_code); + jit_movr_p(dest, JIT_R0); + } else + (void)jit_calli(sjc.slow_ptr_set_code); + CHECK_LIMIT(); + + if (want_type) { + GC_CAN_IGNORE jit_insn *refdone, *refok; + refdone = jit_jmpi(jit_forward()); + mz_patch_branch(reffast); + + /* JIT_V1 will contain an offset + JIT_R0 will contain the pointer + In set mode, JIT_R1 will contain the new value */ + + if ((n == (is_ref ? 3 : 4)) || (n == (is_ref ? 4 : 5))) { + mz_rs_ldxi(JIT_V1, n - (is_ref ? 1 : 2)); + (void)jit_bmci_ul(refslow, JIT_V1, 0x1); + jit_rshi_l(JIT_V1, JIT_V1, 1); + if (!abs_offset) { + jit_lshi_l(JIT_V1, JIT_V1, step_shift); + } + } else { + jit_movi_ul(JIT_V1, 0); + } + + (void)mz_bnei_t(refslow, JIT_R0, scheme_cpointer_type, JIT_R2); + jit_ldxi_s(JIT_R2, JIT_R0, (intptr_t)&SCHEME_CPTR_FLAGS((Scheme_Chaperone *)0x0)); + refok = jit_bmci_ul(jit_forward(), JIT_R2, 0x2); + jit_ldxi_l(JIT_R2, JIT_R0, (intptr_t)&((Scheme_Offset_Cptr *)0x0)->offset); + jit_addr_l(JIT_V1, JIT_V1, JIT_R2); + mz_patch_branch(refok); + jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&((Scheme_Cptr *)0x0)->val); + jit_addr_p(JIT_R0, JIT_R0, JIT_V1); + CHECK_LIMIT(); + + /* At this point, JIT_V1 is folded into JIT_R0 */ + + if (!is_ref) { + mz_rs_ldxi(JIT_R1, n-1); + if (want_type == scheme_integer_type) { + (void)jit_bmci_ul(refslow, JIT_R1, 0x1); + jit_rshi_l(JIT_R1, JIT_R1, 1); + if (want_int_max) { + (void)jit_blti_l(refslow, JIT_R1, want_int_min); + (void)jit_bgti_l(refslow, JIT_R1, want_int_max); + } else { +#ifdef SIXTY_FOUR_BIT_INTEGERS + if (((ctype == scheme_int32_ctype) + || (ctype == scheme_uint32_ctype))) { + jit_rshi_ul(JIT_R2, JIT_R1, 32); + jit_extr_i_l(JIT_R2, JIT_R2); + (void)jit_bgti_l(refslow, JIT_R2, 0); + (void)jit_blti_l(refslow, JIT_R2, -1); + } else if (ctype == scheme_uint64_ctype) { + (void)jit_blti_l(refslow, JIT_R1, 0); + } +#endif + } + } else { + (void)jit_bmsi_ul(refslow, JIT_R1, 0x1); + (void)mz_bnei_t(refslow, JIT_R1, want_type, JIT_R2); + } + } + + if (ctype == scheme_pointer_ctype) { + if (is_ref) { + scheme_signal_error("internal error: _pointer reference not implemented"); + } else { + jit_movi_l(JIT_V1, 0); + jit_ldxi_s(JIT_R2, JIT_R1, (intptr_t)&SCHEME_CPTR_FLAGS((Scheme_Chaperone *)0x0)); + refok = jit_bmci_ul(jit_forward(), JIT_R2, 0x2); + jit_ldxi_l(JIT_V1, JIT_R1, (intptr_t)&((Scheme_Offset_Cptr *)0x0)->offset); + mz_patch_branch(refok); + jit_ldxi_p(JIT_R1, JIT_R1, (intptr_t)&((Scheme_Cptr *)0x0)->val); + jit_addr_p(JIT_R1, JIT_R1, JIT_V1); + jit_str_p(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_double_ctype) { + if (is_ref) { + jit_ldr_d_fppush(JIT_FPR0, JIT_R0); + CHECK_LIMIT(); + __END_SHORT_JUMPS__(1); + scheme_generate_alloc_double(jitter, 0, dest); + __START_SHORT_JUMPS__(1); + CHECK_LIMIT(); + } else { + jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val); + jit_str_d_fppop(JIT_R0, JIT_FPR0); + } + } else if (ctype == scheme_float_ctype) { + if (is_ref) { + jit_ldr_f_fppush(JIT_FPR0, JIT_R0); + jit_extr_f_d(JIT_FPR0, JIT_FPR0); + CHECK_LIMIT(); + __END_SHORT_JUMPS__(1); + scheme_generate_alloc_double(jitter, 0, dest); + __START_SHORT_JUMPS__(1); + CHECK_LIMIT(); + } else { + jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val); + jit_extr_d_f(JIT_FPR0, JIT_FPR0); + jit_str_f_fppop(JIT_R0, JIT_FPR0); + } + } else if (ctype == scheme_int8_ctype) { + if (is_ref) { + jit_ldr_c(JIT_R1, JIT_R0); + jit_extr_c_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); + } else { + jit_str_c(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_uint8_ctype) { + if (is_ref) { + jit_ldr_uc(JIT_R1, JIT_R0); + jit_extr_uc_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); + } else { + jit_str_uc(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_int16_ctype) { + if (is_ref) { + jit_ldr_s(JIT_R1, JIT_R0); + jit_extr_s_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); + } else { + jit_str_s(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_uint16_ctype) { + if (is_ref) { + jit_ldr_us(JIT_R1, JIT_R0); + jit_extr_us_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); + } else { + jit_str_us(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_int32_ctype) { + if (is_ref) { + jit_ldr_i(JIT_R1, JIT_R0); +#ifdef SIXTY_FOUR_BIT_INTEGERS + jit_extr_i_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); +#else + jit_fixnum_l(JIT_R0, JIT_R1); + jit_lshi_l(JIT_R2, JIT_R0, 1); + (void)jit_bner_l(refslow, JIT_R1, JIT_R2); + jit_movr_p(dest, JIT_R0); +#endif + } else { + jit_str_i(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_uint32_ctype) { + if (is_ref) { + jit_ldr_i(JIT_R1, JIT_R0); +#ifdef SIXTY_FOUR_BIT_INTEGERS + jit_extr_ui_l(JIT_R1, JIT_R1); + jit_fixnum_l(dest, JIT_R1); +#else + (void)jit_blti_l(refslow, JIT_R1, 0); + jit_fixnum_l(JIT_R0, JIT_R1); + jit_lshi_l(JIT_R2, JIT_R0, 1); + (void)jit_bner_l(refslow, JIT_R1, JIT_R2); + jit_movr_p(dest, JIT_R0); +#endif + } else { + jit_str_ui(JIT_R0, JIT_R1); + } +#ifdef SIXTY_FOUR_BIT_INTEGERS + } else if (ctype == scheme_int64_ctype) { + if (is_ref) { + jit_ldr_l(JIT_R1, JIT_R0); + jit_fixnum_l(JIT_R0, JIT_R1); + jit_lshi_l(JIT_R2, JIT_R0, 1); + (void)jit_bner_l(refslow, JIT_R1, JIT_R2); + jit_movr_p(dest, JIT_R0); + } else { + jit_str_l(JIT_R0, JIT_R1); + } + } else if (ctype == scheme_uint64_ctype) { + if (is_ref) { + jit_ldr_l(JIT_R1, JIT_R0); + (void)jit_blti_l(refslow, JIT_R1, 0); + jit_fixnum_l(JIT_R0, JIT_R1); + jit_lshi_l(JIT_R2, JIT_R0, 1); + (void)jit_bner_l(refslow, JIT_R1, JIT_R2); + jit_movr_p(dest, JIT_R0); + } else { + jit_str_ul(JIT_R0, JIT_R1); + } +#endif + } else { + scheme_signal_error("internal error: unhandled ctype"); + } + + CHECK_LIMIT(); + mz_patch_ucbranch(refdone); + } + + __END_SHORT_JUMPS__(1); + + mz_rs_inc(n); /* no sync */ + mz_runstack_popped(jitter, n); + + if (!is_ref && !result_ignored) + (void)jit_movi_p(dest, scheme_void); + return 1; } } diff --git a/racket/src/racket/src/lightning/i386/fp-extfpu.h b/racket/src/racket/src/lightning/i386/fp-extfpu.h index 5fd5078289..c6c0b59c53 100644 --- a/racket/src/racket/src/lightning/i386/fp-extfpu.h +++ b/racket/src/racket/src/lightning/i386/fp-extfpu.h @@ -195,6 +195,7 @@ union jit_fpu_double_imm { : (FPX(), FLDLm(0, (rs), 0, 0), FSTPr ((rd) + 1))) #define jit_fpu_ldr_d_fppush(rd, rs) (FPX(), FLDLm(0, (rs), 0, 0)) +#define jit_fpu_ldr_f_fppush(rd, rs) (FPX(), FLDSm(0, (rs), 0, 0)) #define jit_fpu_ldr_ld(rd, rs) \ ((rd) == 0 ? (FSTPr (0), FPX(), FLDTm(0, (rs), 0, 0)) \ @@ -288,11 +289,15 @@ union jit_fpu_double_imm { #define jit_fpu_stxi_d_fppop(id, rd, rs) (FPX(), FSTPLm((id), (rd), 0, 0)) #define jit_fpu_str_d_fppop(rd, rs) (FPX(), FSTPLm(0, (rd), 0, 0)) #define jit_fpu_stxr_d_fppop(d1, d2, rs) (FPX(), FSTPLm(0, (d1), (d2), 1)) +#define jit_fpu_str_f_fppop(rd, rs) (FPX(), FSTPSm(0, (rd), 0, 0)) #define jit_fpu_stxi_ld_fppop(id, rd, rs) (FPX(), FSTPTm((id), (rd), 0, 0)) #define jit_fpu_str_ld_fppop(rd, rs) (FPX(), FSTPTm(0, (rd), 0, 0)) #define jit_fpu_stxr_ld_fppop(d1, d2, rs) (FPX(), FSTPTm(0, (d1), (d2), 1)) +#define jit_fpu_extr_d_f(r1, r2) jit_fpu_movr_d(r1, r2) +#define jit_fpu_extr_f_d(r1, r2) jit_fpu_movr_d(r1, r2) + /* Assume round to near mode */ #define jit_fpu_floorr_d_i(rd, rs) \ (FLDr (rs), jit_fpu_floor2((rd), ((rd) == _EDX ? _EAX : _EDX))) diff --git a/racket/src/racket/src/lightning/i386/fp-sse.h b/racket/src/racket/src/lightning/i386/fp-sse.h index fa014b87d4..8cd3d7e031 100644 --- a/racket/src/racket/src/lightning/i386/fp-sse.h +++ b/racket/src/racket/src/lightning/i386/fp-sse.h @@ -100,6 +100,7 @@ #define jit_ldxi_d(f0, r0, i0) MOVSDmr(i0, r0, _NOREG, _SCL1, f0) +#define jit_str_f(r0, f0) MOVSSrm(f0, 0, r0, _NOREG, _SCL1) #define jit_str_d(r0, f0) MOVSDrm(f0, 0, r0, _NOREG, _SCL1) #define _jit_sti_d(i0, f0) MOVSDrm(f0, (long)i0, _NOREG, _NOREG, _SCL1) @@ -140,6 +141,7 @@ #endif # define jit_extr_d_f(f0, f1) CVTSD2SSrr(f1, f0) +# define jit_extr_f_d(f0, f1) CVTSS2SDrr(f1, f0) #define jit_abs_d(f0, f1) \ ((f0 == f1) \ diff --git a/racket/src/racket/src/lightning/i386/fp.h b/racket/src/racket/src/lightning/i386/fp.h index 940166b48d..d0a8228e9f 100644 --- a/racket/src/racket/src/lightning/i386/fp.h +++ b/racket/src/racket/src/lightning/i386/fp.h @@ -98,6 +98,7 @@ # define jit_ldi_ld_fppush(rd, is) jit_fpu_ldi_ld_fppush(rd, is) # define jit_ldr_d(rd, rs) jit_fpu_ldr_d(rd, rs) # define jit_ldr_d_fppush(rd, rs) jit_fpu_ldr_d_fppush(rd, rs) +# define jit_ldr_f_fppush(rd, rs) jit_fpu_ldr_f_fppush(rd, rs) # define jit_ldr_ld(rd, rs) jit_fpu_ldr_ld(rd, rs) # define jit_ldr_ld_fppush(rd, rs) jit_fpu_ldr_ld_fppush(rd, rs) # define jit_ldxi_d(rd, rs, is) jit_fpu_ldxi_d(rd, rs, is) @@ -113,16 +114,20 @@ # define jit_extr_i_ld_fppush(rd, rs) jit_fpu_extr_i_ld_fppush(rd, rs) # define jit_extr_l_d_fppush(rd, rs) jit_fpu_extr_l_d_fppush(rd, rs) # define jit_extr_l_ld_fppush(rd, rs) jit_fpu_extr_l_ld_fppush(rd, rs) +# define jit_extr_d_f(rd, rs) jit_fpu_extr_d_f(rd, rs) +# define jit_extr_f_d(rd, rs) jit_fpu_extr_f_d(rd, rs) # define jit_stxi_f(id, rd, rs) jit_fpu_stxi_f(id, rd, rs) # define jit_stxr_f(d1, d2, rs) jit_fpu_stxr_f(d1, d2, rs) # define jit_stxi_d(id, rd, rs) jit_fpu_stxi_d(id, rd, rs) # define jit_stxr_d(d1, d2, rs) jit_fpu_stxr_d(d1, d2, rs) # define jit_sti_d(id, rs) jit_fpu_sti_d(id, rs) # define jit_str_d(rd, rs) jit_fpu_str_d(rd, rs) +# define jit_str_f(rd, rs) jit_fpu_str_f(rd, rs) # define jit_sti_d_fppop(id, rs) jit_fpu_sti_d_fppop(id, rs) # define jit_sti_ld_fppop(id, rs) jit_fpu_sti_ld_fppop(id, rs) # define jit_stxi_d_fppop(id, rd, rs) jit_fpu_stxi_d_fppop(id, rd, rs) # define jit_str_d_fppop(rd, rs) jit_fpu_str_d_fppop(rd, rs) +# define jit_str_f_fppop(rd, rs) jit_fpu_str_f_fppop(rd, rs) # define jit_stxr_d_fppop(d1, d2, rs) jit_fpu_stxr_d_fppop(d1, d2, rs) # define jit_stxi_ld_fppop(id, rd, rs) jit_fpu_stxi_ld_fppop(id, rd, rs) # define jit_str_ld_fppop(rd, rs) jit_fpu_str_ld_fppop(rd, rs) diff --git a/racket/src/racket/src/lightning/ppc/fp.h b/racket/src/racket/src/lightning/ppc/fp.h index ed3cd8278d..57ffacc1da 100644 --- a/racket/src/racket/src/lightning/ppc/fp.h +++ b/racket/src/racket/src/lightning/ppc/fp.h @@ -234,6 +234,8 @@ STWrm(JIT_AUX, -4, JIT_SP), \ LFDrri(rd, JIT_SP, -8), \ FSUBDrrr(rd, rd, JIT_FPR(5))) - + +#define jit_extr_d_f(rd, rs) jit_movr_d(rd, rs) +#define jit_extr_f_d(rd, rs) jit_movr_d(rd, rs) #endif /* __lightning_asm_h */ diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index a5410cfd67..a3b963fec5 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -3890,7 +3890,8 @@ int scheme_compiled_duplicate_ok(Scheme_Object *fb, int cross_module) && (!cross_module || (SCHEME_BYTE_STRLEN_VAL(fb) < STR_INLINE_LIMIT))) || SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type) || (SCHEME_NUMBERP(fb) - && (!cross_module || small_inline_number(fb)))); + && (!cross_module || small_inline_number(fb))) + || SAME_TYPE(SCHEME_TYPE(fb), scheme_ctype_type)); } static int equivalent_exprs(Scheme_Object *a, Scheme_Object *b) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 061dfde19b..a27a430e35 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -547,6 +547,18 @@ extern Scheme_Object *scheme_reduced_procedure_struct; #define scheme_constant_key scheme_stack_dump_key #define scheme_fixed_key scheme_default_prompt_tag +extern Scheme_Object *scheme_double_ctype; +extern Scheme_Object *scheme_float_ctype; +extern Scheme_Object *scheme_pointer_ctype; +extern Scheme_Object *scheme_int8_ctype; +extern Scheme_Object *scheme_uint8_ctype; +extern Scheme_Object *scheme_int16_ctype; +extern Scheme_Object *scheme_uint16_ctype; +extern Scheme_Object *scheme_int32_ctype; +extern Scheme_Object *scheme_uint32_ctype; +extern Scheme_Object *scheme_int64_ctype; +extern Scheme_Object *scheme_uint64_ctype; + /*========================================================================*/ /* hash functions */ /*========================================================================*/ @@ -646,6 +658,9 @@ extern void scheme_check_foreign_work(void); XFORM_NONGCING extern void *scheme_extract_pointer(Scheme_Object *v); #endif +Scheme_Object *scheme_foreign_ptr_ref(int argc, Scheme_Object **argv); +void scheme_foreign_ptr_set(int argc, Scheme_Object **argv); + void scheme_kickoff_green_thread_time_slice_timer(intptr_t usec); #ifdef UNIX_PROCESSES