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

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

@ -992,7 +992,13 @@
(apply + (map get-variable-size
(map cdr (cdr m)))))])
(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))]
[(vtype? vtype) 1]
[else (error 'get-variable-size "not a vtype: ~e"
@ -1130,7 +1136,10 @@
(printf "~aPUSHUNION(~a, ~a~a)" comma full-name n plus)
(add1 n)]
[(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)]
[(struc-type? vtype)
(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])
(if (null? l)
(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
(aloop (add1 array-index) n comma)
;; All done
@ -1965,11 +1981,14 @@
;; Array decl:
(loop (sub1 l)
(let ([inner (seq->list (seq-in (list-ref e l)))])
(if (null? inner)
(if empty-array-is-ptr?
'pointer
0)
(tok-n (car inner))))
(cond
[(null? inner)
(if empty-array-is-ptr?
'pointer
0)]
[(= 1 (length inner))
(tok-n (car inner))]
[else 'unknown]))
pointers non-pointers)]
[(braces? v)
;; No more variable declarations
@ -2002,13 +2021,14 @@
(union-type? (cdr base-is-ptr?))))]
[struct-array? (or (and base-struct (not pointer?) (number? array-size))
(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
(and struct-array?
(struct-array-type-count (cdr base-is-ptr?))))])
(when (and struct-array?
(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."
(tok-line v) (tok-file v) name))
(when (and (not union-ok?)
@ -2042,7 +2062,7 @@
(cond
[struct-array?
(format "struct ~a[~a] " base-struct array-size)]
[(number? array-size)
[(or (number? array-size) (eq? array-size 'unknown))
(format "[~a] " array-size)]
[(and base-struct (not pointer?))
(format "struct ~a " base-struct)]
@ -2055,7 +2075,7 @@
(cond
[struct-array?
(make-struct-array-type base-struct array-size)]
[(number? array-size)
[(or (number? array-size) (eq? array-size 'unknown))
(make-array-type array-size)]
[pointer? (make-pointer-type (or (and base (list base))
non-ptr-base)
@ -2970,7 +2990,9 @@
null]
[(array-type? 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])
(if (= n c)
null
@ -2989,7 +3011,14 @@
(let loop ([l (cdr (lookup-struct-def (struc-type-struct vtype)))])
(if (null? l)
(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
(aloop (add1 array-index))
;; All done