@@ -374,13 +374,113 @@ let caml_format_int fmt i =
374
374
let f = parse_format fmt in
375
375
aux f i
376
376
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
+
377
476
(* FIXME: improve codegen for such cases
378
477
let div_mod (x : int64) (y : int64) : int64 * int64 =
379
478
let a, b = Caml_int64.(div_mod (unsafe_of_int64 x) (unsafe_of_int64 y)) in
380
479
Caml_int64.unsafe_to_int64 a , Caml_int64.unsafe_to_int64 b
381
480
*)
382
481
let 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
384
484
let f = parse_format fmt in
385
485
let x =
386
486
if f.signedconv && x < 0L then
@@ -389,114 +489,26 @@ let caml_int64_format fmt x =
389
489
Caml_int64_extern. neg x
390
490
end
391
491
else x in
392
- let s = ref " " in
492
+ let s =
393
493
394
494
begin match f.base with
395
495
| Hex ->
396
- s .contents < - Caml_int64. to_hex x ^ s.contents
496
+ Caml_int64. to_hex x
397
497
| 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
443
499
| 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 =
491
503
if f.prec > = 0 then
492
504
begin
493
505
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
495
507
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
498
510
499
- finish_formatting f s.contents
511
+ finish_formatting f fill_s
500
512
501
513
let caml_format_float fmt x =
502
514
let module String = Caml_string_extern in
0 commit comments