Skip to content

Commit e81bcfe

Browse files
sipmasipma
committed
CHB: add error handling
1 parent 5cfb456 commit e81bcfe

File tree

8 files changed

+34
-17
lines changed

8 files changed

+34
-17
lines changed

‎CodeHawk/CH/chutil/cHTraceResult.ml‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
------------------------------------------------------------------------------
55
The MIT License (MIT)
66
7-
Copyright (c) 2023-2024 Aarno Labs LLC
7+
Copyright (c) 2023-2025 Aarno Labs LLC
88
99
Permission is hereby granted, free of charge, to any person obtaining a copy
1010
of this software and associated documentation files (the "Software"), to deal
@@ -105,7 +105,13 @@ let tprop (r: 'a traceresult) (msg: string): 'a traceresult =
105105
| Error e -> Error (msg :: e)
106106

107107

108-
let titer (f: 'a -> unit) (r: 'a traceresult) =
108+
let titer ~(ok:'a -> unit) ~(error: string list -> unit) (r: 'a traceresult) =
109+
match r with
110+
| Ok v -> ok v
111+
| Error e -> error e
112+
113+
114+
let titer_default (f: 'a -> unit) (r: 'a traceresult) =
109115
match r with
110116
| Ok v -> f v
111117
| Error _ -> ()

‎CodeHawk/CH/chutil/cHTraceResult.mli‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -100,8 +100,13 @@ val tbind:
100100
?msg:string -> ('a -> 'c traceresult) -> ('a traceresult) -> 'c traceresult
101101

102102

103-
(** [titer f r] is [f v] if [r] is [Ok v] and [()] otherwise.*)
104-
val titer: ('a -> unit) -> ('a traceresult) -> unit
103+
(** [titer ~ok ~error r] is [ok v] if [r] is [Ok v] and [error e] if [r] is
104+
[Error e].*)
105+
val titer: ok:('a -> unit) -> error:(string list -> unit) -> ('a traceresult) -> unit
106+
107+
108+
(** [titer_default f r] is [f v] if [r] is [Ok v] and [()] otherwise.*)
109+
val titer_default: ('a -> unit) -> 'a traceresult -> unit
105110

106111

107112
(** [tfold_list ~ok init rl] folds [Ok] values left to right, starting from

‎CodeHawk/CHB/bchlib/bCHDataBlock.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
77
Copyright (c) 2005-2019 Kestrel Technology LLC
88
Copyright (c) 2020 Henny B. Sipma
9-
Copyright (c) 2021-2024 Aarno Labs LLC
9+
Copyright (c) 2021-2025 Aarno Labs LLC
1010
1111
Permission is hereby granted, free of charge, to any person obtaining a copy
1212
of this software and associated documentation files (the "Software"), to deal
@@ -372,7 +372,7 @@ let find_seh4_structures_in_section (base:doubleword_int) (section:string) =
372372
let dw = ch#read_doubleword in
373373
if dw#equal wordzero then (* GSCookieXOROffset *)
374374
let startAddr = base#add_int (ch#pos - 8) in
375-
TR.titer
375+
TR.titer_default
376376
(fun db ->
377377
if db#get_length > 16 then
378378
structs := db :: !structs)

‎CodeHawk/CHB/bchlibarm32/bCHARMOperand.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -499,7 +499,7 @@ object (self:'a)
499499
| (ARMShiftedIndexOffset (ivar, srt, i), true) ->
500500
let optscale =
501501
match srt with
502-
| ARMImmSRT (SRType LSL, 3) -> Some 8
502+
| ARMImmSRT (SRType_LSL, 3) -> Some 8
503503
| ARMImmSRT (SRType_LSL, 2) -> Some 4
504504
| ARMImmSRT (SRType_LSL, 0) -> Some 1
505505
| _ -> None in

‎CodeHawk/CHB/bchlibarm32/bCHConstructARMFunction.ml‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -309,8 +309,10 @@ let construct_arm_assembly_block
309309
let newfnentries = new DoublewordCollections.set_t in
310310

311311
let set_block_entry (a: doubleword_int) =
312-
TR.titer (fun instr ->
313-
instr#set_block_entry) (get_arm_assembly_instruction a) in
312+
TR.titer
313+
~ok:(fun instr -> instr#set_block_entry)
314+
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
315+
(get_arm_assembly_instruction a) in
314316

315317
let get_instr = get_arm_assembly_instruction in
316318
let has_next_instr =
@@ -561,7 +563,8 @@ let construct_arm_assembly_function
561563
List.iter (fun a -> if doneset#has a then () else workset#add a) l in
562564
let set_block_entry (baddr: doubleword_int) =
563565
TR.titer
564-
(fun instr -> instr#set_block_entry)
566+
~ok:(fun instr -> instr#set_block_entry)
567+
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
565568
(get_arm_assembly_instruction baddr) in
566569
let blocks = ref [] in
567570
let rec add_block (baddr: doubleword_int) =

‎CodeHawk/CHB/bchlibarm32/bCHFnARMDictionary.ml‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -604,7 +604,6 @@ object (self)
604604
else
605605
Error [__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
606606
^ "Parameter type not recognized in call instruction"] in
607-
let ptype = get_parameter_type p in
608607
let xx = rewrite_expr ?restrict:(Some 4) x in
609608
(*
610609
let xx =

‎CodeHawk/CHB/bchlibmips32/bCHDisassembleMIPS.ml‎

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
77
Copyright (c) 2005-2020 Kestrel Technology LLC
88
Copyright (c) 2020 Henny Sipma
9-
Copyright (c) 2021-2024 Aarno Labs LLC
9+
Copyright (c) 2021-2025 Aarno Labs LLC
1010
1111
Permission is hereby granted, free of charge, to any person obtaining a copy
1212
of this software and associated documentation files (the "Software"), to deal
@@ -585,8 +585,10 @@ let get_successors (faddr:doubleword_int) (iaddr:doubleword_int) =
585585
let trace_block (faddr:doubleword_int) (baddr:doubleword_int) =
586586

587587
let set_block_entry (va: doubleword_int) =
588-
TR.titer (fun instr ->
589-
instr#set_block_entry) (get_mips_assembly_instruction va) in
588+
TR.titer
589+
~ok:(fun instr -> instr#set_block_entry)
590+
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
591+
(get_mips_assembly_instruction va) in
590592

591593
let get_instr iaddr = get_mips_assembly_instruction iaddr in
592594

@@ -717,7 +719,8 @@ let trace_function (faddr:doubleword_int) =
717719
let doneSet = new DoublewordCollections.set_t in
718720
let set_block_entry (baddr: doubleword_int) =
719721
TR.titer
720-
(fun instr -> instr#set_block_entry)
722+
~ok:(fun instr -> instr#set_block_entry)
723+
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
721724
(get_mips_assembly_instruction baddr) in
722725
let get_iaddr s = (ctxt_string_to_location faddr s)#i in
723726
let add_to_workset l =

‎CodeHawk/CHB/bchlibpower32/bCHConstructPowerFunction.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
------------------------------------------------------------------------------
55
The MIT License (MIT)
66
7-
Copyright (c) 2023-2024 Aarno Labs LLC
7+
Copyright (c) 2023-2025 Aarno Labs LLC
88
99
Permission is hereby granted, free of charge, to any person obtaining a copy
1010
of this software and associated documentation files (the "Software"), to deal
@@ -290,7 +290,8 @@ let construct_pwr_assembly_function
290290
List.iter (fun a -> if doneset#has a then () else workset#add a) l in
291291
let set_block_entry (baddr: doubleword_int) =
292292
TR.titer
293-
(fun instr -> instr#set_block_entry)
293+
~ok:(fun instr -> instr#set_block_entry)
294+
~error:(fun e -> log_error_result __FILE__ __LINE__ e)
294295
(get_pwr_assembly_instruction baddr) in
295296
let blocks = ref [] in
296297
let rec add_block (baddr: doubleword_int) =

0 commit comments

Comments
 (0)