Experimental Mach-O emmiter

Mach-O.r2

REBOL [
	Title:   "Red/System Mach-O format emitter"
	Author:  "Nenad Rakocevic"
	File: 	 %Mach-O.r
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
]

context [
	defs: [
		image [
			base-address ; TODO
		]
		extensions [
			exe %""
			obj %.o
			lib %.a
;			dll %.so
		]
		machine [
		;--  CPU -------- ID ------ Endianness
			IA32		7			little
		]

		file-type [
			exe		2	;	MH_EXECUTE
			; TODO: add other types
		]

		submachine [
		]

		load-commands [
;			LC_UUID			
			LC_SEGMENT		1
;			LC_SEGMENT_64	
;			LC_SYMTAB		
			LC_UNIXTHREAD	5
		]

	]
	
	macho-header: make struct! [
		magic		[integer!]		; #feedface
		cputype		[integer!]		; #00000007 - cputype (CPU_TYPE_X86)
		cpusubtype	[integer!]		; #00000003 - cpusubtype (CPU_SUBTYPE_I386_ALL)
		filetype	[integer!]		; #00000002 - filetype (MH_EXECUTE)
		ncmds		[integer!]		;	?2? - ncmds
		sizeofcmds	[integer!]		;	(_start - _cmds) - cmdsize
		flags		[integer!]		;	?0?	- flags
	] none
	
	load-command: make struct! [
		cmd		[integer!]
		cmdsize	[integer!]
	] none
	
	uuid-command: make struct! [
		cmd		[integer!]
		cmdsize	[integer!]
		uuid	[integer!]
	] none

	segment-command: make struct! [
		cmd			[integer!]
		cmdsize		[integer!]
;		segname		[string!] 		; FIXME: 16 chars
		segname1	[integer!]
		segname2	[integer!]
		segname3	[integer!]
		segname4	[integer!]
		vmaddr		[integer!]
		vmsize		[integer!]
		fileoff		[integer!]
		filesize	[integer!]
		maxprot		[integer!]	; FIXME: vm_prot_t
		initprot	[integer!]	; FIXME: vm_prot_t
		nsects		[integer!]
		flags		[integer!]
	] none

	thread-command: make struct! [
		cmd				[integer!]
		cmdsize			[integer!]
		flavor			[integer!]
		count			[integer!]
;		state			[16 ints]
		state_eax		[integer!]
		state_ebx		[integer!]
		state_ecx		[integer!]
		state_edx		[integer!]
		state_edi		[integer!]
		state_esi		[integer!]
		state_ebp		[integer!]
		state_esp		[integer!]
		state_ss		[integer!]
		state_eflags	[integer!]
		state_eip		[integer!]
		state_cs		[integer!]
		state_ds		[integer!]
		state_es		[integer!]
		state_fs		[integer!]
		state_gs		[integer!]
	] none

	section: make struct! [
;		sectname		[char[16]]		; FIXME
		sectname1		[integer!]
		sectname2		[integer!]
		sectname3		[integer!]
		sectname4		[integer!]
;		segname			[char[16]]		; FIXME
		segname1		[integer!]
		segname2		[integer!]
		segname3		[integer!]
		segname4		[integer!]		
		addr			[integer!]
		size			[integer!]
		offset			[integer!]
		align			[integer!]
		reloff			[integer!]
		nreloc			[integer!]
		flags			[integer!]
		reserved1		[integer!]
		reserved2		[integer!]
	] none

	macho-size: 	length? third macho-header
	seg-size:		length? third segment-command
	sect-size:		length? third section
	thrhdr-size:	length? third thread-command

	pad: func [
		buffer [any-string!]
		/to width
	][
		unless to [width: 16]
		head insert/dup tail buffer null (width - 1) and negate ((length? buffer) // width)
	]

	pad4: func [buffer [any-string!]][
		head insert/dup tail buffer null 3 and negate ((length? buffer) // 4)
	]

	pad16: func [buffer [any-string!]][
		head insert/dup tail buffer null 15 and negate ((length? buffer) // 16)
	]

	; FIXME: how to pass string to struct! directly?
	pass-string: func [string][to integer! to binary! string]

	load-commands: make block! 5

	text-segment: none

	pointer: make struct! [
		value [integer!]							;-- 32/64-bit, watch out for endianess!!
	] none

	calc-global-pointers: func [job][

		ncmds: 3 ; TEXT, DATA, THREAD
			
		; Careful with this number!!! It expect exactly two sections (should be in main build func)
		code-ptr: macho-size + (2 * seg-size) + (2 * sect-size) + thrhdr-size
		
;		pad/to job/sections/code/2 4096
		code-size: length? job/sections/code/2
;		data-ptr: code-ptr + code-size				; text(code) is padded to 4096
		data-ptr: 8192 ; FIXME (should be 2000h in virtual space)
		data-size: length? job/sections/data/2
	]

	resolve-data-refs: func [job /local code][
		code: job/sections/code/2

		foreach [name spec] job/symbols [
			if all [spec/1 = 'global not empty? spec/3][
				pointer/value: data-ptr + spec/2
				foreach ref spec/3 [change at code ref third pointer]
			]
		]
	]
	
	build-macho-header: func [
		job [object!] 
;		/local macho
	][
		; machine
		machine: find defs/machine job/target

		macho: make struct! macho-header none
		
		macho/magic:		to integer! #{FEEDFACE}
		macho/cputype:		second machine
		macho/cpusubtype:	3
		macho/filetype:		select defs/file-type job/type
		
		macho/ncmds:		ncmds
;		macho/sizeofcmds:	sizeofcmds		; set during build
		macho/flags:		0 ; FIXME

		macho
	]
	
	segment-sections: copy []
	
	build-segment: func [
		job
		seg-name
		/local sc
	][
		
		sc: make struct! segment-command none

		sc/cmd: 			select defs/load-commands 'LC_SEGMENT
;		sc/segname:			pad16 "__TEXT"
		segname: head reverse copy/part pad16 seg-name 8
		sc/segname1:		pass-string skip pad16 segname 4
		sc/segname2:		pass-string copy/part segname 8		; bytes 3 and 4 should be zero already
		sc/vmaddr:			either "__TEXT" = trim seg-name [4096][8192]	; FIXME
		sc/vmsize:			4096	; FIXME
		sc/fileoff:			either "__TEXT" = trim seg-name [0][4096]
		sc/filesize:		either "__TEXT" = trim seg-name [4096][data-size]
		sc/maxprot:			7		; FIXME
		sc/initprot:		5		; FIXME

	;	build section(s)
		clear segment-sections
		seg-size: length? third sc
		
		ptr: either "__TEXT" = trim seg-name [code-ptr][4096]
		siz: length? either "__TEXT" = trim seg-name [job/sections/code/2][job/sections/data/2]
		sectname: head reverse copy/part pad16 lowercase copy seg-name 8
		segname: head reverse copy/part pad16 seg-name 8

		sec: make struct! section none

		sec/sectname1:		pass-string skip pad16 sectname 4
		sec/sectname2:		pass-string copy/part sectname 8
		sec/segname1:		pass-string skip pad16 segname 4
		sec/segname2:		pass-string copy/part segname 8
		sec/addr:			4096 + ptr ; FIXME
		sec/size:			siz
		sec/offset:			ptr
		sec/flags:			either "__TEXT" = trim seg-name [to integer! #{80000400}][0]

		seg-size: seg-size + length? third sec
		append segment-sections sec

		sc/nsects:			length? segment-sections
		sc/cmdsize: 		seg-size	
		sc
	]
	
	build-command: func [
		name
		arg
		/local lc
	][
		lc: make struct! load-command none
		lc/cmd: select defs/load-commands name
		lc/cmdsize: 20 ; FIXME
		repend/only load-commands [name lc]
	]

	build-thread-header: func [
		/local sc
	][
		sc: make struct! thread-command none
		sc/cmd: 		select defs/load-commands 'LC_UNIXTHREAD
		sc/cmdsize: 	length? third sc
		
		sc/flavor:			1 		; FIXME
		sc/count:			16		; FIXME
		sc/state_eip:		code-ptr + 4096 	; FIXME: start addr after all headers
		
		sc
	]

	build: func [
		job [object!]
		/local macho text-seg text-sec data-seg data-sec thread
	][
		remove/part find job/sections 'import 2		;@@ (to be removed once 'import supported)

		calc-global-pointers job

		macho: build-macho-header job

		; prepare text segment struct		
		text-seg: build-segment job "__TEXT"
		text-sec: first segment-sections
		macho/sizeofcmds: macho/sizeofcmds + text-seg/cmdsize
		
		; prepare data segment struct
		data-seg: build-segment job "__DATA"
		data-sec: first segment-sections ; warning!
		macho/sizeofcmds: macho/sizeofcmds + data-seg/cmdsize
		
		; prepare thread struct
		thread: build-thread-header
		macho/sizeofcmds: macho/sizeofcmds + thrhdr-size

		; add Mach header
		append job/buffer third macho
		
		; add LC_SEGMENTs and its sections
		append job/buffer third text-seg
		append job/buffer third text-sec
		append job/buffer third data-seg
		append job/buffer third data-sec
		
		; add LC_UNIXTHREAD
		append job/buffer third thread

		resolve-data-refs job

; TODO: fix pad bug
		job/sections/code/2: copy/part pad/to job/sections/code/2 4096 - code-ptr 4096 - code-ptr

		; add code
		foreach [name spec] job/sections [			;-- concatenate all section contents		
			append job/buffer spec/2
		]
	]
	
]