diff --git a/collects/tests/racket/benchmarks/shootout/binarytrees-normal.rkt b/collects/tests/racket/benchmarks/shootout/binarytrees-normal.rkt new file mode 100644 index 0000000000..15a4143d17 --- /dev/null +++ b/collects/tests/racket/benchmarks/shootout/binarytrees-normal.rkt @@ -0,0 +1,49 @@ +#lang racket/base + +;;; The Computer Language Benchmarks Game +;;; http://shootout.alioth.debian.org/ +;;; Derived from the Chicken variant by Sven Hartrumpf + +(require racket/cmdline racket/require (for-syntax racket/base) + (filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name "")) + racket/unsafe/ops)) + +(struct leaf (val)) +(struct node leaf (left right)) + +(define (make item d) + (if (fx= d 0) + (leaf item) + (let ([item2 (fx* item 2)] [d2 (fx- d 1)]) + (node item (make (fx- item2 1) d2) (make item2 d2))))) + +(define (check t) + (let loop ([t t] [acc 0]) + (let ([acc (fx+ (leaf-val t) acc)]) + (if (node? t) + (loop (node-left t) + (fx- acc (loop (node-right t) 0))) + acc)))) + +(define min-depth 4) + +(define (main n) + (let ([max-depth (max (+ min-depth 2) n)]) + (let ([stretch-depth (+ max-depth 1)]) + (printf "stretch tree of depth ~a\t check: ~a\n" + stretch-depth + (check (make 0 stretch-depth)))) + (let ([long-lived-tree (make 0 max-depth)]) + (for ([d (in-range 4 (+ max-depth 1) 2)]) + (let ([iterations (expt 2 (+ (- max-depth d) min-depth))]) + (printf "~a\t trees of depth ~a\t check: ~a\n" + (* 2 iterations) + d + (for/fold ([c 0]) ([i (in-range iterations)]) + (fx+ c (fx+ (check (make i d)) + (check (make (fx- 0 i) d)))))))) + (printf "long lived tree of depth ~a\t check: ~a\n" + max-depth + (check long-lived-tree))))) + +(command-line #:args (n) (main (string->number n))) diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index aa06b8fe50..e08d4734b2 100644 --- a/src/racket/src/cstartup.inc +++ b/src/racket/src/cstartup.inc @@ -1,14 +1,14 @@ { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0, -27,0,31,0,38,0,42,0,49,0,54,0,61,0,66,0,69,0,74,0,83, +21,0,25,0,29,0,36,0,41,0,54,0,61,0,66,0,69,0,74,0,83, 0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0, 163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,96,1,129, 1,162,1,221,1,21,2,99,2,155,2,160,2,180,2,73,3,93,3,145,3, 211,3,100,4,242,4,40,5,51,5,130,5,0,0,92,7,0,0,69,35,37, -109,105,110,45,115,116,120,29,11,11,11,72,112,97,114,97,109,101,116,101,114, -105,122,101,63,97,110,100,66,100,101,102,105,110,101,63,108,101,116,66,117,110, -108,101,115,115,64,99,111,110,100,66,108,101,116,114,101,99,64,108,101,116,42, +109,105,110,45,115,116,120,29,11,11,11,66,100,101,102,105,110,101,63,97,110, +100,63,108,101,116,66,117,110,108,101,115,115,64,99,111,110,100,72,112,97,114, +97,109,101,116,101,114,105,122,101,66,108,101,116,114,101,99,64,108,101,116,42, 62,111,114,64,119,104,101,110,68,104,101,114,101,45,115,116,120,29,11,11,11, 65,113,117,111,116,101,29,94,2,15,68,35,37,107,101,114,110,101,108,11,29, 94,2,15,68,35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105, @@ -16,12 +16,12 @@ 108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1, 20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121, 61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240, -85,88,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16, -20,2,8,2,2,2,4,2,2,2,5,2,2,2,6,2,2,2,7,2,2, -2,10,2,2,2,3,2,2,2,9,2,2,2,11,2,2,2,12,2,2,97, -37,11,8,240,85,88,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2, -37,2,13,2,2,2,13,96,11,11,8,240,85,88,0,0,16,0,96,38,11, -8,240,85,88,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14, +110,88,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16, +20,2,3,2,2,2,4,2,2,2,5,2,2,2,6,2,2,2,10,2,2, +2,7,2,2,2,8,2,2,2,9,2,2,2,11,2,2,2,12,2,2,97, +37,11,8,240,110,88,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2, +37,2,13,2,2,2,13,96,38,11,8,240,110,88,0,0,16,0,96,11,11, +8,240,110,88,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14, 2,2,11,11,11,8,32,8,31,8,30,8,29,27,248,22,163,4,195,249,22, 156,4,80,158,39,36,251,22,89,2,18,248,22,104,199,12,249,22,79,2,19, 248,22,106,201,27,248,22,163,4,195,249,22,156,4,80,158,39,36,251,22,89, @@ -30,14 +30,14 @@ 81,194,248,22,80,193,249,22,156,4,80,158,39,36,251,22,89,2,18,248,22, 80,199,249,22,79,2,4,248,22,81,201,11,18,100,10,13,16,6,36,2,14, 2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1, -8,101,110,118,49,55,50,57,54,16,4,11,11,2,21,3,1,8,101,110,118, -49,55,50,57,55,27,248,22,81,248,22,163,4,196,28,248,22,87,193,20,14, +8,101,110,118,49,55,51,51,57,16,4,11,11,2,21,3,1,8,101,110,118, +49,55,51,52,48,27,248,22,81,248,22,163,4,196,28,248,22,87,193,20,14, 159,37,36,37,28,248,22,87,248,22,81,194,248,22,80,193,249,22,156,4,80, 158,39,36,250,22,89,2,22,248,22,89,249,22,89,248,22,89,2,23,248,22, 80,201,251,22,89,2,18,2,23,2,23,249,22,79,2,11,248,22,81,204,18, 100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29, -16,4,11,11,2,20,3,1,8,101,110,118,49,55,50,57,57,16,4,11,11, -2,21,3,1,8,101,110,118,49,55,51,48,48,248,22,163,4,193,27,248,22, +16,4,11,11,2,20,3,1,8,101,110,118,49,55,51,52,50,16,4,11,11, +2,21,3,1,8,101,110,118,49,55,51,52,51,248,22,163,4,193,27,248,22, 163,4,194,249,22,79,248,22,89,248,22,80,196,248,22,81,195,27,248,22,81, 248,22,163,4,23,197,1,249,22,156,4,80,158,39,36,28,248,22,64,248,22, 157,4,248,22,80,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11, @@ -51,7 +51,7 @@ 249,22,2,32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,163,4,248, 22,80,201,248,22,81,198,27,248,22,81,248,22,163,4,196,27,248,22,163,4, 248,22,80,195,249,22,156,4,80,158,40,36,28,248,22,87,195,250,22,90,2, -22,9,248,22,81,199,250,22,89,2,6,248,22,89,248,22,80,199,250,22,90, +22,9,248,22,81,199,250,22,89,2,5,248,22,89,248,22,80,199,250,22,90, 2,10,248,22,81,201,248,22,81,202,27,248,22,81,248,22,163,4,23,197,1, 27,249,22,1,22,93,249,22,2,22,163,4,248,22,163,4,248,22,80,199,248, 22,183,4,249,22,156,4,80,158,41,36,251,22,89,1,22,119,105,116,104,45, @@ -63,12 +63,12 @@ 193,20,14,159,37,36,37,249,22,156,4,80,158,39,36,27,248,22,163,4,248, 22,80,197,28,249,22,152,9,62,61,62,248,22,157,4,248,22,104,196,250,22, 89,2,22,248,22,89,249,22,89,21,93,2,27,248,22,80,199,250,22,90,2, -8,249,22,89,2,27,249,22,89,248,22,113,203,2,27,248,22,81,202,251,22, +7,249,22,89,2,27,249,22,89,248,22,113,203,2,27,248,22,81,202,251,22, 89,2,18,28,249,22,152,9,248,22,157,4,248,22,80,200,64,101,108,115,101, -10,248,22,80,197,250,22,90,2,22,9,248,22,81,200,249,22,79,2,8,248, +10,248,22,80,197,250,22,90,2,22,9,248,22,81,200,249,22,79,2,7,248, 22,81,202,99,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30, -8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,55,51,50,50,16,4, -11,11,2,21,3,1,8,101,110,118,49,55,51,50,51,18,158,94,10,64,118, +8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,55,51,54,53,16,4, +11,11,2,21,3,1,8,101,110,118,49,55,51,54,54,18,158,94,10,64,118, 111,105,100,8,48,27,248,22,81,248,22,163,4,196,249,22,156,4,80,158,39, 36,28,248,22,64,248,22,157,4,248,22,80,197,250,22,89,2,28,248,22,89, 248,22,80,199,248,22,104,198,27,248,22,157,4,248,22,80,197,250,22,89,2, @@ -81,25 +81,25 @@ 11,2,12,36,46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0, 16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11, 20,15,16,2,20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1, -2,13,16,1,33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0, +2,13,16,1,33,33,10,16,5,2,6,88,163,8,36,37,53,37,9,223,0, 33,34,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8, 36,37,53,37,9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11, 16,5,2,4,88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36, 16,1,2,13,16,1,33,37,11,16,5,2,11,88,163,8,36,37,56,37,9, 223,0,33,38,36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2, -6,88,163,8,36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2, +5,88,163,8,36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2, 13,16,0,11,16,5,2,9,88,163,8,36,37,53,37,9,223,0,33,44,36, 20,113,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54, 37,9,223,0,33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2, -3,88,163,8,36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2, -13,16,0,11,16,5,2,8,88,163,8,36,37,58,37,9,223,0,33,47,36, -20,113,159,36,16,1,2,13,16,1,33,49,11,16,5,2,5,88,163,8,36, +8,88,163,8,36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2, +13,16,0,11,16,5,2,7,88,163,8,36,37,58,37,9,223,0,33,47,36, +20,113,159,36,16,1,2,13,16,1,33,49,11,16,5,2,3,88,163,8,36, 37,54,37,9,223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16, 0,94,2,16,2,17,93,2,16,9,9,36,0}; EVAL_ONE_SIZED_STR((char *)expr, 2028); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,126,0,0,0,1,0,0,8,0,21,0, 26,0,43,0,55,0,77,0,106,0,121,0,139,0,151,0,167,0,181,0,203, 0,219,0,236,0,2,1,13,1,19,1,28,1,35,1,42,1,54,1,70,1, @@ -373,7 +373,7 @@ 95,23,195,1,23,197,1,249,22,164,2,195,88,163,8,36,38,48,11,9,223, 3,33,96,28,197,86,94,20,18,159,11,80,158,42,49,193,20,18,159,11,80, 158,42,50,196,86,94,20,18,159,11,80,158,42,55,193,20,18,159,11,80,158, -42,56,196,193,28,193,80,158,38,49,80,158,38,55,248,22,8,88,163,8,32, +42,56,196,193,28,193,80,158,38,49,80,158,38,55,248,22,9,88,163,8,32, 37,8,40,8,240,0,240,94,0,9,224,1,2,33,97,0,7,35,114,120,34, 47,43,34,28,248,22,142,7,23,195,2,27,249,22,175,15,2,99,196,28,192, 28,249,22,191,3,248,22,103,195,248,22,181,3,248,22,145,7,198,249,22,7, @@ -579,7 +579,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 10007); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0, 57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,179, 1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115, @@ -606,7 +606,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 501); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,89,0,0,0,1,0,0,7,0,18,0, 45,0,51,0,60,0,67,0,89,0,102,0,128,0,145,0,167,0,175,0,187, 0,202,0,218,0,236,0,0,1,12,1,28,1,51,1,63,1,94,1,101,1, @@ -1012,7 +1012,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 8458); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,49,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0, 29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0, 0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2, @@ -1020,7 +1020,7 @@ 114,107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2, 74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66, 35,37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11, -29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,111,90, +29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,136,90, 0,0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6, 36,36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36, 36,16,0,159,36,20,113,159,36,16,1,11,16,0,20,26,144,9,2,1,2, diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 98c293b3f7..0f54e2ca8b 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -1889,10 +1889,15 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, g = scheme_current_thread->ku.multiple.count; if (i == g) { + int is_st; + values = scheme_current_thread->ku.multiple.array; scheme_current_thread->ku.multiple.array = NULL; if (SAME_OBJ(values, scheme_current_thread->values_buffer)) scheme_current_thread->values_buffer = NULL; + + is_st = scheme_is_simple_make_struct_type(vals_expr, g, 1, 1); + for (i = 0; i < g; i++) { var = SCHEME_VEC_ELS(vec)[i+delta]; if (dm_env) { @@ -1913,7 +1918,10 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro, scheme_shadow(scheme_get_bucket_home(b), (Scheme_Object *)b->key, 1); if (SCHEME_TOPLEVEL_FLAGS(var) & SCHEME_TOPLEVEL_SEAL) { - ((Scheme_Bucket_With_Flags *)b)->flags |= GLOB_IS_IMMUTATED; + if (is_st) + ((Scheme_Bucket_With_Flags *)b)->flags |= (GLOB_IS_IMMUTATED | GLOB_IS_CONSISTENT); + else + ((Scheme_Bucket_With_Flags *)b)->flags |= GLOB_IS_IMMUTATED; } } } diff --git a/src/racket/src/jit.h b/src/racket/src/jit.h index edd9ebe0f6..24e92ff4e7 100644 --- a/src/racket/src/jit.h +++ b/src/racket/src/jit.h @@ -1266,6 +1266,17 @@ void scheme_jit_release_native_code(void *fnlized, void *p); int scheme_do_generate_common(mz_jit_state *jitter, void *_data); int scheme_do_generate_more_common(mz_jit_state *jitter, void *_data); +int scheme_save_struct_temp(mz_jit_state *jitter, int reg); +int scheme_restore_struct_temp(mz_jit_state *jitter, int reg); +int scheme_generate_struct_op(mz_jit_state *jitter, int kind, int for_branch, + Branch_Info *branch_info, int branch_short, + int result_ignored, + int check_proc, int check_arg_fixnum, + int type_pos, int field_pos, + int pop_and_jump, + jit_insn *refslow, jit_insn *refslow2, + jit_insn *bref_false, jit_insn *bref_true); + /**********************************************************************/ /* jit */ /**********************************************************************/ diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c index 80711c9918..e9e99a72c7 100644 --- a/src/racket/src/jitcommon.c +++ b/src/racket/src/jitcommon.c @@ -101,21 +101,25 @@ static Scheme_Object *vector_check_chaperone_of(Scheme_Object *o, Scheme_Object return o; } -static int save_struct_temp(mz_jit_state *jitter) +static int save_struct_temp(mz_jit_state *jitter, int reg) { #ifdef MZ_USE_JIT_PPC - jit_movr_p(JIT_V(3), JIT_V1); + jit_movr_p(JIT_V(3), reg); #endif #ifdef MZ_USE_JIT_I386 # ifdef X86_ALIGN_STACK - mz_set_local_p(JIT_V1, JIT_LOCAL3); + mz_set_local_p(reg, JIT_LOCAL3); # else - jit_pushr_p(JIT_V1); + jit_pushr_p(reg); # endif #endif return 1; } +int scheme_save_struct_temp(mz_jit_state *jitter, int reg) { + return save_struct_temp(jitter, reg); +} + static int restore_struct_temp(mz_jit_state *jitter, int reg) { #ifdef MZ_USE_JIT_PPC @@ -131,6 +135,10 @@ static int restore_struct_temp(mz_jit_state *jitter, int reg) return 1; } +int scheme_restore_struct_temp(mz_jit_state *jitter, int reg) { + return restore_struct_temp(jitter, reg); +} + static void allocate_values(int count, Scheme_Thread *p) { Scheme_Object **a; @@ -1418,6 +1426,227 @@ static int gen_struct_slow(mz_jit_state *jitter, int kind, int ok_proc, return 1; } +int scheme_generate_struct_op(mz_jit_state *jitter, int kind, int for_branch, + Branch_Info *branch_info, int branch_short, + int result_ignored, + int check_proc, int check_arg_fixnum, + int type_pos, int field_pos, + int pop_and_jump, + GC_CAN_IGNORE jit_insn *refslow, GC_CAN_IGNORE jit_insn *refslow2, + GC_CAN_IGNORE jit_insn *bref_false, GC_CAN_IGNORE jit_insn *bref_true) +/* kind: pred (1), get (2), or set (3) + R0 is (potential) struct proc, R1 is (potential) struct. + In set mode, value to install is saved as a temp. */ +{ + GC_CAN_IGNORE jit_insn *ref2, *ref3, *bref1, *bref2, *refretry; + GC_CAN_IGNORE jit_insn *bref3, *bref4, *bref8, *ref9, *refdone; + + __START_SHORT_JUMPS__(branch_short); + + if (check_proc) { + (void)mz_bnei_t(refslow, JIT_R0, scheme_prim_type, JIT_R2); + jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Primitive_Proc *)0x0)->pp.flags); + jit_andi_i(JIT_R2, JIT_R2, SCHEME_PRIM_OTHER_TYPE_MASK); + (void)jit_bnei_i(refslow, JIT_R2, ((kind == 3) + ? SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER + : ((kind == 1) + ? SCHEME_PRIM_STRUCT_TYPE_PRED + : SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER))); + } + + CHECK_LIMIT(); + /* Check argument: */ + if (kind == 1) { + bref1 = jit_bmsi_ul(jit_forward(), JIT_R1, 0x1); + refretry = _jit.x.pc; + jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type); + __START_INNER_TINY__(1); + ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type); + ref3 = jit_beqi_i(jit_forward(), JIT_R2, scheme_proc_struct_type); + ref9 = jit_beqi_i(jit_forward(), JIT_R2, scheme_chaperone_type); + __END_INNER_TINY__(1); + bref2 = jit_bnei_i(jit_forward(), JIT_R2, scheme_proc_chaperone_type); + CHECK_LIMIT(); + __START_INNER_TINY__(1); + mz_patch_branch(ref9); + jit_ldxi_p(JIT_R1, JIT_R1, &SCHEME_CHAPERONE_VAL(0x0)); + (void)jit_jmpi(refretry); + mz_patch_branch(ref3); + __END_INNER_TINY__(1); + } else { + if (check_arg_fixnum) { + (void)jit_bmsi_ul(refslow2, JIT_R1, 0x1); + } + jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type); + __START_INNER_TINY__(1); + ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type); + __END_INNER_TINY__(1); + (void)jit_bnei_i(refslow2, JIT_R2, scheme_proc_struct_type); + bref1 = bref2 = NULL; + } + __START_INNER_TINY__(1); + mz_patch_branch(ref2); + __END_INNER_TINY__(1); + CHECK_LIMIT(); + + if (type_pos != 0) { + /* Put argument struct type in R2, target struct type in V1 */ + jit_ldxi_p(JIT_R2, JIT_R1, &((Scheme_Structure *)0x0)->stype); + if (type_pos < 0) { + jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); + if (kind >= 2) { + jit_ldxi_p(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->struct_type); + } + } + CHECK_LIMIT(); + + if (type_pos < 0) { + /* common case: types are the same */ + if (kind >= 2) { + __START_INNER_TINY__(1); + bref8 = jit_beqr_p(jit_forward(), JIT_R2, JIT_V1); + __END_INNER_TINY__(1); + } else + bref8 = NULL; + } else + bref8 = NULL; + + jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->name_pos); + if (type_pos < 0) { + jit_ldxi_i(JIT_V1, JIT_V1, &((Scheme_Struct_Type *)0x0)->name_pos); + /* Now R2 is argument depth, V1 is target depth */ + if (kind == 1) { + bref3 = jit_bltr_i(jit_forward(), JIT_R2, JIT_V1); + } else { + (void)jit_bltr_i(refslow2, JIT_R2, JIT_V1); + bref3 = NULL; + } + } else { + if (type_pos != 0) { + (void)jit_blti_i(refslow2, JIT_R2, type_pos); + } + bref3 = NULL; + } + CHECK_LIMIT(); + /* Lookup argument type at target type depth, put it in R2: */ + if (type_pos < 0) { + jit_lshi_ul(JIT_R2, JIT_V1, JIT_LOG_WORD_SIZE); + jit_addi_p(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->parent_types); + } + } else { + bref3 = NULL; + bref8 = NULL; + } + jit_ldxi_p(JIT_V1, JIT_R1, &((Scheme_Structure *)0x0)->stype); + if (type_pos < 0) { + jit_ldxr_p(JIT_R2, JIT_V1, JIT_R2); + } else { + jit_ldxi_p(JIT_R2, JIT_V1, (type_pos << JIT_LOG_WORD_SIZE) + (intptr_t)&(((Scheme_Struct_Type *)0x0)->parent_types)); + } + CHECK_LIMIT(); + + /* (Re-)load target type into V1: */ + jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); + if (kind >= 2) { + jit_ldxi_p(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->struct_type); + } + + if (kind == 1) { + bref4 = jit_bner_p(jit_forward(), JIT_R2, JIT_V1); + + /* True branch: */ + if (!for_branch) { + (void)jit_movi_p(JIT_R0, scheme_true); + } else if (branch_info) { + scheme_branch_for_true(jitter, branch_info); + } else { + mz_patch_ucbranch(bref_true); +#ifdef MZ_USE_JIT_I386 +# ifndef X86_ALIGN_STACK + jit_popr_p(JIT_V1); +# endif +#endif + } + if (pop_and_jump) + mz_epilog(JIT_V1); + else if (!for_branch) { + __START_INNER_TINY__(1); + refdone = jit_jmpi(jit_forward()); + __END_INNER_TINY__(1); + } + + /* False branch: */ + if (branch_info) { + scheme_add_branch_false(branch_info, bref1); + scheme_add_branch_false(branch_info, bref2); + if (bref3) + scheme_add_branch_false(branch_info, bref3); + scheme_add_branch_false(branch_info, bref4); + } else { + mz_patch_branch(bref1); + mz_patch_branch(bref2); + if (bref3) + mz_patch_branch(bref3); + mz_patch_branch(bref4); + if (for_branch) { + mz_patch_branch(bref_false); + if (pop_and_jump) { + restore_struct_temp(jitter, JIT_V1); + mz_epilog_without_jmp(); + } + jit_jmpr(JIT_V1); + } else { + (void)jit_movi_p(JIT_R0, scheme_false); + if (pop_and_jump) + mz_epilog(JIT_V1); + } + if (!pop_and_jump) { + __START_INNER_TINY__(1); + mz_patch_ucbranch(refdone); + __END_INNER_TINY__(1); + } + } + } else { + (void)jit_bner_p(refslow2, JIT_R2, JIT_V1); + bref4 = NULL; + if (bref8) { + __START_INNER_TINY__(1); + mz_patch_branch(bref8); + __END_INNER_TINY__(1); + } + /* Extract field */ + if (field_pos < 0) { + jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); + jit_ldxi_i(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->field); + jit_lshi_ul(JIT_V1, JIT_V1, JIT_LOG_WORD_SIZE); + jit_addi_p(JIT_V1, JIT_V1, &((Scheme_Structure *)0x0)->slots); + } else { + field_pos = (field_pos << JIT_LOG_WORD_SIZE) + (uintptr_t)&((Scheme_Structure *)0x0)->slots; + } + if (kind == 3) { + restore_struct_temp(jitter, JIT_R0); + if (field_pos < 0) + jit_stxr_p(JIT_V1, JIT_R1, JIT_R0); + else + jit_stxi_p(field_pos, JIT_R1, JIT_R0); + if (!result_ignored) + (void)jit_movi_p(JIT_R0, scheme_void); + } else { + if (field_pos < 0) + jit_ldxr_p(JIT_R0, JIT_R1, JIT_V1); + else + jit_ldxi_p(JIT_R0, JIT_R1, field_pos); + } + if (pop_and_jump) + mz_epilog(JIT_V1); + } + CHECK_LIMIT(); + + __END_SHORT_JUMPS__(branch_short); + + return 1; +} + static int common4(mz_jit_state *jitter, void *_data) { int i, ii, iii; @@ -1570,8 +1799,8 @@ static int common4(mz_jit_state *jitter, void *_data) for (i = 0; i < 4; i++) { /* pred, pred_branch, get, or set */ void *code; int kind, for_branch; - GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refslow, *refslow2, *bref1, *bref2, *refretry; - GC_CAN_IGNORE jit_insn *bref3, *bref4, *bref5, *bref6, *bref8, *ref9; + GC_CAN_IGNORE jit_insn *ref, *refslow, *refslow2; + GC_CAN_IGNORE jit_insn *bref5, *bref6; if ((ii == 1) && (i == 1)) continue; /* no multi variant of pred branch */ if ((ii == 2) && (i == 1)) continue; /* no tail variant of pred branch */ @@ -1592,7 +1821,7 @@ static int common4(mz_jit_state *jitter, void *_data) for_branch = 1; sjc.struct_pred_branch_code = jit_get_ip().ptr; /* Save target address for false branch: */ - save_struct_temp(jitter); + save_struct_temp(jitter, JIT_V1); } else if (i == 2) { kind = 2; for_branch = 0; @@ -1612,7 +1841,7 @@ static int common4(mz_jit_state *jitter, void *_data) else sjc.struct_set_code = jit_get_ip().ptr; /* Save value to install: */ - save_struct_temp(jitter); + save_struct_temp(jitter, JIT_V1); } mz_prolog(JIT_V1); @@ -1637,140 +1866,13 @@ static int common4(mz_jit_state *jitter, void *_data) /* Continue trying fast path: check proc */ mz_patch_branch(ref); - (void)mz_bnei_t(refslow, JIT_R0, scheme_prim_type, JIT_R2); - jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Primitive_Proc *)0x0)->pp.flags); - jit_andi_i(JIT_R2, JIT_R2, SCHEME_PRIM_OTHER_TYPE_MASK); - (void)jit_bnei_i(refslow, JIT_R2, ((kind == 3) - ? SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER - : ((kind == 1) - ? SCHEME_PRIM_STRUCT_TYPE_PRED - : SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER))); - CHECK_LIMIT(); - /* Check argument: */ - if (kind == 1) { - bref1 = jit_bmsi_ul(jit_forward(), JIT_R1, 0x1); - refretry = _jit.x.pc; - jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type); - __START_INNER_TINY__(1); - ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type); - ref3 = jit_beqi_i(jit_forward(), JIT_R2, scheme_proc_struct_type); - ref9 = jit_beqi_i(jit_forward(), JIT_R2, scheme_chaperone_type); - __END_INNER_TINY__(1); - bref2 = jit_bnei_i(jit_forward(), JIT_R2, scheme_proc_chaperone_type); - CHECK_LIMIT(); - __START_INNER_TINY__(1); - mz_patch_branch(ref9); - jit_ldxi_p(JIT_R1, JIT_R1, &SCHEME_CHAPERONE_VAL(0x0)); - (void)jit_jmpi(refretry); - mz_patch_branch(ref3); - __END_INNER_TINY__(1); - } else { - (void)jit_bmsi_ul(refslow2, JIT_R1, 0x1); - jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type); - __START_INNER_TINY__(1); - ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type); - __END_INNER_TINY__(1); - (void)jit_bnei_i(refslow2, JIT_R2, scheme_proc_struct_type); - bref1 = bref2 = NULL; - } - __START_INNER_TINY__(1); - mz_patch_branch(ref2); - __END_INNER_TINY__(1); - CHECK_LIMIT(); - - /* Put argument struct type in R2, target struct type in V1 */ - jit_ldxi_p(JIT_R2, JIT_R1, &((Scheme_Structure *)0x0)->stype); - jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); - if (kind >= 2) { - jit_ldxi_p(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->struct_type); - } - CHECK_LIMIT(); - - /* common case: types are the same */ - if (kind >= 2) { - __START_INNER_TINY__(1); - bref8 = jit_beqr_p(jit_forward(), JIT_R2, JIT_V1); - __END_INNER_TINY__(1); - } else - bref8 = NULL; - - jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->name_pos); - jit_ldxi_i(JIT_V1, JIT_V1, &((Scheme_Struct_Type *)0x0)->name_pos); - /* Now R2 is argument depth, V1 is target depth */ - if (kind == 1) { - bref3 = jit_bltr_i(jit_forward(), JIT_R2, JIT_V1); - } else { - (void)jit_bltr_i(refslow2, JIT_R2, JIT_V1); - bref3 = NULL; - } - CHECK_LIMIT(); - /* Lookup argument type at target type depth, put it in R2: */ - jit_lshi_ul(JIT_R2, JIT_V1, JIT_LOG_WORD_SIZE); - jit_addi_p(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->parent_types); - jit_ldxi_p(JIT_V1, JIT_R1, &((Scheme_Structure *)0x0)->stype); - jit_ldxr_p(JIT_R2, JIT_V1, JIT_R2); - CHECK_LIMIT(); - - /* Re-load target type into V1: */ - jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); - if (kind >= 2) { - jit_ldxi_p(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->struct_type); - } - - if (kind == 1) { - bref4 = jit_bner_p(jit_forward(), JIT_R2, JIT_V1); - - /* True branch: */ - if (!for_branch) { - (void)jit_movi_p(JIT_R0, scheme_true); - } else { - mz_patch_ucbranch(bref6); -#ifdef MZ_USE_JIT_I386 -# ifndef X86_ALIGN_STACK - jit_popr_p(JIT_V1); -# endif -#endif - } - mz_epilog(JIT_V1); - - /* False branch: */ - mz_patch_branch(bref1); - mz_patch_branch(bref2); - mz_patch_branch(bref3); - mz_patch_branch(bref4); - if (for_branch) { - mz_patch_branch(bref5); - restore_struct_temp(jitter, JIT_V1); - mz_epilog_without_jmp(); - jit_jmpr(JIT_V1); - } else { - (void)jit_movi_p(JIT_R0, scheme_false); - mz_epilog(JIT_V1); - } - } else { - (void)jit_bner_p(refslow2, JIT_R2, JIT_V1); - bref4 = NULL; - __START_INNER_TINY__(1); - mz_patch_branch(bref8); - __END_INNER_TINY__(1); - /* Extract field */ - jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val); - jit_ldxi_i(JIT_V1, JIT_V1, &((Struct_Proc_Info *)0x0)->field); - jit_lshi_ul(JIT_V1, JIT_V1, JIT_LOG_WORD_SIZE); - jit_addi_p(JIT_V1, JIT_V1, &((Scheme_Structure *)0x0)->slots); - if (kind == 3) { - restore_struct_temp(jitter, JIT_R0); - jit_stxr_p(JIT_V1, JIT_R1, JIT_R0); - (void)jit_movi_p(JIT_R0, scheme_void); - } else { - jit_ldxr_p(JIT_R0, JIT_R1, JIT_V1); - } - mz_epilog(JIT_V1); - } - CHECK_LIMIT(); - __END_SHORT_JUMPS__(1); + scheme_generate_struct_op(jitter, kind, for_branch, NULL, 1, 0, + 1, 1, -1, -1, + 1, refslow, refslow2, bref5, bref6); + CHECK_LIMIT(); + scheme_jit_register_sub_func(jitter, code, scheme_false); } } diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index e835bc0e3b..5dde16f57c 100644 --- a/src/racket/src/jitinline.c +++ b/src/racket/src/jitinline.c @@ -352,12 +352,27 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app return 1; } +static Scheme_Object *extract_struct_constant(mz_jit_state *jitter, Scheme_Object *rator) +{ + if (SAME_TYPE(SCHEME_TYPE(rator), scheme_toplevel_type) + && (SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_CONST) { + rator = scheme_extract_global(rator, jitter->nc, 1); + if (rator) + return ((Scheme_Bucket *)rator)->val; + } + + return NULL; +} + static int generate_inlined_struct_op(int kind, mz_jit_state *jitter, Scheme_Object *rator, Scheme_Object *rand, Scheme_Object *rand2, Branch_Info *for_branch, int branch_short, - int is_tail, int multi_ok) + int is_tail, int multi_ok, int result_ignored) /* de-sync'd ok; for branch, sync'd before */ { + GC_CAN_IGNORE jit_insn *ref, *ref2, *refslow; + Scheme_Object *inline_rator; + LOG_IT(("inlined struct op\n")); if (!rand2) { @@ -381,24 +396,49 @@ static int generate_inlined_struct_op(int kind, mz_jit_state *jitter, /* R0 is [potential] predicate/getter/setting, R1 is struct. V1 is value for setting. */ + if ((kind == INLINE_STRUCT_PROC_PRED) /* REMOVEME */ + || (kind == INLINE_STRUCT_PROC_GET) + || (kind == INLINE_STRUCT_PROC_SET)) { + inline_rator = extract_struct_constant(jitter, rator); + if (inline_rator && (kind != INLINE_STRUCT_PROC_PRED)) { + __START_SHORT_JUMPS__(1); + ref = jit_bmci_ul(jit_forward(), JIT_R1, 0x1); + refslow = _jit.x.pc; + if (kind == INLINE_STRUCT_PROC_SET) + scheme_restore_struct_temp(jitter, JIT_V1); + __END_SHORT_JUMPS__(1); + } else { + ref = NULL; + refslow = NULL; + } + } else { + inline_rator = NULL; + ref = NULL; + refslow = NULL; + } + if (for_branch) { scheme_prepare_branch_jump(jitter, for_branch); CHECK_LIMIT(); - __START_SHORT_JUMPS__(for_branch->branch_short); - scheme_add_branch_false_movi(for_branch, jit_patchable_movi_p(JIT_V1, jit_forward())); - __END_SHORT_JUMPS__(for_branch->branch_short); - (void)jit_calli(sjc.struct_pred_branch_code); - __START_SHORT_JUMPS__(for_branch->branch_short); - scheme_branch_for_true(jitter, for_branch); - __END_SHORT_JUMPS__(for_branch->branch_short); - CHECK_LIMIT(); + if (!inline_rator) { + __START_SHORT_JUMPS__(for_branch->branch_short); + scheme_add_branch_false_movi(for_branch, jit_patchable_movi_p(JIT_V1, jit_forward())); + __END_SHORT_JUMPS__(for_branch->branch_short); + (void)jit_calli(sjc.struct_pred_branch_code); + __START_SHORT_JUMPS__(for_branch->branch_short); + scheme_branch_for_true(jitter, for_branch); + __END_SHORT_JUMPS__(for_branch->branch_short); + CHECK_LIMIT(); + } } else if (kind == INLINE_STRUCT_PROC_PRED) { - if (is_tail) { - (void)jit_calli(sjc.struct_pred_tail_code); - } else if (multi_ok) { - (void)jit_calli(sjc.struct_pred_multi_code); - } else { - (void)jit_calli(sjc.struct_pred_code); + if (!inline_rator) { + if (is_tail) { + (void)jit_calli(sjc.struct_pred_tail_code); + } else if (multi_ok) { + (void)jit_calli(sjc.struct_pred_multi_code); + } else { + (void)jit_calli(sjc.struct_pred_code); + } } } else if (kind == INLINE_STRUCT_PROC_GET) { if (is_tail) { @@ -446,6 +486,48 @@ static int generate_inlined_struct_op(int kind, mz_jit_state *jitter, scheme_signal_error("internal error: unknown struct-op mode"); } + if (inline_rator) { + int pos, tpos, jkind; + + inline_rator = ((Scheme_Primitive_Closure *)inline_rator)->val[0]; + if (kind == INLINE_STRUCT_PROC_PRED) { + pos = 0; + tpos = ((Scheme_Struct_Type *)inline_rator)->name_pos; + } else { + pos = ((Struct_Proc_Info *)inline_rator)->field; + tpos = ((Struct_Proc_Info *)inline_rator)->struct_type->name_pos; + } + + if (ref) { + __START_SHORT_JUMPS__(1); + ref2 = jit_jmpi(jit_forward()); + mz_patch_ucbranch(ref); + __END_SHORT_JUMPS__(1); + } else + ref2 = NULL; + + if (kind == INLINE_STRUCT_PROC_GET) + jkind = 2; + else if (kind == INLINE_STRUCT_PROC_SET) { + scheme_save_struct_temp(jitter, JIT_V1); + jkind = 3; + } else + jkind = 1; + + scheme_generate_struct_op(jitter, jkind, !!for_branch, + for_branch, branch_short, + result_ignored, + 0, 0, + tpos, pos, + 0, refslow, refslow, NULL, NULL); + + if (ref2) { + __START_SHORT_JUMPS__(1); + mz_patch_ucbranch(ref2); + __END_SHORT_JUMPS__(1); + } + } + return 1; } @@ -836,7 +918,8 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in int k; k = inlineable_struct_prim(rator, jitter, 1, 1); if (k == INLINE_STRUCT_PROC_PRED) { - generate_inlined_struct_op(1, jitter, rator, app->rand, NULL, for_branch, branch_short, is_tail, multi_ok); + generate_inlined_struct_op(1, jitter, rator, app->rand, NULL, for_branch, branch_short, is_tail, multi_ok, + result_ignored); scheme_direct_call_count++; return 1; } else if (((k == INLINE_STRUCT_PROC_GET) @@ -844,7 +927,8 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in || (k == INLINE_STRUCT_PROC_PROP_PRED) || (k == INLINE_STRUCT_PROC_CONSTR)) && !for_branch) { - generate_inlined_struct_op(k, jitter, rator, app->rand, NULL, for_branch, branch_short, is_tail, multi_ok); + generate_inlined_struct_op(k, jitter, rator, app->rand, NULL, for_branch, branch_short, is_tail, multi_ok, + result_ignored); scheme_direct_call_count++; return 1; } @@ -2066,7 +2150,8 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i int k; k = inlineable_struct_prim(rator, jitter, 2, 2); if (k) { - generate_inlined_struct_op(k, jitter, rator, app->rand1, app->rand2, for_branch, branch_short, is_tail, multi_ok); + generate_inlined_struct_op(k, jitter, rator, app->rand1, app->rand2, for_branch, branch_short, is_tail, multi_ok, + result_ignored); scheme_direct_call_count++; return 1; } diff --git a/src/racket/src/module.c b/src/racket/src/module.c index 1f1244d329..3a9e466d01 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -4121,6 +4121,7 @@ static void setup_accessible_table(Scheme_Module *m) for (i = 0; i < cnt; i++) { form = SCHEME_VEC_ELS(m->bodies[0])[i]; if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_values_type)) { + int checked_st = 0, is_st = 0; for (k = SCHEME_VEC_SIZE(form); k-- > 1; ) { tl = SCHEME_VEC_ELS(form)[k]; if (SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_SEAL) { @@ -4135,21 +4136,31 @@ static void setup_accessible_table(Scheme_Module *m) won't generate such modules, but synthesized module bytecode might leave bindings out of the `toplevels' table. */ } else { - if ((SCHEME_VEC_SIZE(form) == 2) - && scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) { - /* record simple constant from cross-module propagation: */ - v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]); - } else if (SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(form)[0]), scheme_inline_variant_type)) { - /* record a potentially inlineable function */ - if (SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] != (Scheme_Object *)m->prefix) - SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] = (Scheme_Object *)m->prefix; - v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]); - } else if (is_procedure_expression(SCHEME_VEC_ELS(form)[0])) { - /* record that it's constant across all instantiations: */ - v = scheme_make_pair(v, scheme_constant_key); + if (SCHEME_VEC_SIZE(form) == 2) { + if (scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) { + /* record simple constant from cross-module propagation: */ + v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]); + } else if (SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(form)[0]), scheme_inline_variant_type)) { + /* record a potentially inlineable function */ + if (SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] != (Scheme_Object *)m->prefix) + SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] = (Scheme_Object *)m->prefix; + v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]); + } else if (is_procedure_expression(SCHEME_VEC_ELS(form)[0])) { + /* record that it's constant across all instantiations: */ + v = scheme_make_pair(v, scheme_constant_key); + } else { + /* record that it's fixed for any given instantiation: */ + v = scheme_make_pair(v, scheme_fixed_key); + } } else { - /* record that it's fixed for any given instantiation: */ - v = scheme_make_pair(v, scheme_fixed_key); + if (!checked_st) { + is_st = scheme_is_simple_make_struct_type(SCHEME_VEC_ELS(form)[0], + SCHEME_VEC_SIZE(form)-1, + 1, 1); + checked_st = 1; + } + if (is_st) + v = scheme_make_pair(v, scheme_constant_key); } scheme_hash_set(ht, tl, v); } diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index 639d9d48c3..6d3c11976d 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -149,59 +149,6 @@ void scheme_init_optimize() /* utils */ /*========================================================================*/ -static int is_current_inspector_call(Scheme_Object *a) -{ - if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) { - Scheme_App_Rec *app = (Scheme_App_Rec *)a; - if (!app->num_args - && SAME_OBJ(app->args[0], scheme_current_inspector_proc)) - return 1; - } - return 0; -} - -static int is_proc_spec_proc(Scheme_Object *p) -{ - Scheme_Type vtype; - - if (SCHEME_PROCP(p)) { - p = scheme_get_or_check_arity(p, -1); - if (SCHEME_INTP(p)) { - return (SCHEME_INT_VAL(p) >= 1); - } else if (SCHEME_STRUCTP(p) - && scheme_is_struct_instance(scheme_arity_at_least, p)) { - p = ((Scheme_Structure *)p)->slots[0]; - if (SCHEME_INTP(p)) - return (SCHEME_INT_VAL(p) >= 1); - } - return 0; - } - - vtype = SCHEME_TYPE(p); - - if (vtype == scheme_unclosed_procedure_type) { - if (((Scheme_Closure_Data *)p)->num_params >= 1) - return 1; - } - - return 0; -} - -static void note_match(int actual, int expected, Optimize_Info *warn_info) -{ - if (!warn_info || (expected == -1)) - return; - - if (actual != expected) { - scheme_log(warn_info->logger, - SCHEME_LOG_WARNING, - 0, - "warning%s: %d values produced when %d expected", - scheme_optimize_context_to_string(warn_info->context), - actual, expected); - } -} - int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expected_vals) /* return 2 => results are a constant when arguments are constants */ { @@ -220,6 +167,21 @@ int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expec return 0; } +static void note_match(int actual, int expected, Optimize_Info *warn_info) +{ + if (!warn_info || (expected == -1)) + return; + + if (actual != expected) { + scheme_log(warn_info->logger, + SCHEME_LOG_WARNING, + 0, + "warning%s: %d values produced when %d expected", + scheme_optimize_context_to_string(warn_info->context), + actual, expected); + } +} + int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, Optimize_Info *warn_info, int deeper_than, int no_id) /* Checks whether the bytecode `o' returns `vals' values with no @@ -358,33 +320,16 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, } if (vtype == scheme_application_type) { - /* Look for multiple values, or for `make-struct-type'. - (The latter is especially useful to Honu.) */ Scheme_App_Rec *app = (Scheme_App_Rec *)o; - if ((app->num_args >= 4) && (app->num_args <= 10) + + if ((app->num_args >= 4) && (app->num_args <= 11) && SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) { note_match(5, vals, warn_info); - if ((vals == 5) || (vals < 0)) { - /* Look for (make-struct-type sym #f non-neg-int non-neg-int [omitable null]) */ - if (SCHEME_SYMBOLP(app->args[1]) - && SCHEME_FALSEP(app->args[2]) - && SCHEME_INTP(app->args[3]) - && (SCHEME_INT_VAL(app->args[3]) >= 0) - && SCHEME_INTP(app->args[4]) - && (SCHEME_INT_VAL(app->args[4]) >= 0) - && ((app->num_args < 5) - || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info, - deeper_than + (resolved ? app->num_args : 0), 0)) - && ((app->num_args < 6) - || SCHEME_NULLP(app->args[6])) - && ((app->num_args < 7) - || SCHEME_FALSEP(app->args[7]) - || is_current_inspector_call(app->args[7])) - && ((app->num_args < 8) - || SCHEME_FALSEP(app->args[8]) - || is_proc_spec_proc(app->args[8])) - && ((app->num_args < 9) - || SCHEME_NULLP(app->args[9]))) { + if (scheme_is_simple_make_struct_type(o, vals, resolved, 0)) { + if ((app->num_args < 5) + /* auto-field value: */ + || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info, + deeper_than + (resolved ? app->num_args : 0), 0)) { return 1; } } @@ -445,6 +390,216 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, return 0; } +static int is_current_inspector_call(Scheme_Object *a) +{ + if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) { + Scheme_App_Rec *app = (Scheme_App_Rec *)a; + if (!app->num_args + && SAME_OBJ(app->args[0], scheme_current_inspector_proc)) + return 1; + } + return 0; +} + +static int is_proc_spec_proc(Scheme_Object *p) +{ + Scheme_Type vtype; + + if (SCHEME_PROCP(p)) { + p = scheme_get_or_check_arity(p, -1); + if (SCHEME_INTP(p)) { + return (SCHEME_INT_VAL(p) >= 1); + } else if (SCHEME_STRUCTP(p) + && scheme_is_struct_instance(scheme_arity_at_least, p)) { + p = ((Scheme_Structure *)p)->slots[0]; + if (SCHEME_INTP(p)) + return (SCHEME_INT_VAL(p) >= 1); + } + return 0; + } + + vtype = SCHEME_TYPE(p); + + if (vtype == scheme_unclosed_procedure_type) { + if (((Scheme_Closure_Data *)p)->num_params >= 1) + return 1; + } + + return 0; +} + +static int is_local_ref(Scheme_Object *e, int p, int r) +{ + return (SAME_TYPE(SCHEME_TYPE(e), scheme_local_type) + && (SCHEME_LOCAL_POS(e) >= p) + && (SCHEME_LOCAL_POS(e) < (p + r))); +} + +static int is_int_list(Scheme_Object *o, int up_to) +{ + if (SCHEME_PAIRP(o)) { + char *s, quick[8]; + Scheme_Object *e; + if (up_to <= 8) + s = quick; + else + s = (char *)scheme_malloc_atomic(up_to); + memset(s, 0, up_to); + while (SCHEME_PAIRP(o)) { + e = SCHEME_CAR(o); + o = SCHEME_CDR(o); + if (!SCHEME_INTP(e) + || (SCHEME_INT_VAL(e) < 0) + || (SCHEME_INT_VAL(e) > up_to) + || s[SCHEME_INT_VAL(e)]) + return 0; + s[SCHEME_INT_VAL(e)] = 1; + } + } + + return SCHEME_NULLP(o); +} + +static int is_values_with_accessors_and_mutators(Scheme_Object *e, int vals, int resolved) +{ + if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) { + Scheme_App_Rec *app = (Scheme_App_Rec *)e; + int delta = (resolved ? app->num_args : 0); + if (SAME_OBJ(app->args[0], scheme_values_func) + && (app->num_args == vals)) { + int i; + for (i = app->num_args; i > 0; i--) { + if (is_local_ref(app->args[1], delta, 5)) { + /* ok */ + } else if (SAME_TYPE(SCHEME_TYPE(app->args[i]), scheme_application3_type)) { + Scheme_App3_Rec *app3 = (Scheme_App3_Rec *)app->args[i]; + int delta2 = delta + (resolved ? 2 : 0); + if (SAME_OBJ(app3->rator, scheme_make_struct_field_accessor_proc)) { + if (!is_local_ref(app3->rand1, delta2+3, 1) + && SCHEME_SYMBOLP(app3->rand2)) + break; + } else if (SAME_OBJ(app3->rator, scheme_make_struct_field_mutator_proc)) { + if (!is_local_ref(app3->rand1, delta2+4, 1) + && SCHEME_SYMBOLP(app3->rand2)) + break; + } else + break; + } + } + if (i <= 0) + return 1; + } + } + + return 0; +} + +static Scheme_Object *skip_clears(Scheme_Object *body) +{ + if (SAME_TYPE(SCHEME_TYPE(body), scheme_sequence_type)) { + Scheme_Sequence *seq = (Scheme_Sequence *)body; + int i; + for (i = seq->count - 1; i--; ) { + if (!SAME_TYPE(SCHEME_TYPE(seq->array[i]), scheme_local_type)) + break; + } + if (i < 0) + return seq->array[seq->count-1]; + } + return body; +} + +int scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int resolved, int check_auto) +/* Checks whether it's a `make-struct-type' call that certainly succeeds + (i.e., no exception) --- pending a check of argument 5 if !check_auto */ +{ + if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) { + if ((vals == 5) || (vals < 0)) { + Scheme_App_Rec *app = (Scheme_App_Rec *)e; + + if ((app->num_args >= 4) && (app->num_args <= 11) + && SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) { + if (SCHEME_SYMBOLP(app->args[1]) + && SCHEME_FALSEP(app->args[2]) /* super = #f */ + && SCHEME_INTP(app->args[3]) + && (SCHEME_INT_VAL(app->args[3]) >= 0) + && SCHEME_INTP(app->args[4]) + && (SCHEME_INT_VAL(app->args[4]) >= 0) + && ((app->num_args < 5) + /* auto-field value: */ + || !check_auto + || scheme_omittable_expr(app->args[5], 1, 3, resolved, NULL, -1, 0)) + && ((app->num_args < 6) + /* no properties: */ + || SCHEME_NULLP(app->args[6])) + && ((app->num_args < 7) + /* inspector: */ + || SCHEME_FALSEP(app->args[7]) + || is_current_inspector_call(app->args[7])) + && ((app->num_args < 8) + /* propcedure property: */ + || SCHEME_FALSEP(app->args[8]) + || is_proc_spec_proc(app->args[8])) + && ((app->num_args < 9) + /* immutables: */ + || is_int_list(app->args[9], + SCHEME_INT_VAL(app->args[3]))) + && ((app->num_args < 10) + /* guard: */ + || SCHEME_FALSEP(app->args[10])) + && ((app->num_args < 11) + /* constructor name: */ + || SCHEME_FALSEP(app->args[11]) + || SCHEME_SYMBOLP(app->args[11]))) { + return 1; + } + } + } + } + + if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_let_void_type)) { + /* check for (let-values ([(: mk ? ref- set-!) (make-struct-type ...)]) (values ...)) + as generated by the expansion of `struct' */ + Scheme_Let_Header *lh = (Scheme_Let_Header *)e; + if ((lh->count == 5) && (lh->num_clauses == 1)) { + if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) { + Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body; + if (SAME_TYPE(SCHEME_TYPE(lv->value), scheme_application_type) + && scheme_is_simple_make_struct_type(lv->value, 5, resolved, check_auto)) { + /* We have (let-values ([... (make-struct-type)]) ....), so make sure body + just uses `make-struct-field-{accessor,mutator}'. */ + if (is_values_with_accessors_and_mutators(lv->body, vals, resolved)) + return 1; + } + } + } + } + + if (SAME_TYPE(SCHEME_TYPE(e), scheme_let_void_type)) { + /* same thing, but in resolved form */ + Scheme_Let_Void *lvd = (Scheme_Let_Void *)e; + if (lvd->count == 5) { + if (SAME_TYPE(SCHEME_TYPE(lvd->body), scheme_let_value_type)) { + Scheme_Let_Value *lv = (Scheme_Let_Value *)lvd->body; + if ((lv->position == 0) && (lv->count == 5)) { + Scheme_Object *e2; + e2 = skip_clears(lv->value); + if (SAME_TYPE(SCHEME_TYPE(e2), scheme_application_type) + && scheme_is_simple_make_struct_type(e2, 5, resolved, check_auto)) { + /* We have (let-values ([... (make-struct-type)]) ....), so make sure body + just uses `make-struct-field-{accessor,mutator}'. */ + e2 = skip_clears(lv->body); + if (is_values_with_accessors_and_mutators(e2, vals, resolved)) + return 1; + } + } + } + } + } + + return 0; +} + static int single_valued_noncm_expression(Scheme_Object *expr, int fuel) /* Non-omittable but single-valued expresions that are not sensitive to being in tail position. */ @@ -4550,21 +4705,19 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) e = SCHEME_VEC_ELS(e)[1]; n = scheme_list_length(vars); - if (n == 1) { - if (IS_COMPILED_PROC(e)) { - Scheme_Toplevel *tl; + if ((n == 1) && IS_COMPILED_PROC(e)) { + Scheme_Toplevel *tl; - tl = (Scheme_Toplevel *)SCHEME_CAR(vars); - - if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { - int pos; - if (!consts) - consts = scheme_make_hash_table(SCHEME_hash_ptr); - pos = tl->position; - scheme_hash_set(consts, - scheme_make_integer(pos), - estimate_closure_size(e)); - } + tl = (Scheme_Toplevel *)SCHEME_CAR(vars); + + if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { + int pos; + if (!consts) + consts = scheme_make_hash_table(SCHEME_hash_ptr); + pos = tl->position; + scheme_hash_set(consts, + scheme_make_integer(pos), + estimate_closure_size(e)); } } } @@ -4625,56 +4778,60 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) cnst = 1; sproc = 1; } + } else if (scheme_is_simple_make_struct_type(e, n, 0, 1)) { + cnst = 1; } if (cnst) { Scheme_Toplevel *tl; + while (n--) { + tl = (Scheme_Toplevel *)SCHEME_CAR(vars); + vars = SCHEME_CDR(vars); - tl = (Scheme_Toplevel *)SCHEME_CAR(vars); + if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { + Scheme_Object *e2; - if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) { - Scheme_Object *e2; - - if (sproc) { - e2 = scheme_make_noninline_proc(e); - } else if (IS_COMPILED_PROC(e)) { - e2 = optimize_clone(1, e, info, 0, 0); - if (e2) { - Scheme_Object *pr; - pr = scheme_make_raw_pair(scheme_make_raw_pair(e2, e), NULL); - if (cl_last) - SCHEME_CDR(cl_last) = pr; - else - cl_first = pr; - cl_last = pr; - } else + if (sproc) { e2 = scheme_make_noninline_proc(e); - } else { - e2 = e; - } + } else if (IS_COMPILED_PROC(e)) { + e2 = optimize_clone(1, e, info, 0, 0); + if (e2) { + Scheme_Object *pr; + pr = scheme_make_raw_pair(scheme_make_raw_pair(e2, e), NULL); + if (cl_last) + SCHEME_CDR(cl_last) = pr; + else + cl_first = pr; + cl_last = pr; + } else + e2 = scheme_make_noninline_proc(e); + } else { + e2 = e; + } - if (e2) { - int pos; - if (!consts) - consts = scheme_make_hash_table(SCHEME_hash_ptr); - pos = tl->position; - scheme_hash_set(consts, scheme_make_integer(pos), e2); - if (!re_consts) - re_consts = scheme_make_hash_table(SCHEME_hash_ptr); - scheme_hash_set(re_consts, scheme_make_integer(i_m), - scheme_make_integer(pos)); - } else { - /* At least mark it as fixed */ + if (e2) { + int pos; + if (!consts) + consts = scheme_make_hash_table(SCHEME_hash_ptr); + pos = tl->position; + scheme_hash_set(consts, scheme_make_integer(pos), e2); + if (!re_consts) + re_consts = scheme_make_hash_table(SCHEME_hash_ptr); + scheme_hash_set(re_consts, scheme_make_integer(i_m), + scheme_make_integer(pos)); + } else { + /* At least mark it as fixed */ - if (!fixed_table) { - fixed_table = scheme_make_hash_table(SCHEME_hash_ptr); - if (!consts) - consts = scheme_make_hash_table(SCHEME_hash_ptr); - scheme_hash_set(consts, scheme_false, (Scheme_Object *)fixed_table); - } - scheme_hash_set(fixed_table, scheme_make_integer(tl->position), scheme_true); - } - } + if (!fixed_table) { + fixed_table = scheme_make_hash_table(SCHEME_hash_ptr); + if (!consts) + consts = scheme_make_hash_table(SCHEME_hash_ptr); + scheme_hash_set(consts, scheme_false, (Scheme_Object *)fixed_table); + } + scheme_hash_set(fixed_table, scheme_make_integer(tl->position), scheme_true); + } + } + } } else { /* The binding is not inlinable/propagatable, but unless it's set!ed, it is constant after evaluating the definition. We diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index c81e6053a8..0311f11072 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -371,6 +371,8 @@ extern Scheme_Object *scheme_hash_ref_proc; extern Scheme_Object *scheme_box_proc; extern Scheme_Object *scheme_call_with_values_proc; extern Scheme_Object *scheme_make_struct_type_proc; +extern Scheme_Object *scheme_make_struct_field_accessor_proc; +extern Scheme_Object *scheme_make_struct_field_mutator_proc; extern Scheme_Object *scheme_current_inspector_proc; extern Scheme_Object *scheme_varref_const_p_proc; @@ -2869,6 +2871,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, int scheme_might_invoke_call_cc(Scheme_Object *value); int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator); int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expected_vals); +int scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, int resolved, int check_auto); int scheme_is_env_variable_boxed(Scheme_Comp_Env *env, int which); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index eec864f698..b3c0fa8679 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.3.1.2" +#define MZSCHEME_VERSION "5.3.1.3" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/racket/src/struct.c b/src/racket/src/struct.c index 02c7e349a2..501a8481c1 100644 --- a/src/racket/src/struct.c +++ b/src/racket/src/struct.c @@ -36,6 +36,8 @@ READ_ONLY Scheme_Object *scheme_equal_property; READ_ONLY Scheme_Object *scheme_no_arity_property; READ_ONLY Scheme_Object *scheme_impersonator_of_property; READ_ONLY Scheme_Object *scheme_make_struct_type_proc; +READ_ONLY Scheme_Object *scheme_make_struct_field_accessor_proc; +READ_ONLY Scheme_Object *scheme_make_struct_field_mutator_proc; READ_ONLY Scheme_Object *scheme_current_inspector_proc; READ_ONLY Scheme_Object *scheme_recur_symbol; READ_ONLY Scheme_Object *scheme_display_symbol; @@ -553,15 +555,20 @@ scheme_init_struct (Scheme_Env *env) 3, 3), env); + REGISTER_SO(scheme_make_struct_field_accessor_proc); + scheme_make_struct_field_accessor_proc = scheme_make_prim_w_arity(make_struct_field_accessor, + "make-struct-field-accessor", + 2, 3); scheme_add_global_constant("make-struct-field-accessor", - scheme_make_prim_w_arity(make_struct_field_accessor, - "make-struct-field-accessor", - 2, 3), + scheme_make_struct_field_accessor_proc, env); + + REGISTER_SO(scheme_make_struct_field_mutator_proc); + scheme_make_struct_field_mutator_proc = scheme_make_prim_w_arity(make_struct_field_mutator, + "make-struct-field-mutator", + 2, 3); scheme_add_global_constant("make-struct-field-mutator", - scheme_make_prim_w_arity(make_struct_field_mutator, - "make-struct-field-mutator", - 2, 3), + scheme_make_struct_field_mutator_proc, env); scheme_add_global_constant("wrap-evt", diff --git a/src/racket/src/validate.c b/src/racket/src/validate.c index a17a87389c..820ab6da3c 100644 --- a/src/racket/src/validate.c +++ b/src/racket/src/validate.c @@ -363,6 +363,8 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port, tl_state, tl_timestamp, NULL, !!only_var, 0, vc, 0, 0, NULL, size-1); + if (scheme_is_simple_make_struct_type(val, size-1, 1, 1)) + result = 2; flags = SCHEME_TOPLEVEL_READY; if (result == 2) { @@ -1412,7 +1414,10 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr, check_self_call_valid(app->args[0], port, vc, delta, stack); if (result) { - r = scheme_is_functional_primitive(app->args[0], app->num_args, expected_results); + if (scheme_is_simple_make_struct_type((Scheme_Object *)app, expected_results, 1, 1)) + r = 2; + else + r = scheme_is_functional_primitive(app->args[0], app->num_args, expected_results); result = validate_join(result, r); } }