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

optimizer: fix guarded-constructor tracking

Browse Source 
Some parts of the optimizer were inconsistent in whether a tracked
structure type needed to have a constructor that always succeeds
(i.e., no associated guard). Increase precision to track both kinds of
structure types, and avoid some unnecessary space-safety clearing in
the vicinity of nonfailing constructors.
This commit is contained in:
Matthew Flatt 2018-03-16 08:07:01 -06:00
parent 600469d164
commit ad3ab8b352
6 changed files with 70 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.90.0.21")
(define version "6.90.0.22")
(define deps `("racket-lib"
["racket" #:version ,version]))

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

@ -442,7 +442,9 @@ int scheme_is_struct_functional(Scheme_Object *rator, int num_args, Optimize_Inf
int mode = (SCHEME_PROC_SHAPE_MODE(c) & STRUCT_PROC_SHAPE_MASK);
int field_count = (SCHEME_PROC_SHAPE_MODE(c) >> STRUCT_PROC_SHAPE_SHIFT);
if (((num_args == 1) && (mode == STRUCT_PROC_SHAPE_PRED))
|| ((num_args == field_count) && (mode == STRUCT_PROC_SHAPE_CONSTR))) {
|| ((num_args == field_count)
&& (mode == STRUCT_PROC_SHAPE_CONSTR)
&& (SCHEME_PROC_SHAPE_MODE(c) & STRUCT_PROC_SHAPE_NONFAIL_CONSTR))) {
return 1;
}
} else if (SAME_TYPE(SCHEME_TYPE(c), scheme_struct_prop_proc_shape_type)) {
@ -1398,7 +1400,8 @@ static int is_ok_value(Ok_Value_Callback ok_value, void *data,
static int ok_constant_super_value(void *data, Scheme_Object *v, int mode)
/* Is `v` a structure type (which can serve as a supertype)? */
{
Scheme_Object **_parent_identity = (Scheme_Object **)data;
Scheme_Object **_parent_identity = (Scheme_Object **)((void **)data)[0];
int *_nonfail_constr = (int *)((void **)data)[1];
if (mode == OK_CONSTANT_SHAPE) {
if (SAME_TYPE(SCHEME_TYPE(v), scheme_struct_proc_shape_type)) {
@ -1407,20 +1410,28 @@ static int ok_constant_super_value(void *data, Scheme_Object *v, int mode)
if (mode == STRUCT_PROC_SHAPE_STRUCT) {
if (_parent_identity)
*_parent_identity = SCHEME_PROC_SHAPE_IDENTITY(v);
if (_nonfail_constr)
*_nonfail_constr = SCHEME_PROC_SHAPE_MODE(v) & STRUCT_PROC_SHAPE_NONFAIL_CONSTR;
return field_count + 1;
}
}
} else if (mode == OK_CONSTANT_ENCODED_SHAPE) {
intptr_t k;
if (scheme_decode_struct_shape(v, &k)) {
if ((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT)
if ((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT) {
if (_nonfail_constr)
*_nonfail_constr = k & STRUCT_PROC_SHAPE_NONFAIL_CONSTR;
return (k >> STRUCT_PROC_SHAPE_SHIFT) + 1;
}
}
} else if (mode == OK_CONSTANT_VALIDATE_SHAPE) {
int k = SCHEME_INT_VAL(v);
if ((k >= 0)
&& (k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT)
&& (k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_STRUCT) {
if (_nonfail_constr)
*_nonfail_constr = k & STRUCT_PROC_SHAPE_NONFAIL_CONSTR;
return (k >> STRUCT_PROC_SHAPE_SHIFT) + 1;
}
} else if (mode == OK_CONSTANT_VARIANT) {
if (SCHEME_VECTORP(v) && (SCHEME_VEC_SIZE(v) == 3)) {
if (_parent_identity)
@ -1429,15 +1440,21 @@ static int ok_constant_super_value(void *data, Scheme_Object *v, int mode)
if (v && SCHEME_INTP(v)) {
int mode = (SCHEME_INT_VAL(v) & STRUCT_PROC_SHAPE_MASK);
int field_count = (SCHEME_INT_VAL(v) >> STRUCT_PROC_SHAPE_SHIFT);
if (mode == STRUCT_PROC_SHAPE_STRUCT)
if (mode == STRUCT_PROC_SHAPE_STRUCT) {
if (_nonfail_constr)
*_nonfail_constr = SCHEME_INT_VAL(v) & STRUCT_PROC_SHAPE_NONFAIL_CONSTR;
return field_count + 1;
}
}
}
} else if (mode == OK_CONSTANT_VALUE) {
if (SCHEME_STRUCT_TYPEP(v)) {
Scheme_Struct_Type *st = (Scheme_Struct_Type *)v;
if (st->num_slots == st->num_islots)
if (st->num_slots == st->num_islots) {
if (_nonfail_constr)
*_nonfail_constr = st->nonfail_constructor;
return st->num_slots + 1;
}
}
}
@ -1449,10 +1466,16 @@ static int is_constant_super(Scheme_Object *arg,
Scheme_Hash_Table *top_level_table,
Scheme_Object **runstack, int rs_delta,
Scheme_Linklet *enclosing_linklet,
Scheme_Object **_parent_identity)
Scheme_Object **_parent_identity,
int *_nonfail_constr)
/* Does `arg` produce another structure type (which can serve as a supertype)? */
{
return is_ok_value(ok_constant_super_value, _parent_identity,
void *data[2];
data[0] = _parent_identity;
data[1] = _nonfail_constr;
return is_ok_value(ok_constant_super_value, data,
arg,
info,
top_level_table,
@ -1591,7 +1614,6 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
pending a check of the auto-value argument if `flags` includes `CHECK_STRUCT_TYPE_DELAY_AUTO_CHECK`.
The expression itself must have no side-effects except for errors (but the possibility
of errors means that the expression is not necessarily omittable).
The resulting *constructor* must always succeed (i.e., no guards).
The result is the auto-value argument or scheme_true if it's simple, NULL if not.
The first result of `e` will be a struct type, the second a constructor, and the third a predicate;
the rest are selectors and mutators. */
@ -1606,7 +1628,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
if ((app->num_args >= 4) && (app->num_args <= 11)
&& SAME_OBJ(scheme_make_struct_type_proc, app->args[0])) {
int super_count_plus_one;
int super_count_plus_one, super_nonfail_constr = 1;
if (_parent_identity)
*_parent_identity = scheme_null;
@ -1614,7 +1636,8 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
super_count_plus_one = is_constant_super(app->args[2],
info, top_level_table, runstack,
rs_delta + app->num_args,
enclosing_linklet, _parent_identity);
enclosing_linklet, _parent_identity,
&super_nonfail_constr);
else
super_count_plus_one = 0;
@ -1663,7 +1686,9 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
SCHEME_INT_VAL(app->args[3])))
&& ((app->num_args < 10)
/* guard: */
|| SCHEME_FALSEP(app->args[10]))
|| SCHEME_FALSEP(app->args[10])
/* Could try to check for procedure with correct arity: */
|| !(flags & CHECK_STRUCT_TYPE_ALWAYS_SUCCEED))
&& ((app->num_args < 11)
/* constructor name: */
|| SCHEME_FALSEP(app->args[11])
@ -1694,6 +1719,8 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
enclosing_linklet,
1, &authentic))
_stinfo->authentic = authentic;
_stinfo->nonfail_constructor = (super_nonfail_constr
&& ((app->num_args < 10) || SCHEME_FALSEP(app->args[10])));
_stinfo->num_gets = 1;
_stinfo->num_sets = 1;
}
@ -1822,12 +1849,15 @@ intptr_t scheme_get_struct_proc_shape(int k, Simple_Struct_Type_Info *stinfo)
if (stinfo->field_count == stinfo->init_field_count)
return (STRUCT_PROC_SHAPE_STRUCT
| (stinfo->authentic ? STRUCT_PROC_SHAPE_AUTHENTIC : 0)
| (stinfo->nonfail_constructor ? STRUCT_PROC_SHAPE_NONFAIL_CONSTR : 0)
| (stinfo->field_count << STRUCT_PROC_SHAPE_SHIFT));
else
return STRUCT_PROC_SHAPE_OTHER;
break;
case 1:
return STRUCT_PROC_SHAPE_CONSTR | (stinfo->init_field_count << STRUCT_PROC_SHAPE_SHIFT);
return (STRUCT_PROC_SHAPE_CONSTR
| (stinfo->init_field_count << STRUCT_PROC_SHAPE_SHIFT)
| (stinfo->nonfail_constructor ? STRUCT_PROC_SHAPE_NONFAIL_CONSTR : 0));
break;
case 2:
return (STRUCT_PROC_SHAPE_PRED
@ -3845,10 +3875,11 @@ static int appn_flags(Scheme_Object *rator, Optimize_Info *info)
if (SAME_TYPE(SCHEME_TYPE(rator), scheme_proc_shape_type)) {
return APPN_FLAG_SFS_TAIL;
} else if (SAME_TYPE(SCHEME_TYPE(rator), scheme_struct_proc_shape_type)) {
int ps = SCHEME_PROC_SHAPE_MODE(rator);
int ps = SCHEME_PROC_SHAPE_MODE(rator) & STRUCT_PROC_SHAPE_MASK;
if ((ps == STRUCT_PROC_SHAPE_PRED)
|| (ps == STRUCT_PROC_SHAPE_GETTER)
|| (ps == STRUCT_PROC_SHAPE_SETTER))
|| (ps == STRUCT_PROC_SHAPE_SETTER)
|| (ps == STRUCT_PROC_SHAPE_CONSTR))
return (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
return 0;
}

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

@ -1079,6 +1079,7 @@ typedef struct Scheme_Struct_Type {
mzshort num_islots; /* initialized + parent-initialized */
mzshort name_pos;
char authentic; /* 1 => chaperones/impersonators disallowed */
char nonfail_constructor; /* 1 => constructor never fails */
Scheme_Object *name;
@ -3042,6 +3043,7 @@ typedef struct {
int normal_ops; /* are selectors and predicates in the usual order? */
int indexed_ops; /* do selectors have the index built in (as opposed to taking an index argument)? */
int authentic; /* conservatively 0 is ok */
int nonfail_constructor;
int num_gets, num_sets;
int setter_fields; /* if indexed, bitmap for first 32 fields to indicate which have setters */
} Simple_Struct_Type_Info;
@ -3077,8 +3079,9 @@ Scheme_Object *scheme_make_struct_proc_shape(intptr_t k, Scheme_Object *identity
#define STRUCT_PROC_SHAPE_SETTER 4
#define STRUCT_PROC_SHAPE_OTHER 5
#define STRUCT_PROC_SHAPE_MASK 0xF
#define STRUCT_PROC_SHAPE_AUTHENTIC 0x10
#define STRUCT_PROC_SHAPE_SHIFT 5
#define STRUCT_PROC_SHAPE_AUTHENTIC 0x10
#define STRUCT_PROC_SHAPE_NONFAIL_CONSTR 0x20
#define STRUCT_PROC_SHAPE_SHIFT 6
typedef struct Scheme_Struct_Proc_Shape {
Scheme_Object so;

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.90.0.21"
#define MZSCHEME_VERSION "6.90.0.22"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 90
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 21
#define MZSCHEME_VERSION_W 22
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -3439,6 +3439,10 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex
| STRUCT_PROC_SHAPE_STRUCT
| ((st->authentic && (!expected || (v & STRUCT_PROC_SHAPE_AUTHENTIC)))
? STRUCT_PROC_SHAPE_AUTHENTIC
: 0)
| ((st->nonfail_constructor
&& (!expected || (v & STRUCT_PROC_SHAPE_NONFAIL_CONSTR)))
? STRUCT_PROC_SHAPE_NONFAIL_CONSTR
: 0));
} else if (!SCHEME_PRIMP(e)) {
want_v = -1;
@ -3447,8 +3451,12 @@ intptr_t scheme_get_or_check_structure_shape(Scheme_Object *e, Scheme_Object *ex
if ((i == SCHEME_PRIM_STRUCT_TYPE_CONSTR)
|| (i == SCHEME_PRIM_STRUCT_TYPE_SIMPLE_CONSTR)) {
st = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(e)[0];
want_v = ((st->num_islots << STRUCT_PROC_SHAPE_SHIFT)
| STRUCT_PROC_SHAPE_CONSTR);
want_v = ((st->num_islots << STRUCT_PROC_SHAPE_SHIFT)
| STRUCT_PROC_SHAPE_CONSTR
| ((st->nonfail_constructor
&& (!expected || (v & STRUCT_PROC_SHAPE_NONFAIL_CONSTR)))
? STRUCT_PROC_SHAPE_NONFAIL_CONSTR
: 0));
} else if (i == SCHEME_PRIM_STRUCT_TYPE_PRED) {
st = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(e)[0];
want_v = (STRUCT_PROC_SHAPE_PRED
@ -4737,6 +4745,7 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base,
struct_type->num_islots = num_fields + (parent_type ? parent_type->num_islots : 0);
struct_type->name_pos = depth;
struct_type->authentic = 0;
struct_type->nonfail_constructor = 1;
struct_type->inspector = scheme_false;
struct_type->uninit_val = uninit_val;
struct_type->props = NULL;
@ -4803,6 +4812,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
}
struct_type->name = base;
struct_type->nonfail_constructor = (parent_type ? parent_type->nonfail_constructor : 1);
struct_type->num_slots = num_fields + num_uninit_fields + (parent_type ? parent_type->num_slots : 0);
struct_type->num_islots = num_fields + (parent_type ? parent_type->num_islots : 0);
@ -5066,6 +5076,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
}
struct_type->guard = guard;
struct_type->nonfail_constructor = 0;
} else if (chaperone_undefined) {
struct_type->guard = scheme_undefined;
}
@ -5073,6 +5084,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base,
if (parent && SCHEME_NP_CHAPERONEP(parent)) {
guard = add_struct_type_chaperone_guards(parent, struct_type->guard);
struct_type->guard = guard;
struct_type->nonfail_constructor = 0;
}
if (checked_proc)

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

@ -1092,7 +1092,8 @@ static int is_functional_nonfailing_rator(Scheme_Object *rator, int num_args, in
v = scheme_hash_get(*_st_ht, scheme_make_integer(pos));
if (v) {
int k = SCHEME_INT_VAL(v);
if ((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_CONSTR) {
if (((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_CONSTR)
&& (k & STRUCT_PROC_SHAPE_NONFAIL_CONSTR)) {
if (num_args == (k >> STRUCT_PROC_SHAPE_SHIFT))
return 1;
} else if ((k & STRUCT_PROC_SHAPE_MASK) == STRUCT_PROC_SHAPE_PRED) {