diff options
35 files changed, 429 insertions, 325 deletions
@@ -10,8 +10,6 @@ utils/formatmsg.cmo: utils/formatmsg.cmi utils/formatmsg.cmx: utils/formatmsg.cmi utils/misc.cmo: utils/misc.cmi utils/misc.cmx: utils/misc.cmi -utils/nativeint.cmo: utils/nativeint.cmi -utils/nativeint.cmx: utils/nativeint.cmi utils/tbl.cmo: utils/formatmsg.cmi utils/tbl.cmi utils/tbl.cmx: utils/formatmsg.cmx utils/tbl.cmi utils/terminfo.cmo: utils/terminfo.cmi @@ -400,18 +398,16 @@ asmcomp/asmgen.cmi: asmcomp/cmm.cmi bytecomp/lambda.cmi asmcomp/clambda.cmi: parsing/asttypes.cmi typing/ident.cmi \ bytecomp/lambda.cmi asmcomp/closure.cmi: asmcomp/clambda.cmi bytecomp/lambda.cmi -asmcomp/cmm.cmi: typing/ident.cmi utils/nativeint.cmi +asmcomp/cmm.cmi: typing/ident.cmi asmcomp/cmmgen.cmi: asmcomp/clambda.cmi asmcomp/cmm.cmi asmcomp/codegen.cmi: asmcomp/cmm.cmi asmcomp/comballoc.cmi: asmcomp/mach.cmi asmcomp/compilenv.cmi: asmcomp/clambda.cmi typing/ident.cmi asmcomp/emit.cmi: asmcomp/cmm.cmi asmcomp/linearize.cmi -asmcomp/emitaux.cmi: utils/nativeint.cmi asmcomp/interf.cmi: asmcomp/mach.cmi asmcomp/linearize.cmi: asmcomp/mach.cmi asmcomp/reg.cmi asmcomp/liveness.cmi: asmcomp/mach.cmi -asmcomp/mach.cmi: asmcomp/arch.cmo asmcomp/cmm.cmi utils/nativeint.cmi \ - asmcomp/reg.cmi +asmcomp/mach.cmi: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/printcmm.cmi: asmcomp/cmm.cmi asmcomp/printlinear.cmi: asmcomp/linearize.cmi asmcomp/printmach.cmi: asmcomp/mach.cmi asmcomp/reg.cmi @@ -426,8 +422,8 @@ asmcomp/selectgen.cmi: asmcomp/arch.cmo asmcomp/cmm.cmi typing/ident.cmi \ asmcomp/selection.cmi: asmcomp/cmm.cmi asmcomp/mach.cmi asmcomp/spill.cmi: asmcomp/mach.cmi asmcomp/split.cmi: asmcomp/mach.cmi -asmcomp/arch.cmo: utils/config.cmi utils/formatmsg.cmi -asmcomp/arch.cmx: utils/config.cmx utils/formatmsg.cmx +asmcomp/arch.cmo: utils/formatmsg.cmi +asmcomp/arch.cmx: utils/formatmsg.cmx asmcomp/asmgen.cmo: utils/clflags.cmo asmcomp/closure.cmi asmcomp/cmm.cmi \ asmcomp/cmmgen.cmi asmcomp/coloring.cmi asmcomp/comballoc.cmi \ utils/config.cmi asmcomp/emit.cmi asmcomp/emitaux.cmi utils/formatmsg.cmi \ @@ -474,18 +470,16 @@ asmcomp/closure.cmx: parsing/asttypes.cmi asmcomp/clambda.cmx \ utils/clflags.cmx asmcomp/compilenv.cmx typing/ident.cmx \ bytecomp/lambda.cmx utils/misc.cmx typing/primitive.cmx utils/tbl.cmx \ asmcomp/closure.cmi -asmcomp/cmm.cmo: asmcomp/arch.cmo typing/ident.cmi utils/nativeint.cmi \ - asmcomp/cmm.cmi -asmcomp/cmm.cmx: asmcomp/arch.cmx typing/ident.cmx utils/nativeint.cmx \ - asmcomp/cmm.cmi +asmcomp/cmm.cmo: asmcomp/arch.cmo typing/ident.cmi asmcomp/cmm.cmi +asmcomp/cmm.cmx: asmcomp/arch.cmx typing/ident.cmx asmcomp/cmm.cmi asmcomp/cmmgen.cmo: asmcomp/arch.cmo parsing/asttypes.cmi asmcomp/clambda.cmi \ utils/clflags.cmo asmcomp/cmm.cmi asmcomp/compilenv.cmi typing/ident.cmi \ - bytecomp/lambda.cmi utils/misc.cmi utils/nativeint.cmi \ - typing/primitive.cmi asmcomp/proc.cmi typing/types.cmi asmcomp/cmmgen.cmi + bytecomp/lambda.cmi utils/misc.cmi typing/primitive.cmi asmcomp/proc.cmi \ + typing/types.cmi asmcomp/cmmgen.cmi asmcomp/cmmgen.cmx: asmcomp/arch.cmx parsing/asttypes.cmi asmcomp/clambda.cmx \ utils/clflags.cmx asmcomp/cmm.cmx asmcomp/compilenv.cmx typing/ident.cmx \ - bytecomp/lambda.cmx utils/misc.cmx utils/nativeint.cmx \ - typing/primitive.cmx asmcomp/proc.cmx typing/types.cmx asmcomp/cmmgen.cmi + bytecomp/lambda.cmx utils/misc.cmx typing/primitive.cmx asmcomp/proc.cmx \ + typing/types.cmx asmcomp/cmmgen.cmi asmcomp/codegen.cmo: asmcomp/cmm.cmi asmcomp/coloring.cmi asmcomp/emit.cmi \ utils/formatmsg.cmi asmcomp/interf.cmi asmcomp/linearize.cmi \ asmcomp/liveness.cmi asmcomp/printcmm.cmi asmcomp/printlinear.cmi \ @@ -506,16 +500,16 @@ asmcomp/compilenv.cmo: asmcomp/clambda.cmi utils/config.cmi typing/env.cmi \ utils/formatmsg.cmi typing/ident.cmi utils/misc.cmi asmcomp/compilenv.cmi asmcomp/compilenv.cmx: asmcomp/clambda.cmx utils/config.cmx typing/env.cmx \ utils/formatmsg.cmx typing/ident.cmx utils/misc.cmx asmcomp/compilenv.cmi -asmcomp/emit.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/compilenv.cmi \ - utils/config.cmi asmcomp/emitaux.cmi asmcomp/linearize.cmi \ - parsing/location.cmi asmcomp/mach.cmi utils/misc.cmi utils/nativeint.cmi \ - asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/emit.cmi -asmcomp/emit.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/compilenv.cmx \ - utils/config.cmx asmcomp/emitaux.cmx asmcomp/linearize.cmx \ - parsing/location.cmx asmcomp/mach.cmx utils/misc.cmx utils/nativeint.cmx \ - asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/emit.cmi -asmcomp/emitaux.cmo: utils/nativeint.cmi asmcomp/emitaux.cmi -asmcomp/emitaux.cmx: utils/nativeint.cmx asmcomp/emitaux.cmi +asmcomp/emit.cmo: asmcomp/arch.cmo utils/clflags.cmo asmcomp/cmm.cmi \ + asmcomp/compilenv.cmi utils/config.cmi asmcomp/emitaux.cmi \ + asmcomp/linearize.cmi asmcomp/mach.cmi utils/misc.cmi asmcomp/proc.cmi \ + asmcomp/reg.cmi asmcomp/emit.cmi +asmcomp/emit.cmx: asmcomp/arch.cmx utils/clflags.cmx asmcomp/cmm.cmx \ + asmcomp/compilenv.cmx utils/config.cmx asmcomp/emitaux.cmx \ + asmcomp/linearize.cmx asmcomp/mach.cmx utils/misc.cmx asmcomp/proc.cmx \ + asmcomp/reg.cmx asmcomp/emit.cmi +asmcomp/emitaux.cmo: asmcomp/emitaux.cmi +asmcomp/emitaux.cmx: asmcomp/emitaux.cmi asmcomp/interf.cmo: asmcomp/mach.cmi utils/misc.cmi asmcomp/proc.cmi \ asmcomp/reg.cmi asmcomp/interf.cmi asmcomp/interf.cmx: asmcomp/mach.cmx utils/misc.cmx asmcomp/proc.cmx \ @@ -530,34 +524,36 @@ asmcomp/liveness.cmo: utils/formatmsg.cmi asmcomp/mach.cmi utils/misc.cmi \ asmcomp/liveness.cmx: utils/formatmsg.cmx asmcomp/mach.cmx utils/misc.cmx \ asmcomp/printmach.cmx asmcomp/proc.cmx asmcomp/reg.cmx \ asmcomp/liveness.cmi -asmcomp/mach.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi utils/nativeint.cmi \ - asmcomp/reg.cmi asmcomp/mach.cmi -asmcomp/mach.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx utils/nativeint.cmx \ - asmcomp/reg.cmx asmcomp/mach.cmi +asmcomp/mach.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/reg.cmi \ + asmcomp/mach.cmi +asmcomp/mach.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/reg.cmx \ + asmcomp/mach.cmi asmcomp/printcmm.cmo: asmcomp/cmm.cmi utils/formatmsg.cmi typing/ident.cmi \ - utils/nativeint.cmi asmcomp/printcmm.cmi + asmcomp/printcmm.cmi asmcomp/printcmm.cmx: asmcomp/cmm.cmx utils/formatmsg.cmx typing/ident.cmx \ - utils/nativeint.cmx asmcomp/printcmm.cmi + asmcomp/printcmm.cmi asmcomp/printlinear.cmo: utils/formatmsg.cmi asmcomp/linearize.cmi \ asmcomp/mach.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi asmcomp/printlinear.cmx: utils/formatmsg.cmx asmcomp/linearize.cmx \ asmcomp/mach.cmx asmcomp/printmach.cmx asmcomp/printlinear.cmi asmcomp/printmach.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi utils/formatmsg.cmi \ - asmcomp/mach.cmi utils/nativeint.cmi asmcomp/printcmm.cmi \ - asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/printmach.cmi + asmcomp/mach.cmi asmcomp/printcmm.cmi asmcomp/proc.cmi asmcomp/reg.cmi \ + asmcomp/printmach.cmi asmcomp/printmach.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx utils/formatmsg.cmx \ - asmcomp/mach.cmx utils/nativeint.cmx asmcomp/printcmm.cmx \ - asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/printmach.cmi -asmcomp/proc.cmo: asmcomp/arch.cmo utils/ccomp.cmi utils/clflags.cmo \ - asmcomp/cmm.cmi asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi \ + asmcomp/mach.cmx asmcomp/printcmm.cmx asmcomp/proc.cmx asmcomp/reg.cmx \ + asmcomp/printmach.cmi +asmcomp/proc.cmo: asmcomp/arch.cmo utils/ccomp.cmi asmcomp/cmm.cmi \ + utils/formatmsg.cmi asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi \ asmcomp/proc.cmi -asmcomp/proc.cmx: asmcomp/arch.cmx utils/ccomp.cmx utils/clflags.cmx \ - asmcomp/cmm.cmx asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx \ +asmcomp/proc.cmx: asmcomp/arch.cmx utils/ccomp.cmx asmcomp/cmm.cmx \ + utils/formatmsg.cmx asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx \ asmcomp/proc.cmi asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi -asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reload.cmi -asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reload.cmi +asmcomp/reload.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \ + asmcomp/reg.cmi asmcomp/reloadgen.cmi asmcomp/reload.cmi +asmcomp/reload.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.cmx \ + asmcomp/reg.cmx asmcomp/reloadgen.cmx asmcomp/reload.cmi asmcomp/reloadgen.cmo: asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi \ asmcomp/reloadgen.cmi asmcomp/reloadgen.cmx: asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx \ @@ -566,21 +562,19 @@ asmcomp/schedgen.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/linearize.cmi \ asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi asmcomp/schedgen.cmi asmcomp/schedgen.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/linearize.cmx \ asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx asmcomp/schedgen.cmi -asmcomp/scheduling.cmo: asmcomp/arch.cmo asmcomp/mach.cmi \ - asmcomp/schedgen.cmi asmcomp/scheduling.cmi -asmcomp/scheduling.cmx: asmcomp/arch.cmx asmcomp/mach.cmx \ - asmcomp/schedgen.cmx asmcomp/scheduling.cmi +asmcomp/scheduling.cmo: asmcomp/schedgen.cmi asmcomp/scheduling.cmi +asmcomp/scheduling.cmx: asmcomp/schedgen.cmx asmcomp/scheduling.cmi asmcomp/selectgen.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi typing/ident.cmi \ - asmcomp/mach.cmi utils/misc.cmi utils/nativeint.cmi asmcomp/proc.cmi \ - asmcomp/reg.cmi utils/tbl.cmi asmcomp/selectgen.cmi + asmcomp/mach.cmi utils/misc.cmi asmcomp/proc.cmi asmcomp/reg.cmi \ + utils/tbl.cmi asmcomp/selectgen.cmi asmcomp/selectgen.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx typing/ident.cmx \ - asmcomp/mach.cmx utils/misc.cmx utils/nativeint.cmx asmcomp/proc.cmx \ - asmcomp/reg.cmx utils/tbl.cmx asmcomp/selectgen.cmi + asmcomp/mach.cmx utils/misc.cmx asmcomp/proc.cmx asmcomp/reg.cmx \ + utils/tbl.cmx asmcomp/selectgen.cmi asmcomp/selection.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \ - utils/misc.cmi asmcomp/reg.cmi asmcomp/selectgen.cmi \ + utils/misc.cmi asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/selectgen.cmi \ asmcomp/selection.cmi asmcomp/selection.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.cmx \ - utils/misc.cmx asmcomp/reg.cmx asmcomp/selectgen.cmx \ + utils/misc.cmx asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/selectgen.cmx \ asmcomp/selection.cmi asmcomp/spill.cmo: asmcomp/mach.cmi asmcomp/proc.cmi asmcomp/reg.cmi \ asmcomp/spill.cmi @@ -34,7 +34,7 @@ INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver -I tople UTILS=utils/misc.cmo utils/formatmsg.cmo utils/tbl.cmo utils/config.cmo \ utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo -OPTUTILS=$(UTILS) utils/nativeint.cmo +OPTUTILS=$(UTILS) PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \ parsing/syntaxerr.cmo parsing/pstream.cmo parsing/parser.cmo \ diff --git a/Makefile.nt b/Makefile.nt index 5096a00ba..532b54215 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -32,7 +32,7 @@ INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver -I tople UTILS=utils\misc.cmo utils\formatmsg.cmo utils\tbl.cmo utils\config.cmo \ utils\clflags.cmo utils\terminfo.cmo utils\ccomp.cmo utils\warnings.cmo -OPTUTILS=$(UTILS) utils\nativeint.cmo +OPTUTILS=$(UTILS) PARSING=parsing\linenum.cmo parsing\location.cmo parsing\longident.cmo \ parsing\syntaxerr.cmo parsing\pstream.cmo parsing\parser.cmo \ diff --git a/asmcomp/alpha/emit.mlp b/asmcomp/alpha/emit.mlp index e066f40ee..f699f4ee3 100644 --- a/asmcomp/alpha/emit.mlp +++ b/asmcomp/alpha/emit.mlp @@ -52,8 +52,8 @@ let insert_load_gp f = let instr_needs_gp next = function Lend -> false | Lop(Iconst_int n) -> (* for large n, turned into ldq ($gp) *) - next || Nativeint.cmp n (-0x80000000) < 0 - || Nativeint.cmp n 0x7FFFFFFF > 0 + next || n < Nativeint.of_int(-0x80000000) + || n > Nativeint.of_int 0x7FFFFFFF | Lop(Iconst_float s) -> true (* turned into ldq ($gp) *) | Lop(Iconst_symbol s) -> true (* turned into ldq ($gp) *) | Lop(Icall_ind) -> false (* does ldgp if needed afterwards *) @@ -372,11 +372,11 @@ let emit_instr i = fatal_error "Emit_alpha: Imove" end | Lop(Iconst_int n) -> - if Nativeint.sign n = 0 then + if n = Nativeint.zero then ` clr {emit_reg i.res.(0)}\n` else if digital_asm || - (Nativeint.cmp n (-0x80000000) >= 0 && - Nativeint.cmp n 0x7FFFFFFF <= 0) then + (n >= Nativeint.of_int (-0x80000000) && + n <= Nativeint.of_int 0x7FFFFFFF) then ` ldiq {emit_reg i.res.(0)}, {emit_nativeint n}\n` else begin (* Work around a bug in gas/gld concerning big integer constants *) @@ -730,7 +730,7 @@ let emit_fundecl (fundecl, needs_gp) = ` {emit_string rdata_section}\n`; ` .align 3\n`; List.iter - (fun (lbl, n) -> `{emit_label lbl}: .quad {emit_string(Nativeint.to_hexa_string n)}\n`) + (fun (lbl, n) -> `{emit_label lbl}: .quad 0x{emit_string(Nativeint.format "%x" n)}\n`) !bigint_constants end; if !float_constants <> [] then begin @@ -764,7 +764,7 @@ let emit_item = function else (* Work around a bug in gas regarding the parsing of long decimal constants *) - ` .quad {emit_string(Nativeint.to_hexa_string n)}\n` + ` .quad 0x{emit_string(Nativeint.format "%x" n)}\n` | Csingle f -> ` .float {emit_string f}\n` | Cdouble f -> diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index c007c5fc1..4e663e466 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -176,8 +176,8 @@ let name_for_float_operation = function let rec is_immed n shift = shift <= 24 && - (Nativeint.logand n (Nativeint.shift (Nativeint.from 0xFF) shift) = n || - is_immed n (shift + 2)) + (Nativeint.logand n (Nativeint.shift_left (Nativeint.of_int 0xFF) shift) = n + || is_immed n (shift + 2)) let is_immediate n = is_immed n 0 @@ -188,11 +188,11 @@ let emit_complex_intconst r n = let shift = ref 0 in let first = ref true in let ninstr = ref 0 in - while Nativeint.sign !i <> 0 do - if Nativeint.to_int (Nativeint.shift !i (- !shift)) land 3 = 0 then + while !i <> Nativeint.zero do + if Nativeint.to_int (Nativeint.shift_left !i (- !shift)) land 3 = 0 then shift := !shift + 2 else begin - let mask = Nativeint.shift (Nativeint.from 0xFF) !shift in + let mask = Nativeint.shift_left (Nativeint.of_int 0xFF) !shift in let bits = Nativeint.logand !i mask in if !first then ` mov {emit_reg r}, #{emit_nativeint bits} @ {emit_nativeint n}\n` @@ -273,7 +273,7 @@ let emit_instr i = end | Lop(Iconst_int n) -> let r = i.res.(0) in - let nr = Nativeint.logxor n (Nativeint.from(-1)) in + let nr = Nativeint.lognot n in if is_immediate n then begin ` mov {emit_reg r}, #{emit_nativeint n}\n`; 1 end else if is_immediate nr then begin @@ -359,7 +359,7 @@ let emit_instr i = ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1 | Lop(Ialloc n) -> - let nn = Nativeint.from n in + let nn = Nativeint.of_int n in if !fastcode_flag then begin if is_immediate nn then begin ` ldr r10, [alloc_limit, #0]\n`; diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index ed4382a24..64cd25880 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -51,7 +51,8 @@ let float_tag = Cconst_int 253 let floatarray_tag = Cconst_int 254 let block_header tag sz = - Nativeint.add (Nativeint.shift (Nativeint.from sz) 10) (Nativeint.from tag) + Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10) + (Nativeint.of_int tag) let closure_header sz = block_header 250 sz let infix_header ofs = block_header 249 ofs let float_header = block_header 253 (size_float / size_addr) @@ -72,8 +73,9 @@ let min_repr_int = min_int asr 1 let int_const n = if n <= max_repr_int & n >= min_repr_int then Cconst_int((n lsl 1) + 1) - else Cconst_natint(Nativeint.add (Nativeint.shift (Nativeint.from n) 1) - (Nativeint.from 1)) + else Cconst_natint(Nativeint.add + (Nativeint.shift_left (Nativeint.of_int n) 1) + Nativeint.one) let add_const c n = if n = 0 then c else Cop(Caddi, [c; Cconst_int n]) @@ -963,11 +965,11 @@ and emit_constant_fields fields cont = and emit_constant_field field cont = match field with Const_base(Const_int n) -> - (Cint(Nativeint.add (Nativeint.shift (Nativeint.from n) 1) - (Nativeint.from 1)), + (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) + Nativeint.one), cont) | Const_base(Const_char c) -> - (Cint(Nativeint.from(((Char.code c) lsl 1) + 1)), cont) + (Cint(Nativeint.of_int(((Char.code c) lsl 1) + 1)), cont) | Const_base(Const_float s) -> let lbl = new_const_label() in (Clabel_address lbl, @@ -978,7 +980,7 @@ and emit_constant_field field cont = Cint(string_header (String.length s)) :: Cdefine_label lbl :: emit_string_constant s cont) | Const_pointer n -> - (Cint(Nativeint.from((n lsl 1) + 1)), cont) + (Cint(Nativeint.of_int((n lsl 1) + 1)), cont) | Const_block(tag, fields) -> let lbl = new_const_label() in let (emit_fields, cont1) = emit_constant_fields fields cont in @@ -1007,23 +1009,23 @@ let emit_constant_closure symb fundecls cont = if arity = 1 then Cint(infix_header pos) :: Csymbol_address label :: - Cint(Nativeint.from 3) :: + Cint(Nativeint.of_int 3) :: emit_others (pos + 3) rem else Cint(infix_header pos) :: Csymbol_address(curry_function arity) :: - Cint(Nativeint.from (arity lsl 1 + 1)) :: + Cint(Nativeint.of_int (arity lsl 1 + 1)) :: Csymbol_address label :: emit_others (pos + 4) rem in Cint(closure_header (fundecls_size fundecls)) :: Cdefine_symbol symb :: if arity = 1 then Csymbol_address label :: - Cint(Nativeint.from 3) :: + Cint(Nativeint.of_int 3) :: emit_others 3 remainder else Csymbol_address(curry_function arity) :: - Cint(Nativeint.from (arity lsl 1 + 1)) :: + Cint(Nativeint.of_int (arity lsl 1 + 1)) :: Csymbol_address label :: emit_others 4 remainder @@ -1193,7 +1195,7 @@ let entry_point namelist = (* Generate the table of globals *) -let cint_zero = Cint(Nativeint.from 0) +let cint_zero = Cint(Nativeint.zero) let global_table namelist = Cdata(Cdefine_symbol "caml_globals" :: diff --git a/asmcomp/hppa/emit.mlp b/asmcomp/hppa/emit.mlp index 3e009925d..ecade16c3 100644 --- a/asmcomp/hppa/emit.mlp +++ b/asmcomp/hppa/emit.mlp @@ -153,7 +153,7 @@ let emit_imports () = let is_offset n = (n < 8192) && (n >= -8192) (* 14 bits *) let is_offset_native n = - Nativeint.cmp n 8192 < 0 && Nativeint.cmp n (-8192) >= 0 + n < Nativeint.of_int 8192 && n >= Nativeint.of_int (-8192) let emit_load instr addr arg dst = match addr with diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index 4c855c1ff..24c0f997c 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -295,7 +295,7 @@ let emit_instr i = ` movl {emit_reg src}, {emit_reg dst}\n` end | Lop(Iconst_int n) -> - if Nativeint.sign n = 0 then begin + if n = Nativeint.zero then begin match i.res.(0).loc with Reg n -> ` xorl {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | _ -> ` movl $0, {emit_reg i.res.(0)}\n` diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp index 79e0d41af..6654f74e5 100644 --- a/asmcomp/i386/emit_nt.mlp +++ b/asmcomp/i386/emit_nt.mlp @@ -276,7 +276,7 @@ let emit_instr i = ` mov {emit_reg dst}, {emit_reg src}\n` end | Lop(Iconst_int n) -> - if Nativeint.sign n = 0 then begin + if n = Nativeint.zero then begin match i.res.(0).loc with Reg n -> ` xor {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | _ -> ` mov {emit_reg i.res.(0)}, 0\n` diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml index c640291e9..d7c1f2b74 100644 --- a/asmcomp/i386/selection.ml +++ b/asmcomp/i386/selection.ml @@ -155,11 +155,11 @@ method select_addressing exp = method select_store addr exp = match exp with Cconst_int n -> - (Ispecific(Istore_int(Nativeint.from n, addr)), Ctuple []) + (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple []) | Cconst_natint n -> (Ispecific(Istore_int(n, addr)), Ctuple []) | Cconst_pointer n -> - (Ispecific(Istore_int(Nativeint.from n, addr)), Ctuple []) + (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple []) | Cconst_symbol s -> (Ispecific(Istore_symbol(s, addr)), Ctuple []) | _ -> @@ -248,9 +248,9 @@ method insert_op op rs rd = method select_push exp = match exp with - Cconst_int n -> (Ispecific(Ipush_int(Nativeint.from n)), Ctuple []) + Cconst_int n -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple []) | Cconst_natint n -> (Ispecific(Ipush_int n), Ctuple []) - | Cconst_pointer n -> (Ispecific(Ipush_int(Nativeint.from n)), Ctuple []) + | Cconst_pointer n -> (Ispecific(Ipush_int(Nativeint.of_int n)), Ctuple []) | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple []) | Cop(Cload Word, [loc]) -> let (addr, arg) = self#select_addressing loc in diff --git a/asmcomp/mips/emit.mlp b/asmcomp/mips/emit.mlp index f2ecc73b8..bac3e44f9 100644 --- a/asmcomp/mips/emit.mlp +++ b/asmcomp/mips/emit.mlp @@ -240,7 +240,7 @@ let emit_instr i = fatal_error "Emit_mips: Imove" end | Lop(Iconst_int n) -> - if Nativeint.sign n = 0 then + if n = Nativeint.zero then ` move {emit_reg i.res.(0)}, $0\n` else ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 1ae23cbff..2dbd8613e 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -143,13 +143,13 @@ let low n = n land 0xFFFF let high n = n asr 16 let nativelow n = Nativeint.to_int n land 0xFFFF -let nativehigh n = Nativeint.to_int (Nativeint.shift n (-16)) +let nativehigh n = Nativeint.to_int (Nativeint.shift_right n 16) let is_immediate n = n <= 32767 && n >= -32768 let is_native_immediate n = - Nativeint.cmp n 32767 <= 0 && Nativeint.cmp n (-32768) >= 0 + n <= Nativeint.of_int 32767 && n >= Nativeint.of_int (-32768) (* Output a "upper 16 bits" or "lower 16 bits" operator (for the absolute addressing mode) *) diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index cef24453e..4a5091b61 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -360,7 +360,7 @@ method emit_expr env exp = match exp with Cconst_int n -> let r = Reg.createv typ_int in - self#insert_op (Iconst_int(Nativeint.from n)) [||] r + self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r | Cconst_natint n -> let r = Reg.createv typ_int in self#insert_op (Iconst_int n) [||] r @@ -372,7 +372,7 @@ method emit_expr env exp = self#insert_op (Iconst_symbol n) [||] r | Cconst_pointer n -> let r = Reg.createv typ_addr in - self#insert_op (Iconst_int(Nativeint.from n)) [||] r + self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r | Cvar v -> begin try Tbl.find v env diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp index 6ff58ab58..f11a21259 100644 --- a/asmcomp/sparc/emit.mlp +++ b/asmcomp/sparc/emit.mlp @@ -73,7 +73,7 @@ let is_immediate n = n <= 4095 && n >= -4096 let is_native_immediate n = - Nativeint.cmp n 4095 <= 0 && Nativeint.cmp n (-4096) >= 0 + n <= Nativeint.of_int 4095 && n >= Nativeint.of_int (-4096) (* Output a label *) diff --git a/asmrun/.depend b/asmrun/.depend index 79ef33683..69d70b2e7 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -1,8 +1,8 @@ alloc.o: alloc.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/minor_gc.h \ - ../byterun/stacks.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/minor_gc.h ../byterun/stacks.h array.o: array.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ @@ -18,16 +18,22 @@ compact.o: compact.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h -compare.o: compare.c ../byterun/fail.h ../byterun/misc.h \ +compare.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h +custom.o: custom.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h extern.o: extern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h fail.o: fail.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ @@ -50,30 +56,32 @@ freelist.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/major_gc.h gc_ctrl.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/compact.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h ../byterun/stacks.h ../byterun/memory.h + ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/stacks.h \ + ../byterun/memory.h hash.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/custom.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h ../byterun/md5.h ints.o: ints.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h io.o: io.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/signals.h \ - ../byterun/sys.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/signals.h ../byterun/sys.h lexing.o: lexing.c ../byterun/fail.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/stacks.h ../byterun/memory.h \ @@ -84,10 +92,10 @@ main.o: main.c ../byterun/misc.h ../byterun/config.h \ ../byterun/mlvalues.h ../byterun/sys.h major_gc.o: major_gc.c ../byterun/compact.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/finalise.h \ - ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/gc_ctrl.h ../byterun/weak.h + ../byterun/custom.h ../byterun/mlvalues.h ../byterun/fail.h \ + ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h md5.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/md5.h \ @@ -136,8 +144,8 @@ signals.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/sys.h startup.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/sys.h + ../byterun/misc.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/sys.h str.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h @@ -157,9 +165,9 @@ weak.o: weak.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/minor_gc.h alloc.d.o: alloc.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/minor_gc.h \ - ../byterun/stacks.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/minor_gc.h ../byterun/stacks.h array.d.o: array.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ @@ -175,16 +183,22 @@ compact.d.o: compact.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h -compare.d.o: compare.c ../byterun/fail.h ../byterun/misc.h \ +compare.d.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h +custom.d.o: custom.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h extern.d.o: extern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h fail.d.o: fail.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ @@ -207,30 +221,32 @@ freelist.d.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/major_gc.h gc_ctrl.d.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/compact.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h ../byterun/stacks.h ../byterun/memory.h + ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/stacks.h \ + ../byterun/memory.h hash.d.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/custom.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h ../byterun/md5.h ints.d.o: ints.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h io.d.o: io.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/signals.h \ - ../byterun/sys.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/signals.h ../byterun/sys.h lexing.d.o: lexing.c ../byterun/fail.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/stacks.h ../byterun/memory.h \ @@ -241,10 +257,10 @@ main.d.o: main.c ../byterun/misc.h ../byterun/config.h \ ../byterun/mlvalues.h ../byterun/sys.h major_gc.d.o: major_gc.c ../byterun/compact.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/finalise.h \ - ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/gc_ctrl.h ../byterun/weak.h + ../byterun/custom.h ../byterun/mlvalues.h ../byterun/fail.h \ + ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h md5.d.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/md5.h \ @@ -293,8 +309,8 @@ signals.d.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/sys.h startup.d.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/sys.h + ../byterun/misc.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/sys.h str.d.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h @@ -314,9 +330,9 @@ weak.d.o: weak.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/minor_gc.h alloc.p.o: alloc.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/minor_gc.h \ - ../byterun/stacks.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/minor_gc.h ../byterun/stacks.h array.p.o: array.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ @@ -332,16 +348,22 @@ compact.p.o: compact.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \ ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h -compare.p.o: compare.c ../byterun/fail.h ../byterun/misc.h \ +compare.p.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h +custom.p.o: custom.c ../byterun/alloc.h ../byterun/misc.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h extern.p.o: extern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h fail.p.o: fail.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ @@ -364,30 +386,32 @@ freelist.p.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/major_gc.h gc_ctrl.p.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/compact.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \ - ../byterun/minor_gc.h ../byterun/stacks.h ../byterun/memory.h + ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/stacks.h \ + ../byterun/memory.h hash.p.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h + ../byterun/custom.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h intern.p.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/reverse.h ../byterun/md5.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \ + ../byterun/memory.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/reverse.h ../byterun/md5.h ints.p.o: ints.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \ + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \ ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ ../byterun/minor_gc.h io.p.o: io.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h \ - ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \ - ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/signals.h \ - ../byterun/sys.h + ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \ + ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ + ../byterun/signals.h ../byterun/sys.h lexing.p.o: lexing.c ../byterun/fail.h ../byterun/misc.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/stacks.h ../byterun/memory.h \ @@ -398,10 +422,10 @@ main.p.o: main.c ../byterun/misc.h ../byterun/config.h \ ../byterun/mlvalues.h ../byterun/sys.h major_gc.p.o: major_gc.c ../byterun/compact.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \ - ../byterun/fail.h ../byterun/mlvalues.h ../byterun/finalise.h \ - ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \ - ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \ - ../byterun/gc_ctrl.h ../byterun/weak.h + ../byterun/custom.h ../byterun/mlvalues.h ../byterun/fail.h \ + ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \ + ../byterun/minor_gc.h ../byterun/gc_ctrl.h ../byterun/weak.h md5.p.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/md5.h \ @@ -450,8 +474,8 @@ signals.p.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ ../byterun/sys.h startup.p.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/fail.h ../byterun/gc.h \ - ../byterun/gc_ctrl.h ../byterun/sys.h + ../byterun/misc.h ../byterun/custom.h ../byterun/fail.h \ + ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/sys.h str.p.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \ ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/mlvalues.h ../byterun/fail.h diff --git a/asmrun/startup.c b/asmrun/startup.c index 6407f4b79..a93e05c26 100644 --- a/asmrun/startup.c +++ b/asmrun/startup.c @@ -17,6 +17,7 @@ #include <stdio.h> #include <stdlib.h> #include "callback.h" +#include "custom.h" #include "fail.h" #include "gc.h" #include "gc_ctrl.h" @@ -112,6 +113,7 @@ void caml_main(char **argv) value res; init_ieee_floats(); + init_custom_operations(); #ifdef DEBUG verbose_init = 1; #endif diff --git a/byterun/.depend b/byterun/.depend index 127a48a42..693ecf00f 100644 --- a/byterun/.depend +++ b/byterun/.depend @@ -49,7 +49,8 @@ interp.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ instruct.h interp.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ prims.h signals.h stacks.h jumptbl.h ints.o: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h + mlvalues.h custom.h fail.h intext.h io.h fix_code.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h io.o: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h signals.h sys.h @@ -92,9 +93,9 @@ signals.o: signals.c alloc.h misc.h config.h ../config/m.h \ stacks.o: stacks.c config.h ../config/m.h ../config/s.h fail.h misc.h \ mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h startup.o: startup.c config.h ../config/m.h ../config/s.h alloc.h \ - misc.h mlvalues.h callback.h debugger.h exec.h fail.h fix_code.h \ - gc_ctrl.h interp.h intext.h io.h memory.h gc.h major_gc.h freelist.h \ - minor_gc.h prims.h signals.h stacks.h sys.h + misc.h mlvalues.h callback.h custom.h debugger.h exec.h fail.h \ + fix_code.h gc_ctrl.h interp.h intext.h io.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h prims.h signals.h stacks.h sys.h str.o: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h sys.o: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ @@ -157,7 +158,8 @@ interp.d.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ instruct.h interp.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ prims.h signals.h stacks.h ints.d.o: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h + mlvalues.h custom.h fail.h intext.h io.h fix_code.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h io.d.o: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h signals.h sys.h @@ -200,9 +202,9 @@ signals.d.o: signals.c alloc.h misc.h config.h ../config/m.h \ stacks.d.o: stacks.c config.h ../config/m.h ../config/s.h fail.h misc.h \ mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h startup.d.o: startup.c config.h ../config/m.h ../config/s.h alloc.h \ - misc.h mlvalues.h callback.h debugger.h exec.h fail.h fix_code.h \ - gc_ctrl.h interp.h intext.h io.h memory.h gc.h major_gc.h freelist.h \ - minor_gc.h prims.h signals.h stacks.h sys.h + misc.h mlvalues.h callback.h custom.h debugger.h exec.h fail.h \ + fix_code.h gc_ctrl.h interp.h intext.h io.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h prims.h signals.h stacks.h sys.h str.d.o: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h sys.d.o: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ diff --git a/byterun/custom.c b/byterun/custom.c index 3f36a9b66..c814f1d6f 100644 --- a/byterun/custom.c +++ b/byterun/custom.c @@ -98,3 +98,17 @@ struct custom_operations * final_custom_operations(final_fun fn) custom_ops_table = l; return ops; } + +extern struct custom_operations int32_ops, nativeint_ops; +#if SIZEOF_LONG == 8 || SIZEOF_LONG_LONG == 8 +extern struct custom_operations int64_ops; +#endif + +void init_custom_operations(void) +{ + register_custom_operations(&int32_ops); + register_custom_operations(&nativeint_ops); +#if SIZEOF_LONG == 8 || SIZEOF_LONG_LONG == 8 + register_custom_operations(&int64_ops); +#endif +} diff --git a/byterun/custom.h b/byterun/custom.h index 72b9f884f..09755485f 100644 --- a/byterun/custom.h +++ b/byterun/custom.h @@ -47,4 +47,6 @@ void register_custom_operations(struct custom_operations * ops); struct custom_operations * find_custom_operations(char * ident); struct custom_operations * final_custom_operations(void (*fn)(value)); +void init_custom_operations(void); + #endif diff --git a/byterun/intern.c b/byterun/intern.c index b45e8d50d..0f385ce9f 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -590,3 +590,9 @@ void deserialize_block_8(void * data, long len) intern_src += len * 8; #endif } + +void deserialize_error(char * msg) +{ + intern_cleanup(); + failwith(msg); +} diff --git a/byterun/intext.h b/byterun/intext.h index c346dcb44..a4370eb31 100644 --- a/byterun/intext.h +++ b/byterun/intext.h @@ -112,6 +112,7 @@ extern void deserialize_block_1(void * data, long len); extern void deserialize_block_2(void * data, long len); extern void deserialize_block_4(void * data, long len); extern void deserialize_block_8(void * data, long len); +extern void deserialize_error(char * msg); /* Auxiliary stuff for sending code pointers */ unsigned char * code_checksum (void); diff --git a/byterun/ints.c b/byterun/ints.c index d6afe0976..f37240e15 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -155,7 +155,7 @@ static unsigned long int32_deserialize(void * dst) return 4; } -static struct custom_operations int32_ops = { +struct custom_operations int32_ops = { "_i", custom_finalize_default, int32_compare, @@ -221,7 +221,7 @@ value int32_of_int(value v) /* ML */ value int32_to_int(value v) /* ML */ { return Val_long(Int32_val(v)); } -value format_int32(value fmt, value arg) /* ML */ +value int32_format(value fmt, value arg) /* ML */ { char format_string[32], default_format_buffer[32]; char * buffer; @@ -268,8 +268,8 @@ static unsigned long int64_deserialize(void * dst) return 8; } -static struct custom_operations int64_ops = { - "_i", +struct custom_operations int64_ops = { + "_j", custom_finalize_default, int64_compare, int64_hash, @@ -340,7 +340,7 @@ value int64_of_int32(value v) /* ML */ value int64_to_int32(value v) /* ML */ { return copy_int32((int32) Int64_val(v)); } -value format_int64(value fmt, value arg) /* ML */ +value int64_format(value fmt, value arg) /* ML */ { char format_string[64], default_format_buffer[64]; char * buffer; @@ -371,7 +371,7 @@ value int64_of_string(value s) /* ML */ if (d < 0) break; res = base * res + d; } - if (*p != 0) failwith("Int64.of_string"); + if (*p != 0) failwith("int_of_string"); return copy_int64(sign < 0 ? -((int64) res) : (int64) res); } @@ -438,3 +438,142 @@ value int64_of_string(value s) { invalid_arg(int64_error); } #endif + +/* Native integers */ + +static int nativeint_compare(value v1, value v2) +{ + long i1 = Int32_val(v1); + long i2 = Int32_val(v2); + return i1 == i2 ? 0 : i1 < i2 ? -1 : 1; +} + +static long nativeint_hash(value v) +{ + return Nativeint_val(v); +} + +static void nativeint_serialize(value v, unsigned long * wsize_32, + unsigned long * wsize_64) +{ + long l = Nativeint_val(v); +#ifdef ARCH_SIXTYFOUR + if (l <= 0x7FFFFFFFL && l >= -0x80000000L) { + serialize_int_1(1); + serialize_int_4((int32) l); + } else { + serialize_int_1(2); + serialize_int_8(l); + } +#else + serialize_int_1(1); + serialize_int_4(l); +#endif + *wsize_32 = 4; + *wsize_64 = 8; +} + +static unsigned long nativeint_deserialize(void * dst) +{ + switch (deserialize_uint_1()) { + case 1: + *((long *) dst) = deserialize_sint_4(); + break; + case 2: +#ifdef ARCH_SIXTYFOUR + *((long *) dst) = deserialize_sint_8(); +#else + deserialize_error("input_value: native integer value too large"); +#endif + break; + default: + deserialize_error("input_value: ill-formed native integer"); + } + return sizeof(long); +} + +struct custom_operations nativeint_ops = { + "_n", + custom_finalize_default, + nativeint_compare, + nativeint_hash, + nativeint_serialize, + nativeint_deserialize +}; + +value copy_nativeint(long i) +{ + value res = alloc_custom(&nativeint_ops, sizeof(long), 0, 1); + Nativeint_val(res) = i; + return res; +} + +value nativeint_neg(value v) /* ML */ +{ return copy_nativeint(- Nativeint_val(v)); } + +value nativeint_add(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) + Nativeint_val(v2)); } + +value nativeint_sub(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) - Nativeint_val(v2)); } + +value nativeint_mul(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) * Nativeint_val(v2)); } + +value nativeint_div(value v1, value v2) /* ML */ +{ + long divisor = Nativeint_val(v2); + if (divisor == 0) raise_zero_divide(); + return copy_nativeint(Nativeint_val(v1) / divisor); +} + +value nativeint_mod(value v1, value v2) /* ML */ +{ + long divisor = Nativeint_val(v2); + if (divisor == 0) raise_zero_divide(); + return copy_nativeint(Nativeint_val(v1) % divisor); +} + +value nativeint_and(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) & Nativeint_val(v2)); } + +value nativeint_or(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) | Nativeint_val(v2)); } + +value nativeint_xor(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) ^ Nativeint_val(v2)); } + +value nativeint_shift_left(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) << Int_val(v2)); } + +value nativeint_shift_right(value v1, value v2) /* ML */ +{ return copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); } + +value nativeint_shift_right_unsigned(value v1, value v2) /* ML */ +{ return copy_nativeint((uint32)Nativeint_val(v1) >> Int_val(v2)); } + +value nativeint_of_int(value v) /* ML */ +{ return copy_nativeint(Long_val(v)); } + +value nativeint_to_int(value v) /* ML */ +{ return Val_long(Nativeint_val(v)); } + +value nativeint_format(value fmt, value arg) /* ML */ +{ + char format_string[32], default_format_buffer[32]; + char * buffer; + value res; + + buffer = parse_format(fmt, "l", format_string, default_format_buffer); + sprintf(buffer, format_string, (long) Nativeint_val(arg)); + res = copy_string(buffer); + if (buffer != default_format_buffer) stat_free(buffer); + return res; +} + +value nativeint_of_string(value s) /* ML */ +{ + return copy_nativeint(parse_long(String_val(s))); +} + + diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h index a45111341..da50eeba2 100644 --- a/byterun/mlvalues.h +++ b/byterun/mlvalues.h @@ -221,10 +221,11 @@ void Store_double_val (value,double); #define Data_custom_val(v) ((void *) &Field(v, 1)) struct custom_operations; /* defined in [custom.h] */ -/* Int32.t and Int64.t are represented as custom blocks. */ +/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ #define Int32_val(v) (*((int32 *) Data_custom_val(v))) #define Int64_val(v) (*((int64 *) Data_custom_val(v))) +#define Nativeint_val(v) (*((long *) Data_custom_val(v))) /* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ diff --git a/byterun/startup.c b/byterun/startup.c index 56d1d1f02..d4f123fc8 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -24,6 +24,7 @@ #endif #include "alloc.h" #include "callback.h" +#include "custom.h" #include "debugger.h" #include "exec.h" #include "fail.h" @@ -257,6 +258,7 @@ void caml_main(char **argv) /* Machine-dependent initialization of the floating-point hardware so that it behaves as much as possible as specified in IEEE */ init_ieee_floats(); + init_custom_operations(); external_raise = NULL; /* Determine options and position of bytecode file */ #ifdef DEBUG diff --git a/otherlibs/labltk/Makefile b/otherlibs/labltk/Makefile index 675ad71b4..1ba69dd0d 100644 --- a/otherlibs/labltk/Makefile +++ b/otherlibs/labltk/Makefile @@ -38,3 +38,6 @@ partialclean clean: for d in $(SUBDIRS); do \ cd $$d; $(MAKE) clean; cd ..; \ done + +depend: +# To do some day diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend index d3d798eb9..c455e78e3 100644 --- a/otherlibs/num/.depend +++ b/otherlibs/num/.depend @@ -1,9 +1,10 @@ nat_stubs.o: nat_stubs.c ../../byterun/alloc.h ../../byterun/misc.h \ ../../byterun/config.h ../../byterun/../config/m.h \ ../../byterun/../config/s.h ../../byterun/mlvalues.h \ - ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ - ../../byterun/freelist.h ../../byterun/minor_gc.h nat.h \ - bignum/h/BigNum.h bignum/h/BntoBnn.h + ../../byterun/custom.h ../../byterun/intext.h ../../byterun/io.h \ + ../../byterun/fix_code.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h nat.h bignum/h/BigNum.h bignum/h/BntoBnn.h big_int.cmi: nat.cmi num.cmi: big_int.cmi nat.cmi ratio.cmi ratio.cmi: big_int.cmi nat.cmi diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index 3876956f3..68361a8e4 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -13,8 +13,6 @@ event.cmo: condition.cmi mutex.cmi event.cmi event.cmx: condition.cmx mutex.cmx event.cmi mutex.cmo: thread.cmi mutex.cmi mutex.cmx: thread.cmx mutex.cmi -pervasives.cmo: pervasives.cmi -pervasives.cmx: pervasives.cmi thread.cmo: thread.cmi thread.cmx: thread.cmi threadUnix.cmo: thread.cmi threadUnix.cmi diff --git a/stdlib/.depend b/stdlib/.depend index 766b0d23e..2b0087125 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -1,5 +1,6 @@ format.cmi: buffer.cmi genlex.cmi: stream.cmi +int64.cmi: int32.cmi parsing.cmi: lexing.cmi obj.cmi printf.cmi: buffer.cmi arg.cmo: array.cmi list.cmi printf.cmi string.cmi sys.cmi arg.cmi @@ -24,6 +25,10 @@ genlex.cmo: char.cmi hashtbl.cmi list.cmi stream.cmi string.cmi genlex.cmi genlex.cmx: char.cmx hashtbl.cmx list.cmx stream.cmx string.cmx genlex.cmi hashtbl.cmo: array.cmi sys.cmi hashtbl.cmi hashtbl.cmx: array.cmx sys.cmx hashtbl.cmi +int32.cmo: int32.cmi +int32.cmx: int32.cmi +int64.cmo: int32.cmi int64.cmi +int64.cmx: int32.cmx int64.cmi lazy.cmo: lazy.cmi lazy.cmx: lazy.cmi lexing.cmo: string.cmi lexing.cmi @@ -34,6 +39,8 @@ map.cmo: map.cmi map.cmx: map.cmi marshal.cmo: string.cmi marshal.cmi marshal.cmx: string.cmx marshal.cmi +nativeint.cmo: sys.cmi nativeint.cmi +nativeint.cmx: sys.cmx nativeint.cmi obj.cmo: marshal.cmi obj.cmi obj.cmx: marshal.cmx obj.cmi oo.cmo: array.cmi hashtbl.cmi list.cmi map.cmi obj.cmi random.cmi sort.cmi \ diff --git a/stdlib/Makefile b/stdlib/Makefile index 84f0cd0ce..2d92b8995 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -29,7 +29,7 @@ OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \ set.cmo map.cmo stack.cmo queue.cmo stream.cmo \ buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \ digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \ - lazy.cmo filename.cmo + lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo all: stdlib.cma std_exit.cmo camlheader camlheader_ur diff --git a/stdlib/Makefile.Mac b/stdlib/Makefile.Mac index abc96f3f2..7961d652e 100644 --- a/stdlib/Makefile.Mac +++ b/stdlib/Makefile.Mac @@ -23,7 +23,7 @@ OBJS = pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo � set.cmo map.cmo stack.cmo queue.cmo stream.cmo � buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo � digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo � - lazy.cmo filename.cmo + lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo all � stdlib.cma std_exit.cmo camlheader camlheader_ur diff --git a/stdlib/Makefile.nt b/stdlib/Makefile.nt index d0e839668..d769049ec 100644 --- a/stdlib/Makefile.nt +++ b/stdlib/Makefile.nt @@ -27,7 +27,7 @@ OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \ set.cmo map.cmo stack.cmo queue.cmo stream.cmo \ buffer.cmo printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \ digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo \ - lazy.cmo filename.cmo + lazy.cmo filename.cmo int32.cmo int64.cmo nativeint.cmo all: stdlib.cma std_exit.cmo camlheader camlheader_ur diff --git a/stdlib/printf.mli b/stdlib/printf.mli index b68e9d6c5..8f43eba68 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -33,6 +33,7 @@ val fprintf: out_channel -> ('a, out_channel, unit) format -> 'a using lowercase letters. - [X]: convert an integer argument to unsigned hexadecimal, using uppercase letters. +- [o]: convert an integer argument to unsigned octal. - [s]: insert a string argument - [c]: insert a character argument - [f]: convert a floating-point argument to decimal notation, diff --git a/test/Moretest/intext.ml b/test/Moretest/intext.ml index 24cabba3f..375d46366 100644 --- a/test/Moretest/intext.ml +++ b/test/Moretest/intext.ml @@ -49,6 +49,17 @@ let test_out filename = output_value oc (big 1000); Marshal.to_channel oc y [Marshal.No_sharing]; Marshal.to_channel oc fib [Marshal.Closures]; + output_value oc (Int32.of_string "0"); + output_value oc (Int32.of_string "123456"); + output_value oc (Int32.of_string "-123456"); + output_value oc (Int64.of_string "0"); + output_value oc (Int64.of_string "123456789123456"); + output_value oc (Int64.of_string "-123456789123456"); + output_value oc (Nativeint.of_string "0"); + output_value oc (Nativeint.of_string "123456"); + output_value oc (Nativeint.of_string "-123456"); + output_value oc (Nativeint.shift_left (Nativeint.of_string "123456789") 32); + output_value oc (Nativeint.shift_left (Nativeint.of_string "-123456789") 32); close_out oc @@ -115,6 +126,19 @@ let test_in filename = G((D "sharing" as t1), (D "sharing" as t2)) -> t1 != t2 | _ -> false); test 25 (let fib = input_value ic in fib 5 = 8 && fib 10 = 89); + test 26 (input_value ic = Int32.of_string "0"); + test 27 (input_value ic = Int32.of_string "123456"); + test 28 (input_value ic = Int32.of_string "-123456"); + test 29 (input_value ic = Int64.of_string "0"); + test 30 (input_value ic = Int64.of_string "123456789123456"); + test 31 (input_value ic = Int64.of_string "-123456789123456"); + test 32 (input_value ic = Nativeint.of_string "0"); + test 33 (input_value ic = Nativeint.of_string "123456"); + test 34 (input_value ic = Nativeint.of_string "-123456"); + test 35 (input_value ic = + Nativeint.shift_left (Nativeint.of_string "123456789") 32); + test 36 (input_value ic = + Nativeint.shift_left (Nativeint.of_string "-123456789") 32); close_in ic let test_string () = diff --git a/utils/nativeint.ml b/utils/nativeint.ml deleted file mode 100644 index 0eb31d71d..000000000 --- a/utils/nativeint.ml +++ /dev/null @@ -1,71 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* lsb is the least significant bit of the native int (0 <= lsb <= 1) - msw is the remaining 31 or 63 most significant bits. *) -type t = { msw: int; lsb: int } - -let from i = { msw = i asr 1; lsb = i land 1 } - -let to_int n = (n.msw lsl 1) lor n.lsb - -let add n1 n2 = - let s = n1.lsb + n2.lsb in - { msw = n1.msw + n2.msw + s asr 1; lsb = s land 1 } - -let sub n1 n2 = - let d = n1.lsb - n2.lsb in - { msw = n1.msw - n2.msw + d asr 1; lsb = d land 1 } - -let shift n s = - if s = 0 then n else - if s > 0 then - { msw = (n.msw lsl s) lor (n.lsb lsl (s-1)); lsb = 0 } - else - { msw = n.msw asr (-s); lsb = (n.msw asr (-s - 1)) land 1 } - -let logand n1 n2 = - { msw = n1.msw land n2.msw; lsb = n1.lsb land n2.lsb } -let logor n1 n2 = - { msw = n1.msw lor n2.msw; lsb = n1.lsb lor n2.lsb } -let logxor n1 n2 = - { msw = n1.msw lxor n2.msw; lsb = n1.lsb lxor n2.lsb } - -let sign n = - if n.msw < 0 then -1 else - if n.msw = 0 && n.lsb = 0 then 0 else 1 - -let compare n1 n2 = sign(sub n1 n2) - -let cmp n1 i2 = compare n1 (from i2) - -let to_string n = - let a = if n.msw >= 0 then n else sub (from 0) n in - let (q, r) = - (* Watch out for the case n.msw = min_int, in which case a.msw < 0 *) - if a.msw <> min_int - then (a.msw / 5, a.msw mod 5) - else (max_int / 5, max_int mod 5 + 1) in - (if n.msw >= 0 then "" else "-") ^ - (if q > 0 then string_of_int q else "") ^ - string_of_int (r * 2 + a.lsb) - -let to_hexa_string n = - let a = if n.msw >= 0 then n else sub (from 0) n in - let q = a.msw lsr 3 in - let r = a.msw land 0x7 in - Printf.sprintf "%s0x%x%x" - (if n.msw >= 0 then "" else "-") - q - (r * 2 + a.lsb) diff --git a/utils/nativeint.mli b/utils/nativeint.mli deleted file mode 100644 index cca8aa6c7..000000000 --- a/utils/nativeint.mli +++ /dev/null @@ -1,48 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Operations on native integers (32 or 64 bits). *) - -type t - -val from: int -> t - (* Turn an integer into a native integer *) -val to_int : t -> int - (* Return the integer value of a native integer, dropping the - most significant bit *) -val add: t -> t -> t -val sub: t -> t -> t - (* Addition, subtraction. *) -val shift: t -> int -> t - (* [shift n s] shifts [n] left by [s] bits if [s] > 0 - and right by [-s] bits if [s] < 0. *) -val logand: t -> t -> t -val logor: t -> t -> t -val logxor: t -> t -> t - (* Bitwise and, or, xor *) -val sign: t -> int - (* [sign n1] returns [0] if [n1] is zero, a positive - integer if [n] is positive, and a negative integer if - [n] is negative. *) -val compare: t -> t -> int - (* [compare n1 n2] returns [0] if [n1 = n2], a positive - integer if [n1] > [n2], and a negative integer if - [n1] < [n2]. *) -val cmp: t -> int -> int - (* [cmp n1 i2] is [compare n1 (from i2)]. *) -val to_string: t -> string - (* Return the signed decimal representation of a native integer. *) -val to_hexa_string: t -> string - (* Return the signed hexadecimal representation of a native integer, - in 0x notation. *) |