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

mach-o: infer machine type instead of depending on cross information

Browse Source 
Directly inferring the machine type works more easily for some Racket
CS build steps.
This commit is contained in:
Matthew Flatt 2020-12-22 12:33:35 -07:00
parent 15ab674ef8
commit a450246ee7
1 changed files with 45 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
racket/collects/compiler/private/mach-o.rkt
View File

@ -1,17 +1,16 @@
#lang racket/base #lang racket/base
(require setup/cross-system (require racket/promise)
racket/promise)
(provide add-plt-segment (provide add-plt-segment
remove-signature remove-signature
add-ad-hoc-signature add-ad-hoc-signature
get/set-dylib-path) get/set-dylib-path)
(define exe-id (define (check-exe-id exe-id)
(delay (unless (memv exe-id '(#xFeedFacf #xFeedFace))
(if (= 64 (cross-system-type 'word)) (error 'mach-o "unrecognized #x~x" exe-id)))
#xFeedFacf
#xFeedFace))) (define aarch64-machine-type #x0100000C)
(define (read-ulong p) (define (read-ulong p)
(integer-bytes->integer (read-bytes 4 p) #f)) (integer-bytes->integer (read-bytes 4 p) #f))
@ -32,8 +31,8 @@
(unless (= a b) (unless (= a b)
(error 'check-same "not: ~e ~e" a b))) (error 'check-same "not: ~e ~e" a b)))
(define (round-up-page v) (define (round-up-page v machine-type)
(if (eq? 'aarch64 (cross-system-type 'arch)) < (if (eqv? machine-type aarch64-machine-type)
(bitwise-and #xFFFFC000 (+ v #x3FFF)) (bitwise-and #xFFFFC000 (+ v #x3FFF))
(bitwise-and #xFFFFF000 (+ v #xFFF)))) (bitwise-and #xFFFFF000 (+ v #xFFF))))
@ -73,13 +72,14 @@
void void
(lambda () (lambda ()
(file-stream-buffer-mode out 'none) (file-stream-buffer-mode out 'none)
(check-same (force exe-id) (read-ulong p)) (define exe-id (read-ulong p))
(read-ulong p) (check-exe-id exe-id)
(define machine-id (read-ulong p))
(read-ulong p) (read-ulong p)
(check-same #x2 (read-ulong p)) (check-same #x2 (read-ulong p))
(let* ([total-cnt (read-ulong p)] (let* ([total-cnt (read-ulong p)]
[cmdssz (read-ulong p)] [cmdssz (read-ulong p)]
[min-used (round-up-page cmdssz)] [min-used (round-up-page cmdssz machine-id)]
[sym-tab-pos #f] [sym-tab-pos #f]
[dysym-pos #f] [dysym-pos #f]
[hints-pos #f] [hints-pos #f]
@ -103,7 +103,7 @@
[linkedit-limit-offset 0]) [linkedit-limit-offset 0])
;; (printf "~a cmds, length 0x~x\n" cnt cmdssz) ;; (printf "~a cmds, length 0x~x\n" cnt cmdssz)
(read-ulong p) ; flags (read-ulong p) ; flags
(when (equal? (force exe-id) #xFeedFacf) (when (equal? exe-id #xFeedFacf)
(read-ulong p)) ; extra reserved word for 64-bit header (read-ulong p)) ; extra reserved word for 64-bit header
(let loop ([cnt total-cnt]) (let loop ([cnt total-cnt])
(unless (zero? cnt) (unless (zero? cnt)
@ -146,7 +146,7 @@
[reloff (read-ulong p)] [reloff (read-ulong p)]
[nreloc (read-ulong p)] [nreloc (read-ulong p)]
[flags (read-ulong p)]) [flags (read-ulong p)])
(when ((+ offset vmsz) . > . (+ cmdssz (if (equal? (force exe-id) #xFeedFacf) 32 28))) (when ((+ offset vmsz) . > . (+ cmdssz (if (equal? exe-id #xFeedFacf) 32 28)))
(when (and (positive? offset) (when (and (positive? offset)
(offset . < . min-used)) (offset . < . min-used))
;; (printf " new min!\n") ;; (printf " new min!\n")
@ -262,20 +262,20 @@
code-signature-pos) code-signature-pos)
;; (printf "Start offset: 0x~x\n" min-used) ;; (printf "Start offset: 0x~x\n" min-used)
(let ([end-cmd (+ cmdssz (let ([end-cmd (+ cmdssz
(if (equal? (force exe-id) #xFeedFacf) 32 28) (if (equal? exe-id #xFeedFacf) 32 28)
(- code-signature-lc-sz))] (- code-signature-lc-sz))]
[new-cmd-sz (if segdata [new-cmd-sz (if segdata
(if link-edit-64? 72 56) (if link-edit-64? 72 56)
0)] 0)]
[outlen (if segdata [outlen (if segdata
(round-up-page (bytes-length segdata)) (round-up-page (bytes-length segdata) machine-id)
0)] 0)]
[out-offset (if move-link-edit? [out-offset (if move-link-edit?
link-edit-offset link-edit-offset
(+ link-edit-offset (round-up-page link-edit-len)))] (+ link-edit-offset (round-up-page link-edit-len machine-id)))]
[out-addr (if move-link-edit? [out-addr (if move-link-edit?
link-edit-addr link-edit-addr
(+ link-edit-addr (round-up-page link-edit-vmlen)))]) (+ link-edit-addr (round-up-page link-edit-vmlen machine-id)))])
(unless ((+ end-cmd new-cmd-sz) . < . min-used) (unless ((+ end-cmd new-cmd-sz) . < . min-used)
(error 'check-header (error 'check-header
"no room for a new section load command (current end is ~a; min used is ~a; need ~a)" "no room for a new section load command (current end is ~a; min used is ~a; need ~a)"
@ -415,28 +415,29 @@
;; requires that a signature is not already present ;; requires that a signature is not already present
(define (add-ad-hoc-signature file) (define (add-ad-hoc-signature file)
(cond
[(eq? 'aarch64 (cross-system-type 'arch))
(define orig-size (file-size file))
(define file-identity (let-values ([(base name dir?) (split-path file)])
(bytes-append (path->bytes name) #"\0")))
(let-values ([(p out) (open-input-output-file file #:exists 'update)]) (let-values ([(p out) (open-input-output-file file #:exists 'update)])
(dynamic-wind (dynamic-wind
void void
(lambda () (lambda ()
(file-stream-buffer-mode out 'none) (file-stream-buffer-mode out 'none)
(check-same (force exe-id) (read-ulong p)) (define exe-id (read-ulong p))
(read-ulong p) (check-exe-id exe-id)
(define machine-id (read-ulong p))
(cond
[(eqv? machine-id aarch64-machine-type)
(define orig-size (file-size file))
(define file-identity (let-values ([(base name dir?) (split-path file)])
(bytes-append (path->bytes name) #"\0")))
(read-ulong p) (read-ulong p)
(check-same #x2 (read-ulong p)) (check-same #x2 (read-ulong p))
(let* ([total-cnt (read-ulong p)] (let* ([total-cnt (read-ulong p)]
[cmdssz (read-ulong p)] [cmdssz (read-ulong p)]
[min-used (round-up-page cmdssz)] [min-used (round-up-page cmdssz machine-id)]
[link-edit-64? #f] [link-edit-64? #f]
[link-edit-pos #f] [link-edit-pos #f]
[link-edit-len 0]) [link-edit-len 0])
(read-ulong p) ; flags (read-ulong p) ; flags
(when (equal? (force exe-id) #xFeedFacf) (when (equal? exe-id #xFeedFacf)
(read-ulong p)) ; extra reserved word for 64-bit header (read-ulong p)) ; extra reserved word for 64-bit header
(let loop ([cnt total-cnt]) (let loop ([cnt total-cnt])
(unless (zero? cnt) (unless (zero? cnt)
@ -463,7 +464,7 @@
(file-position p (+ pos sz)) (file-position p (+ pos sz))
(loop (sub1 cnt))))) (loop (sub1 cnt)))))
(let* ([end-cmd (+ cmdssz (let* ([end-cmd (+ cmdssz
(if (equal? (force exe-id) #xFeedFacf) 32 28))] (if (equal? exe-id #xFeedFacf) 32 28))]
[new-cmd-sz 16] [new-cmd-sz 16]
[log-page-size 12] [log-page-size 12]
[page-size (expt 2 log-page-size)] [page-size (expt 2 log-page-size)]
@ -495,7 +496,7 @@
(let ([file-pos (+ link-edit-pos 8 16 (* 1 (if link-edit-64? 8 4)))] (let ([file-pos (+ link-edit-pos 8 16 (* 1 (if link-edit-64? 8 4)))]
[len (+ link-edit-len data-size (- padded-size orig-size))]) [len (+ link-edit-len data-size (- padded-size orig-size))])
(file-position out file-pos) (file-position out file-pos)
((if link-edit-64? write-xulong write-ulong) (round-up-page len) out) ; vm-len ((if link-edit-64? write-xulong write-ulong) (round-up-page len machine-id) out) ; vm-len
(file-position out (+ file-pos (* 2 (if link-edit-64? 8 4)))) (file-position out (+ file-pos (* 2 (if link-edit-64? 8 4))))
((if link-edit-64? write-xulong write-ulong) len out)) ((if link-edit-64? write-xulong write-ulong) len out))
;; Add padding: ;; Add padding:
@ -540,13 +541,13 @@
(write-bytes file-identity out) (write-bytes file-identity out)
(for ([hash-code (in-list hash-codes)]) (for ([hash-code (in-list hash-codes)])
(write-bytes hash-code out))))) (write-bytes hash-code out))))]
(lambda ()
(close-input-port p)
(close-output-port out))))]
[else [else
;; no signing ;; no signing
(void)])) (void)]))
(lambda ()
(close-input-port p)
(close-output-port out)))))
(define (get/set-dylib-path file rx new-path) (define (get/set-dylib-path file rx new-path)
(let-values ([(p out) (if new-path (let-values ([(p out) (if new-path
@ -556,14 +557,15 @@
(dynamic-wind (dynamic-wind
void void
(lambda () (lambda ()
(check-same (force exe-id) (read-ulong p)) (define exe-id (read-ulong p))
(check-exe-id exe-id)
(read-ulong p) (read-ulong p)
(read-ulong p) (read-ulong p)
(read-ulong p) ; 2 is executable, etc. (read-ulong p) ; 2 is executable, etc.
(let* ([cnt (read-ulong p)] (let* ([cnt (read-ulong p)]
[cmdssz (read-ulong p)]) [cmdssz (read-ulong p)])
(read-ulong p) (read-ulong p)
(when (equal? (force exe-id) #xFeedFacf) (when (equal? exe-id #xFeedFacf)
(read-ulong p)) (read-ulong p))
(let loop ([cnt cnt] [base 0] [delta 0] [result null]) (let loop ([cnt cnt] [base 0] [delta 0] [result null])
(if (zero? cnt) (if (zero? cnt)