mirror of
https://github.com/rust-lang/rust.git
synced 2026-04-28 03:07:24 +03:00
Graydon Hoare
1785 lines
55 KiB
OCaml
1785 lines
55 KiB
OCaml
(*
|
|
* Module for writing System V ELF files.
|
|
*
|
|
* FIXME: Presently heavily infected with x86 and elf32 specificities,
|
|
* though they are reasonably well marked. Needs to be refactored to
|
|
* depend on abi fields if it's to be usable for other elf
|
|
* configurations.
|
|
*)
|
|
|
|
open Asm;;
|
|
open Common;;
|
|
|
|
let log (sess:Session.sess) =
|
|
Session.log "obj (elf)"
|
|
sess.Session.sess_log_obj
|
|
sess.Session.sess_log_out
|
|
;;
|
|
|
|
let iflog (sess:Session.sess) (thunk:(unit -> unit)) : unit =
|
|
if sess.Session.sess_log_obj
|
|
then thunk ()
|
|
else ()
|
|
;;
|
|
|
|
|
|
(* Fixed sizes of structs involved in elf32 spec. *)
|
|
let elf32_ehsize = 52L;;
|
|
let elf32_phentsize = 32L;;
|
|
let elf32_shentsize = 40L;;
|
|
let elf32_symsize = 16L;;
|
|
let elf32_rela_entsz = 0xcL;;
|
|
|
|
type ei_class =
|
|
ELFCLASSNONE
|
|
| ELFCLASS32
|
|
| ELFCLASS64
|
|
;;
|
|
|
|
|
|
type ei_data =
|
|
ELFDATANONE
|
|
| ELFDATA2LSB
|
|
| ELFDATA2MSB
|
|
;;
|
|
|
|
|
|
let elf_identification sess ei_class ei_data =
|
|
SEQ
|
|
[|
|
|
STRING "\x7fELF";
|
|
BYTES
|
|
[|
|
|
(match ei_class with (* EI_CLASS *)
|
|
ELFCLASSNONE -> 0
|
|
| ELFCLASS32 -> 1
|
|
| ELFCLASS64 -> 2);
|
|
(match ei_data with (* EI_DATA *)
|
|
ELFDATANONE -> 0
|
|
| ELFDATA2LSB -> 1
|
|
| ELFDATA2MSB -> 2);
|
|
|
|
1; (* EI_VERSION = EV_CURRENT *)
|
|
|
|
(* EI_OSABI *)
|
|
(match sess.Session.sess_targ with
|
|
FreeBSD_x86_elf -> 9
|
|
| _ -> 0);
|
|
|
|
0; (* EI_ABIVERSION *)
|
|
|
|
0; (* EI_PAD #9 *)
|
|
0; (* EI_PAD #A *)
|
|
0; (* EI_PAD #B *)
|
|
0; (* EI_PAD #C *)
|
|
0; (* EI_PAD #D *)
|
|
0; (* EI_PAD #E *)
|
|
0; (* EI_PAD #F *)
|
|
|]
|
|
|]
|
|
;;
|
|
|
|
|
|
type e_type =
|
|
ET_NONE
|
|
| ET_REL
|
|
| ET_EXEC
|
|
| ET_DYN
|
|
| ET_CORE
|
|
;;
|
|
|
|
|
|
type e_machine =
|
|
(* Maybe support more later. *)
|
|
EM_NONE
|
|
| EM_386
|
|
| EM_X86_64
|
|
;;
|
|
|
|
|
|
type e_version =
|
|
EV_NONE
|
|
| EV_CURRENT
|
|
;;
|
|
|
|
|
|
let elf32_header
|
|
~(sess:Session.sess)
|
|
~(ei_data:ei_data)
|
|
~(e_type:e_type)
|
|
~(e_machine:e_machine)
|
|
~(e_version:e_version)
|
|
~(e_entry_fixup:fixup)
|
|
~(e_phoff_fixup:fixup)
|
|
~(e_shoff_fixup:fixup)
|
|
~(e_phnum:int64)
|
|
~(e_shnum:int64)
|
|
~(e_shstrndx:int64)
|
|
: frag =
|
|
let elf_header_fixup = new_fixup "elf header" in
|
|
let entry_pos =
|
|
if sess.Session.sess_library_mode
|
|
then (IMM 0L)
|
|
else (M_POS e_entry_fixup)
|
|
in
|
|
DEF
|
|
(elf_header_fixup,
|
|
SEQ [| elf_identification sess ELFCLASS32 ei_data;
|
|
WORD (TY_u16, (IMM (match e_type with
|
|
ET_NONE -> 0L
|
|
| ET_REL -> 1L
|
|
| ET_EXEC -> 2L
|
|
| ET_DYN -> 3L
|
|
| ET_CORE -> 4L)));
|
|
WORD (TY_u16, (IMM (match e_machine with
|
|
EM_NONE -> 0L
|
|
| EM_386 -> 3L
|
|
| EM_X86_64 -> 62L)));
|
|
WORD (TY_u32, (IMM (match e_version with
|
|
EV_NONE -> 0L
|
|
| EV_CURRENT -> 1L)));
|
|
WORD (TY_u32, entry_pos);
|
|
WORD (TY_u32, (F_POS e_phoff_fixup));
|
|
WORD (TY_u32, (F_POS e_shoff_fixup));
|
|
WORD (TY_u32, (IMM 0L)); (* e_flags *)
|
|
WORD (TY_u16, (IMM elf32_ehsize));
|
|
WORD (TY_u16, (IMM elf32_phentsize));
|
|
WORD (TY_u16, (IMM e_phnum));
|
|
WORD (TY_u16, (IMM elf32_shentsize));
|
|
WORD (TY_u16, (IMM e_shnum));
|
|
WORD (TY_u16, (IMM e_shstrndx));
|
|
|])
|
|
;;
|
|
|
|
|
|
type sh_type =
|
|
SHT_NULL
|
|
| SHT_PROGBITS
|
|
| SHT_SYMTAB
|
|
| SHT_STRTAB
|
|
| SHT_RELA
|
|
| SHT_HASH
|
|
| SHT_DYNAMIC
|
|
| SHT_NOTE
|
|
| SHT_NOBITS
|
|
| SHT_REL
|
|
| SHT_SHLIB
|
|
| SHT_DYNSYM
|
|
;;
|
|
|
|
|
|
type sh_flags =
|
|
SHF_WRITE
|
|
| SHF_ALLOC
|
|
| SHF_EXECINSTR
|
|
;;
|
|
|
|
|
|
let section_header
|
|
?(sh_link:int64 option=None)
|
|
?(sh_info:int64 option=None)
|
|
?(zero_sh_addr:bool=false)
|
|
?(sh_flags:sh_flags list=[])
|
|
?(section_fixup:fixup option=None)
|
|
?(sh_addralign:int64=1L)
|
|
?(sh_entsize:int64=0L)
|
|
~(shstring_table_fixup:fixup)
|
|
~(shname_string_fixup:fixup)
|
|
(sh_type:sh_type)
|
|
: frag =
|
|
SEQ
|
|
[|
|
|
WORD (TY_i32, (SUB
|
|
((F_POS shname_string_fixup),
|
|
(F_POS shstring_table_fixup))));
|
|
WORD (TY_u32, (IMM (match sh_type with
|
|
SHT_NULL -> 0L
|
|
| SHT_PROGBITS -> 1L
|
|
| SHT_SYMTAB -> 2L
|
|
| SHT_STRTAB -> 3L
|
|
| SHT_RELA -> 4L
|
|
| SHT_HASH -> 5L
|
|
| SHT_DYNAMIC -> 6L
|
|
| SHT_NOTE -> 7L
|
|
| SHT_NOBITS -> 8L
|
|
| SHT_REL -> 9L
|
|
| SHT_SHLIB -> 10L
|
|
| SHT_DYNSYM -> 11L)));
|
|
WORD (TY_u32, (IMM (fold_flags
|
|
(fun f -> match f with
|
|
SHF_WRITE -> 0x1L
|
|
| SHF_ALLOC -> 0x2L
|
|
| SHF_EXECINSTR -> 0x4L) sh_flags)));
|
|
WORD (TY_u32,
|
|
if zero_sh_addr
|
|
then IMM 0L
|
|
else (match section_fixup with
|
|
None -> (IMM 0L)
|
|
| Some s -> (M_POS s)));
|
|
WORD (TY_u32, (match section_fixup with
|
|
None -> (IMM 0L)
|
|
| Some s -> (F_POS s)));
|
|
WORD (TY_u32, (match section_fixup with
|
|
None -> (IMM 0L)
|
|
| Some s -> (F_SZ s)));
|
|
WORD (TY_u32, (IMM (match sh_link with
|
|
None -> 0L
|
|
| Some i -> i)));
|
|
WORD (TY_u32, (IMM (match sh_info with
|
|
None -> 0L
|
|
| Some i -> i)));
|
|
WORD (TY_u32, (IMM sh_addralign));
|
|
WORD (TY_u32, (IMM sh_entsize));
|
|
|]
|
|
;;
|
|
|
|
|
|
type p_type =
|
|
PT_NULL
|
|
| PT_LOAD
|
|
| PT_DYNAMIC
|
|
| PT_INTERP
|
|
| PT_NOTE
|
|
| PT_SHLIB
|
|
| PT_PHDR
|
|
;;
|
|
|
|
|
|
type p_flag =
|
|
PF_X
|
|
| PF_W
|
|
| PF_R
|
|
;;
|
|
|
|
|
|
let program_header
|
|
~(p_type:p_type)
|
|
~(segment_fixup:fixup)
|
|
~(p_flags:p_flag list)
|
|
~(p_align:int64)
|
|
: frag =
|
|
SEQ
|
|
[|
|
|
WORD (TY_u32, (IMM (match p_type with
|
|
PT_NULL -> 0L
|
|
| PT_LOAD -> 1L
|
|
| PT_DYNAMIC -> 2L
|
|
| PT_INTERP -> 3L
|
|
| PT_NOTE -> 4L
|
|
| PT_SHLIB -> 5L
|
|
| PT_PHDR -> 6L)));
|
|
WORD (TY_u32, (F_POS segment_fixup));
|
|
WORD (TY_u32, (M_POS segment_fixup));
|
|
WORD (TY_u32, (M_POS segment_fixup));
|
|
WORD (TY_u32, (F_SZ segment_fixup));
|
|
WORD (TY_u32, (M_SZ segment_fixup));
|
|
WORD (TY_u32, (IMM (fold_flags
|
|
(fun f ->
|
|
match f with
|
|
PF_X -> 0x1L
|
|
| PF_W -> 0x2L
|
|
| PF_R -> 0x4L)
|
|
p_flags)));
|
|
WORD (TY_u32, (IMM p_align));
|
|
|]
|
|
;;
|
|
|
|
|
|
type st_bind =
|
|
STB_LOCAL
|
|
| STB_GLOBAL
|
|
| STB_WEAK
|
|
;;
|
|
|
|
|
|
type st_type =
|
|
STT_NOTYPE
|
|
| STT_OBJECT
|
|
| STT_FUNC
|
|
| STT_SECTION
|
|
| STT_FILE
|
|
;;
|
|
|
|
|
|
(* Special symbol-section indices *)
|
|
let shn_UNDEF = 0L;;
|
|
let shn_ABS = 0xfff1L;;
|
|
let shn_ABS = 0xfff2L;;
|
|
|
|
|
|
let symbol
|
|
~(string_table_fixup:fixup)
|
|
~(name_string_fixup:fixup)
|
|
~(sym_target_fixup:fixup option)
|
|
~(st_bind:st_bind)
|
|
~(st_type:st_type)
|
|
~(st_shndx:int64)
|
|
: frag =
|
|
let st_bind_num =
|
|
match st_bind with
|
|
STB_LOCAL -> 0L
|
|
| STB_GLOBAL -> 1L
|
|
| STB_WEAK -> 2L
|
|
in
|
|
let st_type_num =
|
|
match st_type with
|
|
STT_NOTYPE -> 0L
|
|
| STT_OBJECT -> 1L
|
|
| STT_FUNC -> 2L
|
|
| STT_SECTION -> 3L
|
|
| STT_FILE -> 4L
|
|
in
|
|
SEQ
|
|
[|
|
|
WORD (TY_u32, (SUB
|
|
((F_POS name_string_fixup),
|
|
(F_POS string_table_fixup))));
|
|
WORD (TY_u32, (match sym_target_fixup with
|
|
None -> (IMM 0L)
|
|
| Some f -> (M_POS f)));
|
|
WORD (TY_u32, (match sym_target_fixup with
|
|
None -> (IMM 0L)
|
|
| Some f -> (M_SZ f)));
|
|
WORD (TY_u8, (* st_info *)
|
|
(OR
|
|
((SLL ((IMM st_bind_num), 4)),
|
|
(AND ((IMM st_type_num), (IMM 0xfL))))));
|
|
WORD (TY_u8, (IMM 0L)); (* st_other *)
|
|
WORD (TY_u16, (IMM st_shndx));
|
|
|]
|
|
;;
|
|
|
|
type d_tag =
|
|
DT_NULL
|
|
| DT_NEEDED
|
|
| DT_PLTRELSZ
|
|
| DT_PLTGOT
|
|
| DT_HASH
|
|
| DT_STRTAB
|
|
| DT_SYMTAB
|
|
| DT_RELA
|
|
| DT_RELASZ
|
|
| DT_RELAENT
|
|
| DT_STRSZ
|
|
| DT_SYMENT
|
|
| DT_INIT
|
|
| DT_FINI
|
|
| DT_SONAME
|
|
| DT_RPATH
|
|
| DT_SYMBOLIC
|
|
| DT_REL
|
|
| DT_RELSZ
|
|
| DT_RELENT
|
|
| DT_PLTREL
|
|
| DT_DEBUG
|
|
| DT_TEXTREL
|
|
| DT_JMPREL
|
|
| DT_BIND_NOW
|
|
| DT_INIT_ARRAY
|
|
| DT_FINI_ARRAY
|
|
| DT_INIT_ARRAYSZ
|
|
| DT_FINI_ARRAYSZ
|
|
| DT_RUNPATH
|
|
| DT_FLAGS
|
|
| DT_ENCODING
|
|
| DT_PREINIT_ARRAY
|
|
| DT_PREINIT_ARRAYSZ
|
|
;;
|
|
|
|
type elf32_dyn = (d_tag * expr64);;
|
|
|
|
let elf32_num_of_dyn_tag tag =
|
|
match tag with
|
|
DT_NULL -> 0L
|
|
| DT_NEEDED -> 1L
|
|
| DT_PLTRELSZ -> 2L
|
|
| DT_PLTGOT -> 3L
|
|
| DT_HASH -> 4L
|
|
| DT_STRTAB -> 5L
|
|
| DT_SYMTAB -> 6L
|
|
| DT_RELA -> 7L
|
|
| DT_RELASZ -> 8L
|
|
| DT_RELAENT -> 9L
|
|
| DT_STRSZ -> 10L
|
|
| DT_SYMENT -> 11L
|
|
| DT_INIT -> 12L
|
|
| DT_FINI -> 13L
|
|
| DT_SONAME -> 14L
|
|
| DT_RPATH -> 15L
|
|
| DT_SYMBOLIC -> 16L
|
|
| DT_REL -> 17L
|
|
| DT_RELSZ -> 18L
|
|
| DT_RELENT -> 19L
|
|
| DT_PLTREL -> 20L
|
|
| DT_DEBUG -> 21L
|
|
| DT_TEXTREL -> 22L
|
|
| DT_JMPREL -> 23L
|
|
| DT_BIND_NOW -> 24L
|
|
| DT_INIT_ARRAY -> 25L
|
|
| DT_FINI_ARRAY -> 26L
|
|
| DT_INIT_ARRAYSZ -> 27L
|
|
| DT_FINI_ARRAYSZ -> 28L
|
|
| DT_RUNPATH -> 29L
|
|
| DT_FLAGS -> 30L
|
|
| DT_ENCODING -> 31L
|
|
| DT_PREINIT_ARRAY -> 32L
|
|
| DT_PREINIT_ARRAYSZ -> 33L
|
|
;;
|
|
|
|
let elf32_dyn_frag d =
|
|
let (tag, expr) = d in
|
|
let tagval = elf32_num_of_dyn_tag tag in
|
|
SEQ [| WORD (TY_u32, (IMM tagval)); WORD (TY_u32, expr) |]
|
|
;;
|
|
|
|
type elf32_386_reloc_type =
|
|
R_386_NONE
|
|
| R_386_32
|
|
| R_386_PC32
|
|
| R_386_GOT32
|
|
| R_386_PLT32
|
|
| R_386_COPY
|
|
| R_386_GLOB_DAT
|
|
| R_386_JMP_SLOT
|
|
| R_386_RELATIVE
|
|
| R_386_GOTOFF
|
|
| R_386_GOTPC
|
|
;;
|
|
|
|
|
|
type elf32_386_rela =
|
|
{ elf32_386_rela_type: elf32_386_reloc_type;
|
|
elf32_386_rela_offset: expr64;
|
|
elf32_386_rela_sym: expr64;
|
|
elf32_386_rela_addend: expr64 }
|
|
;;
|
|
|
|
let elf32_386_rela_frag r =
|
|
let type_val =
|
|
match r.elf32_386_rela_type with
|
|
R_386_NONE -> 0L
|
|
| R_386_32 -> 1L
|
|
| R_386_PC32 -> 2L
|
|
| R_386_GOT32 -> 3L
|
|
| R_386_PLT32 -> 4L
|
|
| R_386_COPY -> 5L
|
|
| R_386_GLOB_DAT -> 6L
|
|
| R_386_JMP_SLOT -> 7L
|
|
| R_386_RELATIVE -> 8L
|
|
| R_386_GOTOFF -> 9L
|
|
| R_386_GOTPC -> 10L
|
|
in
|
|
let info_expr =
|
|
WORD (TY_u32,
|
|
(OR
|
|
(SLL ((r.elf32_386_rela_sym), 8),
|
|
AND ((IMM 0xffL), (IMM type_val)))))
|
|
in
|
|
SEQ [| WORD (TY_u32, r.elf32_386_rela_offset);
|
|
info_expr;
|
|
WORD (TY_u32, r.elf32_386_rela_addend) |]
|
|
;;
|
|
|
|
|
|
let elf32_linux_x86_file
|
|
~(sess:Session.sess)
|
|
~(crate:Ast.crate)
|
|
~(entry_name:string)
|
|
~(text_frags:(string option, frag) Hashtbl.t)
|
|
~(data_frags:(string option, frag) Hashtbl.t)
|
|
~(bss_frags:(string option, frag) Hashtbl.t)
|
|
~(rodata_frags:(string option, frag) Hashtbl.t)
|
|
~(required_fixups:(string, fixup) Hashtbl.t)
|
|
~(dwarf:Dwarf.debug_records)
|
|
~(sem:Semant.ctxt)
|
|
~(needed_libs:string array)
|
|
: frag =
|
|
|
|
(* Procedure Linkage Tables (PLTs), Global Offset Tables
|
|
* (GOTs), and the relocations that set them up:
|
|
*
|
|
* The PLT goes in a section called .plt and GOT in a section called
|
|
* .got. The portion of the GOT that holds PLT jump slots goes in a
|
|
* section called .got.plt. Dynamic relocations for these jump slots go in
|
|
* section .rela.plt.
|
|
*
|
|
* The easiest way to understand the PLT/GOT system is to draw it:
|
|
*
|
|
* PLT GOT
|
|
* +----------------------+ +----------------------+
|
|
* 0| push &<GOT[1]> 0| <reserved>
|
|
* | jmp *GOT[2] 1| <libcookie>
|
|
* | 2| & <ld.so:resolve-a-sym>
|
|
* 1| jmp *GOT[3] 3| & <'push 0' in PLT[1]>
|
|
* | push 0 4| & <'push 1' in PLT[2]>
|
|
* | jmp *PLT[0] 5| & <'push 2' in PLT[3]>
|
|
* |
|
|
* 2| jmp *GOT[4]
|
|
* | push 1
|
|
* | jmp *PLT[0]
|
|
* |
|
|
* 2| jmp *GOT[5]
|
|
* | push 2
|
|
* | jmp *PLT[0]
|
|
*
|
|
*
|
|
* In normal user code, we call PLT entries with a call to a
|
|
* PC-relative address, the PLT entry, which itself does an indirect
|
|
* jump through a slot in the GOT that it also addresses
|
|
* PC-relative. This makes the whole scheme PIC.
|
|
*
|
|
* The linker fills in the GOT on startup. For the first 3, it uses
|
|
* its own thinking. For the remainder it needs to be instructed to
|
|
* fill them in with "jump slot relocs", type R_386_JUMP_SLOT, each
|
|
* of which says in effect which PLT entry it's to point back to and
|
|
* which symbol it's to be resolved to later. These relocs go in the
|
|
* section .rela.plt.
|
|
*)
|
|
|
|
let plt0_fixup = new_fixup "PLT[0]" in
|
|
let got_prefix = SEQ [| WORD (TY_u32, (IMM 0L));
|
|
WORD (TY_u32, (IMM 0L));
|
|
WORD (TY_u32, (IMM 0L)); |]
|
|
in
|
|
|
|
let got_cell reg i =
|
|
let got_entry_off = Int64.of_int (i*4) in
|
|
let got_entry_mem = Il.RegIn (reg, (Some (Asm.IMM got_entry_off))) in
|
|
Il.Mem (got_entry_mem, Il.ScalarTy (Il.AddrTy Il.CodeTy))
|
|
in
|
|
|
|
let got_code_cell reg i =
|
|
Il.CodePtr (Il.Cell (got_cell reg i))
|
|
in
|
|
|
|
let plt0_frag =
|
|
let reg = Il.Hreg X86.eax in
|
|
let e = X86.new_emitter_without_vregs () in
|
|
Il.emit e (Il.Push (Il.Cell (got_cell reg 1)));
|
|
Il.emit e (Il.jmp Il.JMP (got_code_cell reg 2));
|
|
Il.emit e Il.Nop;
|
|
Il.emit e Il.Nop;
|
|
Il.emit e Il.Nop;
|
|
Il.emit e Il.Nop;
|
|
DEF (plt0_fixup, (X86.frags_of_emitted_quads sess e))
|
|
in
|
|
|
|
(*
|
|
* The existence of the GOT/PLT mish-mash causes, therefore, the
|
|
* following new sections:
|
|
*
|
|
* .plt - the PLT itself, in the r/x text segment
|
|
* .got.plt - the PLT-used portion of the GOT, in the r/w segment
|
|
* .rela.plt - the dynamic relocs for the GOT-PLT, in the r/x segment
|
|
*
|
|
* In addition, because we're starting up a dynamically linked executable,
|
|
* we have to have several more sections!
|
|
*
|
|
* .interp - the read-only section that names ld.so
|
|
* .dynsym - symbols named by the PLT/GOT entries, r/x segment
|
|
* .dynstr - string-names used in those symbols, r/x segment
|
|
* .hash - hashtable in which to look these up, r/x segment
|
|
* .dynamic - the machine-readable description of the dynamic
|
|
* linkage requirements of this elf file, in the
|
|
* r/w _DYNAMIC segment
|
|
*
|
|
* The Dynamic section contains a sequence of 2-word records of type
|
|
* d_tag.
|
|
*
|
|
*)
|
|
|
|
(* There are 17 official section headers in the file we're making: *)
|
|
(* *)
|
|
(* section 0: <null section> *)
|
|
(* *)
|
|
(* section 1: .interp (segment 1: R+X, INTERP) *)
|
|
(* *)
|
|
(* section 2: .text (segment 2: R+X, LOAD) *)
|
|
(* section 3: .rodata ... *)
|
|
(* section 4: .dynsym ... *)
|
|
(* section 5: .dynstr ... *)
|
|
(* section 6: .hash ... *)
|
|
(* section 7: .plt ... *)
|
|
(* section 8: .got ... *)
|
|
(* section 9: .rela.plt ... *)
|
|
(* *)
|
|
(* section 10: .data (segment 3: R+W, LOAD) *)
|
|
(* section 11: .bss ... *)
|
|
(* *)
|
|
(* section 12: .dynamic (segment 4: R+W, DYNAMIC) *)
|
|
(* *)
|
|
(* section 13: .shstrtab (not in a segment) *)
|
|
(* section 14: .debug_aranges (segment 2: cont'd) *)
|
|
(* section 15: .debug_pubnames ... *)
|
|
(* section 14: .debug_info ... *)
|
|
(* section 15: .debug_abbrev ... *)
|
|
(* section 14: .debug_line ... *)
|
|
(* section 15: .debug_frame ... *)
|
|
(* section 16: .note..rust (segment 5: NOTE) *)
|
|
|
|
let sname s =
|
|
new_fixup (Printf.sprintf "string name of '%s' section" s)
|
|
in
|
|
let null_section_name_fixup = sname "<null>" in
|
|
let interp_section_name_fixup = sname ".interp"in
|
|
let text_section_name_fixup = sname ".text" in
|
|
let rodata_section_name_fixup = sname ".rodata" in
|
|
let dynsym_section_name_fixup = sname ".dynsym" in
|
|
let dynstr_section_name_fixup = sname ".dynstr" in
|
|
let hash_section_name_fixup = sname ".hash" in
|
|
let plt_section_name_fixup = sname ".plt" in
|
|
let got_plt_section_name_fixup = sname ".got.plt" in
|
|
let rela_plt_section_name_fixup = sname ".rela.plt" in
|
|
let data_section_name_fixup = sname ".data" in
|
|
let bss_section_name_fixup = sname ".bss" in
|
|
let dynamic_section_name_fixup = sname ".dynamic" in
|
|
let shstrtab_section_name_fixup = sname ".shstrtab" in
|
|
let debug_aranges_section_name_fixup = sname ".debug_aranges" in
|
|
let debug_pubnames_section_name_fixup = sname ".debug_pubnames" in
|
|
let debug_info_section_name_fixup = sname ".debug_info" in
|
|
let debug_abbrev_section_name_fixup = sname ".debug_abbrev" in
|
|
let debug_line_section_name_fixup = sname ".debug_line" in
|
|
let debug_frame_section_name_fixup = sname ".debug_frame" in
|
|
let note_rust_section_name_fixup = sname ".note.rust" in
|
|
|
|
(* let interpndx = 1L in *) (* Section index of .interp *)
|
|
let textndx = 2L in (* Section index of .text *)
|
|
let rodatandx = 3L in (* Section index of .rodata *)
|
|
let dynsymndx = 4L in (* Section index of .dynsym *)
|
|
let dynstrndx = 5L in (* Section index of .dynstr *)
|
|
(* let hashndx = 6L in *) (* Section index of .hash *)
|
|
let pltndx = 7L in (* Section index of .plt *)
|
|
(* let gotpltndx = 8L in *) (* Section index of .got.plt *)
|
|
(* let relapltndx = 9L in *) (* Section index of .rela.plt *)
|
|
let datandx = 10L in (* Section index of .data *)
|
|
let bssndx = 11L in (* Section index of .bss *)
|
|
(* let dynamicndx = 12L in *) (* Section index of .dynamic *)
|
|
let shstrtabndx = 13L in (* Section index of .shstrtab *)
|
|
|
|
let section_header_table_fixup = new_fixup ".section header table" in
|
|
let interp_section_fixup = new_fixup ".interp section" in
|
|
let text_section_fixup = new_fixup ".text section" in
|
|
let rodata_section_fixup = new_fixup ".rodata section" in
|
|
let dynsym_section_fixup = new_fixup ".dynsym section" in
|
|
let dynstr_section_fixup = new_fixup ".dynstr section" in
|
|
let hash_section_fixup = new_fixup ".hash section" in
|
|
let plt_section_fixup = new_fixup ".plt section" in
|
|
let got_plt_section_fixup = new_fixup ".got.plt section" in
|
|
let rela_plt_section_fixup = new_fixup ".rela.plt section" in
|
|
let data_section_fixup = new_fixup ".data section" in
|
|
let bss_section_fixup = new_fixup ".bss section" in
|
|
let dynamic_section_fixup = new_fixup ".dynamic section" in
|
|
let shstrtab_section_fixup = new_fixup ".shstrtab section" in
|
|
let note_rust_section_fixup = new_fixup ".shstrtab section" in
|
|
|
|
let shstrtab_section =
|
|
SEQ
|
|
[|
|
|
DEF (null_section_name_fixup, ZSTRING "");
|
|
DEF (interp_section_name_fixup, ZSTRING ".interp");
|
|
DEF (text_section_name_fixup, ZSTRING ".text");
|
|
DEF (rodata_section_name_fixup, ZSTRING ".rodata");
|
|
DEF (dynsym_section_name_fixup, ZSTRING ".dynsym");
|
|
DEF (dynstr_section_name_fixup, ZSTRING ".dynstr");
|
|
DEF (hash_section_name_fixup, ZSTRING ".hash");
|
|
DEF (plt_section_name_fixup, ZSTRING ".plt");
|
|
DEF (got_plt_section_name_fixup, ZSTRING ".got.plt");
|
|
DEF (rela_plt_section_name_fixup, ZSTRING ".rela.plt");
|
|
DEF (data_section_name_fixup, ZSTRING ".data");
|
|
DEF (bss_section_name_fixup, ZSTRING ".bss");
|
|
DEF (dynamic_section_name_fixup, ZSTRING ".dynamic");
|
|
DEF (shstrtab_section_name_fixup, ZSTRING ".shstrtab");
|
|
DEF (debug_aranges_section_name_fixup, ZSTRING ".debug_aranges");
|
|
DEF (debug_pubnames_section_name_fixup, ZSTRING ".debug_pubnames");
|
|
DEF (debug_info_section_name_fixup, ZSTRING ".debug_info");
|
|
DEF (debug_abbrev_section_name_fixup, ZSTRING ".debug_abbrev");
|
|
DEF (debug_line_section_name_fixup, ZSTRING ".debug_line");
|
|
DEF (debug_frame_section_name_fixup, ZSTRING ".debug_frame");
|
|
DEF (note_rust_section_name_fixup, ZSTRING ".note.rust");
|
|
|]
|
|
in
|
|
|
|
let section_headers =
|
|
[|
|
|
(* <null> *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: null_section_name_fixup
|
|
~section_fixup: None
|
|
~sh_addralign: 0L
|
|
SHT_NULL);
|
|
|
|
(* .interp *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: interp_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some interp_section_fixup)
|
|
SHT_PROGBITS);
|
|
|
|
(* .text *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: text_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ]
|
|
~section_fixup: (Some text_section_fixup)
|
|
~sh_addralign: 32L
|
|
SHT_PROGBITS);
|
|
|
|
(* .rodata *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: rodata_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some rodata_section_fixup)
|
|
~sh_addralign: 32L
|
|
SHT_PROGBITS);
|
|
|
|
(* .dynsym *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: dynsym_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some dynsym_section_fixup)
|
|
~sh_addralign: 4L
|
|
~sh_entsize: elf32_symsize
|
|
~sh_link: (Some dynstrndx)
|
|
SHT_DYNSYM);
|
|
|
|
(* .dynstr *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: dynstr_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some dynstr_section_fixup)
|
|
SHT_STRTAB);
|
|
|
|
(* .hash *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: hash_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some hash_section_fixup)
|
|
~sh_addralign: 4L
|
|
~sh_entsize: 4L
|
|
SHT_PROGBITS);
|
|
|
|
(* .plt *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: plt_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ]
|
|
~section_fixup: (Some plt_section_fixup)
|
|
~sh_addralign: 4L
|
|
SHT_PROGBITS);
|
|
|
|
(* .got.plt *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: got_plt_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_WRITE ]
|
|
~section_fixup: (Some got_plt_section_fixup)
|
|
~sh_addralign: 4L
|
|
SHT_PROGBITS);
|
|
|
|
(* .rela.plt *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: rela_plt_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC ]
|
|
~section_fixup: (Some rela_plt_section_fixup)
|
|
~sh_addralign: 4L
|
|
~sh_entsize: elf32_rela_entsz
|
|
~sh_link: (Some dynsymndx)
|
|
~sh_info: (Some pltndx)
|
|
SHT_RELA);
|
|
|
|
(* .data *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: data_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_WRITE ]
|
|
~section_fixup: (Some data_section_fixup)
|
|
~sh_addralign: 32L
|
|
SHT_PROGBITS);
|
|
|
|
(* .bss *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: bss_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_WRITE ]
|
|
~section_fixup: (Some bss_section_fixup)
|
|
~sh_addralign: 32L
|
|
SHT_NOBITS);
|
|
|
|
(* .dynamic *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: dynamic_section_name_fixup
|
|
~sh_flags: [ SHF_ALLOC; SHF_WRITE ]
|
|
~section_fixup: (Some dynamic_section_fixup)
|
|
~sh_addralign: 8L
|
|
~sh_link: (Some dynstrndx)
|
|
SHT_DYNAMIC);
|
|
|
|
(* .shstrtab *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: shstrtab_section_name_fixup
|
|
~section_fixup: (Some shstrtab_section_fixup)
|
|
SHT_STRTAB);
|
|
|
|
(*
|
|
FIXME: uncomment the dwarf section headers as you make use of them;
|
|
recent gdb versions have got fussier about parsing dwarf and don't
|
|
like seeing junk there.
|
|
*)
|
|
|
|
(* .debug_aranges *)
|
|
(*
|
|
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_aranges_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_aranges_fixup)
|
|
~sh_addralign: 8L
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
*)
|
|
(* .debug_pubnames *)
|
|
(*
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_pubnames_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_pubnames_fixup)
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
*)
|
|
|
|
(* .debug_info *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_info_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_info_fixup)
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
|
|
(* .debug_abbrev *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_abbrev_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_abbrev_fixup)
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
|
|
(* .debug_line *)
|
|
(*
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_line_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_line_fixup)
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
*)
|
|
|
|
(* .debug_frame *)
|
|
(*
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: debug_frame_section_name_fixup
|
|
~section_fixup: (Some sem.Semant.ctxt_debug_frame_fixup)
|
|
~sh_addralign: 4L
|
|
~zero_sh_addr: true
|
|
SHT_PROGBITS);
|
|
*)
|
|
|
|
(* .note.rust *)
|
|
(section_header
|
|
~shstring_table_fixup: shstrtab_section_fixup
|
|
~shname_string_fixup: note_rust_section_name_fixup
|
|
~section_fixup: (Some note_rust_section_fixup)
|
|
SHT_NOTE);
|
|
|
|
|]
|
|
in
|
|
let section_header_table = SEQ section_headers in
|
|
|
|
|
|
(* There are 6 official program headers in the file we're making: *)
|
|
(* segment 0: RX / PHDR *)
|
|
(* segment 1: R / INTERP *)
|
|
(* segment 2: RX / LOAD *)
|
|
(* segment 3: RW / LOAD *)
|
|
(* segment 4: RW / DYNAMIC *)
|
|
(* segment 5: R *)
|
|
|
|
let program_header_table_fixup = new_fixup "program header table" in
|
|
let segment_0_fixup = new_fixup "segment 0" in
|
|
let segment_1_fixup = new_fixup "segment 1" in
|
|
let segment_2_fixup = new_fixup "segment 2" in
|
|
let segment_3_fixup = new_fixup "segment 3" in
|
|
let segment_4_fixup = new_fixup "segment 4" in
|
|
let segment_5_fixup = new_fixup "segment 5" in
|
|
|
|
let segment_0_align = 4 in
|
|
let segment_1_align = 1 in
|
|
let segment_2_align = 0x1000 in
|
|
let segment_3_align = 0x1000 in
|
|
let segment_4_align = 0x1000 in
|
|
let segment_5_align = 1 in
|
|
|
|
let program_headers = [|
|
|
(program_header
|
|
~p_type: PT_PHDR
|
|
~segment_fixup: segment_0_fixup
|
|
~p_flags: [ PF_R; PF_X ]
|
|
~p_align: (Int64.of_int segment_0_align));
|
|
(program_header
|
|
~p_type: PT_INTERP
|
|
~segment_fixup: segment_1_fixup
|
|
~p_flags: [ PF_R ]
|
|
~p_align: (Int64.of_int segment_1_align));
|
|
(program_header
|
|
~p_type: PT_LOAD
|
|
~segment_fixup: segment_2_fixup
|
|
~p_flags: [ PF_R; PF_X ]
|
|
~p_align: (Int64.of_int segment_2_align));
|
|
(program_header
|
|
~p_type: PT_LOAD
|
|
~segment_fixup: segment_3_fixup
|
|
~p_flags: [ PF_R; PF_W ]
|
|
~p_align: (Int64.of_int segment_3_align));
|
|
(program_header
|
|
~p_type: PT_DYNAMIC
|
|
~segment_fixup: segment_4_fixup
|
|
~p_flags: [ PF_R; PF_W ]
|
|
~p_align: (Int64.of_int segment_4_align));
|
|
(program_header
|
|
~p_type: PT_NOTE
|
|
~segment_fixup: segment_5_fixup
|
|
~p_flags: [ PF_R;]
|
|
~p_align: (Int64.of_int segment_5_align));
|
|
|]
|
|
in
|
|
let program_header_table = SEQ program_headers in
|
|
|
|
let e_entry_fixup = new_fixup "entry symbol" in
|
|
|
|
let elf_header =
|
|
elf32_header
|
|
~sess
|
|
~ei_data: ELFDATA2LSB
|
|
~e_type: (if sess.Session.sess_library_mode then ET_DYN else ET_EXEC)
|
|
~e_machine: EM_386
|
|
~e_version: EV_CURRENT
|
|
|
|
~e_entry_fixup: e_entry_fixup
|
|
~e_phoff_fixup: program_header_table_fixup
|
|
~e_shoff_fixup: section_header_table_fixup
|
|
~e_phnum: (Int64.of_int (Array.length program_headers))
|
|
~e_shnum: (Int64.of_int (Array.length section_headers))
|
|
~e_shstrndx: shstrtabndx
|
|
in
|
|
|
|
let n_syms = ref 1 in (* The empty symbol, implicit. *)
|
|
|
|
let data_sym name st_bind fixup =
|
|
let name_fixup = new_fixup ("data symbol name fixup: '" ^ name ^ "'") in
|
|
let strtab_entry = DEF (name_fixup, ZSTRING name) in
|
|
let symtab_entry =
|
|
symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: name_fixup
|
|
~sym_target_fixup: (Some fixup)
|
|
~st_bind
|
|
~st_type: STT_OBJECT
|
|
~st_shndx: datandx
|
|
in
|
|
incr n_syms;
|
|
(strtab_entry, symtab_entry)
|
|
in
|
|
|
|
let bss_sym name st_bind fixup =
|
|
let name_fixup = new_fixup ("bss symbol name fixup: '" ^ name ^ "'") in
|
|
let strtab_entry = DEF (name_fixup, ZSTRING name) in
|
|
let symtab_entry =
|
|
symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: name_fixup
|
|
~sym_target_fixup: (Some fixup)
|
|
~st_bind
|
|
~st_type: STT_OBJECT
|
|
~st_shndx: bssndx
|
|
in
|
|
incr n_syms;
|
|
(strtab_entry, symtab_entry)
|
|
in
|
|
|
|
let rodata_sym name st_bind fixup =
|
|
let name_fixup = new_fixup ("rodata symbol name fixup: '" ^ name ^ "'") in
|
|
let strtab_entry = DEF (name_fixup, ZSTRING name) in
|
|
let symtab_entry =
|
|
symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: name_fixup
|
|
~sym_target_fixup: (Some fixup)
|
|
~st_bind
|
|
~st_type: STT_OBJECT
|
|
~st_shndx: rodatandx
|
|
in
|
|
incr n_syms;
|
|
(strtab_entry, symtab_entry)
|
|
in
|
|
|
|
let text_sym name st_bind fixup =
|
|
let name_fixup = new_fixup ("text symbol name fixup: '" ^ name ^ "'") in
|
|
let strtab_frag = DEF (name_fixup, ZSTRING name) in
|
|
let symtab_frag =
|
|
symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: name_fixup
|
|
~sym_target_fixup: (Some fixup)
|
|
~st_bind: st_bind
|
|
~st_type: STT_FUNC
|
|
~st_shndx: textndx
|
|
in
|
|
incr n_syms;
|
|
(strtab_frag, symtab_frag)
|
|
in
|
|
|
|
let require_sym name st_bind _(*fixup*) =
|
|
let name_fixup =
|
|
new_fixup ("require symbol name fixup: '" ^ name ^ "'")
|
|
in
|
|
let strtab_frag = DEF (name_fixup, ZSTRING name) in
|
|
let symtab_frag =
|
|
symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: name_fixup
|
|
~sym_target_fixup: None
|
|
~st_bind
|
|
~st_type: STT_FUNC
|
|
~st_shndx: shn_UNDEF
|
|
in
|
|
incr n_syms;
|
|
(strtab_frag, symtab_frag)
|
|
in
|
|
|
|
let frags_of_symbol sym_emitter st_bind symname_opt symbody x =
|
|
let (strtab_frags, symtab_frags, body_frags) = x in
|
|
let (strtab_frag, symtab_frag, body_frag) =
|
|
match symname_opt with
|
|
None -> (MARK, MARK, symbody)
|
|
| Some symname ->
|
|
let body_fixup =
|
|
new_fixup ("symbol body fixup: '" ^ symname ^ "'")
|
|
in
|
|
let body =
|
|
if symname = entry_name
|
|
then DEF (e_entry_fixup, DEF (body_fixup, symbody))
|
|
else DEF (body_fixup, symbody)
|
|
in
|
|
let (str, sym) = sym_emitter symname st_bind body_fixup in
|
|
(str, sym, body)
|
|
in
|
|
((strtab_frag :: strtab_frags),
|
|
(symtab_frag :: symtab_frags),
|
|
(body_frag :: body_frags))
|
|
in
|
|
|
|
let frags_of_require_symbol sym_emitter st_bind symname plt_entry_fixup x =
|
|
let (i, strtab_frags, symtab_frags,
|
|
plt_frags, got_plt_frags, rela_plt_frags) = x in
|
|
let (strtab_frag, symtab_frag) = sym_emitter symname st_bind None in
|
|
let e = X86.new_emitter_without_vregs () in
|
|
let jump_slot_fixup = new_fixup ("jump slot #" ^ string_of_int i) in
|
|
let jump_slot_initial_target_fixup =
|
|
new_fixup ("jump slot #" ^ string_of_int i ^ " initial target") in
|
|
|
|
(* You may notice this PLT entry doesn't look like either of the
|
|
* types of "normal" PLT entries outlined in the ELF manual. It is,
|
|
* however, just what you get when you combine a PIC PLT entry with
|
|
* inline calls to the horrible __i686.get_pc_thunk.ax kludge used
|
|
* on x86 to support entering PIC PLTs. We're just doing it *in*
|
|
* the PLT entries rather than infecting all the callers with the
|
|
* obligation of having the GOT address in a register on
|
|
* PLT-entry.
|
|
*)
|
|
|
|
let plt_frag =
|
|
let (reg, _, _) = X86.get_next_pc_thunk in
|
|
|
|
Il.emit_full e (Some plt_entry_fixup) Il.Dead;
|
|
|
|
Abi.load_fixup_addr e reg got_plt_section_fixup Il.CodeTy;
|
|
|
|
Il.emit e (Il.jmp Il.JMP (got_code_cell reg (2+i)));
|
|
|
|
Il.emit_full e (Some jump_slot_initial_target_fixup)
|
|
(Il.Push (X86.immi (Int64.of_int i)));
|
|
|
|
Il.emit e (Il.jmp Il.JMP (Il.direct_code_ptr plt0_fixup));
|
|
X86.frags_of_emitted_quads sess e
|
|
in
|
|
let got_plt_frag =
|
|
DEF (jump_slot_fixup,
|
|
WORD (TY_u32, (M_POS jump_slot_initial_target_fixup)))
|
|
in
|
|
let rela_plt =
|
|
{ elf32_386_rela_type = R_386_JMP_SLOT;
|
|
elf32_386_rela_offset = (M_POS jump_slot_fixup);
|
|
elf32_386_rela_sym = (IMM (Int64.of_int i));
|
|
elf32_386_rela_addend = (IMM 0L) }
|
|
in
|
|
let rela_plt_frag = elf32_386_rela_frag rela_plt in
|
|
(i+1,
|
|
(strtab_frag :: strtab_frags),
|
|
(symtab_frag :: symtab_frags),
|
|
(plt_frag :: plt_frags),
|
|
(got_plt_frag :: got_plt_frags),
|
|
(rela_plt_frag :: rela_plt_frags))
|
|
in
|
|
|
|
(* Emit text export symbols. *)
|
|
let (global_text_strtab_frags, global_text_symtab_frags) =
|
|
match htab_search sem.Semant.ctxt_native_provided SEG_text with
|
|
None -> ([], [])
|
|
| Some etab ->
|
|
Hashtbl.fold
|
|
begin
|
|
fun name fix x ->
|
|
let (strtab_frags, symtab_frags) = x in
|
|
let (str, sym) = text_sym name STB_GLOBAL fix in
|
|
(str :: strtab_frags,
|
|
sym :: symtab_frags)
|
|
end
|
|
etab
|
|
([],[])
|
|
in
|
|
|
|
(* Emit text fragments (possibly named). *)
|
|
let (global_text_strtab_frags,
|
|
global_text_symtab_frags,
|
|
text_body_frags) =
|
|
Hashtbl.fold
|
|
(frags_of_symbol text_sym STB_GLOBAL)
|
|
text_frags
|
|
(global_text_strtab_frags, global_text_symtab_frags, [])
|
|
in
|
|
|
|
let (local_text_strtab_frags,
|
|
local_text_symtab_frags) =
|
|
|
|
let symbol_frags_of_code _ code accum =
|
|
let (strtab_frags, symtab_frags) = accum in
|
|
let fix = code.Semant.code_fixup in
|
|
let (strtab_frag, symtab_frag) =
|
|
text_sym fix.fixup_name STB_LOCAL fix
|
|
in
|
|
(strtab_frag :: strtab_frags,
|
|
symtab_frag :: symtab_frags)
|
|
in
|
|
|
|
let symbol_frags_of_glue_code g code accum =
|
|
let (strtab_frags, symtab_frags) = accum in
|
|
let fix = code.Semant.code_fixup in
|
|
let (strtab_frag, symtab_frag) =
|
|
text_sym (Semant.glue_str sem g) STB_LOCAL fix
|
|
in
|
|
(strtab_frag :: strtab_frags,
|
|
symtab_frag :: symtab_frags)
|
|
in
|
|
|
|
let item_str_frags, item_sym_frags =
|
|
Hashtbl.fold symbol_frags_of_code
|
|
sem.Semant.ctxt_all_item_code ([], [])
|
|
in
|
|
let glue_str_frags, glue_sym_frags =
|
|
Hashtbl.fold symbol_frags_of_glue_code
|
|
sem.Semant.ctxt_glue_code ([], [])
|
|
in
|
|
(item_str_frags @ glue_str_frags,
|
|
item_sym_frags @ glue_sym_frags)
|
|
in
|
|
|
|
(* Emit rodata export symbols. *)
|
|
let (rodata_strtab_frags, rodata_symtab_frags) =
|
|
match htab_search sem.Semant.ctxt_native_provided SEG_data with
|
|
None -> ([], [])
|
|
| Some etab ->
|
|
Hashtbl.fold
|
|
begin
|
|
fun name fix x ->
|
|
let (strtab_frags, symtab_frags) = x in
|
|
let (str, sym) = rodata_sym name STB_GLOBAL fix in
|
|
(str :: strtab_frags,
|
|
sym :: symtab_frags)
|
|
end
|
|
etab
|
|
([],[])
|
|
in
|
|
|
|
(* Emit rodata fragments (possibly named). *)
|
|
let (rodata_strtab_frags,
|
|
rodata_symtab_frags,
|
|
rodata_body_frags) =
|
|
Hashtbl.fold
|
|
(frags_of_symbol rodata_sym STB_GLOBAL)
|
|
rodata_frags
|
|
(rodata_strtab_frags, rodata_symtab_frags, [])
|
|
in
|
|
|
|
|
|
let (data_strtab_frags,
|
|
data_symtab_frags,
|
|
data_body_frags) =
|
|
Hashtbl.fold (frags_of_symbol data_sym STB_GLOBAL) data_frags ([],[],[])
|
|
in
|
|
|
|
let (bss_strtab_frags,
|
|
bss_symtab_frags,
|
|
bss_body_frags) =
|
|
Hashtbl.fold (frags_of_symbol bss_sym STB_GLOBAL) bss_frags ([],[],[])
|
|
in
|
|
|
|
let (_,
|
|
require_strtab_frags,
|
|
require_symtab_frags,
|
|
plt_frags,
|
|
got_plt_frags,
|
|
rela_plt_frags) =
|
|
Hashtbl.fold (frags_of_require_symbol require_sym STB_GLOBAL)
|
|
required_fixups
|
|
(1,[],[],[plt0_frag],[got_prefix],[])
|
|
in
|
|
let require_symtab_frags = List.rev require_symtab_frags in
|
|
let plt_frags = List.rev plt_frags in
|
|
let got_plt_frags = List.rev got_plt_frags in
|
|
let rela_plt_frags = List.rev rela_plt_frags in
|
|
|
|
let dynamic_needed_strtab_frags =
|
|
Array.make (Array.length needed_libs) MARK
|
|
in
|
|
|
|
let dynamic_frags =
|
|
let dynamic_needed_frags = Array.make (Array.length needed_libs) MARK in
|
|
for i = 0 to (Array.length needed_libs) - 1 do
|
|
let fixup =
|
|
new_fixup ("needed library name fixup: " ^ needed_libs.(i))
|
|
in
|
|
dynamic_needed_frags.(i) <-
|
|
elf32_dyn_frag (DT_NEEDED, SUB (M_POS fixup,
|
|
M_POS dynstr_section_fixup));
|
|
dynamic_needed_strtab_frags.(i) <-
|
|
DEF (fixup, ZSTRING needed_libs.(i))
|
|
done;
|
|
(SEQ [|
|
|
SEQ dynamic_needed_frags;
|
|
elf32_dyn_frag (DT_STRTAB, M_POS dynstr_section_fixup);
|
|
elf32_dyn_frag (DT_STRSZ, M_SZ dynstr_section_fixup);
|
|
|
|
elf32_dyn_frag (DT_SYMTAB, M_POS dynsym_section_fixup);
|
|
elf32_dyn_frag (DT_SYMENT, IMM elf32_symsize);
|
|
|
|
elf32_dyn_frag (DT_HASH, M_POS hash_section_fixup);
|
|
elf32_dyn_frag (DT_PLTGOT, M_POS got_plt_section_fixup);
|
|
|
|
elf32_dyn_frag (DT_PLTREL, IMM (elf32_num_of_dyn_tag DT_RELA));
|
|
elf32_dyn_frag (DT_PLTRELSZ, M_SZ rela_plt_section_fixup);
|
|
elf32_dyn_frag (DT_JMPREL, M_POS rela_plt_section_fixup);
|
|
|
|
elf32_dyn_frag (DT_NULL, IMM 0L)
|
|
|])
|
|
in
|
|
|
|
let null_strtab_fixup = new_fixup "null dynstrtab entry" in
|
|
let null_strtab_frag = DEF (null_strtab_fixup, ZSTRING "") in
|
|
let null_symtab_frag = (symbol
|
|
~string_table_fixup: dynstr_section_fixup
|
|
~name_string_fixup: null_strtab_fixup
|
|
~sym_target_fixup: None
|
|
~st_bind: STB_LOCAL
|
|
~st_type: STT_NOTYPE
|
|
~st_shndx: 0L) in
|
|
|
|
let dynsym_frags = (null_symtab_frag ::
|
|
(require_symtab_frags @
|
|
global_text_symtab_frags @
|
|
local_text_symtab_frags @
|
|
rodata_symtab_frags @
|
|
data_symtab_frags @
|
|
bss_symtab_frags))
|
|
in
|
|
|
|
let dynstr_frags = (null_strtab_frag ::
|
|
(require_strtab_frags @
|
|
global_text_strtab_frags @
|
|
local_text_strtab_frags @
|
|
rodata_strtab_frags @
|
|
data_strtab_frags @
|
|
bss_strtab_frags @
|
|
(Array.to_list dynamic_needed_strtab_frags)))
|
|
in
|
|
|
|
let interp_section =
|
|
|
|
DEF (interp_section_fixup, ZSTRING
|
|
(if sess.Session.sess_targ = FreeBSD_x86_elf
|
|
then "/libexec/ld-elf.so.1"
|
|
else "/lib/ld-linux.so.2"))
|
|
in
|
|
|
|
let text_section =
|
|
DEF (text_section_fixup,
|
|
SEQ (Array.of_list text_body_frags))
|
|
in
|
|
let rodata_section =
|
|
DEF (rodata_section_fixup,
|
|
SEQ (Array.of_list rodata_body_frags))
|
|
in
|
|
let data_section =
|
|
DEF (data_section_fixup,
|
|
SEQ (Array.of_list data_body_frags))
|
|
in
|
|
let bss_section =
|
|
DEF (bss_section_fixup,
|
|
SEQ (Array.of_list bss_body_frags))
|
|
in
|
|
let dynsym_section =
|
|
DEF (dynsym_section_fixup,
|
|
SEQ (Array.of_list dynsym_frags))
|
|
in
|
|
let dynstr_section =
|
|
DEF (dynstr_section_fixup,
|
|
SEQ (Array.of_list dynstr_frags))
|
|
in
|
|
|
|
let hash_section =
|
|
let n_syms = !n_syms in
|
|
|
|
DEF (hash_section_fixup,
|
|
(* Worst hashtable ever: one chain. *)
|
|
SEQ [|
|
|
WORD (TY_u32, IMM 1L); (* nbucket *)
|
|
WORD (TY_u32, (* nchain *)
|
|
IMM (Int64.of_int n_syms));
|
|
WORD (TY_u32, IMM 1L); (* bucket 0 => symbol 1. *)
|
|
SEQ
|
|
begin
|
|
Array.init
|
|
n_syms
|
|
(fun i ->
|
|
let next = (* chain[i] => if last then 0 else i+1 *)
|
|
if i > 0 && i < (n_syms-1)
|
|
then Int64.of_int (i+1)
|
|
else 0L
|
|
in
|
|
WORD (TY_u32, IMM next))
|
|
end;
|
|
|])
|
|
in
|
|
|
|
let plt_section =
|
|
DEF (plt_section_fixup,
|
|
SEQ (Array.of_list plt_frags))
|
|
in
|
|
|
|
let got_plt_section =
|
|
DEF (got_plt_section_fixup,
|
|
SEQ (Array.of_list got_plt_frags))
|
|
in
|
|
|
|
let rela_plt_section =
|
|
DEF (rela_plt_section_fixup,
|
|
SEQ (Array.of_list rela_plt_frags))
|
|
in
|
|
|
|
let dynamic_section =
|
|
DEF (dynamic_section_fixup, dynamic_frags)
|
|
in
|
|
|
|
let note_rust_section =
|
|
DEF (note_rust_section_fixup,
|
|
(Asm.note_rust_frags crate.node.Ast.crate_meta))
|
|
in
|
|
|
|
|
|
let page_alignment = 0x1000 in
|
|
|
|
let align_both i =
|
|
ALIGN_FILE (page_alignment,
|
|
(ALIGN_MEM (page_alignment, i)))
|
|
in
|
|
|
|
let def_aligned f i =
|
|
align_both
|
|
(SEQ [| DEF(f,i);
|
|
(align_both MARK)|])
|
|
in
|
|
|
|
let debug_aranges_section =
|
|
def_aligned
|
|
sem.Semant.ctxt_debug_aranges_fixup
|
|
dwarf.Dwarf.debug_aranges
|
|
in
|
|
let debug_pubnames_section =
|
|
def_aligned
|
|
sem.Semant.ctxt_debug_pubnames_fixup
|
|
dwarf.Dwarf.debug_pubnames
|
|
in
|
|
let debug_info_section =
|
|
def_aligned
|
|
sem.Semant.ctxt_debug_info_fixup
|
|
dwarf.Dwarf.debug_info
|
|
in
|
|
let debug_abbrev_section =
|
|
def_aligned
|
|
sem.Semant.ctxt_debug_abbrev_fixup
|
|
dwarf.Dwarf.debug_abbrev
|
|
in
|
|
let debug_line_section =
|
|
def_aligned
|
|
sem.Semant.ctxt_debug_line_fixup
|
|
dwarf.Dwarf.debug_line
|
|
in
|
|
let debug_frame_section =
|
|
def_aligned sem.Semant.ctxt_debug_frame_fixup dwarf.Dwarf.debug_frame
|
|
in
|
|
|
|
let load_address = 0x0804_8000L in
|
|
|
|
SEQ
|
|
[|
|
|
MEMPOS load_address;
|
|
ALIGN_FILE
|
|
(segment_2_align,
|
|
DEF
|
|
(segment_2_fixup,
|
|
SEQ
|
|
[|
|
|
DEF (sem.Semant.ctxt_image_base_fixup, MARK);
|
|
elf_header;
|
|
ALIGN_FILE
|
|
(segment_0_align,
|
|
DEF
|
|
(segment_0_fixup,
|
|
SEQ
|
|
[|
|
|
DEF (program_header_table_fixup,
|
|
program_header_table);
|
|
|]));
|
|
ALIGN_FILE
|
|
(segment_1_align,
|
|
DEF (segment_1_fixup, interp_section));
|
|
text_section;
|
|
rodata_section;
|
|
dynsym_section;
|
|
dynstr_section;
|
|
hash_section;
|
|
plt_section;
|
|
rela_plt_section;
|
|
debug_aranges_section;
|
|
debug_pubnames_section;
|
|
debug_info_section;
|
|
debug_abbrev_section;
|
|
debug_line_section;
|
|
debug_frame_section;
|
|
|]));
|
|
ALIGN_FILE
|
|
(segment_3_align,
|
|
DEF
|
|
(segment_3_fixup,
|
|
SEQ
|
|
[|
|
|
data_section;
|
|
got_plt_section;
|
|
bss_section;
|
|
ALIGN_FILE
|
|
(segment_4_align,
|
|
DEF (segment_4_fixup,
|
|
dynamic_section));
|
|
ALIGN_FILE
|
|
(segment_5_align,
|
|
DEF (segment_5_fixup,
|
|
note_rust_section));
|
|
|]));
|
|
DEF (shstrtab_section_fixup,
|
|
shstrtab_section);
|
|
DEF (section_header_table_fixup,
|
|
section_header_table);
|
|
|]
|
|
;;
|
|
|
|
let emit_file
|
|
(sess:Session.sess)
|
|
(crate:Ast.crate)
|
|
(code:Asm.frag)
|
|
(data:Asm.frag)
|
|
(sem:Semant.ctxt)
|
|
(dwarf:Dwarf.debug_records)
|
|
: unit =
|
|
|
|
let text_frags = Hashtbl.create 4 in
|
|
let rodata_frags = Hashtbl.create 4 in
|
|
let data_frags = Hashtbl.create 4 in
|
|
let bss_frags = Hashtbl.create 4 in
|
|
let required_fixups = Hashtbl.create 4 in
|
|
|
|
(*
|
|
* Startup on elf-linux is more complex than in win32. It's
|
|
* thankfully documented in some detail around the net.
|
|
*
|
|
* - The elf entry address is for _start.
|
|
*
|
|
* - _start pushes:
|
|
*
|
|
* eax (should be zero)
|
|
* esp (holding the kernel-provided stack end)
|
|
* edx (address of _rtld_fini)
|
|
* address of _fini
|
|
* address of _init
|
|
* ecx (argv)
|
|
* esi (argc)
|
|
* address of main
|
|
*
|
|
* and then calls __libc_start_main@plt.
|
|
*
|
|
* - This means any sensible binary has a PLT. Fun. So
|
|
* We call into the PLT, which itself is just a bunch
|
|
* of indirect jumps through slots in the GOT, and wind
|
|
* up in __libc_start_main. Which calls _init, then
|
|
* essentially exit(main(argc,argv)).
|
|
*)
|
|
|
|
|
|
let init_fixup = new_fixup "_init function entry" in
|
|
let fini_fixup = new_fixup "_fini function entry" in
|
|
let (start_fixup, rust_start_fixup) =
|
|
if sess.Session.sess_library_mode
|
|
then (None, None)
|
|
else (Some (new_fixup "start function entry"),
|
|
Some (Semant.require_native sem REQUIRED_LIB_rustrt "rust_start"))
|
|
in
|
|
let libc_start_main_fixup = new_fixup "__libc_start_main@plt stub" in
|
|
|
|
let start_fn _ =
|
|
let start_fixup =
|
|
match start_fixup with
|
|
None -> bug () "missing start fixup in non-library mode"
|
|
| Some s -> s
|
|
in
|
|
let e = X86.new_emitter_without_vregs () in
|
|
let push_r32 r = Il.emit e
|
|
(Il.Push (Il.Cell (Il.Reg (Il.Hreg r, Il.ValTy Il.Bits32))))
|
|
in
|
|
let push_pos32 = X86.push_pos32 e in
|
|
|
|
Il.emit e (Il.unary Il.UMOV (X86.rc X86.ebp) (X86.immi 0L));
|
|
Il.emit e (Il.Pop (X86.rc X86.esi));
|
|
Il.emit e (Il.unary Il.UMOV (X86.rc X86.ecx) (X86.ro X86.esp));
|
|
Il.emit e (Il.binary Il.AND
|
|
(X86.rc X86.esp) (X86.ro X86.esp)
|
|
(X86.immi 0xfffffffffffffff0L));
|
|
|
|
push_r32 X86.eax;
|
|
push_r32 X86.esp;
|
|
push_r32 X86.edx;
|
|
push_pos32 fini_fixup;
|
|
push_pos32 init_fixup;
|
|
push_r32 X86.ecx;
|
|
push_r32 X86.esi;
|
|
push_pos32 start_fixup;
|
|
Il.emit e (Il.call
|
|
(Il.Reg (Il.Hreg X86.eax, Il.ValTy Il.Bits32))
|
|
(Il.direct_code_ptr libc_start_main_fixup));
|
|
X86.frags_of_emitted_quads sess e
|
|
in
|
|
|
|
let do_nothing_fn _ =
|
|
let e = X86.new_emitter_without_vregs () in
|
|
Il.emit e Il.Ret;
|
|
X86.frags_of_emitted_quads sess e
|
|
in
|
|
|
|
let main_fn _ =
|
|
match (start_fixup, rust_start_fixup, sem.Semant.ctxt_main_fn_fixup) with
|
|
(None, _, _)
|
|
| (_, None, _)
|
|
| (_, _, None) -> MARK
|
|
| (Some start_fixup,
|
|
Some rust_start_fixup,
|
|
Some main_fn_fixup) ->
|
|
let e = X86.new_emitter_without_vregs () in
|
|
X86.objfile_start e
|
|
~start_fixup
|
|
~rust_start_fixup
|
|
~main_fn_fixup
|
|
~crate_fixup: sem.Semant.ctxt_crate_fixup
|
|
~indirect_start: false;
|
|
X86.frags_of_emitted_quads sess e
|
|
in
|
|
|
|
let needed_libs =
|
|
[|
|
|
if sess.Session.sess_targ = FreeBSD_x86_elf
|
|
then "libc.so.7"
|
|
else "libc.so.6";
|
|
"librustrt.so"
|
|
|]
|
|
in
|
|
|
|
let _ =
|
|
if not sess.Session.sess_library_mode
|
|
then
|
|
begin
|
|
htab_put text_frags (Some "_start") (start_fn());
|
|
htab_put text_frags (Some "_init")
|
|
(DEF (init_fixup, do_nothing_fn()));
|
|
htab_put text_frags (Some "_fini")
|
|
(DEF (fini_fixup, do_nothing_fn()));
|
|
htab_put text_frags (Some "main") (main_fn ());
|
|
htab_put required_fixups "__libc_start_main" libc_start_main_fixup;
|
|
end;
|
|
htab_put text_frags None code;
|
|
htab_put rodata_frags None data;
|
|
|
|
if sess.Session.sess_targ = FreeBSD_x86_elf
|
|
then
|
|
(*
|
|
* FreeBSD wants some extra symbols in .bss so its libc can fill
|
|
* them in, I think.
|
|
*)
|
|
List.iter
|
|
(fun x -> htab_put bss_frags (Some x) (WORD (TY_u32, (IMM 0L))))
|
|
[
|
|
"environ";
|
|
"optind";
|
|
"optarg";
|
|
"_CurrentRuneLocale";
|
|
"__stack_chk_guard";
|
|
"__mb_sb_limit";
|
|
"__isthreaded";
|
|
"__stdinp";
|
|
"__stderrp";
|
|
"__stdoutp";
|
|
];
|
|
|
|
Hashtbl.iter
|
|
begin
|
|
fun _ tab ->
|
|
Hashtbl.iter
|
|
begin
|
|
fun name fixup ->
|
|
htab_put required_fixups name fixup
|
|
end
|
|
tab
|
|
end
|
|
sem.Semant.ctxt_native_required
|
|
in
|
|
|
|
let all_frags =
|
|
elf32_linux_x86_file
|
|
~sess
|
|
~crate
|
|
~entry_name: "_start"
|
|
~text_frags
|
|
~data_frags
|
|
~bss_frags
|
|
~dwarf
|
|
~sem
|
|
~rodata_frags
|
|
~required_fixups
|
|
~needed_libs
|
|
in
|
|
write_out_frag sess true all_frags
|
|
;;
|
|
|
|
let elf_magic = "\x7fELF";;
|
|
|
|
let sniff
|
|
(sess:Session.sess)
|
|
(filename:filename)
|
|
: asm_reader option =
|
|
try
|
|
let stat = Unix.stat filename in
|
|
if (stat.Unix.st_kind = Unix.S_REG) &&
|
|
(stat.Unix.st_size > 4)
|
|
then
|
|
let ar = new_asm_reader sess filename in
|
|
let _ = log sess "sniffing ELF file" in
|
|
if (ar.asm_get_zstr_padded 4) = elf_magic
|
|
then (ar.asm_seek 0; Some ar)
|
|
else None
|
|
else
|
|
None
|
|
with
|
|
_ -> None
|
|
;;
|
|
|
|
let get_sections
|
|
(sess:Session.sess)
|
|
(ar:asm_reader)
|
|
: (string,(int*int)) Hashtbl.t =
|
|
let sects = Hashtbl.create 0 in
|
|
let _ = log sess "reading sections" in
|
|
let elf_id = ar.asm_get_zstr_padded 4 in
|
|
let _ = assert (elf_id = elf_magic) in
|
|
|
|
let _ = ar.asm_seek 0x10 in
|
|
let _ = ar.asm_adv_u16 () in (* e_type *)
|
|
let _ = ar.asm_adv_u16 () in (* e_machine *)
|
|
let _ = ar.asm_adv_u32 () in (* e_version *)
|
|
let _ = ar.asm_adv_u32 () in (* e_entry *)
|
|
let _ = ar.asm_adv_u32 () in (* e_phoff *)
|
|
let e_shoff = ar.asm_get_u32 () in (* e_shoff *)
|
|
let _ = ar.asm_adv_u32 () in (* e_flags *)
|
|
let _ = ar.asm_adv_u16 () in (* e_ehsize *)
|
|
let _ = ar.asm_adv_u16 () in (* e_phentsize *)
|
|
let _ = ar.asm_adv_u16 () in (* e_phnum *)
|
|
let e_shentsize = ar.asm_get_u16 () in
|
|
let e_shnum = ar.asm_get_u16 () in
|
|
let e_shstrndx = ar.asm_get_u16 () in
|
|
let _ = log sess
|
|
"%d ELF section headers, %d bytes each, starting at 0x%x"
|
|
e_shnum e_shentsize e_shoff
|
|
in
|
|
let _ = log sess "section %d is .shstrtab" e_shstrndx in
|
|
|
|
let read_section_hdr n =
|
|
let _ = ar.asm_seek (e_shoff + n * e_shentsize) in
|
|
let str_off = ar.asm_get_u32() in
|
|
let _ = ar.asm_adv_u32() in (* sh_type *)
|
|
let _ = ar.asm_adv_u32() in (* sh_flags *)
|
|
let _ = ar.asm_adv_u32() in (* sh_addr *)
|
|
let off = ar.asm_get_u32() in (* sh_off *)
|
|
let size = ar.asm_get_u32() in (* sh_size *)
|
|
let _ = ar.asm_adv_u32() in (* sh_link *)
|
|
let _ = ar.asm_adv_u32() in (* sh_info *)
|
|
let _ = ar.asm_adv_u32() in (* sh_addralign *)
|
|
let _ = ar.asm_adv_u32() in (* sh_entsize *)
|
|
(str_off, off, size)
|
|
in
|
|
|
|
let (_, str_base, _) = read_section_hdr e_shstrndx in
|
|
|
|
let _ = ar.asm_seek e_shoff in
|
|
for i = 0 to (e_shnum - 1) do
|
|
let (str_off, off, size) = read_section_hdr i in
|
|
let _ = ar.asm_seek (str_base + str_off) in
|
|
let name = ar.asm_get_zstr() in
|
|
log sess "section %d: %s, size %d, offset 0x%x" i name size off;
|
|
Hashtbl.add sects name (off, size);
|
|
done;
|
|
sects
|
|
;;
|
|
|
|
|
|
(*
|
|
* Local Variables:
|
|
* fill-column: 78;
|
|
* indent-tabs-mode: nil
|
|
* buffer-file-coding-system: utf-8-unix
|
|
* compile-command: "make -k -C $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
|
|
* End:
|
|
*)
|