@@ -67,80 +67,86 @@ let save ?(parent : int option) (seed : Seed.t) =
6767let evaluate_seeds_and_construct_seedpool seeds node_tbl distmap =
6868 let open AUtil in
6969 let pool = create () in
70- (* let pools =
71- List.fold_left
72- (fun pools (_, llm, traces) ->
73- let seed = Seed.make llm traces "" node_tbl distmap in
74- L.debug "evaluate seed: \n%s\n" (ALlvm.string_of_llmodule llm);
75- L.debug "score: %s" (string_of_float (Seed.score seed));
76- seed :: pools)
77- [] seeds
78- in
79- let init_cov =
80- List.fold_left
81- (fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
82- Coverage.empty pools
83- in
84- pools |> List.to_seq |> add_seq pool;
85- (pool, init_cov) *)
86- let pool_covers, pool_noncovers =
87- List. fold_left
88- (fun (pool_covers , pool_noncovers ) (_ , llm , traces ) ->
89- let seed = Seed. make llm traces " " node_tbl distmap in
90- L. debug " evaluate seed: \n %s\n " (ALlvm. string_of_llmodule llm);
91- L. debug " score: %s" (string_of_float (Seed. score seed));
92- (* will assume all-edges option to non-directed fuzzing *)
93- if ! Config. coverage = Config.FuzzingMode. All_edges then
94- (pool_covers, seed :: pool_noncovers)
95- else if Seed. covers seed then (seed :: pool_covers, pool_noncovers)
96- else (pool_covers, seed :: pool_noncovers))
97- ([] , [] ) seeds
98- in
99- if pool_covers = [] then (
100- L. info " No covering seeds found. Using closest seeds." ;
101- let pool_closest =
102- pool_noncovers
103- |> List. sort_uniq (fun a b ->
104- compare
105- (ALlvm. hash_llm (Seed. llmodule a))
106- (ALlvm. hash_llm (Seed. llmodule b)))
107- in
108- let pool_closest =
109- if ! Config. score = Config.FuzzingMode. Constant then pool_closest
110- else
111- pool_closest
112- |> List. sort (fun a b -> compare (Seed. score a) (Seed. score b))
113- in
114- let pool_closest =
115- (* will assume all-edges option to non-directed fuzzing *)
116- if ! Config. coverage = Config.FuzzingMode. All_edges then pool_closest
117- else pool_closest |> take ! Config. max_initial_seed
70+ if
71+ (* Optimuzz_Base *)
72+ ! Config. score = Config.FuzzingMode. Constant
73+ && ! Config. coverage = Config.FuzzingMode. All_edges
74+ then (
75+ let pools =
76+ List. fold_left
77+ (fun pools (_ , llm , traces ) ->
78+ let seed = Seed. make llm traces " " node_tbl distmap in
79+ L. debug " evaluate seed: \n %s\n " (ALlvm. string_of_llmodule llm);
80+ L. debug " score: %s" (string_of_float (Seed. score seed));
81+ seed :: pools)
82+ [] seeds
11883 in
119-
12084 let init_cov =
12185 List. fold_left
12286 (fun accu seed -> Coverage. union accu (Seed. edge_cov seed))
123- Coverage. empty pool_closest
87+ Coverage. empty pools
12488 in
125- pool_closest |> List. to_seq |> add_seq pool;
89+ pools |> List. to_seq |> add_seq pool;
12690 (pool, init_cov))
127- else (
128- (* if we have covering seeds, we use covering seeds only. *)
129- L. info " Covering seeds found. Using them only." ;
130- let pool_covers =
131- pool_covers
132- |> List. sort_uniq (fun a b ->
133- compare
134- (ALlvm. hash_llm (Seed. llmodule a))
135- (ALlvm. hash_llm (Seed. llmodule b)))
136- in
137- let init_cov =
91+ else
92+ let pool_covers, pool_noncovers =
13893 List. fold_left
139- (fun accu seed -> Coverage. union accu (Seed. edge_cov seed))
140- Coverage. empty pool_covers
94+ (fun (pool_covers , pool_noncovers ) (_ , llm , traces ) ->
95+ let seed = Seed. make llm traces " " node_tbl distmap in
96+ L. debug " evaluate seed: \n %s\n " (ALlvm. string_of_llmodule llm);
97+ L. debug " score: %s" (string_of_float (Seed. score seed));
98+ (* will assume all-edges option to non-directed fuzzing *)
99+ if ! Config. coverage = Config.FuzzingMode. All_edges then
100+ (pool_covers, seed :: pool_noncovers)
101+ else if Seed. covers seed then (seed :: pool_covers, pool_noncovers)
102+ else (pool_covers, seed :: pool_noncovers))
103+ ([] , [] ) seeds
141104 in
142- pool_covers |> List. to_seq |> add_seq pool;
143- (pool, init_cov))
105+ if pool_covers = [] then (
106+ L. info " No covering seeds found. Using closest seeds." ;
107+ let pool_closest =
108+ pool_noncovers
109+ |> List. sort_uniq (fun a b ->
110+ compare
111+ (ALlvm. hash_llm (Seed. llmodule a))
112+ (ALlvm. hash_llm (Seed. llmodule b)))
113+ in
114+ let pool_closest =
115+ if ! Config. score = Config.FuzzingMode. Constant then pool_closest
116+ else
117+ pool_closest
118+ |> List. sort (fun a b -> compare (Seed. score a) (Seed. score b))
119+ in
120+ let pool_closest =
121+ (* will assume all-edges option to non-directed fuzzing *)
122+ if ! Config. coverage = Config.FuzzingMode. All_edges then pool_closest
123+ else pool_closest |> take ! Config. max_initial_seed
124+ in
125+
126+ let init_cov =
127+ List. fold_left
128+ (fun accu seed -> Coverage. union accu (Seed. edge_cov seed))
129+ Coverage. empty pool_closest
130+ in
131+ pool_closest |> List. to_seq |> add_seq pool;
132+ (pool, init_cov))
133+ else (
134+ (* if we have covering seeds, we use covering seeds only. *)
135+ L. info " Covering seeds found. Using them only." ;
136+ let pool_covers =
137+ pool_covers
138+ |> List. sort_uniq (fun a b ->
139+ compare
140+ (ALlvm. hash_llm (Seed. llmodule a))
141+ (ALlvm. hash_llm (Seed. llmodule b)))
142+ in
143+ let init_cov =
144+ List. fold_left
145+ (fun accu seed -> Coverage. union accu (Seed. edge_cov seed))
146+ Coverage. empty pool_covers
147+ in
148+ pool_covers |> List. to_seq |> add_seq pool;
149+ (pool, init_cov))
144150
145151let make llctx node_tbl (distmap : float Aflgo.DistanceTable.t ) =
146152 let open AUtil in
0 commit comments