fix JIT bug related to bad struct-field mutators
We can't disallow the creation of bad mutators without breaking old code, but we can prevent the JIT from treating them like good ones. Closes PR 13062
This commit is contained in:
parent
23722e64c2
commit
bd8e1e8b1f
|
@ -1071,6 +1071,31 @@
|
|||
(test #f prefab-key? '#(apple))
|
||||
(test #t prefab-key? '(apple 4))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; We can make a bogus mutator, but we can't apply it:
|
||||
|
||||
(let ()
|
||||
;; Test based on code from dmarshall:
|
||||
(define-values (struct:thing make-thing thing? thing-ref thing-set!)
|
||||
(make-struct-type
|
||||
'thing #f 1 0
|
||||
#f ; auto val
|
||||
(list) ; property list
|
||||
#f ; inspector
|
||||
#f ; proc-spec
|
||||
(list 0))) ; immutables
|
||||
|
||||
(define thing.id (make-struct-field-accessor thing-ref 0))
|
||||
(define thing.id! (make-struct-field-mutator thing-set! 0))
|
||||
|
||||
(test #t struct-mutator-procedure? thing.id!)
|
||||
(err/rt-test (thing.id! 'new-val))
|
||||
|
||||
(let ([f #f])
|
||||
;; defeat inlining to ensure that thunk is JITted:
|
||||
(set! f (lambda () (thing.id! (make-thing 1) 'new-val)))
|
||||
(err/rt-test (f))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
@ -681,6 +681,7 @@ typedef struct Scheme_Offset_Cptr
|
|||
#define SCHEME_PRIM_STRUCT_TYPE_CONSTR 128
|
||||
#define SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER 256
|
||||
#define SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER (128 | 256)
|
||||
#define SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER (32 | 128)
|
||||
#define SCHEME_PRIM_TYPE_PARAMETER 64
|
||||
#define SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER (64 | 128)
|
||||
#define SCHEME_PRIM_SOMETIMES_INLINED (64 | 256)
|
||||
|
|
|
@ -2591,6 +2591,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_CONSTR)
|
||||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER)
|
||||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER)
|
||||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER)
|
||||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER)
|
||||
|| (kind == SCHEME_PRIM_STRUCT_TYPE_PRED)) {
|
||||
print_named(obj, "struct-procedure",
|
||||
|
|
|
@ -1325,7 +1325,7 @@ static Scheme_Object *guard_property(Scheme_Object *prop, Scheme_Object *v, Sche
|
|||
if (SCHEME_INTP(v)) {
|
||||
intptr_t pos;
|
||||
pos = SCHEME_INT_VAL(orig_v);
|
||||
if (!t->immutables || !t->immutables[pos]) {
|
||||
if (!t->immutables || !t->immutables[pos]) {
|
||||
scheme_contract_error("make-struct-type",
|
||||
"field is not specified as immutable for a prop:procedure index",
|
||||
"index", 1, orig_v,
|
||||
|
@ -3040,7 +3040,8 @@ struct_setter_p(int argc, Scheme_Object *argv[])
|
|||
Scheme_Object *v = argv[0];
|
||||
if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v);
|
||||
return ((STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER)
|
||||
|| STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER))
|
||||
|| STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER)
|
||||
|| STRUCT_mPROCP(v, SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER))
|
||||
? scheme_true : scheme_false);
|
||||
}
|
||||
|
||||
|
@ -3827,6 +3828,8 @@ make_struct_proc(Scheme_Struct_Type *struct_type,
|
|||
2 + need_pos, 2 + need_pos, 0);
|
||||
if (need_pos)
|
||||
flags |= SCHEME_PRIM_STRUCT_TYPE_INDEXLESS_SETTER;
|
||||
else if (struct_type->immutables && struct_type->immutables[field_num])
|
||||
flags |= SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER;
|
||||
else
|
||||
flags |= SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER;
|
||||
/* See note above:
|
||||
|
@ -3844,7 +3847,8 @@ Scheme_Object *scheme_rename_struct_proc(Scheme_Object *p, Scheme_Object *sym)
|
|||
if (SCHEME_PRIMP(p)) {
|
||||
unsigned short flags = ((Scheme_Primitive_Proc *)p)->pp.flags;
|
||||
int is_getter = ((flags & SCHEME_PRIM_OTHER_TYPE_MASK) == SCHEME_PRIM_STRUCT_TYPE_INDEXED_GETTER);
|
||||
int is_setter = ((flags & SCHEME_PRIM_OTHER_TYPE_MASK) == SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER);
|
||||
int is_setter = (((flags & SCHEME_PRIM_OTHER_TYPE_MASK) == SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER)
|
||||
|| ((flags & SCHEME_PRIM_OTHER_TYPE_MASK) == SCHEME_PRIM_STRUCT_TYPE_BROKEN_INDEXED_SETTER));
|
||||
|
||||
if (is_getter || is_setter) {
|
||||
const char *func_name;
|
||||
|
|
Loading…
Reference in New Issue
Block a user