@@ -374,13 +374,113 @@ 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+ let s = ref " " in
382+ let wbase = 10L in
383+ let cvtbl = " 0123456789" in
384+
385+ (if x < 0L then
386+ let y = Caml_int64. discard_sign x in
387+ (* 2 ^ 63 + y `div_mod` 10 *)
388+
389+ let quotient_l = 922337203685477580L (* 2 ^ 63 / 10 *)
390+ (* {lo = -858993460n; hi = 214748364n} *)
391+ (* TODO: int64 constant folding so that we can do idiomatic code
392+ 2 ^ 63 / 10 *) in
393+ let modulus_l = 8L in
394+ (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
395+ we can not do the code above, it can overflow when y is really large
396+ *)
397+ let c, d = Caml_int64. div_mod y wbase in
398+ let e ,f = Caml_int64. div_mod (Caml_int64_extern. add modulus_l d) wbase in
399+ let quotient =
400+ ref (Caml_int64_extern. add (Caml_int64_extern. add quotient_l c )
401+ e) in
402+ let modulus = ref f in
403+ s .contents< -
404+ Caml_string_extern. get_string_unsafe
405+ cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
406+
407+ while quotient.contents <> 0L do
408+ let a, b = Caml_int64. div_mod (quotient.contents) wbase in
409+ quotient .contents< - a;
410+ modulus .contents< - b;
411+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
412+ done ;
413+
414+ else
415+ let a, b = Caml_int64. div_mod x wbase in
416+ let quotient = ref a in
417+ let modulus = ref b in
418+ s .contents< -
419+ Caml_string_extern. get_string_unsafe
420+ cvtbl ( Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
421+
422+ while quotient.contents <> 0L do
423+ let a, b = Caml_int64. div_mod (quotient.contents) wbase in
424+ quotient .contents< - a;
425+ modulus .contents< - b;
426+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
427+ done ); s.contents
428+
429+ let oct_of_int64 x =
430+ let s = ref " " in
431+ let wbase = 8L in
432+ let cvtbl = " 01234567" in
433+ (if x < 0L then
434+ begin
435+ let y = Caml_int64. discard_sign x in
436+ (* 2 ^ 63 + y `div_mod` 8 *)
437+ let quotient_l = 1152921504606846976L
438+ (* {lo = 0n; hi = 268435456n } *) (* 2 ^ 31 / 8 *)
439+ in
440+
441+ (* let c, d = Caml_int64.div_mod (Caml_int64.add y modulus_l) wbase in
442+ we can not do the code above, it can overflow when y is really large
443+ *)
444+ let c, d = Caml_int64. div_mod y wbase in
445+
446+ let quotient =
447+ ref (Caml_int64_extern. add quotient_l c ) in
448+ let modulus = ref d in
449+ s .contents< -
450+ Caml_string_extern. get_string_unsafe
451+ cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
452+
453+ while quotient.contents <> 0L do
454+ let a, b = Caml_int64. div_mod quotient.contents wbase in
455+ quotient .contents< - a;
456+ modulus .contents< - b;
457+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
458+ done ;
459+ end
460+ else
461+ let a, b = Caml_int64. div_mod x wbase in
462+ let quotient = ref a in
463+ let modulus = ref b in
464+ s .contents< -
465+ Caml_string_extern. get_string_unsafe
466+ cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
467+
468+ while quotient.contents <> 0L do
469+ let a, b = Caml_int64. div_mod (quotient.contents) wbase in
470+ quotient .contents< - a;
471+ modulus .contents< - b;
472+ s .contents< - Caml_string_extern. get_string_unsafe cvtbl (Caml_int64_extern. to_int modulus.contents) ^ s.contents ;
473+ done ); s.contents
474+
475+
377476(* FIXME: improve codegen for such cases
378477let div_mod (x : int64) (y : int64) : int64 * int64 =
379478 let a, b = Caml_int64.(div_mod (unsafe_of_int64 x) (unsafe_of_int64 y)) in
380479 Caml_int64.unsafe_to_int64 a , Caml_int64.unsafe_to_int64 b
381480*)
382481let caml_int64_format fmt x =
383- let module String = Caml_string_extern in
482+ if fmt = " %d" then Caml_int64. to_string x
483+ else
384484 let f = parse_format fmt in
385485 let x =
386486 if f.signedconv && x < 0L then
@@ -389,114 +489,26 @@ let caml_int64_format fmt x =
389489 Caml_int64_extern. neg x
390490 end
391491 else x in
392- let s = ref " " in
492+ let s =
393493
394494 begin match f.base with
395495 | Hex ->
396- s .contents < - Caml_int64. to_hex x ^ s.contents
496+ Caml_int64. to_hex x
397497 | 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-
498+ oct_of_int64 x
443499 | 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 ;
500+ dec_of_pos_int64 x
501+ end in
502+ let fill_s =
491503 if f.prec > = 0 then
492504 begin
493505 f.filter < - " " ;
494- let n = f.prec - Caml_string_extern. length s.contents in
506+ let n = f.prec - Caml_string_extern. length s in
495507 if n > 0 then
496- s .contents < - repeat n " 0" ^ s.contents
497- end ;
508+ repeat n " 0" ^ s else s
509+ end else s in
498510
499- finish_formatting f s.contents
511+ finish_formatting f fill_s
500512
501513let caml_format_float fmt x =
502514 let module String = Caml_string_extern in
0 commit comments