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

add XFORM_NONGCING_NONALIASING annotation

Browse Source 
An `XFORM_NONGCING_NONALIASING` function doesn't trigger a GC, and
when it is given an argument that is an address of a local variable,
it fills in that address and doesn't leak it. This annotation allows
the xform transformation (to support precise GC) avoid some work for
some hash-iteration functions.
This commit is contained in:
Matthew Flatt 2016-02-28 17:09:45 -07:00
parent 8a59534669
commit 3b25e22dd6
8 changed files with 56 additions and 27 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.4.0.10")
(define version "6.4.0.11")
(define deps `("racket-lib"
["racket" #:version ,version]))

39
racket/collects/compiler/private/xform.rkt
View File

@ -741,6 +741,7 @@
(printf "#define GC_CAN_IGNORE /**/\n")
(printf "#define XFORM_CAN_IGNORE /**/\n")
(printf "#define __xform_nongcing__ /**/\n")
(printf "#define __xform_nongcing_nonaliasing__ /**/\n")
;; Another annotation to protect against GC conversion:
(printf "#define HIDE_FROM_XFORM(x) x\n")
(printf "#define XFORM_HIDE_EXPR(x) x\n")
@ -959,7 +960,13 @@
(for-each (lambda (name)
(hash-set! non-gcing-functions name #t))
non-gcing-builtin-functions)
;; Non-aliasing function may take address of variables as arguments to fill
;; them in, but they don't expose those addresses, so taking a variable's
;; address for an argument doesn't make it live for the rest of the enclosing
;; function.
(define non-aliasing-functions (make-hasheq))
(define non-returning-functions
;; The following functions never return, so the wrappers
;; don't need to push any variables:
@ -1122,8 +1129,9 @@
(set! struct-defs (list-ref l 6))
(set! non-gcing-functions (hash-copy (list-ref l 7)))
(set! non-aliasing-functions (hash-copy (list-ref l 8)))
(set! gc-var-stack-mode (list-ref l 8))))))
(set! gc-var-stack-mode (list-ref l 9))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Pretty-printing output
@ -1560,6 +1568,9 @@
(let ([name (register-proto-information e)])
(when (eq? (tok-n (car e)) '__xform_nongcing__)
(hash-set! non-gcing-functions name #t))
(when (eq? (tok-n (car e)) '__xform_nongcing_nonaliasing__)
(hash-set! non-gcing-functions name #t)
(hash-set! non-aliasing-functions name #t))
(when show-info?
(printf "/* PROTO ~a */\n" name))
(if (or precompiling-header?
@ -1594,6 +1605,9 @@
(let ([name (register-proto-information e)])
(when (eq? (tok-n (car e)) '__xform_nongcing__)
(hash-set! non-gcing-functions name #t))
(when (eq? (tok-n (car e)) '__xform_nongcing_nonaliasing__)
(hash-set! non-gcing-functions name #t)
(hash-set! non-aliasing-functions name #t))
(if (skip-function? e)
e
(begin
@ -1866,7 +1880,8 @@
(if (pair? t)
(if (or (memq (tok-n (car t)) '(extern static virtual __stdcall __cdecl
inline _inline __inline __inline__
__xform_nongcing__))
__xform_nongcing__
__xform_nongcing_nonaliasing__))
(equal? "C" (tok-n (car t))))
(loop (cdr t))
(cons (car t) (loop (cdr t))))
@ -2541,7 +2556,7 @@
e
(lambda (name class-name type args static?)
type)))])
(if (hash-ref non-gcing-functions name (lambda () #f))
(if (hash-ref non-gcing-functions name #f)
(when saw-gcing-call
(log-error "[GCING] ~a in ~a: Function ~a declared __xform_nongcing__, but includes a function call at ~s."
(tok-line saw-gcing-call) (tok-file saw-gcing-call)
@ -3903,6 +3918,21 @@
null]
[(pragma? (car e))
(loop (cdr e))]
[(and (pair? (cdr e))
(parens? (cadr e))
(hash-ref non-aliasing-functions (tok-n (car e)) #f))
;; A call to a non-aliasing function: drop immediate '&'s on args:
(define (drop-&s now? e)
(cond
[(null? e) null]
[(and now? (eq? '& (tok-n (car e))))
(drop-&s #f (cdr e))]
[(eq? '|,| (tok-n (car e)))
(cons (car e) (drop-&s #t (cdr e)))]
[else
(cons (car e) (drop-&s #f (cdr e)))]))
(append (loop (drop-&s #t (seq->list (seq-in (cadr e)))))
(loop (cddr e)))]
[(eq? '& (tok-n (car e)))
(if (null? (cdr e))
null
@ -4121,6 +4151,7 @@
(marshall non-pointer-types)
(marshall struct-defs)
non-gcing-functions
non-aliasing-functions
(list 'quote gc-var-stack-mode))])
(with-output-to-file (change-suffix file-out #".zo")
(lambda ()

10
racket/src/racket/include/scheme.h
View File

@ -177,9 +177,19 @@ typedef long FILE;
#endif
#ifdef MZ_XFORM
/* A non-GCing function will never trigger a garbage collection.
The xform tool checks this declaration, and it uses this hint
to avoid registering variables unnecessarily. */
# define XFORM_NONGCING __xform_nongcing__
/* A non-GCing, non-aliasing function is non-GCing, and it may take
arguments that are addresses of local variables, but it doesn't
leak those addresses; it only filles them in. The xform tool only
checks the non-GCing part of this declaration, but uses both
facets of the hint. */
# define XFORM_NONGCING_NONALIASING __xform_nongcing_nonaliasing__
#else
# define XFORM_NONGCING /* empty */
# define XFORM_NONGCING_NONALIASING /* empty */
#endif
#ifdef MZ_XFORM

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

@ -4029,7 +4029,7 @@ Scheme_Object *unsafe_hash_table_iterate_next(int argc, Scheme_Object *argv[])
return NULL;
}
static Scheme_Object *unsafe_hash_table_iterate_key_slow(int argc, Scheme_Object *argv[])
Scheme_Object *unsafe_hash_table_iterate_key(int argc, Scheme_Object *argv[])
{
GC_CAN_IGNORE const char *name = "unsafe-mutable-hash-iterate-key";
Scheme_Object *obj = argv[0], *key;
@ -4047,18 +4047,6 @@ static Scheme_Object *unsafe_hash_table_iterate_key_slow(int argc, Scheme_Object
return NULL;
}
Scheme_Object *unsafe_hash_table_iterate_key(int argc, Scheme_Object *argv[])
{
Scheme_Object *obj = argv[0], *key;
mzlonglong pos = SCHEME_INT_VAL(argv[1]);
if (!SCHEME_NP_CHAPERONEP(obj)
&& scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, NULL))
return key;
else
return unsafe_hash_table_iterate_key_slow(argc, argv);
}
static Scheme_Object *unsafe_hash_table_iterate_value_slow(int argc, Scheme_Object *argv[])
{
GC_CAN_IGNORE const char *name = "unsafe-mutable-hash-iterate-value";
@ -4162,7 +4150,7 @@ Scheme_Object *unsafe_hash_tree_iterate_key(int argc, Scheme_Object *argv[])
scheme_unsafe_hash_tree_subtree(obj, args, &subtree, &i);
key = subtree->els[i];
if (!SCHEME_NP_CHAPERONEP(obj))
if (SCHEME_NP_CHAPERONEP(obj))
return chaperone_hash_key("unsafe-immutable-hash-iterate-key", obj, key);
else
return key;

1
racket/src/racket/src/makex.rkt
View File

@ -60,6 +60,7 @@
[else
(let* ([l (regexp-replace #rx"^extern " l "")]
[l (regexp-replace #rx"^XFORM_NONGCING " l "")]
[l (regexp-replace #rx"^XFORM_NONGCING_NONALIASING " l "")]
[l (regexp-replace #rx"^MZ_EXTERN " l "")]
[l (regexp-replace #rx"^THREAD_LOCAL " l "")]
[l2 (regexp-replace #rx"^volatile " l "")]

6
racket/src/racket/src/schemef.h
View File

@ -498,7 +498,7 @@ MZ_EXTERN Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, co
MZ_EXTERN int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
MZ_EXTERN Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt);
MZ_EXTERN void scheme_clear_bucket_table(Scheme_Bucket_Table *bt);
XFORM_NONGCING MZ_EXTERN int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING_NONALIASING MZ_EXTERN int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING Scheme_Object *scheme_bucket_table_next(Scheme_Bucket_Table *hash, mzlonglong start);
MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table(int type);
@ -514,7 +514,7 @@ MZ_EXTERN int scheme_is_hash_table_equal(Scheme_Object *o);
MZ_EXTERN int scheme_is_hash_table_eqv(Scheme_Object *o);
MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht);
MZ_EXTERN void scheme_clear_hash_table(Scheme_Hash_Table *ht);
XFORM_NONGCING MZ_EXTERN int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING_NONALIASING MZ_EXTERN int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_hash_table_next(Scheme_Hash_Table *hash, mzlonglong start);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
@ -523,7 +523,7 @@ MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_
MZ_EXTERN Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
XFORM_NONGCING MZ_EXTERN mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos);
XFORM_NONGCING MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
XFORM_NONGCING_NONALIASING MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
MZ_EXTERN int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
MZ_EXTERN int scheme_is_hash_tree_equal(Scheme_Object *o);
MZ_EXTERN int scheme_is_hash_tree_eqv(Scheme_Object *o);

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

@ -949,12 +949,11 @@ Scheme_Hash_Tree *scheme_hash_tree_set_w_key_wraps(Scheme_Hash_Tree *tree, Schem
Scheme_Object *key_wraps);
Scheme_Object *scheme_unsafe_hash_tree_start(Scheme_Hash_Tree *ht);
XFORM_NONGCING void scheme_unsafe_hash_tree_subtree(Scheme_Object *obj, Scheme_Object *args,
Scheme_Hash_Tree **_subtree, int *_i);
XFORM_NONGCING_NONALIASING void scheme_unsafe_hash_tree_subtree(Scheme_Object *obj, Scheme_Object *args,
Scheme_Hash_Tree **_subtree, int *_i);
XFORM_NONGCING Scheme_Object *scheme_unsafe_hash_tree_access(Scheme_Hash_Tree *subtree, int i);
Scheme_Object *scheme_unsafe_hash_tree_next(Scheme_Hash_Tree *ht, Scheme_Object *args);
Scheme_Object *scheme_hash_tree_next_pos(Scheme_Hash_Tree *tree, mzlonglong pos);
XFORM_NONGCING int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
int scheme_is_hash_tree_equal(Scheme_Object *o);
int scheme_is_hash_tree_eqv(Scheme_Object *o);

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.4.0.10"
#define MZSCHEME_VERSION "6.4.0.11"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 4
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 10
#define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)