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

xform: fix bad parsing of array sizes

Browse Source 
A size expression N+M for a literal integer N was parsed as just N.
Report an error when that case happens (since it's difficult to
handle) instead of mishandling it.

Merge to v6.1
(cherry picked from commit e063b654fa)
This commit is contained in:
Matthew Flatt 2014-07-13 18:03:57 +01:00 committed by Ryan Culpepper
parent e6b1ffa1fb
commit 47aa868b0d
1 changed files with 43 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -992,7 +992,13 @@
(apply + (map get-variable-size (apply + (map get-variable-size
(map cdr (cdr m)))))]) (map cdr (cdr m)))))])
(if (struct-array-type? vtype) (if (struct-array-type? vtype)
(* size (struct-array-type-count vtype)) (* size
(let ([c (struct-array-type-count vtype)])
(cond
[(eq? c 'unknown)
(log-error "[STRUCT ARRAY]: Can't get size of unknown-sized array")
1]
[else c])))
size))] size))]
[(vtype? vtype) 1] [(vtype? vtype) 1]
[else (error 'get-variable-size "not a vtype: ~e" [else (error 'get-variable-size "not a vtype: ~e"
@ -1130,7 +1136,10 @@
(printf "~aPUSHUNION(~a, ~a~a)" comma full-name n plus) (printf "~aPUSHUNION(~a, ~a~a)" comma full-name n plus)
(add1 n)] (add1 n)]
[(array-type? vtype) [(array-type? vtype)
(printf "~aPUSHARRAY(~a, ~a, ~a~a)" comma full-name (array-type-count vtype) n plus) (define c (array-type-count vtype))
(when (eq? c 'unknown)
(log-error "[ARRAY]: Can't push unknown array size onto mark stack: ~a." full-name))
(printf "~aPUSHARRAY(~a, ~a, ~a~a)" comma full-name (if (eq? c 'unknown) 0 c) n plus)
(+ 3 n)] (+ 3 n)]
[(struc-type? vtype) [(struc-type? vtype)
(let aloop ([array-index 0][n n][comma comma]) (let aloop ([array-index 0][n n][comma comma])
@ -1138,7 +1147,14 @@
(let loop ([n n][l (cdr (lookup-struct-def (struc-type-struct vtype)))][comma comma]) (let loop ([n n][l (cdr (lookup-struct-def (struc-type-struct vtype)))][comma comma])
(if (null? l) (if (null? l)
(if (and (struct-array-type? vtype) (if (and (struct-array-type? vtype)
(< (add1 array-index) (struct-array-type-count vtype))) (< (add1 array-index)
(let ([c (struct-array-type-count vtype)])
(cond
[(eq? c 'unknown)
(log-error "[STRUCT ARRAY]: Can't push with unknown array size: ~a."
full-name)
1]
[else c]))))
;; Next in array ;; Next in array
(aloop (add1 array-index) n comma) (aloop (add1 array-index) n comma)
;; All done ;; All done
@ -1965,11 +1981,14 @@
;; Array decl: ;; Array decl:
(loop (sub1 l) (loop (sub1 l)
(let ([inner (seq->list (seq-in (list-ref e l)))]) (let ([inner (seq->list (seq-in (list-ref e l)))])
(if (null? inner) (cond
[(null? inner)
(if empty-array-is-ptr? (if empty-array-is-ptr?
'pointer 'pointer
0) 0)]
(tok-n (car inner)))) [(= 1 (length inner))
(tok-n (car inner))]
[else 'unknown]))
pointers non-pointers)] pointers non-pointers)]
[(braces? v) [(braces? v)
;; No more variable declarations ;; No more variable declarations
@ -2002,13 +2021,14 @@
(union-type? (cdr base-is-ptr?))))] (union-type? (cdr base-is-ptr?))))]
[struct-array? (or (and base-struct (not pointer?) (number? array-size)) [struct-array? (or (and base-struct (not pointer?) (number? array-size))
(and base-is-ptr? (struct-array-type? (cdr base-is-ptr?))))] (and base-is-ptr? (struct-array-type? (cdr base-is-ptr?))))]
[array-size (if (number? array-size) [array-size (if (or (number? array-size) (eq? array-size 'unknown))
array-size array-size
(and struct-array? (and struct-array?
(struct-array-type-count (cdr base-is-ptr?))))]) (struct-array-type-count (cdr base-is-ptr?))))])
(when (and struct-array? (when (and struct-array?
(not union-ok?) (not union-ok?)
(> array-size 16)) (and (number? array-size)
(> array-size 16)))
(log-error "[SIZE] ~a in ~a: Large array of structures at ~a." (log-error "[SIZE] ~a in ~a: Large array of structures at ~a."
(tok-line v) (tok-file v) name)) (tok-line v) (tok-file v) name))
(when (and (not union-ok?) (when (and (not union-ok?)
@ -2042,7 +2062,7 @@
(cond (cond
[struct-array? [struct-array?
(format "struct ~a[~a] " base-struct array-size)] (format "struct ~a[~a] " base-struct array-size)]
[(number? array-size) [(or (number? array-size) (eq? array-size 'unknown))
(format "[~a] " array-size)] (format "[~a] " array-size)]
[(and base-struct (not pointer?)) [(and base-struct (not pointer?))
(format "struct ~a " base-struct)] (format "struct ~a " base-struct)]
@ -2055,7 +2075,7 @@
(cond (cond
[struct-array? [struct-array?
(make-struct-array-type base-struct array-size)] (make-struct-array-type base-struct array-size)]
[(number? array-size) [(or (number? array-size) (eq? array-size 'unknown))
(make-array-type array-size)] (make-array-type array-size)]
[pointer? (make-pointer-type (or (and base (list base)) [pointer? (make-pointer-type (or (and base (list base))
non-ptr-base) non-ptr-base)
@ -2970,7 +2990,9 @@
null] null]
[(array-type? vtype) [(array-type? vtype)
(let ([c (array-type-count vtype)]) (let ([c (array-type-count vtype)])
(if (<= c 3) (when (eq? c 'unknown)
(log-error "[ARRAY]: Can't initialize array of unknown: ~a." full-name))
(if (and (number? c) (<= c 3))
(let loop ([n 0]) (let loop ([n 0])
(if (= n c) (if (= n c)
null null
@ -2989,7 +3011,14 @@
(let loop ([l (cdr (lookup-struct-def (struc-type-struct vtype)))]) (let loop ([l (cdr (lookup-struct-def (struc-type-struct vtype)))])
(if (null? l) (if (null? l)
(if (and (struct-array-type? vtype) (if (and (struct-array-type? vtype)
(< (add1 array-index) (struct-array-type-count vtype))) (< (add1 array-index)
(let ([c (struct-array-type-count vtype)])
(cond
[(eq? c 'unknown)
(log-error "[STRUCT ARRAY]: Can't initialize with unknown array size: ~a."
full-name)
1]
[else c]))))
;; Next in array ;; Next in array
(aloop (add1 array-index)) (aloop (add1 array-index))
;; All done ;; All done