@@ -105,12 +105,17 @@ let ud_get_offset (sectionname: string) =
105105 (LBLOCK [STR " No offset found for " ; STR sectionname]))
106106
107107
108- let assumption_violation (p :pretty_t ) =
109- let msg = LBLOCK [STR " Section header creation assumption violation: " ; p] in
110- begin
111- ch_error_log#add " section header creation" msg;
112- raise (BCH_failure msg)
113- end
108+ let assumption_violation
109+ (line : int ) (s : elf_dynamic_segment_int ) (p :pretty_t ) =
110+ let msg =
111+ LBLOCK [STR " bCHELFSectionHeaderCreator:" ; INT line; STR " : " ;
112+ STR " Assumption violation: " ; p] in
113+ begin
114+ ch_error_log#add
115+ " section header creation"
116+ (LBLOCK [msg; NL ; STR " Dynamic table: " ; NL ; s#toPretty;NL ]);
117+ raise (BCH_failure msg)
118+ end
114119
115120
116121class section_header_creator_t
@@ -162,23 +167,31 @@ object (self)
162167
163168 method private get_offset_2 (vaddr :doubleword_int ): doubleword_int =
164169 match loadsegments with
165- | [] -> raise (BCH_failure (LBLOCK [ STR " No load segments found" ]))
166- | [ (_,_,_) ] ->
167- assumption_violation (STR " Only one load segment found" )
170+ | [] ->
171+ assumption_violation
172+ __LINE__ dynamicsegment (LBLOCK [ STR " No load segments found" ])
173+ | [ (_, _, _) ] ->
174+ assumption_violation
175+ __LINE__
176+ dynamicsegment
177+ (STR " Only one load segment found" )
168178 | (_ ,_ ,_ )::(_ ,ph ,_ )::_ ->
169179 let base2 = ph#get_vaddr in
170180 let offset2 = ph#get_offset in
171- let basediff =
172- fail_tvalue
173- (trerror_record
174- (LBLOCK [
175- STR " BCHELFSectionHeaderCreator#get_offset_2: " ;
176- STR " vaddr: " ;
177- vaddr#toPretty;
178- STR " ; base2: " ;
179- base2#toPretty]))
180- (vaddr#subtract base2) in
181- basediff#add offset2
181+ TR. tfold
182+ ~ok: (fun basediff -> basediff#add offset2)
183+ ~error: (fun e ->
184+ assumption_violation
185+ __LINE__
186+ dynamicsegment
187+ (LBLOCK [
188+ STR " Base2 address: " ;
189+ base2#toPretty;
190+ STR " cannot be subtracted from vaddr: " ;
191+ vaddr#toPretty;
192+ STR " : " ;
193+ STR (String. concat " ; " e)]))
194+ (vaddr#subtract base2)
182195
183196 method private has_interp_program_header =
184197 List. exists
@@ -196,8 +209,10 @@ object (self)
196209 | _ -> false ) phdrs in ph
197210 with
198211 | Not_found ->
199- raise
200- (BCH_failure (LBLOCK [ STR " PT_INTERP program header not found" ]))
212+ assumption_violation
213+ __LINE__
214+ dynamicsegment
215+ (LBLOCK [STR " PT_INTERP program header not found" ])
201216
202217 method private get_dynamic_program_header =
203218 try
@@ -208,7 +223,10 @@ object (self)
208223 | _ -> false ) phdrs in ph
209224 with
210225 | Not_found ->
211- assumption_violation (STR " PT_DYNAMIC program header not found" )
226+ assumption_violation
227+ __LINE__
228+ dynamicsegment
229+ (STR " PT_DYNAMIC program header not found" )
212230
213231 method private has_reginfo_program_header =
214232 List. exists (fun (_ ,ph ,_ ) ->
@@ -225,8 +243,10 @@ object (self)
225243 | _ -> false ) phdrs in ph
226244 with
227245 | Not_found ->
228- raise
229- (BCH_failure (LBLOCK [ STR " PT_REGINFO program header not found" ]))
246+ assumption_violation
247+ __LINE__
248+ dynamicsegment
249+ (LBLOCK [STR " PT_REGINFO program header not found" ])
230250
231251 method get_section_headers =
232252 List. mapi
@@ -383,7 +403,7 @@ object (self)
383403 let offset = self#get_offset_1 vaddr in
384404 let trsize = symtabaddr#subtract vaddr in
385405 if Result. is_error trsize then
386- assumption_violation (STR " DT_SYMTAB < DT_HASH" )
406+ assumption_violation __LINE__ dynamicsegment (STR " DT_SYMTAB < DT_HASH" )
387407 else
388408 let size = TR. tget_ok trsize in
389409 let entsize = s2d " 0x4" in
@@ -395,6 +415,8 @@ object (self)
395415 end
396416 else
397417 assumption_violation
418+ __LINE__
419+ dynamicsegment
398420 (STR " DT_HASH or DT_SYMTAB not present, or DT_HASH is zero" )
399421
400422 (* inputs: from dynamic table, program header, type PT_Load (1)
@@ -422,14 +444,10 @@ object (self)
422444 else if ud_has_size sectionname then
423445 ud_get_size sectionname
424446 else
425- begin
426- chlog#add " dynamic table" (dynamicsegment#toPretty);
427- assumption_violation
428- (LBLOCK [
429- STR " Unable to determine size of dynamic symbol table" ;
430- NL ;
431- dynamicsegment#toPretty])
432- end in
447+ assumption_violation
448+ __LINE__
449+ dynamicsegment
450+ (LBLOCK [STR " Unable to determine size of dynamic symbol table" ]) in
433451 let sh = mk_elf_section_header () in
434452 let stype = s2d " 0xb" in
435453 let flags = s2d " 0x2" in
@@ -491,7 +509,15 @@ object (self)
491509 let addr = vaddr in
492510 let offset = self#get_offset_1 vaddr in
493511 let size =
494- TR. tget_ok (numerical_to_doubleword dynamicsegment#get_string_table_size) in
512+ TR. tfold
513+ ~ok: Fun. id
514+ ~error: (fun e ->
515+ assumption_violation
516+ __LINE__
517+ dynamicsegment
518+ (LBLOCK [STR " Illegal size of string table: " ;
519+ STR (String. concat " ; " e)]))
520+ (numerical_to_doubleword dynamicsegment#get_string_table_size) in
495521 let addralign = s2d " 0x1" in
496522 begin
497523 sh#set_fields
@@ -693,7 +719,7 @@ object (self)
693719 section_headers < - sh :: section_headers
694720 end
695721 else
696- assumption_violation (STR " DT_INIT not present" )
722+ assumption_violation __LINE__ dynamicsegment (STR " DT_INIT not present" )
697723
698724 (* inputs: from elf file header, program header, type PT_Load (1)
699725 * - addr: fh#get_program_entry_point ?
@@ -726,18 +752,22 @@ object (self)
726752 let finiaddr = dynamicsegment#get_fini_address in
727753 let finidiff = finiaddr#subtract vaddr in
728754 if Result. is_error finidiff then
729- assumption_violation (STR " DT_FINI < program entry point" )
755+ assumption_violation
756+ __LINE__ dynamicsegment (STR " DT_FINI < program entry point" )
730757 else
731758 TR. tget_ok finidiff
732759 else if dynamicsegment#has_init_address then
733760 let initaddress = dynamicsegment#get_init_address in
734761 let initdiff = initaddress#subtract vaddr in
735762 if Result. is_error initdiff then
736- assumption_violation (STR " DT_INIT < program entry point" )
763+ assumption_violation
764+ __LINE__ dynamicsegment (STR " DT_INIT < program entry point" )
737765 else
738766 TR. tget_ok initdiff
739767 else
740768 assumption_violation
769+ __LINE__
770+ dynamicsegment
741771 (LBLOCK [
742772 STR " DT_INIT and DT_FINI not present; " ;
743773 STR " please provide size of .text section in fixup data" ]) in
@@ -806,17 +836,21 @@ object (self)
806836 let vaddr = finiaddr#add finisize in
807837 let phenddiff = phend#subtract finiaddr in
808838 if Result. is_error phenddiff then
809- assumption_violation (STR " PT_Load(end) < finiaddr" )
839+ assumption_violation
840+ __LINE__ dynamicsegment (STR " PT_Load(end) < finiaddr" )
810841 else
811842 let trsize = (TR. tget_ok phenddiff)#subtract finisize in
812843 if Result. is_error trsize then
813- assumption_violation (STR " PT_Load(end) < finiaddr" )
844+ assumption_violation
845+ __LINE__ dynamicsegment (STR " PT_Load(end) < finiaddr" )
814846 else
815847 let size = TR. tget_ok trsize in
816848 (vaddr, size)
817849 else
818850 begin
819851 assumption_violation
852+ __LINE__
853+ dynamicsegment
820854 (LBLOCK [
821855 STR " No addr/size information for .rodata; " ;
822856 STR " please supply in fixup data" ])
@@ -976,7 +1010,8 @@ object (self)
9761010 let offset = self#get_offset_2 vaddr in
9771011 let trsize = rldmapaddr#subtract vaddr in
9781012 if Result. is_error trsize then
979- assumption_violation (STR " DT_MIPS_RLD_MAP < data header address" )
1013+ assumption_violation
1014+ __LINE__ dynamicsegment (STR " DT_MIPS_RLD_MAP < data header address" )
9801015 else
9811016 let size = TR. tget_ok trsize in
9821017 let addralign = s2d " 0x4" in
@@ -1050,7 +1085,7 @@ object (self)
10501085 let offset = self#get_offset_2 vaddr in
10511086 let trsize = (ph#get_vaddr#add ph#get_file_size)#subtract vaddr in
10521087 if Result. is_error trsize then
1053- assumption_violation (STR " filesize < vaddr" )
1088+ assumption_violation __LINE__ dynamicsegment (STR " filesize < vaddr" )
10541089 else
10551090 let size = TR. tget_ok trsize in
10561091 let addralign = s2d " 0x4" in
0 commit comments