Merge pull request #46 from dinosaure/re-mono

hannesm · web-flow · commit f683146b7264 · 2025-03-23T09:22:20.000+01:00
Monomorphize some min/max functions
diff --git a/src/input.ml b/src/input.ml
@@ -171,7 +171,7 @@ let deliver_in_2 m stats now id conn seg ack =
     rcv_nxt ;
     rcv_wnd ;
     tf_rxwin0sent = (rcv_wnd = 0) ;
-    rcv_adv = Sequence.addi rcv_nxt ((min (rcv_wnd lsr rcv_scale) Params.tcp_maxwin) lsl rcv_scale) ;
+    rcv_adv = Sequence.addi rcv_nxt ((Int.min (rcv_wnd lsr rcv_scale) Params.tcp_maxwin) lsl rcv_scale) ;
     t_maxseg ;
     last_ack_sent = rcv_nxt ;
     t_softerror ;
@@ -573,7 +573,7 @@ let di3_ackstuff now id conn seg ourfinisacked fin ack =
       let snd_ssthresh =
         (*: Set to half the current flight size as per RFC2581/2582 :*)
         (* TODO hannes still true in respect of ABC? *)
-        max 2 ((min cb.snd_wnd cb.snd_cwnd) / 2 / cb.t_maxseg) * cb.t_maxseg
+        Int.max 2 ((Int.min cb.snd_wnd cb.snd_cwnd) / 2 / cb.t_maxseg) * cb.t_maxseg
       in
       let control_block = {
         cb with t_dupacks = t_dupacks' ;
@@ -636,7 +636,7 @@ let di3_datastuff_really now the_ststuff conn seg _bsd_fast_path ourfinisacked f
      urgent data in the segment. :*)
   let trim_amt_left =
     if Sequence.greater cb.rcv_nxt seg.Segment.seq then
-      min (Sequence.window cb.rcv_nxt seg.seq) (Cstruct.length seg.payload)
+      Int.min (Sequence.window cb.rcv_nxt seg.seq) (Cstruct.length seg.payload)
     else
       0
   in
@@ -650,7 +650,7 @@ let di3_datastuff_really now the_ststuff conn seg _bsd_fast_path ourfinisacked f
      here because there is still urgent data to be received, but now in a future
      segment. :*)
   let data_trimmed_left_right =
-    Cstruct.sub data_trimmed_left 0 (min cb.rcv_wnd (Cstruct.length data_trimmed_left))
+    Cstruct.sub data_trimmed_left 0 (Int.min cb.rcv_wnd (Cstruct.length data_trimmed_left))
   in
   let fin_trimmed =
     if Cstruct.equal data_trimmed_left_right data_trimmed_left then
diff --git a/src/segment.ml b/src/segment.ml
@@ -267,7 +267,7 @@ let tcp_output_required now conn =
       cb.State.snd_cwnd
   in
   (*: Calculate the amount of unused send window :*)
-  let win = min cb.State.snd_wnd snd_cwnd in
+  let win = Int.min cb.State.snd_wnd snd_cwnd in
   let snd_wnd_unused = win - (Sequence.window cb.State.snd_nxt cb.State.snd_una) in
   (*: Is it possible that a FIN may need to be sent? :*)
   let fin_required =
@@ -287,7 +287,7 @@ let tcp_output_required now conn =
   let have_data_or_fin_to_send = Sequence.less cb.snd_nxt last_sndq_data_and_fin_seq in
   (*: The amount by which the right edge of the advertised window could be moved :*)
   let window_update_delta =
-    (min (Params.tcp_maxwin lsl cb.State.rcv_scale))
+    (Int.min (Params.tcp_maxwin lsl cb.State.rcv_scale))
        (conn.rcvbufsize - Cstruct.lenv conn.rcvq) -
     Sequence.window cb.State.rcv_adv cb.State.rcv_nxt
   in
@@ -353,7 +353,7 @@ let tcp_output_really_helper now (src, src_port, dst, dst_port) window_probe con
     else
       cb.State.snd_cwnd
   in
-  let win0 = min cb.State.snd_wnd snd_cwnd in
+  let win0 = Int.min cb.State.snd_wnd snd_cwnd in
   let win = if window_probe && win0 = 0 then 1 else win0 in
   let snd_wnd_unused = win - (Sequence.window cb.State.snd_nxt cb.State.snd_una) in
   let fin_required =
@@ -365,15 +365,15 @@ let tcp_output_really_helper now (src, src_port, dst, dst_port) window_probe con
   let data_to_send, more_data_could_be_sent =
     let data' =
       Cstruct.shiftv (List.rev conn.State.sndq)
-        (max 0
-           (min (Cstruct.lenv conn.State.sndq)
+        (Int.max 0
+           (Int.min (Cstruct.lenv conn.State.sndq)
               (Sequence.window cb.State.snd_nxt cb.State.snd_una)))
         (* taking the minimum to avoid exceeding the sndq *)
     in
     let data' = Cstruct.concat data' in
-    let len_could_be_sent = max 0 snd_wnd_unused in
+    let len_could_be_sent = Int.max 0 snd_wnd_unused in
     let dlen = Cstruct.length data' in
-    Cstruct.sub data' 0 (min dlen (min len_could_be_sent cb.State.t_maxseg)),
+    Cstruct.sub data' 0 (Int.min dlen (Int.min len_could_be_sent cb.State.t_maxseg)),
     dlen > cb.t_maxseg && len_could_be_sent > cb.t_maxseg
   in
   let dlen = Cstruct.length data_to_send in
@@ -402,8 +402,8 @@ let tcp_output_really_helper now (src, src_port, dst, dst_port) window_probe con
     | Time_wait -> window_size
     | _ ->
       let rcv_wnd'' = Subr.calculate_bsd_rcv_wnd conn in
-      max window_size
-        (min (Params.tcp_maxwin lsl cb.State.rcv_scale)
+      Int.max window_size
+        (Int.min (Params.tcp_maxwin lsl cb.State.rcv_scale)
            (if rcv_wnd'' < conn.rcvbufsize / 4 && rcv_wnd'' < cb.State.t_maxseg
             then 0  (*: Silly window avoidance: shouldn't advertise a tiny window :*)
             else rcv_wnd''))
@@ -414,7 +414,7 @@ let tcp_output_really_helper now (src, src_port, dst, dst_port) window_probe con
   let seg =
     { src_port ; dst_port ; seq = snd_nxt;
       ack = Some cb.State.rcv_nxt ; flag ; push ;
-      window = min (rcv_wnd' lsr cb.rcv_scale) max_win ;
+      window = Int.min (rcv_wnd' lsr cb.rcv_scale) max_win ;
       options = [] ; payload = data_to_send
     }
   in
@@ -430,7 +430,7 @@ let tcp_output_really_helper now (src, src_port, dst, dst_port) window_probe con
   in
   (*: Updated values to store in the control block after the segment is output :*)
   let snd_nxt' = Sequence.(addi (addi snd_nxt dlen) (if fin then 1 else 0)) in
-  let snd_max = max cb.State.snd_max snd_nxt' in
+  let snd_max = Sequence.max cb.State.snd_max snd_nxt' in
   (*: Following a |tcp_output| code walkthrough by SB: :*)
   let tt_rexmt =
     if (State.mode_of cb.tt_rexmt = None ||
@@ -515,7 +515,7 @@ let tcp_output_perhaps now id conn =
 
 (* auxFns:1384 *)
 let make_syn_ack cb (src, src_port, dst, dst_port) =
-  let window = min cb.State.rcv_wnd max_win in
+  let window = Int.min cb.State.rcv_wnd max_win in
   let options =
     MaximumSegmentSize cb.t_advmss ::
     (Option.map (fun sc -> WindowScale sc) cb.request_r_scale |> Option.to_list)
@@ -527,7 +527,7 @@ let make_syn_ack cb (src, src_port, dst, dst_port) =
 
 (* auxFns:1333 *)
 let make_syn cb (src, src_port, dst, dst_port) =
-  let window = min cb.State.rcv_wnd max_win in
+  let window = Int.min cb.State.rcv_wnd max_win in
   let options =
     MaximumSegmentSize cb.State.t_advmss ::
     (Option.map (fun sc -> WindowScale sc) cb.request_r_scale |> Option.to_list)
@@ -539,7 +539,7 @@ let make_syn cb (src, src_port, dst, dst_port) =
 
 (* auxFns:1437 *)
 let make_ack cb ~fin (src, src_port, dst, dst_port) =
-  let window = min (cb.State.rcv_wnd lsr cb.rcv_scale) max_win in
+  let window = Int.min (cb.State.rcv_wnd lsr cb.rcv_scale) max_win in
   (* sack *)
   src, dst,
   { src_port ; dst_port ;
diff --git a/src/subr.ml b/src/subr.ml
@@ -49,7 +49,7 @@ let calculate_buf_sizes (* conn *) cb_t_maxseg seg_mss bw_delay_product_for_rt r
         BSD has the route MTU if avail, or [[MIN MSSDFLT (link MTU)]] otherwise, as the first argument
         of the MIN below.  That is the same calculation as we did in [[connect_1]]. We don't repeat it,
         but use the cached value in [[cb.t_maxseg]]. :*)
-    min cb_t_maxseg (max 64 (match seg_mss with None -> Params.mssdflt | Some x -> x))
+    min cb_t_maxseg (Int.max 64 (match seg_mss with None -> Params.mssdflt | Some x -> x))
   in
   let rcvbufsize' = match bw_delay_product_for_rt with None -> rcvbufsize | Some x -> x in
   let rcvbufsize'',t_maxseg'' =
@@ -67,11 +67,11 @@ let calculate_buf_sizes (* conn *) cb_t_maxseg seg_mss bw_delay_product_for_rt r
       min Params.sb_max (roundup t_maxseg' sndbufsize')
   in
   (* compute initial cwnd *)
-  let snd_cwnd = min (4 * t_maxseg'') (max (2 * t_maxseg'') 4380) in
+  let snd_cwnd = min (4 * t_maxseg'') (Int.max (2 * t_maxseg'') 4380) in
   rcvbufsize'', sndbufsize'', t_maxseg'', snd_cwnd
 
 let calculate_bsd_rcv_wnd conn =
-  max (Sequence.window conn.control_block.rcv_adv conn.control_block.rcv_nxt)
+  Int.max (Sequence.window conn.control_block.rcv_adv conn.control_block.rcv_nxt)
     (conn.rcvbufsize - Cstruct.lenv conn.rcvq)
 
 let update_rtt rtt ri =
@@ -80,8 +80,8 @@ let update_rtt rtt ri =
     if ri.tf_srtt_valid then
       let delta     = Int64.(sub (sub rtt (Duration.of_ms 1)) ri.t_srtt) in
       let vardelta  = Int64.(sub (abs delta) ri.t_rttvar) in
-      let t_srtt'   = max (Duration.of_ms 16) Int64.(add ri.t_srtt (shift_right delta 3))
-      and t_rttvar' = max (Duration.of_ms 32) Int64.(add ri.t_rttvar (shift_right vardelta 2))
+      let t_srtt'   = Int64.max (Duration.of_ms 16) Int64.(add ri.t_srtt (shift_right delta 3))
+      and t_rttvar' = Int64.max (Duration.of_ms 32) Int64.(add ri.t_rttvar (shift_right vardelta 2))
       (* BSD behaviour is never to let these go to zero, but clip at the least
          positive value.  Since SRTT is measured in 1/32 tick and RTTVAR in
          1/16 tick, these are the minimum values.  A more natural implementation
@@ -107,26 +107,26 @@ let update_rtt rtt ri =
 
 (* auxFns:864 *)
 let expand_cwnd ssthresh maxseg maxwin cwnd =
-  min maxwin (cwnd + (if cwnd > ssthresh then max 1 ((maxseg * maxseg) / cwnd) else maxseg))
+  min maxwin (cwnd + (if cwnd > ssthresh then Int.max 1 ((maxseg * maxseg) / cwnd) else maxseg))
 
 (* auxFns:657 *)
 let computed_rto backoffs shift ri =
   Int64.(mul backoffs.(shift)
-           (max ri.t_rttmin Int64.(add ri.t_srtt (shift_left ri.t_rttvar 2))))
+           (Int64.max ri.t_rttmin Int64.(add ri.t_srtt (shift_left ri.t_rttvar 2))))
 
 (* auxFns:663 *)
 let computed_rxtcur ri =
-  max ri.t_rttmin
-    (min Params.tcptv_rexmtmax
+  Int64.max ri.t_rttmin
+    (Int64.min Params.tcptv_rexmtmax
        (computed_rto
           (if ri.t_wassyn then Params.tcp_syn_backoff else Params.tcp_backoff)
           (match ri.t_lastshift with None -> 0 | Some x -> x) ri))
 
 (* auxFns:692 *)
 let start_tt_rexmt_gen mode backoffs now shift wantmin ri =
   let rxtcur =
-    max (if wantmin then
-           max ri.t_rttmin
+    Int64.max (if wantmin then
+           Int64.max ri.t_rttmin
              (match ri.t_lastrtt with None -> 0L | Some v -> Int64.add v (Duration.of_ms 2))
          else ri.t_rttmin)
       (min Params.tcptv_rexmtmax (* better not be infinite! *)
@@ -142,8 +142,8 @@ let start_tt_rexmt_syn = start_tt_rexmt_gen RexmtSyn Params.tcp_syn_backoff
 let start_tt_rexmt = start_tt_rexmt_gen Rexmt Params.tcp_backoff
 
 let start_tt_persist now shift ri =
-  let cur = max Params.tcptv_persmin (* better not be infinite! *)
-      (min Params.tcptv_persmax (* better not be infinite! *)
+  let cur = Int64.max Params.tcptv_persmin (* better not be infinite! *)
+      (Int64.min Params.tcptv_persmax (* better not be infinite! *)
          (computed_rto Params.tcp_backoff shift ri))
   in
   Log.debug (fun m -> m "starting persist timer %a (backoff is %a)"
diff --git a/src/tcptimer.ml b/src/tcptimer.ml
@@ -31,7 +31,7 @@ let timer_tt_rexmtsyn m now shift id conn =
         snd_recover = Sequence.incr cb.iss ;
         t_rttseg = None ;
         snd_cwnd = maxseg ;
-        snd_ssthresh = maxseg * max 2 (min cb.snd_wnd cb.snd_cwnd / (2 * maxseg)) ; (* need to adjust with cc_newreno *)
+        snd_ssthresh = maxseg * Int.max 2 (min cb.snd_wnd cb.snd_cwnd / (2 * maxseg)) ; (* need to adjust with cc_newreno *)
         t_dupacks = 0 ;
       }
       in

Original file line number	Diff line number	Diff line change
`@@ -31,7 +31,7 @@ let timer_tt_rexmtsyn m now shift id conn =`
`31`	`31`	`snd_recover = Sequence.incr cb.iss ;`
`32`	`32`	`t_rttseg = None ;`
`33`	`33`	`snd_cwnd = maxseg ;`
`34`		`- snd_ssthresh = maxseg * max 2 (min cb.snd_wnd cb.snd_cwnd / (2 * maxseg)) ; (* need to adjust with cc_newreno *)`
	`34`	`+ snd_ssthresh = maxseg * Int.max 2 (min cb.snd_wnd cb.snd_cwnd / (2 * maxseg)) ; (* need to adjust with cc_newreno *)`
`35`	`35`	`t_dupacks = 0 ;`
`36`	`36`	`}`
`37`	`37`	`in`