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

xform: add XFORM_ASSERT_NO_CONVERSION

Browse Source 
A `XFORM_ASSERT_NO_CONVERSION` declaration makes xform check that
an procedure that is intended to avoid instrumentation actually
does avoid it.
This commit is contained in:
Matthew Flatt 2016-03-02 09:44:31 -07:00
parent f2e34fedea
commit 3617e1f81e
5 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -756,6 +756,7 @@
(printf "#define XFORM_START_SUSPEND /**/\n")
(printf "#define XFORM_END_SUSPEND /**/\n")
(printf "#define XFORM_SKIP_PROC /**/\n")
(printf "#define XFORM_ASSERT_NO_CONVERSION /**/\n")
;; For avoiding warnings:
(printf "#define XFORM_OK_PLUS +\n")
(printf "#define XFORM_OK_MINUS -\n")
@ -1796,7 +1797,7 @@
(define (class-decl? e)
(memq (tok-n (car e)) '(class)))
; ;Recognize a function (as opposed to a prototype):
;; Recognize a function (as opposed to a prototype):
(define (function? e)
(let ([l (length e)])
(and (> l 2)
@ -1809,6 +1810,7 @@
(let ([v (list-ref e (sub1 ll))])
(or (parens? v)
(eq? (tok-n v) 'XFORM_SKIP_PROC)
(eq? (tok-n v) 'XFORM_ASSERT_NO_CONVERSION)
;; `const' can appear between the arg parens
;; and the function body; this happens in the
;; OS X headers
@ -2419,6 +2421,9 @@
(if (eq? semi (tok-n v))
(values (list-ref e (sub1 len)) (sub1 len))
(values v len)))]
[(assert-no-conversion?)
(eq? (tok-n (list-ref e (sub1 len)))
'XFORM_ASSERT_NO_CONVERSION)]
[(body-e) (seq->list (seq-in body-v))]
[(class-name function-name func-pos)
(let loop ([e e][p 0])
@ -2433,7 +2438,9 @@
[(args-e) (seq->list (seq-in (list-ref e (if (and func-pos
(eq? class-name function-name))
(add1 func-pos)
(sub1 len)))))]
(if assert-no-conversion?
(- len 2)
(sub1 len))))))]
[(arg-vars all-arg-vars)
(let-values ([(arg-pragmas arg-decls) (body->lines (append
args-e
@ -2583,8 +2590,13 @@
(cons
(make-note 'note #f #f "/* No conversion */")
orig-body-e))
(list->seq body-e))))))))
(begin
(when assert-no-conversion?
(log-error "[CONVERSION] ~a in ~a: Function ~a declared XFORM_ASSERT_NO_CONVERSION, but requires conversion."
(tok-line (car e)) (tok-file (car e))
name))
(list->seq body-e)))))))))
(define (convert-class-vars body-e arg-vars c++-class new-vars-box)
(when c++-class
(let-values ([(pragmas el) (body->lines body-e #f)])

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

@ -237,6 +237,7 @@ typedef struct FSSpec mzFSSpec;
#ifdef MZ_PRECISE_GC
# ifndef MZ_XFORM
# define XFORM_SKIP_PROC /* empty */
# define XFORM_ASSERT_NO_CONVERSION /* empty */
# define XFORM_CAN_IGNORE /**/
# endif
#else
@ -246,6 +247,7 @@ typedef struct FSSpec mzFSSpec;
# define XFORM_START_SUSPEND /**/
# define XFORM_END_SUSPEND /**/
# define XFORM_SKIP_PROC /**/
# define XFORM_ASSERT_NO_CONVERSION /**/
# define XFORM_START_TRUST_ARITH /**/
# define XFORM_END_TRUST_ARITH /**/
# define XFORM_CAN_IGNORE /**/

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

@ -4030,6 +4030,7 @@ Scheme_Object *unsafe_hash_table_iterate_next(int argc, Scheme_Object *argv[])
}
Scheme_Object *unsafe_hash_table_iterate_key(int argc, Scheme_Object *argv[])
XFORM_ASSERT_NO_CONVERSION
{
GC_CAN_IGNORE const char *name = "unsafe-mutable-hash-iterate-key";
Scheme_Object *obj = argv[0], *key;
@ -4069,6 +4070,7 @@ static Scheme_Object *unsafe_hash_table_iterate_value_slow(int argc, Scheme_Obje
}
Scheme_Object *unsafe_hash_table_iterate_value(int argc, Scheme_Object *argv[])
XFORM_ASSERT_NO_CONVERSION
{
Scheme_Object *obj = argv[0], *key, *val;
mzlonglong pos = SCHEME_INT_VAL(argv[1]);
@ -4142,6 +4144,7 @@ Scheme_Object *unsafe_hash_tree_iterate_next(int argc, Scheme_Object *argv[])
}
Scheme_Object *unsafe_hash_tree_iterate_key(int argc, Scheme_Object *argv[])
XFORM_ASSERT_NO_CONVERSION
{
Scheme_Object *obj = argv[0], *args = argv[1], *key;
Scheme_Hash_Tree *subtree;
@ -4174,6 +4177,7 @@ static Scheme_Object *unsafe_hash_tree_iterate_value_slow(int argc, Scheme_Objec
}
Scheme_Object *unsafe_hash_tree_iterate_value(int argc, Scheme_Object *argv[])
XFORM_ASSERT_NO_CONVERSION
{
Scheme_Object *obj = argv[0], *args = argv[1];
Scheme_Hash_Tree *subtree;

2
racket/src/racket/src/portfun.c
View File

@ -432,6 +432,7 @@ static MZ_INLINE Scheme_Input_Port *input_port_record_slow(Scheme_Object *port)
}
Scheme_Input_Port *scheme_input_port_record(Scheme_Object *port)
XFORM_ASSERT_NO_CONVERSION
{
/* Avoid MZ_PRECISE_GC instrumentation in the common case: */
if (SCHEME_INPORTP(port))
@ -464,6 +465,7 @@ static MZ_INLINE Scheme_Output_Port *output_port_record_slow(Scheme_Object *port
}
Scheme_Output_Port *scheme_output_port_record(Scheme_Object *port)
XFORM_ASSERT_NO_CONVERSION
{
/* Avoid MZ_PRECISE_GC instrumentation in the common case: */
if (SCHEME_OUTPORTP(port))

1
racket/src/racket/src/symbol.c
View File

@ -102,6 +102,7 @@ static Scheme_Object *rehash_symbol_bucket(Scheme_Hash_Table *table,
static Scheme_Object *symbol_bucket(Scheme_Hash_Table *table,
GC_CAN_IGNORE const char *key, uintptr_t length,
Scheme_Object *naya)
XFORM_ASSERT_NO_CONVERSION
{
hash_v_t h, h2;
uintptr_t mask;