From d8c26b7d876a29bf3a0cb697a60e9a38e93ab6e5 Mon Sep 17 00:00:00 2001
From: Erik Charlebois <erikcharlebois@gmail.com>
Date: Thu, 15 Apr 2010 01:20:57 -0700
Subject: [PATCH] Fat binary loading

---
 extra/macho/a2.macho           | Bin 0 -> 12888 bytes
 extra/macho/macho-tests.factor |  10 ++++++++--
 extra/macho/macho.factor       |  31 ++++++++++++++++++++++++++-----
 3 files changed, 34 insertions(+), 7 deletions(-)
 create mode 100755 extra/macho/a2.macho

diff --git a/extra/macho/a2.macho b/extra/macho/a2.macho
new file mode 100755
index 0000000000000000000000000000000000000000..ed9a3a9a278bdaf8c3236ad2b96012df6d46c7dc
GIT binary patch
literal 12888
zcmeHN-)me&6h1dun^co@+Xs!<=vG=9Y)L9YsbFCv4cX9A*Cs7NlyNtElU=#lUGCmZ
zH$rhCC<X}xd=Y%{(LX_?h*j|CL-oNI@kv@q5TS@j>_g-C-8+-Ln{Cq<MUXjU=FFLy
zb7tn7xi@#t*>CQA{E3J-jz~{aq+28j@yQuveMpup0u}*_fJML}U=gqgSOhEr76FTZ
zMZh9p5%?b<aQ*ggcY1LD$Hl+dh4t{#e`=4&n|f`Jf@hGF%8pHpzchZ~1>F#1@EzQj
zXlED$C^bDkGu_@j)Ti4aPFlv?<N+j1DI}!=w-IOoY^S}e16T~|r*s#}T-P=wq`6&2
zL8;o(LcZduT2RkF-DxkmFS2KxAx1VfdbPdQ{AfrOU9al;q5byt9@O>@YXg+qsAGP!
zwZJcx=XIx@>rHEW{kolUoZ8lo2Bqrd%cXKbmCAFKP;Q@JR@<Wkh(tLN74MoW<rdYP
zpIdOF=AHBVP}|FDZOS-n+w_pgtJ?w!JST5s1C=^6Ha!+=!FgyqC+57w&I#?Bxhhr0
zo<>_+4g7oB8#F_}P8=)lXIxgw%k5@wP|wdyi*j7woMSVbQdPe)58TvZ&aZW@H?8dr
zYX!=D4(>%t6>>qY)w&bEqPCaPT`0%*p`{s>TF?Et$@6E&&rF(U76#h(0WxVuFP7^J
z+rwIT67gO+q01pl;r$YmPeI0?%phxk(+v0IJIFlKpB@r<4;<%2vPdNMVd7YOk<6Z>
z*g+papZ#_cUJK#4e6C09HGkAA<wpxkUO{(!44m`uk{go~-+u8`-@8+zZ}k88F!$gi
zB#!wM(tl0neRsckgzt59;+lw^>?JBat+iwQwV*J2?AXZ35#UhDvy=XR0B-agxdO>)
z)0<kV1@6Mg^Km`uTCxaO1S|p;0gHe|z#{NZBk-DJR&HjNZ`{hfbEP-4T2HRrUjEFv
z_H%c}`8~7p{jZ74^0nT~^0QL^lcn`uOkm~9b$;6ZagnO4r%$8I&pBD=hve6v%hr)D
zN029wpIaTeiQ2KLts_5xuN9HW#xGl2TSb0OZT!TN>v@&b<%;hW9%M7r<e=s$%@2cz
z-(28He0P(c)9EkVhe(w9J>G|WFtj4FIUo-2o1p!)NpfD#UJ$2|-1Gh=NXfpQ-Zc&>
z$B{VBFy=&hgq0*NL<W*?btP!N-`rE#v>P4Q_qLOo@79+inEOQ)>!aMzys7za`nJs?
zU=gqgSOhEr76FTZMZh9p5wHkY1S|p;fqxf){b{Ate50WduC7(eIj<Bfsl^lWqMuwl
zkY+$EjEt*1V#Ww)`?40z#~(b9R&Jvdpu$g~Tt$#Nm^00Acqr+s1vx*EvyxD9bRkzN
zOZNQCm_IKU-ST3|uasq8x)zEs<IdIt7eVtJ$CwC1qh*GaJ-SW0<?0Z!%^?__l~)!e
z-!1DY)ZAjW$*g(EphSho;ps4OcDNs80KOd)Po-aEA3Qb2U-5*Njo;#^mW|)y8OYs2
zE0JGg0-XBBzmcU3hX;H$q2GgE8OkOu_j061mq<wbO@JegaR-Gl&$!$S+qd0CLZ=dA
zpP)1o-BhtUNlA)7I7mf5IH-xLhVf(-0zE4cUqtx31*%e=m@Bg*D%_`N<L-VkqFp!p
K-El%NKhodF$Vt8c

literal 0
HcmV?d00001

diff --git a/extra/macho/macho-tests.factor b/extra/macho/macho-tests.factor
index ca60d3dc9b..d52eb778f6 100644
--- a/extra/macho/macho-tests.factor
+++ b/extra/macho/macho-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Erik Charlebois.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.streams.string kernel literals macho multiline strings
-tools.test ;
+USING: accessors alien io io.streams.string kernel literals macho
+multiline sequences strings tools.test ;
 IN: macho.tests
 
 STRING: validation-output
@@ -24,3 +24,9 @@ STRING: validation-output
 { $ validation-output }
 [ <string-writer> dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ]
 unit-test
+
+{ t } [
+    "resource:extra/macho/a2.macho" [
+        >c-ptr fat-binary-members first data>> >c-ptr macho-header 64-bit?
+    ] with-mapped-macho
+] unit-test
diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor
index 79cb59c148..70dc594e07 100644
--- a/extra/macho/macho.factor
+++ b/extra/macho/macho.factor
@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.strings alien.syntax
 classes classes.struct combinators combinators.short-circuit
 io.encodings.ascii io.encodings.string kernel literals make
 math sequences specialized-arrays typed fry io.mmap formatting
-locals splitting ;
+locals splitting io.binary arrays ;
 FROM: alien.c-types => short ;
 IN: macho
 
@@ -812,7 +812,7 @@ C-ENUM: reloc_type_ppc
     PPC_RELOC_LOCAL_SECTDIFF ;
 
 ! Low-level interface
-SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 ;
+SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 fat_arch uchar ;
 UNION: mach_header_32/64 mach_header mach_header_64 ;
 UNION: segment_command_32/64 segment_command segment_command_64 ;
 UNION: load-command segment_command segment_command_64
@@ -826,6 +826,26 @@ UNION: section_32/64-array section-array section_64-array ;
 UNION: nlist_32/64 nlist nlist_64 ;
 UNION: nlist_32/64-array nlist-array nlist_64-array ;
 
+TUPLE: fat-binary-member cpu-type cpu-subtype data ;
+ERROR: not-fat-binary ;
+
+TYPED: fat-binary-members ( >c-ptr -- fat-binary-members )
+    fat_header memory>struct dup magic>> {
+        { FAT_MAGIC [ ] }
+        { FAT_CIGAM [ ] }
+        [ 2drop not-fat-binary ]
+    } case dup
+    [ >c-ptr fat_header heap-size swap <displaced-alien> ]
+    [ nfat_arch>> 4 >be le> ] bi
+    <direct-fat_arch-array> [
+        {
+            [ nip cputype>> 4 >be le> ]
+            [ nip cpusubtype>> 4 >be le> ]
+            [ offset>> 4 >be le> swap >c-ptr <displaced-alien> ]
+            [ nip size>> 4 >be le> <direct-uchar-array> ]
+        } 2cleave fat-binary-member boa
+    ] with { } map-as ;
+
 TYPED: 64-bit? ( macho: mach_header_32/64 -- ? )
     magic>> {
         { MH_MAGIC_64 [ t ] }
@@ -924,12 +944,13 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
 : macho-nm ( path -- )
     [| macho |
         macho load-commands segment-commands sections-array :> sections
-        
         macho load-commands symtab-commands [| symtab |
             macho symtab symbols [
                 [ drop n_value>> "%016x " printf ]
-                [ drop n_sect>> sections nth sectname>>
-                  read-array-string "%-16s" printf ]
+                [
+                    drop n_sect>> sections nth sectname>>
+                    read-array-string "%-16s" printf
+                ]
                 [ symbol-name "%s\n" printf ] 2tri
             ] curry each
         ] each