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

Windows: another PE update fix

Browse Source 
Corrects problems with a4d569ae31 to unbreak MinGW-based builds.
This commit is contained in:
Matthew Flatt 2016-03-31 14:40:39 -06:00
parent 236b17f625
commit 161a9edb57
1 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
racket/collects/compiler/private/pe-rsrc.rkt
View File

@ -439,15 +439,18 @@
[else [else
(log-pe-rsrc-debug "moving resources to end") (log-pe-rsrc-debug "moving resources to end")
(define earliest-section-file-position (define (check-extra-header-ok)
(for/fold ([p (section-file-position (car (pe-sections pe)))]) ([s (in-list (pe-sections pe))]) (define earliest-section-file-position
(min p (section-file-position s)))) (for/fold ([p (section-file-position (car (pe-sections pe)))]) ([s (in-list (pe-sections pe))])
(log-pe-rsrc-debug "earliest section at ~x" earliest-section-file-position) (if (zero? (section-file-position s))
p
(min p (section-file-position s)))))
(log-pe-rsrc-debug "earliest section at ~x" earliest-section-file-position)
(unless (> earliest-section-file-position (unless (> earliest-section-file-position
(+ (* SECTION-HEADER-SIZE (length (pe-sections pe))) (+ (* SECTION-HEADER-SIZE (length (pe-sections pe)))
(pe-section-start-pos pe))) (pe-section-start-pos pe)))
(error 'update-resources "no room for a new section header")) (error 'update-resources "no room for a new section header")))
(define new-virtual-addr (define new-virtual-addr
(same-alignment (same-alignment
@ -479,15 +482,22 @@
new-virtual-size new-virtual-size
new-position) new-position)
(define need-new-section?
(for/or ([s2 (in-list (pe-sections pe))]
#:unless (eq? s s2))
((section-virtual-addr s2) . > . (section-virtual-addr s))))
(define new-sections (define new-sections
(sort (cons (sort (append
(section (if need-new-section?
#".DROPpe\0" (list (section
(section-virtual-size s) #".DROPpe\0"
(section-virtual-addr s) (section-virtual-size s)
(section-file-length s) (section-virtual-addr s)
(section-file-position s) (section-file-length s)
(section-characteristics s)) (section-file-position s)
(section-characteristics s)))
null)
(for/list ([s2 (in-list (pe-sections pe))]) (for/list ([s2 (in-list (pe-sections pe))])
(if (eq? s s2) (if (eq? s s2)
(section (section-name s) (section (section-name s)