(**********************************************************************)
(* (c) Greg Morrisett, Neal Glew, Richard Samuels                     *)
(*     September 1998, all rights reserved.                           *)
(**********************************************************************)

(* Elf
 * Outputs elf format object files.
 *)
   
open Identifier;;
open Tal;;
open Objfile;;
open Binout;;

(***** File header *****)

type elf_file_header = {
   ei_magic : string;			(* len = 4. use ei_mag = "\127ELF" *)
   ei_class : int;			(* b: use elfclass32 = 1 *)
   ei_data : int;			(* use elfdata2lsb = 1 for big-endian*)
   ei_version : int;			(* byte: use ev_current = 1 *)
					(* Skip to 0+16 bytes *)
   e_type : int;			(* hword: file type *)
   e_machine : int;			(* hword: target machine *)
   e_version : int;			(* word: use ev_current = 1 *)
   e_entry : int;			(* word: entry point *)
   e_phoff : int;			(* word: program header offset *)
   e_shoff : int;			(* word: section header offset *)
   e_flags : long;			(* word: flags *)
   e_ehsize : int;			(* hword: ELF header size *)
   e_phentsize : int;			(* hword: prog header entry size *)
   e_phnum : int;			(* hword: # of prog header entries *)
   e_shentsize : int;			(* hword: sec header entry size *)
   e_shnum : int;			(* hword: # of sec header entries *)
   e_shstrndx : int		 (* hword: section name string table index *)
 }
;;

let sizeof_elf_file_header = 52;;

(* Values for e_magic, e_class, e_data, e_version *)
let ei_magic_value = "\127ELF";;
let elfclass32 = 1;;
let elfdata2lsb = 1;;
let ev_current = 1;;

(* Values for e_type *)
let et_rel = 1				(* Relocatable file *)
and et_exec = 2				(* Executable *)
and et_dyn = 3  			(* DLL *)
;;

(* Values for e_machine *)
let em_386 = 3;;				

(***** Symbol table *****)

type elf_symbol = {
   st_name : int;			(*name of the symbol, put in strtable*)
   st_value : int;			(* word: offset of symbol in section *)
   st_size : int;			(* word: size *)
   st_binding : int;			(* 4bits: stb_* *)
   st_type : int;			(* 4bits: stt_* *)
   st_other : int;			(* byte, reserved. *)
   st_shndx : int			(* hword: section num. of symbol *)
 }
;;

let sizeof_elf_symbol = 16;;

type elf_symbol_table = {
   mutable st_local_symbols : elf_symbol list;	
   mutable st_local_symcount : int;	(* Number of local symbols. *)
   mutable st_global_symbols : elf_symbol list;
   mutable st_symcount : int		(* Index of next symbol *)
 }
;;

type elf_string_table = {
   mutable st_strings : string list;
   mutable st_length : int		(* Index of next string *)
 }
;;

(***** Relocations *****)

type elf_relocation_entry = {
   r_offset : int;			(*W: where to apply relocation *)
				   (* The below are combined into r_info: *)
   r_sym : int;				(*H+B: the index of the symbol *)
   r_type : int;			(*B: the type of relocation *)
   r_addend : int			(*W: explicit addend *)
 }
;;

let sizeof_elf_reloc = 8;;

(***** Section header *****)

type elf_section_link = 
   Int_link of int
 | Section_link of elf_section

and elf_section_header = {		(* All values are words. *)
   sh_name : int;			(* Index of name in section name tbl *)
   sh_type : int;
   sh_flags : int;
   sh_addr : int;
   mutable sh_offset : int;		(* Determined at write time *)
   sh_size : int;
   sh_link : elf_section_link;
   sh_info : elf_section_link;
   sh_addralign : int;
   sh_entsize : int
 }

(**** Sections *****)

and elf_section_data = 
 | Prog_data of Stringchan.string_chan
 | Relocation_data of elf_relocation_entry list
 | Symbol_data of elf_symbol_table
 | String_data of elf_string_table
 | No_data

and elf_section = {
   mutable es_number : int;
   es_header : elf_section_header;
   es_data : elf_section_data
 }
;;

(***** ELF file internal representation *****)

type elf_file = {
   f_header : elf_file_header;
   f_sections : elf_section array
 }
;;

(***** Section header values *****)

let sizeof_elf_section_header = 40;;

(* section header numbers *)
let shn_undef = 0
and shn_abs = 0xFFF1			(* Symbols with absolute location *)
and shn_common = 0xFFF2  		(* Common symbols *)
;;

(* values for sh_name *)
let sname_comment = ".comment"		(* version info *)
and sname_data = ".data"		(* initialized data *)
and sname_dynamic = ".dynamic"		(* dynamic linking info *)
and sname_dynstr = ".dynstr"		(* strings for dynamic linking *)
and sname_dynsym = ".dynsym"		(* dynamic linking symbol table *)
and sname_fini = ".fini"		(* process termination code *)
and sname_got = ".got"			(* global offset table *)
and sname_hash = ".hash"		(* symbol hash table *)
and sname_init = ".init"		(* initialization code *)
and sname_note = ".note"		(* notes *)
and sname_plt = ".plt"			(* procedure linkage table *)
and sname_rel sname = ".rel" ^ sname	(* relocations for a named section *)
and sname_rela sname = ".rela" ^ sname	(* relocs with explicit addends *)
and sname_rodata = ".rodata"		(* read-only data *)
and sname_shstrtab = ".shstrtab"	(* section name string table *)
and sname_strtab = ".strtab"		(* string table *)
and sname_symtab = ".symtab"		(* symbol table *)
and sname_text = ".text"		(* executable instructions *)
;;

(* values for sh_type *)

let sht_null = 0
and sht_progbits = 1			(* information for the program *)
and sht_symtab = 2			(* symbol table *)
and sht_strtab = 3			(* string table *)
and sht_rela = 4			(*relocation table w/explicit addends*)
and sht_hash = 5			(* symbol hash table *)
and sht_dynamic = 6			(* dynamic linking info *)
and sht_note = 7			(* notes *)
and sht_nobits = 8			(* occupies no space in file *)
and sht_rel = 9				(* relocation table w/o addends *)
and sht_shlib = 10			(* unspecified *)
and sht_dynsym = 11 			(* dynamic symbol table *)
;;

let english_sh_type (i : int) =
   match i with
    | 0 -> "Null"
    | 1 -> "Program bits"
    | 2 -> "Symbol table"
    | 3 -> "String table"
    | 4 -> "Relocation table (explicit addends)"
    | 5 -> "Symbol hash table"
    | 6 -> "Dynamic info"
    | 7 -> "Notes"
    | 8 -> "No bits"
    | 9 -> "Relocation table (no explicit addends)"
    | 10 -> "Unspecified shared library stuff"
    | 11 -> "Dynamic symbol table"
    | _ -> "Unknown"
;;

(* values for sh_flags *)

let shf_write = 1			(* writable *)
and shf_alloc = 2			(* occupies memory *)
and shf_execinstr = 4  			(* executable *)
;;

(***** Symbol table values *****)

(* values for st_binding *)

let stb_local = 0
and stb_global = 1
and stb_weak = 2
;;

(* values for st_type *)

let stt_notype = 0			(* no type *)
and stt_object = 1			(* data object/variable *)
and stt_func = 2			(* function or code label *)
and stt_section = 3			(* section *)
and stt_file = 4  			(* name of source file *)
;;			    (* stt_file must have stb_local, be in shn_abs*)

(***** Constructors *****)

let make_elf_file_header shoffset shnum shstrndx = {
   ei_magic = ei_magic_value;
   ei_class = elfclass32;
   ei_data = elfdata2lsb;
   ei_version = ev_current;

   e_type = et_rel;
   e_machine = em_386;
   e_version = ev_current;
   e_entry = 0;
   e_phoff = 0;
   e_shoff = shoffset;
   e_flags = (0, 0);
   e_ehsize = sizeof_elf_file_header;
   e_phentsize = 0;
   e_phnum = 0;
   e_shentsize = sizeof_elf_section_header;
   e_shnum = shnum;
   e_shstrndx = shstrndx
 }
;;

let make_zero_section() = {
   es_number = 0;
   es_header = {   sh_name = 0;
		 sh_type = sht_null;
		 sh_flags = 0;
		 sh_addr = 0;
		 sh_offset = 0;
		 sh_size = 0;
		 sh_link = Int_link 0;
		 sh_info = Int_link 0;
		 sh_addralign = 0;
		 sh_entsize = 0
	       };
   es_data = No_data
 }
;;
 
(* string tables begin with \0 and end with \0, using \0-terminated strings. *)

let make_zero_symbol() = {
   st_name = 0;
   st_value = 0;
   st_size = 0;
   st_binding = stb_local;
   st_type = stt_notype;
   st_other = 0;
   st_shndx = shn_undef
 }
;;

(***** String table functions *****)

(* empty_string_table
   Returns an empty string table. *)

let empty_string_table () = {
   st_strings = [];
   st_length = 1			(* Skip 1 byte for initial \0 byte. *)
 }
;;

(* add_string 
   Returns: the starting offset of the string. 
   Side effects: Adds the string to strtable.
     Strings are added in reverse order. *)

let add_string strtable s =
   if (String.length s) > 0 then
      let start_pos = strtable.st_length in
      strtable.st_strings <- (s :: strtable.st_strings);
      strtable.st_length <- strtable.st_length + (String.length s) + 1;
      start_pos
   else
      0
;;

(* make_strtable_section
   Returns an ELF section for the given string table.
   Side effects: the section's name is put into secnames. *)

let make_strtable_section secnames strtable = {
   es_number = 0;			(* Determined at write time *)
   es_header = { sh_name = (add_string secnames sname_strtab);
		 sh_type = sht_strtab;
		 sh_flags = 0;
		 sh_addr = 0;
		 sh_offset = 0;		(* Determined at write time *)
		 sh_size = strtable.st_length;
		 sh_link = Int_link 0;
		 sh_info = Int_link 0;
		 sh_addralign = 1;
		 sh_entsize = 0
	       };
   es_data = String_data strtable
 }
;;

(***** Symbol table functions *****)

(* make_elf_import_symbol
   Returns a symbol for an import (global, from undefined section.) 
   Side effects: adds the symbol's name to the string table. *)

let make_elf_import_symbol strtable symname = {
   st_name = (add_string strtable symname);
   st_value = 0;
   st_size = 0;
   st_binding = stb_global;
   st_type = stt_notype;
   st_other = 0;
   st_shndx = shn_undef
 }
;;

(* to_elf_st_binding
   Returns the appropriate binding value for a given symbol scope. *)

let to_elf_st_binding scope =
   match scope with
      Local -> stb_local
    | Weak -> stb_weak
    | Global -> stb_global
;;

(* is_code_symbol 
   Returns TRUE if the symbol is in a code section, not a data section. *)

let is_code_symbol sec_num pos =
   (sec_num = 2)
;;

(* make_elf_internal_symbol
   Returns a symbol for an internal (static or export) symbol. 
   Side effects: adds the symbol's name to the string table. *)

let make_elf_internal_symbol strtable name sec_num pos size scope = {
   st_name = (add_string strtable name);
   st_value = pos;
   st_size = size;
   st_binding = (to_elf_st_binding scope);
   st_type = (if (is_code_symbol sec_num pos) then stt_func else stt_object);
   st_other = 0;
   st_shndx = sec_num
 }
;;

(* to_elf_symbol 
   Returns the given objfile symbol, translated into an ELF symbol. 
   Side effects: adds the symbol's name to the string table. *)

let to_elf_symbol strtable sym = 
   if sym.sym_section = 0 then
      (make_elf_import_symbol strtable (id_to_string sym.sym_ident))
   else
      (make_elf_internal_symbol strtable (id_to_string sym.sym_ident)
	    sym.sym_section sym.sym_offset sym.sym_size sym.sym_scope)
;;

(* empty_elf_symbol_table
   Returns an ELF symbol table containing the zero symbol. *)
let empty_elf_symbol_table() = {
   st_local_symbols = [make_zero_symbol()];
   st_local_symcount = 1;

   st_global_symbols = [];
   st_symcount = 1
 }
;;

(* add_elf_symbol
   Side effects: adds the given ELF symbol to the symbol table, in the local
   or the global section, as appropriate. 
   NOTE: The symbol lists are constructed in reverse order. *)

let add_elf_symbol symtable elf_sym =
   if elf_sym.st_binding = stb_local then 
      begin
	 symtable.st_local_symbols <- (elf_sym :: symtable.st_local_symbols);
	 symtable.st_local_symcount <- (symtable.st_local_symcount + 1);
      end
   else if elf_sym.st_binding = stb_global then 
      begin
	 symtable.st_global_symbols <- (elf_sym::symtable.st_global_symbols);
      end;
   symtable.st_symcount <- (symtable.st_symcount + 1)
;;

(* add_objfile_symbol
   Side effects:
     - Translates the objfile symbol into an ELF symbol and adds it to the
       symbol table.
     - Sets the old symbol's index to its new index in the symbol table. 
     - Adds the symbol's name to the string table. *)

let add_objfile_symbol strtable symtable sym =
   sym.sym_index <- symtable.st_symcount;
   (add_elf_symbol symtable (to_elf_symbol strtable sym))
;;
	 
(* add_filename_symbol
   Side effects: 
    - Adds the special filename symbol to the symbol table. 
    - Adds the file name to the string table. *)

let add_filename_symbol symtable strtable srcfilename =
   let filename_symbol = {
      st_name = (add_string strtable srcfilename);
      st_value = 0;
      st_size = 0;
      st_binding = stb_local;
      st_type = stt_file;
      st_other = 0;
      st_shndx = shn_abs
    } in
   (add_elf_symbol symtable filename_symbol)
;;
     
(* add_section_start_symbol
   Side effects: adds a section's start symbol to the symbol table. *)

let add_section_start_symbol symtable strtable sec_num sec =
   let section_symbol = {
      st_name = (add_string strtable  "");(**)(*Section symbols have no name?*)
      st_value = 0;
      st_size = 0;
      st_binding = stb_local;
      st_type = stt_section;
      st_other = 0;
      st_shndx = sec_num
    } in
   (add_elf_symbol symtable section_symbol)
;;

(* add_section_symbols
   Side effects: 
     - Adds the section start symbol and all of the symbols
       for the section into the symbol table. 
     - Puts each symbol's name into the string table. *)

let rec add_section_symbols symtable strtable sec_num secs =
   match secs with
      [] -> ()
    | (sec :: tail) ->
	 (add_section_start_symbol symtable strtable sec_num sec);
	 (List.iter (add_objfile_symbol strtable symtable) sec.s_symbols);
	 (add_section_symbols symtable strtable (sec_num + 1) tail)
;;

(* make_elf_symbol_table
   Returns an ELF symbol table for the given objfile, with all ELF-specific
     and normal symbols added.
   Side effects: Each objfile symbol in the symbol dictionary is given its
     actual index in the symbol list. *)

let make_elf_symbol_table strtable srcfilename objfile = 
   let symtable = empty_elf_symbol_table() in
   (add_filename_symbol symtable strtable srcfilename);
   (add_section_symbols symtable strtable 1 objfile.o_secs);
   (List.iter (add_objfile_symbol strtable symtable) objfile.o_import_symbols);
   symtable
;;

(* make_symtable_section
   Returns an ELF section for the given symbol table. 
   Side effects: The section's name is put in secnames. *)

let make_symtable_section secnames strtable_section symtable = {
   es_number = 0;			(* Determined at write time *)
   es_header = { sh_name = (add_string secnames sname_symtab);
		 sh_type = sht_symtab;
		 sh_flags = 0;
		 sh_addr = 0;
		 sh_offset = 0;		(* Determined at write time *)
		 sh_size = (symtable.st_symcount * sizeof_elf_symbol);
		 sh_link = Section_link strtable_section;
		 sh_info = Int_link symtable.st_local_symcount;
		 sh_addralign = 1;
		 sh_entsize = sizeof_elf_symbol
	       };
   es_data = Symbol_data symtable
 }
;;

(* make_symbol_sections
   Returns a (string table section, symbol table section) pair for the 
   symbols in the object file. 
   Side effects: the sections' names are put in the section names table. *)

let make_symbol_sections secnames srcfilename objfile = 
   let strtable = empty_string_table() in
   let symtable = (make_elf_symbol_table strtable srcfilename objfile) in
   
   let strtable_section = (make_strtable_section secnames strtable) in
   let symtable_section = (make_symtable_section secnames strtable_section
				symtable) in
   (strtable_section, symtable_section)
;;

(***** Program section functions *****)

(* make_program_section
   Returns a new section and section header for a program data section
     (text or data). The section's name, data, and size are taken from the
     objfile section, but no offset or section number is given. 
     These values will be assigned when the section is written. 
   Side effects: the section's name is added to the section name 
     string table. *)

let make_program_section secnames sec = {
   es_number = 0;			(* assigned when written *)
   es_header =   { sh_name = (add_string secnames sec.s_name);
		   sh_type = sht_progbits;
		   sh_flags = (shf_alloc + shf_execinstr);
		   sh_addr = 0;
		   sh_offset = 0;	(* assigned when written *)
		   sh_size = (Stringchan.get_mark sec.s_data);
		   sh_link = Int_link 0;
		   sh_info = Int_link 0;
		   sh_addralign = 4;
		   sh_entsize = 0
		 };
   es_data = Prog_data sec.s_data
 }
;;

(***** Relocation table functions *****)

let elf_reloctype_none = 0
and elf_reloctype_dir32 = 1
and elf_reloctype_rel32 = 2
;;

(* elf_reloc_type_of
   Returns the ELF relocation type for the given relocation relativity
   and scale. *)

let elf_reloctype_of relativity scale = 
   match (relativity, scale) with
      (Relative, Byte4) -> elf_reloctype_rel32
    | (Absolute, Byte4) -> elf_reloctype_dir32
    | _ -> failwith "elf_reloctype_of @ elf.ml : bad relocation type."
;;

(* to_elf_relocation
   Returns a new ELF relocation for the given objfile relocation. *)

let to_elf_relocation reloc = {
   r_offset = reloc.rel_pos;
   r_sym = reloc.rel_symbol.sym_index;
   r_type = (elf_reloctype_of reloc.rel_relativity reloc.rel_scale);
   r_addend = reloc.rel_addend
 }
;;

(* make_relocation_section
   Returns a new relocation section for the given program section.
   Symbol_section is the symbol table, program_section is the 
   section in the ELF file, and objfile_section is the same section from
   the objfile. The relocations from the objfile section are translated
   into ELF relocations. 
   Side effects: the section's name is added to the section names table. *)

let make_relocation_section secnames symbol_section
      program_section objfile_section = {
   es_number = 0;			(* assigned when written *)
   es_header = { sh_name = (add_string secnames 
			     (sname_rela objfile_section.s_name));
		 sh_type = sht_rela;
		 sh_flags = 0;
		 sh_addr = 0;
		 sh_offset = 0;		(* assigned when written *)
		 sh_size = ((List.length objfile_section.s_relocs) 
				 * sizeof_elf_reloc);
		 sh_link = Section_link symbol_section;
		 sh_info = Section_link program_section;
		 sh_addralign = 4;
		 sh_entsize = sizeof_elf_reloc
	       };
   es_data = Relocation_data (List.map to_elf_relocation
				  objfile_section.s_relocs)
 }
;;

(***** Etc. *****)

(* make_secnames_section
   Returns a new section for the section names table.
   Side effects: The name of the section names table section is added to the
     table before the section is made. *)
	    
let make_secnames_section secnames = 
   let sec_name = (add_string secnames sname_shstrtab) in 
   { es_number = 0;
      es_header = { sh_name = sec_name;
		    sh_type = sht_strtab;
		    sh_flags = 0;
		    sh_addr = 0;
		    sh_offset = 0;		(* assigned when written *)
		    sh_size = secnames.st_length;
		    sh_link = Int_link 0;
		    sh_info = Int_link 0;
		    sh_addralign = 1;
		    sh_entsize = 0
		  };
      es_data = String_data secnames
    }
;;

(***************************** WRITING ****************************)

(* put_link
   Writes an Int_link or a Section_link to the file. 
   An Int_link is just written; a Section_link is resolved by looking up
   the section's number and writing that. *)

let put_link outfile link = 
   match link with
      Int_link i -> put_word outfile i
    | Section_link s -> put_word outfile s.es_number
;;

(* write_reloc
   Side effects: writes a single ELF relocation. *)

let write_reloc outfile reloc = 
   begin
      put_word outfile reloc.r_offset;
      put_word outfile ((reloc.r_sym lsl 8) lor (reloc.r_type land 0xFF));
   end
;;

(* write_symbol
   Side effects: writes a single ELF symbol. *)

let write_symbol outfile symbol =
   begin
      put_word outfile symbol.st_name;
      put_word outfile symbol.st_value;
      put_word outfile symbol.st_size;
      put_byte outfile ((symbol.st_binding lsl 4) 
			     lor (symbol.st_type land 0xF));
      put_byte outfile symbol.st_other;
      put_hword outfile symbol.st_shndx;
   end
;;

(* write_symbol_table
   Side effects: writes all symbols in the symbol table. *)

let write_symbol_table outfile symtable = 
   begin
      (List.iter (write_symbol outfile) (List.rev symtable.st_local_symbols));
      (List.iter (write_symbol outfile) (List.rev symtable.st_global_symbols));
   end
;;

(* write_string_table
   Side effects: writes all strings in the string table. *)

let write_string_table outfile strtable = 
   let rec write_strings outfile strs =
      match strs with 
	 [] -> ()
       | (str :: tail) -> 
	    (write_strings outfile tail);(* Write strings in reverse order *)
	    (put_string outfile str);	(* Output string *)
	    (put_byte outfile 0);	(* Follow string with \0 byte *)
   in
   (put_byte outfile 0);		(* Write initial \0 byte for table. *)
   (write_strings outfile strtable.st_strings)
;;

(* write_section_data
   Side effects: Writes the data for any type of ELF section. *)

let write_section_data outfile sec sec_number = 
   begin
      sec.es_header.sh_offset <- (pos_out outfile); (* Record actual position *)
      sec.es_number <- sec_number;	(* Record actual section number *)
	    
      begin
	 match sec.es_data with
	  | Prog_data secdata -> 
	       (output outfile (Stringchan.to_string secdata) 0 
		     (Stringchan.get_mark secdata))
	  | Relocation_data relocs ->
	       (List.iter (write_reloc outfile) relocs)
	  | Symbol_data symbols ->
	       (write_symbol_table outfile symbols)
	  | String_data strings ->
	       (write_string_table outfile strings)
	  | No_data -> ()
      end;

      (* Pad to the next 4-byte boundary. *)
      (pad_to_4bytes outfile);
   end
;;

(* write_sections_data
   Side effects: writes the data for a list of sections. *)

let rec write_sections_data outfile secs secnum = 
   match secs with
      [] -> ()
    | (sec :: tail) ->
	 (write_section_data outfile sec secnum);
	 (write_sections_data outfile tail (secnum + 1))
;;

(* write_section_header
   Side effects: writes the header for a section. *)

let write_section_header outfile sec =
   begin
      let sh = sec.es_header in
      put_word outfile sh.sh_name;
      put_word outfile sh.sh_type;
      put_word outfile sh.sh_flags;
      put_word outfile sh.sh_addr;
      put_word outfile sh.sh_offset;
      put_word outfile sh.sh_size;
      put_link outfile sh.sh_link;
      put_link outfile sh.sh_info;
      put_word outfile sh.sh_addralign;
      put_word outfile sh.sh_entsize;
   end
;;

(* write_elf_file_header
   side effects: writes the ELF file header to the file. *)

let write_elf_file_header outfile h = 
   begin
      let header_start_pos = (pos_out outfile) in
      put_string outfile h.ei_magic;
      put_byte outfile h.ei_class;
      put_byte outfile h.ei_data;
      put_byte outfile h.ei_version;
      
      seek_out outfile (header_start_pos + 16);(* Skip to 0+16 bytes*)
      put_hword outfile h.e_type;
      put_hword outfile h.e_machine;
      put_word outfile h.e_version;
      put_word outfile h.e_entry;
      put_word outfile h.e_phoff;
      put_word outfile h.e_shoff;
      put_long outfile h.e_flags;
      put_hword outfile h.e_ehsize;
      put_hword outfile h.e_phentsize;
      put_hword outfile h.e_phnum;
      put_hword outfile h.e_shentsize;
      put_hword outfile h.e_shnum;
      put_hword outfile h.e_shstrndx;
   end
;;

(* write_elf 
   Side effects: Creates an ELF file from the given objfile, 
   and writes it into an open file handle. *)

let write_elf outfile srcfilename objfile  = 
   let secnames = empty_string_table() in

   let (symbol_section, symbol_string_section) = 
      (make_symbol_sections secnames srcfilename objfile) in

   let program_sections = 
      (List.map (make_program_section secnames) objfile.o_secs) in

   let relocation_sections = 
      (List.map2 (make_relocation_section secnames symbol_section) 
	    program_sections objfile.o_secs) in

   let section_name_string_section = (make_secnames_section secnames) in

   (* Put the sections in a list. *)
   let sections = (make_zero_section() :: 
		     (program_sections @ relocation_sections @ 
			[symbol_section; symbol_string_section; 
			   section_name_string_section])) in
   begin
      (* Now start writing. Update the section headers with the 
         correct offset, size, and section number as we go. *)
   
      (* Skip the file header; we'll fill it in later. *)
      (seek_out outfile sizeof_elf_file_header);
   
      (* Write section data and update the section headers. *)
      (write_sections_data outfile sections 0);

      (* Now write the section headers. *)
      let section_header_table_pos = (pos_out outfile) in
      (List.iter (write_section_header outfile) sections);

      (* Now seek back and write the file header. *)
      (seek_out outfile 0);
      (write_elf_file_header outfile 
	    (make_elf_file_header section_header_table_pos 
		  (List.length sections)
		  section_name_string_section.es_number));
   end
;;

(* create_elf
   Side effects: Creates and writes a new ELF file from the given objfile. *)
   
let create_elf srcfilename outfilename objfile = 
   let outfile = (open_out outfilename) in
   (write_elf outfile srcfilename objfile);
   (close_out outfile)
;;

(* EOF: elf.cmo *)
