@@ -374,13 +374,93 @@ let caml_format_int fmt i =
374374 let f = parse_format fmt in
375375 aux f i
376376
377+ (* This can handle unsigned integer (-1L) and print it as "%Lu" which
378+ will overflow signed integer in general
379+ *)
380+ let dec_of_pos_int64 x =
381+
382+
383+ (if x < 0L then
384+
385+ let wbase = 10L in
386+ let cvtbl = " 0123456789" in
387+ let y = Caml_int64. discard_sign x in
388+ (* 2 ^ 63 + y `div_mod` 10 *)
389+
390+ let quotient_l = 922337203685477580L (* 2 ^ 63 / 10 *)
391+ (* {lo = -858993460n; hi = 214748364n} *)
392+ (* TODO: int64 constant folding so that we can do idiomatic code
393+ 2 ^ 63 / 10 *) in
394+ let modulus_l = 8L in
395+ (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
396+ we can not do the code above, it can overflow when y is really large
397+ *)
398+ let c, d = Caml_int64. div_mod y wbase in
399+ let e ,f = Caml_int64. div_mod (Caml_int64_extern. add modulus_l d) wbase in
400+ let quotient =
401+ (Caml_int64_extern. add (Caml_int64_extern. add quotient_l c )
402+ e) in
403+ Caml_int64. to_string quotient ^
404+ (Caml_string_extern. get_string_unsafe
405+ cvtbl (Caml_int64_extern. to_int f))
406+ else
407+ Caml_int64. to_string x)
408+
409+ let oct_of_int64 x =
410+ let s = ref " " in
411+ let wbase = 8L in
412+ let cvtbl = " 01234567" in
413+ (if x < 0L then
414+ begin
415+ let y = Caml_int64. discard_sign x in
416+ (* 2 ^ 63 + y `div_mod` 8 *)
417+ let quotient_l = 1152921504606846976L
418+ (* {lo = 0n; hi = 268435456n } *) (* 2 ^ 31 / 8 *)
419+ in
420+
421+ (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
422+ we can not do the code above, it can overflow when y is really large
423+ *)
424+ let c, d = Caml_int64. div_mod y wbase in
425+
426+ let quotient =
427+ ref (Caml_int64_extern. add quotient_l c ) in
428+ let modulus = ref d in
429+ s .contents< -
430+ Caml_string_extern. get_string_unsafe
431+ cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
432+
433+ while quotient.contents <> 0L do
434+ let a, b = Caml_int64. div_mod quotient.contents wbase in
435+ quotient .contents< - a;
436+ modulus .contents< - b;
437+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
438+ done ;
439+ end
440+ else
441+ let a, b = Caml_int64. div_mod x wbase in
442+ let quotient = ref a in
443+ let modulus = ref b in
444+ s .contents< -
445+ Caml_string_extern. get_string_unsafe
446+ cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
447+
448+ while quotient.contents <> 0L do
449+ let a, b = Caml_int64. div_mod (quotient.contents) wbase in
450+ quotient .contents< - a;
451+ modulus .contents< - b;
452+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
453+ done ); s.contents
454+
455+
377456(* FIXME: improve codegen for such cases
378457let div_mod (x : int64) (y : int64) : int64 * int64 =
379458 let a, b = Caml_int64.(div_mod (unsafe_of_int64 x) (unsafe_of_int64 y)) in
380459 Caml_int64.unsafe_to_int64 a , Caml_int64.unsafe_to_int64 b
381460*)
382461let caml_int64_format fmt x =
383- let module String = Caml_string_extern in
462+ if fmt = " %d" then Caml_int64. to_string x
463+ else
384464 let f = parse_format fmt in
385465 let x =
386466 if f.signedconv && x < 0L then
@@ -389,114 +469,26 @@ let caml_int64_format fmt x =
389469 Caml_int64_extern. neg x
390470 end
391471 else x in
392- let s = ref " " in
472+ let s =
393473
394474 begin match f.base with
395475 | Hex ->
396- s .contents < - Caml_int64. to_hex x ^ s.contents
476+ Caml_int64. to_hex x
397477 | Oct ->
398- let wbase = 8L in
399- let cvtbl = " 01234567" in
400-
401- if x < 0L then
402- begin
403- let y = Caml_int64. discard_sign x in
404- (* 2 ^ 63 + y `div_mod` 8 *)
405- let quotient_l = 1152921504606846976L
406- (* {lo = 0n; hi = 268435456n } *) (* 2 ^ 31 / 8 *)
407- in
408-
409- (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
410- we can not do the code above, it can overflow when y is really large
411- *)
412- let c, d = Caml_int64. div_mod y wbase in
413-
414- let quotient =
415- ref (Caml_int64_extern. add quotient_l c ) in
416- let modulus = ref d in
417- s .contents< -
418- Caml_string_extern. of_char
419- cvtbl.[ Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
420-
421- while quotient.contents <> 0L do
422- let a, b = Caml_int64. div_mod quotient.contents wbase in
423- quotient .contents< - a;
424- modulus .contents< - b;
425- s .contents< - Caml_string_extern. of_char cvtbl.[Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
426- done ;
427- end
428- else
429- let a, b = Caml_int64. div_mod x wbase in
430- let quotient = ref a in
431- let modulus = ref b in
432- s .contents< -
433- Caml_string_extern. of_char
434- cvtbl.[ Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
435-
436- while quotient.contents <> 0L do
437- let a, b = Caml_int64. div_mod (quotient.contents) wbase in
438- quotient .contents< - a;
439- modulus .contents< - b;
440- s .contents< - Caml_string_extern. of_char cvtbl.[Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
441- done
442-
478+ oct_of_int64 x
443479 | Dec ->
444- let wbase = 10L in
445- let cvtbl = " 0123456789" in
446-
447- if x < 0L then
448- let y = Caml_int64. discard_sign x in
449- (* 2 ^ 63 + y `div_mod` 10 *)
450-
451- let quotient_l = 922337203685477580L (* 2 ^ 63 / 10 *)
452- (* {lo = -858993460n; hi = 214748364n} *)
453- (* TODO: int64 constant folding so that we can do idiomatic code
454- 2 ^ 63 / 10 *) in
455- let modulus_l = 8L in
456- (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
457- we can not do the code above, it can overflow when y is really large
458- *)
459- let c, d = Caml_int64. div_mod y wbase in
460- let e ,f = Caml_int64. div_mod (Caml_int64_extern. add modulus_l d) wbase in
461- let quotient =
462- ref (Caml_int64_extern. add (Caml_int64_extern. add quotient_l c )
463- e) in
464- let modulus = ref f in
465- s .contents< -
466- Caml_string_extern. of_char
467- cvtbl.[Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
468-
469- while quotient.contents <> 0L do
470- let a, b = Caml_int64. div_mod (quotient.contents) wbase in
471- quotient .contents< - a;
472- modulus .contents< - b;
473- s .contents< - Caml_string_extern. of_char cvtbl.[Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
474- done ;
475-
476- else
477- let a, b = Caml_int64. div_mod x wbase in
478- let quotient = ref a in
479- let modulus = ref b in
480- s .contents< -
481- Caml_string_extern. of_char
482- cvtbl.[ Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
483-
484- while quotient.contents <> 0L do
485- let a, b = Caml_int64. div_mod (quotient.contents) wbase in
486- quotient .contents< - a;
487- modulus .contents< - b;
488- s .contents< - Caml_string_extern. of_char cvtbl.[Caml_int64_extern. to_int modulus.contents] ^ s.contents ;
489- done ;
490- end ;
480+ dec_of_pos_int64 x
481+ end in
482+ let fill_s =
491483 if f.prec > = 0 then
492484 begin
493485 f.filter < - " "
494- let n = f.prec - Caml_string_extern. length s.contents in
486+ let n = f.prec - Caml_string_extern. length s in
495487 if n > 0 then
496- s .contents < - repeat n " 0" ^ s.contents
497- end ;
488+ repeat n " 0" ^ s else s
489+ end else s in
498490
499- finish_formatting f s.contents
491+ finish_formatting f fill_s
500492
501493let caml_format_float fmt x =
502494 let module String = Caml_string_extern in
0 commit comments