Formatstrings

CodeHawk/CH/chutil/cHFormatStringParser.ml

@@ -399,29 +399,11 @@ object (self)
 
   method get_flags = List.rev flags
 
-  method get_fieldwidth =
-    if self#has_fieldwidth then
-      fieldwidth
-    else
-      raise
-        (CHFailure
-           (LBLOCK [STR "Format argument spec does not have a field width"]))
+  method get_fieldwidth = fieldwidth
 
-  method get_precision =
-    if self#has_precision then
-      precision
-    else
-      raise
-        (CHFailure
-           (LBLOCK [STR "Format argument spec does not have a precision"]))
+  method get_precision = precision
 
-  method get_lengthmodifier =
-    if self#has_lengthmodifier then
-      lengthmodifier
-    else
-      raise
-        (CHFailure
-           (LBLOCK [STR "Argument spec does not have a length modifier"]))
+  method get_lengthmodifier = lengthmodifier
 
   method get_conversion = conversion
 
@@ -894,3 +876,48 @@ let parse_formatstring (s:string) (isinput:bool) =
   let result = parser#get_result in
   let _ = result#set_literal_length parser#get_literal_length in
   result
+
+
+let specifier_of_conversion (c: conversion_t): string =
+  match c with
+  | StringConverter -> "s"
+  | IntConverter | DecimalConverter -> "d"
+  | UnsignedDecimalConverter -> "u"
+  | UnsignedOctalConverter -> "o"
+  | UnsignedHexConverter false -> "x"
+  | UnsignedHexConverter true -> "X"
+  | FixedDoubleConverter false -> "f"
+  | FixedDoubleConverter true -> "F"
+  | ExpDoubleConverter false -> "e"
+  | ExpDoubleConverter true -> "E"
+  | FlexDoubleConverter false -> "g"
+  | FlexDoubleConverter true -> "G"
+  | HexDoubleConverter false -> "a"
+  | HexDoubleConverter true -> "A"
+  | UnsignedCharConverter -> "c"
+  | PointerConverter -> "p"
+  | OutputArgument -> "n"
+
+
+let specifier_of_lengthmodifier (lm: lengthmodifier_t): string =
+  match lm with
+  | NoModifier -> "none"
+  | _ ->
+     if H.mem invlengthmodifier_table lm then
+       H.find invlengthmodifier_table lm
+     else
+       raise (CHFailure (LBLOCK [STR "Error in specifier_of_lengthmodifier"]))
+
+
+let specifier_of_fieldwidth (fw: fieldwidth_t): string =
+  match fw with
+  | NoFieldwidth -> "nfw"
+  | FieldwidthArgument -> "fwa"
+  | FieldwidthConstant i -> "fwc:" ^ (string_of_int i)
+
+
+let specifier_of_precision (p: precision_t): string =
+  match p with
+  | NoPrecision -> "np"
+  | PrecisionArgument -> "pa"
+  | PrecisionConstant i -> "pc:" ^ (string_of_int i)

CodeHawk/CH/chutil/cHFormatStringParser.mli

@@ -126,3 +126,8 @@ class type formatstring_parser_int =
 val conversion_table: (int,conversion_t) Hashtbl.t
 val invconversion_table: (conversion_t,int) Hashtbl.t
 val parse_formatstring: string -> bool -> formatstring_spec_int
+
+val specifier_of_conversion: conversion_t -> string
+val specifier_of_lengthmodifier: lengthmodifier_t -> string
+val specifier_of_fieldwidth: fieldwidth_t -> string
+val specifier_of_precision: precision_t -> string

CodeHawk/CHB/bchlib/bCHFloc.ml

@@ -727,6 +727,7 @@ object (self)
                    ["fmt-string: \"" ^ fmtstring ^ "\"";
                     "isinput: " ^ (if isinput then "yes" else "no")] in
                let fmtspec = parse_formatstring fmtstring isinput in
+               let _ = self#f#add_format_string self#cia fmtstring isinput in
                let _ =
                  log_diagnostics_result
                    ~tag:"update-arm-varargs"

CodeHawk/CHB/bchlib/bCHFunctionInfo.ml

@@ -106,6 +106,7 @@ module DoublewordCollections = CHCollections.Make
    end)
 
 
+let bd = BCHDictionary.bdictionary
 let id = BCHInterfaceDictionary.interface_dictionary
 
 let memmap = BCHGlobalMemoryMap.global_memory_map
@@ -1657,6 +1658,7 @@ object (self)
   val env = new function_environment_t faddr fndata varmgr
   val constant_table = new VariableCollections.table_t          (* constants *)
   val calltargets = H.create 5                               (* call-targets *)
+  val formatstrings = H.create 5                           (* format strings *)
 
   val base_pointers = new VariableCollections.set_t         (* base-pointers *)
   val mutable stack_adjustment = None                    (* stack-adjustment *)
@@ -2191,6 +2193,12 @@ object (self)
         if ctinfo#is_call_category cat then acc+1 else acc)
       calltargets 0
 
+  method add_format_string (iaddr: ctxt_iaddress_t) (s: string) (isinput: bool) =
+    if H.mem formatstrings iaddr then
+      ()
+    else
+      H.add formatstrings iaddr (s, isinput)
+
 
   (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *
    * base pointers                                                             *
@@ -2407,6 +2415,22 @@ object (self)
         let ctinfo = read_xml_call_target_info cnode in
         H.add calltargets a ctinfo) (node#getTaggedChildren "ctinfo")
 
+  method private write_xml_format_strings (node: xml_element_int) =
+    let iformatstrings = H.fold (fun k v a -> (k, v) :: a) formatstrings [] in
+    node#appendChildren
+      (List.map
+         (fun (iaddr, (s, isinput)) ->
+           let fsnode = xmlElement "fs" in
+           let fmtspec = CHFormatStringParser.parse_formatstring s isinput in
+           begin
+             fsnode#setAttribute "a" iaddr;
+             (fsnode#setAttribute "kind"
+                (if isinput then "scanf" else "printf"));
+             fsnode#setIntAttribute "ixs" (bd#index_string s);
+             fsnode#setIntAttribute "ixc" (id#index_formatstring_spec fmtspec);
+             fsnode
+           end) iformatstrings)
+
   method private write_xml_constants (node:xml_element_int) =
     let var_to_xml (v,n) =
       let varNode = xmlElement "var" in
@@ -2530,6 +2554,7 @@ object (self)
     let teNode = xmlElement "test-expressions" in
     let jtNode = xmlElement "jump-targets" in
     let ctNode = xmlElement "call-targets" in
+    let fsNode = xmlElement "format-strings" in
     let bpNode = xmlElement "base-pointers" in
     let vvNode = xmlElement "variable-names" in
     let srNode = xmlElement "saved-registers" in
@@ -2543,6 +2568,7 @@ object (self)
       self#write_xml_test_variables tvNode;
       (* self#write_xml_jump_targets jtNode ; *)
       self#write_xml_call_targets ctNode;
+      self#write_xml_format_strings fsNode;
       self#write_xml_base_pointers bpNode;
       self#write_xml_variable_names vvNode;
       self#write_xml_saved_registers srNode;
@@ -2556,6 +2582,7 @@ object (self)
           teNode;
           cNode;
 	  ctNode;
+          fsNode;
           jtNode;
           bpNode;
           vvNode;

CodeHawk/CHB/bchlib/bCHInterfaceDictionary.ml

@@ -33,6 +33,7 @@ open CHNumerical
 open CHPretty
 
 (* chutil *)
+open CHFormatStringParser
 open CHLogger
 open CHIndexTable
 open CHXmlDocument
@@ -70,6 +71,8 @@ class interface_dictionary_t:interface_dictionary_int =
 object (self)
 
   val formatstring_type_table = mk_index_table "formatstring-type-table"
+  val formatarg_spec_table = mk_index_table "formatarg-spec-table"
+  val formatstring_spec_table = mk_index_table "formatstring-spec-table"
   val pld_position_table = mk_index_table "pld-position-table"
   val pld_position_list_table = mk_index_table "pld-position-table-list"
   val parameter_location_detail_table =
@@ -104,6 +107,8 @@ object (self)
   initializer
     tables <- [
       formatstring_type_table;
+      formatarg_spec_table;
+      formatstring_spec_table;
       pld_position_table;
       pld_position_list_table;
       parameter_location_detail_table;
@@ -155,6 +160,20 @@ object (self)
     | "rp" -> RestrictedPrintFormat (List.tl tags)
     | s -> raise_tag_error name s formatstring_type_mcts#tags
 
+  method index_formatarg_spec (a: argspec_int) =
+    let tags = [
+        specifier_of_fieldwidth a#get_fieldwidth;
+        specifier_of_precision a#get_precision;
+        specifier_of_lengthmodifier a#get_lengthmodifier;
+        specifier_of_conversion a#get_conversion] in
+    let key = (tags, a#get_flags) in
+    formatarg_spec_table#add key
+
+  method index_formatstring_spec (f: formatstring_spec_int) =
+    let args =
+      f#get_literal_length :: (List.map self#index_formatarg_spec f#get_arguments) in
+    formatstring_spec_table#add ([], args)
+
   method index_pld_position (p: pld_position_t) =
     let tags = [pld_position_mcts#ts p] in
     let key =

CodeHawk/CHB/bchlib/bCHLibTypes.mli

@@ -37,6 +37,7 @@ open CHNumericalConstraints
 open CHPretty
 
 (* chutil *)
+open CHFormatStringParser
 open CHTraceResult
 open CHXmlDocument
 
@@ -2801,6 +2802,9 @@ class type interface_dictionary_int =
     method index_formatstring_type: formatstring_type_t -> int
     method get_formatstring_type: int -> formatstring_type_t
 
+    method index_formatarg_spec: argspec_int -> int
+    method index_formatstring_spec: formatstring_spec_int -> int
+
     method index_pld_position: pld_position_t -> int
     method get_pld_position: int -> pld_position_t
 
@@ -6142,6 +6146,8 @@ object
       the address of the associated call instruction.*)
   method get_callees_located: (ctxt_iaddress_t * call_target_info_int) list
 
+  method add_format_string: ctxt_iaddress_t -> string -> bool -> unit
+
   (** {1 Save and restore}*)
 
   (** [finfo#write_xml xnode] writes the internal state of the function-info

CodeHawk/CHB/bchlib/bCHVersion.ml

@@ -95,8 +95,8 @@ end
 
 
 let version = new version_info_t 
-  ~version:"0.6.0_20260614"
-  ~date:"2026-06-14"
+  ~version:"0.6.0_20260617"
+  ~date:"2026-06-17"
   ~licensee: None
   ~maxfilesize: None
   ()