ELF 2nd try

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

context [
	defs: [
		image [
			base-address	134512640	; #{08048000}
		]
		extensions [
			exe %""
			obj %.o
			lib %.a
			dll %.so
		]
		machine [
		;--  CPU -------- ID ------ Endianness
			IA32			3			1	; EM_386, ELFDATA2LSB
		]
		class [
			none			0
			c-32-bit		1
			c-64-bit		2
		]
		encoding [
			none			0
			LSB				1				;-- little endian data encoding
			MSB				2				;-- big endian data encoding
		]
		file-type [
			none			0				;-- no file type
			relocatable		1				;-- relocatable file
			executable		2				;-- executable file
			shared			3				;-- shared object file
			core			4				;-- core file
			lo-proc			#{FF00}			;-- processor-specific
			hi-proc			#{FFFF}			;-- processor-specific
		]
		segment-type [
			null			0				;-- ignore entry
			load			1				;-- loadable segment
			dynamic			2				;-- dynamic linking information
			interp			3				;-- interpreter path name
			note			4				;-- notes/comments
			shlib			5				;-- reserved (unused)
			phdr			6				;-- program header table location
			lo-proc			#{70000000}		;-- reserved (proc-specific)
			hi-proc			#{7FFFFFFF}		;-- reserved (proc-specific)
		]
		segment-flags [						;-- @@ missing from official docs ?!? @@
			executable		1
			write			2
			read			4
		]
		segment-access [
			CODE			5				;-- [read executable]	; 1st part of LOAD segment
			DATA			6				;-- [read write]		; 2nd part of LOAD segment
			IMPORT			6				;-- [read write]		; DYNAMIC segment
		]
		section-type [
			null			0				;-- mark inactive section header
			prog-bits		1				;-- flags
			sym-tab			2				;-- symbol table (for link editing)
			str-tab			3				;-- string table
			rela			4				;-- relocations with addends
			hash			5				;-- symbol hash table
			dynamic			6				;-- dynamic linking
			note			7				;-- notes/comments
			no-bits			8				;-- ??
			rel				9				;-- relocations without addends
			shlib			10				;-- reserved (unused)
			dyn-sym			11				;-- symbol table (dynamic linking)
			lo-proc			#{70000000}		;-- reserved (proc-specific)
			hi-proc			#{7FFFFFFF}		;-- reserved (proc-specific)
			lo-user			#{80000000}		;-- reserved (lower bound reserved indexes)
			hi-user			#{8FFFFFFF}		;-- reserved (upper bound reserved indexes)
		]
		s-flags [
			write			1				;-- writable data
			alloc			2				;-- requires memory during program execution
			exec			4				;-- executable code
			mask-proc		#{F0000000}		;-- proc-specific semantics
		]
	]
	
	page-size:	 4096						;-- system page size
	ptr:		 0							;-- virtual address global pointer
	code-base:	 0							;-- code entry point
	data-base:	 0							;-- data virtual address
	data-offset: 0							;-- data segment offset in file


	elf-header: make struct! [
		ident-mag0			[char!]			;-- 0x7F
		ident-mag1			[char!]			;-- "E"
		ident-mag2			[char!]			;-- "L"
		ident-mag3			[char!]			;-- "F"
		ident-class			[char!]			;-- file class
		ident-data			[char!]			;-- data encoding
		ident-version		[char!]			;-- file version
		ident-pad0			[char!]
		ident-pad1			[integer!]
		ident-pad2			[integer!]
		type				[short]
		machine				[short]
		version				[integer!]
		entry				[integer!]
		phoff				[integer!]
		shoff				[integer!]
		flags				[integer!]
		ehsize				[short]
		phentsize			[short]
		phnum				[short]
		shentsize			[short]
		shnum				[short]
		shstrndx			[short]
	] none

	program-header: make struct! [
		type				[integer!]
		offset				[integer!]
		vaddr				[integer!]
		paddr				[integer!]
		filesz				[integer!]
		memsz				[integer!]
		flags				[integer!]
		align				[integer!]
	] none

	ehdr-size: length? third elf-header
	phdr-size: length? third program-header
	
	pointer: make struct! [
		value [integer!]					;-- 32/64-bit, watch out for endianess!!
	] none
	
	file-offset?: does [ptr - defs/image/base-address]
	
	calc-padding?: func [buffer][
		round/to file-offset? + (length? buffer) + page-size page-size
	]
	
	adjust-section: func [spec [block!] /offset offs /local ph][
		ph: spec/1
		ph/offset: any [offs file-offset?]
		ph/vaddr:  ptr
		ph/paddr:  ptr
		ph/filesz: length? spec/2
		ph/memsz:  ph/filesz			;@@ not sure about the alignment requirement?
	]
	
	resolve-data-refs: func [job /local ptr code][
		code: job/sections/code/2
		
		foreach [name spec] job/symbols [
			if all [spec/1 = 'global not empty? spec/3][			
				ptr: data-base + spec/2				
				pointer/value: ptr
				foreach ref spec/3 [change at code ref probe third pointer]
			]
		]
	]

	build-program-header: func [job [object!] name spec /local ph] [
		ph: make struct! program-header none
		ph/type:	select defs/segment-type switch name [
						CODE	['load]
						DATA	['load]
						IMPORT	['dynamic]
						;add more as needed...
					]
		ph/flags:	defs/segment-access/:name
		ph/align:	switch/default name [
						CODE 	[page-size]
						DATA 	[page-size]
						INTERP 	[1]
					][4]					; @@ (4 for all the others?)
		spec/1: ph
	]
	
	build-elf-header: func [job [object!] /local machine eh][
		machine: find defs/machine job/target

		eh: make struct! elf-header none
		eh/ident-mag0:		#"^(7F)"
		eh/ident-mag1:		#"E"
		eh/ident-mag2:		#"L"
		eh/ident-mag3:		#"F"
		eh/ident-class:		to-char defs/class/c-32-bit
		eh/ident-data:		to-char defs/encoding/LSB	;TBD: make it target-dependent
		eh/ident-version:	to-char 1					;-- 0: invalid, 1: current
		eh/type:			defs/file-type/executable	;TBD: switch on job/type
		eh/machine:			machine/2
		eh/version:			1							; EV_CURRENT
		eh/entry:			code-base
		eh/phoff:			ehdr-size
		eh/shoff:			0
		eh/flags:			0
		eh/ehsize:			ehdr-size
		eh/phentsize:		phdr-size
		eh/phnum:			(length? job/sections) / 2	;-- sections are "segments" here
		eh/shentsize:		0
		eh/shnum:			0
		eh/shstrndx:		0

		append job/buffer third eh
	]

	build: func [job [object!]][
	
remove/part find job/sections 'import 2				;@@ (to be removed)
		;
		; TBD: merge ELF specific sections to job/sections (segment) here
		;
		
		ptr: defs/image/base-address
		foreach [name spec] job/sections [			;-- 1st pass: build header structs
			build-program-header job name spec
			if name = 'code [ptr: ptr + ehdr-size]	;-- ehdr is stored in the 1st LOAD segment
			ptr: ptr + phdr-size
		]
		
		foreach [name spec] job/sections [			;-- 2nd pass: build content and adjust headers
			ptr: ptr + switch name [
				CODE	[
					adjust-section/offset spec 0
					code-base: ptr
					data-offset: file-offset? + length? spec/2
					calc-padding? spec/2			;-- new page required due to access rights change
				]
				DATA	[
					adjust-section/offset spec data-offset
					data-base: ptr					;-- adjust data entry point to new page
					length? spec/2
				]									;-- while keeping congruence between p_vaddr & p_offset
				IMPORT	[
				;	build-import job spec			;TBD: uncomment when ready
				;	adjust-section spec
				;	length? spec/2
					0								;@@ (to be removed)
				]
			]
			spec/1: copy third spec/1				;-- serialize header
		]
		
		build-elf-header job						;-- easier to build it here
		
		resolve-data-refs job						;-- resolve data references

		foreach [name spec] job/sections [			;-- 3rd pass: concatenate all section headers
			append job/buffer spec/1
		]
		foreach [name spec] job/sections [			;-- 4th pass: concatenate all section contents
			append job/buffer spec/2
		]

		probe job/buffer
	]
]