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

recognize `struct' bindings as constant

Browse Source 
The JIT takes advantage of known-constant bindings to avoid the
check that a variable is still bound to a structure predicate,
selector, or mutator; that makes the code short enough to really
inline. The inlined version takes about half the time of the
indirect version.

The compiler does not yet track bindings precisely enough to
recognize constants for sub-type declarations.
This commit is contained in:
Matthew Flatt 2012-10-26 08:50:37 -07:00
parent 8bc3b70a3c
commit 736e6efc2d
12 changed files with 783 additions and 345 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
collects/tests/racket/benchmarks/shootout/binarytrees-normal.rkt Normal file
View File

@ -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)))

62
src/racket/src/cstartup.inc
View File

@ -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,

10
src/racket/src/eval.c
View File

@ -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;
}
}
}

11
src/racket/src/jit.h
View File

@ -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 */
/**********************************************************************/

382
src/racket/src/jitcommon.c
View File

@ -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);
}
}

121
src/racket/src/jitinline.c
View File

@ -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;
}

39
src/racket/src/module.c
View File

@ -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);
}

421
src/racket/src/optimize.c
View File

@ -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

3
src/racket/src/schpriv.h
View File

@ -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);

4
src/racket/src/schvers.h
View File

@ -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)

19
src/racket/src/struct.c
View File

@ -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",

7
src/racket/src/validate.c
View File

@ -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);
}
}