diff options
268 files changed, 3411 insertions, 1630 deletions
@@ -280,15 +280,17 @@ bytecomp/bytelibrarian.cmo: utils/clflags.cmo utils/config.cmi \ bytecomp/bytelibrarian.cmx: utils/clflags.cmx utils/config.cmx \ bytecomp/emitcode.cmx utils/misc.cmx bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmo: bytecomp/bytesections.cmi utils/ccomp.cmi \ - utils/clflags.cmo utils/config.cmi bytecomp/emitcode.cmi typing/ident.cmi \ - bytecomp/instruct.cmi utils/misc.cmi bytecomp/opcodes.cmo \ - bytecomp/symtable.cmi bytecomp/bytelink.cmi + utils/clflags.cmo utils/config.cmi bytecomp/dll.cmi bytecomp/emitcode.cmi \ + typing/ident.cmi bytecomp/instruct.cmi utils/misc.cmi \ + bytecomp/opcodes.cmo bytecomp/symtable.cmi bytecomp/bytelink.cmi bytecomp/bytelink.cmx: bytecomp/bytesections.cmx utils/ccomp.cmx \ - utils/clflags.cmx utils/config.cmx bytecomp/emitcode.cmx typing/ident.cmx \ - bytecomp/instruct.cmx utils/misc.cmx bytecomp/opcodes.cmx \ - bytecomp/symtable.cmx bytecomp/bytelink.cmi + utils/clflags.cmx utils/config.cmx bytecomp/dll.cmx bytecomp/emitcode.cmx \ + typing/ident.cmx bytecomp/instruct.cmx utils/misc.cmx \ + bytecomp/opcodes.cmx bytecomp/symtable.cmx bytecomp/bytelink.cmi bytecomp/bytesections.cmo: utils/config.cmi bytecomp/bytesections.cmi bytecomp/bytesections.cmx: utils/config.cmx bytecomp/bytesections.cmi +bytecomp/dll.cmo: utils/config.cmi utils/misc.cmi bytecomp/dll.cmi +bytecomp/dll.cmx: utils/config.cmx utils/misc.cmx bytecomp/dll.cmi bytecomp/emitcode.cmo: parsing/asttypes.cmi typing/btype.cmi \ utils/clflags.cmo utils/config.cmi typing/env.cmi typing/ident.cmi \ bytecomp/instruct.cmi bytecomp/lambda.cmi bytecomp/meta.cmi \ @@ -340,11 +342,11 @@ bytecomp/simplif.cmx: parsing/asttypes.cmi utils/clflags.cmx typing/ident.cmx \ bytecomp/switch.cmo: bytecomp/switch.cmi bytecomp/switch.cmx: bytecomp/switch.cmi bytecomp/symtable.cmo: parsing/asttypes.cmi bytecomp/bytesections.cmi \ - utils/clflags.cmo bytecomp/emitcode.cmi typing/ident.cmi \ + utils/clflags.cmo bytecomp/dll.cmi bytecomp/emitcode.cmi typing/ident.cmi \ bytecomp/lambda.cmi bytecomp/meta.cmi utils/misc.cmi typing/predef.cmi \ bytecomp/runtimedef.cmi utils/tbl.cmi bytecomp/symtable.cmi bytecomp/symtable.cmx: parsing/asttypes.cmi bytecomp/bytesections.cmx \ - utils/clflags.cmx bytecomp/emitcode.cmx typing/ident.cmx \ + utils/clflags.cmx bytecomp/dll.cmx bytecomp/emitcode.cmx typing/ident.cmx \ bytecomp/lambda.cmx bytecomp/meta.cmx utils/misc.cmx typing/predef.cmx \ bytecomp/runtimedef.cmx utils/tbl.cmx bytecomp/symtable.cmi bytecomp/translclass.cmo: parsing/asttypes.cmi typing/ident.cmi \ @@ -395,8 +397,8 @@ 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 asmcomp/cmmgen.cmi: asmcomp/clambda.cmi asmcomp/cmm.cmi +asmcomp/cmm.cmi: typing/ident.cmi asmcomp/codegen.cmi: asmcomp/cmm.cmi asmcomp/comballoc.cmi: asmcomp/mach.cmi asmcomp/compilenv.cmi: asmcomp/clambda.cmi typing/ident.cmi @@ -410,8 +412,8 @@ asmcomp/printlinear.cmi: asmcomp/linearize.cmi asmcomp/printmach.cmi: asmcomp/mach.cmi asmcomp/reg.cmi asmcomp/proc.cmi: asmcomp/mach.cmi asmcomp/reg.cmi asmcomp/reg.cmi: asmcomp/cmm.cmi -asmcomp/reload.cmi: asmcomp/mach.cmi asmcomp/reloadgen.cmi: asmcomp/mach.cmi asmcomp/reg.cmi +asmcomp/reload.cmi: asmcomp/mach.cmi asmcomp/schedgen.cmi: asmcomp/linearize.cmi asmcomp/mach.cmi asmcomp/scheduling.cmi: asmcomp/linearize.cmi asmcomp/selectgen.cmi: asmcomp/arch.cmo asmcomp/cmm.cmi typing/ident.cmi \ @@ -419,8 +421,6 @@ 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 -asmcomp/arch.cmx: utils/config.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 asmcomp/interf.cmi \ @@ -445,12 +445,14 @@ asmcomp/asmlibrarian.cmx: utils/ccomp.cmx asmcomp/clambda.cmx \ asmcomp/asmlibrarian.cmi asmcomp/asmlink.cmo: asmcomp/asmgen.cmi utils/ccomp.cmi utils/clflags.cmo \ asmcomp/cmmgen.cmi asmcomp/compilenv.cmi utils/config.cmi \ - asmcomp/emit.cmi asmcomp/emitaux.cmi parsing/location.cmi utils/misc.cmi \ - asmcomp/proc.cmi bytecomp/runtimedef.cmi asmcomp/asmlink.cmi + bytecomp/dll.cmi asmcomp/emit.cmi asmcomp/emitaux.cmi \ + parsing/location.cmi utils/misc.cmi asmcomp/proc.cmi \ + bytecomp/runtimedef.cmi asmcomp/asmlink.cmi asmcomp/asmlink.cmx: asmcomp/asmgen.cmx utils/ccomp.cmx utils/clflags.cmx \ asmcomp/cmmgen.cmx asmcomp/compilenv.cmx utils/config.cmx \ - asmcomp/emit.cmx asmcomp/emitaux.cmx parsing/location.cmx utils/misc.cmx \ - asmcomp/proc.cmx bytecomp/runtimedef.cmx asmcomp/asmlink.cmi + bytecomp/dll.cmx asmcomp/emit.cmx asmcomp/emitaux.cmx \ + parsing/location.cmx utils/misc.cmx asmcomp/proc.cmx \ + bytecomp/runtimedef.cmx asmcomp/asmlink.cmi asmcomp/clambda.cmo: parsing/asttypes.cmi typing/ident.cmi \ bytecomp/lambda.cmi asmcomp/clambda.cmi asmcomp/clambda.cmx: parsing/asttypes.cmi typing/ident.cmx \ @@ -463,8 +465,6 @@ 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 \ bytecomp/switch.cmx utils/tbl.cmx asmcomp/closure.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 typing/primitive.cmi asmcomp/proc.cmi \ @@ -473,6 +473,8 @@ 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 typing/primitive.cmx asmcomp/proc.cmx \ bytecomp/switch.cmx typing/types.cmx asmcomp/cmmgen.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/codegen.cmo: asmcomp/cmm.cmi asmcomp/coloring.cmi asmcomp/emit.cmi \ asmcomp/interf.cmi asmcomp/linearize.cmi asmcomp/liveness.cmi \ asmcomp/printcmm.cmi asmcomp/printlinear.cmi asmcomp/printmach.cmi \ @@ -493,16 +495,16 @@ asmcomp/compilenv.cmo: asmcomp/clambda.cmi utils/config.cmi typing/env.cmi \ typing/ident.cmi utils/misc.cmi asmcomp/compilenv.cmi asmcomp/compilenv.cmx: asmcomp/clambda.cmx utils/config.cmx typing/env.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 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 asmcomp/proc.cmx \ - asmcomp/reg.cmx asmcomp/emit.cmi asmcomp/emitaux.cmo: asmcomp/emitaux.cmi asmcomp/emitaux.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/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 \ @@ -531,28 +533,26 @@ asmcomp/printmach.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \ asmcomp/printmach.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.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/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.cmi +asmcomp/proc.cmo: asmcomp/arch.cmo utils/ccomp.cmi asmcomp/cmm.cmi \ + asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi asmcomp/proc.cmi +asmcomp/proc.cmx: asmcomp/arch.cmx utils/ccomp.cmx asmcomp/cmm.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/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 \ asmcomp/reloadgen.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/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 asmcomp/proc.cmi asmcomp/reg.cmi \ utils/tbl.cmi asmcomp/selectgen.cmi @@ -560,10 +560,10 @@ asmcomp/selectgen.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx typing/ident.cmx \ 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 utils/misc.cmi asmcomp/proc.cmi \ asmcomp/reg.cmi asmcomp/spill.cmi @@ -601,14 +601,14 @@ driver/errors.cmx: bytecomp/bytelibrarian.cmx bytecomp/bytelink.cmx \ bytecomp/translclass.cmx bytecomp/translcore.cmx typing/typeclass.cmx \ typing/typecore.cmx typing/typedecl.cmx typing/typemod.cmx \ typing/typetexp.cmx utils/warnings.cmx driver/errors.cmi +driver/main_args.cmo: driver/main_args.cmi +driver/main_args.cmx: driver/main_args.cmi driver/main.cmo: bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmi \ utils/clflags.cmo driver/compile.cmi utils/config.cmi driver/errors.cmi \ driver/main_args.cmi utils/warnings.cmi driver/main.cmi driver/main.cmx: bytecomp/bytelibrarian.cmx bytecomp/bytelink.cmx \ utils/clflags.cmx driver/compile.cmx utils/config.cmx driver/errors.cmx \ driver/main_args.cmx utils/warnings.cmx driver/main.cmi -driver/main_args.cmo: driver/main_args.cmi -driver/main_args.cmx: driver/main_args.cmi driver/optcompile.cmo: asmcomp/asmgen.cmi utils/ccomp.cmi utils/clflags.cmo \ asmcomp/compilenv.cmi utils/config.cmi typing/env.cmi \ parsing/location.cmi utils/misc.cmi parsing/parse.cmi \ @@ -664,32 +664,34 @@ toplevel/genprintval.cmx: typing/btype.cmx typing/ctype.cmx \ utils/misc.cmx typing/outcometree.cmi typing/path.cmx typing/predef.cmx \ typing/printtyp.cmx typing/types.cmx toplevel/genprintval.cmi toplevel/topdirs.cmo: bytecomp/bytelink.cmi utils/clflags.cmo \ - utils/config.cmi typing/ctype.cmi bytecomp/emitcode.cmi typing/env.cmi \ - typing/ident.cmi parsing/longident.cmi bytecomp/meta.cmi utils/misc.cmi \ - bytecomp/opcodes.cmo typing/path.cmi typing/printtyp.cmi \ + utils/config.cmi typing/ctype.cmi bytecomp/dll.cmi bytecomp/emitcode.cmi \ + typing/env.cmi typing/ident.cmi parsing/longident.cmi bytecomp/meta.cmi \ + utils/misc.cmi bytecomp/opcodes.cmo typing/path.cmi typing/printtyp.cmi \ bytecomp/symtable.cmi toplevel/toploop.cmi toplevel/trace.cmi \ typing/types.cmi utils/warnings.cmi toplevel/topdirs.cmi toplevel/topdirs.cmx: bytecomp/bytelink.cmx utils/clflags.cmx \ - utils/config.cmx typing/ctype.cmx bytecomp/emitcode.cmx typing/env.cmx \ - typing/ident.cmx parsing/longident.cmx bytecomp/meta.cmx utils/misc.cmx \ - bytecomp/opcodes.cmx typing/path.cmx typing/printtyp.cmx \ + utils/config.cmx typing/ctype.cmx bytecomp/dll.cmx bytecomp/emitcode.cmx \ + typing/env.cmx typing/ident.cmx parsing/longident.cmx bytecomp/meta.cmx \ + utils/misc.cmx bytecomp/opcodes.cmx typing/path.cmx typing/printtyp.cmx \ bytecomp/symtable.cmx toplevel/toploop.cmx toplevel/trace.cmx \ typing/types.cmx utils/warnings.cmx toplevel/topdirs.cmi toplevel/toploop.cmo: bytecomp/bytegen.cmi utils/clflags.cmo \ - driver/compile.cmi utils/config.cmi bytecomp/emitcode.cmi typing/env.cmi \ - driver/errors.cmi toplevel/genprintval.cmi typing/ident.cmi \ - parsing/lexer.cmi parsing/location.cmi parsing/longident.cmi \ - bytecomp/meta.cmi utils/misc.cmi typing/outcometree.cmi parsing/parse.cmi \ + driver/compile.cmi utils/config.cmi bytecomp/dll.cmi \ + bytecomp/emitcode.cmi typing/env.cmi driver/errors.cmi \ + toplevel/genprintval.cmi typing/ident.cmi parsing/lexer.cmi \ + parsing/location.cmi parsing/longident.cmi bytecomp/meta.cmi \ + utils/misc.cmi typing/outcometree.cmi parsing/parse.cmi \ parsing/parsetree.cmi typing/path.cmi typing/predef.cmi \ parsing/printast.cmi bytecomp/printinstr.cmi bytecomp/printlambda.cmi \ typing/printtyp.cmi bytecomp/simplif.cmi bytecomp/symtable.cmi \ bytecomp/translmod.cmi typing/typedtree.cmi typing/typemod.cmi \ typing/types.cmi utils/warnings.cmi toplevel/toploop.cmi toplevel/toploop.cmx: bytecomp/bytegen.cmx utils/clflags.cmx \ - driver/compile.cmx utils/config.cmx bytecomp/emitcode.cmx typing/env.cmx \ - driver/errors.cmx toplevel/genprintval.cmx typing/ident.cmx \ - parsing/lexer.cmx parsing/location.cmx parsing/longident.cmx \ - bytecomp/meta.cmx utils/misc.cmx typing/outcometree.cmi parsing/parse.cmx \ + driver/compile.cmx utils/config.cmx bytecomp/dll.cmx \ + bytecomp/emitcode.cmx typing/env.cmx driver/errors.cmx \ + toplevel/genprintval.cmx typing/ident.cmx parsing/lexer.cmx \ + parsing/location.cmx parsing/longident.cmx bytecomp/meta.cmx \ + utils/misc.cmx typing/outcometree.cmi parsing/parse.cmx \ parsing/parsetree.cmi typing/path.cmx typing/predef.cmx \ parsing/printast.cmx bytecomp/printinstr.cmx bytecomp/printlambda.cmx \ typing/printtyp.cmx bytecomp/simplif.cmx bytecomp/symtable.cmx \ @@ -8,15 +8,17 @@ Type-checker: module A: sig module type T = sig module T: M end end module B: A.T - Improved efficiency of module type-checking via lazy computation of - certain summary information. + certain signature summary information. Byte-code compiler: - Protect against VM stack overflow caused by module initialization code with many local variables. +- Support for dynamic loading of the C part of mixed Caml/C libraries. Native-code compiler: - Attempt to recover gracefully from system stack overflow. Currently works on x86 under Linux and BSD. +- Alpha: work around "as" bug in Tru64 5.1. Toplevel environment: - Revised printing of inferred types and evaluation results @@ -26,10 +28,15 @@ Tools: - ocamldep: added -pp option to handle preprocessed source files. Run-time system: +- Support for dynamic loading of the C part of mixed Caml/C libraries. + Currently works under Linux, FreeBSD, Windows, Tru64, Solaris and Irix. +- Implemented registration of global C roots with a skip list, + runs much faster when there are many global C roots. - Autoconfiguration script: fixed wrong detection of Mac OS X; problem with the Sparc, gcc 3.0, and float alignment fixed. Other libraries: +- All libraries revised to allow dynamic loading of the C part. - Graphics under X Windows: revised event handling, should no longer lose mouse events between two calls to wait_next_event(); wait_next_event() now interruptible by signals. @@ -57,7 +57,7 @@ COMP=bytecomp/lambda.cmo bytecomp/printlambda.cmo \ bytecomp/typeopt.cmo bytecomp/switch.cmo bytecomp/matching.cmo \ bytecomp/translobj.cmo bytecomp/translcore.cmo \ bytecomp/translclass.cmo bytecomp/translmod.cmo \ - bytecomp/simplif.cmo bytecomp/runtimedef.cmo + bytecomp/simplif.cmo bytecomp/runtimedef.cmo bytecomp/dll.cmo BYTECOMP=bytecomp/meta.cmo bytecomp/instruct.cmo bytecomp/bytegen.cmo \ bytecomp/printinstr.cmo bytecomp/opcodes.cmo bytecomp/emitcode.cmo \ @@ -102,7 +102,7 @@ EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \ utils/config.cmo utils/clflags.cmo \ typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \ typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \ - bytecomp/symtable.cmo toplevel/expunge.cmo + bytecomp/dll.cmo bytecomp/symtable.cmo toplevel/expunge.cmo PERVASIVES=arg array buffer callback char digest filename format gc hashtbl \ lexing list map obj parsing pervasives printexc printf queue random \ @@ -212,6 +212,7 @@ install: FORCE if test -d $(LIBDIR); then : ; else $(MKDIR) $(LIBDIR); fi if test -d $(MANDIR); then : ; else $(MKDIR) $(MANDIR); fi cd byterun; $(MAKE) install + echo "$(LIBDIR)" > $(LIBDIR)/ld.conf cp ocamlc $(BINDIR)/ocamlc$(EXE) cp ocaml $(BINDIR)/ocaml$(EXE) cd stdlib; $(MAKE) install @@ -277,9 +278,11 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%BYTERUN%%|$(BINDIR)/ocamlrun|' \ -e 's|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS)|' \ -e 's|%%BYTELINK%%|$(BYTECC) $(BYTECCLINKOPTS)|' \ + -e 's|%%BYTECCRPATH%%|$(BYTECCRPATH)|' \ -e 's|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|' \ -e 's|%%NATIVELINK%%|$(NATIVECC) $(NATIVECCLINKOPTS)|' \ -e 's|%%PARTIALLD%%|ld -r $(NATIVECCLINKOPTS)|' \ + -e 's|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|' \ -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \ -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \ -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \ @@ -289,6 +292,7 @@ utils/config.ml: utils/config.mlp config/Makefile -e 's|%%EXT_OBJ%%|.o|' \ -e 's|%%EXT_ASM%%|.s|' \ -e 's|%%EXT_LIB%%|.a|' \ + -e 's|%%EXT_DLL%%|.so|' \ utils/config.mlp > utils/config.ml @chmod -w utils/config.ml diff --git a/Makefile.nt b/Makefile.nt index 795711a9a8..c5a8ce9fca 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -59,7 +59,7 @@ COMP=bytecomp\lambda.cmo bytecomp\printlambda.cmo \ BYTECOMP=bytecomp\meta.cmo bytecomp\instruct.cmo bytecomp\bytegen.cmo \ bytecomp\printinstr.cmo bytecomp\opcodes.cmo bytecomp\emitcode.cmo \ - bytecomp\bytesections.cmo bytecomp\symtable.cmo \ + bytecomp\bytesections.cmo bytecomp\dll.cmo bytecomp\symtable.cmo \ bytecomp\bytelibrarian.cmo bytecomp\bytelink.cmo ASMCOMP=asmcomp\arch.cmo asmcomp\cmm.cmo asmcomp\printcmm.cmo \ @@ -99,7 +99,7 @@ EXPUNGEOBJS=utils\misc.cmo utils\tbl.cmo \ utils\config.cmo utils\clflags.cmo \ typing\ident.cmo typing\path.cmo typing\types.cmo typing\btype.cmo \ typing\predef.cmo bytecomp\runtimedef.cmo bytecomp\bytesections.cmo \ - bytecomp\symtable.cmo toplevel\expunge.cmo + bytecomp\dll.cmo bytecomp\symtable.cmo toplevel\expunge.cmo PERVASIVES=arg array buffer callback char digest filename format gc hashtbl \ lexing list map obj parsing pervasives printexc printf queue random \ @@ -206,6 +206,7 @@ install: installbyt installopt installbyt: cd byterun & $(MAKEREC) install + echo $(LIBDIR)> $(LIBDIR)\ld.conf cp ocamlc $(BINDIR)\ocamlc.exe cp ocaml $(BINDIR)\ocaml.exe cd stdlib & $(MAKEREC) install @@ -267,7 +268,7 @@ partialclean:: utils\config.ml: utils\config.mlp config\Makefile.nt @rm -f utils\config.ml - sed -e "s|%%%%LIBDIR%%%%|$(LIBDIR:\=/)|" \ + sed -e "s|%%%%LIBDIR%%%%|$(LIBDIR:\=\\\\\\\\)|" \ -e "s|%%%%BYTERUN%%%%|ocamlrun|" \ -e "s|%%%%BYTECC%%%%|$(BYTECC) $(BYTECCCOMPOPTS)|" \ -e "s|%%%%BYTELINK%%%%|$(BYTECC) $(BYTECCLINKOPTS)|" \ @@ -282,6 +283,7 @@ utils\config.ml: utils\config.mlp config\Makefile.nt -e "s|%%%%EXT_OBJ%%%%|.obj|" \ -e "s|%%%%EXT_ASM%%%%|.asm|" \ -e "s|%%%%EXT_LIB%%%%|.lib|" \ + -e "s|%%%%EXT_DLL%%%%|.dll|" \ utils\config.mlp > utils\config.ml @attrib +r utils\config.ml diff --git a/README.win32 b/README.win32 index 1b2b349920..5d31981f03 100644 --- a/README.win32 +++ b/README.win32 @@ -73,8 +73,9 @@ supported. Windows NT on non-Intel processors has not been tested. The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) runs without any additional tools. -Linking Caml bytecode with C code (ocamlc -custom) requires the -Microsoft Visual C++ compiler version 6. +Statically linking Caml bytecode with C code (ocamlc -custom) requires the +Microsoft Visual C++ compiler version 6. Dynamic loading of DLLs is +supported out of the box, without additional software. The native-code compiler (ocamlopt) requires Visual C++ version 6 and the Microsoft assembler MASM version 6.11 or later. @@ -127,9 +128,14 @@ The command-line tools can be recompiled from the Unix source distribution (ocaml-X.YZ.tar.gz), which also contains the files modified for Windows. -In addition to Visual C++ (version 4, 5 or 6) and MASM 6, you will -need the CygWin port of GNU tools, available from -http://sourceware.cygnus.com/cygwin/ +You will need the following software components to perform the recompilation: +- Windows NT or 2000 (the Makefiles do not work under Windows 95, 98, ME + due to differences between NT and 9x command-line interpreters); +- Visual C++ version 6 +- MASM version 6.11 (see above) +- The CygWin port of GNU tools, available from + http://sourceware.cygnus.com/cygwin/ +- TCL/TK version 8.3 (for the LablTK GUI) (see above). To recompile, first copy manually the files config/m-nt.h and config/s-nt.h to config/m.h and config/s.h. Edit config/Makefile.nt as needed. diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 15ae74366e..fff54f955b 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -233,7 +233,7 @@ let call_linker file_list startup_file = (String.concat " " (List.rev file_list)) | _ -> if not !Clflags.output_c_object then - Printf.sprintf "%s %s -o %s -I%s %s %s %s %s %s %s %s" + Printf.sprintf "%s %s -o %s -I%s %s %s %s %s %s %s %s %s" !Clflags.c_linker (if !Clflags.gprofile then "-pg" else "") !Clflags.exec_name @@ -244,6 +244,12 @@ let call_linker file_list startup_file = (String.concat " " (List.map (fun dir -> if dir = "" then "" else "-L" ^ dir) !load_path)) + (String.concat " " + (List.map (fun dir -> if dir = "" then "" else + Config.native_c_rpath ^ dir) + (!Clflags.dllpaths @ + Dll.ld_library_path_contents() @ + Dll.ld_conf_contents()))) (String.concat " " (List.rev !Clflags.ccobjs)) runtime_lib c_lib diff --git a/asmrun/.depend b/asmrun/.depend index 4f5ef48127..ce2546b1e2 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -122,7 +122,9 @@ minor_gc.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/gc_ctrl.h \ ../byterun/signals.h misc.o: misc.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/misc.h + ../byterun/../config/s.h ../byterun/misc.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h obj.o: obj.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 \ @@ -293,7 +295,9 @@ minor_gc.d.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/gc_ctrl.h \ ../byterun/signals.h misc.d.o: misc.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/misc.h + ../byterun/../config/s.h ../byterun/misc.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h obj.d.o: obj.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 \ @@ -464,7 +468,9 @@ minor_gc.p.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \ ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/gc_ctrl.h \ ../byterun/signals.h misc.p.o: misc.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/misc.h + ../byterun/../config/s.h ../byterun/misc.h ../byterun/memory.h \ + ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \ + ../byterun/freelist.h ../byterun/minor_gc.h obj.p.o: obj.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 \ diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 589768565f..7efc9f64e3 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamllex b/boot/ocamllex Binary files differindex fa0deece9a..6ad31bf31b 100755 --- a/boot/ocamllex +++ b/boot/ocamllex diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index 96708d5f62..7bece05700 100644 --- a/bytecomp/bytelibrarian.ml +++ b/bytecomp/bytelibrarian.ml @@ -38,6 +38,7 @@ let copy_compunit ic oc compunit = (* Add C objects and options and "custom" info from a library descriptor *) +let lib_sharedobjs = ref [] let lib_ccobjs = ref [] let lib_ccopts = ref [] diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 25ea79c4d2..1c3aefe802 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -27,6 +27,8 @@ type error = | Inconsistent_import of string * string * string | Custom_runtime | File_exists of string + | Cannot_open_dll of string + | Require_custom exception Error of error @@ -36,16 +38,14 @@ type link_action = | Link_archive of string * compilation_unit list (* Name of .cma file and descriptors of the units to be linked. *) -(* Add C objects and options and "custom" info from a library descriptor *) -(* Ignore them if -noautolink or -use-runtime were given *) +(* Add C objects and options from a library descriptor *) +(* Ignore them if -noautolink was given *) let lib_ccobjs = ref [] let lib_ccopts = ref [] let add_ccobjs l = - if not !Clflags.no_auto_link && String.length !Clflags.use_runtime = 0 - && String.length !Clflags.use_prims = 0 - then begin + if not !Clflags.no_auto_link then begin if l.lib_custom then Clflags.custom_runtime := true; lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs; lib_ccopts := l.lib_ccopts @ !lib_ccopts @@ -65,8 +65,8 @@ let add_ccobjs l = and b.cma was built with ocamlc -i ... objb1 objb2 lib_ccobjs starts as [], becomes objb2 objb1 when b.cma is scanned, - then obja2 obja1 objb2 objb1 when b.cma is scanned. - Clflags.ccobjs was initially obj2 obj1, + then obja2 obja1 objb2 objb1 when a.cma is scanned. + Clflags.ccobjs was initially obj2 obj1. and is set to obj2 obj1 obja2 obja1 objb2 objb1. Finally, the C compiler is given objb1 objb2 obja1 obja2 obj1 obj2, which is what we need. (If b depends on a, a.cma must appear before @@ -249,16 +249,14 @@ let output_debug_info oc = !debug_info; debug_info := [] -(* Transform a file name into an absolute file name *) +(* Output a list of strings with 0-termination *) -let make_absolute file = - if Filename.is_relative file - then Filename.concat (Sys.getcwd()) file - else file +let output_stringlist oc l = + List.iter (fun s -> output_string oc s; output_byte oc 0) l (* Create a bytecode executable file *) -let link_bytecode tolink exec_name copy_header = +let link_bytecode tolink exec_name standalone = if Sys.os_type = "MacOS" then begin (* Create it as a text file for bytecode scripts *) let c = open_out_gen [Open_wronly; Open_creat] 0o777 exec_name in @@ -267,35 +265,45 @@ let link_bytecode tolink exec_name copy_header = let outchan = open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] 0o777 exec_name in try - (* Copy the header *) - if copy_header then begin + if standalone then begin + (* Copy the header *) try - let header = - if String.length !Clflags.use_runtime > 0 - then "camlheader_ur" else "camlheader" in - let inchan = open_in_bin (find_in_path !load_path header) in + let inchan = open_in_bin (find_in_path !load_path "camlheader") in copy_file inchan outchan; close_in inchan with Not_found | Sys_error _ -> () end; Bytesections.init_record outchan; - (* The path to the bytecode interpreter (in use_runtime mode) *) - if String.length !Clflags.use_runtime > 0 then begin - output_string outchan (make_absolute !Clflags.use_runtime); - output_char outchan '\n'; - Bytesections.record outchan "RNTM" - end; (* The bytecode *) let start_code = pos_out outchan in Symtable.init(); Hashtbl.clear crc_interfaces; + let sharedobjs = Dll.extract_dll_names !Clflags.ccobjs in + if standalone then begin + (* Initialize the DLL machinery *) + if List.length sharedobjs < List.length !Clflags.ccobjs + then raise (Error Require_custom); + Dll.add_path !load_path; + try Dll.open_dlls sharedobjs + with Failure reason -> raise(Error(Cannot_open_dll reason)) + end; let output_fun = output_string outchan and currpos_fun () = pos_out outchan - start_code in List.iter (link_file output_fun currpos_fun) tolink; + if standalone then Dll.close_all_dlls(); (* The final STOP instruction *) output_byte outchan Opcodes.opSTOP; output_byte outchan 0; output_byte outchan 0; output_byte outchan 0; Bytesections.record outchan "CODE"; + (* DLL stuff *) + if standalone then begin + (* The extra search path for DLLs *) + output_stringlist outchan !Clflags.dllpaths; + Bytesections.record outchan "DLPT"; + (* The names of the DLLs *) + output_stringlist outchan sharedobjs; + Bytesections.record outchan "DLLS" + end; (* The names of all primitives *) Symtable.output_primitive_names outchan; Bytesections.record outchan "PRIM"; @@ -399,7 +407,7 @@ let build_custom_runtime prim_name exec_name = "Unix" | "Cygwin" -> Ccomp.command (Printf.sprintf - "%s -o %s -I%s %s %s %s %s -lcamlrun %s" + "%s -o %s -I%s %s %s %s %s %s -lcamlrun %s" !Clflags.c_linker exec_name Config.standard_library @@ -408,6 +416,12 @@ let build_custom_runtime prim_name exec_name = (String.concat " " (List.map (fun dir -> if dir = "" then "" else "-L" ^ dir) !load_path)) + (String.concat " " + (List.map (fun dir -> if dir = "" then "" else + Config.bytecomp_c_rpath ^ dir) + (!Clflags.dllpaths @ + Dll.ld_library_path_contents() @ + Dll.ld_conf_contents()))) (String.concat " " (List.rev !Clflags.ccobjs)) Config.bytecomp_c_libraries) | "Win32" -> @@ -541,3 +555,7 @@ let report_error ppf = function fprintf ppf "Error while building custom runtime system" | File_exists file -> fprintf ppf "Cannot overwrite existing file %s" file + | Cannot_open_dll file -> + fprintf ppf "Error on dynamically loaded library: %s" file + | Require_custom -> + fprintf ppf "Linking with non-Caml, non-shared object files requires the -custom flag" diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli index d3b932e29f..34de27c7fd 100644 --- a/bytecomp/bytelink.mli +++ b/bytecomp/bytelink.mli @@ -25,6 +25,8 @@ type error = | Inconsistent_import of string * string * string | Custom_runtime | File_exists of string + | Cannot_open_dll of string + | Require_custom exception Error of error diff --git a/bytecomp/bytesections.ml b/bytecomp/bytesections.ml index 084d6a043a..a9750cff49 100644 --- a/bytecomp/bytesections.ml +++ b/bytecomp/bytesections.ml @@ -78,6 +78,14 @@ let seek_section ic name = seek_sec (in_channel_length ic - 16 - 8 * List.length !section_table) !section_table +(* Return the contents of a section, as a string *) + +let read_section ic name = + let len = seek_section ic name in + let res = String.create len in + really_input ic res 0 len; + res + (* Return the position of the beginning of the first section *) let pos_first_section ic = diff --git a/bytecomp/bytesections.mli b/bytecomp/bytesections.mli index 9e12796091..48032454f2 100644 --- a/bytecomp/bytesections.mli +++ b/bytecomp/bytesections.mli @@ -44,5 +44,8 @@ val seek_section: in_channel -> string -> int and return the length of that section. Raise Not_found if no such section exists. *) +val read_section: in_channel -> string -> string + (* Return the contents of a section, as a string *) + val pos_first_section: in_channel -> int (* Return the position of the beginning of the first section *) diff --git a/bytecomp/dll.ml b/bytecomp/dll.ml new file mode 100644 index 0000000000..7814e1a04a --- /dev/null +++ b/bytecomp/dll.ml @@ -0,0 +1,149 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2001 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$ *) + +(* Handling of dynamically-linked libraries *) + +type dll_handle +type dll_address + +external dll_open: string -> dll_handle = "dynlink_open_lib" +external dll_close: dll_handle -> unit = "dynlink_close_lib" +external dll_sym: dll_handle -> string -> dll_address = "dynlink_lookup_symbol" +external add_primitive: dll_address -> int = "dynlink_add_primitive" +external get_current_dlls: unit -> dll_handle array + = "dynlink_get_current_libs" + +(* Current search path for DLLs *) +let search_path = ref ([] : string list) + +(* DLLs currently opened *) +let opened_dlls = ref ([] : dll_handle list) + +(* File names for those DLLs *) +let names_of_opened_dlls = ref ([] : string list) + +(* Add the given directories to the search path for DLLs. *) +let add_path dirs = + search_path := dirs @ !search_path + +(* Read the [ld.conf] file and return the corresponding list of directories *) + +let ld_conf_contents () = + let path = ref [] in + begin try + let ic = open_in (Filename.concat Config.standard_library "ld.conf") in + begin try + while true do + path := input_line ic :: !path + done + with End_of_file -> () + end; + close_in ic + with Sys_error _ -> () + end; + List.rev !path + +(* Split the CAML_LD_LIBRARY_PATH environment variable and return + the corresponding list of directories. *) + +let split str sep = + let rec split_rec pos = + if pos >= String.length str then [] else begin + try + let newpos = String.index_from str pos sep in + String.sub str pos (newpos - pos) :: + split_rec (newpos + 1) + with Not_found -> + [String.sub str pos (String.length str - pos)] + end in + split_rec 0 + +let ld_library_path_contents () = + let path_separator = + match Sys.os_type with + "Unix" | "Cygwin" -> ':' | "Win32" -> ';' | _ -> assert false in + try + split (Sys.getenv "CAML_LD_LIBRARY_PATH") path_separator + with Not_found -> + [] + +(* Extract names of DLLs from a list of C object files and libraries *) + +let extract_dll_names files = + List.fold_right + (fun file res -> + if Filename.check_suffix file Config.ext_dll then + Filename.chop_suffix file Config.ext_dll :: res + else if String.length file >= 2 && String.sub file 0 2 = "-l" then + ("lib" ^ String.sub file 2 (String.length file - 2)) :: res + else + res) + files [] + +(* Open a list of DLLs, adding them to opened_dlls. + Raise [Failure msg] in case of error. *) + +let open_dll name = + let name = name ^ Config.ext_dll in + let fullname = + try Misc.find_in_path !search_path name with Not_found -> name in + if not (List.mem fullname !names_of_opened_dlls) then begin + let dll = dll_open fullname in + names_of_opened_dlls := fullname :: !names_of_opened_dlls; + opened_dlls := dll :: !opened_dlls + end + +let open_dlls names = + List.iter open_dll (List.rev names) + +(* Close all DLLs *) + +let close_all_dlls () = + List.iter dll_close !opened_dlls; + opened_dlls := []; + names_of_opened_dlls := [] + +(* Find a primitive in the currently opened DLLs. + Raise [Not_found] if not found. *) + +let find_primitive prim_name = + let rec find = function + [] -> + raise Not_found + | dll :: rem -> + try dll_sym dll prim_name with Failure _ -> find rem in + find !opened_dlls + +(* If linking in core (dynlink or toplevel), synchronize the VM + table of primitive with the linker's table of primitive + by storing the given primitive function at the given position + in the VM table of primitives. *) + +let linking_in_core = ref false + +let synchronize_primitive num symb = + if !linking_in_core then begin + let actual_num = add_primitive symb in + assert (actual_num = num) + end + +(* Initialization for linking in core (dynlink or toplevel) *) + +let init_toplevel dllpath = + search_path := + ld_library_path_contents() @ split dllpath '\000' @ ld_conf_contents(); + opened_dlls := Array.to_list (get_current_dlls()); + names_of_opened_dlls := []; + linking_in_core := true + diff --git a/bytecomp/dll.mli b/bytecomp/dll.mli new file mode 100644 index 0000000000..e3f063317c --- /dev/null +++ b/bytecomp/dll.mli @@ -0,0 +1,56 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2001 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$ *) + +(* Handling of dynamically-linked libraries *) + +(* Extract names of DLLs from a list of C object files and libraries *) +val extract_dll_names: string list -> string list + +(* Open a list of DLLs, adding them to opened_dlls. + Raise [Failure msg] in case of error. *) +val open_dlls: string list -> unit + +(* Close all DLLs *) +val close_all_dlls: unit -> unit + +(* The abstract type representing C function pointers *) +type dll_address + +(* Find a primitive in the currently opened DLLs and return its address. + Raise [Not_found] if not found. *) +val find_primitive: string -> dll_address + +(* If linking in core (dynlink or toplevel), synchronize the VM + table of primitive with the linker's table of primitive + by storing the given primitive function at the given position + in the VM table of primitives. *) +val synchronize_primitive: int -> dll_address -> unit + +(* Add the given directories to the search path for DLLs. *) +val add_path: string list -> unit + +(* Read the [ld.conf] file and return the corresponding list of directories *) +val ld_conf_contents: unit -> string list + +(* Split the CAML_LD_LIBRARY_PATH environment variable and return + the corresponding list of directories *) +val ld_library_path_contents: unit -> string list + +(* Initialization for linking in core (dynlink or toplevel). + Initialize the search path to the same path that was used to start + the running program (CAML_LD_LIBRARY_PATH + directories in executable + + contents of ld.conf file). Take note of the DLLs that were opened + when starting the running program. *) +val init_toplevel: string -> unit + diff --git a/bytecomp/meta.ml b/bytecomp/meta.ml index 2e95d12a86..e8ae4608a8 100644 --- a/bytecomp/meta.ml +++ b/bytecomp/meta.ml @@ -19,6 +19,5 @@ external static_free : string -> unit = "static_free" external static_resize : string -> int -> string = "static_resize" type closure = unit -> Obj.t external reify_bytecode : string -> int -> closure = "reify_bytecode" -external available_primitives : unit -> string array = "available_primitives" external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t = "invoke_traced_function" diff --git a/bytecomp/meta.mli b/bytecomp/meta.mli index 24934a228a..e76a56532e 100644 --- a/bytecomp/meta.mli +++ b/bytecomp/meta.mli @@ -21,6 +21,5 @@ external static_free : string -> unit = "static_free" external static_resize : string -> int -> string = "static_resize" type closure = unit -> Obj.t external reify_bytecode : string -> int -> closure = "reify_bytecode" -external available_primitives : unit -> string array = "available_primitives" external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t = "invoke_traced_function" diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 4a2117f4c0..f22702f11c 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -19,7 +19,6 @@ open Asttypes open Lambda open Emitcode - (* Functions for batch linking *) type error = @@ -33,7 +32,7 @@ exception Error of error type 'a numtable = { num_cnt: int; (* The next number *) - num_tbl: ('a, int) Tbl.t } (* The table of already numbered objects *) + num_tbl: ('a, int) Tbl.t } (* The table of already numbered objects *) let empty_numtable = { num_cnt = 0; num_tbl = Tbl.empty } @@ -80,9 +79,16 @@ let num_of_prim name = try find_numtable !c_prim_table name with Not_found -> - if !Clflags.custom_runtime - then enter_numtable c_prim_table name - else raise(Error(Unavailable_primitive name)) + if !Clflags.custom_runtime then + enter_numtable c_prim_table name + else begin + let symb = + try Dll.find_primitive name + with Not_found -> raise(Error(Unavailable_primitive name)) in + let num = enter_numtable c_prim_table name in + Dll.synchronize_primitive num symb; + num + end let require_primitive name = if name.[0] <> '%' then ignore(num_of_prim name) @@ -110,12 +116,12 @@ let output_primitive_table outchan = fprintf outchan "extern long %s();\n" prim.(i) done; fprintf outchan "typedef long (*primitive)();\n"; - fprintf outchan "primitive cprim[] = {\n"; + fprintf outchan "primitive builtin_cprim[] = {\n"; for i = 0 to Array.length prim - 1 do fprintf outchan " %s,\n" prim.(i) done; fprintf outchan " (primitive) 0 };\n"; - fprintf outchan "char * names_of_cprim[] = {\n"; + fprintf outchan "char * names_of_builtin_cprim[] = {\n"; for i = 0 to Array.length prim - 1 do fprintf outchan " \"%s\",\n" prim.(i) done; @@ -138,33 +144,8 @@ let init () = let cst = Const_block(0, [Const_base(Const_string name)]) in literal_table := (c, cst) :: !literal_table) Runtimedef.builtin_exceptions; - (* Enter the known C primitives *) - if String.length !Clflags.use_prims > 0 then begin - let ic = open_in !Clflags.use_prims in - try - while true do - set_prim_table (input_line ic) - done - with End_of_file -> close_in ic - | x -> close_in ic; raise x - end else if String.length !Clflags.use_runtime > 0 then begin - let primfile = Filename.temp_file "camlprims" "" in - try - if Sys.command(Printf.sprintf "%s -p > %s" - !Clflags.use_runtime primfile) <> 0 - then raise(Error(Wrong_vm !Clflags.use_runtime)); - let ic = open_in primfile in - try - while true do - set_prim_table (input_line ic) - done - with End_of_file -> remove_file primfile; close_in ic - | x -> close_in ic; raise x - with x -> remove_file primfile; raise x - end else begin - Array.iter set_prim_table - Runtimedef.builtin_primitives - end + (* Initialize the known C primitives *) + Array.iter set_prim_table Runtimedef.builtin_primitives (* Relocate a block of object bytecode *) @@ -239,19 +220,28 @@ let update_global_table () = (* Initialize the linker for toplevel use *) let init_toplevel () = - (* Read back the known global symbols from the executable file *) + (* Read back the known global symbols and the known primitives + from the executable file *) let ic = open_in_bin Sys.argv.(0) in begin try Bytesections.read_toc ic; ignore(Bytesections.seek_section ic "SYMB"); - global_table := (input_value ic : Ident.t numtable) + global_table := (input_value ic : Ident.t numtable); + let prims = Bytesections.read_section ic "PRIM" in + let pos = ref 0 in + while !pos < String.length prims do + let i = String.index_from prims !pos '\000' in + set_prim_table (String.sub prims !pos (i - !pos)); + pos := i + 1 + done with Bytesections.Bad_magic_number | Not_found | Failure _ -> fatal_error "Toplevel bytecode executable is corrupted" end; + let dllpath = + try Bytesections.read_section ic "DLPT" with Not_found -> "" in close_in ic; - (* Enter the known C primitives *) - Array.iter set_prim_table - (Meta.available_primitives()) + (* Initialize the Dll machinery for toplevel use *) + Dll.init_toplevel dllpath (* Find the value of a global identifier *) diff --git a/byterun/.depend b/byterun/.depend index 7b495bf375..f517dc5b2d 100644 --- a/byterun/.depend +++ b/byterun/.depend @@ -22,6 +22,9 @@ custom.o: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ debugger.o: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h +dynlink.o: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h extern.o: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ major_gc.h freelist.h minor_gc.h reverse.h @@ -80,7 +83,8 @@ meta.o: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ minor_gc.o: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h gc_ctrl.h signals.h -misc.o: misc.c config.h ../config/m.h ../config/s.h misc.h +misc.o: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h mpwtool.o: mpwtool.c obj.o: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ @@ -101,10 +105,10 @@ 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 backtrace.h callback.h custom.h debugger.h exec.h \ - fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h intext.h io.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h prims.h printexc.h \ - reverse.h signals.h stacks.h sys.h startup.h + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.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 \ @@ -112,10 +116,12 @@ sys.o: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ gc.h major_gc.h freelist.h minor_gc.h sys.h terminfo.o: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ misc.h mlvalues.h fail.h io.h +unix.o: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h weak.o: weak.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 -win32.o: win32.c signals.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h +win32.o: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h alloc.d.o: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ stacks.h @@ -140,6 +146,9 @@ custom.d.o: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ debugger.d.o: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h +dynlink.d.o: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h extern.d.o: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ major_gc.h freelist.h minor_gc.h reverse.h @@ -199,7 +208,8 @@ meta.d.o: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ minor_gc.d.o: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h gc_ctrl.h signals.h -misc.d.o: misc.c config.h ../config/m.h ../config/s.h misc.h +misc.d.o: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h mpwtool.d.o: mpwtool.c obj.d.o: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ @@ -220,10 +230,10 @@ 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 backtrace.h callback.h custom.h debugger.h exec.h \ - fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h intext.h io.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h prims.h printexc.h \ - reverse.h signals.h stacks.h sys.h startup.h + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.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 \ @@ -231,7 +241,9 @@ sys.d.o: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ gc.h major_gc.h freelist.h minor_gc.h sys.h terminfo.d.o: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ misc.h mlvalues.h fail.h io.h +unix.d.o: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h weak.d.o: weak.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 -win32.d.o: win32.c signals.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h +win32.d.o: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h diff --git a/byterun/.depend.nt b/byterun/.depend.nt index a0bc8b7c54..d5304419b5 100644 --- a/byterun/.depend.nt +++ b/byterun/.depend.nt @@ -1,199 +1,498 @@ -alloc.obj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h major_gc.h freelist.h memory.h gc.h minor_gc.h stacks.h -array.obj: array.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +alloc.dobj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ + stacks.h +array.dobj: array.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 -callback.obj: callback.c callback.h mlvalues.h config.h ../config/m.h \ - ../config/s.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ - interp.h instruct.h fix_code.h stacks.h -compact.obj: compact.c config.h ../config/m.h ../config/s.h freelist.h \ - misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ - roots.h weak.h -compare.obj: compare.c fail.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h \ +backtrace.dobj: backtrace.c config.h ../config/m.h ../config/s.h \ + mlvalues.h misc.h alloc.h io.h instruct.h intext.h fix_code.h exec.h \ + startup.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + sys.h backtrace.h +callback.dobj: callback.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h interp.h instruct.h fix_code.h stacks.h +compact.dobj: compact.c config.h ../config/m.h ../config/s.h finalise.h \ + roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h gc_ctrl.h weak.h +compare.dobj: compare.c custom.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +custom.dobj: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h -debugger.obj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ +debugger.dobj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h -extern.obj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \ - freelist.h minor_gc.h reverse.h -fail.obj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +dynlink.dobj: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h +extern.dobj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +fail.dobj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h minor_gc.h \ - signals.h stacks.h -fix_code.obj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ + printexc.h signals.h stacks.h +finalise.dobj: finalise.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h signals.h +fix_code.dobj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \ major_gc.h freelist.h minor_gc.h reverse.h -floats.obj: floats.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +floats.dobj: floats.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 \ - stacks.h -freelist.obj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ + reverse.h stacks.h +freelist.dobj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h -gc_ctrl.obj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h compact.h gc.h gc_ctrl.h major_gc.h \ - freelist.h minor_gc.h stacks.h memory.h -hash.obj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h -instrtrace.obj: instrtrace.c -intern.obj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \ - freelist.h minor_gc.h reverse.h -interp.obj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h callback.h debugger.h fail.h fix_code.h instrtrace.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.obj: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +gc_ctrl.dobj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h compact.h custom.h finalise.h roots.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h stacks.h +globroots.dobj: globroots.c memory.h config.h ../config/m.h ../config/s.h \ + gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h globroots.h +hash.dobj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ + custom.h memory.h gc.h major_gc.h freelist.h minor_gc.h +instrtrace.dobj: instrtrace.c +intern.dobj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +interp.dobj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h backtrace.h callback.h debugger.h fail.h fix_code.h \ + instrtrace.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.dobj: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.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.dobj: 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 +lexing.dobj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h +macintosh.dobj: macintosh.c misc.h config.h ../config/m.h ../config/s.h \ + rotatecursor.h +main.dobj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ + sys.h +major_gc.dobj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ + misc.h custom.h mlvalues.h fail.h finalise.h roots.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h +md5.dobj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h md5.h io.h reverse.h +memory.dobj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ + signals.h +meta.dobj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h fix_code.h interp.h major_gc.h freelist.h memory.h \ + gc.h minor_gc.h prims.h stacks.h +minor_gc.dobj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ + misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h gc_ctrl.h signals.h +misc.dobj: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h +mpwtool.dobj: mpwtool.c +obj.dobj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ + prims.h +parsing.dobj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ + misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h +prims.dobj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ + misc.h prims.h +printexc.dobj: printexc.c backtrace.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h debugger.h fail.h printexc.h +roots.dobj: roots.c finalise.h roots.h misc.h config.h ../config/m.h \ + ../config/s.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h globroots.h stacks.h +rotatecursor.dobj: rotatecursor.c rotatecursor.h +signals.dobj: signals.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h roots.h signals.h sys.h +stacks.dobj: 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.dobj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h +str.dobj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h +sys.dobj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ + mlvalues.h debugger.h fail.h instruct.h signals.h stacks.h memory.h \ + gc.h major_gc.h freelist.h minor_gc.h sys.h +terminfo.dobj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h fail.h io.h +unix.dobj: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h +weak.dobj: weak.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 -io.obj: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ - mlvalues.h fail.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ - signals.h sys.h -lexing.obj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ +win32.dobj: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h +alloc.d.dobj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ + stacks.h +array.d.dobj: array.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 +backtrace.d.dobj: backtrace.c config.h ../config/m.h ../config/s.h \ + mlvalues.h misc.h alloc.h io.h instruct.h intext.h fix_code.h exec.h \ + startup.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + sys.h backtrace.h +callback.d.dobj: callback.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h interp.h instruct.h fix_code.h stacks.h +compact.d.dobj: compact.c config.h ../config/m.h ../config/s.h finalise.h \ + roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h gc_ctrl.h weak.h +compare.d.dobj: compare.c custom.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +custom.d.dobj: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +debugger.d.dobj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ + misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h +dynlink.d.dobj: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h +extern.d.dobj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +fail.d.dobj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h minor_gc.h \ + printexc.h signals.h stacks.h +finalise.d.dobj: finalise.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h signals.h +fix_code.d.dobj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ + misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h reverse.h +floats.d.dobj: floats.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 \ + reverse.h stacks.h +freelist.d.dobj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ + misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h +gc_ctrl.d.dobj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h compact.h custom.h finalise.h roots.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h stacks.h +globroots.d.dobj: globroots.c memory.h config.h ../config/m.h ../config/s.h \ + gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h globroots.h +hash.d.dobj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ + custom.h memory.h gc.h major_gc.h freelist.h minor_gc.h +instrtrace.d.dobj: instrtrace.c instruct.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h opnames.h +intern.d.dobj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +interp.d.dobj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h backtrace.h callback.h debugger.h fail.h fix_code.h \ + instrtrace.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.dobj: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.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.dobj: 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 +lexing.d.dobj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h -macintosh.obj: macintosh.c -main.obj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ +macintosh.d.dobj: macintosh.c misc.h config.h ../config/m.h ../config/s.h \ + rotatecursor.h +main.d.dobj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ sys.h -major_gc.obj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ - misc.h fail.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h \ - memory.h minor_gc.h weak.h -md5.obj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +major_gc.d.dobj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ + misc.h custom.h mlvalues.h fail.h finalise.h roots.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h +md5.d.dobj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h md5.h io.h reverse.h -memory.obj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ +memory.d.dobj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ signals.h -meta.obj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +meta.d.dobj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h fix_code.h interp.h major_gc.h freelist.h memory.h \ gc.h minor_gc.h prims.h stacks.h -minor_gc.obj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ - misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h freelist.h memory.h \ - minor_gc.h roots.h signals.h -misc.obj: misc.c config.h ../config/m.h ../config/s.h misc.h -obj.obj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +minor_gc.d.dobj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ + misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h gc_ctrl.h signals.h +misc.d.dobj: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h +mpwtool.d.dobj: mpwtool.c +obj.d.dobj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ prims.h -parsing.obj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ +parsing.d.dobj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h -prims.obj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ +prims.d.dobj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ misc.h prims.h -printexc.obj: printexc.c fail.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h -roots.obj: roots.c memory.h config.h ../config/m.h ../config/s.h gc.h \ - mlvalues.h misc.h major_gc.h freelist.h minor_gc.h roots.h stacks.h -rotatecursor.obj: rotatecursor.c rotatecursor.h -signals.obj: signals.c alloc.h misc.h config.h ../config/m.h \ +printexc.d.dobj: printexc.c backtrace.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h debugger.h fail.h printexc.h +roots.d.dobj: roots.c finalise.h roots.h misc.h config.h ../config/m.h \ + ../config/s.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h globroots.h stacks.h +rotatecursor.d.dobj: rotatecursor.c rotatecursor.h +signals.d.dobj: signals.c alloc.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h roots.h signals.h sys.h -stacks.obj: stacks.c config.h ../config/m.h ../config/s.h fail.h misc.h \ +stacks.d.dobj: 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.obj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ - misc.h mlvalues.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 stacks.h sys.h -str.obj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +startup.d.dobj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h +str.d.dobj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h -sys.obj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ +sys.d.dobj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ mlvalues.h debugger.h fail.h instruct.h signals.h stacks.h memory.h \ gc.h major_gc.h freelist.h minor_gc.h sys.h -terminfo.obj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ +terminfo.d.dobj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ misc.h mlvalues.h fail.h io.h -weak.obj: weak.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +unix.d.dobj: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h +weak.d.dobj: weak.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 -wincmdline.obj: wincmdline.c -alloc.d.obj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h major_gc.h freelist.h memory.h gc.h minor_gc.h stacks.h -array.d.obj: array.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +win32.d.dobj: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h +alloc.sobj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ + stacks.h +array.sobj: array.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 -callback.d.obj: callback.c callback.h mlvalues.h config.h ../config/m.h \ - ../config/s.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ - interp.h instruct.h fix_code.h stacks.h -compact.d.obj: compact.c config.h ../config/m.h ../config/s.h freelist.h \ - misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ - roots.h weak.h -compare.d.obj: compare.c fail.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h \ +backtrace.sobj: backtrace.c config.h ../config/m.h ../config/s.h \ + mlvalues.h misc.h alloc.h io.h instruct.h intext.h fix_code.h exec.h \ + startup.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + sys.h backtrace.h +callback.sobj: callback.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h interp.h instruct.h fix_code.h stacks.h +compact.sobj: compact.c config.h ../config/m.h ../config/s.h finalise.h \ + roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h gc_ctrl.h weak.h +compare.sobj: compare.c custom.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +custom.sobj: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h -debugger.d.obj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ +debugger.sobj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h -extern.d.obj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \ - freelist.h minor_gc.h reverse.h -fail.d.obj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +dynlink.sobj: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h +extern.sobj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +fail.sobj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h minor_gc.h \ - signals.h stacks.h -fix_code.d.obj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ + printexc.h signals.h stacks.h +finalise.sobj: finalise.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h signals.h +fix_code.sobj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \ major_gc.h freelist.h minor_gc.h reverse.h -floats.d.obj: floats.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +floats.sobj: floats.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 \ + reverse.h stacks.h +freelist.sobj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ + misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h +gc_ctrl.sobj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h compact.h custom.h finalise.h roots.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h stacks.h +globroots.sobj: globroots.c memory.h config.h ../config/m.h ../config/s.h \ + gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h globroots.h +hash.sobj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ + custom.h memory.h gc.h major_gc.h freelist.h minor_gc.h +instrtrace.sobj: instrtrace.c +intern.sobj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +interp.sobj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h backtrace.h callback.h debugger.h fail.h fix_code.h \ + instrtrace.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.sobj: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.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.sobj: 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 +lexing.sobj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h +macintosh.sobj: macintosh.c misc.h config.h ../config/m.h ../config/s.h \ + rotatecursor.h +main.sobj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ + sys.h +major_gc.sobj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ + misc.h custom.h mlvalues.h fail.h finalise.h roots.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h +md5.sobj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h md5.h io.h reverse.h +memory.sobj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ + signals.h +meta.sobj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h fix_code.h interp.h major_gc.h freelist.h memory.h \ + gc.h minor_gc.h prims.h stacks.h +minor_gc.sobj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ + misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h gc_ctrl.h signals.h +misc.sobj: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h +mpwtool.sobj: mpwtool.c +obj.sobj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ + prims.h +parsing.sobj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ + misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h +prims.sobj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ + misc.h prims.h +printexc.sobj: printexc.c backtrace.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h debugger.h fail.h printexc.h +roots.sobj: roots.c finalise.h roots.h misc.h config.h ../config/m.h \ + ../config/s.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h globroots.h stacks.h +rotatecursor.sobj: rotatecursor.c rotatecursor.h +signals.sobj: signals.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h roots.h signals.h sys.h +stacks.sobj: 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.sobj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h +str.sobj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h +sys.sobj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ + mlvalues.h debugger.h fail.h instruct.h signals.h stacks.h memory.h \ + gc.h major_gc.h freelist.h minor_gc.h sys.h +terminfo.sobj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h fail.h io.h +unix.sobj: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h +weak.sobj: weak.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 +win32.sobj: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h +alloc.d.sobj: alloc.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h minor_gc.h \ stacks.h -freelist.d.obj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ +array.d.sobj: array.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 +backtrace.d.sobj: backtrace.c config.h ../config/m.h ../config/s.h \ + mlvalues.h misc.h alloc.h io.h instruct.h intext.h fix_code.h exec.h \ + startup.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + sys.h backtrace.h +callback.d.sobj: callback.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h interp.h instruct.h fix_code.h stacks.h +compact.d.sobj: compact.c config.h ../config/m.h ../config/s.h finalise.h \ + roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h gc_ctrl.h weak.h +compare.d.sobj: compare.c custom.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +custom.d.sobj: custom.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h +debugger.d.sobj: debugger.c config.h ../config/m.h ../config/s.h debugger.h \ + misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h +dynlink.d.sobj: dynlink.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h osdeps.h prims.h +extern.d.sobj: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +fail.d.sobj: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h minor_gc.h \ + printexc.h signals.h stacks.h +finalise.d.sobj: finalise.c callback.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h fail.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h signals.h +fix_code.d.sobj: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \ + misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h reverse.h +floats.d.sobj: floats.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 \ + reverse.h stacks.h +freelist.d.sobj: freelist.c config.h ../config/m.h ../config/s.h freelist.h \ misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h -gc_ctrl.d.obj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h compact.h gc.h gc_ctrl.h major_gc.h \ - freelist.h minor_gc.h stacks.h memory.h -hash.d.obj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h -instrtrace.d.obj: instrtrace.c instruct.h misc.h config.h ../config/m.h \ +gc_ctrl.d.sobj: gc_ctrl.c alloc.h misc.h config.h ../config/m.h \ + ../config/s.h mlvalues.h compact.h custom.h finalise.h roots.h \ + memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h stacks.h +globroots.d.sobj: globroots.c memory.h config.h ../config/m.h ../config/s.h \ + gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h globroots.h +hash.d.sobj: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \ + custom.h memory.h gc.h major_gc.h freelist.h minor_gc.h +instrtrace.d.sobj: instrtrace.c instruct.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h opnames.h -intern.d.obj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \ - freelist.h minor_gc.h reverse.h -interp.d.obj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ - mlvalues.h callback.h debugger.h fail.h fix_code.h instrtrace.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.obj: 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 -io.d.obj: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ - mlvalues.h fail.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ - signals.h sys.h -lexing.d.obj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ +intern.d.sobj: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h custom.h fail.h gc.h intext.h io.h fix_code.h memory.h \ + major_gc.h freelist.h minor_gc.h reverse.h +interp.d.sobj: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ + mlvalues.h backtrace.h callback.h debugger.h fail.h fix_code.h \ + instrtrace.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.sobj: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.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.sobj: 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 +lexing.d.sobj: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h -macintosh.d.obj: macintosh.c -main.d.obj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ +macintosh.d.sobj: macintosh.c misc.h config.h ../config/m.h ../config/s.h \ + rotatecursor.h +main.d.sobj: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \ sys.h -major_gc.d.obj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ - misc.h fail.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h \ - memory.h minor_gc.h weak.h -md5.d.obj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +major_gc.d.sobj: major_gc.c compact.h config.h ../config/m.h ../config/s.h \ + misc.h custom.h mlvalues.h fail.h finalise.h roots.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h +md5.d.sobj: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h md5.h io.h reverse.h -memory.d.obj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ +memory.d.sobj: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \ signals.h -meta.d.obj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +meta.d.sobj: meta.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h fix_code.h interp.h major_gc.h freelist.h memory.h \ gc.h minor_gc.h prims.h stacks.h -minor_gc.d.obj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ - misc.h mlvalues.h gc.h gc_ctrl.h major_gc.h freelist.h memory.h \ - minor_gc.h roots.h signals.h -misc.d.obj: misc.c config.h ../config/m.h ../config/s.h misc.h -obj.d.obj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +minor_gc.d.sobj: minor_gc.c config.h ../config/m.h ../config/s.h fail.h \ + misc.h mlvalues.h finalise.h roots.h memory.h gc.h major_gc.h \ + freelist.h minor_gc.h gc_ctrl.h signals.h +misc.d.sobj: misc.c config.h ../config/m.h ../config/s.h misc.h memory.h \ + gc.h mlvalues.h major_gc.h freelist.h minor_gc.h +mpwtool.d.sobj: mpwtool.c +obj.d.sobj: obj.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h gc.h major_gc.h freelist.h memory.h minor_gc.h \ prims.h -parsing.d.obj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ +parsing.d.sobj: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \ misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h -prims.d.obj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ +prims.d.sobj: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \ misc.h prims.h -printexc.d.obj: printexc.c fail.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h -roots.d.obj: roots.c memory.h config.h ../config/m.h ../config/s.h gc.h \ - mlvalues.h misc.h major_gc.h freelist.h minor_gc.h roots.h stacks.h -rotatecursor.d.obj: rotatecursor.c rotatecursor.h -signals.d.obj: signals.c alloc.h misc.h config.h ../config/m.h \ +printexc.d.sobj: printexc.c backtrace.h mlvalues.h config.h ../config/m.h \ + ../config/s.h misc.h debugger.h fail.h printexc.h +roots.d.sobj: roots.c finalise.h roots.h misc.h config.h ../config/m.h \ + ../config/s.h memory.h gc.h mlvalues.h major_gc.h freelist.h \ + minor_gc.h globroots.h stacks.h +rotatecursor.d.sobj: rotatecursor.c rotatecursor.h +signals.d.sobj: signals.c alloc.h misc.h config.h ../config/m.h \ ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h major_gc.h \ freelist.h minor_gc.h roots.h signals.h sys.h -stacks.d.obj: stacks.c config.h ../config/m.h ../config/s.h fail.h misc.h \ +stacks.d.sobj: 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.obj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ - misc.h mlvalues.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 stacks.h sys.h -str.d.obj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +startup.d.sobj: startup.c config.h ../config/m.h ../config/s.h alloc.h \ + misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \ + dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \ + intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \ + prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h +str.d.sobj: str.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ mlvalues.h fail.h -sys.d.obj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ +sys.d.sobj: sys.c config.h ../config/m.h ../config/s.h alloc.h misc.h \ mlvalues.h debugger.h fail.h instruct.h signals.h stacks.h memory.h \ gc.h major_gc.h freelist.h minor_gc.h sys.h -terminfo.d.obj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ +terminfo.d.sobj: terminfo.c config.h ../config/m.h ../config/s.h alloc.h \ misc.h mlvalues.h fail.h io.h -weak.d.obj: weak.c alloc.h misc.h config.h ../config/m.h ../config/s.h \ +unix.d.sobj: unix.c config.h ../config/m.h ../config/s.h memory.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h +weak.d.sobj: weak.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 -wincmdline.d.obj: wincmdline.c +win32.d.sobj: win32.c memory.h config.h ../config/m.h ../config/s.h gc.h \ + mlvalues.h misc.h major_gc.h freelist.h minor_gc.h osdeps.h signals.h diff --git a/byterun/Makefile b/byterun/Makefile index 7088ceafc0..e67d13b9bd 100644 --- a/byterun/Makefile +++ b/byterun/Makefile @@ -23,13 +23,15 @@ OBJS=interp.o misc.o stacks.o fix_code.o startup.o main.o \ fail.o signals.o printexc.o backtrace.o \ compare.o ints.o floats.o str.o array.o io.o extern.o intern.o \ hash.o sys.o meta.o parsing.o gc_ctrl.o terminfo.o md5.o obj.o \ - lexing.o callback.o debugger.o weak.o compact.o finalise.o custom.o + lexing.o callback.o debugger.o weak.o compact.o finalise.o custom.o \ + dynlink.o unix.o DOBJS=$(OBJS:.o=.d.o) instrtrace.d.o PRIMS=alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \ intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \ - signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c stacks.c + signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c stacks.c \ + dynlink.c PUBLIC_INCLUDES=mlvalues.h alloc.h misc.h callback.h fail.h custom.h @@ -69,17 +71,17 @@ clean: rm -f primitives prims.c opnames.h jumptbl.h primitives : $(PRIMS) - sed -n -e '/\/\* ML \*\//s/.* \([a-z0-9_][a-z0-9_]*\) *(.*/\1/p' \ + sed -n -e "s/CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" \ $(PRIMS) > primitives prims.c : primitives (echo '#include "mlvalues.h"'; \ echo '#include "prims.h"'; \ sed -e 's/.*/extern value &();/' primitives; \ - echo 'c_primitive cprim[] = {'; \ + echo 'c_primitive builtin_cprim[] = {'; \ sed -e 's/.*/ &,/' primitives; \ echo ' 0 };'; \ - echo 'char * names_of_cprim[] = {'; \ + echo 'char * names_of_builtin_cprim[] = {'; \ sed -e 's/.*/ "&",/' primitives; \ echo ' 0 };') > prims.c diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt index 980d417b77..b06b3e2095 100644 --- a/byterun/Makefile.nt +++ b/byterun/Makefile.nt @@ -15,7 +15,7 @@ !include ..\config\Makefile.nt CC=$(BYTECC) -CFLAGS=$(BYTECCCOMPOPTS) +CFLAGS=-DIN_OCAMLRUN -DOCAML_STDLIB_DIR="\"$(LIBDIR:\=\\)\"" OBJS=interp.obj misc.obj stacks.obj fix_code.obj startup.obj main.obj \ fail.obj signals.obj freelist.obj major_gc.obj minor_gc.obj \ @@ -23,15 +23,16 @@ OBJS=interp.obj misc.obj stacks.obj fix_code.obj startup.obj main.obj \ str.obj array.obj io.obj extern.obj intern.obj hash.obj sys.obj \ meta.obj parsing.obj gc_ctrl.obj terminfo.obj md5.obj obj.obj lexing.obj \ win32.obj printexc.obj callback.obj debugger.obj weak.obj compact.obj \ - finalise.obj custom.obj backtrace.obj globroots.obj + finalise.obj custom.obj backtrace.obj globroots.obj dynlink.obj PRIMS=alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \ intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \ - signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c stacks.c + signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c stacks.c \ + dynlink.c PUBLIC_INCLUDES=mlvalues.h alloc.h misc.h callback.h fail.h custom.h -all: ocamlrun.exe +all: ocamlrun.exe libcamlrun.lib if not exist ..\stdlib\caml mkdir ..\stdlib\caml cp $(PUBLIC_INCLUDES) ..\stdlib\caml sed -e "/#include .*\/m.h/r ..\config\m.h" \ @@ -41,11 +42,15 @@ all: ocamlrun.exe -e "/#define Alloc_small/,/^}/d" \ -e "/Modify/,/^}/d" memory.h > ..\stdlib\caml\memory.h -ocamlrun.exe: libcamlrun.lib prims.obj - $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -o ocamlrun.exe prims.obj libcamlrun.lib $(CCLIBS) +ocamlrun.exe: $(OBJS:.obj=.dobj) prims.dobj + link /nologo /out:ocamlrun.exe $(OBJS:.obj=.dobj) prims.dobj $(CCLIBS) + +libcamlrun.lib: $(OBJS:.obj=.sobj) + $(MKLIB)libcamlrun.lib $(OBJS:.obj=.sobj) install: cp ocamlrun.exe $(BINDIR)\ocamlrun.exe + cp ocamlrun.lib $(LIBDIR)\ocamlrun.lib cp libcamlrun.lib $(LIBDIR)\libcamlrun.lib if not exist $(LIBDIR)\caml mkdir $(LIBDIR)\caml cp $(PUBLIC_INCLUDES) $(LIBDIR)\caml @@ -56,25 +61,22 @@ install: -e "/#define Alloc_small/,/^}/d" \ -e "/Modify/,/^}/d" memory.h > $(LIBDIR)\caml\memory.h -libcamlrun.lib: $(OBJS) - $(MKLIB)libcamlrun.lib $(OBJS) - clean: - rm -f ocamlrun.exe *.obj *.lib + rm -f *.exe *.dobj *.sobj *.lib rm -f primitives prims.c opnames.h jumptbl.h primitives : $(PRIMS) - sed -n -e "/\/\* ML \*\//s/.* \([a-z0-9_][a-z0-9_]*\) *(.*/\1/p" \ + sed -n -e "s/CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p" \ $(PRIMS) > primitives prims.c : primitives echo #include "mlvalues.h" > prims.c echo #include "prims.h" >> prims.c sed -e "s/.*/extern value &();/" primitives >> prims.c - echo c_primitive cprim[] = { >> prims.c + echo c_primitive builtin_cprim[] = { >> prims.c sed -e "s/.*/ &,/" primitives >> prims.c echo 0 }; >> prims.c - echo char * names_of_cprim[] = { >> prims.c + echo char * names_of_builtin_cprim[] = { >> prims.c sed -e "s/.*/ \"^&\",/" primitives >> prims.c echo 0 }; >> prims.c @@ -89,7 +91,17 @@ jumptbl.h : instruct.h sed -n -e "/^ /s/ \([A-Z]\)/ \&\&lbl_\1/gp" \ -e "/^}/q" instruct.h > jumptbl.h +.SUFFIXES: .dobj .sobj + +.c.dobj: + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) -c $< + mv $*.obj $*.dobj +.c.sobj: + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) -c $< + mv $*.obj $*.sobj + depend: - sed -e "s/\.o/.obj/g" .depend > .depend.nt + sed -e "s/\.o/.dobj/g" .depend > .depend.nt + sed -e "s/\.o/.sobj/g" .depend >> .depend.nt !include .depend.nt diff --git a/byterun/alloc.c b/byterun/alloc.c index 53e82df25c..33b3f108b2 100644 --- a/byterun/alloc.c +++ b/byterun/alloc.c @@ -28,7 +28,7 @@ #define Setup_for_gc #define Restore_after_gc -value alloc (mlsize_t wosize, tag_t tag) +CAMLexport value alloc (mlsize_t wosize, tag_t tag) { value result; mlsize_t i; @@ -48,7 +48,7 @@ value alloc (mlsize_t wosize, tag_t tag) return result; } -value alloc_small (mlsize_t wosize, tag_t tag) +CAMLexport value alloc_small (mlsize_t wosize, tag_t tag) { value result; @@ -59,12 +59,12 @@ value alloc_small (mlsize_t wosize, tag_t tag) return result; } -value alloc_tuple(mlsize_t n) +CAMLexport value alloc_tuple(mlsize_t n) { return alloc(n, 0); } -value alloc_string (mlsize_t len) +CAMLexport value alloc_string (mlsize_t len) { value result; mlsize_t offset_index; @@ -82,13 +82,14 @@ value alloc_string (mlsize_t len) return result; } -value alloc_final (mlsize_t len, final_fun fun, mlsize_t mem, mlsize_t max) +CAMLexport value alloc_final (mlsize_t len, final_fun fun, + mlsize_t mem, mlsize_t max) { return alloc_custom(final_custom_operations(fun), len * sizeof(value), mem, max); } -value copy_string(char const *s) +CAMLexport value copy_string(char const *s) { int len; value res; @@ -99,7 +100,7 @@ value copy_string(char const *s) return res; } -value alloc_array(value (*funct)(char const *), char const ** arr) +CAMLexport value alloc_array(value (*funct)(char const *), char const ** arr) { CAMLparam0 (); mlsize_t nbr, n; @@ -122,12 +123,12 @@ value alloc_array(value (*funct)(char const *), char const ** arr) } } -value copy_string_array(char const ** arr) +CAMLexport value copy_string_array(char const ** arr) { return alloc_array(copy_string, arr); } -int convert_flag_list(value list, int *flags) +CAMLexport int convert_flag_list(value list, int *flags) { int res; res = 0; @@ -140,7 +141,7 @@ int convert_flag_list(value list, int *flags) /* For compiling let rec over values */ -value alloc_dummy(value size) /* ML */ +CAMLprim value alloc_dummy(value size) { mlsize_t wosize = Int_val(size); @@ -148,7 +149,7 @@ value alloc_dummy(value size) /* ML */ return alloc (wosize, 0); } -value update_dummy(value dummy, value newval) /* ML */ +CAMLprim value update_dummy(value dummy, value newval) { mlsize_t size, i; size = Wosize_val(newval); diff --git a/byterun/alloc.h b/byterun/alloc.h index 39be6c8aed..bb829febbc 100644 --- a/byterun/alloc.h +++ b/byterun/alloc.h @@ -19,24 +19,25 @@ #include "misc.h" #include "mlvalues.h" -value alloc (mlsize_t, tag_t); -value alloc_small (mlsize_t, tag_t); -value alloc_tuple (mlsize_t); -value alloc_string (mlsize_t); -value copy_string (char const *); -value copy_string_array (char const **); -value copy_double (double); -value copy_int32 (int32); /* defined in [ints.c] */ -value copy_int64 (int64); /* defined in [ints.c] */ -value copy_nativeint (long); /* defined in [ints.c] */ -value alloc_array (value (*funct) (char const *), char const ** array); +CAMLextern value alloc (mlsize_t, tag_t); +CAMLextern value alloc_small (mlsize_t, tag_t); +CAMLextern value alloc_tuple (mlsize_t); +CAMLextern value alloc_string (mlsize_t); +CAMLextern value copy_string (char const *); +CAMLextern value copy_string_array (char const **); +CAMLextern value copy_double (double); +CAMLextern value copy_int32 (int32); /* defined in [ints.c] */ +CAMLextern value copy_int64 (int64); /* defined in [ints.c] */ +CAMLextern value copy_nativeint (long); /* defined in [ints.c] */ +CAMLextern value alloc_array (value (*funct) (char const *), + char const ** array); typedef void (*final_fun)(value); -value alloc_final (mlsize_t /*size in words*/, - final_fun, /*finalization function*/ - mlsize_t, /*resources consumed*/ - mlsize_t /*max resources*/); +CAMLextern value alloc_final (mlsize_t /*size in words*/, + final_fun, /*finalization function*/ + mlsize_t, /*resources consumed*/ + mlsize_t /*max resources*/); -int convert_flag_list (value, int *); +CAMLextern int convert_flag_list (value, int *); #endif /* _alloc_ */ diff --git a/byterun/array.c b/byterun/array.c index cec8b91725..5c87c7ddb6 100644 --- a/byterun/array.c +++ b/byterun/array.c @@ -22,14 +22,14 @@ #ifndef NATIVE_CODE -value array_get_addr(value array, value index) /* ML */ +CAMLprim value array_get_addr(value array, value index) { long idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array)) invalid_argument("Array.get"); return Field(array, idx); } -value array_get_float(value array, value index) /* ML */ +CAMLprim value array_get_float(value array, value index) { long idx = Long_val(index); double d; @@ -47,7 +47,7 @@ value array_get_float(value array, value index) /* ML */ return res; } -value array_get(value array, value index) /* ML */ +CAMLprim value array_get(value array, value index) { if (Tag_val(array) == Double_array_tag) return array_get_float(array, index); @@ -55,7 +55,7 @@ value array_get(value array, value index) /* ML */ return array_get_addr(array, index); } -value array_set_addr(value array, value index, value newval) /* ML */ +CAMLprim value array_set_addr(value array, value index, value newval) { long idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array)) invalid_argument("Array.set"); @@ -63,7 +63,7 @@ value array_set_addr(value array, value index, value newval) /* ML */ return Val_unit; } -value array_set_float(value array, value index, value newval) /* ML */ +CAMLprim value array_set_float(value array, value index, value newval) { long idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array) / Double_wosize) @@ -72,7 +72,7 @@ value array_set_float(value array, value index, value newval) /* ML */ return Val_unit; } -value array_set(value array, value index, value newval) /* ML */ +CAMLprim value array_set(value array, value index, value newval) { if (Tag_val(array) == Double_array_tag) return array_set_float(array, index, newval); @@ -80,7 +80,7 @@ value array_set(value array, value index, value newval) /* ML */ return array_set_addr(array, index, newval); } -value array_unsafe_get_float(value array, value index) /* ML */ +CAMLprim value array_unsafe_get_float(value array, value index) { double d; value res; @@ -95,7 +95,7 @@ value array_unsafe_get_float(value array, value index) /* ML */ return res; } -value array_unsafe_get(value array, value index) /* ML */ +CAMLprim value array_unsafe_get(value array, value index) { if (Tag_val(array) == Double_array_tag) return array_unsafe_get_float(array, index); @@ -103,20 +103,20 @@ value array_unsafe_get(value array, value index) /* ML */ return Field(array, Long_val(index)); } -value array_unsafe_set_addr(value array, value index, value newval) /* ML */ +CAMLprim value array_unsafe_set_addr(value array, value index, value newval) { long idx = Long_val(index); Modify(&Field(array, idx), newval); return Val_unit; } -value array_unsafe_set_float(value array, value index, value newval) /* ML */ +CAMLprim value array_unsafe_set_float(value array, value index, value newval) { Store_double_field(array, Long_val(index), Double_val(newval)); return Val_unit; } -value array_unsafe_set(value array, value index, value newval) /* ML */ +CAMLprim value array_unsafe_set(value array, value index, value newval) { if (Tag_val(array) == Double_array_tag) return array_unsafe_set_float(array, index, newval); @@ -126,7 +126,7 @@ value array_unsafe_set(value array, value index, value newval) /* ML */ #endif -value make_vect(value len, value init) /* ML */ +CAMLprim value make_vect(value len, value init) { CAMLparam2 (len, init); CAMLlocal1 (res); @@ -168,7 +168,7 @@ value make_vect(value len, value init) /* ML */ CAMLreturn (res); } -value make_array(value init) /* ML */ +CAMLprim value make_array(value init) { CAMLparam1 (init); mlsize_t wsize, size, i; diff --git a/byterun/backtrace.c b/byterun/backtrace.c index 273aa79d05..5219a8e700 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -33,9 +33,9 @@ #include "sys.h" #include "backtrace.h" -int backtrace_active = 0; -int backtrace_pos = 0; -code_t * backtrace_buffer = NULL; +CAMLexport int backtrace_active = 0; +CAMLexport int backtrace_pos = 0; +CAMLexport code_t * backtrace_buffer = NULL; #define BACKTRACE_BUFFER_SIZE 1024 /* Location of fields in the Instruct.debug_event record */ @@ -162,7 +162,7 @@ static void print_location(value events, code_t pc) /* Print a backtrace */ -void print_exception_backtrace(void) +CAMLexport void print_exception_backtrace(void) { value events; int i, nrepeat; diff --git a/byterun/backtrace.h b/byterun/backtrace.h index 05c95d48c3..2ae64ef412 100644 --- a/byterun/backtrace.h +++ b/byterun/backtrace.h @@ -3,11 +3,11 @@ #include "mlvalues.h" -extern int backtrace_active; -extern int backtrace_pos; -extern code_t * backtrace_buffer; +CAMLextern int backtrace_active; +CAMLextern int backtrace_pos; +CAMLextern code_t * backtrace_buffer; extern void stash_backtrace(code_t pc, value * sp); -extern void print_exception_backtrace(void); +CAMLextern void print_exception_backtrace(void); #endif diff --git a/byterun/callback.c b/byterun/callback.c index d6d4d3548c..e2e8811698 100644 --- a/byterun/callback.c +++ b/byterun/callback.c @@ -51,7 +51,7 @@ static void thread_callback(void) #endif -value callbackN_exn(value closure, int narg, value args[]) +CAMLexport value callbackN_exn(value closure, int narg, value args[]) { int i; @@ -68,14 +68,14 @@ value callbackN_exn(value closure, int narg, value args[]) return interprete(callback_code, sizeof(callback_code)); } -value callback_exn(value closure, value arg1) +CAMLexport value callback_exn(value closure, value arg1) { value arg[1]; arg[0] = arg1; return callbackN_exn(closure, 1, arg); } -value callback2_exn(value closure, value arg1, value arg2) +CAMLexport value callback2_exn(value closure, value arg1, value arg2) { value arg[2]; arg[0] = arg1; @@ -83,7 +83,8 @@ value callback2_exn(value closure, value arg1, value arg2) return callbackN_exn(closure, 2, arg); } -value callback3_exn(value closure, value arg1, value arg2, value arg3) +CAMLexport value callback3_exn(value closure, + value arg1, value arg2, value arg3) { value arg[3]; arg[0] = arg1; @@ -96,7 +97,7 @@ value callback3_exn(value closure, value arg1, value arg2, value arg3) /* Native-code callbacks. callback[123]_exn are implemented in asm. */ -value callbackN_exn(value closure, int narg, value args[]) +CAMLexport value callbackN_exn(value closure, int narg, value args[]) { CAMLparam1 (closure); CAMLxparamN (args, narg); @@ -131,28 +132,28 @@ value callbackN_exn(value closure, int narg, value args[]) /* Exception-propagating variants of the above */ -value callback (value closure, value arg) +CAMLexport value callback (value closure, value arg) { value res = callback_exn(closure, arg); if (Is_exception_result(res)) mlraise(Extract_exception(res)); return res; } -value callback2 (value closure, value arg1, value arg2) +CAMLexport value callback2 (value closure, value arg1, value arg2) { value res = callback2_exn(closure, arg1, arg2); if (Is_exception_result(res)) mlraise(Extract_exception(res)); return res; } -value callback3 (value closure, value arg1, value arg2, value arg3) +CAMLexport value callback3 (value closure, value arg1, value arg2, value arg3) { value res = callback3_exn(closure, arg1, arg2, arg3); if (Is_exception_result(res)) mlraise(Extract_exception(res)); return res; } -value callbackN (value closure, int narg, value args[]) +CAMLexport value callbackN (value closure, int narg, value args[]) { value res = callbackN_exn(closure, narg, args); if (Is_exception_result(res)) mlraise(Extract_exception(res)); @@ -178,7 +179,7 @@ static unsigned int hash_value_name(char *name) return h % Named_value_size; } -value register_named_value(value vname, value val) /* ML */ +CAMLprim value register_named_value(value vname, value val) { struct named_value * nv; char * name = String_val(vname); @@ -194,7 +195,7 @@ value register_named_value(value vname, value val) /* ML */ return Val_unit; } -value * caml_named_value(char *name) +CAMLexport value * caml_named_value(char *name) { struct named_value * nv; for (nv = named_value_table[hash_value_name(name)]; diff --git a/byterun/callback.h b/byterun/callback.h index 9cca6070fe..20404bbdc5 100644 --- a/byterun/callback.h +++ b/byterun/callback.h @@ -19,26 +19,28 @@ #include "mlvalues.h" -value callback (value closure, value arg); -value callback2 (value closure, value arg1, value arg2); -value callback3 (value closure, value arg1, value arg2, value arg3); -value callbackN (value closure, int narg, value args[]); +CAMLextern value callback (value closure, value arg); +CAMLextern value callback2 (value closure, value arg1, value arg2); +CAMLextern value callback3 (value closure, value arg1, value arg2, value arg3); +CAMLextern value callbackN (value closure, int narg, value args[]); -value callback_exn (value closure, value arg); -value callback2_exn (value closure, value arg1, value arg2); -value callback3_exn (value closure, value arg1, value arg2, value arg3); -value callbackN_exn (value closure, int narg, value args[]); +CAMLextern value callback_exn (value closure, value arg); +CAMLextern value callback2_exn (value closure, value arg1, value arg2); +CAMLextern value callback3_exn (value closure, + value arg1, value arg2, value arg3); +CAMLextern value callbackN_exn (value closure, int narg, value args[]); #define Make_exception_result(v) ((v) | 2) #define Is_exception_result(v) (((v) & 3) == 2) #define Extract_exception(v) ((v) & ~3) -char * format_caml_exception(value exn); -value * caml_named_value (char * name); +CAMLextern char * format_caml_exception(value exn); /* in [printexc.c] */ -void caml_main (char ** argv); -void caml_startup (char ** argv); +CAMLextern value * caml_named_value (char * name); -extern int callback_depth; +CAMLextern void caml_main (char ** argv); +CAMLextern void caml_startup (char ** argv); + +CAMLextern int callback_depth; #endif diff --git a/byterun/compact.h b/byterun/compact.h index 047382dfc8..aa02cfbec3 100644 --- a/byterun/compact.h +++ b/byterun/compact.h @@ -19,8 +19,8 @@ #include "config.h" #include "misc.h" -void compact_heap (void); -void compact_heap_maybe (void); +extern void compact_heap (void); +extern void compact_heap_maybe (void); #endif /* _compact_ */ diff --git a/byterun/compare.c b/byterun/compare.c index 2d0ec368ec..565b5ec379 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -182,7 +182,7 @@ static long compare_val(value v1, value v2) } } -value compare(value v1, value v2) /* ML */ +CAMLprim value compare(value v1, value v2) { long res = compare_val(v1, v2); /* Free stack if needed */ @@ -195,42 +195,42 @@ value compare(value v1, value v2) /* ML */ return Val_int(0); } -value equal(value v1, value v2) /* ML */ +CAMLprim value equal(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res == 0); } -value notequal(value v1, value v2) /* ML */ +CAMLprim value notequal(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res != 0); } -value lessthan(value v1, value v2) /* ML */ +CAMLprim value lessthan(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res < 0); } -value lessequal(value v1, value v2) /* ML */ +CAMLprim value lessequal(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res <= 0); } -value greaterthan(value v1, value v2) /* ML */ +CAMLprim value greaterthan(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res > 0); } -value greaterequal(value v1, value v2) /* ML */ +CAMLprim value greaterequal(value v1, value v2) { long res = compare_val(v1, v2); if (compare_stack != compare_stack_init) compare_free_stack(); diff --git a/byterun/custom.c b/byterun/custom.c index 23f0fd6db4..abef0e740d 100644 --- a/byterun/custom.c +++ b/byterun/custom.c @@ -20,10 +20,10 @@ #include "memory.h" #include "mlvalues.h" -value alloc_custom(struct custom_operations * ops, - unsigned long size, - mlsize_t mem, - mlsize_t max) +CAMLextern value alloc_custom(struct custom_operations * ops, + unsigned long size, + mlsize_t mem, + mlsize_t max) { mlsize_t wosize; value result; @@ -41,14 +41,14 @@ value alloc_custom(struct custom_operations * ops, return result; } -int custom_compare_default(value v1, value v2) +CAMLextern int custom_compare_default(value v1, value v2) { failwith("equal: abstract value"); return 0; } -void custom_serialize_default(value v, unsigned long * wsize_32, - unsigned long * wsize_64) +CAMLextern void custom_serialize_default(value v, unsigned long * wsize_32, + unsigned long * wsize_64) { failwith("output_value: abstract value"); } @@ -60,7 +60,7 @@ struct custom_operations_list { static struct custom_operations_list * custom_ops_table = NULL; -void register_custom_operations(struct custom_operations * ops) +CAMLextern void register_custom_operations(struct custom_operations * ops) { struct custom_operations_list * l = stat_alloc(sizeof(struct custom_operations_list)); diff --git a/byterun/custom.h b/byterun/custom.h index 09755485f8..3e8abdd0ec 100644 --- a/byterun/custom.h +++ b/byterun/custom.h @@ -30,23 +30,23 @@ struct custom_operations { }; #define custom_finalize_default NULL -extern int custom_compare_default(value v1, value v2); +CAMLextern int custom_compare_default(value v1, value v2); #define custom_hash_default NULL -extern void custom_serialize_default(value v, unsigned long * wsize_32, - unsigned long * wsize_64); +CAMLextern void custom_serialize_default(value v, unsigned long * wsize_32, + unsigned long * wsize_64); #define custom_deserialize_default NULL #define Custom_ops_val(v) (*((struct custom_operations **) (v))) -value alloc_custom(struct custom_operations * ops, - unsigned long size, /*size in bytes*/ - mlsize_t mem, /*resources consumed*/ - mlsize_t max /*max resources*/); +CAMLextern value alloc_custom(struct custom_operations * ops, + unsigned long size, /*size in bytes*/ + mlsize_t mem, /*resources consumed*/ + mlsize_t max /*max resources*/); -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)); +CAMLextern void register_custom_operations(struct custom_operations * ops); +extern struct custom_operations * find_custom_operations(char * ident); +extern struct custom_operations * final_custom_operations(void (*fn)(value)); -void init_custom_operations(void); +extern void init_custom_operations(void); #endif diff --git a/byterun/dynlink.c b/byterun/dynlink.c new file mode 100644 index 0000000000..cb4d0afb14 --- /dev/null +++ b/byterun/dynlink.c @@ -0,0 +1,212 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Dynamic loading of C primitives. */ + +#include <stddef.h> +#include <stdlib.h> +#include <string.h> +#include <fcntl.h> +#include <sys/stat.h> +#include "config.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include "alloc.h" +#include "dynlink.h" +#include "fail.h" +#include "mlvalues.h" +#include "memory.h" +#include "misc.h" +#include "osdeps.h" +#include "prims.h" + +/* The table of primitives */ +struct ext_table prim_table; + +/* The table of shared libraries currently opened */ +static struct ext_table shared_libs; + +/* The search path for shared libraries */ +struct ext_table shared_libs_path; + +/* Look up the given primitive name in the built-in primitive table, + then in the opened shared libraries (shared_libs) */ +static c_primitive lookup_primitive(char * name) +{ + int i; + void * res; + + for (i = 0; names_of_builtin_cprim[i] != NULL; i++) { + if (strcmp(name, names_of_builtin_cprim[i]) == 0) + return builtin_cprim[i]; + } + for (i = 0; i < shared_libs.size; i++) { + res = caml_dlsym(shared_libs.contents[i], name); + if (res != NULL) return (c_primitive) res; + } + return NULL; +} + +/* Parse the OCAML_STDLIB_DIR/ld.conf file and add the directories + listed there to the search path */ + +#define LD_CONF_NAME "ld.conf" + +static char * parse_ld_conf(void) +{ + char * stdlib, * ldconfname, * config, * p, * q; + struct stat st; + int ldconf, nread; + + stdlib = getenv("CAMLLIB"); + if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR; + ldconfname = stat_alloc(strlen(stdlib) + 2 + sizeof(LD_CONF_NAME)); + strcpy(ldconfname, stdlib); + strcat(ldconfname, "/" LD_CONF_NAME); + if (stat(ldconfname, &st) == -1) { + stat_free(ldconfname); + return NULL; + } + ldconf = open(ldconfname, O_RDONLY, 0); + if (ldconf == -1) + fatal_error_arg("Fatal error: cannot read loader config file %s\n", + ldconfname); + config = stat_alloc(st.st_size + 1); + nread = read(ldconf, config, st.st_size); + if (nread == -1) + fatal_error_arg("Fatal error: error while reading loader config file %s\n", + ldconfname); + config[nread] = 0; + q = config; + for (p = config; *p != 0; p++) { + if (*p == '\n') { + *p = 0; + ext_table_add(&shared_libs_path, q); + q = p + 1; + } + } + close(ldconf); + stat_free(ldconfname); + return config; +} + +/* Open the given shared library and add it to shared_libs. + Abort on error. */ +static void open_shared_lib(char * name) +{ + char * realname; + void * handle; + + realname = search_dll_in_path(&shared_libs_path, name); + gc_message(0x100, "Loading shared library %s\n", (unsigned long) realname); + handle = caml_dlopen(realname); + if (handle == NULL) + fatal_error_arg2("Fatal error: cannot load shared library %s\n", name, + "Reason: %s\n", caml_dlerror()); + ext_table_add(&shared_libs, handle); + stat_free(realname); +} + +/* Build the table of primitives, given a search path and a list + of shared libraries (both 0-separated in a char array). + Abort the runtime system on error. */ +void build_primitive_table(char * lib_path, + char * libs, + char * req_prims) +{ + char * tofree1, * tofree2; + char * p; + + /* Initialize the search path for dynamic libraries: + - directories specified on the command line with the -I option + - directories specified in the CAML_LD_LIBRARY_PATH + - directories specified in the executable + - directories specified in the file <stdlib>/ld.conf */ + tofree1 = decompose_path(&shared_libs_path, getenv("CAML_LD_LIBRARY_PATH")); + if (lib_path != NULL) + for (p = lib_path; *p != 0; p += strlen(p) + 1) + ext_table_add(&shared_libs_path, p); + tofree2 = parse_ld_conf(); + /* Open the shared libraries */ + ext_table_init(&shared_libs, 8); + if (libs != NULL) + for (p = libs; *p != 0; p += strlen(p) + 1) + open_shared_lib(p); + /* Build the primitive table */ + ext_table_init(&prim_table, 0x180); + for (p = req_prims; *p != 0; p += strlen(p) + 1) { + c_primitive prim = lookup_primitive(p); + if (prim == NULL) + fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p); + ext_table_add(&prim_table, (void *) prim); + } + /* Clean up */ + stat_free(tofree1); + stat_free(tofree2); + ext_table_free(&shared_libs_path, 0); +} + +/** dlopen interface for the bytecode linker **/ + +#define Handle_val(v) (*((void **) (v))) + +CAMLprim value dynlink_open_lib(value filename) +{ + void * handle; + value result; + + handle = caml_dlopen(String_val(filename)); + if (handle == NULL) failwith(caml_dlerror()); + result = alloc_small(1, Abstract_tag); + Handle_val(result) = handle; + return result; +} + +CAMLprim value dynlink_close_lib(value handle) +{ + caml_dlclose(Handle_val(handle)); + return Val_unit; +} + +CAMLprim value dynlink_lookup_symbol(value handle, value symbolname) +{ + void * symb; + value result; + symb = caml_dlsym(Handle_val(handle), String_val(symbolname)); + if (symb == NULL) failwith(caml_dlerror()); + result = alloc_small(1, Abstract_tag); + Handle_val(result) = symb; + return result; +} + +CAMLprim value dynlink_add_primitive(value handle) +{ + return Val_int(ext_table_add(&prim_table, Handle_val(handle))); +} + +CAMLprim value dynlink_get_current_libs(value unit) +{ + CAMLparam0(); + CAMLlocal1(res); + int i; + + res = alloc_tuple(shared_libs.size); + for (i = 0; i < shared_libs.size; i++) { + value v = alloc_small(1, Abstract_tag); + Handle_val(v) = shared_libs.contents[i]; + Store_field(res, i, v); + } + CAMLreturn(res); +} diff --git a/byterun/dynlink.h b/byterun/dynlink.h new file mode 100644 index 0000000000..46643c5841 --- /dev/null +++ b/byterun/dynlink.h @@ -0,0 +1,33 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Dynamic loading of C primitives. */ + +#ifndef _dynlink_ +#define _dynlink_ + +#include "misc.h" + +/* Build the table of primitives, given a search path, a list + of shared libraries, and a list of primitive names + (all three 0-separated in char arrays). + Abort the runtime system on error. */ +extern void build_primitive_table(char * lib_path, + char * libs, + char * req_prims); + +/* The search path for shared libraries */ +extern struct ext_table shared_libs_path; + +#endif diff --git a/byterun/extern.c b/byterun/extern.c index eadea20404..a8097b6568 100644 --- a/byterun/extern.c +++ b/byterun/extern.c @@ -415,7 +415,7 @@ void output_val(struct channel *chan, value v, value flags) stat_free(block); } -value output_value(value vchan, value v, value flags) /* ML */ +CAMLprim value output_value(value vchan, value v, value flags) { CAMLparam3 (vchan, v, flags); struct channel * channel = Channel(vchan); @@ -426,7 +426,7 @@ value output_value(value vchan, value v, value flags) /* ML */ CAMLreturn (Val_unit); } -value output_value_to_string(value v, value flags) /* ML */ +CAMLprim value output_value_to_string(value v, value flags) { long len; value res; @@ -438,7 +438,8 @@ value output_value_to_string(value v, value flags) /* ML */ return res; } -value output_value_to_buffer(value buf, value ofs, value len, value v, value flags) /* ML */ +CAMLprim value output_value_to_buffer(value buf, value ofs, value len, + value v, value flags) { long len_res; extern_block = &Byte(buf, Long_val(ofs)); @@ -449,8 +450,8 @@ value output_value_to_buffer(value buf, value ofs, value len, value v, value fla return Val_long(len_res); } -void output_value_to_malloc(value v, value flags, - /*out*/ char ** buf, /*out*/ long * len) +CAMLexport void output_value_to_malloc(value v, value flags, + /*out*/ char ** buf, /*out*/ long * len) { long len_res; alloc_extern_block(); @@ -461,14 +462,14 @@ void output_value_to_malloc(value v, value flags, /* Functions for writing user-defined marshallers */ -void serialize_int_1(int i) +CAMLexport void serialize_int_1(int i) { if (extern_ptr + 1 > extern_limit) resize_extern_block(1); extern_ptr[0] = i; extern_ptr += 1; } -void serialize_int_2(int i) +CAMLexport void serialize_int_2(int i) { if (extern_ptr + 2 > extern_limit) resize_extern_block(2); extern_ptr[0] = i >> 8; @@ -476,7 +477,7 @@ void serialize_int_2(int i) extern_ptr += 2; } -void serialize_int_4(int32 i) +CAMLexport void serialize_int_4(int32 i) { if (extern_ptr + 4 > extern_limit) resize_extern_block(4); extern_ptr[0] = i >> 24; @@ -486,29 +487,29 @@ void serialize_int_4(int32 i) extern_ptr += 4; } -void serialize_int_8(int64 i) +CAMLexport void serialize_int_8(int64 i) { serialize_block_8(&i, 1); } -void serialize_float_4(float f) +CAMLexport void serialize_float_4(float f) { serialize_block_4(&f, 1); } -void serialize_float_8(double f) +CAMLexport void serialize_float_8(double f) { serialize_block_8(&f, 1); } -void serialize_block_1(void * data, long len) +CAMLexport void serialize_block_1(void * data, long len) { if (extern_ptr + len > extern_limit) resize_extern_block(len); memmove(extern_ptr, data, len); extern_ptr += len; } -void serialize_block_2(void * data, long len) +CAMLexport void serialize_block_2(void * data, long len) { unsigned char * p; char * q; @@ -523,7 +524,7 @@ void serialize_block_2(void * data, long len) #endif } -void serialize_block_4(void * data, long len) +CAMLexport void serialize_block_4(void * data, long len) { unsigned char * p; char * q; @@ -538,7 +539,7 @@ void serialize_block_4(void * data, long len) #endif } -void serialize_block_8(void * data, long len) +CAMLexport void serialize_block_8(void * data, long len) { unsigned char * p; char * q; diff --git a/byterun/fail.c b/byterun/fail.c index 2e68d5f9f4..3d84784e88 100644 --- a/byterun/fail.c +++ b/byterun/fail.c @@ -28,7 +28,7 @@ struct longjmp_buffer * external_raise = NULL; value exn_bucket; -void mlraise(value v) +CAMLexport void mlraise(value v) { #ifdef DEBUG extern int volatile async_signal_mode; /* from signals.c */ @@ -40,7 +40,7 @@ void mlraise(value v) siglongjmp(external_raise->buf, 1); } -void raise_constant(value tag) +CAMLexport void raise_constant(value tag) { CAMLparam1 (tag); CAMLlocal1 (bucket); @@ -50,7 +50,7 @@ void raise_constant(value tag) mlraise(bucket); } -void raise_with_arg(value tag, value arg) +CAMLexport void raise_with_arg(value tag, value arg) { CAMLparam2 (tag, arg); CAMLlocal1 (bucket); @@ -61,7 +61,7 @@ void raise_with_arg(value tag, value arg) mlraise(bucket); } -void raise_with_string(value tag, char *msg) +CAMLexport void raise_with_string(value tag, char *msg) { CAMLparam1 (tag); CAMLlocal1 (vmsg); @@ -70,12 +70,12 @@ void raise_with_string(value tag, char *msg) raise_with_arg(tag, vmsg); } -void failwith (char *msg) +CAMLexport void failwith (char *msg) { raise_with_string(Field(global_data, FAILURE_EXN), msg); } -void invalid_argument (char *msg) +CAMLexport void invalid_argument (char *msg) { raise_with_string(Field(global_data, INVALID_EXN), msg); } @@ -89,39 +89,39 @@ static struct { value exn; } out_of_memory_bucket = { 0, 0 }; -void raise_out_of_memory(void) +CAMLexport void raise_out_of_memory(void) { if (out_of_memory_bucket.exn == 0) fatal_error("Fatal error: out of memory while raising Out_of_memory\n"); mlraise((value) &(out_of_memory_bucket.exn)); } -void raise_stack_overflow(void) +CAMLexport void raise_stack_overflow(void) { raise_constant(Field(global_data, STACK_OVERFLOW_EXN)); } -void raise_sys_error(value msg) +CAMLexport void raise_sys_error(value msg) { raise_with_arg(Field(global_data, SYS_ERROR_EXN), msg); } -void raise_end_of_file(void) +CAMLexport void raise_end_of_file(void) { raise_constant(Field(global_data, END_OF_FILE_EXN)); } -void raise_zero_divide(void) +CAMLexport void raise_zero_divide(void) { raise_constant(Field(global_data, ZERO_DIVIDE_EXN)); } -void raise_not_found(void) +CAMLexport void raise_not_found(void) { raise_constant(Field(global_data, NOT_FOUND_EXN)); } -void raise_sys_blocked_io(void) +CAMLexport void raise_sys_blocked_io(void) { raise_constant(Field(global_data, SYS_BLOCKED_IO)); } diff --git a/byterun/fail.h b/byterun/fail.h index f9977ecef6..3c1d25f38f 100644 --- a/byterun/fail.h +++ b/byterun/fail.h @@ -44,25 +44,25 @@ struct longjmp_buffer { #define siglongjmp(buf,val) longjmp(buf,val) #endif -extern struct longjmp_buffer * external_raise; +CAMLextern struct longjmp_buffer * external_raise; extern value exn_bucket; -void mlraise (value bucket) Noreturn; -void raise_constant (value tag) Noreturn; -void raise_with_arg (value tag, value arg) Noreturn; -void raise_with_string (value tag, char * msg) Noreturn; -void failwith (char *) Noreturn; -void invalid_argument (char *) Noreturn; -void raise_out_of_memory (void) Noreturn; -void raise_stack_overflow (void) Noreturn; -void raise_sys_error (value) Noreturn; -void raise_end_of_file (void) Noreturn; -void raise_zero_divide (void) Noreturn; -void raise_not_found (void) Noreturn; -void init_exceptions (void); -void array_bound_error (void) Noreturn; -void raise_sys_blocked_io (void) Noreturn; +CAMLextern void mlraise (value bucket) Noreturn; +CAMLextern void raise_constant (value tag) Noreturn; +CAMLextern void raise_with_arg (value tag, value arg) Noreturn; +CAMLextern void raise_with_string (value tag, char * msg) Noreturn; +CAMLextern void failwith (char *) Noreturn; +CAMLextern void invalid_argument (char *) Noreturn; +CAMLextern void raise_out_of_memory (void) Noreturn; +CAMLextern void raise_stack_overflow (void) Noreturn; +CAMLextern void raise_sys_error (value) Noreturn; +CAMLextern void raise_end_of_file (void) Noreturn; +CAMLextern void raise_zero_divide (void) Noreturn; +CAMLextern void raise_not_found (void) Noreturn; +CAMLextern void init_exceptions (void); +CAMLextern void array_bound_error (void) Noreturn; +CAMLextern void raise_sys_blocked_io (void) Noreturn; -extern void (*caml_reset_sigmask)(void); +CAMLextern void (*caml_reset_sigmask)(void); #endif /* _fail_ */ diff --git a/byterun/finalise.c b/byterun/finalise.c index 2ff11ad443..bea2dfc854 100644 --- a/byterun/finalise.c +++ b/byterun/finalise.c @@ -134,7 +134,7 @@ void final_empty_young (void) } /* Put (f,v) in the recent set. */ -value final_register (value f, value v) /* ML */ +CAMLprim value final_register (value f, value v) { if (!(Is_block (v) && (Is_in_heap (v) || Is_young (v)))){ invalid_argument ("Gc.finalise"); diff --git a/byterun/floats.c b/byterun/floats.c index 96bada43d6..d1a09b426b 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -25,7 +25,7 @@ #ifdef ARCH_ALIGN_DOUBLE -double Double_val(value val) +CAMLexport double Double_val(value val) { union { value v[2]; double d; } buffer; @@ -35,7 +35,7 @@ double Double_val(value val) return buffer.d; } -void Store_double_val(value val, double dbl) +CAMLexport void Store_double_val(value val, double dbl) { union { value v[2]; double d; } buffer; @@ -47,7 +47,7 @@ void Store_double_val(value val, double dbl) #endif -value copy_double(double d) +CAMLexport value copy_double(double d) { value res; @@ -60,7 +60,7 @@ value copy_double(double d) return res; } -value format_float(value fmt, value arg) /* ML */ +CAMLprim value format_float(value fmt, value arg) { #define MAX_DIGITS 350 /* Max number of decimal digits in a "natural" (not artificially padded) @@ -101,67 +101,67 @@ value format_float(value fmt, value arg) /* ML */ return res; } -value float_of_string(value s) /* ML */ +CAMLprim value float_of_string(value s) { return copy_double(atof(String_val(s))); } -value int_of_float(value f) /* ML */ +CAMLprim value int_of_float(value f) { return Val_long((long) Double_val(f)); } -value float_of_int(value n) /* ML */ +CAMLprim value float_of_int(value n) { return copy_double((double) Long_val(n)); } -value neg_float(value f) /* ML */ +CAMLprim value neg_float(value f) { return copy_double(- Double_val(f)); } -value abs_float(value f) /* ML */ +CAMLprim value abs_float(value f) { return copy_double(fabs(Double_val(f))); } -value add_float(value f, value g) /* ML */ +CAMLprim value add_float(value f, value g) { return copy_double(Double_val(f) + Double_val(g)); } -value sub_float(value f, value g) /* ML */ +CAMLprim value sub_float(value f, value g) { return copy_double(Double_val(f) - Double_val(g)); } -value mul_float(value f, value g) /* ML */ +CAMLprim value mul_float(value f, value g) { return copy_double(Double_val(f) * Double_val(g)); } -value div_float(value f, value g) /* ML */ +CAMLprim value div_float(value f, value g) { return copy_double(Double_val(f) / Double_val(g)); } -value exp_float(value f) /* ML */ +CAMLprim value exp_float(value f) { return copy_double(exp(Double_val(f))); } -value floor_float(value f) /* ML */ +CAMLprim value floor_float(value f) { return copy_double(floor(Double_val(f))); } -value fmod_float(value f1, value f2) /* ML */ +CAMLprim value fmod_float(value f1, value f2) { return copy_double(fmod(Double_val(f1), Double_val(f2))); } -value frexp_float(value f) /* ML */ +CAMLprim value frexp_float(value f) { CAMLparam1 (f); CAMLlocal2 (res, mantissa); @@ -174,22 +174,22 @@ value frexp_float(value f) /* ML */ CAMLreturn (res); } -value ldexp_float(value f, value i) /* ML */ +CAMLprim value ldexp_float(value f, value i) { return copy_double(ldexp(Double_val(f), Int_val(i))); } -value log_float(value f) /* ML */ +CAMLprim value log_float(value f) { return copy_double(log(Double_val(f))); } -value log10_float(value f) /* ML */ +CAMLprim value log10_float(value f) { return copy_double(log10(Double_val(f))); } -value modf_float(value f) /* ML */ +CAMLprim value modf_float(value f) { #if __SC__ _float_eval frem; /* Problem with Apple's <math.h> */ @@ -207,102 +207,102 @@ value modf_float(value f) /* ML */ CAMLreturn (res); } -value sqrt_float(value f) /* ML */ +CAMLprim value sqrt_float(value f) { return copy_double(sqrt(Double_val(f))); } -value power_float(value f, value g) /* ML */ +CAMLprim value power_float(value f, value g) { return copy_double(pow(Double_val(f), Double_val(g))); } -value sin_float(value f) /* ML */ +CAMLprim value sin_float(value f) { return copy_double(sin(Double_val(f))); } -value sinh_float(value f) /* ML */ +CAMLprim value sinh_float(value f) { return copy_double(sinh(Double_val(f))); } -value cos_float(value f) /* ML */ +CAMLprim value cos_float(value f) { return copy_double(cos(Double_val(f))); } -value cosh_float(value f) /* ML */ +CAMLprim value cosh_float(value f) { return copy_double(cosh(Double_val(f))); } -value tan_float(value f) /* ML */ +CAMLprim value tan_float(value f) { return copy_double(tan(Double_val(f))); } -value tanh_float(value f) /* ML */ +CAMLprim value tanh_float(value f) { return copy_double(tanh(Double_val(f))); } -value asin_float(value f) /* ML */ +CAMLprim value asin_float(value f) { return copy_double(asin(Double_val(f))); } -value acos_float(value f) /* ML */ +CAMLprim value acos_float(value f) { return copy_double(acos(Double_val(f))); } -value atan_float(value f) /* ML */ +CAMLprim value atan_float(value f) { return copy_double(atan(Double_val(f))); } -value atan2_float(value f, value g) /* ML */ +CAMLprim value atan2_float(value f, value g) { return copy_double(atan2(Double_val(f), Double_val(g))); } -value ceil_float(value f) /* ML */ +CAMLprim value ceil_float(value f) { return copy_double(ceil(Double_val(f))); } -value eq_float(value f, value g) /* ML */ +CAMLprim value eq_float(value f, value g) { return Val_bool(Double_val(f) == Double_val(g)); } -value neq_float(value f, value g) /* ML */ +CAMLprim value neq_float(value f, value g) { return Val_bool(Double_val(f) != Double_val(g)); } -value le_float(value f, value g) /* ML */ +CAMLprim value le_float(value f, value g) { return Val_bool(Double_val(f) <= Double_val(g)); } -value lt_float(value f, value g) /* ML */ +CAMLprim value lt_float(value f, value g) { return Val_bool(Double_val(f) < Double_val(g)); } -value ge_float(value f, value g) /* ML */ +CAMLprim value ge_float(value f, value g) { return Val_bool(Double_val(f) >= Double_val(g)); } -value gt_float(value f, value g) /* ML */ +CAMLprim value gt_float(value f, value g) { return Val_bool(Double_val(f) > Double_val(g)); } -value float_of_bytes(value s) /* ML */ +CAMLprim value float_of_bytes(value s) { value d = copy_double(0.0); #ifdef ARCH_BIG_ENDIAN @@ -315,7 +315,7 @@ value float_of_bytes(value s) /* ML */ enum { FP_normal, FP_subnormal, FP_zero, FP_infinite, FP_nan }; -value classify_float(value vd) /* ML */ +CAMLprim value classify_float(value vd) { #ifdef fpclassify switch (fpclassify(Double_val(vd))) { diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index b269a18f22..8b564ac227 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -242,13 +242,13 @@ void heap_check (void) } #endif -value gc_stat(value v) /* ML */ +CAMLprim value gc_stat(value v) { Assert (v == Val_unit); return heap_stats (1); } -value gc_counters(value v) /* ML */ +CAMLprim value gc_counters(value v) { CAMLparam0 (); /* v is ignored */ CAMLlocal1 (res); @@ -266,7 +266,7 @@ value gc_counters(value v) /* ML */ CAMLreturn (res); } -value gc_get(value v) /* ML */ +CAMLprim value gc_get(value v) { CAMLparam0 (); /* v is ignored */ CAMLlocal1 (res); @@ -313,7 +313,7 @@ static long norm_minsize (long int s) return s; } -value gc_set(value v) /* ML */ +CAMLprim value gc_set(value v) { unsigned long newpf, newpm; asize_t newheapincr; @@ -354,13 +354,13 @@ value gc_set(value v) /* ML */ return Val_unit; } -value gc_minor(value v) /* ML */ +CAMLprim value gc_minor(value v) { Assert (v == Val_unit); minor_collection (); return Val_unit; } -value gc_major(value v) /* ML */ +CAMLprim value gc_major(value v) { Assert (v == Val_unit); empty_minor_heap (); finish_major_cycle (); @@ -368,7 +368,7 @@ value gc_major(value v) /* ML */ return Val_unit; } -value gc_full_major(value v) /* ML */ +CAMLprim value gc_full_major(value v) { Assert (v == Val_unit); empty_minor_heap (); finish_major_cycle (); @@ -379,7 +379,7 @@ value gc_full_major(value v) /* ML */ return Val_unit; } -value gc_compaction(value v) /* ML */ +CAMLprim value gc_compaction(value v) { Assert (v == Val_unit); empty_minor_heap (); finish_major_cycle (); diff --git a/byterun/hash.c b/byterun/hash.c index 3bccd34d74..08f8eee150 100644 --- a/byterun/hash.c +++ b/byterun/hash.c @@ -23,7 +23,7 @@ static long hash_univ_limit, hash_univ_count; static void hash_aux(value obj); -value hash_univ_param(value count, value limit, value obj) /* ML */ +CAMLprim value hash_univ_param(value count, value limit, value obj) { hash_univ_limit = Long_val(limit); hash_univ_count = Long_val(count); @@ -134,7 +134,7 @@ static void hash_aux(value obj) /* Hashing variant tags */ -value hash_variant(char * tag) +CAMLexport value hash_variant(char * tag) { value accu; /* Same hashing algorithm as in ../typing/btype.ml, function hash_variant */ diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c index 160225fb53..97409aafbf 100644 --- a/byterun/instrtrace.c +++ b/byterun/instrtrace.c @@ -23,7 +23,7 @@ #include "opnames.h" extern code_t start_code; -extern char * names_of_cprim[]; +extern char * names_of_builtin_cprim[]; long icount = 0; @@ -59,9 +59,9 @@ void disasm_instr(pc) printf(" %d, %d\n", pc[0], pc[1]); break; /* Instructions with a C primitive as operand */ case C_CALL1: case C_CALL2: case C_CALL3: case C_CALL4: case C_CALL5: - printf(" %s\n", names_of_cprim[pc[0]]); break; + printf(" %s\n", names_of_builtin_cprim[pc[0]]); break; /* REVISE */ case C_CALLN: - printf(" %d, %s\n", pc[0], names_of_cprim[pc[1]]); break; + printf(" %d, %s\n", pc[0], names_of_builtin_cprim[pc[1]]); break; default: printf("\n"); } diff --git a/byterun/intern.c b/byterun/intern.c index edf856f94c..ce9ab2d1ae 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -371,7 +371,7 @@ value input_val(struct channel *chan) return res; } -value input_value(value vchan) /* ML */ +CAMLprim value input_value(value vchan) { CAMLparam1 (vchan); struct channel * chan = Channel(vchan); @@ -383,7 +383,7 @@ value input_value(value vchan) /* ML */ CAMLreturn (res); } -value input_val_from_string(value str, long int ofs) +CAMLexport value input_val_from_string(value str, long int ofs) { CAMLparam1 (str); mlsize_t num_objects, size_32, size_64, whsize; @@ -410,12 +410,12 @@ value input_val_from_string(value str, long int ofs) CAMLreturn (obj); } -value input_value_from_string(value str, value ofs) /* ML */ +CAMLprim value input_value_from_string(value str, value ofs) { return input_val_from_string(str, Long_val(ofs)); } -value input_value_from_malloc(char * data, long ofs) +CAMLexport value input_value_from_malloc(char * data, long ofs) { mlsize_t num_objects, size_32, size_64, whsize; value obj; @@ -442,7 +442,7 @@ value input_value_from_malloc(char * data, long ofs) return obj; } -value marshal_data_size(value buff, value ofs) /* ML */ +CAMLprim value marshal_data_size(value buff, value ofs) { uint32 magic; mlsize_t block_len; @@ -491,71 +491,71 @@ unsigned char * code_checksum(void) /* Functions for writing user-defined marshallers */ -int deserialize_uint_1(void) +CAMLexport int deserialize_uint_1(void) { return read8u(); } -int deserialize_sint_1(void) +CAMLexport int deserialize_sint_1(void) { return read8s(); } -int deserialize_uint_2(void) +CAMLexport int deserialize_uint_2(void) { return read16u(); } -int deserialize_sint_2(void) +CAMLexport int deserialize_sint_2(void) { return read16s(); } -uint32 deserialize_uint_4(void) +CAMLexport uint32 deserialize_uint_4(void) { return read32u(); } -int32 deserialize_sint_4(void) +CAMLexport int32 deserialize_sint_4(void) { return read32s(); } -uint64 deserialize_uint_8(void) +CAMLexport uint64 deserialize_uint_8(void) { uint64 i; deserialize_block_8(&i, 1); return i; } -int64 deserialize_sint_8(void) +CAMLexport int64 deserialize_sint_8(void) { int64 i; deserialize_block_8(&i, 1); return i; } -float deserialize_float_4(void) +CAMLexport float deserialize_float_4(void) { float f; deserialize_block_4(&f, 1); return f; } -double deserialize_float_8(void) +CAMLexport double deserialize_float_8(void) { double f; deserialize_block_8(&f, 1); return f; } -void deserialize_block_1(void * data, long len) +CAMLexport void deserialize_block_1(void * data, long len) { memmove(data, intern_src, len); intern_src += len; } -void deserialize_block_2(void * data, long len) +CAMLexport void deserialize_block_2(void * data, long len) { unsigned char * p, * q; #ifndef ARCH_BIG_ENDIAN @@ -568,7 +568,7 @@ void deserialize_block_2(void * data, long len) #endif } -void deserialize_block_4(void * data, long len) +CAMLexport void deserialize_block_4(void * data, long len) { unsigned char * p, * q; #ifndef ARCH_BIG_ENDIAN @@ -581,7 +581,7 @@ void deserialize_block_4(void * data, long len) #endif } -void deserialize_block_8(void * data, long len) +CAMLexport void deserialize_block_8(void * data, long len) { unsigned char * p, * q; #ifndef ARCH_BIG_ENDIAN @@ -594,7 +594,7 @@ void deserialize_block_8(void * data, long len) #endif } -void deserialize_error(char * msg) +CAMLexport void deserialize_error(char * msg) { intern_cleanup(); failwith(msg); diff --git a/byterun/interp.c b/byterun/interp.c index fcb3e2c470..a393f98e36 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -827,34 +827,34 @@ value interprete(code_t prog, asize_t prog_size) Instruct(C_CALL1): Setup_for_c_call; - accu = cprim[*pc](accu); + accu = Primitive(*pc)(accu); Restore_after_c_call; pc++; Next; Instruct(C_CALL2): Setup_for_c_call; - accu = cprim[*pc](accu, sp[1]); + accu = Primitive(*pc)(accu, sp[1]); Restore_after_c_call; sp += 1; pc++; Next; Instruct(C_CALL3): Setup_for_c_call; - accu = cprim[*pc](accu, sp[1], sp[2]); + accu = Primitive(*pc)(accu, sp[1], sp[2]); Restore_after_c_call; sp += 2; pc++; Next; Instruct(C_CALL4): Setup_for_c_call; - accu = cprim[*pc](accu, sp[1], sp[2], sp[3]); + accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3]); Restore_after_c_call; sp += 3; pc++; Next; Instruct(C_CALL5): Setup_for_c_call; - accu = cprim[*pc](accu, sp[1], sp[2], sp[3], sp[4]); + accu = Primitive(*pc)(accu, sp[1], sp[2], sp[3], sp[4]); Restore_after_c_call; sp += 4; pc++; @@ -863,7 +863,7 @@ value interprete(code_t prog, asize_t prog_size) int nargs = *pc++; *--sp = accu; Setup_for_c_call; - accu = cprim[*pc](sp + 1, nargs); + accu = Primitive(*pc)(sp + 1, nargs); Restore_after_c_call; sp += nargs; pc++; diff --git a/byterun/intext.h b/byterun/intext.h index a4370eb318..20c19e4660 100644 --- a/byterun/intext.h +++ b/byterun/intext.h @@ -81,38 +81,42 @@ /* The entry points */ -void output_val (struct channel * chan, value v, value flags); -value input_val (struct channel * chan); -value input_val_from_string (value str, long ofs); +CAMLextern void output_val (struct channel * chan, value v, value flags); +CAMLextern void output_value_to_malloc(value v, value flags, + /*out*/ char ** buf, + /*out*/ long * len); +CAMLextern value input_val (struct channel * chan); +CAMLextern value input_val_from_string (value str, long ofs); +CAMLextern value input_value_from_malloc(char * data, long ofs); /* Functions for writing user-defined marshallers */ -extern void serialize_int_1(int i); -extern void serialize_int_2(int i); -extern void serialize_int_4(int32 i); -extern void serialize_int_8(int64 i); -extern void serialize_float_4(float f); -extern void serialize_float_8(double f); -extern void serialize_block_1(void * data, long len); -extern void serialize_block_2(void * data, long len); -extern void serialize_block_4(void * data, long len); -extern void serialize_block_8(void * data, long len); - -extern int deserialize_uint_1(void); -extern int deserialize_sint_1(void); -extern int deserialize_uint_2(void); -extern int deserialize_sint_2(void); -extern uint32 deserialize_uint_4(void); -extern int32 deserialize_sint_4(void); -extern uint64 deserialize_uint_8(void); -extern int64 deserialize_sint_8(void); -extern float deserialize_float_4(void); -extern double deserialize_float_8(void); -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); +CAMLextern void serialize_int_1(int i); +CAMLextern void serialize_int_2(int i); +CAMLextern void serialize_int_4(int32 i); +CAMLextern void serialize_int_8(int64 i); +CAMLextern void serialize_float_4(float f); +CAMLextern void serialize_float_8(double f); +CAMLextern void serialize_block_1(void * data, long len); +CAMLextern void serialize_block_2(void * data, long len); +CAMLextern void serialize_block_4(void * data, long len); +CAMLextern void serialize_block_8(void * data, long len); + +CAMLextern int deserialize_uint_1(void); +CAMLextern int deserialize_sint_1(void); +CAMLextern int deserialize_uint_2(void); +CAMLextern int deserialize_sint_2(void); +CAMLextern uint32 deserialize_uint_4(void); +CAMLextern int32 deserialize_sint_4(void); +CAMLextern uint64 deserialize_uint_8(void); +CAMLextern int64 deserialize_sint_8(void); +CAMLextern float deserialize_float_4(void); +CAMLextern double deserialize_float_8(void); +CAMLextern void deserialize_block_1(void * data, long len); +CAMLextern void deserialize_block_2(void * data, long len); +CAMLextern void deserialize_block_4(void * data, long len); +CAMLextern void deserialize_block_8(void * data, long len); +CAMLextern 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 36af2650be..bc20a8ebe0 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -75,7 +75,7 @@ static long parse_long(char * p) return sign < 0 ? -((long) res) : (long) res; } -value int_of_string(value s) /* ML */ +CAMLprim value int_of_string(value s) { return Val_long(parse_long(String_val(s))); } @@ -117,7 +117,7 @@ static char * parse_format(value fmt, return stat_alloc(prec + 1); } -value format_int(value fmt, value arg) /* ML */ +CAMLprim value format_int(value fmt, value arg) { char format_string[FORMAT_BUFFER_SIZE]; char default_format_buffer[FORMAT_BUFFER_SIZE]; @@ -158,7 +158,7 @@ static unsigned long int32_deserialize(void * dst) return 4; } -struct custom_operations int32_ops = { +CAMLexport struct custom_operations int32_ops = { "_i", custom_finalize_default, int32_compare, @@ -167,70 +167,70 @@ struct custom_operations int32_ops = { int32_deserialize }; -value copy_int32(int32 i) +CAMLexport value copy_int32(int32 i) { value res = alloc_custom(&int32_ops, 4, 0, 1); Int32_val(res) = i; return res; } -value int32_neg(value v) /* ML */ +CAMLprim value int32_neg(value v) { return copy_int32(- Int32_val(v)); } -value int32_add(value v1, value v2) /* ML */ +CAMLprim value int32_add(value v1, value v2) { return copy_int32(Int32_val(v1) + Int32_val(v2)); } -value int32_sub(value v1, value v2) /* ML */ +CAMLprim value int32_sub(value v1, value v2) { return copy_int32(Int32_val(v1) - Int32_val(v2)); } -value int32_mul(value v1, value v2) /* ML */ +CAMLprim value int32_mul(value v1, value v2) { return copy_int32(Int32_val(v1) * Int32_val(v2)); } -value int32_div(value v1, value v2) /* ML */ +CAMLprim value int32_div(value v1, value v2) { int32 divisor = Int32_val(v2); if (divisor == 0) raise_zero_divide(); return copy_int32(Int32_val(v1) / divisor); } -value int32_mod(value v1, value v2) /* ML */ +CAMLprim value int32_mod(value v1, value v2) { int32 divisor = Int32_val(v2); if (divisor == 0) raise_zero_divide(); return copy_int32(Int32_val(v1) % divisor); } -value int32_and(value v1, value v2) /* ML */ +CAMLprim value int32_and(value v1, value v2) { return copy_int32(Int32_val(v1) & Int32_val(v2)); } -value int32_or(value v1, value v2) /* ML */ +CAMLprim value int32_or(value v1, value v2) { return copy_int32(Int32_val(v1) | Int32_val(v2)); } -value int32_xor(value v1, value v2) /* ML */ +CAMLprim value int32_xor(value v1, value v2) { return copy_int32(Int32_val(v1) ^ Int32_val(v2)); } -value int32_shift_left(value v1, value v2) /* ML */ +CAMLprim value int32_shift_left(value v1, value v2) { return copy_int32(Int32_val(v1) << Int_val(v2)); } -value int32_shift_right(value v1, value v2) /* ML */ +CAMLprim value int32_shift_right(value v1, value v2) { return copy_int32(Int32_val(v1) >> Int_val(v2)); } -value int32_shift_right_unsigned(value v1, value v2) /* ML */ +CAMLprim value int32_shift_right_unsigned(value v1, value v2) { return copy_int32((uint32)Int32_val(v1) >> Int_val(v2)); } -value int32_of_int(value v) /* ML */ +CAMLprim value int32_of_int(value v) { return copy_int32(Long_val(v)); } -value int32_to_int(value v) /* ML */ +CAMLprim value int32_to_int(value v) { return Val_long(Int32_val(v)); } -value int32_of_float(value v) /* ML */ +CAMLprim value int32_of_float(value v) { return copy_int32((int32)(Double_val(v))); } -value int32_to_float(value v) /* ML */ +CAMLprim value int32_to_float(value v) { return copy_double((double)(Int32_val(v))); } -value int32_format(value fmt, value arg) /* ML */ +CAMLprim value int32_format(value fmt, value arg) { char format_string[FORMAT_BUFFER_SIZE]; char default_format_buffer[FORMAT_BUFFER_SIZE]; @@ -244,7 +244,7 @@ value int32_format(value fmt, value arg) /* ML */ return res; } -value int32_of_string(value s) /* ML */ +CAMLprim value int32_of_string(value s) { return copy_int32(parse_long(String_val(s))); } @@ -255,7 +255,7 @@ value int32_of_string(value s) /* ML */ #ifdef ARCH_ALIGN_INT64 -int64 Int64_val(value v) +CAMLexport int64 Int64_val(value v) { union { int32 i[2]; int64 j; } buffer; buffer.i[0] = ((int32 *) Data_custom_val(v))[0]; @@ -290,7 +290,7 @@ static unsigned long int64_deserialize(void * dst) return 8; } -struct custom_operations int64_ops = { +CAMLexport struct custom_operations int64_ops = { "_j", custom_finalize_default, int64_compare, @@ -299,7 +299,7 @@ struct custom_operations int64_ops = { int64_deserialize }; -value copy_int64(int64 i) +CAMLexport value copy_int64(int64 i) { value res = alloc_custom(&int64_ops, 8, 0, 1); #ifndef ARCH_ALIGN_INT64 @@ -313,75 +313,75 @@ value copy_int64(int64 i) return res; } -value int64_neg(value v) /* ML */ +CAMLprim value int64_neg(value v) { return copy_int64(- Int64_val(v)); } -value int64_add(value v1, value v2) /* ML */ +CAMLprim value int64_add(value v1, value v2) { return copy_int64(Int64_val(v1) + Int64_val(v2)); } -value int64_sub(value v1, value v2) /* ML */ +CAMLprim value int64_sub(value v1, value v2) { return copy_int64(Int64_val(v1) - Int64_val(v2)); } -value int64_mul(value v1, value v2) /* ML */ +CAMLprim value int64_mul(value v1, value v2) { return copy_int64(Int64_val(v1) * Int64_val(v2)); } -value int64_div(value v1, value v2) /* ML */ +CAMLprim value int64_div(value v1, value v2) { int64 divisor = Int64_val(v2); if (divisor == 0) raise_zero_divide(); return copy_int64(Int64_val(v1) / divisor); } -value int64_mod(value v1, value v2) /* ML */ +CAMLprim value int64_mod(value v1, value v2) { int64 divisor = Int64_val(v2); if (divisor == 0) raise_zero_divide(); return copy_int64(Int64_val(v1) % divisor); } -value int64_and(value v1, value v2) /* ML */ +CAMLprim value int64_and(value v1, value v2) { return copy_int64(Int64_val(v1) & Int64_val(v2)); } -value int64_or(value v1, value v2) /* ML */ +CAMLprim value int64_or(value v1, value v2) { return copy_int64(Int64_val(v1) | Int64_val(v2)); } -value int64_xor(value v1, value v2) /* ML */ +CAMLprim value int64_xor(value v1, value v2) { return copy_int64(Int64_val(v1) ^ Int64_val(v2)); } -value int64_shift_left(value v1, value v2) /* ML */ +CAMLprim value int64_shift_left(value v1, value v2) { return copy_int64(Int64_val(v1) << Int_val(v2)); } -value int64_shift_right(value v1, value v2) /* ML */ +CAMLprim value int64_shift_right(value v1, value v2) { return copy_int64(Int64_val(v1) >> Int_val(v2)); } -value int64_shift_right_unsigned(value v1, value v2) /* ML */ +CAMLprim value int64_shift_right_unsigned(value v1, value v2) { return copy_int64((uint64)Int64_val(v1) >> Int_val(v2)); } -value int64_of_int(value v) /* ML */ +CAMLprim value int64_of_int(value v) { return copy_int64(Long_val(v)); } -value int64_to_int(value v) /* ML */ +CAMLprim value int64_to_int(value v) { return Val_long((long) Int64_val(v)); } -value int64_of_float(value v) /* ML */ +CAMLprim value int64_of_float(value v) { return copy_int64((int64)(Double_val(v))); } -value int64_to_float(value v) /* ML */ +CAMLprim value int64_to_float(value v) { return copy_double((double)(Int64_val(v))); } -value int64_of_int32(value v) /* ML */ +CAMLprim value int64_of_int32(value v) { return copy_int64(Int32_val(v)); } -value int64_to_int32(value v) /* ML */ +CAMLprim value int64_to_int32(value v) { return copy_int32((int32) Int64_val(v)); } -value int64_of_nativeint(value v) /* ML */ +CAMLprim value int64_of_nativeint(value v) { return copy_int64(Nativeint_val(v)); } -value int64_to_nativeint(value v) /* ML */ +CAMLprim value int64_to_nativeint(value v) { return copy_nativeint((long) Int64_val(v)); } -value int64_format(value fmt, value arg) /* ML */ +CAMLprim value int64_format(value fmt, value arg) #ifdef ARCH_INT64_PRINTF_FORMAT { char format_string[FORMAT_BUFFER_SIZE]; @@ -400,7 +400,7 @@ value int64_format(value fmt, value arg) /* ML */ { invalid_argument ("Int64.format is not implemented on this platform"); } #endif -value int64_of_string(value s) /* ML */ +CAMLprim value int64_of_string(value s) { char * p; uint64 res; @@ -418,14 +418,14 @@ value int64_of_string(value s) /* ML */ return copy_int64(sign < 0 ? -((int64) res) : (int64) res); } -value int64_bits_of_float(value vd) /* ML */ +CAMLprim value int64_bits_of_float(value vd) { union { double d; int64 i; } u; u.d = Double_val(vd); return copy_int64(u.i); } -value int64_float_of_bits(value vi) /* ML */ +CAMLprim value int64_float_of_bits(value vi) { union { double d; int64 i; } u; u.i = Int64_val(vi); @@ -567,7 +567,7 @@ static unsigned long nativeint_deserialize(void * dst) return sizeof(long); } -struct custom_operations nativeint_ops = { +CAMLexport struct custom_operations nativeint_ops = { "_n", custom_finalize_default, nativeint_compare, @@ -576,76 +576,76 @@ struct custom_operations nativeint_ops = { nativeint_deserialize }; -value copy_nativeint(long i) +CAMLexport 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 */ +CAMLprim value nativeint_neg(value v) { return copy_nativeint(- Nativeint_val(v)); } -value nativeint_add(value v1, value v2) /* ML */ +CAMLprim value nativeint_add(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) + Nativeint_val(v2)); } -value nativeint_sub(value v1, value v2) /* ML */ +CAMLprim value nativeint_sub(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) - Nativeint_val(v2)); } -value nativeint_mul(value v1, value v2) /* ML */ +CAMLprim value nativeint_mul(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) * Nativeint_val(v2)); } -value nativeint_div(value v1, value v2) /* ML */ +CAMLprim value nativeint_div(value v1, value v2) { 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 */ +CAMLprim value nativeint_mod(value v1, value v2) { 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 */ +CAMLprim value nativeint_and(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) & Nativeint_val(v2)); } -value nativeint_or(value v1, value v2) /* ML */ +CAMLprim value nativeint_or(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) | Nativeint_val(v2)); } -value nativeint_xor(value v1, value v2) /* ML */ +CAMLprim value nativeint_xor(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) ^ Nativeint_val(v2)); } -value nativeint_shift_left(value v1, value v2) /* ML */ +CAMLprim value nativeint_shift_left(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) << Int_val(v2)); } -value nativeint_shift_right(value v1, value v2) /* ML */ +CAMLprim value nativeint_shift_right(value v1, value v2) { return copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); } -value nativeint_shift_right_unsigned(value v1, value v2) /* ML */ +CAMLprim value nativeint_shift_right_unsigned(value v1, value v2) { return copy_nativeint((unsigned long)Nativeint_val(v1) >> Int_val(v2)); } -value nativeint_of_int(value v) /* ML */ +CAMLprim value nativeint_of_int(value v) { return copy_nativeint(Long_val(v)); } -value nativeint_to_int(value v) /* ML */ +CAMLprim value nativeint_to_int(value v) { return Val_long(Nativeint_val(v)); } -value nativeint_of_float(value v) /* ML */ +CAMLprim value nativeint_of_float(value v) { return copy_nativeint((long)(Double_val(v))); } -value nativeint_to_float(value v) /* ML */ +CAMLprim value nativeint_to_float(value v) { return copy_double((double)(Nativeint_val(v))); } -value nativeint_of_int32(value v) /* ML */ +CAMLprim value nativeint_of_int32(value v) { return copy_nativeint(Int32_val(v)); } -value nativeint_to_int32(value v) /* ML */ +CAMLprim value nativeint_to_int32(value v) { return copy_int32(Nativeint_val(v)); } -value nativeint_format(value fmt, value arg) /* ML */ +CAMLprim value nativeint_format(value fmt, value arg) { char format_string[FORMAT_BUFFER_SIZE]; char default_format_buffer[FORMAT_BUFFER_SIZE]; @@ -659,7 +659,7 @@ value nativeint_format(value fmt, value arg) /* ML */ return res; } -value nativeint_of_string(value s) /* ML */ +CAMLprim value nativeint_of_string(value s) { return copy_nativeint(parse_long(String_val(s))); } diff --git a/byterun/io.c b/byterun/io.c index 65830c24e1..23e0d409cb 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -43,10 +43,10 @@ /* Hooks for locking channels */ -void (*channel_mutex_free) (struct channel *) = NULL; -void (*channel_mutex_lock) (struct channel *) = NULL; -void (*channel_mutex_unlock) (struct channel *) = NULL; -void (*channel_mutex_unlock_exn) (void) = NULL; +CAMLexport void (*channel_mutex_free) (struct channel *) = NULL; +CAMLexport void (*channel_mutex_lock) (struct channel *) = NULL; +CAMLexport void (*channel_mutex_unlock) (struct channel *) = NULL; +CAMLexport void (*channel_mutex_unlock_exn) (void) = NULL; /* Basic functions over type struct channel *. These functions can be called directly from C. @@ -54,7 +54,7 @@ void (*channel_mutex_unlock_exn) (void) = NULL; /* Functions shared between input and output */ -struct channel * open_descriptor(int fd) +CAMLexport struct channel * open_descriptor(int fd) { struct channel * channel; @@ -67,14 +67,14 @@ struct channel * open_descriptor(int fd) return channel; } -void close_channel(struct channel *channel) +CAMLexport void close_channel(struct channel *channel) { close(channel->fd); if (channel_mutex_free != NULL) (*channel_mutex_free)(channel); stat_free(channel); } -long channel_size(struct channel *channel) +CAMLexport long channel_size(struct channel *channel) { long end; @@ -86,7 +86,7 @@ long channel_size(struct channel *channel) return end; } -int channel_binary_mode(struct channel *channel) +CAMLexport int channel_binary_mode(struct channel *channel) { #ifdef _WIN32 int oldmode = setmode(channel->fd, O_BINARY); @@ -141,7 +141,7 @@ again: at least one character. Returns true if the buffer is empty at the end of the flush, or false if some data remains in the buffer. */ -int flush_partial(struct channel *channel) +CAMLexport int flush_partial(struct channel *channel) { int towrite, written; @@ -158,14 +158,14 @@ int flush_partial(struct channel *channel) /* Flush completely the buffer. */ -void flush(struct channel *channel) +CAMLexport void flush(struct channel *channel) { while (! flush_partial(channel)) /*nothing*/; } /* Output data */ -void putword(struct channel *channel, uint32 w) +CAMLexport void putword(struct channel *channel, uint32 w) { if (! channel_binary_mode(channel)) failwith("output_binary_int: not a binary channel"); @@ -175,7 +175,7 @@ void putword(struct channel *channel, uint32 w) putch(channel, w); } -int putblock(struct channel *channel, char *p, long int len) +CAMLexport int putblock(struct channel *channel, char *p, long int len) { int n, free, towrite, written; @@ -201,7 +201,7 @@ int putblock(struct channel *channel, char *p, long int len) } } -void really_putblock(struct channel *channel, char *p, long int len) +CAMLexport void really_putblock(struct channel *channel, char *p, long int len) { int written; while (len > 0) { @@ -211,14 +211,14 @@ void really_putblock(struct channel *channel, char *p, long int len) } } -void seek_out(struct channel *channel, long int dest) +CAMLexport void seek_out(struct channel *channel, long int dest) { flush(channel); if (lseek(channel->fd, dest, 0) != dest) sys_error(NO_ARG); channel->offset = dest; } -long pos_out(struct channel *channel) +CAMLexport long pos_out(struct channel *channel) { return channel->offset + channel->curr - channel->buff; } @@ -245,7 +245,7 @@ static int do_read(int fd, char *p, unsigned int n) return retcode; } -unsigned char refill(struct channel *channel) +CAMLexport unsigned char refill(struct channel *channel) { int n; @@ -257,7 +257,7 @@ unsigned char refill(struct channel *channel) return (unsigned char)(channel->buff[0]); } -uint32 getword(struct channel *channel) +CAMLexport uint32 getword(struct channel *channel) { int i; uint32 res; @@ -271,7 +271,7 @@ uint32 getword(struct channel *channel) return res; } -int getblock(struct channel *channel, char *p, long int len) +CAMLexport int getblock(struct channel *channel, char *p, long int len) { int n, avail, nread; @@ -296,7 +296,7 @@ int getblock(struct channel *channel, char *p, long int len) } } -int really_getblock(struct channel *chan, char *p, long int n) +CAMLexport int really_getblock(struct channel *chan, char *p, long int n) { int r; while (n > 0) { @@ -308,7 +308,7 @@ int really_getblock(struct channel *chan, char *p, long int n) return (n == 0); } -void seek_in(struct channel *channel, long int dest) +CAMLexport void seek_in(struct channel *channel, long int dest) { if (dest >= channel->offset - (channel->max - channel->buff) && dest <= channel->offset) { @@ -320,12 +320,12 @@ void seek_in(struct channel *channel, long int dest) } } -long pos_in(struct channel *channel) +CAMLexport long pos_in(struct channel *channel) { return channel->offset - (channel->max - channel->curr); } -long input_scan_line(struct channel *channel) +CAMLexport long input_scan_line(struct channel *channel) { char * p; int n; @@ -400,19 +400,19 @@ static value alloc_channel(struct channel *chan) return res; } -value caml_open_descriptor(value fd) /* ML */ +CAMLprim value caml_open_descriptor(value fd) { return alloc_channel(open_descriptor(Int_val(fd))); } -value channel_descriptor(value vchannel) /* ML */ +CAMLprim value channel_descriptor(value vchannel) { int fd = Channel(vchannel)->fd; if (fd == -1) { errno = EBADF; sys_error(NO_ARG); } return Val_int(fd); } -value caml_close_channel(value vchannel) /* ML */ +CAMLprim value caml_close_channel(value vchannel) { /* For output channels, must have flushed before */ struct channel * channel = Channel(vchannel); @@ -425,12 +425,12 @@ value caml_close_channel(value vchannel) /* ML */ return Val_unit; } -value caml_channel_size(value vchannel) /* ML */ +CAMLprim value caml_channel_size(value vchannel) { return Val_long(channel_size(Channel(vchannel))); } -value caml_set_binary_mode(value vchannel, value mode) /* ML */ +CAMLprim value caml_set_binary_mode(value vchannel, value mode) { #ifdef _WIN32 struct channel * channel = Channel(vchannel); @@ -440,7 +440,7 @@ value caml_set_binary_mode(value vchannel, value mode) /* ML */ return Val_unit; } -value caml_flush_partial(value vchannel) /* ML */ +CAMLprim value caml_flush_partial(value vchannel) { struct channel * channel = Channel(vchannel); int res; @@ -453,7 +453,7 @@ value caml_flush_partial(value vchannel) /* ML */ return Val_bool(res); } -value caml_flush(value vchannel) /* ML */ +CAMLprim value caml_flush(value vchannel) { struct channel * channel = Channel(vchannel); /* Don't fail if channel is closed, this causes problem with flush on @@ -465,7 +465,7 @@ value caml_flush(value vchannel) /* ML */ return Val_unit; } -value caml_output_char(value vchannel, value ch) /* ML */ +CAMLprim value caml_output_char(value vchannel, value ch) { struct channel * channel = Channel(vchannel); Lock(channel); @@ -474,7 +474,7 @@ value caml_output_char(value vchannel, value ch) /* ML */ return Val_unit; } -value caml_output_int(value vchannel, value w) /* ML */ +CAMLprim value caml_output_int(value vchannel, value w) { struct channel * channel = Channel(vchannel); Lock(channel); @@ -483,7 +483,7 @@ value caml_output_int(value vchannel, value w) /* ML */ return Val_unit; } -value caml_output_partial(value vchannel, value buff, value start, value length) /* ML */ +CAMLprim value caml_output_partial(value vchannel, value buff, value start, value length) { CAMLparam4 (vchannel, buff, start, length); struct channel * channel = Channel(vchannel); @@ -495,7 +495,7 @@ value caml_output_partial(value vchannel, value buff, value start, value length) CAMLreturn (Val_int(res)); } -value caml_output(value vchannel, value buff, value start, value length) /* ML */ +CAMLprim value caml_output(value vchannel, value buff, value start, value length) { CAMLparam4 (vchannel, buff, start, length); struct channel * channel = Channel(vchannel); @@ -512,7 +512,7 @@ value caml_output(value vchannel, value buff, value start, value length) /* ML * CAMLreturn (Val_unit); } -value caml_seek_out(value vchannel, value pos) /* ML */ +CAMLprim value caml_seek_out(value vchannel, value pos) { struct channel * channel = Channel(vchannel); Lock(channel); @@ -521,12 +521,12 @@ value caml_seek_out(value vchannel, value pos) /* ML */ return Val_unit; } -value caml_pos_out(value vchannel) /* ML */ +CAMLprim value caml_pos_out(value vchannel) { return Val_long(pos_out(Channel(vchannel))); } -value caml_input_char(value vchannel) /* ML */ +CAMLprim value caml_input_char(value vchannel) { struct channel * channel = Channel(vchannel); unsigned char c; @@ -537,7 +537,7 @@ value caml_input_char(value vchannel) /* ML */ return Val_long(c); } -value caml_input_int(value vchannel) /* ML */ +CAMLprim value caml_input_int(value vchannel) { struct channel * channel = Channel(vchannel); long i; @@ -551,7 +551,7 @@ value caml_input_int(value vchannel) /* ML */ return Val_long(i); } -value caml_input(value vchannel,value buff,value vstart,value vlength) /* ML */ +CAMLprim value caml_input(value vchannel,value buff,value vstart,value vlength) { CAMLparam4 (vchannel, buff, vstart, vlength); struct channel * channel = Channel(vchannel); @@ -583,7 +583,7 @@ value caml_input(value vchannel,value buff,value vstart,value vlength) /* ML */ CAMLreturn (Val_long(n)); } -value caml_seek_in(value vchannel, value pos) /* ML */ +CAMLprim value caml_seek_in(value vchannel, value pos) { struct channel * channel = Channel(vchannel); Lock(channel); @@ -592,12 +592,12 @@ value caml_seek_in(value vchannel, value pos) /* ML */ return Val_unit; } -value caml_pos_in(value vchannel) /* ML */ +CAMLprim value caml_pos_in(value vchannel) { return Val_long(pos_in(Channel(vchannel))); } -value caml_input_scan_line(value vchannel) /* ML */ +CAMLprim value caml_input_scan_line(value vchannel) { struct channel * channel = Channel(vchannel); long res; diff --git a/byterun/io.h b/byterun/io.h index 0be5adaf16..b4bbd524d7 100644 --- a/byterun/io.h +++ b/byterun/io.h @@ -54,20 +54,20 @@ struct channel { ? refill(channel) \ : (unsigned char) *((channel))->curr++) -struct channel * open_descriptor (int); -void close_channel (struct channel *); -int channel_binary_mode (struct channel *); +CAMLextern struct channel * open_descriptor (int); +CAMLextern void close_channel (struct channel *); +CAMLextern int channel_binary_mode (struct channel *); -int flush_partial (struct channel *); -void flush (struct channel *); -void putword (struct channel *, uint32); -int putblock (struct channel *, char *, long); -void really_putblock (struct channel *, char *, long); +CAMLextern int flush_partial (struct channel *); +CAMLextern void flush (struct channel *); +CAMLextern void putword (struct channel *, uint32); +CAMLextern int putblock (struct channel *, char *, long); +CAMLextern void really_putblock (struct channel *, char *, long); -unsigned char refill (struct channel *); -uint32 getword (struct channel *); -int getblock (struct channel *, char *, long); -int really_getblock (struct channel *, char *, long); +CAMLextern unsigned char refill (struct channel *); +CAMLextern uint32 getword (struct channel *); +CAMLextern int getblock (struct channel *, char *, long); +CAMLextern int really_getblock (struct channel *, char *, long); /* Extract a struct channel * from the heap object representing it */ @@ -75,10 +75,10 @@ int really_getblock (struct channel *, char *, long); /* The locking machinery */ -extern void (*channel_mutex_free) (struct channel *); -extern void (*channel_mutex_lock) (struct channel *); -extern void (*channel_mutex_unlock) (struct channel *); -extern void (*channel_mutex_unlock_exn) (void); +CAMLextern void (*channel_mutex_free) (struct channel *); +CAMLextern void (*channel_mutex_lock) (struct channel *); +CAMLextern void (*channel_mutex_unlock) (struct channel *); +CAMLextern void (*channel_mutex_unlock_exn) (void); #define Lock(channel) \ if (channel_mutex_lock != NULL) (*channel_mutex_lock)(channel) diff --git a/byterun/lexing.c b/byterun/lexing.c index 790053c46e..fa1c0618bc 100644 --- a/byterun/lexing.c +++ b/byterun/lexing.c @@ -46,7 +46,8 @@ struct lexing_table { #define Short(tbl,n) (((short *)(tbl))[(n)]) #endif -value lex_engine(struct lexing_table *tbl, value start_state, struct lexer_buffer *lexbuf) /* ML */ +CAMLprim value lex_engine(struct lexing_table *tbl, value start_state, + struct lexer_buffer *lexbuf) { int state, base, backtrk, c; diff --git a/byterun/major_gc.h b/byterun/major_gc.h index 0b86b6072b..aad845439a 100644 --- a/byterun/major_gc.h +++ b/byterun/major_gc.h @@ -46,10 +46,10 @@ typedef int page_table_entry; typedef char page_table_entry; #endif -extern char *heap_start; -extern char *heap_end; +CAMLextern char *heap_start; +CAMLextern char *heap_end; extern unsigned long total_heap_size; -extern page_table_entry *page_table; +CAMLextern page_table_entry *page_table; extern asize_t page_low, page_high; extern char *gc_sweep_hp; diff --git a/byterun/md5.c b/byterun/md5.c index 9ae4a62a11..45ca12110c 100644 --- a/byterun/md5.c +++ b/byterun/md5.c @@ -22,7 +22,7 @@ /* MD5 message digest */ -value md5_string(value str, value ofs, value len) /* ML */ +CAMLprim value md5_string(value str, value ofs, value len) { struct MD5Context ctx; value res; @@ -33,7 +33,7 @@ value md5_string(value str, value ofs, value len) /* ML */ return res; } -value md5_chan(value vchan, value len) /* ML */ +CAMLprim value md5_chan(value vchan, value len) { struct channel * chan = Channel(vchan); struct MD5Context ctx; diff --git a/byterun/md5.h b/byterun/md5.h index 847b66c3fd..21104096e6 100644 --- a/byterun/md5.h +++ b/byterun/md5.h @@ -21,8 +21,8 @@ #include "mlvalues.h" #include "io.h" -value md5_string (value str, value ofs, value len); -value md5_chan (value vchan, value len); +CAMLextern value md5_string (value str, value ofs, value len); +CAMLextern value md5_chan (value vchan, value len); struct MD5Context { uint32 buf[4]; diff --git a/byterun/memory.h b/byterun/memory.h index f0167cb4c9..30875ec7fc 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -25,14 +25,14 @@ #include "misc.h" #include "mlvalues.h" -value alloc_shr (mlsize_t, tag_t); +CAMLextern value alloc_shr (mlsize_t, tag_t); void adjust_gc_speed (mlsize_t, mlsize_t); -void modify (value *, value); -void initialize (value *, value); -value check_urgent_gc (value); -void * stat_alloc (asize_t); /* Size in bytes. */ -void stat_free (void *); -void * stat_resize (void *, asize_t); /* Size in bytes. */ +CAMLextern void modify (value *, value); +CAMLextern void initialize (value *, value); +CAMLextern value check_urgent_gc (value); +CAMLextern void * stat_alloc (asize_t); /* Size in bytes. */ +CAMLextern void stat_free (void *); +CAMLextern void * stat_resize (void *, asize_t); /* Size in bytes. */ header_t *alloc_for_heap (asize_t request); /* Size in bytes. */ void free_for_heap (header_t *mem); int add_to_heap (header_t *mem); @@ -94,7 +94,7 @@ struct caml__roots_block { value *tables [5]; }; -extern struct caml__roots_block *local_roots; /* defined in roots.c */ +CAMLextern struct caml__roots_block *local_roots; /* defined in roots.c */ /* The following macros are used to declare C local variables and function parameters of type [value]. @@ -351,12 +351,12 @@ extern struct caml__roots_block *local_roots; /* defined in roots.c */ for the duration of the program, or until [remove_global_root] is called. */ -void register_global_root (value *); +CAMLextern void register_global_root (value *); /* [remove_global_root] removes a memory root registered on a global C variable with [register_global_root]. */ -void remove_global_root (value *); +CAMLextern void remove_global_root (value *); #endif /* _memory_ */ diff --git a/byterun/meta.c b/byterun/meta.c index 74f8756922..8df61dcaf6 100644 --- a/byterun/meta.c +++ b/byterun/meta.c @@ -29,12 +29,12 @@ #ifndef NATIVE_CODE -value get_global_data(value unit) /* ML */ +CAMLprim value get_global_data(value unit) { return global_data; } -value reify_bytecode(value prog, value len) /* ML */ +CAMLprim value reify_bytecode(value prog, value len) { value clos; #ifdef ARCH_BIG_ENDIAN @@ -48,7 +48,7 @@ value reify_bytecode(value prog, value len) /* ML */ return clos; } -value realloc_global(value size) /* ML */ +CAMLprim value realloc_global(value size) { mlsize_t requested_size, actual_size, i; value new_global_data; @@ -69,17 +69,12 @@ value realloc_global(value size) /* ML */ return Val_unit; } -value available_primitives(value unit) /* ML */ -{ - return copy_string_array((char const **) names_of_cprim); -} - -value get_current_environment(value unit) /* ML */ +CAMLprim value get_current_environment(value unit) { return *extern_sp; } -value invoke_traced_function(value codeptr, value env, value arg) /* ML */ +CAMLprim value invoke_traced_function(value codeptr, value env, value arg) { /* Stack layout on entry: return frame into instrument_closure function diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h index 196d4ef3d9..a9d7b48226 100644 --- a/byterun/minor_gc.h +++ b/byterun/minor_gc.h @@ -18,8 +18,8 @@ #include "misc.h" -extern char *young_start, *young_ptr, *young_end, *young_limit; -extern value **ref_table_ptr, **ref_table_limit; +CAMLextern char *young_start, *young_ptr, *young_end, *young_limit; +CAMLextern value **ref_table_ptr, **ref_table_limit; extern asize_t minor_heap_size; extern int in_minor_collection; @@ -28,8 +28,8 @@ extern int in_minor_collection; extern void set_minor_heap_size (asize_t); extern void empty_minor_heap (void); -extern void minor_collection (void); -extern void garbage_collection (void); /* for the native-code system */ +CAMLextern void minor_collection (void); +CAMLextern void garbage_collection (void); /* for the native-code system */ extern void realloc_ref_table (void); extern void oldify (value, value *); diff --git a/byterun/misc.c b/byterun/misc.c index e3050fb827..a6972ccb52 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -15,6 +15,7 @@ #include <stdio.h> #include "config.h" #include "misc.h" +#include "memory.h" #ifdef HAS_UI #include "ui.h" #endif @@ -67,6 +68,19 @@ void fatal_error_arg (char *fmt, char *arg) #endif } +void fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2) +{ +#ifdef HAS_UI + ui_print_stderr(fmt1, arg1); + ui_print_stderr(fmt2, arg2); + ui_exit (2); +#else + fprintf (stderr, fmt1, arg1); + fprintf (stderr, fmt2, arg2); + exit(2); +#endif +} + char *aligned_malloc (asize_t size, int modulo, void **block) { char *raw_mem; @@ -92,3 +106,32 @@ char *aligned_malloc (asize_t size, int modulo, void **block) #endif return (char *) (aligned_mem - modulo); } + +void ext_table_init(struct ext_table * tbl, int init_capa) +{ + tbl->size = 0; + tbl->capacity = init_capa; + tbl->contents = stat_alloc(sizeof(void *) * init_capa); +} + +int ext_table_add(struct ext_table * tbl, void * data) +{ + int res; + if (tbl->size >= tbl->capacity) { + tbl->capacity *= 2; + tbl->contents = + stat_resize(tbl->contents, sizeof(void *) * tbl->capacity); + } + res = tbl->size; + tbl->contents[res] = data; + tbl->size++; + return res; +} + +void ext_table_free(struct ext_table * tbl, int free_entries) +{ + int i; + if (free_entries) + for (i = 0; i < tbl->size; i++) stat_free(tbl->contents[i]); + stat_free(tbl->contents); +} diff --git a/byterun/misc.h b/byterun/misc.h index 4da1c2bd39..4720e68939 100644 --- a/byterun/misc.h +++ b/byterun/misc.h @@ -42,6 +42,22 @@ typedef char * addr; #define Noreturn #endif +/* Export control (to mark primitives and to handle Windows DLL) */ + +#if defined(_WIN32) && defined(_DLL) +# define CAMLexport __declspec(dllexport) +# define CAMLprim __declspec(dllexport) +# if defined(IN_OCAMLRUN) +# define CAMLextern __declspec(dllexport) extern +# else +# define CAMLextern __declspec(dllimport) extern +# endif +#else +# define CAMLexport +# define CAMLprim +# define CAMLextern extern +#endif + /* Assertions */ #ifdef DEBUG @@ -51,8 +67,22 @@ void caml_failed_assert (char *, char *, int) Noreturn; #define CAMLassert(x) #endif -void fatal_error (char *) Noreturn; -void fatal_error_arg (char *, char *) Noreturn; +void fatal_error (char *msg) Noreturn; +void fatal_error_arg (char *fmt, char *arg) Noreturn; +void fatal_error_arg2 (char *fmt1, char *arg1, + char *fmt2, char *arg2) Noreturn; + +/* Data structures */ + +struct ext_table { + int size; + int capacity; + void ** contents; +}; + +extern void ext_table_init(struct ext_table * tbl, int init_capa); +extern int ext_table_add(struct ext_table * tbl, void * data); +extern void ext_table_free(struct ext_table * tbl, int free_entries); /* GC flags and messages */ diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h index c8246f727a..8da310efc5 100644 --- a/byterun/mlvalues.h +++ b/byterun/mlvalues.h @@ -177,7 +177,7 @@ typedef opcode_t * code_t; #define Oid_val(val) Long_val(Field((val), 1)) /* Another special case: variants */ -extern value hash_variant(char * tag); +CAMLextern value hash_variant(char * tag); /* 2- If tag >= No_scan_tag : a sequence of bytes. */ @@ -196,7 +196,7 @@ extern value hash_variant(char * tag); /* Strings. */ #define String_tag 252 #define String_val(x) ((char *) Bp_val(x)) -mlsize_t string_length (value); +CAMLextern mlsize_t string_length (value); /* Floating-point numbers. */ #define Double_tag 253 @@ -205,8 +205,8 @@ mlsize_t string_length (value); #define Double_val(v) (* (double *)(v)) #define Store_double_val(v,d) (* (double *)(v) = (d)) #else -double Double_val (value); -void Store_double_val (value,double); +CAMLextern double Double_val (value); +CAMLextern void Store_double_val (value,double); #endif /* Arrays of floating-point numbers. */ @@ -234,12 +234,12 @@ struct custom_operations; /* defined in [custom.h] */ #ifndef ARCH_ALIGN_INT64 #define Int64_val(v) (*((int64 *) Data_custom_val(v))) #else -extern int64 Int64_val(value v); +CAMLextern int64 Int64_val(value v); #endif /* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ -extern header_t atom_table[]; +CAMLextern header_t atom_table[]; #define Atom(tag) (Val_hp (&(atom_table [(tag)]))) /* Is_atom tests whether a well-formed block is statically allocated @@ -251,7 +251,7 @@ extern header_t atom_table[]; #ifndef NATIVE_CODE #define Is_atom(v) ((v) >= Atom(0) && (v) <= Atom(255)) #else -extern char * static_data_start, * static_data_end; +CAMLextern char * static_data_start, * static_data_end; #define Is_atom(v) \ ((((char *)(v) >= static_data_start && (char *)(v) < static_data_end) || \ ((v) >= Atom(0) && (v) <= Atom(255)))) diff --git a/byterun/obj.c b/byterun/obj.c index f79483d4a7..caa39f23e4 100644 --- a/byterun/obj.c +++ b/byterun/obj.c @@ -24,33 +24,33 @@ #include "mlvalues.h" #include "prims.h" -value static_alloc(value size) /* ML */ +CAMLprim value static_alloc(value size) { return (value) stat_alloc((asize_t) Long_val(size)); } -value static_free(value blk) /* ML */ +CAMLprim value static_free(value blk) { stat_free((void *) blk); return Val_unit; } -value static_resize(value blk, value new_size) /* ML */ +CAMLprim value static_resize(value blk, value new_size) { return (value) stat_resize((char *) blk, (asize_t) Long_val(new_size)); } -value obj_is_block(value arg) /* ML */ +CAMLprim value obj_is_block(value arg) { return Val_bool(Is_block(arg)); } -value obj_tag(value arg) /* ML */ +CAMLprim value obj_tag(value arg) { return Val_int(Tag_val(arg)); } -value obj_block(value tag, value size) /* ML */ +CAMLprim value obj_block(value tag, value size) { value res; mlsize_t sz, i; @@ -66,7 +66,7 @@ value obj_block(value tag, value size) /* ML */ return res; } -value obj_dup(value arg) /* ML */ +CAMLprim value obj_dup(value arg) { CAMLparam1 (arg); CAMLlocal1 (res); @@ -93,7 +93,7 @@ value obj_dup(value arg) /* ML */ with the leftover part of the object: this is needed in the major heap and harmless in the minor heap. */ -value obj_truncate (value v, value newsize) /* ML */ +CAMLprim value obj_truncate (value v, value newsize) { mlsize_t new_wosize = Long_val (newsize); header_t hd = Hd_val (v); diff --git a/byterun/osdeps.h b/byterun/osdeps.h new file mode 100644 index 0000000000..b1eba23d5f --- /dev/null +++ b/byterun/osdeps.h @@ -0,0 +1,53 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Operating system - specific stuff */ + +#ifndef _osdeps_ + +#define _osdeps_ + +#include "misc.h" + +/* Decompose the given path into a list of directories, and add them + to the given table. Return the block to be freed later. */ +extern char * decompose_path(struct ext_table * tbl, char * path); + +/* Search the given file in the given list of directories. + If not found, return a copy of [name]. Result is allocated with + [stat_alloc]. */ +extern char * search_in_path(struct ext_table * path, char * name); + +/* Same, but search an executable name in the system path for executables. */ +CAMLextern char * search_exe_in_path(char * name); + +/* Same, but search a shared library in the given path. */ +extern char * search_dll_in_path(struct ext_table * path, char * name); + +/* Open a shared library and return a handle on it. + Return [NULL] on error. */ +extern void * caml_dlopen(char * libname); + +/* Close a shared library handle */ +extern void caml_dlclose(void * handle); + +/* Look up the given symbol in the given shared library. + Return [NULL] if not found, or symbol value if found. */ +extern void * caml_dlsym(void * handle, char * name); + +/* Return an error message describing the most recent dynlink failure. */ +extern char * caml_dlerror(void); + +#endif + diff --git a/byterun/parsing.c b/byterun/parsing.c index bd875733db..a0b2786e73 100644 --- a/byterun/parsing.c +++ b/byterun/parsing.c @@ -105,7 +105,8 @@ int parser_trace = 0; /* The pushdown automata */ -value parse_engine(struct parser_tables *tables, struct parser_env *env, value cmd, value arg) /* ML */ +CAMLprim value parse_engine(struct parser_tables *tables, + struct parser_env *env, value cmd, value arg) { int state; mlsize_t sp, asp; diff --git a/byterun/prims.h b/byterun/prims.h index 5742fa637f..5377c73c16 100644 --- a/byterun/prims.h +++ b/byterun/prims.h @@ -19,7 +19,11 @@ typedef value (*c_primitive)(); -extern c_primitive cprim[]; -extern char * names_of_cprim[]; +extern c_primitive builtin_cprim[]; +extern char * names_of_builtin_cprim[]; + +extern struct ext_table prim_table; + +#define Primitive(n) ((c_primitive)(prim_table.contents[n])) #endif /* _prims_ */ diff --git a/byterun/printexc.c b/byterun/printexc.c index cd0994ea63..e1f531697d 100644 --- a/byterun/printexc.c +++ b/byterun/printexc.c @@ -46,7 +46,7 @@ static void add_string(struct stringbuf *buf, char *s) buf->ptr += len; } -char * format_caml_exception(value exn) +CAMLexport char * format_caml_exception(value exn) { mlsize_t start, i; value bucket, v; diff --git a/byterun/printexc.h b/byterun/printexc.h index b28fadfaf2..ad8c7b4cc4 100644 --- a/byterun/printexc.h +++ b/byterun/printexc.h @@ -19,7 +19,7 @@ #include "misc.h" #include "mlvalues.h" -char * format_caml_exception (value); +CAMLextern char * format_caml_exception (value); void fatal_uncaught_exception (value) Noreturn; diff --git a/byterun/roots.c b/byterun/roots.c index 74e5b2e7fd..0a14ab44f8 100644 --- a/byterun/roots.c +++ b/byterun/roots.c @@ -24,7 +24,7 @@ #include "roots.h" #include "stacks.h" -struct caml__roots_block *local_roots = NULL; +CAMLexport struct caml__roots_block *local_roots = NULL; void (*scan_roots_hook) (scanning_action f) = NULL; diff --git a/byterun/roots.h b/byterun/roots.h index 99240d6c5f..eecab00818 100644 --- a/byterun/roots.h +++ b/byterun/roots.h @@ -24,14 +24,14 @@ void oldify_local_roots (void); void darken_all_roots (void); void do_roots (scanning_action); #ifndef NATIVE_CODE -void do_local_roots (scanning_action, value *, value *, - struct caml__roots_block *); +CAMLextern void do_local_roots (scanning_action, value *, value *, + struct caml__roots_block *); #else -void do_local_roots(scanning_action f, char * bottom_of_stack, - unsigned long last_retaddr, value * gc_regs, - struct caml__roots_block * local_roots); +CAMLextern void do_local_roots(scanning_action f, char * bottom_of_stack, + unsigned long last_retaddr, value * gc_regs, + struct caml__roots_block * local_roots); #endif -extern void (*scan_roots_hook) (scanning_action); +CAMLextern void (*scan_roots_hook) (scanning_action); #endif /* _roots_ */ diff --git a/byterun/signals.c b/byterun/signals.c index d63e7ccc7b..e376237abb 100644 --- a/byterun/signals.c +++ b/byterun/signals.c @@ -107,7 +107,7 @@ void urge_major_slice (void) something_to_do = 1; } -void enter_blocking_section(void) +CAMLexport void enter_blocking_section(void) { int temp; @@ -124,7 +124,7 @@ void enter_blocking_section(void) if (enter_blocking_section_hook != NULL) enter_blocking_section_hook(); } -void leave_blocking_section(void) +CAMLexport void leave_blocking_section(void) { if (leave_blocking_section_hook != NULL) leave_blocking_section_hook(); Assert(async_signal_mode); @@ -201,7 +201,7 @@ static int posix_signals[] = { SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGVTALRM, SIGPROF }; -int convert_signal_number(int signo) +CAMLexport int convert_signal_number(int signo) { if (signo < 0 && signo >= -(sizeof(posix_signals) / sizeof(int))) return posix_signals[-signo-1]; @@ -221,7 +221,7 @@ static int rev_convert_signal_number(int signo) #define NSIG 64 #endif -value install_signal_handler(value signal_number, value action) /* ML */ +CAMLprim value install_signal_handler(value signal_number, value action) { CAMLparam2 (signal_number, action); int sig; diff --git a/byterun/signals.h b/byterun/signals.h index 99e4cf70b2..2743cb8c6c 100644 --- a/byterun/signals.h +++ b/byterun/signals.h @@ -19,21 +19,21 @@ #include "mlvalues.h" extern value signal_handlers; -extern int volatile pending_signal; -extern int volatile something_to_do; +CAMLextern int volatile pending_signal; +CAMLextern int volatile something_to_do; extern int volatile force_major_slice; -extern int volatile async_signal_mode; +CAMLextern int volatile async_signal_mode; -void enter_blocking_section (void); -void leave_blocking_section (void); +CAMLextern void enter_blocking_section (void); +CAMLextern void leave_blocking_section (void); void urge_major_slice (void); -int convert_signal_number (int); +CAMLextern int convert_signal_number (int); void execute_signal(int signal_number, int in_signal_handler); void process_event(void); -extern void (*enter_blocking_section_hook)(void); -extern void (*leave_blocking_section_hook)(void); -extern void (* volatile async_action_hook)(void); +CAMLextern void (*enter_blocking_section_hook)(void); +CAMLextern void (*leave_blocking_section_hook)(void); +CAMLextern void (* volatile async_action_hook)(void); #endif /* _signals_ */ diff --git a/byterun/stacks.c b/byterun/stacks.c index 9bc69af48e..c7611babfb 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -21,12 +21,12 @@ #include "mlvalues.h" #include "stacks.h" -value * stack_low; -value * stack_high; -value * stack_threshold; -value * extern_sp; -value * trapsp; -value * trap_barrier; +CAMLexport value * stack_low; +CAMLexport value * stack_high; +CAMLexport value * stack_threshold; +CAMLexport value * extern_sp; +CAMLexport value * trapsp; +CAMLexport value * trap_barrier; value global_data; unsigned long max_stack_size; /* also used in gc_ctrl.c */ @@ -81,7 +81,7 @@ void realloc_stack(asize_t required_space) #undef shift } -value ensure_stack_capacity(value required_space) /* ML */ +CAMLprim value ensure_stack_capacity(value required_space) { asize_t req = Long_val(required_space); if (extern_sp - req < stack_low) realloc_stack(req); diff --git a/byterun/stacks.h b/byterun/stacks.h index db017c56d2..ba815e049f 100644 --- a/byterun/stacks.h +++ b/byterun/stacks.h @@ -22,12 +22,12 @@ #include "mlvalues.h" #include "memory.h" -extern value * stack_low; -extern value * stack_high; -extern value * stack_threshold; -extern value * extern_sp; -extern value * trapsp; -extern value * trap_barrier; +CAMLextern value * stack_low; +CAMLextern value * stack_high; +CAMLextern value * stack_threshold; +CAMLextern value * extern_sp; +CAMLextern value * trapsp; +CAMLextern value * trap_barrier; #define Trap_pc(tp) (((code_t *)(tp))[0]) #define Trap_link(tp) (((value **)(tp))[1]) diff --git a/byterun/startup.c b/byterun/startup.c index 9ac9a2100f..9f7840ad47 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -30,6 +30,7 @@ #include "callback.h" #include "custom.h" #include "debugger.h" +#include "dynlink.h" #include "exec.h" #include "fail.h" #include "fix_code.h" @@ -42,6 +43,7 @@ #include "minor_gc.h" #include "misc.h" #include "mlvalues.h" +#include "osdeps.h" #include "prims.h" #include "printexc.h" #include "reverse.h" @@ -58,7 +60,7 @@ #define SEEK_END 2 #endif -header_t atom_table[256]; +CAMLexport header_t atom_table[256]; /* Initialize the atom table */ @@ -97,8 +99,8 @@ int attempt_open(char **name, struct exec_trailer *trail, int err; char buf [2]; - truename = searchpath(*name); - if (truename == 0) truename = *name; else *name = truename; + truename = search_exe_in_path(*name); + *name = truename; gc_message(0x100, "Opening bytecode executable %s\n", (unsigned long) truename); fd = open(truename, O_RDONLY | O_BINARY); @@ -170,28 +172,21 @@ int32 seek_section(int fd, struct exec_trailer *trail, char *name) return len; } -/* Check the primitives used by the bytecode file against the table of - primitives linked in this interpreter */ +/* Read and return the contents of the section having the given name. + Add a terminating 0. Return NULL if no such section. */ -static void check_primitives(int fd, int prim_size) +static char * read_section(int fd, struct exec_trailer *trail, char *name) { - char * prims = stat_alloc(prim_size); - char * p; - int idx; - - if (read(fd, prims, prim_size) != prim_size) - fatal_error("Fatal error: cannot read primitive table\n"); - /* prims contains 0-terminated strings, concatenated. */ - for (p = prims, idx = 0; - p < prims + prim_size; - p = p + strlen(p) + 1, idx++) { - if (names_of_cprim[idx] == NULL || - strcmp(p, names_of_cprim[idx]) != 0) - fatal_error_arg("Fatal error: this bytecode file cannot run " - "on this bytecode interpreter\n" - "Mismatch on primitive `%s'\n", p); - } - stat_free(prims); + int32 len; + char * data; + + len = seek_optional_section(fd, trail, name); + if (len == -1) return NULL; + data = stat_alloc(len + 1); + if (read(fd, data, len) != len) + fatal_error_arg("Fatal error: error reading section %s\n", name); + data[len] = 0; + return data; } /* Invocation of ocamlrun: 4 cases. @@ -249,13 +244,19 @@ static int parse_command_line(char **argv) verb_gc = 1+4+8+16+32; break; case 'p': - for (j = 0; names_of_cprim[j] != NULL; j++) - printf("%s\n", names_of_cprim[j]); + for (j = 0; names_of_builtin_cprim[j] != NULL; j++) + printf("%s\n", names_of_builtin_cprim[j]); exit(0); break; case 'b': backtrace_active = 1; break; + case 'I': + if (argv[i + 1] != NULL) { + ext_table_add(&shared_libs_path, argv[i + 1]); + i++; + } + break; default: fatal_error_arg("Unknown option %s.\n", argv[i]); } @@ -308,18 +309,20 @@ extern void caml_signal_thread(void * lpParam); /* Main entry point when loading code from a file */ -void caml_main(char **argv) +CAMLexport void caml_main(char **argv) { int fd, pos; struct exec_trailer trail; asize_t prog_size; struct channel * chan; value res; + char * shared_lib_path, * shared_libs, * req_prims; /* 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(); + ext_table_init(&shared_libs_path, 8); external_raise = NULL; /* Determine options and position of bytecode file */ #ifdef DEBUG @@ -358,8 +361,15 @@ void caml_main(char **argv) /* Load the code */ code_size = seek_section(fd, &trail, "CODE"); load_code(fd, code_size); - /* Check the primitives */ - check_primitives(fd, seek_section(fd, &trail, "PRIM")); + /* Build the table of primitives */ + shared_lib_path = read_section(fd, &trail, "DLPT"); + shared_libs = read_section(fd, &trail, "DLLS"); + req_prims = read_section(fd, &trail, "PRIM"); + if (req_prims == NULL) fatal_error("Fatal error: no PRIM section\n"); + build_primitive_table(shared_lib_path, shared_libs, req_prims); + stat_free(shared_lib_path); + stat_free(shared_libs); + stat_free(req_prims); /* Load the globals */ seek_section(fd, &trail, "DATA"); chan = open_descriptor(fd); @@ -391,7 +401,8 @@ void caml_main(char **argv) /* Main entry point when code is linked in as initialized data */ -void caml_startup_code(code_t code, asize_t code_size, char *data, char **argv) +CAMLexport void caml_startup_code(code_t code, asize_t code_size, + char *data, char **argv) { value res; @@ -413,6 +424,9 @@ void caml_startup_code(code_t code, asize_t code_size, char *data, char **argv) #ifdef THREADED_CODE thread_code(start_code, code_size); #endif + /* Use the builtin table of primitives */ + prim_table.size = prim_table.capacity = -1; + prim_table.contents = (void **) builtin_cprim; /* Load the globals */ global_data = input_val_from_string((value)data, 0); /* Ensure that the globals are in the major heap. */ diff --git a/byterun/startup.h b/byterun/startup.h index 86379c7286..93d55f843f 100644 --- a/byterun/startup.h +++ b/byterun/startup.h @@ -4,9 +4,9 @@ #include "misc.h" #include "exec.h" -extern void caml_main(char **argv); -extern void caml_startup_code(code_t code, asize_t code_size, - char *data, char **argv); +CAMLextern void caml_main(char **argv); +CAMLextern void caml_startup_code(code_t code, asize_t code_size, + char *data, char **argv); enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2 }; diff --git a/byterun/str.c b/byterun/str.c index 51ff4aa9f6..65467e5984 100644 --- a/byterun/str.c +++ b/byterun/str.c @@ -24,7 +24,7 @@ #include <locale.h> #endif -mlsize_t string_length(value s) +CAMLexport mlsize_t string_length(value s) { mlsize_t temp; temp = Bosize_val(s) - 1; @@ -32,7 +32,7 @@ mlsize_t string_length(value s) return temp - Byte (s, temp); } -value ml_string_length(value s) /* ML */ +CAMLprim value ml_string_length(value s) { mlsize_t temp; temp = Bosize_val(s) - 1; @@ -40,21 +40,21 @@ value ml_string_length(value s) /* ML */ return Val_long(temp - Byte (s, temp)); } -value create_string(value len) /* ML */ +CAMLprim value create_string(value len) { mlsize_t size = Long_val(len); if (size > Bsize_wsize (Max_wosize) - 1) invalid_argument("String.create"); return alloc_string(size); } -value string_get(value str, value index) /* ML */ +CAMLprim value string_get(value str, value index) { long idx = Long_val(index); if (idx < 0 || idx >= string_length(str)) invalid_argument("String.get"); return Val_int(Byte_u(str, idx)); } -value string_set(value str, value index, value newval) /* ML */ +CAMLprim value string_set(value str, value index, value newval) { long idx = Long_val(index); if (idx < 0 || idx >= string_length(str)) invalid_argument("String.set"); @@ -62,7 +62,7 @@ value string_set(value str, value index, value newval) /* ML */ return Val_unit; } -value string_equal(value s1, value s2) /* ML */ +CAMLprim value string_equal(value s1, value s2) { mlsize_t sz1 = Wosize_val(s1); mlsize_t sz2 = Wosize_val(s2); @@ -73,18 +73,18 @@ value string_equal(value s1, value s2) /* ML */ return Val_true; } -value string_notequal(value s1, value s2) /* ML */ +CAMLprim value string_notequal(value s1, value s2) { return Val_not(string_equal(s1, s2)); } -value blit_string(value s1, value ofs1, value s2, value ofs2, value n) /* ML */ +CAMLprim value blit_string(value s1, value ofs1, value s2, value ofs2, value n) { memmove(&Byte(s2, Long_val(ofs2)), &Byte(s1, Long_val(ofs1)), Int_val(n)); return Val_unit; } -value fill_string(value s, value offset, value len, value init) /* ML */ +CAMLprim value fill_string(value s, value offset, value len, value init) { register char * p; register mlsize_t n; @@ -97,7 +97,7 @@ value fill_string(value s, value offset, value len, value init) /* ML */ return Val_unit; } -value is_printable(value chr) /* ML */ +CAMLprim value is_printable(value chr) { int c; @@ -124,7 +124,7 @@ value is_printable(value chr) /* ML */ #endif } -value bitvect_test(value bv, value n) /* ML */ +CAMLprim value bitvect_test(value bv, value n) { int pos = Int_val(n); return Val_int(Byte_u(bv, pos >> 3) & (1 << (pos & 7))); diff --git a/byterun/sys.c b/byterun/sys.c index 179885c0c6..0677129bb9 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -53,11 +53,15 @@ #include "ui.h" #endif +#ifndef _WIN32 extern int errno; +#endif #ifdef HAS_STRERROR +#ifndef _WIN32 extern char * strerror(int); +#endif char * error_message(void) { @@ -86,7 +90,7 @@ char * error_message(void) #define EWOULDBLOCK (-1) #endif -void sys_error(value arg) +CAMLexport void sys_error(value arg) { CAMLparam1 (arg); char * err; @@ -110,7 +114,7 @@ void sys_error(value arg) } } -value sys_exit(value retcode) /* ML */ +CAMLprim value sys_exit(value retcode) { #ifndef NATIVE_CODE debugger(PROGRAM_EXIT); @@ -142,7 +146,7 @@ static int sys_open_flags[] = { O_BINARY, O_TEXT, O_NONBLOCK }; -value sys_open(value path, value flags, value perm) /* ML */ +CAMLprim value sys_open(value path, value flags, value perm) { int ret; ret = open(String_val(path), convert_flag_list(flags, sys_open_flags) @@ -154,13 +158,13 @@ value sys_open(value path, value flags, value perm) /* ML */ return Val_long(ret); } -value sys_close(value fd) /* ML */ +CAMLprim value sys_close(value fd) { close(Int_val(fd)); return Val_unit; } -value sys_file_exists(value name) /* ML */ +CAMLprim value sys_file_exists(value name) { #if macintosh int f; @@ -174,7 +178,7 @@ value sys_file_exists(value name) /* ML */ #endif } -value sys_remove(value name) /* ML */ +CAMLprim value sys_remove(value name) { int ret; ret = unlink(String_val(name)); @@ -182,20 +186,20 @@ value sys_remove(value name) /* ML */ return Val_unit; } -value sys_rename(value oldname, value newname) /* ML */ +CAMLprim value sys_rename(value oldname, value newname) { if (rename(String_val(oldname), String_val(newname)) != 0) sys_error(oldname); return Val_unit; } -value sys_chdir(value dirname) /* ML */ +CAMLprim value sys_chdir(value dirname) { if (chdir(String_val(dirname)) != 0) sys_error(dirname); return Val_unit; } -value sys_getcwd(value unit) /* ML */ +CAMLprim value sys_getcwd(value unit) { char buff[4096]; #ifdef HAS_GETCWD @@ -206,7 +210,7 @@ value sys_getcwd(value unit) /* ML */ return copy_string(buff); } -value sys_getenv(value var) /* ML */ +CAMLprim value sys_getenv(value var) { char * res; @@ -217,7 +221,7 @@ value sys_getenv(value var) /* ML */ char ** caml_main_argv; -value sys_get_argv(value unit) /* ML */ +CAMLprim value sys_get_argv(value unit) { return copy_string_array((char const **) caml_main_argv); } @@ -237,7 +241,7 @@ void sys_init(char **argv) extern int win32_system(char * command); #endif -value sys_system_command(value command) /* ML */ +CAMLprim value sys_system_command(value command) { int status, retcode; @@ -256,7 +260,7 @@ value sys_system_command(value command) /* ML */ return Val_int(retcode); } -value sys_time(value unit) /* ML */ +CAMLprim value sys_time(value unit) { #ifdef HAS_TIMES #ifndef CLK_TCK @@ -275,7 +279,7 @@ value sys_time(value unit) /* ML */ #endif } -value sys_random_seed (value unit) /* ML */ +CAMLprim value sys_random_seed (value unit) { #ifdef HAS_GETTIMEOFDAY struct timeval tv; @@ -286,7 +290,7 @@ value sys_random_seed (value unit) /* ML */ #endif } -value sys_get_config(value unit) /* ML */ +CAMLprim value sys_get_config(value unit) { CAMLparam0 (); /* unit is unused */ CAMLlocal2 (result, ostype); @@ -298,93 +302,3 @@ value sys_get_config(value unit) /* ML */ CAMLreturn (result); } -/* Search path function */ -/* For Win32: defined in win32.c */ -/* For MacOS: defined in macintosh.c */ - -#if !defined(_WIN32) && !defined(macintosh) - -#ifndef S_ISREG -#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) -#endif - -#ifndef __CYGWIN32__ - -char * searchpath(char * name) -{ - char * fullname; - char * path; - char * p; - char * q; - struct stat st; - - for (p = name; *p != 0; p++) { - if (*p == '/') return name; - } - path = getenv("PATH"); - if (path == NULL) return 0; - fullname = stat_alloc(strlen(name) + strlen(path) + 2); - while(1) { - for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path; - if (p != fullname) *p++ = '/'; - for (q = name; *q != 0; p++, q++) *p = *q; - *p = 0; - if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) break; - if (*path == 0) return 0; - path++; - } - return fullname; -} - -#else - -/* Cygwin needs special treatment because of the implicit ".exe" at the - end of executable file names */ - -static int searchpath_file_ok(char * name) -{ - int fd; - /* Cannot use stat() here because it adds ".exe" implicitly */ - fd = open(name, O_RDONLY); - if (fd == -1) return 0; - close(fd); - return 1; -} - -char * searchpath(char * name) -{ - char * path, * fullname, * p; - - path = getenv("PATH"); - fullname = malloc(strlen(name) + (path == NULL ? 0 : strlen(path)) + 6); - /* 6 = "/" plus ".exe" plus final "\0" */ - if (fullname == NULL) return name; - /* Check for absolute path name */ - for (p = name; *p != 0; p++) { - if (*p == '/' || *p == '\\') { - if (searchpath_file_ok(name)) return name; - strcpy(fullname, name); - strcat(fullname, ".exe"); - if (searchpath_file_ok(name)) return fullname; - return name; - } - } - /* Search in path */ - if (path == NULL) return 0; - while(1) { - for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path; - if (p != fullname) *p++ = '/'; - strcpy(p, name); - if (searchpath_file_ok(fullname)) return fullname; - strcat(fullname, ".exe"); - if (searchpath_file_ok(fullname)) return fullname; - if (*path == 0) break; - path++; - } - return 0; -} - -#endif /* __CYGWIN32__ */ - -#endif /* _WIN32, macintosh, ... */ - diff --git a/byterun/sys.h b/byterun/sys.h index b5a1f32776..0502efb742 100644 --- a/byterun/sys.h +++ b/byterun/sys.h @@ -19,10 +19,9 @@ #define NO_ARG Val_int(0) -extern void sys_error (value); +CAMLextern void sys_error (value); extern void sys_init (char **); -extern value sys_exit (value); -extern char * searchpath (char * name); +CAMLextern value sys_exit (value); extern char ** caml_main_argv; diff --git a/byterun/terminfo.c b/byterun/terminfo.c index 2f648ad715..d930a2d758 100644 --- a/byterun/terminfo.c +++ b/byterun/terminfo.c @@ -40,7 +40,7 @@ static char *down = NULL; static char *standout = NULL; static char *standend = NULL; -value terminfo_setup (value vchan) /* ML */ +CAMLprim value terminfo_setup (value vchan) { value result; static char buffer[1024]; @@ -74,7 +74,7 @@ static int terminfo_putc (int c) return c; } -value terminfo_backup (value lines) /* ML */ +CAMLprim value terminfo_backup (value lines) { int i; @@ -84,13 +84,13 @@ value terminfo_backup (value lines) /* ML */ return Val_unit; } -value terminfo_standout (value start) /* ML */ +CAMLprim value terminfo_standout (value start) { tputs (Bool_val (start) ? standout : standend, 1, terminfo_putc); return Val_unit; } -value terminfo_resume (value lines) /* ML */ +CAMLprim value terminfo_resume (value lines) { int i; @@ -102,24 +102,24 @@ value terminfo_resume (value lines) /* ML */ #else /* defined (HAS_TERMCAP) && !defined (NATIVE_CODE) */ -value terminfo_setup (value vchan) +CAMLexport value terminfo_setup (value vchan) { return Bad_term; } -value terminfo_backup (value lines) +CAMLexport value terminfo_backup (value lines) { invalid_argument("Terminfo.backup"); return Val_unit; } -value terminfo_standout (value start) +CAMLexport value terminfo_standout (value start) { invalid_argument("Terminfo.standout"); return Val_unit; } -value terminfo_resume (value lines) +CAMLexport value terminfo_resume (value lines) { invalid_argument("Terminfo.resume"); return Val_unit; diff --git a/byterun/unix.c b/byterun/unix.c new file mode 100644 index 0000000000..5926391b18 --- /dev/null +++ b/byterun/unix.c @@ -0,0 +1,198 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Unix-specific stuff */ + +#include <stddef.h> +#include <stdlib.h> +#include <string.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <fcntl.h> +#include "config.h" +#ifdef SUPPORT_DYNAMIC_LINKING +#include <dlfcn.h> +#endif +#include "memory.h" +#include "misc.h" +#include "osdeps.h" + +#ifndef S_ISREG +#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) +#endif + +char * decompose_path(struct ext_table * tbl, char * path) +{ + char * p, * q; + int n; + + if (path == NULL) return NULL; + p = stat_alloc(strlen(path) + 1); + strcpy(p, path); + q = p; + while (1) { + for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/; + ext_table_add(tbl, q); + q = q + n; + if (*q == 0) break; + *q = 0; + q += 1; + } + return p; +} + +char * search_in_path(struct ext_table * path, char * name) +{ + char * p, * fullname; + int i; + struct stat st; + + for (p = name; *p != 0; p++) { + if (*p == '/') goto not_found; + } + for (i = 0; i < path->size; i++) { + fullname = stat_alloc(strlen((char *)(path->contents[i])) + + strlen(name) + 2); + strcpy(fullname, (char *)(path->contents[i])); + if (fullname[0] != 0) strcat(fullname, "/"); + strcat(fullname, name); + if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname; + stat_free(fullname); + } + not_found: + fullname = stat_alloc(strlen(name) + 1); + strcpy(fullname, name); + return fullname; +} + +#ifdef __CYGWIN32__ + +/* Cygwin needs special treatment because of the implicit ".exe" at the + end of executable file names */ + +static int cygwin_file_exists(char * name) +{ + int fd; + /* Cannot use stat() here because it adds ".exe" implicitly */ + fd = open(name, O_RDONLY); + if (fd == -1) return 0; + close(fd); + return 1; +} + +static char * cygwin_search_exe_in_path(struct ext_table * path, char * name) +{ + char * p, * fullname; + int i; + + for (p = name; *p != 0; p++) { + if (*p == '/' || *p == '\\') goto not_found; + } + for (i = 0; i < path->size; i++) { + fullname = stat_alloc(strlen((char *)(path->contents[i])) + + strlen(name) + 6); + strcpy(fullname, (char *)(path->contents[i])); + strcat(fullname, "/"); + strcat(fullname, name); + if (cygwin_file_exists(fullname)) return fullname; + strcat(fullname, ".exe"); + if (cygwin_file_exists(fullname)) return fullname; + stat_free(fullname); + } + not_found: + fullname = stat_alloc(strlen(name) + 5); + strcpy(fullname, name); + if (cygwin_file_exists(fullname)) return fullname; + strcat(fullname, ".exe"); + if (cygwin_file_exists(fullname)) return fullname; + strcpy(fullname, name); + return fullname; +} + +#endif + +char * search_exe_in_path(char * name) +{ + struct ext_table path; + char * tofree; + char * res; + + ext_table_init(&path, 8); + tofree = decompose_path(&path, getenv("PATH")); +#ifndef __CYGWIN32__ + res = search_in_path(&path, name); +#else + res = cygwin_search_exe_in_path(&path, name); +#endif + stat_free(tofree); + ext_table_free(&path, 0); + return res; +} + +char * search_dll_in_path(struct ext_table * path, char * name) +{ + char * dllname = stat_alloc(strlen(name) + 4); + char * res; + strcpy(dllname, name); + strcat(dllname, ".so"); + res = search_in_path(path, dllname); + stat_free(dllname); + return res; +} + +#ifdef SUPPORT_DYNAMIC_LINKING + +void * caml_dlopen(char * libname) +{ + return dlopen(libname, RTLD_NOW); +} + +void caml_dlclose(void * handle) +{ + dlclose(handle); +} + +void * caml_dlsym(void * handle, char * name) +{ + return dlsym(handle, name); +} + +char * caml_dlerror(void) +{ + return dlerror(); +} + +#else + +void * caml_dlopen(char * libname) +{ + return NULL; +} + +void caml_dlclose(void * handle) +{ +} + +void * caml_dlsym(void * handle, char * name) +{ + return NULL; +} + +char * caml_dlerror(void) +{ + return "dynamic loading not supported on this platform"; +} + +#endif + diff --git a/byterun/weak.c b/byterun/weak.c index 7288188454..a192edca80 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -23,7 +23,7 @@ value weak_list_head = 0; -value weak_create (value len) /* ML */ +CAMLprim value weak_create (value len) { mlsize_t size, i; value res; @@ -40,7 +40,7 @@ value weak_create (value len) /* ML */ #define None_val (Val_int(0)) #define Some_tag 0 -value weak_set (value ar, value n, value el) /* ML */ +CAMLprim value weak_set (value ar, value n, value el) { mlsize_t offset = Long_val (n) + 1; Assert (Is_in_heap (ar)); @@ -55,7 +55,7 @@ value weak_set (value ar, value n, value el) /* ML */ #define Setup_for_gc #define Restore_after_gc -value weak_get (value ar, value n) /* ML */ +CAMLprim value weak_get (value ar, value n) { CAMLparam2 (ar, n); mlsize_t offset = Long_val (n) + 1; @@ -76,7 +76,7 @@ value weak_get (value ar, value n) /* ML */ #undef Setup_for_gc #undef Restore_after_gc -value weak_get_copy (value ar, value n) /* ML */ +CAMLprim value weak_get_copy (value ar, value n) { CAMLparam2 (ar, n); mlsize_t offset = Long_val (n) + 1; @@ -104,7 +104,7 @@ value weak_get_copy (value ar, value n) /* ML */ CAMLreturn (res); } -value weak_check (value ar, value n) /* ML */ +CAMLprim value weak_check (value ar, value n) { mlsize_t offset = Long_val (n) + 1; Assert (Is_in_heap (ar)); diff --git a/byterun/win32.c b/byterun/win32.c index ed12a84a2d..44eb2bec8f 100644 --- a/byterun/win32.c +++ b/byterun/win32.c @@ -26,25 +26,118 @@ #include <ctype.h> #include <string.h> #include <signal.h> +#include "memory.h" +#include "misc.h" +#include "osdeps.h" #include "signals.h" -/* Path searching function */ +#ifndef S_ISREG +#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) +#endif + +char * decompose_path(struct ext_table * tbl, char * path) +{ + char * p, * q; + int n; + + if (path == NULL) return NULL; + p = stat_alloc(strlen(path) + 1); + strcpy(p, path); + q = p; + while (1) { + for (n = 0; q[n] != 0 && q[n] != ';'; n++) /*nothing*/; + ext_table_add(tbl, q); + q = q + n; + if (*q == 0) break; + *q = 0; + q += 1; + } + return p; +} -char * searchpath(char * name) +char * search_in_path(struct ext_table * path, char * name) { -#define MAX_PATH_LENGTH 1024 - static char fullname[MAX_PATH_LENGTH]; + char * p, * fullname; + int i; + struct stat st; + + for (p = name; *p != 0; p++) { + if (*p == '/' || *p == '\\') goto not_found; + } + for (i = 0; i < path->size; i++) { + fullname = stat_alloc(strlen((char *)(path->contents[i])) + + strlen(name) + 2); + strcpy(fullname, (char *)(path->contents[i])); + strcat(fullname, "\\"); + strcat(fullname, name); + gc_message(0x100, "Searching %s\n", (unsigned long) fullname); + if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname; + stat_free(fullname); + } + not_found: + gc_message(0x100, "%s not found in search path\n", (unsigned long) name); + fullname = stat_alloc(strlen(name) + 1); + strcpy(fullname, name); + return fullname; +} + +CAMLexport char * search_exe_in_path(char * name) +{ +#define MAX_PATH_LENGTH 512 + char * fullname = stat_alloc(512); char * filepart; - if (SearchPath(NULL, /* use system search path */ - name, - ".exe", /* add .exe extension if needed */ - MAX_PATH_LENGTH, /* size of buffer */ - fullname, - &filepart)) - return fullname; + if (! SearchPath(NULL, /* use system search path */ + name, + ".exe", /* add .exe extension if needed */ + MAX_PATH_LENGTH, /* size of buffer */ + fullname, + &filepart)) + strcpy(fullname, name); + return fullname; +} + +char * search_dll_in_path(struct ext_table * path, char * name) +{ + char * dllname = stat_alloc(strlen(name) + 5); + char * res; + strcpy(dllname, name); + strcat(dllname, ".dll"); + res = search_in_path(path, dllname); + stat_free(dllname); + return res; +} + +void * caml_dlopen(char * libname) +{ + return (void *) LoadLibrary(libname); +} + +void caml_dlclose(void * handle) +{ + FreeLibrary((HMODULE) handle); +} + +void * caml_dlsym(void * handle, char * name) +{ + return (void *) GetProcAddress((HMODULE) handle, name); +} + +char * caml_dlerror(void) +{ + static char dlerror_buffer[256]; + DWORD msglen = + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, /* message source */ + GetLastError(), /* error number */ + 0, /* default language */ + dlerror_buffer, /* destination */ + sizeof(dlerror_buffer), /* size of destination */ + NULL); /* no inserts */ + if (msglen == 0) + return "unknown error"; else - return name; + return dlerror_buffer; } /* Expansion of @responsefile and *? file patterns in the command line */ @@ -138,7 +231,7 @@ static void expand_diversion(char * filename) } } -void expand_command_line(int * argcp, char *** argvp) +CAMLexport void expand_command_line(int * argcp, char *** argvp) { int i; argc = 0; @@ -156,8 +249,6 @@ void expand_command_line(int * argcp, char *** argvp) /* Wrapper around "system" for Win32. Create a diversion file if command line is too long. */ -extern char * mktemp(char *); - int win32_system(char * cmdline) { #define MAX_CMD_LENGTH 256 diff --git a/config/Makefile-templ b/config/Makefile-templ index 191c2fa2a6..acb6610e23 100644 --- a/config/Makefile-templ +++ b/config/Makefile-templ @@ -54,7 +54,10 @@ SHARPBANGSCRIPTS=true ### Additional link-time options for $(BYTECC) ### If using GCC on a Dec Alpha under OSF1: -#BYTECCLINKOPTS=-Xlinker -taso +#BYTECCLINKOPTS=-Wl,-T,12000000 -Wl,-D,14000000 +# To support dynamic loading of shared libraries (they need to look at +# our own symbols): +#BYTECCLINKOPTS=-Wl,-E # Otherwise: #BYTECCLINKOPTS= @@ -79,6 +82,22 @@ SHARPBANGSCRIPTS=true #RANLIB=ar rs #RANLIBCMD= +### Shared library support +# Extension for shared libraries: so if supported, a if not supported +#SO=so +#SO=a +# Set to nothing if shared libraries supported, and to -custom if not supported +#CUSTOM_IF_NOT_SHARED= +#CUSTOM_IF_NOT_SHARED=-custom +# Options to $(BYTECC) to produce shared objects (e.g. PIC) +#SHAREDCCCOMPOPTS=-fPIC +# How to build a shared library, invoked with output .so as first arg +# and object files as remaining args +#MKSHAREDLIB=gcc -shared -o +# Compile-time option to $(BYTECC) to add a directory to be searched +# at run-time for shared libraries +#BYTECCRPATH=-Wl,-rpath + ############# Configuration for the native-code compiler ### Name of architecture for the native-code compiler @@ -159,6 +178,10 @@ SHARPBANGSCRIPTS=true ### Additional link-time options for $(NATIVECC) #NATIVECCLINKOPTS= +# Compile-time option to $(NATIVECC) to add a directory to be searched +# at run-time for shared libraries +#NATIVECCRPATH=-Wl,-rpath + ### Flags for the assembler # For the Alpha or the Mips: #ASFLAGS=-O2 @@ -234,9 +257,9 @@ BIGNUM_ARCH=alpha ### Link-time options to ocamlc or ocamlopt for linking with X11 libraries # Needed for the "graph" and "labltk" packages # Usually: -#X11_LINK=-cclib -lX11 +#X11_LINK=-lX11 # For SunOS with OpenLook: -#X11_LINK=-cclib -L$(X11_LIB) -cclib -lX11 +#X11_LINK=-L$(X11_LIB) -lX11 ### -I options for finding the include file ndbm.h # Needed for the "dbm" package diff --git a/config/Makefile.nt b/config/Makefile.nt index 183d7285cb..5b18c2d0f3 100644 --- a/config/Makefile.nt +++ b/config/Makefile.nt @@ -35,12 +35,15 @@ SYSTEM_INCLUDES=c:\Msdev\VC98\Include ### Which C compiler to use for the bytecode interpreter. BYTECC=cl /nologo -### Additional compile-time options for $(BYTECC). +### Additional compile-time options for $(BYTECC). (For static linking.) BYTECCCOMPOPTS=/Ox /MT -### Additional link-time options for $(BYTECC) +### Additional link-time options for $(BYTECC). (For static linking.) BYTECCLINKOPTS=/MT +### Additional compile-time options for $(BYTECC). (For building a DLL.) +DLLCCCOMPOPTS=/Ox /MD + ### Libraries needed BYTECCLIBS=wsock32.lib NATIVECCLIBS=wsock32.lib @@ -50,6 +53,7 @@ CPP=cl /nologo /EP ### How to invoke the librarian MKLIB=lib /nologo /debugtype:CV /out: +MKDLL=cl /nologo /MD /LD ############# Configuration for the native-code compiler @@ -77,7 +81,7 @@ AFLAGS=/coff /Cp ############# Configuration for the contributed libraries -OTHERLIBRARIES=win32unix systhreads str num graph dynlink labltk bigarray +OTHERLIBRARIES=win32unix systhreads str num graph dynlink bigarray #labltk ### Name of the target architecture for the "num" library BIGNUM_ARCH=C diff --git a/config/auto-aux/solaris-ld b/config/auto-aux/solaris-ld new file mode 100644 index 0000000000..3ab90bceff --- /dev/null +++ b/config/auto-aux/solaris-ld @@ -0,0 +1,7 @@ +#!/bin/sh +# Determine if gcc calls the Solaris ld or the GNU ld +# Exit code is 0 for Solaris ld, 1 for GNU ld + +echo "int main() { return 0; }" > hasgot.c +$cc -v -o tst hasgot.c 2>&1 | grep -s '^ld:' > /dev/null +exit $? diff --git a/config/s-templ.h b/config/s-templ.h index 3e6617df63..db50afe9b3 100644 --- a/config/s-templ.h +++ b/config/s-templ.h @@ -50,6 +50,11 @@ /* Define HAS_STRERROR if you have strerror(). */ +#define SUPPORT_DYNAMIC_LINKING + +/* Define SUPPORT_DYNAMIC_LINKING if dynamic loading of C stub code + via dlopen() is available. */ + /* 2. For the Unix library. */ #define HAS_SOCKETS @@ -25,6 +25,7 @@ ccoption='' cclibs='' curseslibs='' mathlib='-lm' +dllib='' x11_include_dir='' x11_lib_dir='' tk_defs='' @@ -32,6 +33,7 @@ tk_libs='' posix_threads=no verbose=no withcurses=yes +withsharedlibs=yes gcc_warnings="-Wall -Wno-unused" @@ -56,7 +58,10 @@ while : ; do ccoption="$2"; shift;; -lib*) cclibs="$2 $cclibs"; shift;; - -no-curses) withcurses=no;; + -no-curses) + withcurses=no;; + -no-shared-libs) + withsharedlibs=no;; -x11include*|--x11include*) x11_include_dir=$2; shift;; -x11lib*|--x11lib*) @@ -354,6 +359,61 @@ if $int64_supported; then esac fi +# Shared library support + +shared_libraries_supported=false +sharedcccompopts='' +mksharedlib='' +byteccrpath='' + +if test $withsharedlibs = "yes"; then + case "$host" in + *-*-linux-gnu|*-*-linux|*-*-freebsd[3-9]*) + sharedcccompopts="-fPIC" + mksharedlib="gcc -shared -o" + bytecclinkopts="$bytecclinkopts -Wl,-E" + byteccrpath="-Wl,-rpath," + shared_libraries_supported=true;; + alpha*-*-osf*) + case "$bytecc" in + cc*) sharedcccompopts="";; + gcc*) sharedcccompopts="-fPIC";; + esac + mksharedlib="ld -shared -expect_unresolved '*' -o" + byteccrpath="-Wl,-rpath," + shared_libraries_supported=true;; + sparc-sun-solaris2*) + case "$bytecc" in + gcc*) + if sh ./solaris-ld; then :; else + sharedcccompopts="-fPIC" + mksharedlib="$bytecc -shared -o" + bytecclinkopts="$bytecclinkopts -Wl,-E" + byteccrpath="-Wl,-rpath,"; + shared_libraries_supported=true + fi;; + *) + sharedcccompopts="-KPIC" + byteccrpath="-Wl,-R," + mksharedlib="/usr/ccs/bin/ld -G -o" + shared_libraries_supported=true;; + esac;; + mips-sgi-irix[56]*) + case "$bytecc" in + cc*) sharedcccompopts="";; + gcc*) sharedcccompopts="-fPIC";; + esac + mksharedlib="ld -shared -rdata_shared -o" + byteccrpath="-Wl,-rpath," + shared_libraries_supported=true;; + esac +fi + +if $shared_libraries_supported; then + echo "Dynamic loading of shared libraries is supported." + echo "#define SUPPORT_DYNAMIC_LINKING" >> s.h +fi + # Configure the native-code compiler arch=none @@ -400,6 +460,7 @@ fi nativecccompopts='' nativecclinkopts='' +nativeccrpath="$byteccrpath" case "$arch,$nativecc,$system,$host_type" in alpha,cc*,digital,*) nativecccompopts=-std1;; @@ -493,6 +554,7 @@ fi # Write the OS type (Unix or Cygwin) echo "#define OCAML_OS_TYPE \"$ostype\"" >> s.h +echo "#define OCAML_STDLIB_DIR \"$libdir\"" >> s.h # Check the semantics of signal handlers @@ -804,18 +866,18 @@ if test "$posix_threads" = "yes"; then nativecccompopts="$nativecccompopts -D_REENTRANT" case "$host" in *-*-solaris*) - pthread_link="-cclib -lpthread -cclib -lposix4";; + pthread_link="-lpthread -lposix4";; *-*-freebsd*) - pthread_link="-ccopt -pthread" + pthread_link="-pthread" bytecccompopts="$bytecccompopts -D_THREAD_SAFE" nativecccompopts="$nativecccompopts -D_THREAD_SAFE";; *-*-openbsd*) - pthread_link="-ccopt -pthread" + pthread_link="-pthread" bytecccompopts="$bytecccompopts -pthread" asppflags="$asppflags -pthread" nativecccompopts="$nativecccompopts -pthread";; *) - pthread_link="-cclib -lpthread";; + pthread_link="-lpthread";; esac echo "Options for linking with POSIX threads: $pthread_link" echo "PTHREAD_LINK=$pthread_link" >> Makefile @@ -868,9 +930,9 @@ do test -f $dir/libX11.so || \ test -f $dir/libX11.sa; then if test $dir = /usr/lib; then - x11_link="-cclib -lX11" + x11_link="-lX11" else - x11_link="-ccopt -L$dir -cclib -lX11" + x11_link="-L$dir -lX11" x11_libs="-L$dir" fi break @@ -905,9 +967,9 @@ for dir in /usr/include /usr/include/gdbm /usr/include/db1; do if sh ./hasgot dbm_open; then dbm_link="" elif sh ./hasgot -lndbm dbm_open; then - dbm_link="-cclib -lndbm" + dbm_link="-lndbm" elif sh ./hasgot -ldb1 dbm_open; then - dbm_link="-cclib -ldb1" + dbm_link="-ldb1" else dbm_include="not found" fi @@ -1020,7 +1082,6 @@ if test $has_tk = true; then fi if test $has_tk = true; then - tk_libs=`echo $tk_libs | sed -e 's/-l/-cclib &/g' -e 's/-[LW]/-ccopt &/g' ` echo "TK_DEFS=$tk_defs" >> Makefile echo "TK_LINK=$tk_libs" >> Makefile otherlibraries="$otherlibraries labltk" @@ -1035,8 +1096,12 @@ cclibs="$cclibs $mathlib" echo "BYTECC=$bytecc" >> Makefile echo "BYTECCCOMPOPTS=$bytecccompopts" >> Makefile echo "BYTECCLINKOPTS=$bytecclinkopts" >> Makefile -echo "BYTECCLIBS=$cclibs $curseslibs" >> Makefile +echo "BYTECCLIBS=$cclibs $dllib $curseslibs" >> Makefile +echo "BYTECCRPATH=$byteccrpath" >> Makefile echo "EXE=$exe" >> Makefile +echo "SUPPORTS_SHARED_LIBRARIES=$shared_libraries_supported" >> Makefile +echo "SHAREDCCCOMPOPTS=$sharedcccompopts" >> Makefile +echo "MKSHAREDLIB=$mksharedlib" >> Makefile echo "ARCH=$arch" >> Makefile echo "MODEL=$model" >> Makefile @@ -1044,6 +1109,7 @@ echo "SYSTEM=$system" >> Makefile echo "NATIVECC=$nativecc" >> Makefile echo "NATIVECCCOMPOPTS=$nativecccompopts" >> Makefile echo "NATIVECCLINKOPTS=$nativecclinkopts" >> Makefile +echo "NATIVECCRPATH=$nativeccrpath" >> Makefile echo "NATIVECCLIBS=$cclibs" >> Makefile echo "ASFLAGS=$asflags" >> Makefile echo "ASPP=$aspp" >> Makefile @@ -1072,7 +1138,14 @@ echo " manual pages.............. $mandir (with extension .$manext)" echo "Configuration for the bytecode compiler:" echo " C compiler used........... $bytecc" echo " options for compiling..... $bytecccompopts" -echo " options for linking....... $bytecclinkopts $cclibs $curseslibs" +echo " options for linking....... $bytecclinkopts $cclibs $dllib $curseslibs" +if $shared_libraries_supported; then +echo " shared libraries are supported" +echo " options for compiling..... $sharedcccompopts $bytecccompopts" +echo " command for building...... $mksharedlib <target>.so <objects>" +else +echo " shared libraries not supported" +fi echo "Configuration for the native-code compiler:" if test "$arch" = "none"; then diff --git a/debugger/.depend b/debugger/.depend index 24873d12fc..4931c88c35 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -9,8 +9,8 @@ events.cmi: ../bytecomp/instruct.cmi frames.cmi: ../bytecomp/instruct.cmi primitives.cmi input_handling.cmi: primitives.cmi loadprinter.cmi: ../otherlibs/dynlink/dynlink.cmi ../parsing/longident.cmi -parser.cmi: ../parsing/longident.cmi parser_aux.cmi parser_aux.cmi: ../parsing/longident.cmi primitives.cmi +parser.cmi: ../parsing/longident.cmi parser_aux.cmi pattern_matching.cmi: debugcom.cmi parser_aux.cmi ../typing/typedtree.cmi primitives.cmi: ../otherlibs/unix/unix.cmi printval.cmi: debugcom.cmi ../typing/env.cmi parser_aux.cmi \ diff --git a/debugger/Makefile b/debugger/Makefile index e236829e6f..e1f6df0daa 100644 --- a/debugger/Makefile +++ b/debugger/Makefile @@ -38,7 +38,8 @@ OTHEROBJS=\ ../typing/datarepr.cmo ../typing/env.cmo \ ../typing/ctype.cmo ../typing/printtyp.cmo ../typing/mtype.cmo \ ../bytecomp/runtimedef.cmo ../bytecomp/bytesections.cmo \ - ../bytecomp/symtable.cmo ../bytecomp/opcodes.cmo ../bytecomp/meta.cmo \ + ../bytecomp/dll.cmo ../bytecomp/symtable.cmo \ + ../bytecomp/opcodes.cmo ../bytecomp/meta.cmo \ ../toplevel/genprintval.cmo \ ../otherlibs/dynlink/dynlink.cmo diff --git a/driver/main.ml b/driver/main.ml index ac008a9c9b..e38f7f383c 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -34,7 +34,8 @@ let process_file ppf name = || Filename.check_suffix name ".cma" then objfiles := name :: !objfiles else if Filename.check_suffix name ext_obj - || Filename.check_suffix name ext_lib then + || Filename.check_suffix name ext_lib + || Filename.check_suffix name ext_dll then ccobjs := name :: !ccobjs else if Filename.check_suffix name ".c" then begin Compile.c_file name; @@ -73,6 +74,7 @@ module Options = Main_args.Make_options (struct let _cclib s = ccobjs := s :: !ccobjs let _ccopt s = ccopts := s :: !ccopts let _custom = set custom_runtime + let _dllpath s = dllpaths := !dllpaths @ [s] let _g = set debug let _i = set print_types let _I s = include_dirs := s :: !include_dirs diff --git a/driver/main_args.ml b/driver/main_args.ml index c340b7ef81..7a5f2049fb 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -20,6 +20,7 @@ module Make_options (F : val _cclib : string -> unit val _ccopt : string -> unit val _custom : unit -> unit + val _dllpath : string -> unit val _g : unit -> unit val _i : unit -> unit val _I : string -> unit @@ -62,6 +63,7 @@ struct "-ccopt", Arg.String F._ccopt, "<opt> Pass option <opt> to the C compiler and linker"; "-custom", Arg.Unit F._custom, " Link in custom mode"; + "-dllpath", Arg.String F._dllpath, "<dir> Add <dir> to the run-time search path for shared libraries"; "-g", Arg.Unit F._g, " Save debugging information"; "-i", Arg.Unit F._i, " Print the types"; "-I", Arg.String F._I, diff --git a/driver/main_args.mli b/driver/main_args.mli index bd71af0148..4b352143dc 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -20,6 +20,7 @@ module Make_options (F : val _cclib : string -> unit val _ccopt : string -> unit val _custom : unit -> unit + val _dllpath : string -> unit val _g : unit -> unit val _i : unit -> unit val _I : string -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index 6a3854f884..4f55fd93a9 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -73,6 +73,8 @@ let main () = "<opt> Pass option <opt> to the C compiler and linker"; "-compact", Arg.Clear optimize_for_speed, " Optimize code size rather than speed"; + "-dllpath", Arg.String (fun s -> dllpaths := !dllpaths @ [s]), + "<dir> Add <dir> to the run-time search path for shared libraries"; "-i", Arg.Set print_types, " Print the types"; "-I", Arg.String(fun dir -> include_dirs := dir :: !include_dirs), "<dir> Add <dir> to the list of include directories"; diff --git a/otherlibs/bigarray/Makefile b/otherlibs/bigarray/Makefile index 50f4ce1562..3f2e81faed 100644 --- a/otherlibs/bigarray/Makefile +++ b/otherlibs/bigarray/Makefile @@ -15,9 +15,10 @@ include ../../config/Makefile CC=$(BYTECC) -CFLAGS=-I../../byterun -g -O $(BYTECCCOMPOPTS) +CFLAGS=-I../../byterun -g -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../unix CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../unix +MKLIB=../../tools/ocamlmklib C_OBJS=bigarray_stubs.o mmap_unix.o @@ -28,19 +29,17 @@ all: libbigarray.a bigarray.cma allopt: libbigarray.a bigarray.cmxa libbigarray.a: $(C_OBJS) - rm -f libbigarray.a - ar rc libbigarray.a $(C_OBJS) - $(RANLIB) libbigarray.a + $(MKLIB) -o bigarray $(C_OBJS) bigarray.cma: $(CAML_OBJS) - $(CAMLC) -a -linkall -custom -o bigarray.cma \ - $(CAML_OBJS) -cclib -lbigarray + $(MKLIB) -ocamlc '$(CAMLC)' -linkall -o bigarray $(CAML_OBJS) bigarray.cmxa: $(CAML_OBJS:.cmo=.cmx) - $(CAMLOPT) -a -linkall -o bigarray.cmxa \ - $(CAML_OBJS:.cmo=.cmx) -cclib -lbigarray + $(MKLIB) -ocamlopt '$(CAMLOPT)' -linkall -o bigarray \ + $(CAML_OBJS:.cmo=.cmx) install: + test -f libbigarray.so && cp libbigarray.so $(LIBDIR) cp bigarray.cmi bigarray.mli libbigarray.a bigarray.cma $(LIBDIR) cd $(LIBDIR); $(RANLIB) libbigarray.a cp bigarray.h $(LIBDIR)/caml/bigarray.h @@ -53,7 +52,7 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f libbigarray.a *.o bigarray.a + rm -f libbigarray.* *.o bigarray.a .SUFFIXES: .ml .mli .cmo .cmi .cmx diff --git a/otherlibs/bigarray/Makefile.nt b/otherlibs/bigarray/Makefile.nt index c3f6970f96..9525c30381 100644 --- a/otherlibs/bigarray/Makefile.nt +++ b/otherlibs/bigarray/Makefile.nt @@ -15,7 +15,7 @@ include ..\..\config\Makefile.nt CC=$(BYTECC) -CFLAGS=-I..\..\byterun -I..\win32unix $(BYTECCCOMPOPTS) +CFLAGS=-I..\..\byterun -I..\win32unix CAMLC=..\..\boot\ocamlrun ..\..\ocamlc -I ..\..\stdlib -I ..\win32unix CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib -I ..\win32unix @@ -23,24 +23,29 @@ C_OBJS=bigarray_stubs.obj mmap_win32.obj CAML_OBJS=bigarray.cmo -all: libbigarray.lib bigarray.cma +all: libbigarray.dll libbigarray.lib bigarray.cma allopt: libbigarray.lib bigarray.cmxa -libbigarray.lib: $(C_OBJS) - rm -f libbigarray.lib - $(MKLIB)libbigarray.lib $(C_OBJS) +libbigarray.dll: $(C_OBJS:.obj=.dobj) + link /nologo /dll /out:libbigarray.dll /implib:tmp.lib \ + $(C_OBJS:.obj=.dobj) ..\..\byterun\ocamlrun.lib + rm tmp.* + +libbigarray.lib: $(C_OBJS:.obj=.sobj) + rm -f libunix.lib + $(MKLIB)libbigarray.lib $(C_OBJS:.obj=.sobj) bigarray.cma: $(CAML_OBJS) - $(CAMLC) -a -linkall -custom -o bigarray.cma \ - $(CAML_OBJS) -cclib -lbigarray + $(CAMLC) -a -linkall -o bigarray.cma $(CAML_OBJS) -cclib -lbigarray bigarray.cmxa: $(CAML_OBJS:.cmo=.cmx) $(CAMLOPT) -a -linkall -o bigarray.cmxa \ $(CAML_OBJS:.cmo=.cmx) -cclib -lbigarray install: - cp bigarray.cmi bigarray.mli libbigarray.lib bigarray.cma $(LIBDIR) + cp libbigarray.dll libbigarray.lib $(LIBDIR) + cp bigarray.cmi bigarray.mli bigarray.cma $(LIBDIR) cp bigarray.h $(LIBDIR)/caml/bigarray.h installopt: @@ -50,9 +55,9 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f libbigarray.lib *.obj + rm -f *.dll *.lib *.dobj *.sobj -.SUFFIXES: .ml .mli .cmo .cmi .cmx +.SUFFIXES: .ml .mli .cmo .cmi .cmx .dobj .sobj .mli.cmi: $(CAMLC) -c $(COMPFLAGS) $< @@ -63,6 +68,14 @@ clean: partialclean .ml.cmx: $(CAMLOPT) -c $(COMPFLAGS) $< +.c.dobj: + $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.dobj + +.c.sobj: + $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.sobj + depend: gcc -MM $(CFLAGS) *.c > .depend ..\..\boot\ocamlrun ..\..\tools\ocamldep *.mli *.ml >> .depend diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 3546bad863..5d22e41d9d 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -126,7 +126,7 @@ value alloc_bigarray_dims(int flags, int num_dims, void * data, ...) /* Allocate a bigarray from Caml */ -value bigarray_create(value vkind, value vlayout, value vdim) +CAMLprim value bigarray_create(value vkind, value vlayout, value vdim) { long dim[MAX_NUM_DIMS]; mlsize_t num_dims; @@ -215,19 +215,19 @@ value bigarray_get_N(value vb, value * vind, int nind) } } -value bigarray_get_1(value vb, value vind1) +CAMLprim value bigarray_get_1(value vb, value vind1) { return bigarray_get_N(vb, &vind1, 1); } -value bigarray_get_2(value vb, value vind1, value vind2) +CAMLprim value bigarray_get_2(value vb, value vind1, value vind2) { value vind[2]; vind[0] = vind1; vind[1] = vind2; return bigarray_get_N(vb, vind, 2); } -value bigarray_get_3(value vb, value vind1, value vind2, value vind3) +CAMLprim value bigarray_get_3(value vb, value vind1, value vind2, value vind3) { value vind[3]; vind[0] = vind1; vind[1] = vind2; vind[2] = vind3; @@ -235,7 +235,7 @@ value bigarray_get_3(value vb, value vind1, value vind2, value vind3) } #if 0 -value bigarray_get_4(value vb, value vind1, value vind2, +CAMLprim value bigarray_get_4(value vb, value vind1, value vind2, value vind3, value vind4) { value vind[4]; @@ -243,7 +243,7 @@ value bigarray_get_4(value vb, value vind1, value vind2, return bigarray_get_N(vb, vind, 4); } -value bigarray_get_5(value vb, value vind1, value vind2, +CAMLprim value bigarray_get_5(value vb, value vind1, value vind2, value vind3, value vind4, value vind5) { value vind[5]; @@ -252,7 +252,7 @@ value bigarray_get_5(value vb, value vind1, value vind2, return bigarray_get_N(vb, vind, 5); } -value bigarray_get_6(value vb, value vind1, value vind2, +CAMLprim value bigarray_get_6(value vb, value vind1, value vind2, value vind3, value vind4, value vind5, value vind6) { value vind[6]; @@ -262,7 +262,7 @@ value bigarray_get_6(value vb, value vind1, value vind2, } #endif -value bigarray_get_generic(value vb, value vind) +CAMLprim value bigarray_get_generic(value vb, value vind) { return bigarray_get_N(vb, &Field(vind, 0), Wosize_val(vind)); } @@ -309,19 +309,19 @@ static value bigarray_set_aux(value vb, value * vind, long nind, value newval) return Val_unit; } -value bigarray_set_1(value vb, value vind1, value newval) +CAMLprim value bigarray_set_1(value vb, value vind1, value newval) { return bigarray_set_aux(vb, &vind1, 1, newval); } -value bigarray_set_2(value vb, value vind1, value vind2, value newval) +CAMLprim value bigarray_set_2(value vb, value vind1, value vind2, value newval) { value vind[2]; vind[0] = vind1; vind[1] = vind2; return bigarray_set_aux(vb, vind, 2, newval); } -value bigarray_set_3(value vb, value vind1, value vind2, value vind3, +CAMLprim value bigarray_set_3(value vb, value vind1, value vind2, value vind3, value newval) { value vind[3]; @@ -330,7 +330,7 @@ value bigarray_set_3(value vb, value vind1, value vind2, value vind3, } #if 0 -value bigarray_set_4(value vb, value vind1, value vind2, +CAMLprim value bigarray_set_4(value vb, value vind1, value vind2, value vind3, value vind4, value newval) { value vind[4]; @@ -338,7 +338,7 @@ value bigarray_set_4(value vb, value vind1, value vind2, return bigarray_set_aux(vb, vind, 4, newval); } -value bigarray_set_5(value vb, value vind1, value vind2, +CAMLprim value bigarray_set_5(value vb, value vind1, value vind2, value vind3, value vind4, value vind5, value newval) { value vind[5]; @@ -347,7 +347,7 @@ value bigarray_set_5(value vb, value vind1, value vind2, return bigarray_set_aux(vb, vind, 5, newval); } -value bigarray_set_6(value vb, value vind1, value vind2, +CAMLprim value bigarray_set_6(value vb, value vind1, value vind2, value vind3, value vind4, value vind5, value vind6, value newval) { @@ -363,14 +363,14 @@ value bigarray_set_N(value vb, value * vind, int nargs) } #endif -value bigarray_set_generic(value vb, value vind, value newval) +CAMLprim value bigarray_set_generic(value vb, value vind, value newval) { return bigarray_set_aux(vb, &Field(vind, 0), Wosize_val(vind), newval); } /* Return the number of dimensions of a big array */ -value bigarray_num_dims(value vb) +CAMLprim value bigarray_num_dims(value vb) { struct caml_bigarray * b = Bigarray_val(vb); return Val_long(b->num_dims); @@ -378,7 +378,7 @@ value bigarray_num_dims(value vb) /* Return the n-th dimension of a big array */ -value bigarray_dim(value vb, value vn) +CAMLprim value bigarray_dim(value vb, value vn) { struct caml_bigarray * b = Bigarray_val(vb); long n = Long_val(vn); @@ -700,7 +700,7 @@ static void bigarray_update_proxy(struct caml_bigarray * b1, /* Slicing */ -value bigarray_slice(value vb, value vind) +CAMLprim value bigarray_slice(value vb, value vind) { struct caml_bigarray * b = Bigarray_val(vb); long index[MAX_NUM_DIMS]; @@ -742,7 +742,7 @@ value bigarray_slice(value vb, value vind) /* Extracting a sub-array of same number of dimensions */ -value bigarray_sub(value vb, value vofs, value vlen) +CAMLprim value bigarray_sub(value vb, value vofs, value vlen) { struct caml_bigarray * b = Bigarray_val(vb); long ofs = Long_val(vofs); @@ -782,7 +782,7 @@ value bigarray_sub(value vb, value vofs, value vlen) /* Copying a big array into another one */ -value bigarray_blit(value vsrc, value vdst) +CAMLprim value bigarray_blit(value vsrc, value vdst) { struct caml_bigarray * src = Bigarray_val(vsrc); struct caml_bigarray * dst = Bigarray_val(vdst); @@ -807,7 +807,7 @@ value bigarray_blit(value vsrc, value vdst) /* Filling a big array with a given value */ -value bigarray_fill(value vb, value vinit) +CAMLprim value bigarray_fill(value vb, value vinit) { struct caml_bigarray * b = Bigarray_val(vb); long num_elts = bigarray_num_elts(b); @@ -872,7 +872,7 @@ value bigarray_fill(value vb, value vinit) /* Reshape an array: change dimensions and number of dimensions, preserving array contents */ -value bigarray_reshape(value vb, value vdim) +CAMLprim value bigarray_reshape(value vb, value vdim) { struct caml_bigarray * b = Bigarray_val(vb); long dim[MAX_NUM_DIMS]; @@ -904,7 +904,7 @@ value bigarray_reshape(value vb, value vdim) /* Initialization */ -value bigarray_init(value unit) +CAMLprim value bigarray_init(value unit) { register_custom_operations(&bigarray_ops); return Val_unit; diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index dcf032f78a..291563d78f 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -36,8 +36,8 @@ extern int bigarray_element_size[]; /* from bigarray_stubs.c */ #define MAP_FAILED ((void *) -1) #endif -value bigarray_map_file(value vfd, value vkind, value vlayout, - value vshared, value vdim) +CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, + value vshared, value vdim) { int fd, flags, major_dim, shared; long num_dims, i; diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index 98b10f8d0c..d3186e73a1 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -13,6 +13,7 @@ /* $Id$ */ #include <stddef.h> +#include <stdio.h> #include <string.h> #include "bigarray.h" #include "custom.h" @@ -23,8 +24,10 @@ extern int bigarray_element_size[]; /* from bigarray_stubs.c */ -value bigarray_map_file(value vfd, value vkind, value vlayout, - value vshared, value vdim) +static void bigarray_sys_error(void); + +CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, + value vshared, value vdim) { HANDLE fd, fmap; int flags, major_dim, mode, perm; @@ -51,9 +54,9 @@ value bigarray_map_file(value vfd, value vkind, value vlayout, } /* Determine file size */ currpos = SetFilePointer(fd, 0, NULL, FILE_CURRENT); - if (currpos == -1) { _dosmaperr(GetLastError()); sys_error(NO_ARG); } + if (currpos == -1) bigarray_sys_error(); file_size = SetFilePointer(fd, 0, NULL, FILE_END); - if (file_size == -1) { _dosmaperr(GetLastError()); sys_error(NO_ARG); } + if (file_size == -1) bigarray_sys_error(); /* Determine array size in bytes (or size of array without the major dimension if that dimension wasn't specified) */ array_size = bigarray_element_size[flags & BIGARRAY_KIND_MASK]; @@ -78,14 +81,10 @@ value bigarray_map_file(value vfd, value vkind, value vlayout, mode = FILE_MAP_COPY; } fmap = CreateFileMapping(fd, NULL, perm, 0, array_size, NULL); - if (fmap == NULL) { - printf("CreateFileMapping failed, err %d\n", GetLastError()); - _dosmaperr(GetLastError()); sys_error(NO_ARG); } + if (fmap == NULL) bigarray_sys_error(); /* Map the mapping in memory */ addr = MapViewOfFile(fmap, mode, 0, 0, array_size); - if (addr == NULL) { - printf("MapViewOfFile failed, err %d\n", GetLastError()); - _dosmaperr(GetLastError()); sys_error(NO_ARG); } + if (addr == NULL) bigarray_sys_error(); /* Close the file mapping */ CloseHandle(fmap); /* Build and return the Caml bigarray */ @@ -97,6 +96,19 @@ void bigarray_unmap_file(void * addr, unsigned long len) UnmapViewOfFile(addr); } - - +static void bigarray_sys_error(void) +{ + char buffer[512]; + unsigned long errnum; + errnum = GetLastError(); + if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + errnum, + 0, + buffer, + sizeof(buffer), + NULL)) + sprintf(buffer, "Unknown error %d\n", errnum); + raise_sys_error(copy_string(buffer)); +} diff --git a/otherlibs/dbm/Makefile b/otherlibs/dbm/Makefile index ed1166fb98..d2f42d71fc 100644 --- a/otherlibs/dbm/Makefile +++ b/otherlibs/dbm/Makefile @@ -20,7 +20,9 @@ include ../../config/Makefile CC=$(BYTECC) -g CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -CFLAGS=$(DBM_INCLUDES) -I../../byterun -O $(BYTECCCOMPOPTS) +MKLIB=../../tools/ocamlmklib + +CFLAGS=$(DBM_INCLUDES) -I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) COBJS=cldbm.o all: libmldbm.a dbm.cmi dbm.cma @@ -28,15 +30,13 @@ all: libmldbm.a dbm.cmi dbm.cma allopt: libmldbm.a dbm.cmi dbm.cmxa libmldbm.a: $(COBJS) - rm -rf libmldbm.a - ar rc libmldbm.a $(COBJS) - $(RANLIB) libmldbm.a + $(MKLIB) -oc mldbm $(COBJS) $(DBM_LINK) dbm.cma: dbm.cmo - $(CAMLC) -a -o dbm.cma -custom dbm.cmo -cclib -lmldbm $(DBM_LINK) + $(MKLIB) -ocamlc '$(CAMLC)' -o dbm -oc mldbm dbm.cmo $(DBM_LINK) dbm.cmxa: dbm.cmx - $(CAMLOPT) -a -o dbm.cmxa dbm.cmx -cclib -lmldbm $(DBM_LINK) + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o dbm dbm.cmx $(DBM_LINK) partialclean: rm -f *.cm* @@ -45,6 +45,7 @@ clean: partialclean rm -f *.a *.o install: + test -f libmldbm.so && cp libmldbm.so $(LIBDIR)/libmldbm.so cp libmldbm.a $(LIBDIR)/libmldbm.a cd $(LIBDIR); $(RANLIB) libmldbm.a cp dbm.cma dbm.cmi dbm.mli $(LIBDIR) diff --git a/otherlibs/dynlink/.depend b/otherlibs/dynlink/.depend index aea012ee07..32e7319d82 100644 --- a/otherlibs/dynlink/.depend +++ b/otherlibs/dynlink/.depend @@ -1,8 +1,10 @@ -dynlink.cmo: ../../utils/config.cmi ../../bytecomp/emitcode.cmi \ - ../../typing/ident.cmi ../../bytecomp/meta.cmi ../../utils/misc.cmi \ - ../../bytecomp/opcodes.cmo ../../bytecomp/symtable.cmi dynlink.cmi -dynlink.cmx: ../../utils/config.cmx ../../bytecomp/emitcode.cmx \ - ../../typing/ident.cmx ../../bytecomp/meta.cmx ../../utils/misc.cmx \ - ../../bytecomp/opcodes.cmx ../../bytecomp/symtable.cmx dynlink.cmi +dynlink.cmo: ../../utils/config.cmi ../../bytecomp/dll.cmi \ + ../../bytecomp/emitcode.cmi ../../typing/ident.cmi \ + ../../bytecomp/meta.cmi ../../utils/misc.cmi ../../bytecomp/opcodes.cmo \ + ../../bytecomp/symtable.cmi dynlink.cmi +dynlink.cmx: ../../utils/config.cmx ../../bytecomp/dll.cmx \ + ../../bytecomp/emitcode.cmx ../../typing/ident.cmx \ + ../../bytecomp/meta.cmx ../../utils/misc.cmx ../../bytecomp/opcodes.cmx \ + ../../bytecomp/symtable.cmx dynlink.cmi extract_crc.cmo: dynlink.cmi extract_crc.cmx: dynlink.cmx diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index 52bd25be1c..fd9e999897 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -24,7 +24,7 @@ OBJS=dynlink.cmo COMPILEROBJS=misc.cmo config.cmo tbl.cmo clflags.cmo \ ident.cmo path.cmo \ types.cmo btype.cmo predef.cmo runtimedef.cmo \ - bytesections.cmo symtable.cmo opcodes.cmo meta.cmo + bytesections.cmo dll.cmo symtable.cmo opcodes.cmo meta.cmo all: dynlink.cma extract_crc diff --git a/otherlibs/dynlink/Makefile.nt b/otherlibs/dynlink/Makefile.nt index 8c81cd9844..b55621a703 100644 --- a/otherlibs/dynlink/Makefile.nt +++ b/otherlibs/dynlink/Makefile.nt @@ -24,7 +24,7 @@ OBJS=dynlink.cmo COMPILEROBJS=misc.cmo config.cmo tbl.cmo \ clflags.cmo ident.cmo path.cmo \ types.cmo btype.cmo predef.cmo runtimedef.cmo \ - bytesections.cmo symtable.cmo opcodes.cmo + bytesections.cmo dll.cmo symtable.cmo opcodes.cmo all: dynlink.cma extract_crc diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml index aa50272fca..408fed34b7 100644 --- a/otherlibs/dynlink/dynlink.ml +++ b/otherlibs/dynlink/dynlink.ml @@ -29,6 +29,7 @@ type error = | Linking_error of string * linking_error | Corrupted_interface of string | File_not_found of string + | Cannot_open_dll of string exception Error of error @@ -178,8 +179,13 @@ let loadfile file_name = if buffer = Config.cma_magic_number then begin let toc_pos = input_binary_int ic in (* Go to table of contents *) seek_in ic toc_pos; - let toc = (input_value ic : library) in - List.iter (load_compunit ic file_name) toc.lib_units + let lib = (input_value ic : library) in + begin try + Dll.open_dlls (Dll.extract_dll_names lib.lib_ccobjs) + with Failure reason -> + raise(Error(Cannot_open_dll reason)) + end; + List.iter (load_compunit ic file_name) lib.lib_units end else raise(Error(Not_a_bytecode_file file_name)); close_in ic @@ -219,3 +225,5 @@ let error_message = function "corrupted interface file " ^ name | File_not_found name -> "cannot find file " ^ name ^ " in search path" + | Cannot_open_dll reason -> + "error loading shared library: " ^ reason diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli index c8732b5db6..e63e106802 100644 --- a/otherlibs/dynlink/dynlink.mli +++ b/otherlibs/dynlink/dynlink.mli @@ -64,6 +64,7 @@ type error = | Linking_error of string * linking_error | Corrupted_interface of string | File_not_found of string + | Cannot_open_dll of string exception Error of error (* Errors in dynamic linking are reported by raising the [Error] exception with a description of the error. *) diff --git a/otherlibs/graph/Makefile b/otherlibs/graph/Makefile index 5c320a432f..4cef66712a 100644 --- a/otherlibs/graph/Makefile +++ b/otherlibs/graph/Makefile @@ -17,10 +17,10 @@ include ../../config/Makefile CC=$(BYTECC) -CFLAGS=-I../../byterun $(X11_INCLUDES) -O $(BYTECCCOMPOPTS) - +CFLAGS=-I../../byterun $(X11_INCLUDES) -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib +MKLIB=../../tools/ocamlmklib OBJS=open.o draw.o fill.o color.o text.o \ image.o make_img.o dump_img.o point_col.o sound.o events.o \ @@ -33,25 +33,22 @@ all: libgraphics.a graphics.cmi graphics.cma allopt: libgraphics.a graphics.cmi graphics.cmxa libgraphics.a: $(OBJS) - rm -f libgraphics.a - ar rc libgraphics.a $(OBJS) - $(RANLIB) libgraphics.a + $(MKLIB) -o graphics $(OBJS) $(X11_LINK) graphics.cma: $(CAMLOBJS) - $(CAMLC) -a -o graphics.cma -custom \ - $(CAMLOBJS) -cclib -lgraphics $(X11_LINK) + $(MKLIB) -ocamlc '$(CAMLC)' -o graphics $(CAMLOBJS) $(X11_LINK) graphics.cmxa: $(CAMLOBJS:.cmo=.cmx) - $(CAMLOPT) -a -o graphics.cmxa \ - $(CAMLOBJS:.cmo=.cmx) -cclib -lgraphics $(X11_LINK) + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o graphics $(CAMLOBJS:.cmo=.cmx) $(X11_LINK) partialclean: rm -f *.cm* clean: partialclean - rm -f *.a *.o + rm -f *.a *.so *.o install: + test -f libgraphics.so && cp libgraphics.so $(LIBDIR)/libgraphics.so cp libgraphics.a $(LIBDIR)/libgraphics.a cd $(LIBDIR); $(RANLIB) libgraphics.a cp graphics.cm[ia] graphicsX11.cmi graphics.mli graphicsX11.mli $(LIBDIR) diff --git a/otherlibs/labltk/browser/Makefile.nt b/otherlibs/labltk/browser/Makefile.nt index 370da56de6..eb0e3ae546 100644 --- a/otherlibs/labltk/browser/Makefile.nt +++ b/otherlibs/labltk/browser/Makefile.nt @@ -32,10 +32,10 @@ JG = jg_tk.cmo jg_config.cmo jg_bind.cmo jg_completion.cmo \ all: ocamlbrowser ocamlbrowser: $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ) winmain.obj - $(LABLC) -o ocamlbrowser $(INCLUDES) \ + $(LABLC) -o ocamlbrowser -custom $(INCLUDES) \ $(TOPDIR)/toplevel/toplevellib.cma \ unix.cma threads.cma str.cma labltk.cma jglib.cma $(OBJ) \ - $(TKLINKOPT) winmain.obj + $(TK_LINK) winmain.obj jglib.cma: $(JG) $(LABLCOMP) -a -o jglib.cma $(JG) diff --git a/otherlibs/labltk/lib/Makefile b/otherlibs/labltk/lib/Makefile index f56794c4a3..81470604db 100644 --- a/otherlibs/labltk/lib/Makefile +++ b/otherlibs/labltk/lib/Makefile @@ -18,15 +18,17 @@ include ./modules WIDGETOBJSX = $(WIDGETOBJS:.cmo=.cmx) labltk.cma : $(SUPPORT) $(WIDGETOBJS) tk.cmo - $(LABLLIBR) -custom -o labltk.cma $(SUPPORT) tk.cmo $(WIDGETOBJS) \ - -cclib -llabltk41 $(TK_LINK) $(X11_LINK) + $(MKLIB) -ocamlc '$(LABLC)' -o labltk -oc labltk41 \ + $(SUPPORT) tk.cmo $(WIDGETOBJS) \ + $(TK_LINK) $(X11_LINK) labltk.cmxa : $(SUPPORTX) $(WIDGETOBJSX) tk.cmx - $(CAMLOPTLIBR) -o labltk.cmxa $(SUPPORTX) tk.cmx $(WIDGETOBJSX) \ - -cclib -llabltk41 $(TK_LINK) $(X11_LINK) + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o labltk -oc labltk41 \ + $(SUPPORTX) tk.cmx $(WIDGETOBJSX) \ + $(TK_LINK) $(X11_LINK) labltktop$(EXE) : $(TOPDEPS) $(WIDGETOBJS) $(SUPPORT) ../support/liblabltk41.a - $(LABLC) -custom -linkall -o labltktop$(EXE) -I ../support \ + $(LABLC) -linkall -o labltktop$(EXE) -I ../support \ -I $(TOPDIR)/toplevel toplevellib.cma labltk.cma \ -I $(OTHERS)/unix unix.cma \ -I $(OTHERS)/str str.cma \ @@ -57,6 +59,7 @@ installopt: labltk.cmxa @if test -d $(LABLTKDIR); then : ; else mkdir $(LABLTKDIR); fi cp $(SUPPORTX) $(WIDGETOBJSX) tk.cmx $(LABLTKDIR) cp labltk.cmxa labltk.a $(LABLTKDIR) + cd $(LABLTKDIR); $(RANLIB) labltk.a chmod 644 $(LABLTKDIR)/*.cmx chmod 644 $(LABLTKDIR)/labltk.cmxa chmod 644 $(LABLTKDIR)/labltk.a diff --git a/otherlibs/labltk/lib/Makefile.nt b/otherlibs/labltk/lib/Makefile.nt index b22672cc16..2fe206049d 100644 --- a/otherlibs/labltk/lib/Makefile.nt +++ b/otherlibs/labltk/lib/Makefile.nt @@ -18,15 +18,15 @@ include ./modules WIDGETOBJSX = $(WIDGETOBJS:.cmo=.cmx) labltk.cma : $(SUPPORT) $(WIDGETOBJS) tk.cmo - $(LABLLIBR) -custom -o labltk.cma $(SUPPORT) tk.cmo $(WIDGETOBJS) \ - -cclib -llabltk41 $(TK_LINK) + $(LABLLIBR) -o labltk.cma $(SUPPORT) tk.cmo $(WIDGETOBJS) \ + -cclib -llabltk41 labltk.cmxa : $(SUPPORTX) $(WIDGETOBJSX) tk.cmx $(CAMLOPTLIBR) -o labltk.cmxa $(SUPPORTX) tk.cmx $(WIDGETOBJSX) \ -cclib -llabltk41 $(TK_LINK) labltk : $(TOPDEPS) $(WIDGETOBJS) $(SUPPORT) - $(LABLC) -custom -linkall -o $@ -I ../support $(TKLINKOPT) \ + $(LABLC) -linkall -o $@ -I ../support $(TKLINKOPT) \ -I $(TOPDIR)/toplevel toplevellib.cma labltk.cma \ -I $(OTHERS)/win32unix unix.cma -I $(OTHERS)/str str.cma \ topmain.cmo diff --git a/otherlibs/labltk/support/Makefile b/otherlibs/labltk/support/Makefile index 3491399dd7..a66f13f497 100644 --- a/otherlibs/labltk/support/Makefile +++ b/otherlibs/labltk/support/Makefile @@ -11,14 +11,12 @@ opt: support.cmx widget.cmx protocol.cmx \ COBJS=cltkCaml.o cltkEval.o cltkEvent.o cltkFile.o cltkMain.o \ cltkMisc.o cltkTimer.o cltkVar.o cltkWait.o -CCFLAGS=-I../../../byterun $(TK_DEFS) $(X11_INCLUDES) +CCFLAGS=-I../../../byterun $(TK_DEFS) $(X11_INCLUDES) $(SHAREDCCCOMPOPTS) COMPFLAGS=-I $(OTHERS)/unix liblabltk41.a : $(COBJS) - rm -f liblabltk41.a - ar rc liblabltk41.a $(COBJS) - $(RANLIB) liblabltk41.a + $(MKLIB) -o labltk41 $(COBJS) $(TK_LINK) $(X11_LINK) PUB=fileevent.cmi fileevent.mli \ protocol.cmi protocol.mli \ @@ -29,7 +27,9 @@ PUB=fileevent.cmi fileevent.mli \ install: liblabltk41.a $(PUB) if test -d $(LABLTKDIR); then : ; else mkdir $(LABLTKDIR); fi cp $(PUB) liblabltk41.a $(LABLTKDIR) - cd $(LABLTKDIR); chmod 644 $(PUB) liblabltk41.a + cd $(LABLTKDIR); $(RANLIB) liblabltk41.a + if test -f liblabltk41.so; then cp liblabltk41.so $(LABLTKDIR); fi + cd $(LABLTKDIR); chmod 644 $(PUB) liblabltk41.* clean : rm -f *.cm* *.o *.a diff --git a/otherlibs/labltk/support/Makefile.common b/otherlibs/labltk/support/Makefile.common index 0bd8f32e5e..d929e45ca1 100644 --- a/otherlibs/labltk/support/Makefile.common +++ b/otherlibs/labltk/support/Makefile.common @@ -22,3 +22,4 @@ LINKFLAGS= CAMLOPT=$(CAMLRUN) $(TOPDIR)/ocamlopt -I $(TOPDIR)/stdlib -labels CAMLOPTLIBR=$(CAMLOPT) -a +MKLIB=$(TOPDIR)/tools/ocamlmklib diff --git a/otherlibs/labltk/support/Makefile.nt b/otherlibs/labltk/support/Makefile.nt index 01699a785b..f42d382b0c 100644 --- a/otherlibs/labltk/support/Makefile.nt +++ b/otherlibs/labltk/support/Makefile.nt @@ -2,7 +2,7 @@ all: support.cmo widget.cmo protocol.cmo \ textvariable.cmo timer.cmo fileevent.cmo \ - liblabltk41.lib + liblabltk41.dll liblabltk41.lib opt: support.cmx widget.cmx protocol.cmx \ textvariable.cmx timer.cmx fileevent.cmx \ @@ -11,13 +11,19 @@ opt: support.cmx widget.cmx protocol.cmx \ COBJS=cltkCaml.obj cltkEval.obj cltkEvent.obj cltkFile.obj cltkMain.obj \ cltkMisc.obj cltkTimer.obj cltkVar.obj cltkWait.obj -CCFLAGS=-I..\..\..\byterun /Zi $(TK_DEFS) +CCFLAGS=-I..\..\..\byterun $(TK_DEFS) COMPFLAGS=-I $(OTHERS)/win32unix -liblabltk41.lib : $(COBJS) +liblabltk41.dll : $(COBJS:.obj=.dobj) + link /nologo /dll /out:liblabltk41.dll /implib:tmp.lib \ + $(COBJS:.obj=.dobj) ..\..\..\byterun\ocamlrun.lib \ + $(TK_LINK) wsock32.lib + rm tmp.* + +liblabltk41.lib : $(COBJS:.obj=.sobj) rm -f liblabltk41.lib - $(MKLIB)liblabltk41.lib $(COBJS) + $(MKLIB)liblabltk41.lib $(COBJS:.obj=.sobj) PUB=fileevent.cmi fileevent.mli \ protocol.cmi protocol.mli \ @@ -25,16 +31,17 @@ PUB=fileevent.cmi fileevent.mli \ timer.cmi timer.mli \ widget.cmi widget.mli -install: liblabltk41.lib $(PUB) +install: liblabltk41.dll liblabltk41.lib $(PUB) @if not exist $(LABLTKDIR) mkdir $(LABLTKDIR) cp $(PUB) $(LABLTKDIR) - cp liblabltk41.lib $(LABLTKDIR) + cp liblabltk41.dll liblabltk41.lib $(LABLTKDIR) + echo $(LABLTKDIR)>> $(LIBDIR)\ld.conf clean : - rm -f *.cm* *.obj *.lib + rm -f *.cm* *.dobj *.sobj *.dll *.lib .SUFFIXES : -.SUFFIXES : .mli .ml .cmi .cmo .cmx .mlp .c .obj +.SUFFIXES : .mli .ml .cmi .cmo .cmx .mlp .c .dobj .sobj .mli.cmi: $(LABLCOMP) $(COMPFLAGS) $< @@ -45,8 +52,13 @@ clean : .ml.cmx: $(CAMLOPT) -c $(COMPFLAGS) $< -.c.obj: +.c.dobj: + $(BYTECC) $(DLLCCCOMPOPTS) $(CCFLAGS) -c $< + mv $*.obj $*.dobj + +.c.sobj: $(BYTECC) $(BYTECCCOMPOPTS) $(CCFLAGS) -c $< + mv $*.obj $*.sobj depend: $(LABLDEP) *.mli *.ml > .depend diff --git a/otherlibs/labltk/support/cltkCaml.c b/otherlibs/labltk/support/cltkCaml.c index 003b9a541d..3847a4e772 100644 --- a/otherlibs/labltk/support/cltkCaml.c +++ b/otherlibs/labltk/support/cltkCaml.c @@ -51,7 +51,7 @@ int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp, int argc, char **argv) * using the following. TCL_VOLATILE ensures that Tcl will make * a copy of the string */ -value camltk_return (value v) /* ML */ +CAMLprim value camltk_return (value v) { CheckInit(); @@ -71,7 +71,7 @@ void tk_error(char *errmsg) takes place during loading of the protocol module */ -value camltk_init(value v) /* ML */ +CAMLprim value camltk_init(value v) { /* Initialize the Caml pointers */ if (tkerror_exn == NULL) diff --git a/otherlibs/labltk/support/cltkEval.c b/otherlibs/labltk/support/cltkEval.c index 9cb044463d..45bc6b9a91 100644 --- a/otherlibs/labltk/support/cltkEval.c +++ b/otherlibs/labltk/support/cltkEval.c @@ -55,7 +55,7 @@ value copy_string_list(int argc, char **argv) * this version works on an arbitrary Tcl command, * and does parsing and substitution */ -value camltk_tcl_eval(value str) /* ML */ +CAMLprim value camltk_tcl_eval(value str) { int code; char *cmd = NULL; @@ -167,7 +167,7 @@ int fill_args (char **argv, int where, value v) } /* v is an array of TkArg */ -value camltk_tcl_direct_eval(value v) /* ML */ +CAMLprim value camltk_tcl_direct_eval(value v) { int i; int size; /* size of argv */ diff --git a/otherlibs/labltk/support/cltkEvent.c b/otherlibs/labltk/support/cltkEvent.c index fecb4244a5..e851f472a7 100644 --- a/otherlibs/labltk/support/cltkEvent.c +++ b/otherlibs/labltk/support/cltkEvent.c @@ -21,7 +21,7 @@ #include <alloc.h> #include "camltk.h" -value camltk_tk_mainloop(void) /* ML */ +CAMLprim value camltk_tk_mainloop(void) { CheckInit(); @@ -43,7 +43,7 @@ static int event_flag_table[] = { TK_ALL_EVENTS }; -value camltk_dooneevent(value flags) /* ML */ +CAMLprim value camltk_dooneevent(value flags) { int ret; diff --git a/otherlibs/labltk/support/cltkFile.c b/otherlibs/labltk/support/cltkFile.c index 5de029c794..a8132db4fb 100644 --- a/otherlibs/labltk/support/cltkFile.c +++ b/otherlibs/labltk/support/cltkFile.c @@ -58,7 +58,7 @@ static Tcl_File tcl_filehandle(value fd) #define Tcl_File int #endif -value camltk_add_file_input(value fd, value cbid) /* ML */ +CAMLprim value camltk_add_file_input(value fd, value cbid) { CheckInit(); Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_READABLE, @@ -73,7 +73,7 @@ value camltk_add_file_input(value fd, value cbid) /* ML */ * in rem_file (it doesn't close the fd anyway). For fds for which we * repeatedly add/rem, this will cause some overhead. */ -value camltk_rem_file_input(value fd, value cbid) /* ML */ +CAMLprim value camltk_rem_file_input(value fd, value cbid) { Tcl_File fh = tcl_filehandle(fd); Tcl_DeleteFileHandler(fh); @@ -83,7 +83,7 @@ value camltk_rem_file_input(value fd, value cbid) /* ML */ return Val_unit; } -value camltk_add_file_output(value fd, value cbid) /* ML */ +CAMLprim value camltk_add_file_output(value fd, value cbid) { CheckInit(); Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_WRITABLE, @@ -91,7 +91,7 @@ value camltk_add_file_output(value fd, value cbid) /* ML */ return Val_unit; } -value camltk_rem_file_output(value fd, value cbid) /* ML */ +CAMLprim value camltk_rem_file_output(value fd, value cbid) { Tcl_File fh = tcl_filehandle(fd); Tcl_DeleteFileHandler(fh); @@ -122,7 +122,7 @@ static Tcl_Channel tcl_channel(value fd, int flags) return Tcl_MakeFileChannel((ClientData) h, flags); } -value camltk_add_file_input(value fd, value cbid) /* ML */ +CAMLprim value camltk_add_file_input(value fd, value cbid) { CheckInit(); Tcl_CreateChannelHandler(tcl_channel(fd, TCL_READABLE), @@ -131,14 +131,14 @@ value camltk_add_file_input(value fd, value cbid) /* ML */ return Val_unit; } -value camltk_rem_file_input(value fd, value cbid) /* ML */ +CAMLprim value camltk_rem_file_input(value fd, value cbid) { Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_READABLE), FileProc, (ClientData) (Int_val(cbid))); return Val_unit; } -value camltk_add_file_output(value fd, value cbid) /* ML */ +CAMLprim value camltk_add_file_output(value fd, value cbid) { CheckInit(); Tcl_CreateChannelHandler(tcl_channel(fd, TCL_WRITABLE), @@ -147,7 +147,7 @@ value camltk_add_file_output(value fd, value cbid) /* ML */ return Val_unit; } -value camltk_rem_file_output(value fd, value cbid) /* ML */ +CAMLprim value camltk_rem_file_output(value fd, value cbid) { Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_WRITABLE), FileProc, (ClientData) (Int_val(cbid))); diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c index ea1679233c..2d07f75a28 100644 --- a/otherlibs/labltk/support/cltkMain.c +++ b/otherlibs/labltk/support/cltkMain.c @@ -64,7 +64,7 @@ Tk_Window cltk_mainWindow; int cltk_slave_mode = 0; /* Initialisation, based on tkMain.c */ -value camltk_opentk(value display, value name) /* ML */ +CAMLprim value camltk_opentk(value display, value name) { if (!cltk_slave_mode) { /* Create an interpreter, dies if error */ diff --git a/otherlibs/labltk/support/cltkMisc.c b/otherlibs/labltk/support/cltkMisc.c index f16928fb86..50ed038100 100644 --- a/otherlibs/labltk/support/cltkMisc.c +++ b/otherlibs/labltk/support/cltkMisc.c @@ -23,7 +23,7 @@ #include "camltk.h" /* Parsing results */ -value camltk_splitlist (value v) /* ML */ +CAMLprim value camltk_splitlist (value v) { int argc; char **argv; diff --git a/otherlibs/labltk/support/cltkTimer.c b/otherlibs/labltk/support/cltkTimer.c index a3d3d3cacf..fec7bfb2ad 100644 --- a/otherlibs/labltk/support/cltkTimer.c +++ b/otherlibs/labltk/support/cltkTimer.c @@ -28,7 +28,7 @@ void TimerProc (ClientData clientdata) callback2(*handler_code,Val_long(clientdata),Val_int(0)); } -value camltk_add_timer(value milli, value cbid) /* ML */ +CAMLprim value camltk_add_timer(value milli, value cbid) { CheckInit(); /* look at tkEvent.c , Tk_Token is an int */ @@ -36,7 +36,7 @@ value camltk_add_timer(value milli, value cbid) /* ML */ (ClientData) (Int_val(cbid))))); } -value camltk_rem_timer(value token) /* ML */ +CAMLprim value camltk_rem_timer(value token) { Tcl_DeleteTimerHandler((Tcl_TimerToken) Int_val(token)); return Val_unit; diff --git a/otherlibs/labltk/support/cltkVar.c b/otherlibs/labltk/support/cltkVar.c index efca7621af..123595cd9b 100644 --- a/otherlibs/labltk/support/cltkVar.c +++ b/otherlibs/labltk/support/cltkVar.c @@ -25,7 +25,7 @@ #include <callback.h> #include "camltk.h" -value camltk_getvar(value var) /* ML */ +CAMLprim value camltk_getvar(value var) { char *s; char *stable_var = NULL; @@ -42,7 +42,7 @@ value camltk_getvar(value var) /* ML */ return(copy_string(s)); } -value camltk_setvar(value var, value contents) /* ML */ +CAMLprim value camltk_setvar(value var, value contents) { char *s; char *stable_var = NULL; @@ -82,7 +82,7 @@ static char * tracevar(ClientData clientdata, Tcl_Interp *interp, } /* Sets up a callback upon modification of a variable */ -value camltk_trace_var(value var, value cbid) /* ML */ +CAMLprim value camltk_trace_var(value var, value cbid) { char *cvar = NULL; @@ -103,7 +103,7 @@ value camltk_trace_var(value var, value cbid) /* ML */ return Val_unit; } -value camltk_untrace_var(value var, value cbid) /* ML */ +CAMLprim value camltk_untrace_var(value var, value cbid) { char *cvar = NULL; diff --git a/otherlibs/labltk/support/cltkWait.c b/otherlibs/labltk/support/cltkWait.c index 57028372f2..5e621470c4 100644 --- a/otherlibs/labltk/support/cltkWait.c +++ b/otherlibs/labltk/support/cltkWait.c @@ -57,7 +57,7 @@ static void WaitVisibilityProc(ClientData clientData, XEvent *eventPtr) } /* Sets up a callback upon Visibility of a window */ -value camltk_wait_vis(value win, value cbid) /* ML */ +CAMLprim value camltk_wait_vis(value win, value cbid) { struct WinCBData *vis = (struct WinCBData *)stat_alloc(sizeof(struct WinCBData)); @@ -84,7 +84,7 @@ static void WaitWindowProc(ClientData clientData, XEvent *eventPtr) } /* Sets up a callback upon window destruction */ -value camltk_wait_des(value win, value cbid) /* ML */ +CAMLprim value camltk_wait_des(value win, value cbid) { struct WinCBData *vis = (struct WinCBData *)stat_alloc(sizeof(struct WinCBData)); diff --git a/otherlibs/num/.depend.nt b/otherlibs/num/.depend.nt index b3f5916fd2..0d604eab10 100644 --- a/otherlibs/num/.depend.nt +++ b/otherlibs/num/.depend.nt @@ -1,9 +1,38 @@ -nat_stubs.obj: nat_stubs.c bignum/h/BigNum.h bignum/h/BntoBnn.h \ - ../../byterun/mlvalues.h ../../byterun/config.h \ - ../../byterun/../config/m.h ../../byterun/../config/s.h \ - ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/memory.h \ +nat_stubs.dobj: nat_stubs.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/intext.h ../../byterun/io.h \ + ../../byterun/fix_code.h ../../byterun/fail.h ../../byterun/memory.h \ ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ - ../../byterun/minor_gc.h nat.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 +arith_flags.cmo: arith_flags.cmi +arith_flags.cmx: arith_flags.cmi +arith_status.cmo: arith_flags.cmi arith_status.cmi +arith_status.cmx: arith_flags.cmx arith_status.cmi +big_int.cmo: int_misc.cmi nat.cmi big_int.cmi +big_int.cmx: int_misc.cmx nat.cmx big_int.cmi +int_misc.cmo: int_misc.cmi +int_misc.cmx: int_misc.cmi +nat.cmo: int_misc.cmi nat.cmi +nat.cmx: int_misc.cmx nat.cmi +num.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi ratio.cmi num.cmi +num.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx ratio.cmx num.cmi +ratio.cmo: arith_flags.cmi big_int.cmi int_misc.cmi nat.cmi string_misc.cmi \ + ratio.cmi +ratio.cmx: arith_flags.cmx big_int.cmx int_misc.cmx nat.cmx string_misc.cmx \ + ratio.cmi +string_misc.cmo: string_misc.cmi +string_misc.cmx: string_misc.cmi +nat_stubs.sobj: nat_stubs.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/intext.h ../../byterun/io.h \ + ../../byterun/fix_code.h ../../byterun/fail.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/num/Makefile b/otherlibs/num/Makefile index 8365537f45..d8b9ae6b15 100644 --- a/otherlibs/num/Makefile +++ b/otherlibs/num/Makefile @@ -18,9 +18,10 @@ include ../../config/Makefile # Compilation options CC=$(BYTECC) -CFLAGS=-O -I./bignum/h -I../../byterun $(BYTECCCOMPOPTS) +CFLAGS=-O -I./bignum/h -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -w s CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -w s +MKLIB=../../tools/ocamlmklib CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \ ratio.cmo num.cmo arith_status.cmo @@ -28,28 +29,29 @@ CAMLOBJS=int_misc.cmo string_misc.cmo nat.cmo big_int.cmo arith_flags.cmo \ CMIFILES=big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi COBJS=nat_stubs.o +BIGNUM_OBJS=bignum/o/KerN.o bignum/o/bnInit.o bignum/o/bnMult.o \ + bignum/o/bnDivide.o bignum/o/bnCmp.o bignum/o/bzf.o bignum/o/bz.o all: libnums.a nums.cma $(CMIFILES) allopt: libnums.a nums.cmxa $(CMIFILES) nums.cma: $(CAMLOBJS) - $(CAMLC) -a -o nums.cma -custom $(CAMLOBJS) -cclib -lnums + $(MKLIB) -ocamlc '$(CAMLC)' -o nums $(CAMLOBJS) nums.cmxa: $(CAMLOBJS:.cmo=.cmx) - $(CAMLOPT) -a -o nums.cmxa $(CAMLOBJS:.cmo=.cmx) -cclib -lnums + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o nums $(CAMLOBJS:.cmo=.cmx) -libnums.a: bignum/libbignum.a $(COBJS) - cp bignum/libbignum.a libnums.a - ar r libnums.a $(COBJS) - $(RANLIB) libnums.a +libnums.a: $(BIGNUM_OBJS) $(COBJS) + $(MKLIB) -o nums $(BIGNUM_OBJS) $(COBJS) -bignum/libbignum.a: - cd bignum; $(MAKE) $(BIGNUM_ARCH) CC="$(CC) $(BYTECCCOMPOPTS)" +$(BIGNUM_OBJS): + cd bignum; $(MAKE) $(BIGNUM_ARCH) CC="$(CC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)" $(CAMLOBJS:.cmo=.cmx): ../../ocamlopt install: + test -f libnums.so && cp libnums.so $(LIBDIR) cp libnums.a $(LIBDIR)/libnums.a cd $(LIBDIR); $(RANLIB) libnums.a cp nums.cma $(CMIFILES) $(CMIFILES:.cmi=.mli) $(LIBDIR) @@ -62,7 +64,7 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f *.a *.o + rm -f *.a *.o *.so cd bignum; $(MAKE) scratch cd test; $(MAKE) clean diff --git a/otherlibs/num/Makefile.nt b/otherlibs/num/Makefile.nt index 2a4cee258a..de74eb27d0 100644 --- a/otherlibs/num/Makefile.nt +++ b/otherlibs/num/Makefile.nt @@ -18,7 +18,7 @@ # Compilation options CC=$(BYTECC) -CFLAGS=-O -I.\bignum\h -I..\..\byterun $(BYTECCCOMPOPTS) +CFLAGS=-O -I.\bignum\h -I..\..\byterun CAMLC=..\..\boot\ocamlrun ..\..\ocamlc -I ..\..\boot -w s CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib -w s @@ -29,25 +29,31 @@ CMIFILES=big_int.cmi nat.cmi num.cmi ratio.cmi arith_status.cmi COBJS=nat_stubs.obj -all: libnums.lib nums.cma $(CMIFILES) +all: libnums.dll libnums.lib nums.cma $(CMIFILES) allopt: libnums.lib nums.cmxa $(CMIFILES) nums.cma: $(CAMLOBJS) - $(CAMLC) -a -o nums.cma -custom $(CAMLOBJS) -cclib -lnums + $(CAMLC) -a -o nums.cma $(CAMLOBJS) -cclib -lnums nums.cmxa: $(CAMLOBJS:.cmo=.cmx) $(CAMLOPT) -a -o nums.cmxa $(CAMLOBJS:.cmo=.cmx) -cclib -lnums -libnums.lib: bignum\libbignum.lib $(COBJS) - $(MKLIB)libnums.lib bignum\libbignum.lib $(COBJS) +libnums.dll: bignum\dbignum.lib $(COBJS:.obj=.dobj) + link /nologo /dll /out:libnums.dll /implib:tmp.lib \ + bignum\dbignum.lib $(COBJS:.obj=.dobj) ..\..\byterun\ocamlrun.lib + rm tmp.* -bignum\libbignum.lib: +libnums.lib: bignum\sbignum.lib $(COBJS:.obj=.sobj) + $(MKLIB)libnums.lib bignum\sbignum.lib $(COBJS:.obj=.sobj) + +bignum\dbignum.lib bignum\sbignum.lib: cd bignum & $(MAKEREC) $(CAMLOBJS:.cmo=.cmx): ..\..\ocamlopt install: + cp libnums.dll $(LIBDIR)\libnums.dll cp libnums.lib $(LIBDIR)\libnums.lib cp nums.cma $(CMIFILES) $(LIBDIR) @@ -58,11 +64,11 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f *.lib *.obj + rm -f *.dll *.lib *.dobj *.sobj cd bignum & $(MAKEREC) scratch cd test & $(MAKEREC) clean -.SUFFIXES: .ml .mli .cmi .cmo .cmx +.SUFFIXES: .ml .mli .cmi .cmo .cmx .dobj .sobj .mli.cmi: $(CAMLC) -c $(COMPFLAGS) $< @@ -73,9 +79,18 @@ clean: partialclean .ml.cmx: $(CAMLOPT) -c $(COMPFLAGS) $< +.c.dobj: + $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.dobj + +.c.sobj: + $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.sobj + nat_stubs.obj: nat.h depend: - sed -e "s/\.o/.obj/g" .depend > .depend.nt + sed -e "s/\.o/.dobj/g" .depend > .depend.nt + sed -e "s/\.o/.sobj/g" .depend >> .depend.nt !include .depend.nt diff --git a/otherlibs/num/bignum/Makefile b/otherlibs/num/bignum/Makefile index 2a5106570c..2c5398a088 100644 --- a/otherlibs/num/bignum/Makefile +++ b/otherlibs/num/bignum/Makefile @@ -27,7 +27,10 @@ default: #all: testKerN bztest # @echo All is done -all: $(LIB) +#all: $(LIB) +# @echo All is done + +all: $(OBJECT) @echo All is done tidy: diff --git a/otherlibs/num/bignum/Makefile.nt b/otherlibs/num/bignum/Makefile.nt index 35ad2eb7bf..c29b1b9970 100644 --- a/otherlibs/num/bignum/Makefile.nt +++ b/otherlibs/num/bignum/Makefile.nt @@ -1,48 +1,87 @@ !include ..\..\..\config\Makefile.nt CC = $(BYTECC) -LIB = libbignum.lib -OBJECT = o\KerN.obj o\bnInit.obj o\bnMult.obj o\bnDivide.obj o\bnCmp.obj o\bzf.obj o\bz.obj +CFLAGS = -c -I.\h -DCAML_LIGHT KERNH = h\BigNum.h -CFLAGS = -c -I.\h -DCAML_LIGHT $(BYTECCCOMPOPTS) +OBJS = o\KerN.obj o\bnInit.obj o\bnMult.obj o\bnDivide.obj \ + o\bnCmp.obj o\bzf.obj o\bz.obj -all: $(LIB) +all: dbignum.lib sbignum.lib scratch: - rm -f o/*.obj libbignum.lib + rm -f *.lib o/*.dobj o/*.sobj -# build the BigNum library -$(LIB): $(OBJECT) - lib /out:$(LIB) $(OBJECT) +# DLL -o\KerN.obj: c\KerN.c - $(CC) $(CFLAGS) c\KerN.c - mv KerN.obj o +dbignum.lib: $(OBJS:.obj=.dobj) + $(MKLIB)dbignum.lib $(OBJS:.obj=.dobj) -o\bnInit.obj: c\bn\bnInit.c $(KERNH) - $(CC) $(CFLAGS) c\bn\bnInit.c - mv bnInit.obj o +o\KerN.dobj: c\KerN.c + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\KerN.c + mv KerN.obj o\KerN.dobj -o\bnMult.obj: c\bn\bnMult.c $(KERNH) - $(CC) $(CFLAGS) c\bn\bnMult.c - mv bnMult.obj o +o\bnInit.dobj: c\bn\bnInit.c $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bn\bnInit.c + mv bnInit.obj o\bnInit.dobj -o\bnDivide.obj: c\bn\bnDivide.c $(KERNH) - $(CC) $(CFLAGS) c\bn\bnDivide.c - mv bnDivide.obj o +o\bnMult.dobj: c\bn\bnMult.c $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bn\bnMult.c + mv bnMult.obj o\bnMult.dobj -o\bnCmp.obj: c\bn\bnCmp.c $(KERNH) - $(CC) $(CFLAGS) c\bn\bnCmp.c - mv bnCmp.obj o +o\bnDivide.dobj: c\bn\bnDivide.c $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bn\bnDivide.c + mv bnDivide.obj o\bnDivide.dobj -o\bz.obj: c\bz.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) c\bz.c - mv bz.obj o +o\bnCmp.dobj: c\bn\bnCmp.c $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bn\bnCmp.c + mv bnCmp.obj o\bnCmp.dobj -o\br.obj: c\br.c h/BigR.h h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) c\br.c - mv br.obj o +o\bz.dobj: c\bz.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bz.c + mv bz.obj o\bz.dobj + +o\br.dobj: c\br.c h/BigR.h h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\br.c + mv br.obj o\br.dobj + +o\bzf.dobj: c\bzf.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(DLLCCCOMPOPTS) c\bzf.c + mv bzf.obj o\bzf.dobj + +# Static + +sbignum.lib: $(OBJS:.obj=.sobj) + $(MKLIB)sbignum.lib $(OBJS:.obj=.sobj) + +o\KerN.sobj: c\KerN.c + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\KerN.c + mv KerN.obj o\KerN.sobj + +o\bnInit.sobj: c\bn\bnInit.c $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bn\bnInit.c + mv bnInit.obj o\bnInit.sobj + +o\bnMult.sobj: c\bn\bnMult.c $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bn\bnMult.c + mv bnMult.obj o\bnMult.sobj + +o\bnDivide.sobj: c\bn\bnDivide.c $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bn\bnDivide.c + mv bnDivide.obj o\bnDivide.sobj + +o\bnCmp.sobj: c\bn\bnCmp.c $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bn\bnCmp.c + mv bnCmp.obj o\bnCmp.sobj + +o\bz.sobj: c\bz.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bz.c + mv bz.obj o\bz.sobj + +o\br.sobj: c\br.c h/BigR.h h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\br.c + mv br.obj o\br.sobj + +o\bzf.sobj: c\bzf.c h/BigZ.h $(KERNH) + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) c\bzf.c + mv bzf.obj o\bzf.sobj -o\bzf.obj: c\bzf.c h/BigZ.h $(KERNH) - $(CC) $(CFLAGS) c\bzf.c - mv bzf.obj o diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c index d1d0fbdfb7..a9977ed07a 100644 --- a/otherlibs/num/nat_stubs.c +++ b/otherlibs/num/nat_stubs.c @@ -38,31 +38,31 @@ static struct custom_operations nat_operations = { deserialize_nat }; -value initialize_nat(value unit) +CAMLprim value initialize_nat(value unit) { register_custom_operations(&nat_operations); return Val_unit; } -value create_nat(value size) +CAMLprim value create_nat(value size) { mlsize_t sz = Long_val(size); return alloc_custom(&nat_operations, sz * sizeof(value), 0, 1); } -value length_nat(value nat) +CAMLprim value length_nat(value nat) { return Val_long(Wosize_val(nat) - 1); } -value set_to_zero_nat(value nat, value ofs, value len) +CAMLprim value set_to_zero_nat(value nat, value ofs, value len) { BnSetToZero(Bignum_val(nat), Long_val(ofs), Long_val(len)); return Val_unit; } -value blit_nat(value nat1, value ofs1, value nat2, value ofs2, value len) +CAMLprim value blit_nat(value nat1, value ofs1, value nat2, value ofs2, value len) { BnAssign(Bignum_val(nat1), Long_val(ofs1), Bignum_val(nat2), Long_val(ofs2), @@ -70,49 +70,49 @@ value blit_nat(value nat1, value ofs1, value nat2, value ofs2, value len) return Val_unit; } -value set_digit_nat(value nat, value ofs, value digit) +CAMLprim value set_digit_nat(value nat, value ofs, value digit) { BnSetDigit(Bignum_val(nat), Long_val(ofs), Long_val(digit)); return Val_unit; } -value nth_digit_nat(value nat, value ofs) +CAMLprim value nth_digit_nat(value nat, value ofs) { return Val_long(BnGetDigit(Bignum_val(nat), Long_val(ofs))); } -value num_digits_nat(value nat, value ofs, value len) +CAMLprim value num_digits_nat(value nat, value ofs, value len) { return Val_long(BnNumDigits(Bignum_val(nat), Long_val(ofs), Long_val(len))); } -value num_leading_zero_bits_in_digit(value nat, value ofs) +CAMLprim value num_leading_zero_bits_in_digit(value nat, value ofs) { return Val_long(BnNumLeadingZeroBitsInDigit(Bignum_val(nat), Long_val(ofs))); } -value is_digit_int(value nat, value ofs) +CAMLprim value is_digit_int(value nat, value ofs) { return Val_bool(BnDoesDigitFitInWord(Bignum_val(nat), Long_val(ofs))); } -value is_digit_zero(value nat, value ofs) +CAMLprim value is_digit_zero(value nat, value ofs) { return Val_bool(BnIsDigitZero(Bignum_val(nat), Long_val(ofs))); } -value is_digit_normalized(value nat, value ofs) +CAMLprim value is_digit_normalized(value nat, value ofs) { return Val_bool(BnIsDigitNormalized(Bignum_val(nat), Long_val(ofs))); } -value is_digit_odd(value nat, value ofs) +CAMLprim value is_digit_odd(value nat, value ofs) { return Val_bool(BnIsDigitOdd(Bignum_val(nat), Long_val(ofs))); } -value incr_nat(value nat, value ofs, value len, value carry_in) +CAMLprim value incr_nat(value nat, value ofs, value len, value carry_in) { return Val_long(BnAddCarry(Bignum_val(nat), Long_val(ofs), Long_val(len), Long_val(carry_in))); @@ -125,19 +125,19 @@ value add_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, Long_val(carry_in))); } -value add_nat(value *argv, int argn) +CAMLprim value add_nat(value *argv, int argn) { return add_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } -value complement_nat(value nat, value ofs, value len) +CAMLprim value complement_nat(value nat, value ofs, value len) { BnComplement(Bignum_val(nat), Long_val(ofs), Long_val(len)); return Val_unit; } -value decr_nat(value nat, value ofs, value len, value carry_in) +CAMLprim value decr_nat(value nat, value ofs, value len, value carry_in) { return Val_long(BnSubtractBorrow(Bignum_val(nat), Long_val(ofs), Long_val(len), Long_val(carry_in))); @@ -150,7 +150,7 @@ value sub_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, Long_val(carry_in))); } -value sub_nat(value *argv, int argn) +CAMLprim value sub_nat(value *argv, int argn) { return sub_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); @@ -164,7 +164,7 @@ value mult_digit_nat_native(value nat1, value ofs1, value len1, value nat2, valu Bignum_val(nat3), Long_val(ofs3))); } -value mult_digit_nat(value *argv, int argn) +CAMLprim value mult_digit_nat(value *argv, int argn) { return mult_digit_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7]); @@ -178,7 +178,7 @@ value mult_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2 Bignum_val(nat3), Long_val(ofs3), Long_val(len3))); } -value mult_nat(value *argv, int argn) +CAMLprim value mult_nat(value *argv, int argn) { return mult_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8]); @@ -191,7 +191,7 @@ value shift_left_nat_native(value nat1, value ofs1, value len1, value nat2, valu return Val_unit; } -value shift_left_nat(value *argv, int argn) +CAMLprim value shift_left_nat(value *argv, int argn) { return shift_left_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); @@ -206,7 +206,7 @@ value div_digit_nat_native(value natq, value ofsq, value natr, value ofsr, value return Val_unit; } -value div_digit_nat(value *argv, int argn) +CAMLprim value div_digit_nat(value *argv, int argn) { return div_digit_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8]); @@ -219,7 +219,7 @@ value div_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, return Val_unit; } -value div_nat(value *argv, int argn) +CAMLprim value div_nat(value *argv, int argn) { return div_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); @@ -232,13 +232,13 @@ value shift_right_nat_native(value nat1, value ofs1, value len1, value nat2, val return Val_unit; } -value shift_right_nat(value *argv, int argn) +CAMLprim value shift_right_nat(value *argv, int argn) { return shift_right_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } -value compare_digits_nat(value nat1, value ofs1, value nat2, value ofs2) +CAMLprim value compare_digits_nat(value nat1, value ofs1, value nat2, value ofs2) { return Val_long(BnCompareDigits(Bignum_val(nat1), Long_val(ofs1), Bignum_val(nat2), Long_val(ofs2))); @@ -250,27 +250,27 @@ value compare_nat_native(value nat1, value ofs1, value len1, value nat2, value o Bignum_val(nat2), Long_val(ofs2), Long_val(len2))); } -value compare_nat(value *argv, int argn) +CAMLprim value compare_nat(value *argv, int argn) { return compare_nat_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } -value land_digit_nat(value nat1, value ofs1, value nat2, value ofs2) +CAMLprim value land_digit_nat(value nat1, value ofs1, value nat2, value ofs2) { BnAndDigits(Bignum_val(nat1), Long_val(ofs1), Bignum_val(nat2), Long_val(ofs2)); return Val_unit; } -value lor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) +CAMLprim value lor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) { BnOrDigits(Bignum_val(nat1), Long_val(ofs1), Bignum_val(nat2), Long_val(ofs2)); return Val_unit; } -value lxor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) +CAMLprim value lxor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) { BnXorDigits(Bignum_val(nat1), Long_val(ofs1), Bignum_val(nat2), Long_val(ofs2)); diff --git a/otherlibs/num/test/Makefile b/otherlibs/num/test/Makefile index 07c28cfe17..1f44794187 100644 --- a/otherlibs/num/test/Makefile +++ b/otherlibs/num/test/Makefile @@ -12,11 +12,13 @@ # $Id$ +include ../../../config/Makefile + CAMLC=../../../boot/ocamlrun ../../../ocamlc -I ../../../stdlib CAMLOPT=../../../boot/ocamlrun ../../../ocamlopt -I ../../../stdlib test: test.byt test.opt - ./test.byt + if $(SUPPORTS_SHARED_LIBRARIES); then ../../../byterun/ocamlrun -I .. ./test.byt; else ./test.byt; fi ./test.opt TESTFILES=test.cmo \ @@ -26,7 +28,7 @@ TESTFILES=test.cmo \ TESTOPTFILES=$(TESTFILES:.cmo=.cmx) test.byt: $(TESTFILES) ../nums.cma ../libnums.a - $(CAMLC) -ccopt -L.. -o test.byt -custom ../nums.cma $(TESTFILES) + $(CAMLC) -ccopt -L.. -o test.byt ../nums.cma $(TESTFILES) test.opt: $(TESTOPTFILES) ../nums.cmxa ../libnums.a $(CAMLOPT) -ccopt -L.. -o test.opt ../nums.cmxa $(TESTOPTFILES) diff --git a/otherlibs/num/test/Makefile.nt b/otherlibs/num/test/Makefile.nt index 0062f1ce3b..ac45c0e370 100644 --- a/otherlibs/num/test/Makefile.nt +++ b/otherlibs/num/test/Makefile.nt @@ -12,11 +12,11 @@ # $Id$ -CAMLC=..\..\..\boot\ocamlrun ..\..\..\ocamlc -I ..\..\..\stdlib -CAMLOPT=..\..\..\boot\ocamlrun ..\..\..\ocamlopt -I ..\..\..\stdlib +CAMLC=..\..\..\boot\ocamlrun ..\..\..\ocamlc -I ..\..\..\stdlib -I .. +CAMLOPT=..\..\..\boot\ocamlrun ..\..\..\ocamlopt -I ..\..\..\stdlib -I .. test: test.byt test.opt - .\test.byt + ..\..\..\byterun\ocamlrun -I .. .\test.byt .\test.opt TESTFILES=test.cmo \ @@ -26,20 +26,20 @@ TESTFILES=test.cmo \ TESTOPTFILES=$(TESTFILES:.cmo=.cmx) test.byt: $(TESTFILES) ..\nums.cma ..\libnums.lib - $(CAMLC) -o test.byt -custom ..\nums.cma $(TESTFILES) ..\libnums.lib + $(CAMLC) -o test.byt nums.cma $(TESTFILES) test.opt: $(TESTOPTFILES) ..\nums.cmxa ..\libnums.lib - $(CAMLOPT) -o test.opt ..\nums.cmxa $(TESTOPTFILES) ..\libnums.lib + $(CAMLOPT) -o test.opt nums.cmxa $(TESTOPTFILES) $(TESTOPTFILES): ..\..\..\ocamlopt .SUFFIXES: .ml .cmo .cmx .ml.cmo: - $(CAMLC) -I .. -c $< + $(CAMLC) -c $< .ml.cmx: - $(CAMLOPT) -I .. -c $< + $(CAMLOPT) -c $< ocamltopnum: ocamlmktop -o ocamltopnum -custom ..\nums.cma ..\libnums.lib diff --git a/otherlibs/str/Makefile b/otherlibs/str/Makefile index 75e6b69fed..ae5419b849 100644 --- a/otherlibs/str/Makefile +++ b/otherlibs/str/Makefile @@ -18,29 +18,28 @@ include ../../config/Makefile # Compilation options CC=$(BYTECC) -CFLAGS=-O -I$(REGEXLIB) -I../../byterun $(BYTECCCOMPOPTS) +CFLAGS=-O -I$(REGEXLIB) -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib REGEXLIB=regex-0.12 COBJS=strstubs.o $(REGEXLIB)/regex.o +MKLIB=../../tools/ocamlmklib all: libstr.a str.cmi str.cma allopt: libstr.a str.cmi str.cmxa libstr.a: $(COBJS) - rm -f libstr.a - ar rc libstr.a $(COBJS) - $(RANLIB) libstr.a + $(MKLIB) -o str $(COBJS) str.cma: str.cmo - $(CAMLC) -a -o str.cma -custom str.cmo -cclib -lstr + $(MKLIB) -ocamlc '$(CAMLC)' -o str str.cmo str.cmxa: str.cmx - $(CAMLOPT) -a -o str.cmxa str.cmx -cclib -lstr + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o str str.cmx $(REGEXLIB)/regex.o: $(REGEXLIB)/regex.c $(REGEXLIB)/regex.h - cd $(REGEXLIB); CC="$(CC) $(BYTECCCOMPOPTS)" sh configure; $(MAKE) + cd $(REGEXLIB); CC="$(CC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)" sh configure; $(MAKE) str.cmx: ../../ocamlopt @@ -52,6 +51,7 @@ clean: partialclean cd $(REGEXLIB); if test -f Makefile; then $(MAKE) distclean; else exit 0; fi install: + test -f libstr.so && cp libstr.so $(LIBDIR)/libstr.so cp libstr.a $(LIBDIR)/libstr.a cd $(LIBDIR); $(RANLIB) libstr.a cp str.cma str.cmi str.mli $(LIBDIR) diff --git a/otherlibs/str/Makefile.nt b/otherlibs/str/Makefile.nt index 87eaee2b6a..79ed66826c 100644 --- a/otherlibs/str/Makefile.nt +++ b/otherlibs/str/Makefile.nt @@ -18,28 +18,37 @@ # Compilation options CC=$(BYTECC) -CFLAGS=-I$(REGEXLIB) -I..\..\byterun $(BYTECCCOMPOPTS) +CFLAGS=-I$(REGEXLIB) -I..\..\byterun CAMLC=..\..\boot\ocamlrun ..\..\ocamlc -I ..\..\boot CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib REGEXLIB=regex-0.12 -REGEXFLAGS=-DREGEX_MALLOC -DSTDC_HEADERS $(BYTECCCOMPOPTS) +REGEXFLAGS=-DREGEX_MALLOC -DSTDC_HEADERS COBJS=strstubs.obj $(REGEXLIB)\regex.obj -all: libstr.lib str.cmi str.cma +all: libstr.dll libstr.lib str.cmi str.cma allopt: libstr.lib str.cmi str.cmxa -libstr.lib: $(COBJS) - $(MKLIB)libstr.lib $(COBJS) +libstr.dll: $(COBJS:.obj=.dobj) + link /nologo /dll /out:libstr.dll /implib:tmp.lib $(COBJS:.obj=.dobj) ..\..\byterun\ocamlrun.lib + rm tmp.* + +libstr.lib: $(COBJS:.obj=.sobj) + $(MKLIB)libstr.lib $(COBJS:.obj=.sobj) str.cma: str.cmo - $(CAMLC) -a -o str.cma -custom str.cmo -cclib -lstr + $(CAMLC) -a -o str.cma str.cmo -cclib -lstr str.cmxa: str.cmx $(CAMLOPT) -a -o str.cmxa str.cmx -cclib -lstr -$(REGEXLIB)\regex.obj: $(REGEXLIB)\regex.c $(REGEXLIB)\regex.h - cd $(REGEXLIB) & $(CC) $(REGEXFLAGS) -c regex.c +$(REGEXLIB)\regex.dobj: $(REGEXLIB)\regex.c $(REGEXLIB)\regex.h + cd $(REGEXLIB) & $(CC) $(REGEXFLAGS) $(DLLCCCOMPOPTS) -c regex.c + mv $(REGEXLIB)\regex.obj $(REGEXLIB)\regex.dobj + +$(REGEXLIB)\regex.sobj: $(REGEXLIB)\regex.c $(REGEXLIB)\regex.h + cd $(REGEXLIB) & $(CC) $(REGEXFLAGS) $(BYTECCCOMPOPTS) -c regex.c + mv $(REGEXLIB)\regex.obj $(REGEXLIB)\regex.sobj str.cmx: ..\..\ocamlopt @@ -47,17 +56,18 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f *.lib *.obj - rm -f $(REGEXLIB)/*.obj + rm -f *.lib *.dll *.dobj *.sobj + rm -f $(REGEXLIB)/*.dobj $(REGEXLIB)/*.sobj install: + cp libstr.dll $(LIBDIR)\libstr.dll cp libstr.lib $(LIBDIR)\libstr.lib cp str.cma str.cmi $(LIBDIR) installopt: cp str.cmx str.cmxa str.lib $(LIBDIR) -.SUFFIXES: .ml .mli .cmo .cmi .cmx +.SUFFIXES: .ml .mli .cmo .cmi .cmx .dobj .sobj .mli.cmi: $(CAMLC) -c $(COMPFLAGS) $< @@ -68,8 +78,15 @@ installopt: .ml.cmx: $(CAMLOPT) -c $(COMPFLAGS) $< +.c.dobj: + $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.dobj + +.c.sobj: + $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.sobj + depend: - gcc -MM $(CFLAGS) *.c > .depend - ..\..\tools\ocamldep *.mli *.ml >> .depend -!include .depend +str.cmo: str.cmi +str.cmx: str.cmi diff --git a/otherlibs/str/strstubs.c b/otherlibs/str/strstubs.c index d4427152a0..1e70a05f2f 100644 --- a/otherlibs/str/strstubs.c +++ b/otherlibs/str/strstubs.c @@ -45,7 +45,7 @@ static regexp alloc_regexp(void) static char * case_fold_table = NULL; -value str_compile_regexp(value src, value fold) /* ML */ +CAMLprim value str_compile_regexp(value src, value fold) { regexp expr; char * msg; @@ -78,7 +78,7 @@ static regoff_t start_regs[10], end_regs[10]; static struct re_registers match_regs = { 10, start_regs, end_regs }; -value str_string_match(regexp expr, value text, value pos) /* ML */ +CAMLprim value str_string_match(regexp expr, value text, value pos) { int len = string_length(text); int start = Int_val(pos); @@ -96,7 +96,7 @@ value str_string_match(regexp expr, value text, value pos) /* ML */ } } -value str_string_partial_match(regexp expr, value text, value pos) /* ML */ +CAMLprim value str_string_partial_match(regexp expr, value text, value pos) { int len = string_length(text); int start = Int_val(pos); @@ -113,7 +113,7 @@ value str_string_partial_match(regexp expr, value text, value pos) /* ML */ } } -value str_search_forward(regexp expr, value text, value pos) /* ML */ +CAMLprim value str_search_forward(regexp expr, value text, value pos) { int res; int len = string_length(text); @@ -132,7 +132,7 @@ value str_search_forward(regexp expr, value text, value pos) /* ML */ } } -value str_search_backward(regexp expr, value text, value pos) /* ML */ +CAMLprim value str_search_backward(regexp expr, value text, value pos) { int res; int len = string_length(text); @@ -151,17 +151,17 @@ value str_search_backward(regexp expr, value text, value pos) /* ML */ } } -value str_beginning_group(value ngroup) /* ML */ +CAMLprim value str_beginning_group(value ngroup) { return Val_int(start_regs[Int_val(ngroup)]); } -value str_end_group(value ngroup) /* ML */ +CAMLprim value str_end_group(value ngroup) { return Val_int(end_regs[Int_val(ngroup)]); } -value str_replacement_text(value repl, value orig) /* ML */ +CAMLprim value str_replacement_text(value repl, value orig) { value res; mlsize_t len, n; diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index 259e470721..abfc3587f3 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -16,6 +16,7 @@ include ../../config/Makefile CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../unix CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../unix +MKLIB=../../tools/ocamlmklib BYTECODE_C_OBJS=posix_b.o NATIVECODE_C_OBJS=posix_n.o @@ -29,28 +30,27 @@ all: libthreads.a threads.cma allopt: libthreadsnat.a threads.cmxa libthreads.a: $(BYTECODE_C_OBJS) - rm -f libthreads.a - ar rc libthreads.a $(BYTECODE_C_OBJS) + $(MKLIB) -o threads $(BYTECODE_C_OBJS) $(PTHREAD_LINK) posix_b.o: posix.c - $(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) -c posix.c + $(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \ + -c posix.c mv posix.o posix_b.o libthreadsnat.a: $(NATIVECODE_C_OBJS) - rm -f libthreadsnat.a - ar rc libthreadsnat.a $(NATIVECODE_C_OBJS) + $(MKLIB) -o threadsnat $(NATIVECODE_C_OBJS) $(PTHREAD_LINK) posix_n.o: posix.c $(NATIVECC) -O -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) -DNATIVE_CODE -DTARGET_$(ARCH) -DSYS_$(SYSTEM) -c posix.c mv posix.o posix_n.o threads.cma: $(THREAD_OBJS) - $(CAMLC) -a -o threads.cma -custom $(THREAD_OBJS) \ - -cclib -lthreads -cclib -lunix $(PTHREAD_LINK) + $(MKLIB) -ocamlc '$(CAMLC)' -o threads $(THREAD_OBJS) \ + -cclib -lunix $(PTHREAD_LINK) threads.cmxa: $(THREAD_OBJS:.cmo=.cmx) - $(CAMLOPT) -a -o threads.cmxa $(THREAD_OBJS:.cmo=.cmx) \ - -cclib -lthreadsnat -cclib -lunix $(PTHREAD_LINK) + $(MKLIB) -ocamlopt '$(CAMLOPT)' -o threads -oc threadsnat \ + $(THREAD_OBJS:.cmo=.cmx) -cclib -lunix $(PTHREAD_LINK) $(THREAD_OBJS:.cmo=.cmx): ../../ocamlopt @@ -65,15 +65,20 @@ clean: partialclean rm -f $(GENFILES) install: + test -f libthreads.so && cp libthreads.so $(LIBDIR)/libthreads.so cp libthreads.a $(LIBDIR)/libthreads.a + cd $(LIBDIR); $(RANLIB) libthreads.a if test -d $(LIBDIR)/threads; then :; else mkdir $(LIBDIR)/threads; fi cp $(THREAD_OBJS:.cmo=.cmi) threads.cma $(LIBDIR)/threads rm -f $(LIBDIR)/threads/stdlib.cma cp thread.mli mutex.mli condition.mli event.mli threadUnix.mli $(LIBDIR) installopt: + test -f libthreadsnat.so && cp libthreadsnat.so $(LIBDIR)/libthreadsnat.so cp libthreadsnat.a $(LIBDIR)/libthreadsnat.a + cd $(LIBDIR); $(RANLIB) libthreadsnat.a cp $(THREAD_OBJS:.cmo=.cmx) threads.cmxa threads.a $(LIBDIR)/threads + cd $(LIBDIR)/threads; $(RANLIB) threads.a .SUFFIXES: .ml .mli .cmo .cmi .cmx diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index cbe761b00f..a5a19e6ea0 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -18,35 +18,41 @@ include ../../config/Makefile.nt CAMLC=..\..\boot\ocamlrun ..\..\ocamlc -I ..\..\stdlib -I ..\win32unix CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib -I ..\win32unix -BYTECODE_C_OBJS=win32_b.obj -NATIVECODE_C_OBJS=win32_n.obj - THREAD_OBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo GENFILES=thread.ml -all: libthreads.lib threads.cma +all: libthreads.dll libthreads.lib threads.cma allopt: libthreadsnat.lib threads.cmxa -libthreads.lib: $(BYTECODE_C_OBJS) +libthreads.dll: win32_b.dobj + link /nologo /dll /out:libthreads.dll /implib:tmp.lib \ + win32_b.dobj ..\..\byterun\ocamlrun.lib + rm tmp.* + +libthreads.lib: win32_b.sobj rm -f libthreads.lib - $(MKLIB)libthreads.lib $(BYTECODE_C_OBJS) + $(MKLIB)libthreads.lib win32_b.sobj + +win32_b.dobj: win32.c + $(BYTECC) -I..\..\byterun $(DLLCCCOMPOPTS) -c win32.c + mv win32.obj win32_b.dobj -win32_b.obj: win32.c - $(BYTECC) -O -I..\..\byterun $(BYTECCCOMPOPTS) -c win32.c - mv win32.obj win32_b.obj +win32_b.sobj: win32.c + $(BYTECC) -I..\..\byterun $(BYTECCCOMPOPTS) -c win32.c + mv win32.obj win32_b.sobj -libthreadsnat.lib: $(NATIVECODE_C_OBJS) +libthreadsnat.lib: win32_n.obj rm -f libthreadsnat.lib - $(MKLIB)libthreadsnat.lib $(NATIVECODE_C_OBJS) + $(MKLIB)libthreadsnat.lib win32_n.obj win32_n.obj: win32.c $(NATIVECC) -DNATIVE_CODE -O -I..\..\asmrun -I..\..\byterun $(NATIVECCCOMPOPTS) -c win32.c mv win32.obj win32_n.obj threads.cma: $(THREAD_OBJS) - $(CAMLC) -a -custom -o threads.cma $(THREAD_OBJS) -cclib -lthreads + $(CAMLC) -a -o threads.cma $(THREAD_OBJS) -cclib -lthreads threads.cmxa: $(THREAD_OBJS:.cmo=.cmx) $(CAMLOPT) -a -o threads.cmxa $(THREAD_OBJS:.cmo=.cmx) \ @@ -61,10 +67,11 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f libthreads*.lib *.obj + rm -f *.dll *.lib *.obj *.dobj *.sobj rm -f $(GENFILES) install: + cp libthreads.dll $(LIBDIR)/libthreads.dll cp libthreads.lib $(LIBDIR)/libthreads.lib if not exist $(LIBDIR)\threads mkdir $(LIBDIR)\threads cp $(THREAD_OBJS:.cmo=.cmi) threads.cma $(LIBDIR)/threads @@ -86,7 +93,5 @@ installopt: $(CAMLOPT) -c $(COMPFLAGS) $< depend: -# gcc -MM -I../../byterun *.c > .depend - ..\..\boot\ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/systhreads/Tests/Makefile.nt b/otherlibs/systhreads/Tests/Makefile.nt index 4b134c5c6c..f45d330507 100644 --- a/otherlibs/systhreads/Tests/Makefile.nt +++ b/otherlibs/systhreads/Tests/Makefile.nt @@ -33,11 +33,11 @@ clean: {..\..\threads\Tests}.ml{}.byt: cp ../../threads/Tests/$*.ml $*.ml - $(CAMLC) -custom -o $*.byt unix.cma threads.cma $*.ml ..\libthreads.lib ..\..\win32unix\libunix.lib wsock32.lib + $(CAMLC) -o $*.byt unix.cma threads.cma $*.ml {..\..\threads\Tests}.ml{}.out: cp ../../threads/Tests/$*.ml $*.ml - $(CAMLOPT) -o $*.out unix.cmxa threads.cmxa $*.ml ..\libthreadsnat.lib ..\..\win32unix\libunix.lib wsock32.lib + $(CAMLOPT) -o $*.out unix.cmxa threads.cmxa $*.ml $(PROGS): ../threads.cma ../libthreads.lib $(PROGS:.byt=.out): ../threads.cmxa ../libthreadsnat.lib diff --git a/otherlibs/systhreads/win32.c b/otherlibs/systhreads/win32.c index 6bf3197451..a79dd9e586 100644 --- a/otherlibs/systhreads/win32.c +++ b/otherlibs/systhreads/win32.c @@ -93,15 +93,18 @@ typedef struct caml_thread_struct * caml_thread_t; /* The descriptor for the currently executing thread (thread-specific) */ -static __declspec( thread ) caml_thread_t curr_thread = NULL; +static caml_thread_t curr_thread = NULL; /* The global mutex used to ensure that at most one thread is running Caml code */ static HANDLE caml_mutex; -/* The thread-specific variable holding last locked I/O channel */ +/* The key used for storing the thread descriptor in the specific data + of the corresponding Posix thread. */ +static DWORD thread_descriptor_key; -static __declspec( thread ) struct channel * last_channel_locked = NULL; +/* The key used for unlocking I/O channels on exceptions */ +static DWORD last_channel_locked_key; /* Identifier for next thread creation */ static long thread_next_ident = 0; @@ -173,6 +176,9 @@ static void caml_thread_leave_blocking_section(void) { /* Re-acquire the global mutex */ WaitForSingleObject(caml_mutex, INFINITE); + /* Update curr_thread to point to the thread descriptor corresponding + to the thread currently executing */ + curr_thread = TlsGetValue(thread_descriptor_key); /* Restore the stack-related global variables */ #ifdef NATIVE_CODE caml_bottom_of_stack= curr_thread->bottom_of_stack; @@ -219,19 +225,20 @@ static void caml_io_mutex_lock(struct channel * chan) unlock the mutex. The alternative (doing the setspecific before locking the mutex is also incorrect, since we could then unlock a mutex that is unlocked or locked by someone else. */ - last_channel_locked = chan; + TlsSetValue(last_channel_locked_key, (void *) chan); leave_blocking_section(); } static void caml_io_mutex_unlock(struct channel * chan) { ReleaseMutex((HANDLE) chan->mutex); - last_channel_locked = NULL; + TlsSetValue(last_channel_locked_key, NULL); } static void caml_io_mutex_unlock_exn(void) { - if (last_channel_locked != NULL) caml_io_mutex_unlock(last_channel_locked); + struct channel * chan = TlsGetValue(last_channel_locked_key); + if (chan != NULL) caml_io_mutex_unlock(chan); } /* The "tick" thread fakes a signal at regular intervals. */ @@ -256,7 +263,7 @@ static void caml_thread_finalize(value vthread) /* Initialize the thread machinery */ -value caml_thread_initialize(value unit) /* ML */ +CAMLprim caml_thread_initialize(value unit) { value vthread = Val_unit; value descr; @@ -267,6 +274,9 @@ value caml_thread_initialize(value unit) /* ML */ /* Initialize the main mutex and acquire it */ caml_mutex = CreateMutex(NULL, TRUE, NULL); if (caml_mutex == NULL) caml_wthread_error("Thread.init"); + /* Initialize the TLS keys */ + thread_descriptor_key = TlsAlloc(); + last_channel_locked_key = TlsAlloc(); /* Create a finalized value to hold thread handle */ vthread = alloc_final(sizeof(struct caml_thread_handle) / sizeof(value), caml_thread_finalize, 1, 1000); @@ -290,6 +300,8 @@ value caml_thread_initialize(value unit) /* ML */ curr_thread->prev = curr_thread; /* The stack-related fields will be filled in at the next enter_blocking_section */ + /* Associate the thread descriptor with the thread */ + TlsSetValue(thread_descriptor_key, (void *) curr_thread); /* Set up the hooks */ prev_scan_roots_hook = scan_roots_hook; scan_roots_hook = caml_thread_scan_roots; @@ -321,14 +333,14 @@ static void caml_thread_start(caml_thread_t th) { value clos; - /* Initialize the per-thread variables */ - curr_thread = th; - last_channel_locked = NULL; + /* Associate the thread descriptor with the thread */ + TlsSetValue(thread_descriptor_key, (void *) th); + TlsSetValue(last_channel_locked_key, NULL); /* Acquire the global mutex and set up the stack variables */ leave_blocking_section(); /* Callback the closure */ clos = Start_closure(th->descr); - Modify(&(Start_closure(th->descr)), Val_unit); + modify(&(Start_closure(th->descr)), Val_unit); callback_exn(clos, Val_unit); /* Remove th from the doubly-linked list of threads */ th->next->prev = th->prev; @@ -346,7 +358,7 @@ static void caml_thread_start(caml_thread_t th) /* The thread now stops running */ } -value caml_thread_new(value clos) /* ML */ +CAMLprim caml_thread_new(value clos) { caml_thread_t th; value vthread = Val_unit; @@ -413,7 +425,7 @@ value caml_thread_new(value clos) /* ML */ /* Return the current thread */ -value caml_thread_self(value unit) /* ML */ +CAMLprim caml_thread_self(value unit) { if (curr_thread == NULL) invalid_argument("Thread.self: not initialized"); return curr_thread->descr; @@ -421,14 +433,14 @@ value caml_thread_self(value unit) /* ML */ /* Return the identifier of a thread */ -value caml_thread_id(value th) /* ML */ +CAMLprim caml_thread_id(value th) { return Ident(th); } /* Print uncaught exception and backtrace */ -value caml_thread_uncaught_exception(value exn) /* ML */ +CAMLprim caml_thread_uncaught_exception(value exn) { char * msg = format_caml_exception(exn); fprintf(stderr, "Thread %d killed on uncaught exception %s\n", @@ -443,7 +455,7 @@ value caml_thread_uncaught_exception(value exn) /* ML */ /* Allow re-scheduling */ -value caml_thread_yield(value unit) /* ML */ +CAMLprim caml_thread_yield(value unit) { enter_blocking_section(); Sleep(0); @@ -453,7 +465,7 @@ value caml_thread_yield(value unit) /* ML */ /* Suspend the current thread until another thread terminates */ -value caml_thread_join(value th) /* ML */ +CAMLprim caml_thread_join(value th) { HANDLE h; Begin_root(th) /* prevent deallocation of handle */ @@ -491,7 +503,7 @@ static struct custom_operations caml_mutex_ops = { custom_deserialize_default }; -value caml_mutex_new(value unit) /* ML */ +CAMLprim caml_mutex_new(value unit) { value mut; mut = alloc_custom(&caml_mutex_ops, sizeof(HANDLE), 1, Max_mutex_number); @@ -500,7 +512,7 @@ value caml_mutex_new(value unit) /* ML */ return mut; } -value caml_mutex_lock(value mut) /* ML */ +CAMLprim caml_mutex_lock(value mut) { int retcode; Begin_root(mut) /* prevent deallocation of mutex */ @@ -512,7 +524,7 @@ value caml_mutex_lock(value mut) /* ML */ return Val_unit; } -value caml_mutex_unlock(value mut) /* ML */ +CAMLprim caml_mutex_unlock(value mut) { BOOL retcode; Begin_root(mut) /* prevent deallocation of mutex */ @@ -524,7 +536,7 @@ value caml_mutex_unlock(value mut) /* ML */ return Val_unit; } -value caml_mutex_try_lock(value mut) /* ML */ +CAMLprim caml_mutex_try_lock(value mut) { int retcode; retcode = WaitForSingleObject(Mutex_val(mut), 0); @@ -535,7 +547,7 @@ value caml_mutex_try_lock(value mut) /* ML */ /* Delay */ -value caml_thread_delay(value val) /* ML */ +CAMLprim caml_thread_delay(value val) { enter_blocking_section(); Sleep((DWORD)(Double_val(val)*1000)); /* milliseconds */ @@ -574,7 +586,7 @@ static struct custom_operations caml_condition_ops = { custom_deserialize_default }; -value caml_condition_new(value unit) /* ML */ +CAMLprim caml_condition_new(value unit) { value cond; cond = alloc_custom(&caml_condition_ops, sizeof(struct caml_condvar), @@ -586,7 +598,7 @@ value caml_condition_new(value unit) /* ML */ return cond; } -value caml_condition_wait(value cond, value mut) /* ML */ +CAMLprim caml_condition_wait(value cond, value mut) { int retcode; HANDLE m = Mutex_val(mut); @@ -609,7 +621,7 @@ value caml_condition_wait(value cond, value mut) /* ML */ return Val_unit; } -value caml_condition_signal(value cond) /* ML */ +CAMLprim caml_condition_signal(value cond) { HANDLE s = Condition_val(cond)->sem; @@ -625,7 +637,7 @@ value caml_condition_signal(value cond) /* ML */ return Val_unit; } -value caml_condition_broadcast(value cond) /* ML */ +CAMLprim caml_condition_broadcast(value cond) { HANDLE s = Condition_val(cond)->sem; unsigned long c = Condition_val(cond)->count; @@ -655,7 +667,7 @@ static void caml_wait_signal_handler(int signo) typedef void (*sighandler_type)(int); -value caml_wait_signal(value sigs) +CAMLprim value caml_wait_signal(value sigs) { HANDLE event; int res, s, retcode; diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index 4af085bb91..8ddbd8287c 100644 --- a/otherlibs/threads/Makefile +++ b/otherlibs/threads/Makefile @@ -15,8 +15,9 @@ include ../../config/Makefile CC=$(BYTECC) -CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) -g +CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../unix +MKLIB=../../tools/ocamlmklib C_OBJS=scheduler.o @@ -46,18 +47,16 @@ all: libthreads.a threads.cma stdlib.cma unix.cma allopt: libthreads.a: $(C_OBJS) - rm -f libthreads.a - ar rc libthreads.a $(C_OBJS) - $(RANLIB) libthreads.a + $(MKLIB) -o threads $(C_OBJS) threads.cma: $(CAML_OBJS) - $(CAMLC) -a -o threads.cma -custom $(CAML_OBJS) -cclib -lthreads + $(MKLIB) -ocamlc '$(CAMLC)' -o threads $(CAML_OBJS) stdlib.cma: $(LIB_OBJS) $(CAMLC) -a -o stdlib.cma $(LIB_OBJS) unix.cma: $(UNIXLIB_OBJS) - $(CAMLC) -a -linkall -custom -o unix.cma $(UNIXLIB_OBJS) -cclib -lunix + $(MKLIB) -ocamlc '$(CAMLC)' -o unix -linkall $(UNIXLIB_OBJS) pervasives.cmo: pervasives.mli pervasives.cmi pervasives.ml $(CAMLC) -nopervasives -c pervasives.ml @@ -94,6 +93,7 @@ clean: partialclean rm -f pervasives.mli marshal.mli unix.mli install: + test -f libthreads.so && cp libthreads.so $(LIBDIR)/libthreads.so cp libthreads.a $(LIBDIR)/libthreads.a cd $(LIBDIR); $(RANLIB) libthreads.a if test -d $(LIBDIR)/threads; then : ; else mkdir $(LIBDIR)/threads; fi diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index 809339c35f..081555a1a5 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -12,8 +12,8 @@ closedir.o: closedir.c unixsupport.h connect.o: connect.c unixsupport.h socketaddr.h cst2constr.o: cst2constr.c cst2constr.h cstringv.o: cstringv.c unixsupport.h -dup.o: dup.c unixsupport.h dup2.o: dup2.c unixsupport.h +dup.o: dup.c unixsupport.h envir.o: envir.c errmsg.o: errmsg.c execv.o: execv.c unixsupport.h @@ -71,8 +71,8 @@ setuid.o: setuid.c unixsupport.h shutdown.o: shutdown.c unixsupport.h signals.o: signals.c unixsupport.h sleep.o: sleep.c unixsupport.h -socket.o: socket.c unixsupport.h socketaddr.o: socketaddr.c unixsupport.h socketaddr.h +socket.o: socket.c unixsupport.h socketpair.o: socketpair.c unixsupport.h sockopt.o: sockopt.c unixsupport.h socketaddr.h stat.o: stat.c unixsupport.h cst2constr.h diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile index fe52678714..17288e3ab5 100644 --- a/otherlibs/unix/Makefile +++ b/otherlibs/unix/Makefile @@ -18,9 +18,10 @@ include ../../config/Makefile # Compilation options CC=$(BYTECC) -CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) +CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib +MKLIB=../../tools/ocamlmklib OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \ chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \ @@ -43,15 +44,13 @@ all: libunix.a unix.cmi unix.cma allopt: libunix.a unix.cmi unix.cmxa libunix.a: $(OBJS) - rm -f libunix.a - ar rc libunix.a $(OBJS) - $(RANLIB) libunix.a + $(MKLIB) -o unix $(OBJS) unix.cma: unix.cmo - $(CAMLC) -a -linkall -custom -o unix.cma unix.cmo -cclib -lunix + $(MKLIB) -o unix -ocamlc '$(CAMLC)' -linkall unix.cmo unix.cmxa: unix.cmx - $(CAMLOPT) -a -linkall -o unix.cmxa unix.cmx -cclib -lunix + $(MKLIB) -o unix -ocamlopt '$(CAMLOPT)' -linkall unix.cmx unix.cmx: ../../ocamlopt @@ -59,9 +58,10 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f *.a *.o + rm -f *.a *.o *.so install: + test -f libunix.so && cp libunix.so $(LIBDIR)/libunix.so cp libunix.a $(LIBDIR)/libunix.a cd $(LIBDIR); $(RANLIB) libunix.a cp unix.cmi unix.cma unix.mli $(LIBDIR) diff --git a/otherlibs/unix/accept.c b/otherlibs/unix/accept.c index 03f8c3c3c8..6f5ae2932f 100644 --- a/otherlibs/unix/accept.c +++ b/otherlibs/unix/accept.c @@ -22,7 +22,7 @@ #include "socketaddr.h" -value unix_accept(value sock) /* ML */ +CAMLprim value unix_accept(value sock) { int retcode; value res; @@ -46,6 +46,6 @@ value unix_accept(value sock) /* ML */ #else -value unix_accept(value sock) { invalid_argument("accept not implemented"); } +CAMLprim value unix_accept(value sock) { invalid_argument("accept not implemented"); } #endif diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c index 99432235e7..72e3d77fbe 100644 --- a/otherlibs/unix/access.c +++ b/otherlibs/unix/access.c @@ -39,7 +39,7 @@ static int access_permission_table[] = { R_OK, W_OK, X_OK, F_OK }; -value unix_access(value path, value perms) /* ML */ +CAMLprim value unix_access(value path, value perms) { int ret; ret = access(String_val(path), diff --git a/otherlibs/unix/addrofstr.c b/otherlibs/unix/addrofstr.c index ab9e271d26..7679180528 100644 --- a/otherlibs/unix/addrofstr.c +++ b/otherlibs/unix/addrofstr.c @@ -20,7 +20,7 @@ #include "socketaddr.h" -value unix_inet_addr_of_string(value s) /* ML */ +CAMLprim value unix_inet_addr_of_string(value s) { #ifdef HAS_INET_ATON struct in_addr address; @@ -37,7 +37,7 @@ value unix_inet_addr_of_string(value s) /* ML */ #else -value unix_inet_addr_of_string(value s) +CAMLprim value unix_inet_addr_of_string(value s) { invalid_argument("inet_addr_of_string not implemented"); } #endif diff --git a/otherlibs/unix/alarm.c b/otherlibs/unix/alarm.c index c52a4074f0..95f2a19e92 100644 --- a/otherlibs/unix/alarm.c +++ b/otherlibs/unix/alarm.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_alarm(t) /* ML */ +CAMLprim value unix_alarm(t) value t; { return Val_int(alarm((unsigned int) Long_val(t))); diff --git a/otherlibs/unix/bind.c b/otherlibs/unix/bind.c index aa111d3b74..9dd660d9b4 100644 --- a/otherlibs/unix/bind.c +++ b/otherlibs/unix/bind.c @@ -19,7 +19,7 @@ #include "socketaddr.h" -value unix_bind(value socket, value address) /* ML */ +CAMLprim value unix_bind(value socket, value address) { int ret; union sock_addr_union addr; @@ -33,7 +33,7 @@ value unix_bind(value socket, value address) /* ML */ #else -value unix_bind(value socket, value address) +CAMLprim value unix_bind(value socket, value address) { invalid_argument("bind not implemented"); } #endif diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c index 63c92c03a2..003e8e4cf5 100644 --- a/otherlibs/unix/chdir.c +++ b/otherlibs/unix/chdir.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_chdir(value path) /* ML */ +CAMLprim value unix_chdir(value path) { int ret; ret = chdir(String_val(path)); diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c index de13f4a429..9ab44e96cd 100644 --- a/otherlibs/unix/chmod.c +++ b/otherlibs/unix/chmod.c @@ -17,7 +17,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_chmod(value path, value perm) /* ML */ +CAMLprim value unix_chmod(value path, value perm) { int ret; ret = chmod(String_val(path), Int_val(perm)); diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c index 90034fa72f..5cc1c3e530 100644 --- a/otherlibs/unix/chown.c +++ b/otherlibs/unix/chown.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_chown(value path, value uid, value gid) /* ML */ +CAMLprim value unix_chown(value path, value uid, value gid) { int ret; ret = chown(String_val(path), Int_val(uid), Int_val(gid)); diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c index 5432789e32..fedb0de50b 100644 --- a/otherlibs/unix/chroot.c +++ b/otherlibs/unix/chroot.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_chroot(value path) /* ML */ +CAMLprim value unix_chroot(value path) { int ret; ret = chroot(String_val(path)); diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c index 0e2caae07f..be929cb6ef 100644 --- a/otherlibs/unix/close.c +++ b/otherlibs/unix/close.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_close(value fd) /* ML */ +CAMLprim value unix_close(value fd) { if (close(Int_val(fd)) == -1) uerror("close", Nothing); return Val_unit; diff --git a/otherlibs/unix/closedir.c b/otherlibs/unix/closedir.c index d44ba896a3..baa63b9ddb 100644 --- a/otherlibs/unix/closedir.c +++ b/otherlibs/unix/closedir.c @@ -21,7 +21,7 @@ #include <sys/dir.h> #endif -value unix_closedir(value d) /* ML */ +CAMLprim value unix_closedir(value d) { closedir((DIR *) d); return Val_unit; diff --git a/otherlibs/unix/connect.c b/otherlibs/unix/connect.c index fbe4a3276e..f74c275b31 100644 --- a/otherlibs/unix/connect.c +++ b/otherlibs/unix/connect.c @@ -20,7 +20,7 @@ #include "socketaddr.h" -value unix_connect(value socket, value address) /* ML */ +CAMLprim value unix_connect(value socket, value address) { int retcode; union sock_addr_union addr; @@ -36,7 +36,7 @@ value unix_connect(value socket, value address) /* ML */ #else -value unix_connect(value socket, value address) +CAMLprim value unix_connect(value socket, value address) { invalid_argument("connect not implemented"); } #endif diff --git a/otherlibs/unix/dup.c b/otherlibs/unix/dup.c index d4af26f5bc..d9c6d3bcba 100644 --- a/otherlibs/unix/dup.c +++ b/otherlibs/unix/dup.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_dup(value fd) /* ML */ +CAMLprim value unix_dup(value fd) { int ret; ret = dup(Int_val(fd)); diff --git a/otherlibs/unix/dup2.c b/otherlibs/unix/dup2.c index 96e841ff3b..e0b7568411 100644 --- a/otherlibs/unix/dup2.c +++ b/otherlibs/unix/dup2.c @@ -17,7 +17,7 @@ #ifdef HAS_DUP2 -value unix_dup2(value fd1, value fd2) /* ML */ +CAMLprim value unix_dup2(value fd1, value fd2) { if (dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing); return Val_unit; @@ -38,7 +38,7 @@ static int do_dup2(int fd1, int fd2) return res; } -value unix_dup2(value fd1, value fd2) +CAMLprim value unix_dup2(value fd1, value fd2) { close(Int_val(fd2)); if (do_dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing); diff --git a/otherlibs/unix/envir.c b/otherlibs/unix/envir.c index a25263c1cd..a9d36e96a0 100644 --- a/otherlibs/unix/envir.c +++ b/otherlibs/unix/envir.c @@ -15,9 +15,11 @@ #include <mlvalues.h> #include <alloc.h> +#ifndef _WIN32 extern char ** environ; +#endif -value unix_environment(void) /* ML */ +CAMLprim value unix_environment(void) { return copy_string_array((const char**)environ); } diff --git a/otherlibs/unix/errmsg.c b/otherlibs/unix/errmsg.c index 65d51a725e..9d218f9e2b 100644 --- a/otherlibs/unix/errmsg.c +++ b/otherlibs/unix/errmsg.c @@ -22,7 +22,7 @@ extern int error_table[]; extern char * strerror(int); -value unix_error_message(value err) /* ML */ +CAMLprim value unix_error_message(value err) { int errnum; errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)]; @@ -34,7 +34,7 @@ value unix_error_message(value err) /* ML */ extern int sys_nerr; extern char *sys_errlist[]; -value unix_error_message(value err) +CAMLprim value unix_error_message(value err) { int errnum; errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)]; diff --git a/otherlibs/unix/execv.c b/otherlibs/unix/execv.c index d7e3ddb440..0a56c4ae87 100644 --- a/otherlibs/unix/execv.c +++ b/otherlibs/unix/execv.c @@ -18,7 +18,7 @@ extern char ** cstringvect(); -value unix_execv(value path, value args) /* ML */ +CAMLprim value unix_execv(value path, value args) { char ** argv; argv = cstringvect(args); diff --git a/otherlibs/unix/execve.c b/otherlibs/unix/execve.c index ba88732888..bc5409f590 100644 --- a/otherlibs/unix/execve.c +++ b/otherlibs/unix/execve.c @@ -18,7 +18,7 @@ extern char ** cstringvect(); -value unix_execve(value path, value args, value env) /* ML */ +CAMLprim value unix_execve(value path, value args, value env) { char ** argv; char ** envp; diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c index 36f7284c51..657184e412 100644 --- a/otherlibs/unix/execvp.c +++ b/otherlibs/unix/execvp.c @@ -17,9 +17,11 @@ #include "unixsupport.h" extern char ** cstringvect(); +#ifndef _WIN32 extern char ** environ; +#endif -value unix_execvp(value path, value args) /* ML */ +CAMLprim value unix_execvp(value path, value args) { char ** argv; argv = cstringvect(args); @@ -30,7 +32,7 @@ value unix_execvp(value path, value args) /* ML */ /* from smart compilers */ } -value unix_execvpe(value path, value args, value env) /* ML */ +CAMLprim value unix_execvpe(value path, value args, value env) { char ** argv; char ** saved_environ; diff --git a/otherlibs/unix/exit.c b/otherlibs/unix/exit.c index 4511d4366b..604e70f846 100644 --- a/otherlibs/unix/exit.c +++ b/otherlibs/unix/exit.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_exit(value n) /* ML */ +CAMLprim value unix_exit(value n) { _exit(Int_val(n)); return Val_unit; /* never reached, but suppress warnings */ diff --git a/otherlibs/unix/fchmod.c b/otherlibs/unix/fchmod.c index e41357b33b..5bb03ff9cc 100644 --- a/otherlibs/unix/fchmod.c +++ b/otherlibs/unix/fchmod.c @@ -19,7 +19,7 @@ #ifdef HAS_FCHMOD -value unix_fchmod(value fd, value perm) /* ML */ +CAMLprim value unix_fchmod(value fd, value perm) { if (fchmod(Int_val(fd), Int_val(perm)) == -1) uerror("fchmod", Nothing); return Val_unit; @@ -27,7 +27,7 @@ value unix_fchmod(value fd, value perm) /* ML */ #else -value unix_fchmod(value fd, value perm) +CAMLprim value unix_fchmod(value fd, value perm) { invalid_argument("fchmod not implemented"); } #endif diff --git a/otherlibs/unix/fchown.c b/otherlibs/unix/fchown.c index caef5fd643..58a734c381 100644 --- a/otherlibs/unix/fchown.c +++ b/otherlibs/unix/fchown.c @@ -17,7 +17,7 @@ #ifdef HAS_FCHMOD -value unix_fchown(value fd, value uid, value gid) /* ML */ +CAMLprim value unix_fchown(value fd, value uid, value gid) { if (fchown(Int_val(fd), Int_val(uid), Int_val(gid)) == -1) uerror("fchown", Nothing); @@ -26,7 +26,7 @@ value unix_fchown(value fd, value uid, value gid) /* ML */ #else -value unix_fchown(value fd, value uid, value gid) +CAMLprim value unix_fchown(value fd, value uid, value gid) { invalid_argument("fchown not implemented"); } #endif diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c index d52dbc7332..58eff00e72 100644 --- a/otherlibs/unix/fcntl.c +++ b/otherlibs/unix/fcntl.c @@ -23,7 +23,7 @@ #define O_NONBLOCK O_NDELAY #endif -value unix_set_nonblock(value fd) /* ML */ +CAMLprim value unix_set_nonblock(value fd) { int retcode; retcode = fcntl(Int_val(fd), F_GETFL, 0); @@ -33,7 +33,7 @@ value unix_set_nonblock(value fd) /* ML */ return Val_unit; } -value unix_clear_nonblock(value fd) /* ML */ +CAMLprim value unix_clear_nonblock(value fd) { int retcode; retcode = fcntl(Int_val(fd), F_GETFL, 0); @@ -45,7 +45,7 @@ value unix_clear_nonblock(value fd) /* ML */ #ifdef FD_CLOEXEC -value unix_set_close_on_exec(value fd) /* ML */ +CAMLprim value unix_set_close_on_exec(value fd) { int retcode; retcode = fcntl(Int_val(fd), F_GETFD, 0); @@ -55,7 +55,7 @@ value unix_set_close_on_exec(value fd) /* ML */ return Val_unit; } -value unix_clear_close_on_exec(value fd) /* ML */ +CAMLprim value unix_clear_close_on_exec(value fd) { int retcode; retcode = fcntl(Int_val(fd), F_GETFD, 0); @@ -67,10 +67,10 @@ value unix_clear_close_on_exec(value fd) /* ML */ #else -value unix_set_close_on_exec(value fd) +CAMLprim value unix_set_close_on_exec(value fd) { invalid_argument("set_close_on_exec not implemented"); } -value unix_clear_close_on_exec(value fd) +CAMLprim value unix_clear_close_on_exec(value fd) { invalid_argument("clear_close_on_exec not implemented"); } #endif diff --git a/otherlibs/unix/fork.c b/otherlibs/unix/fork.c index 5d1017ca1c..6fd38f48b5 100644 --- a/otherlibs/unix/fork.c +++ b/otherlibs/unix/fork.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_fork(value unit) /* ML */ +CAMLprim value unix_fork(value unit) { int ret; ret = fork(); diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c index 7dbc957ddc..cc9f978c6b 100644 --- a/otherlibs/unix/ftruncate.c +++ b/otherlibs/unix/ftruncate.c @@ -17,7 +17,7 @@ #ifdef HAS_TRUNCATE -value unix_ftruncate(value fd, value len) /* ML */ +CAMLprim value unix_ftruncate(value fd, value len) { if (ftruncate(Int_val(fd), Long_val(len)) == -1) uerror("ftruncate", Nothing); @@ -26,7 +26,7 @@ value unix_ftruncate(value fd, value len) /* ML */ #else -value unix_ftruncate(value fd, value len) +CAMLprim value unix_ftruncate(value fd, value len) { invalid_argument("ftruncate not implemented"); } #endif diff --git a/otherlibs/unix/getcwd.c b/otherlibs/unix/getcwd.c index dd5194428b..3f8cf7d895 100644 --- a/otherlibs/unix/getcwd.c +++ b/otherlibs/unix/getcwd.c @@ -30,7 +30,7 @@ #ifdef HAS_GETCWD -value unix_getcwd(value unit) /* ML */ +CAMLprim value unix_getcwd(value unit) { char buff[PATH_MAX]; if (getcwd(buff, sizeof(buff)) == 0) uerror("getcwd", Nothing); @@ -40,7 +40,7 @@ value unix_getcwd(value unit) /* ML */ #else #ifdef HAS_GETWD -value unix_getcwd(value unit) +CAMLprim value unix_getcwd(value unit) { char buff[PATH_MAX]; if (getwd(buff) == 0) uerror("getcwd", copy_string(buff)); @@ -49,7 +49,7 @@ value unix_getcwd(value unit) #else -value unix_getcwd(value unit) +CAMLprim value unix_getcwd(value unit) { invalid_argument("getcwd not implemented"); } #endif diff --git a/otherlibs/unix/getegid.c b/otherlibs/unix/getegid.c index f0864c95cc..2d6a0a8162 100644 --- a/otherlibs/unix/getegid.c +++ b/otherlibs/unix/getegid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_getegid(void) /* ML */ +CAMLprim value unix_getegid(void) { return Val_int(getegid()); } diff --git a/otherlibs/unix/geteuid.c b/otherlibs/unix/geteuid.c index a018c9d0a0..6e80b18868 100644 --- a/otherlibs/unix/geteuid.c +++ b/otherlibs/unix/geteuid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_geteuid(void) /* ML */ +CAMLprim value unix_geteuid(void) { return Val_int(geteuid()); } diff --git a/otherlibs/unix/getgid.c b/otherlibs/unix/getgid.c index 06526f1de5..f64f885fd4 100644 --- a/otherlibs/unix/getgid.c +++ b/otherlibs/unix/getgid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_getgid(void) /* ML */ +CAMLprim value unix_getgid(void) { return Val_int(getgid()); } diff --git a/otherlibs/unix/getgr.c b/otherlibs/unix/getgr.c index 812b16828a..02fa6f2bf0 100644 --- a/otherlibs/unix/getgr.c +++ b/otherlibs/unix/getgr.c @@ -38,7 +38,7 @@ static value alloc_group_entry(struct group *entry) return res; } -value unix_getgrnam(value name) /* ML */ +CAMLprim value unix_getgrnam(value name) { struct group * entry; entry = getgrnam(String_val(name)); @@ -46,7 +46,7 @@ value unix_getgrnam(value name) /* ML */ return alloc_group_entry(entry); } -value unix_getgrgid(value gid) /* ML */ +CAMLprim value unix_getgrgid(value gid) { struct group * entry; entry = getgrgid(Int_val(gid)); diff --git a/otherlibs/unix/getgroups.c b/otherlibs/unix/getgroups.c index 3e42426728..d548aad4fe 100644 --- a/otherlibs/unix/getgroups.c +++ b/otherlibs/unix/getgroups.c @@ -24,7 +24,7 @@ #include <limits.h> #include "unixsupport.h" -value unix_getgroups(value unit) /* ML */ +CAMLprim value unix_getgroups(value unit) { gid_t gidset[NGROUPS_MAX]; int n; @@ -41,7 +41,7 @@ value unix_getgroups(value unit) /* ML */ #else -value unix_getgroups(value unit) +CAMLprim value unix_getgroups(value unit) { invalid_argument("getgroups not implemented"); } #endif diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c index ca22e39b34..65d10595c3 100644 --- a/otherlibs/unix/gethost.c +++ b/otherlibs/unix/gethost.c @@ -64,7 +64,7 @@ static value alloc_host_entry(struct hostent *entry) return res; } -value unix_gethostbyaddr(value a) /* ML */ +CAMLprim value unix_gethostbyaddr(value a) { uint32 adr; struct hostent * entry; @@ -76,7 +76,7 @@ value unix_gethostbyaddr(value a) /* ML */ return alloc_host_entry(entry); } -value unix_gethostbyname(value name) /* ML */ +CAMLprim value unix_gethostbyname(value name) { char hostname[256]; struct hostent * entry; @@ -91,10 +91,10 @@ value unix_gethostbyname(value name) /* ML */ #else -value unix_gethostbyaddr(value name) +CAMLprim value unix_gethostbyaddr(value name) { invalid_argument("gethostbyaddr not implemented"); } -value unix_gethostbyname(value name) +CAMLprim value unix_gethostbyname(value name) { invalid_argument("gethostbyname not implemented"); } #endif diff --git a/otherlibs/unix/gethostname.c b/otherlibs/unix/gethostname.c index 084c1c85af..ed12cb1d89 100644 --- a/otherlibs/unix/gethostname.c +++ b/otherlibs/unix/gethostname.c @@ -27,7 +27,7 @@ #define MAXHOSTNAMELEN 256 #endif -value unix_gethostname(value unit) /* ML */ +CAMLprim value unix_gethostname(value unit) { char name[MAXHOSTNAMELEN]; gethostname(name, MAXHOSTNAMELEN); @@ -40,7 +40,7 @@ value unix_gethostname(value unit) /* ML */ #include <sys/utsname.h> -value unix_gethostname(value unit) +CAMLprim value unix_gethostname(value unit) { struct utsname un; uname(&un); @@ -49,7 +49,7 @@ value unix_gethostname(value unit) #else -value unix_gethostname(value unit) +CAMLprim value unix_gethostname(value unit) { invalid_argument("gethostname not implemented"); } #endif diff --git a/otherlibs/unix/getlogin.c b/otherlibs/unix/getlogin.c index 18c7342213..c749da8b04 100644 --- a/otherlibs/unix/getlogin.c +++ b/otherlibs/unix/getlogin.c @@ -19,7 +19,7 @@ extern char * getlogin(void); -value unix_getlogin(void) /* ML */ +CAMLprim value unix_getlogin(void) { char * name; name = getlogin(); diff --git a/otherlibs/unix/getpeername.c b/otherlibs/unix/getpeername.c index 6c175bd895..1498bedb27 100644 --- a/otherlibs/unix/getpeername.c +++ b/otherlibs/unix/getpeername.c @@ -19,7 +19,7 @@ #include "socketaddr.h" -value unix_getpeername(value sock) /* ML */ +CAMLprim value unix_getpeername(value sock) { int retcode; union sock_addr_union addr; @@ -33,7 +33,7 @@ value unix_getpeername(value sock) /* ML */ #else -value unix_getpeername(value sock) +CAMLprim value unix_getpeername(value sock) { invalid_argument("getpeername not implemented"); } #endif diff --git a/otherlibs/unix/getpid.c b/otherlibs/unix/getpid.c index df39460389..37a4fadac7 100644 --- a/otherlibs/unix/getpid.c +++ b/otherlibs/unix/getpid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_getpid(void) /* ML */ +CAMLprim value unix_getpid(void) { return Val_int(getpid()); } diff --git a/otherlibs/unix/getppid.c b/otherlibs/unix/getppid.c index af5ca3e0d9..4cd09eae98 100644 --- a/otherlibs/unix/getppid.c +++ b/otherlibs/unix/getppid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_getppid(void) /* ML */ +CAMLprim value unix_getppid(void) { return Val_int(getppid()); } diff --git a/otherlibs/unix/getproto.c b/otherlibs/unix/getproto.c index 74d2ca551d..0158ae3c84 100644 --- a/otherlibs/unix/getproto.c +++ b/otherlibs/unix/getproto.c @@ -42,7 +42,7 @@ static value alloc_proto_entry(struct protoent *entry) return res; } -value unix_getprotobyname(value name) /* ML */ +CAMLprim value unix_getprotobyname(value name) { struct protoent * entry; entry = getprotobyname(String_val(name)); @@ -50,7 +50,7 @@ value unix_getprotobyname(value name) /* ML */ return alloc_proto_entry(entry); } -value unix_getprotobynumber(value proto) /* ML */ +CAMLprim value unix_getprotobynumber(value proto) { struct protoent * entry; entry = getprotobynumber(Int_val(proto)); @@ -60,10 +60,10 @@ value unix_getprotobynumber(value proto) /* ML */ #else -value unix_getprotobynumber(value proto) +CAMLprim value unix_getprotobynumber(value proto) { invalid_argument("getprotobynumber not implemented"); } -value unix_getprotobyname(value name) +CAMLprim value unix_getprotobyname(value name) { invalid_argument("getprotobyname not implemented"); } #endif diff --git a/otherlibs/unix/getpw.c b/otherlibs/unix/getpw.c index 6585cfc171..c0a315e213 100644 --- a/otherlibs/unix/getpw.c +++ b/otherlibs/unix/getpw.c @@ -47,7 +47,7 @@ static value alloc_passwd_entry(struct passwd *entry) return res; } -value unix_getpwnam(value name) /* ML */ +CAMLprim value unix_getpwnam(value name) { struct passwd * entry; entry = getpwnam(String_val(name)); @@ -55,7 +55,7 @@ value unix_getpwnam(value name) /* ML */ return alloc_passwd_entry(entry); } -value unix_getpwuid(value uid) /* ML */ +CAMLprim value unix_getpwuid(value uid) { struct passwd * entry; entry = getpwuid(Int_val(uid)); diff --git a/otherlibs/unix/getserv.c b/otherlibs/unix/getserv.c index b1f03c950d..cb36987111 100644 --- a/otherlibs/unix/getserv.c +++ b/otherlibs/unix/getserv.c @@ -48,7 +48,7 @@ static value alloc_service_entry(struct servent *entry) return res; } -value unix_getservbyname(value name, value proto) /* ML */ +CAMLprim value unix_getservbyname(value name, value proto) { struct servent * entry; entry = getservbyname(String_val(name), String_val(proto)); @@ -56,7 +56,7 @@ value unix_getservbyname(value name, value proto) /* ML */ return alloc_service_entry(entry); } -value unix_getservbyport(value port, value proto) /* ML */ +CAMLprim value unix_getservbyport(value port, value proto) { struct servent * entry; entry = getservbyport(htons(Int_val(port)), String_val(proto)); @@ -66,10 +66,10 @@ value unix_getservbyport(value port, value proto) /* ML */ #else -value unix_getservbyport(value port, value proto) +CAMLprim value unix_getservbyport(value port, value proto) { invalid_argument("getservbyport not implemented"); } -value unix_getservbyname(value name, value proto) +CAMLprim value unix_getservbyname(value name, value proto) { invalid_argument("getservbyname not implemented"); } #endif diff --git a/otherlibs/unix/getsockname.c b/otherlibs/unix/getsockname.c index 920900e48e..db6ccb2bf7 100644 --- a/otherlibs/unix/getsockname.c +++ b/otherlibs/unix/getsockname.c @@ -19,7 +19,7 @@ #include "socketaddr.h" -value unix_getsockname(value sock) /* ML */ +CAMLprim value unix_getsockname(value sock) { int retcode; union sock_addr_union addr; @@ -33,7 +33,7 @@ value unix_getsockname(value sock) /* ML */ #else -value unix_getsockname(value sock) +CAMLprim value unix_getsockname(value sock) { invalid_argument("getsockname not implemented"); } #endif diff --git a/otherlibs/unix/gettimeofday.c b/otherlibs/unix/gettimeofday.c index 5c50855b69..6e436b58da 100644 --- a/otherlibs/unix/gettimeofday.c +++ b/otherlibs/unix/gettimeofday.c @@ -21,7 +21,7 @@ #include <sys/types.h> #include <sys/time.h> -value unix_gettimeofday(value unit) /* ML */ +CAMLprim value unix_gettimeofday(value unit) { struct timeval tp; if (gettimeofday(&tp, NULL) == -1) uerror("gettimeofday", Nothing); @@ -30,7 +30,7 @@ value unix_gettimeofday(value unit) /* ML */ #else -value unix_gettimeofday(value unit) +CAMLprim value unix_gettimeofday(value unit) { invalid_argument("gettimeofday not implemented"); } #endif diff --git a/otherlibs/unix/getuid.c b/otherlibs/unix/getuid.c index 39387f5f7a..c3e2be6e97 100644 --- a/otherlibs/unix/getuid.c +++ b/otherlibs/unix/getuid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_getuid(void) /* ML */ +CAMLprim value unix_getuid(void) { return Val_int(getuid()); } diff --git a/otherlibs/unix/gmtime.c b/otherlibs/unix/gmtime.c index 2a75bce2c6..5a71e5e403 100644 --- a/otherlibs/unix/gmtime.c +++ b/otherlibs/unix/gmtime.c @@ -35,7 +35,7 @@ static value alloc_tm(struct tm *tm) return res; } -value unix_gmtime(value t) /* ML */ +CAMLprim value unix_gmtime(value t) { time_t clock; struct tm * tm; @@ -45,7 +45,7 @@ value unix_gmtime(value t) /* ML */ return alloc_tm(tm); } -value unix_localtime(value t) /* ML */ +CAMLprim value unix_localtime(value t) { time_t clock; struct tm * tm; @@ -57,7 +57,7 @@ value unix_localtime(value t) /* ML */ #ifdef HAS_MKTIME -value unix_mktime(value t) /* ML */ +CAMLprim value unix_mktime(value t) { struct tm tm; time_t clock; @@ -87,6 +87,6 @@ value unix_mktime(value t) /* ML */ #else -value unix_mktime(value t) { invalid_argument("mktime not implemented"); } +CAMLprim value unix_mktime(value t) { invalid_argument("mktime not implemented"); } #endif diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c index b3e298afc9..3bab202fd7 100644 --- a/otherlibs/unix/itimer.c +++ b/otherlibs/unix/itimer.c @@ -37,7 +37,7 @@ static value unix_convert_itimer(struct itimerval *tp) static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF }; -value unix_setitimer(value which, value newval) /* ML */ +CAMLprim value unix_setitimer(value which, value newval) { struct itimerval new, old; Set_timeval(new.it_interval, Double_field(newval, 0)); @@ -47,7 +47,7 @@ value unix_setitimer(value which, value newval) /* ML */ return unix_convert_itimer(&old); } -value unix_getitimer(value which) /* ML */ +CAMLprim value unix_getitimer(value which) { struct itimerval val; if (getitimer(itimers[Int_val(which)], &val) == -1) @@ -57,9 +57,9 @@ value unix_getitimer(value which) /* ML */ #else -value unix_setitimer(value which, value newval) +CAMLprim value unix_setitimer(value which, value newval) { invalid_argument("setitimer not implemented"); } -value unix_getitimer(value which) +CAMLprim value unix_getitimer(value which) { invalid_argument("getitimer not implemented"); } #endif diff --git a/otherlibs/unix/kill.c b/otherlibs/unix/kill.c index 264f9c76ef..36e81b391e 100644 --- a/otherlibs/unix/kill.c +++ b/otherlibs/unix/kill.c @@ -18,7 +18,7 @@ #include <signal.h> #include <signals.h> -value unix_kill(value pid, value signal) /* ML */ +CAMLprim value unix_kill(value pid, value signal) { int sig; sig = convert_signal_number(Int_val(signal)); diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c index 9afe116e43..81c06de925 100644 --- a/otherlibs/unix/link.c +++ b/otherlibs/unix/link.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_link(value path1, value path2) /* ML */ +CAMLprim value unix_link(value path1, value path2) { if (link(String_val(path1), String_val(path2)) == -1) uerror("link", path2); return Val_unit; diff --git a/otherlibs/unix/listen.c b/otherlibs/unix/listen.c index 15bccc0e8e..2a19bdcaa8 100644 --- a/otherlibs/unix/listen.c +++ b/otherlibs/unix/listen.c @@ -19,7 +19,7 @@ #include <sys/socket.h> -value unix_listen(value sock, value backlog) /* ML */ +CAMLprim value unix_listen(value sock, value backlog) { if (listen(Int_val(sock), Int_val(backlog)) == -1) uerror("listen", Nothing); return Val_unit; @@ -27,7 +27,7 @@ value unix_listen(value sock, value backlog) /* ML */ #else -value unix_listen(value sock, value backlog) +CAMLprim value unix_listen(value sock, value backlog) { invalid_argument("listen not implemented"); } #endif diff --git a/otherlibs/unix/lockf.c b/otherlibs/unix/lockf.c index 5a8ea43690..aed8710f7a 100644 --- a/otherlibs/unix/lockf.c +++ b/otherlibs/unix/lockf.c @@ -19,7 +19,7 @@ #if defined(F_GETLK) && defined(F_SETLK) && defined(F_SETLKW) -value unix_lockf(value fd, value cmd, value span) /* ML */ +CAMLprim value unix_lockf(value fd, value cmd, value span) { struct flock l; int ret; @@ -93,7 +93,7 @@ static int lock_command_table[] = { F_ULOCK, F_LOCK, F_TLOCK, F_TEST, F_LOCK, F_TLOCK }; -value unix_lockf(value fd, value cmd, value span) +CAMLprim value unix_lockf(value fd, value cmd, value span) { if (lockf(Int_val(fd), lock_command_table[Int_val(cmd)], Long_val(span)) == -1) uerror("lockf", Nothing); @@ -102,7 +102,7 @@ value unix_lockf(value fd, value cmd, value span) #else -value unix_lockf(value fd, value cmd, value span) +CAMLprim value unix_lockf(value fd, value cmd, value span) { invalid_argument("lockf not implemented"); } #endif diff --git a/otherlibs/unix/lseek.c b/otherlibs/unix/lseek.c index fc0a3b7fb0..567f44d4e2 100644 --- a/otherlibs/unix/lseek.c +++ b/otherlibs/unix/lseek.c @@ -27,7 +27,7 @@ static int seek_command_table[] = { SEEK_SET, SEEK_CUR, SEEK_END }; -value unix_lseek(value fd, value ofs, value cmd) /* ML */ +CAMLprim value unix_lseek(value fd, value ofs, value cmd) { long ret; ret = lseek(Int_val(fd), Long_val(ofs), diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c index 3630b2ee44..058ade946a 100644 --- a/otherlibs/unix/mkdir.c +++ b/otherlibs/unix/mkdir.c @@ -17,7 +17,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_mkdir(value path, value perm) /* ML */ +CAMLprim value unix_mkdir(value path, value perm) { if (mkdir(String_val(path), Int_val(perm)) == -1) uerror("mkdir", path); return Val_unit; diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c index 708a751999..997a0a5a70 100644 --- a/otherlibs/unix/mkfifo.c +++ b/otherlibs/unix/mkfifo.c @@ -19,7 +19,7 @@ #ifdef HAS_MKFIFO -value unix_mkfifo(value path, value mode) /* ML */ +CAMLprim value unix_mkfifo(value path, value mode) { if (mkfifo(String_val(path), Int_val(mode)) == -1) uerror("mkfifo", path); @@ -33,7 +33,7 @@ value unix_mkfifo(value path, value mode) /* ML */ #ifdef S_IFIFO -value unix_mkfifo(value path, value mode) +CAMLprim value unix_mkfifo(value path, value mode) { if (mknod(String_val(path), (Int_val(mode) & 07777) | S_IFIFO, 0) == -1) uerror("mkfifo", path); @@ -42,7 +42,7 @@ value unix_mkfifo(value path, value mode) #else -value unix_mkfifo() { invalid_argument("mkfifo not implemented"); } +CAMLprim value unix_mkfifo() { invalid_argument("mkfifo not implemented"); } #endif #endif diff --git a/otherlibs/unix/nice.c b/otherlibs/unix/nice.c index c9ea811345..068a9101ec 100644 --- a/otherlibs/unix/nice.c +++ b/otherlibs/unix/nice.c @@ -22,7 +22,7 @@ #include <sys/time.h> #include <sys/resource.h> -value unix_nice(value incr) /* ML */ +CAMLprim value unix_nice(value incr) { int prio; errno = 0; @@ -37,7 +37,7 @@ value unix_nice(value incr) /* ML */ #else -value unix_nice(value incr) +CAMLprim value unix_nice(value incr) { int ret; errno = 0; diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c index b151984126..068227a330 100644 --- a/otherlibs/unix/open.c +++ b/otherlibs/unix/open.c @@ -25,7 +25,7 @@ static int open_flag_table[] = { O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL }; -value unix_open(value path, value flags, value perm) /* ML */ +CAMLprim value unix_open(value path, value flags, value perm) { int ret; diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c index 567acdac1a..0a1c8b98e3 100644 --- a/otherlibs/unix/opendir.c +++ b/otherlibs/unix/opendir.c @@ -21,7 +21,7 @@ #include <sys/dir.h> #endif -value unix_opendir(value path) /* ML */ +CAMLprim value unix_opendir(value path) { DIR * d; d = opendir(String_val(path)); diff --git a/otherlibs/unix/pipe.c b/otherlibs/unix/pipe.c index c9dae68d22..36a1903efc 100644 --- a/otherlibs/unix/pipe.c +++ b/otherlibs/unix/pipe.c @@ -16,7 +16,7 @@ #include <alloc.h> #include "unixsupport.h" -value unix_pipe(void) /* ML */ +CAMLprim value unix_pipe(void) { int fd[2]; value res; diff --git a/otherlibs/unix/putenv.c b/otherlibs/unix/putenv.c index 257a5c58d4..c20fb8d254 100644 --- a/otherlibs/unix/putenv.c +++ b/otherlibs/unix/putenv.c @@ -22,7 +22,7 @@ #ifdef HAS_PUTENV -value unix_putenv(value name, value val) /* ML */ +CAMLprim value unix_putenv(value name, value val) { mlsize_t namelen = string_length(name); mlsize_t vallen = string_length(val); @@ -38,7 +38,7 @@ value unix_putenv(value name, value val) /* ML */ #else -value unix_putenv(value name, value val) +CAMLprim value unix_putenv(value name, value val) { invalid_argument("putenv not implemented"); } #endif diff --git a/otherlibs/unix/read.c b/otherlibs/unix/read.c index eab87d3440..ac83623996 100644 --- a/otherlibs/unix/read.c +++ b/otherlibs/unix/read.c @@ -18,7 +18,7 @@ #include <signals.h> #include "unixsupport.h" -value unix_read(value fd, value buf, value ofs, value len) /* ML */ +CAMLprim value unix_read(value fd, value buf, value ofs, value len) { long numbytes; int ret; diff --git a/otherlibs/unix/readdir.c b/otherlibs/unix/readdir.c index 6c059d8bcb..b3dd67dd9f 100644 --- a/otherlibs/unix/readdir.c +++ b/otherlibs/unix/readdir.c @@ -25,7 +25,7 @@ typedef struct dirent directory_entry; typedef struct direct directory_entry; #endif -value unix_readdir(value d) /* ML */ +CAMLprim value unix_readdir(value d) { directory_entry * e; diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c index 4bccff4072..e843b571d0 100644 --- a/otherlibs/unix/readlink.c +++ b/otherlibs/unix/readlink.c @@ -28,7 +28,7 @@ #endif #endif -value unix_readlink(value path) /* ML */ +CAMLprim value unix_readlink(value path) { char buffer[PATH_MAX]; int len; @@ -40,7 +40,7 @@ value unix_readlink(value path) /* ML */ #else -value unix_readlink(value path) +CAMLprim value unix_readlink(value path) { invalid_argument("readlink not implemented"); } #endif diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c index 727c901d50..619e643480 100644 --- a/otherlibs/unix/rename.c +++ b/otherlibs/unix/rename.c @@ -16,7 +16,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_rename(value path1, value path2) /* ML */ +CAMLprim value unix_rename(value path1, value path2) { if (rename(String_val(path1), String_val(path2)) == -1) uerror("rename", path1); diff --git a/otherlibs/unix/rewinddir.c b/otherlibs/unix/rewinddir.c index 38488f2ca2..fc59a5bf5b 100644 --- a/otherlibs/unix/rewinddir.c +++ b/otherlibs/unix/rewinddir.c @@ -23,7 +23,7 @@ #ifdef HAS_REWINDDIR -value unix_rewinddir(value d) /* ML */ +CAMLprim value unix_rewinddir(value d) { rewinddir((DIR *) d); return Val_unit; @@ -31,7 +31,7 @@ value unix_rewinddir(value d) /* ML */ #else -value unix_rewinddir(value d) +CAMLprim value unix_rewinddir(value d) { invalid_argument("rewinddir not implemented"); } #endif diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c index e08dcfcf2b..167d8c8c78 100644 --- a/otherlibs/unix/rmdir.c +++ b/otherlibs/unix/rmdir.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_rmdir(value path) /* ML */ +CAMLprim value unix_rmdir(value path) { if (rmdir(String_val(path)) == -1) uerror("rmdir", path); return Val_unit; diff --git a/otherlibs/unix/select.c b/otherlibs/unix/select.c index 07459fb6fb..681b0aaf3b 100644 --- a/otherlibs/unix/select.c +++ b/otherlibs/unix/select.c @@ -59,7 +59,7 @@ static value fdset_to_fdlist(file_descr_set *fdset) return res; } -value unix_select(value readfds, value writefds, value exceptfds, value timeout) /* ML */ +CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout) { file_descr_set read, write, except; double tm; @@ -98,7 +98,7 @@ value unix_select(value readfds, value writefds, value exceptfds, value timeout) #else -value unix_select(value readfds, value writefds, value exceptfds, value timeout) +CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout) { invalid_argument("select not implemented"); } #endif diff --git a/otherlibs/unix/sendrecv.c b/otherlibs/unix/sendrecv.c index f576fa4c7c..8aef019828 100644 --- a/otherlibs/unix/sendrecv.c +++ b/otherlibs/unix/sendrecv.c @@ -26,7 +26,7 @@ static int msg_flag_table[] = { MSG_OOB, MSG_DONTROUTE, MSG_PEEK }; -value unix_recv(value sock, value buff, value ofs, value len, value flags) /* ML */ +CAMLprim value unix_recv(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -45,7 +45,7 @@ value unix_recv(value sock, value buff, value ofs, value len, value flags) /* ML return Val_int(ret); } -value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) /* ML */ +CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -74,7 +74,7 @@ value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) / return res; } -value unix_send(value sock, value buff, value ofs, value len, value flags) /* ML */ +CAMLprim value unix_send(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -91,7 +91,7 @@ value unix_send(value sock, value buff, value ofs, value len, value flags) /* ML return Val_int(ret); } -value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest) +CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest) { int ret; long numbytes; @@ -112,7 +112,7 @@ value unix_sendto_native(value sock, value buff, value ofs, value len, value fla return Val_int(ret); } -value unix_sendto(value *argv, int argc) /* ML */ +CAMLprim value unix_sendto(value *argv, int argc) { return unix_sendto_native (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); @@ -120,19 +120,19 @@ value unix_sendto(value *argv, int argc) /* ML */ #else -value unix_recv(value sock, value buff, value ofs, value len, value flags) +CAMLprim value unix_recv(value sock, value buff, value ofs, value len, value flags) { invalid_argument("recv not implemented"); } -value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) +CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) { invalid_argument("recvfrom not implemented"); } -value unix_send(value sock, value buff, value ofs, value len, value flags) +CAMLprim value unix_send(value sock, value buff, value ofs, value len, value flags) { invalid_argument("send not implemented"); } -value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest) +CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest) { invalid_argument("sendto not implemented"); } -value unix_sendto(value *argv, int argc) +CAMLprim value unix_sendto(value *argv, int argc) { invalid_argument("sendto not implemented"); } #endif diff --git a/otherlibs/unix/setgid.c b/otherlibs/unix/setgid.c index f37b576297..c481594b41 100644 --- a/otherlibs/unix/setgid.c +++ b/otherlibs/unix/setgid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_setgid(value gid) /* ML */ +CAMLprim value unix_setgid(value gid) { if (setgid(Int_val(gid)) == -1) uerror("setgid", Nothing); return Val_unit; diff --git a/otherlibs/unix/setsid.c b/otherlibs/unix/setsid.c index c75893ac37..3c2bbaeddf 100644 --- a/otherlibs/unix/setsid.c +++ b/otherlibs/unix/setsid.c @@ -18,7 +18,7 @@ #include <unistd.h> #endif -value unix_setsid(value unit) /* ML */ +CAMLprim value unix_setsid(value unit) { #ifdef HAS_SETSID return Val_int(setsid()); diff --git a/otherlibs/unix/setuid.c b/otherlibs/unix/setuid.c index 7c613f04bc..346f948c41 100644 --- a/otherlibs/unix/setuid.c +++ b/otherlibs/unix/setuid.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_setuid(value uid) /* ML */ +CAMLprim value unix_setuid(value uid) { if (setuid(Int_val(uid)) == -1) uerror("setuid", Nothing); return Val_unit; diff --git a/otherlibs/unix/shutdown.c b/otherlibs/unix/shutdown.c index 7004752a9a..a6e3cf52c0 100644 --- a/otherlibs/unix/shutdown.c +++ b/otherlibs/unix/shutdown.c @@ -23,7 +23,7 @@ static int shutdown_command_table[] = { 0, 1, 2 }; -value unix_shutdown(value sock, value cmd) /* ML */ +CAMLprim value unix_shutdown(value sock, value cmd) { if (shutdown(Int_val(sock), shutdown_command_table[Int_val(cmd)]) == -1) uerror("shutdown", Nothing); @@ -32,7 +32,7 @@ value unix_shutdown(value sock, value cmd) /* ML */ #else -value unix_shutdown(value sock, value cmd) +CAMLprim value unix_shutdown(value sock, value cmd) { invalid_argument("shutdown not implemented"); } #endif diff --git a/otherlibs/unix/signals.c b/otherlibs/unix/signals.c index 9810d74393..3800c7238a 100644 --- a/otherlibs/unix/signals.c +++ b/otherlibs/unix/signals.c @@ -56,7 +56,7 @@ static value encode_sigset(sigset_t * set) static int sigprocmask_cmd[3] = { SIG_SETMASK, SIG_BLOCK, SIG_UNBLOCK }; -value unix_sigprocmask(value vaction, value vset) /* ML */ +CAMLprim value unix_sigprocmask(value vaction, value vset) { int how; sigset_t set, oldset; @@ -71,14 +71,14 @@ value unix_sigprocmask(value vaction, value vset) /* ML */ return encode_sigset(&oldset); } -value unix_sigpending(value unit) /* ML */ +CAMLprim value unix_sigpending(value unit) { sigset_t pending; if (sigpending(&pending) == -1) uerror("sigpending", Nothing); return encode_sigset(&pending); } -value unix_sigsuspend(value vset) /* ML */ +CAMLprim value unix_sigsuspend(value vset) { sigset_t set; int retcode; @@ -92,13 +92,13 @@ value unix_sigsuspend(value vset) /* ML */ #else -value unix_sigprocmask(value vaction, value vset) +CAMLprim value unix_sigprocmask(value vaction, value vset) { invalid_argument("Unix.sigprocmask not available"); } -value unix_sigpending(value unit) +CAMLprim value unix_sigpending(value unit) { invalid_argument("Unix.sigpending not available"); } -value unix_sigsuspend(value vset) +CAMLprim value unix_sigsuspend(value vset) { invalid_argument("Unix.sigsuspend not available"); } #endif diff --git a/otherlibs/unix/sleep.c b/otherlibs/unix/sleep.c index 69b317a05b..9044b84da6 100644 --- a/otherlibs/unix/sleep.c +++ b/otherlibs/unix/sleep.c @@ -16,7 +16,7 @@ #include <signals.h> #include "unixsupport.h" -value unix_sleep(value t) /* ML */ +CAMLprim value unix_sleep(value t) { enter_blocking_section(); sleep(Int_val(t)); diff --git a/otherlibs/unix/socket.c b/otherlibs/unix/socket.c index 4b678595c1..f7a8af079d 100644 --- a/otherlibs/unix/socket.c +++ b/otherlibs/unix/socket.c @@ -28,7 +28,7 @@ int socket_type_table[] = { SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET }; -value unix_socket(value domain, value type, value proto) /* ML */ +CAMLprim value unix_socket(value domain, value type, value proto) { int retcode; retcode = socket(socket_domain_table[Int_val(domain)], @@ -41,7 +41,7 @@ value unix_socket(value domain, value type, value proto) /* ML */ #else -value unix_socket(value domain, value type, value proto) +CAMLprim value unix_socket(value domain, value type, value proto) { invalid_argument("socket not implemented"); } #endif diff --git a/otherlibs/unix/socketaddr.h b/otherlibs/unix/socketaddr.h index 3fc8580922..df8e9b93af 100644 --- a/otherlibs/unix/socketaddr.h +++ b/otherlibs/unix/socketaddr.h @@ -36,8 +36,8 @@ typedef int socklen_param_type; void get_sockaddr (value mladdr, union sock_addr_union * addr /*out*/, socklen_param_type * addr_len /*out*/); -value alloc_sockaddr (union sock_addr_union * addr /*in*/, +CAMLprim value alloc_sockaddr (union sock_addr_union * addr /*in*/, socklen_param_type addr_len); -value alloc_inet_addr (uint32 inaddr); +CAMLprim value alloc_inet_addr (uint32 inaddr); #define GET_INET_ADDR(v) (*((uint32 *) (v))) diff --git a/otherlibs/unix/socketpair.c b/otherlibs/unix/socketpair.c index 6976d146fc..86c383b842 100644 --- a/otherlibs/unix/socketpair.c +++ b/otherlibs/unix/socketpair.c @@ -22,7 +22,7 @@ extern int socket_domain_table[], socket_type_table[]; -value unix_socketpair(value domain, value type, value proto) /* ML */ +CAMLprim value unix_socketpair(value domain, value type, value proto) { int sv[2]; value res; @@ -38,7 +38,7 @@ value unix_socketpair(value domain, value type, value proto) /* ML */ #else -value unix_socketpair(value domain, value type, value proto) +CAMLprim value unix_socketpair(value domain, value type, value proto) { invalid_argument("socketpair not implemented"); } #endif diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c index cd6e4b132d..210e2134b4 100644 --- a/otherlibs/unix/sockopt.c +++ b/otherlibs/unix/sockopt.c @@ -84,7 +84,7 @@ static int sockopt_optint[] = { SO_LINGER }; static int sockopt_float[] = { SO_RCVTIMEO, SO_SNDTIMEO }; -value getsockopt_int(int *sockopt, value socket, value level, value option) +CAMLprim value getsockopt_int(int *sockopt, value socket, value level, value option) { int optval; socklen_param_type optsize; @@ -96,7 +96,7 @@ value getsockopt_int(int *sockopt, value socket, value level, value option) return Val_int(optval); } -value setsockopt_int(int *sockopt, value socket, value level, +CAMLprim value setsockopt_int(int *sockopt, value socket, value level, value option, value status) { int optval = Int_val(status); @@ -106,25 +106,25 @@ value setsockopt_int(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_bool(value socket, value option) { /* ML */ +CAMLprim value unix_getsockopt_bool(value socket, value option) { /* ML */ return getsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_bool(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_bool(value socket, value option, value status) { return setsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option, status); } -value unix_getsockopt_int(value socket, value option) { /* ML */ +CAMLprim value unix_getsockopt_int(value socket, value option) { /* ML */ return getsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_int(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_int(value socket, value option, value status) { return setsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option, status); } -value getsockopt_optint(int *sockopt, value socket, value level, value option) +CAMLprim value getsockopt_optint(int *sockopt, value socket, value level, value option) { struct linger optval; socklen_param_type optsize; @@ -141,7 +141,7 @@ value getsockopt_optint(int *sockopt, value socket, value level, value option) return res; } -value setsockopt_optint(int *sockopt, value socket, value level, +CAMLprim value setsockopt_optint(int *sockopt, value socket, value level, value option, value status) { struct linger optval; @@ -155,17 +155,17 @@ value setsockopt_optint(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_optint(value socket, value option) /* ML */ +CAMLprim value unix_getsockopt_optint(value socket, value option) { return getsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_optint(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_optint(value socket, value option, value status) { return setsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option, status); } -value getsockopt_float(int *sockopt, value socket, value level, value option) +CAMLprim value getsockopt_float(int *sockopt, value socket, value level, value option) { struct timeval tv; socklen_param_type optsize; @@ -177,7 +177,7 @@ value getsockopt_float(int *sockopt, value socket, value level, value option) return copy_double((double) tv.tv_sec + (double) tv.tv_usec / 1e6); } -value setsockopt_float(int *sockopt, value socket, value level, +CAMLprim value setsockopt_float(int *sockopt, value socket, value level, value option, value status) { struct timeval tv; @@ -192,40 +192,40 @@ value setsockopt_float(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_float(value socket, value option) /* ML */ +CAMLprim value unix_getsockopt_float(value socket, value option) { return getsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_float(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_float(value socket, value option, value status) { return setsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option, status); } #else -value unix_getsockopt(value socket, value option) +CAMLprim value unix_getsockopt(value socket, value option) { invalid_argument("getsockopt not implemented"); } -value unix_setsockopt(value socket, value option, value status) +CAMLprim value unix_setsockopt(value socket, value option, value status) { invalid_argument("setsockopt not implemented"); } -value unix_getsockopt_int(value socket, value option) +CAMLprim value unix_getsockopt_int(value socket, value option) { invalid_argument("getsockopt_int not implemented"); } -value unix_setsockopt_int(value socket, value option, value status) +CAMLprim value unix_setsockopt_int(value socket, value option, value status) { invalid_argument("setsockopt_int not implemented"); } -value unix_getsockopt_optint(value socket, value option) +CAMLprim value unix_getsockopt_optint(value socket, value option) { invalid_argument("getsockopt_optint not implemented"); } -value unix_setsockopt_optint(value socket, value option, value status) +CAMLprim value unix_setsockopt_optint(value socket, value option, value status) { invalid_argument("setsockopt_optint not implemented"); } -value unix_getsockopt_float(value socket, value option) +CAMLprim value unix_getsockopt_float(value socket, value option) { invalid_argument("getsockopt_float not implemented"); } -value unix_setsockopt_float(value socket, value option, value status) +CAMLprim value unix_setsockopt_float(value socket, value option, value status) { invalid_argument("setsockopt_float not implemented"); } #endif diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c index 12b36e0986..a3c0f854f4 100644 --- a/otherlibs/unix/stat.c +++ b/otherlibs/unix/stat.c @@ -64,7 +64,7 @@ static value stat_aux(struct stat *buf) return v; } -value unix_stat(value path) /* ML */ +CAMLprim value unix_stat(value path) { int ret; struct stat buf; @@ -73,7 +73,7 @@ value unix_stat(value path) /* ML */ return stat_aux(&buf); } -value unix_lstat(value path) /* ML */ +CAMLprim value unix_lstat(value path) { int ret; struct stat buf; @@ -86,7 +86,7 @@ value unix_lstat(value path) /* ML */ return stat_aux(&buf); } -value unix_fstat(value fd) /* ML */ +CAMLprim value unix_fstat(value fd) { int ret; struct stat buf; diff --git a/otherlibs/unix/strofaddr.c b/otherlibs/unix/strofaddr.c index 4bbc206a92..e89ad9dbf1 100644 --- a/otherlibs/unix/strofaddr.c +++ b/otherlibs/unix/strofaddr.c @@ -20,7 +20,7 @@ #include "socketaddr.h" -value unix_string_of_inet_addr(value a) /* ML */ +CAMLprim value unix_string_of_inet_addr(value a) { struct in_addr address; address.s_addr = GET_INET_ADDR(a); @@ -29,7 +29,7 @@ value unix_string_of_inet_addr(value a) /* ML */ #else -value unix_string_of_inet_addr(value a) +CAMLprim value unix_string_of_inet_addr(value a) { invalid_argument("string_of_inet_addr not implemented"); } #endif diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c index c0314c48cb..e24e68ef71 100644 --- a/otherlibs/unix/symlink.c +++ b/otherlibs/unix/symlink.c @@ -17,7 +17,7 @@ #ifdef HAS_SYMLINK -value unix_symlink(value path1, value path2) /* ML */ +CAMLprim value unix_symlink(value path1, value path2) { if (symlink(String_val(path1), String_val(path2)) == -1) uerror("symlink", path2); @@ -26,7 +26,7 @@ value unix_symlink(value path1, value path2) /* ML */ #else -value unix_symlink(value path1, value path2) +CAMLprim value unix_symlink(value path1, value path2) { invalid_argument("symlink not implemented"); } #endif diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c index 9a8b586165..29f8c70ca9 100644 --- a/otherlibs/unix/termios.c +++ b/otherlibs/unix/termios.c @@ -229,7 +229,7 @@ static void decode_terminal_status(value *src) } } -value unix_tcgetattr(value fd) /* ML */ +CAMLprim value unix_tcgetattr(value fd) { value res; @@ -244,7 +244,7 @@ static int when_flag_table[] = { TCSANOW, TCSADRAIN, TCSAFLUSH }; -value unix_tcsetattr(value fd, value when, value arg) /* ML */ +CAMLprim value unix_tcsetattr(value fd, value when, value arg) { if (tcgetattr(Int_val(fd), &terminal_status) == -1) uerror("tcsetattr", Nothing); @@ -256,14 +256,14 @@ value unix_tcsetattr(value fd, value when, value arg) /* ML */ return Val_unit; } -value unix_tcsendbreak(value fd, value delay) /* ML */ +CAMLprim value unix_tcsendbreak(value fd, value delay) { if (tcsendbreak(Int_val(fd), Int_val(delay)) == -1) uerror("tcsendbreak", Nothing); return Val_unit; } -value unix_tcdrain(value fd) /* ML */ +CAMLprim value unix_tcdrain(value fd) { if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing); return Val_unit; @@ -273,7 +273,7 @@ static int queue_flag_table[] = { TCIFLUSH, TCOFLUSH, TCIOFLUSH }; -value unix_tcflush(value fd, value queue) /* ML */ +CAMLprim value unix_tcflush(value fd, value queue) { if (tcflush(Int_val(fd), queue_flag_table[Int_val(queue)]) == -1) uerror("tcflush", Nothing); @@ -284,7 +284,7 @@ static int action_flag_table[] = { TCOOFF, TCOON, TCIOFF, TCION }; -value unix_tcflow(value fd, value action) /* ML */ +CAMLprim value unix_tcflow(value fd, value action) { if (tcflow(Int_val(fd), action_flag_table[Int_val(action)]) == -1) uerror("tcflow", Nothing); @@ -293,22 +293,22 @@ value unix_tcflow(value fd, value action) /* ML */ #else -value unix_tcgetattr(value fd) +CAMLprim value unix_tcgetattr(value fd) { invalid_argument("tcgetattr not implemented"); } -value unix_tcsetattr(value fd, value when, value arg) +CAMLprim value unix_tcsetattr(value fd, value when, value arg) { invalid_argument("tcsetattr not implemented"); } -value unix_tcsendbreak(value fd, value delay) +CAMLprim value unix_tcsendbreak(value fd, value delay) { invalid_argument("tcsendbreak not implemented"); } -value unix_tcdrain(value fd) +CAMLprim value unix_tcdrain(value fd) { invalid_argument("tcdrain not implemented"); } -value unix_tcflush(value fd, value queue) +CAMLprim value unix_tcflush(value fd, value queue) { invalid_argument("tcflush not implemented"); } -value unix_tcflow(value fd, value action) +CAMLprim value unix_tcflow(value fd, value action) { invalid_argument("tcflow not implemented"); } #endif diff --git a/otherlibs/unix/time.c b/otherlibs/unix/time.c index 936b96b692..1d32c22c43 100644 --- a/otherlibs/unix/time.c +++ b/otherlibs/unix/time.c @@ -17,7 +17,7 @@ #include <alloc.h> #include "unixsupport.h" -value unix_time(void) /* ML */ +CAMLprim value unix_time(void) { return copy_double((double) time((time_t *) NULL)); } diff --git a/otherlibs/unix/times.c b/otherlibs/unix/times.c index fc0c4c4322..fecc272b51 100644 --- a/otherlibs/unix/times.c +++ b/otherlibs/unix/times.c @@ -28,7 +28,7 @@ #endif #endif -value unix_times(void) /* ML */ +CAMLprim value unix_times(void) { value res; struct tms buffer; diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c index b05f65c84f..57d9123177 100644 --- a/otherlibs/unix/truncate.c +++ b/otherlibs/unix/truncate.c @@ -17,7 +17,7 @@ #ifdef HAS_TRUNCATE -value unix_truncate(value path, value len) /* ML */ +CAMLprim value unix_truncate(value path, value len) { if (truncate(String_val(path), Long_val(len)) == -1) uerror("truncate", path); @@ -26,7 +26,7 @@ value unix_truncate(value path, value len) /* ML */ #else -value unix_truncate(value path, value len) +CAMLprim value unix_truncate(value path, value len) { invalid_argument("truncate not implemented"); } #endif diff --git a/otherlibs/unix/umask.c b/otherlibs/unix/umask.c index 1833e4c52d..9750f7fc56 100644 --- a/otherlibs/unix/umask.c +++ b/otherlibs/unix/umask.c @@ -17,7 +17,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_umask(value perm) /* ML */ +CAMLprim value unix_umask(value perm) { return Val_int(umask(Int_val(perm))); } diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c index 44234181eb..ae21169486 100644 --- a/otherlibs/unix/unlink.c +++ b/otherlibs/unix/unlink.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_unlink(value path) /* ML */ +CAMLprim value unix_unlink(value path) { if (unlink(String_val(path)) == -1) uerror("unlink", path); return Val_unit; diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c index 97d8958ff3..abd3e3423a 100644 --- a/otherlibs/unix/utimes.c +++ b/otherlibs/unix/utimes.c @@ -24,7 +24,7 @@ #include <sys/utime.h> #endif -value unix_utimes(value path, value atime, value mtime) /* ML */ +CAMLprim value unix_utimes(value path, value atime, value mtime) { struct utimbuf times, * t; times.actime = Double_val(atime); @@ -44,7 +44,7 @@ value unix_utimes(value path, value atime, value mtime) /* ML */ #include <sys/types.h> #include <sys/time.h> -value unix_utimes(value path, value atime, value mtime) /* ML */ +CAMLprim value unix_utimes(value path, value atime, value mtime) { struct timeval tv[2], * t; double at = Double_val(atime); @@ -63,7 +63,7 @@ value unix_utimes(value path, value atime, value mtime) /* ML */ #else -value unix_utimes(value path, value atime, value mtime) +CAMLprim value unix_utimes(value path, value atime, value mtime) { invalid_argument("utimes not implemented"); } #endif diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c index 9e252a7802..f8c12d5e49 100644 --- a/otherlibs/unix/wait.c +++ b/otherlibs/unix/wait.c @@ -59,7 +59,7 @@ static value alloc_process_status(int pid, int status) return res; } -value unix_wait(void) /* ML */ +CAMLprim value unix_wait(void) { int pid, status; @@ -80,7 +80,7 @@ static int wait_flag_table[] = { WNOHANG, WUNTRACED }; -value unix_waitpid(value flags, value pid_req) /* ML */ +CAMLprim value unix_waitpid(value flags, value pid_req) { int pid, status; @@ -94,7 +94,7 @@ value unix_waitpid(value flags, value pid_req) /* ML */ #else -value unix_waitpid(value flags, value pid_req) +CAMLprim value unix_waitpid(value flags, value pid_req) { invalid_argument("waitpid not implemented"); } #endif diff --git a/otherlibs/unix/write.c b/otherlibs/unix/write.c index b887f213cf..447ceeef76 100644 --- a/otherlibs/unix/write.c +++ b/otherlibs/unix/write.c @@ -26,7 +26,7 @@ #define EWOULDBLOCK (-1) #endif -value unix_write(value fd, value buf, value vofs, value vlen) /* ML */ +CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) { long ofs, len, written; int numbytes, ret; diff --git a/otherlibs/win32unix/.depend b/otherlibs/win32unix/.depend index c4d3aaa137..1cd8a9a026 100644 --- a/otherlibs/win32unix/.depend +++ b/otherlibs/win32unix/.depend @@ -1,6 +1,36 @@ -envir.o: envir.c - -errmsg.o: errmsg.c - -startup.o: startup.c - +accept.dobj accept.sobj: accept.c unixsupport.h socketaddr.h +bind.dobj bind.sobj: bind.c unixsupport.h socketaddr.h +channels.dobj channels.sobj: channels.c unixsupport.h +close.dobj close.sobj: close.c unixsupport.h +close_on.o: close_on.c unixsupport.h +connect.dobj connect.sobj: connect.c unixsupport.h socketaddr.h +createprocess.dobj createprocess.sobj: createprocess.c unixsupport.h +dup.dobj dup.sobj: dup.c unixsupport.h +dup2.o: dup2.c unixsupport.h +errmsg.dobj errmsg.sobj: errmsg.c unixsupport.h +getpeername.dobj getpeername.sobj: getpeername.c unixsupport.h \ + socketaddr.h +getpid.dobj getpid.sobj: getpid.c unixsupport.h +getsockname.dobj getsockname.sobj: getsockname.c unixsupport.h \ + socketaddr.h +gettimeofday.dobj gettimeofday.sobj: gettimeofday.c unixsupport.h +link.dobj link.sobj: link.c unixsupport.h +listen.dobj listen.sobj: listen.c unixsupport.h +lseek.dobj lseek.sobj: lseek.c unixsupport.h +mkdir.dobj mkdir.sobj: mkdir.c unixsupport.h +open.dobj open.sobj: open.c unixsupport.h +pipe.dobj pipe.sobj: pipe.c unixsupport.h +read.dobj read.sobj: read.c unixsupport.h +select.dobj select.sobj: select.c unixsupport.h +sendrecv.dobj sendrecv.sobj: sendrecv.c unixsupport.h socketaddr.h +shutdown.dobj shutdown.sobj: shutdown.c unixsupport.h +sleep.dobj sleep.sobj: sleep.c unixsupport.h +socket.dobj socket.sobj: socket.c unixsupport.h +sockopt.dobj sockopt.sobj: sockopt.c unixsupport.h +startup.dobj startup.sobj: startup.c +system.dobj system.sobj: system.c unixsupport.h +unixsupport.dobj unixsupport.sobj: unixsupport.c unixsupport.h \ + ../unix/cst2constr.h +windir.dobj windir.sobj: windir.c unixsupport.h +winwait.dobj winwait.sobj: winwait.c unixsupport.h +write.dobj write.sobj: write.c unixsupport.h diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt index f7931d27e5..045c7257e1 100644 --- a/otherlibs/win32unix/Makefile.nt +++ b/otherlibs/win32unix/Makefile.nt @@ -16,13 +16,13 @@ # Compilation options CC=$(BYTECC) -CFLAGS=-I..\..\byterun -I..\unix $(BYTECCCOMPOPTS) +CFLAGS=-I..\..\byterun -I..\unix CAMLC=..\..\boot\ocamlrun ..\..\ocamlc -I ..\..\stdlib CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib # Files in this directory WIN_OBJS = accept.obj bind.obj channels.obj close.obj \ - close_on.obj connect.obj createprocess.obj dup.obj dup2.obj \ + close_on.obj connect.obj createprocess.obj dup.obj dup2.obj errmsg.obj \ getpeername.obj getpid.obj getsockname.obj gettimeofday.obj \ link.obj listen.obj lseek.obj \ mkdir.obj open.obj pipe.obj read.obj select.obj sendrecv.obj \ @@ -31,7 +31,7 @@ WIN_OBJS = accept.obj bind.obj channels.obj close.obj \ # Files from the ..\unix directory UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \ - cstringv.c envir.c errmsg.c execv.c execve.c execvp.c \ + cstringv.c envir.c execv.c execve.c execvp.c \ exit.c getcwd.c gethost.c gethostname.c getproto.c \ getserv.c gmtime.c putenv.c rename.c rmdir.c \ socketaddr.c stat.c strofaddr.c time.c unlink.c utimes.c @@ -43,13 +43,18 @@ C_OBJS=$(WIN_OBJS) $(UNIX_OBJS) CAML_OBJS=unix.cmo CAMLOPT_OBJS=unix.cmx -all: libunix.lib unix.cma +all: libunix.dll libunix.lib unix.cma allopt: libunix.lib unix.cmxa -libunix.lib: copy_unix_files io.h $(C_OBJS) +libunix.dll: copy_unix_files io.h $(C_OBJS:.obj=.dobj) + link /nologo /dll /out:libunix.dll /implib:tmp.lib \ + $(C_OBJS:.obj=.dobj) ..\..\byterun\ocamlrun.lib wsock32.lib + rm tmp.* + +libunix.lib: copy_unix_files io.h $(C_OBJS:.obj=.sobj) rm -f libunix.lib - $(MKLIB)libunix.lib $(C_OBJS) + $(MKLIB)libunix.lib $(C_OBJS:.obj=.sobj) copy_unix_files: @- cd ..\unix & cp -p -u -v $(UNIX_FILES) ../win32unix @@ -60,8 +65,8 @@ io.h: $(SYSTEM_INCLUDES)\io.h copy $(SYSTEM_INCLUDES)\io.h io.h unix.cma: $(CAML_OBJS) - $(CAMLC) -a -linkall -o unix.cma -custom $(CAML_OBJS) \ - -cclib -lunix wsock32.lib + $(CAMLC) -a -linkall -o unix.cma $(CAML_OBJS) \ + -cclib -lunix unix.cmxa: $(CAMLOPT_OBJS) $(CAMLOPT) -a -linkall -o unix.cmxa $(CAMLOPT_OBJS) \ @@ -71,18 +76,19 @@ partialclean: rm -f *.cm* clean: partialclean - rm -f *.lib *.obj + rm -f *.lib *.dll *.exp *.sobj *.dobj rm -f $(UNIX_FILES) rm -f io.h install: + cp libunix.dll $(LIBDIR)/libunix.dll cp libunix.lib $(LIBDIR)/libunix.lib cp unix.cmi unix.cma $(LIBDIR) installopt: cp unix.cmxa unix.cmx unix.lib $(LIBDIR) -.SUFFIXES: .ml .mli .cmo .cmi .cmx +.SUFFIXES: .ml .mli .cmo .cmi .cmx .dobj .sobj .mli.cmi: $(CAMLC) -c $(COMPFLAGS) $< @@ -93,9 +99,15 @@ installopt: .ml.cmx: $(CAMLOPT) -c $(COMPFLAGS) $< +.c.dobj: + $(BYTECC) $(DLLCCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.dobj + +.c.sobj: + $(BYTECC) $(BYTECCCOMPOPTS) $(CFLAGS) -c $< + mv $*.obj $*.sobj + depend: - gcc -MM -I../../byterun *.c > .depend - ..\..\boot\ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend unix.cmi: unix.mli unix.cmo: unix.cmi diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c index fcd3fa514c..e907a1d2b4 100644 --- a/otherlibs/win32unix/accept.c +++ b/otherlibs/win32unix/accept.c @@ -18,7 +18,7 @@ #include "unixsupport.h" #include "socketaddr.h" -value unix_accept(sock) /* ML */ +CAMLprim value unix_accept(sock) value sock; { SOCKET sconn = (SOCKET) Handle_val(sock); diff --git a/otherlibs/win32unix/bind.c b/otherlibs/win32unix/bind.c index 58e4b60e04..b1b23f8169 100644 --- a/otherlibs/win32unix/bind.c +++ b/otherlibs/win32unix/bind.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include "socketaddr.h" -value unix_bind(socket, address) /* ML */ +CAMLprim value unix_bind(socket, address) value socket, address; { int ret; diff --git a/otherlibs/win32unix/channels.c b/otherlibs/win32unix/channels.c index 4cd27a7681..09ef985729 100644 --- a/otherlibs/win32unix/channels.c +++ b/otherlibs/win32unix/channels.c @@ -17,14 +17,14 @@ #include "unixsupport.h" #include <fcntl.h> -value win_fd_handle(value handle) /* ML */ +CAMLprim value win_fd_handle(value handle) { int fd = _open_osfhandle((long) Handle_val(handle), O_BINARY); if (fd == -1) uerror("channel_of_descr", Nothing); return Val_int(fd); } -value win_handle_fd(value fd) /* ML */ +CAMLprim value win_handle_fd(value fd) { return win_alloc_handle((HANDLE) _get_osfhandle(Int_val(fd))); } diff --git a/otherlibs/win32unix/close.c b/otherlibs/win32unix/close.c index 192f5570f3..4349d6b551 100644 --- a/otherlibs/win32unix/close.c +++ b/otherlibs/win32unix/close.c @@ -15,10 +15,10 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_close(value fd) /* ML */ +CAMLprim value unix_close(value fd) { if (! CloseHandle(Handle_val(fd))) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("close", Nothing); } return Val_unit; diff --git a/otherlibs/win32unix/close_on.c b/otherlibs/win32unix/close_on.c index 56ba4e878f..a1eac30d40 100644 --- a/otherlibs/win32unix/close_on.c +++ b/otherlibs/win32unix/close_on.c @@ -24,7 +24,7 @@ int win_set_inherit(value fd, BOOL inherit) if (! DuplicateHandle(GetCurrentProcess(), oldh, GetCurrentProcess(), &newh, 0L, inherit, DUPLICATE_SAME_ACCESS)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); return -1; } Handle_val(fd) = newh; @@ -32,13 +32,13 @@ int win_set_inherit(value fd, BOOL inherit) return 0; } -value win_set_close_on_exec(value fd) /* ML */ +CAMLprim value win_set_close_on_exec(value fd) { if (win_set_inherit(fd, FALSE) == -1) uerror("set_close_on_exec", Nothing); return Val_unit; } -value win_clear_close_on_exec(value fd) /* ML */ +CAMLprim value win_clear_close_on_exec(value fd) { if (win_set_inherit(fd, TRUE) == -1) uerror("clear_close_on_exec", Nothing); return Val_unit; diff --git a/otherlibs/win32unix/connect.c b/otherlibs/win32unix/connect.c index dabcc4e848..d921c0e84c 100644 --- a/otherlibs/win32unix/connect.c +++ b/otherlibs/win32unix/connect.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include "socketaddr.h" -value unix_connect(socket, address) /* ML */ +CAMLprim value unix_connect(socket, address) value socket, address; { SOCKET s = (SOCKET) Handle_val(socket); diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c index d0e2abba97..6e84c78daf 100644 --- a/otherlibs/win32unix/createprocess.c +++ b/otherlibs/win32unix/createprocess.c @@ -14,11 +14,9 @@ #include <windows.h> #include <mlvalues.h> +#include <osdeps.h> #include "unixsupport.h" -/* From the Caml runtime */ -extern char * searchpath(char * name); - static int win_has_console(void); value win_create_process_native(value cmd, value cmdline, value env, @@ -29,8 +27,7 @@ value win_create_process_native(value cmd, value cmdline, value env, char * exefile, * envp; int flags; - exefile = searchpath(String_val(cmd)); - if (exefile == NULL) exefile = String_val(cmd); + exefile = search_exe_in_path(String_val(cmd)); if (env != Val_int(0)) { envp = String_val(Field(env, 0)); } else { @@ -54,7 +51,7 @@ value win_create_process_native(value cmd, value cmdline, value env, /* Create the process */ if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL, TRUE, flags, envp, NULL, &si, &pi)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("create_process", cmd); } CloseHandle(pi.hThread); @@ -63,7 +60,7 @@ value win_create_process_native(value cmd, value cmdline, value env, return Val_int(pi.hProcess); } -value win_create_process(value * argv, int argn) /* ML */ +CAMLprim value win_create_process(value * argv, int argn) { return win_create_process_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); diff --git a/otherlibs/win32unix/dup.c b/otherlibs/win32unix/dup.c index 9a00cb7624..15d20fd8e1 100644 --- a/otherlibs/win32unix/dup.c +++ b/otherlibs/win32unix/dup.c @@ -15,13 +15,13 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_dup(value fd) /* ML */ +CAMLprim value unix_dup(value fd) { HANDLE newh; if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd), GetCurrentProcess(), &newh, 0L, TRUE, DUPLICATE_SAME_ACCESS)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); return -1; } return win_alloc_handle(newh); diff --git a/otherlibs/win32unix/dup2.c b/otherlibs/win32unix/dup2.c index 64e7fab5a0..d16eb84961 100644 --- a/otherlibs/win32unix/dup2.c +++ b/otherlibs/win32unix/dup2.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_dup2(value fd1, value fd2) /* ML */ +CAMLprim value unix_dup2(value fd1, value fd2) { HANDLE oldh, newh; @@ -23,7 +23,7 @@ value unix_dup2(value fd1, value fd2) /* ML */ if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1), GetCurrentProcess(), &newh, 0L, TRUE, DUPLICATE_SAME_ACCESS)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); return -1; } Handle_val(fd2) = newh; diff --git a/otherlibs/win32unix/errmsg.c b/otherlibs/win32unix/errmsg.c new file mode 100644 index 0000000000..7a6cf654ec --- /dev/null +++ b/otherlibs/win32unix/errmsg.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" + +extern int error_table[]; + +CAMLprim value unix_error_message(value err) +{ + int errnum; + char buffer[512]; + + errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)]; + if (errnum > 0) + return copy_string(strerror(errnum)); + if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + -errnum, + 0, + buffer, + sizeof(buffer), + NULL)) + return copy_string(buffer); + return copy_string("unknown error"); +} + diff --git a/otherlibs/win32unix/getpeername.c b/otherlibs/win32unix/getpeername.c index 9bf4ee69fc..135b6d3fd8 100644 --- a/otherlibs/win32unix/getpeername.c +++ b/otherlibs/win32unix/getpeername.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include "socketaddr.h" -value unix_getpeername(sock) /* ML */ +CAMLprim value unix_getpeername(sock) value sock; { int retcode; diff --git a/otherlibs/win32unix/getpid.c b/otherlibs/win32unix/getpid.c index 1248fbcb6f..b33992265b 100644 --- a/otherlibs/win32unix/getpid.c +++ b/otherlibs/win32unix/getpid.c @@ -17,7 +17,7 @@ extern value val_process_id; -value unix_getpid(value unit) /* ML */ +CAMLprim value unix_getpid(value unit) { return val_process_id; } diff --git a/otherlibs/win32unix/getsockname.c b/otherlibs/win32unix/getsockname.c index 8faf5ba1c4..43fd921f9f 100644 --- a/otherlibs/win32unix/getsockname.c +++ b/otherlibs/win32unix/getsockname.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include "socketaddr.h" -value unix_getsockname(sock) /* ML */ +CAMLprim value unix_getsockname(sock) value sock; { int retcode; diff --git a/otherlibs/win32unix/gettimeofday.c b/otherlibs/win32unix/gettimeofday.c index 7285a51d66..0f66131551 100644 --- a/otherlibs/win32unix/gettimeofday.c +++ b/otherlibs/win32unix/gettimeofday.c @@ -21,7 +21,7 @@ static time_t initial_time = 0; /* 0 means uninitialized */ static DWORD initial_tickcount; -value unix_gettimeofday(value unit) /* ML */ +CAMLprim value unix_gettimeofday(value unit) { if (initial_time == 0) { initial_tickcount = GetTickCount(); diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c index cc05646cb7..99ba58ba07 100644 --- a/otherlibs/win32unix/link.c +++ b/otherlibs/win32unix/link.c @@ -24,7 +24,7 @@ BOOL (WINAPI *tCreateHardLink)( LPSECURITY_ATTRIBUTES lpSecurityAttributes ); -value unix_link(value path1, value path2) /* ML */ +CAMLprim value unix_link(value path1, value path2) { HMODULE hModKernel32; tCreateHardLink pCreateHardLink; @@ -34,7 +34,7 @@ value unix_link(value path1, value path2) /* ML */ if (pCreateHardLink == NULL) invalid_argument("Unix.link not implemented"); if (! pCreateHardLink(String_val(path2), String_val(path1), NULL)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("link", path2); } return Val_unit; diff --git a/otherlibs/win32unix/listen.c b/otherlibs/win32unix/listen.c index e0086d52cf..63b3f590cc 100644 --- a/otherlibs/win32unix/listen.c +++ b/otherlibs/win32unix/listen.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include <winsock.h> -value unix_listen(sock, backlog) /* ML */ +CAMLprim value unix_listen(sock, backlog) value sock, backlog; { if (listen((SOCKET) Handle_val(sock), Int_val(backlog)) == -1) diff --git a/otherlibs/win32unix/lseek.c b/otherlibs/win32unix/lseek.c index 0d3e9ee207..2df24b2eb3 100644 --- a/otherlibs/win32unix/lseek.c +++ b/otherlibs/win32unix/lseek.c @@ -27,13 +27,13 @@ static int seek_command_table[] = { FILE_BEGIN, FILE_CURRENT, FILE_END }; -value unix_lseek(value fd, value ofs, value cmd) /* ML */ +CAMLprim value unix_lseek(value fd, value ofs, value cmd) { long ret; ret = SetFilePointer(Handle_val(fd), Long_val(ofs), NULL, seek_command_table[Int_val(cmd)]); if (ret == -1) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("lseek", Nothing); } return Val_long(ret); diff --git a/otherlibs/win32unix/mkdir.c b/otherlibs/win32unix/mkdir.c index c869b00760..f75ce39639 100644 --- a/otherlibs/win32unix/mkdir.c +++ b/otherlibs/win32unix/mkdir.c @@ -15,7 +15,7 @@ #include <mlvalues.h> #include "unixsupport.h" -value unix_mkdir(path, perm) /* ML */ +CAMLprim value unix_mkdir(path, perm) value path, perm; { if (_mkdir(String_val(path)) == -1) uerror("mkdir", path); diff --git a/otherlibs/win32unix/open.c b/otherlibs/win32unix/open.c index 45c58f2f4e..08811182f8 100644 --- a/otherlibs/win32unix/open.c +++ b/otherlibs/win32unix/open.c @@ -25,7 +25,7 @@ static int open_create_flags[8] = { 0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL }; -value unix_open(value path, value flags, value perm) /* ML */ +CAMLprim value unix_open(value path, value flags, value perm) { int fileaccess, createflags, fileattrib, filecreate; SECURITY_ATTRIBUTES attr; @@ -58,7 +58,7 @@ value unix_open(value path, value flags, value perm) /* ML */ FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, filecreate, fileattrib, NULL); if (h == INVALID_HANDLE_VALUE) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("open", path); } return win_alloc_handle(h); diff --git a/otherlibs/win32unix/pipe.c b/otherlibs/win32unix/pipe.c index 160dfeed93..fdcba3418a 100644 --- a/otherlibs/win32unix/pipe.c +++ b/otherlibs/win32unix/pipe.c @@ -20,7 +20,7 @@ #define SIZEBUF 1024 -value unix_pipe(value unit) /* ML */ +CAMLprim value unix_pipe(value unit) { SECURITY_ATTRIBUTES attr; HANDLE readh, writeh; @@ -30,7 +30,7 @@ value unix_pipe(value unit) /* ML */ attr.lpSecurityDescriptor = NULL; attr.bInheritHandle = TRUE; if (! CreatePipe(&readh, &writeh, &attr, SIZEBUF)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("pipe", Nothing); } Begin_roots2(readfd, writefd) diff --git a/otherlibs/win32unix/read.c b/otherlibs/win32unix/read.c index cc3fdc4416..a45a47ecc8 100644 --- a/otherlibs/win32unix/read.c +++ b/otherlibs/win32unix/read.c @@ -18,7 +18,7 @@ #include <signals.h> #include "unixsupport.h" -value unix_read(value fd, value buf, value ofs, value len) /* ML */ +CAMLprim value unix_read(value fd, value buf, value ofs, value len) { DWORD numbytes, numread; BOOL ret; @@ -32,7 +32,7 @@ value unix_read(value fd, value buf, value ofs, value len) /* ML */ ret = ReadFile(h, iobuf, numbytes, &numread, NULL); leave_blocking_section(); if (! ret) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("read", Nothing); } memmove (&Byte(buf, Long_val(ofs)), iobuf, numread); diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c index a8e92088b4..599667dbbe 100644 --- a/otherlibs/win32unix/select.c +++ b/otherlibs/win32unix/select.c @@ -45,7 +45,7 @@ static value fdset_to_fdlist(value fdlist, fd_set *fdset) return res; } -value unix_select(value readfds, value writefds, value exceptfds, value timeout) /* ML */ +CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout) { fd_set read, write, except; double tm; diff --git a/otherlibs/win32unix/sendrecv.c b/otherlibs/win32unix/sendrecv.c index 6e56ccd175..d65bca5906 100644 --- a/otherlibs/win32unix/sendrecv.c +++ b/otherlibs/win32unix/sendrecv.c @@ -22,7 +22,7 @@ static int msg_flag_table[] = { MSG_OOB, MSG_DONTROUTE, MSG_PEEK }; -value unix_recv(value sock, value buff, value ofs, value len, value flags) +CAMLprim value unix_recv(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -41,7 +41,7 @@ value unix_recv(value sock, value buff, value ofs, value len, value flags) return Val_int(ret); } -value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) /* ML */ +CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -71,7 +71,7 @@ value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) / return res; } -value unix_send(value sock, value buff, value ofs, value len, value flags) /* ML */ +CAMLprim value unix_send(value sock, value buff, value ofs, value len, value flags) { int ret; long numbytes; @@ -110,7 +110,7 @@ value unix_sendto_native(value sock, value buff, value ofs, value len, value fla return Val_int(ret); } -value unix_sendto(argv, argc) /* ML */ +CAMLprim value unix_sendto(argv, argc) value * argv; int argc; { diff --git a/otherlibs/win32unix/shutdown.c b/otherlibs/win32unix/shutdown.c index 4de4b46753..bf1e8c911f 100644 --- a/otherlibs/win32unix/shutdown.c +++ b/otherlibs/win32unix/shutdown.c @@ -20,7 +20,7 @@ static int shutdown_command_table[] = { 0, 1, 2 }; -value unix_shutdown(sock, cmd) /* ML */ +CAMLprim value unix_shutdown(sock, cmd) value sock, cmd; { if (shutdown((SOCKET) Handle_val(sock), diff --git a/otherlibs/win32unix/sleep.c b/otherlibs/win32unix/sleep.c index 767ec27634..6622986e41 100644 --- a/otherlibs/win32unix/sleep.c +++ b/otherlibs/win32unix/sleep.c @@ -16,7 +16,7 @@ #include "unixsupport.h" #include <windows.h> -value unix_sleep(t) /* ML */ +CAMLprim value unix_sleep(t) value t; { enter_blocking_section(); diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c index bb17f5811f..c07d76881d 100644 --- a/otherlibs/win32unix/socket.c +++ b/otherlibs/win32unix/socket.c @@ -25,7 +25,7 @@ int socket_type_table[] = { SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET }; -value unix_socket(domain, type, proto) /* ML */ +CAMLprim value unix_socket(domain, type, proto) value domain, type, proto; { SOCKET s; diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c index 32ee982df8..6d3f9d163f 100644 --- a/otherlibs/win32unix/sockopt.c +++ b/otherlibs/win32unix/sockopt.c @@ -52,20 +52,20 @@ value setsockopt_int(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_bool(value socket, value option) { /* ML */ +CAMLprim value unix_getsockopt_bool(value socket, value option) { return getsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_bool(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_bool(value socket, value option, value status) { return setsockopt_int(sockopt_bool, socket, Val_int(SOL_SOCKET), option, status); } -value unix_getsockopt_int(value socket, value option) { /* ML */ +CAMLprim value unix_getsockopt_int(value socket, value option) { return getsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_int(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_int(value socket, value option, value status) { return setsockopt_int(sockopt_int, socket, Val_int(SOL_SOCKET), option, status); } @@ -103,13 +103,13 @@ value setsockopt_optint(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_optint(value socket, value option) /* ML */ +CAMLprim value unix_getsockopt_optint(value socket, value option) { return getsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_optint(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_optint(value socket, value option, value status) { return setsockopt_optint(sockopt_optint, socket, Val_int(SOL_SOCKET), option, status); @@ -144,12 +144,12 @@ value setsockopt_float(int *sockopt, value socket, value level, return Val_unit; } -value unix_getsockopt_float(value socket, value option) /* ML */ +CAMLprim value unix_getsockopt_float(value socket, value option) { return getsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option); } -value unix_setsockopt_float(value socket, value option, value status) /* ML */ +CAMLprim value unix_setsockopt_float(value socket, value option, value status) { return setsockopt_float(sockopt_float, socket, Val_int(SOL_SOCKET), option, status); } diff --git a/otherlibs/win32unix/startup.c b/otherlibs/win32unix/startup.c index 4c8fbc2047..1099d7c26d 100644 --- a/otherlibs/win32unix/startup.c +++ b/otherlibs/win32unix/startup.c @@ -18,7 +18,7 @@ value val_process_id; -value win_startup(unit) /* ML */ +CAMLprim value win_startup(unit) value unit; { WSADATA wsaData; @@ -34,7 +34,7 @@ value win_startup(unit) /* ML */ return Val_unit; } -value win_cleanup(unit) /* ML */ +CAMLprim value win_cleanup(unit) value unit; { (void) WSACleanup(); @@ -45,7 +45,7 @@ static int std_handles[3] = { STD_INPUT_HANDLE, STD_OUTPUT_HANDLE, STD_ERROR_HANDLE }; -value win_stdhandle(value nhandle) /* ML */ +CAMLprim value win_stdhandle(value nhandle) { return win_alloc_handle(GetStdHandle(std_handles[Int_val(nhandle)])); } diff --git a/otherlibs/win32unix/system.c b/otherlibs/win32unix/system.c index fe453dcf95..fe2bcce5ca 100644 --- a/otherlibs/win32unix/system.c +++ b/otherlibs/win32unix/system.c @@ -19,7 +19,7 @@ #include <process.h> #include <stdio.h> -value win_system(cmd) /* ML */ +CAMLprim value win_system(cmd) value cmd; { int ret; diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c index 69d3106bed..ddd5e85262 100644 --- a/otherlibs/win32unix/unixsupport.c +++ b/otherlibs/win32unix/unixsupport.c @@ -54,47 +54,120 @@ value win_alloc_handle(HANDLE h) return res; } +/* Mapping of Windows error codes to POSIX error codes */ + +struct error_entry { unsigned long win_code; int range; int posix_code; }; + +static struct error_entry win_error_table[] = { + { ERROR_INVALID_FUNCTION, 0, EINVAL}, + { ERROR_FILE_NOT_FOUND, 0, ENOENT}, + { ERROR_PATH_NOT_FOUND, 0, ENOENT}, + { ERROR_TOO_MANY_OPEN_FILES, 0, EMFILE}, + { ERROR_ACCESS_DENIED, 0, EACCES}, + { ERROR_INVALID_HANDLE, 0, EBADF}, + { ERROR_ARENA_TRASHED, 0, ENOMEM}, + { ERROR_NOT_ENOUGH_MEMORY, 0, ENOMEM}, + { ERROR_INVALID_BLOCK, 0, ENOMEM}, + { ERROR_BAD_ENVIRONMENT, 0, E2BIG}, + { ERROR_BAD_FORMAT, 0, ENOEXEC}, + { ERROR_INVALID_ACCESS, 0, EINVAL}, + { ERROR_INVALID_DATA, 0, EINVAL}, + { ERROR_INVALID_DRIVE, 0, ENOENT}, + { ERROR_CURRENT_DIRECTORY, 0, EACCES}, + { ERROR_NOT_SAME_DEVICE, 0, EXDEV}, + { ERROR_NO_MORE_FILES, 0, ENOENT}, + { ERROR_LOCK_VIOLATION, 0, EACCES}, + { ERROR_BAD_NETPATH, 0, ENOENT}, + { ERROR_NETWORK_ACCESS_DENIED, 0, EACCES}, + { ERROR_BAD_NET_NAME, 0, ENOENT}, + { ERROR_FILE_EXISTS, 0, EEXIST}, + { ERROR_CANNOT_MAKE, 0, EACCES}, + { ERROR_FAIL_I24, 0, EACCES}, + { ERROR_INVALID_PARAMETER, 0, EINVAL}, + { ERROR_NO_PROC_SLOTS, 0, EAGAIN}, + { ERROR_DRIVE_LOCKED, 0, EACCES}, + { ERROR_BROKEN_PIPE, 0, EPIPE}, + { ERROR_DISK_FULL, 0, ENOSPC}, + { ERROR_INVALID_TARGET_HANDLE, 0, EBADF}, + { ERROR_INVALID_HANDLE, 0, EINVAL}, + { ERROR_WAIT_NO_CHILDREN, 0, ECHILD}, + { ERROR_CHILD_NOT_COMPLETE, 0, ECHILD}, + { ERROR_DIRECT_ACCESS_HANDLE, 0, EBADF}, + { ERROR_NEGATIVE_SEEK, 0, EINVAL}, + { ERROR_SEEK_ON_DEVICE, 0, EACCES}, + { ERROR_DIR_NOT_EMPTY, 0, ENOTEMPTY}, + { ERROR_NOT_LOCKED, 0, EACCES}, + { ERROR_BAD_PATHNAME, 0, ENOENT}, + { ERROR_MAX_THRDS_REACHED, 0, EAGAIN}, + { ERROR_LOCK_FAILED, 0, EACCES}, + { ERROR_ALREADY_EXISTS, 0, EEXIST}, + { ERROR_FILENAME_EXCED_RANGE, 0, ENOENT}, + { ERROR_NESTING_NOT_ALLOWED, 0, EAGAIN}, + { ERROR_NOT_ENOUGH_QUOTA, 0, ENOMEM}, + { ERROR_INVALID_STARTING_CODESEG, + ERROR_INFLOOP_IN_RELOC_CHAIN - ERROR_INVALID_STARTING_CODESEG, + ENOEXEC }, + { ERROR_WRITE_PROTECT, + ERROR_SHARING_BUFFER_EXCEEDED - ERROR_WRITE_PROTECT, + EACCES }, + { 0, -1, 0 } +}; + +void win32_maperr(unsigned long errcode) +{ + int i; + + for (i = 0; win_error_table[i].range >= 0; i++) { + if (errcode >= win_error_table[i].win_code && + errcode <= win_error_table[i].win_code + win_error_table[i].range) { + errno = win_error_table[i].posix_code; + return; + } + } + /* Not found: save original error code, negated so that we can + recognize it in unix_error_message */ + errno = -errcode; +} + /* Windows socket errors */ -#define EWOULDBLOCK WSAEWOULDBLOCK -#define EINPROGRESS WSAEINPROGRESS -#define EALREADY WSAEALREADY -#define ENOTSOCK WSAENOTSOCK -#define EDESTADDRREQ WSAEDESTADDRREQ -#define EMSGSIZE WSAEMSGSIZE -#define EPROTOTYPE WSAEPROTOTYPE -#define ENOPROTOOPT WSAENOPROTOOPT -#define EPROTONOSUPPORT WSAEPROTONOSUPPORT -#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT -#define EOPNOTSUPP WSAEOPNOTSUPP -#define EPFNOSUPPORT WSAEPFNOSUPPORT -#define EAFNOSUPPORT WSAEAFNOSUPPORT -#define EADDRINUSE WSAEADDRINUSE -#define EADDRNOTAVAIL WSAEADDRNOTAVAIL -#define ENETDOWN WSAENETDOWN -#define ENETUNREACH WSAENETUNREACH -#define ENETRESET WSAENETRESET -#define ECONNABORTED WSAECONNABORTED -#define ECONNRESET WSAECONNRESET -#define ENOBUFS WSAENOBUFS -#define EISCONN WSAEISCONN -#define ENOTCONN WSAENOTCONN -#define ESHUTDOWN WSAESHUTDOWN -#define ETOOMANYREFS WSAETOOMANYREFS -#define ETIMEDOUT WSAETIMEDOUT -#define ECONNREFUSED WSAECONNREFUSED -#define ELOOP WSAELOOP -#define EHOSTDOWN WSAEHOSTDOWN -#define EHOSTUNREACH WSAEHOSTUNREACH -#define EPROCLIM WSAEPROCLIM -#define EUSERS WSAEUSERS -#define EDQUOT WSAEDQUOT -#define ESTALE WSAESTALE -#define EREMOTE WSAEREMOTE - -/* Errors not available under Win32 */ - -#define EACCESS (-1) +#define EWOULDBLOCK -WSAEWOULDBLOCK +#define EINPROGRESS -WSAEINPROGRESS +#define EALREADY -WSAEALREADY +#define ENOTSOCK -WSAENOTSOCK +#define EDESTADDRREQ -WSAEDESTADDRREQ +#define EMSGSIZE -WSAEMSGSIZE +#define EPROTOTYPE -WSAEPROTOTYPE +#define ENOPROTOOPT -WSAENOPROTOOPT +#define EPROTONOSUPPORT -WSAEPROTONOSUPPORT +#define ESOCKTNOSUPPORT -WSAESOCKTNOSUPPORT +#define EOPNOTSUPP -WSAEOPNOTSUPP +#define EPFNOSUPPORT -WSAEPFNOSUPPORT +#define EAFNOSUPPORT -WSAEAFNOSUPPORT +#define EADDRINUSE -WSAEADDRINUSE +#define EADDRNOTAVAIL -WSAEADDRNOTAVAIL +#define ENETDOWN -WSAENETDOWN +#define ENETUNREACH -WSAENETUNREACH +#define ENETRESET -WSAENETRESET +#define ECONNABORTED -WSAECONNABORTED +#define ECONNRESET -WSAECONNRESET +#define ENOBUFS -WSAENOBUFS +#define EISCONN -WSAEISCONN +#define ENOTCONN -WSAENOTCONN +#define ESHUTDOWN -WSAESHUTDOWN +#define ETOOMANYREFS -WSAETOOMANYREFS +#define ETIMEDOUT -WSAETIMEDOUT +#define ECONNREFUSED -WSAECONNREFUSED +#define ELOOP -WSAELOOP +#define EHOSTDOWN -WSAEHOSTDOWN +#define EHOSTUNREACH -WSAEHOSTUNREACH +#define EPROCLIM -WSAEPROCLIM +#define EUSERS -WSAEUSERS +#define EDQUOT -WSAEDQUOT +#define ESTALE -WSAESTALE +#define EREMOTE -WSAEREMOTE + +#define EACCESS EACCES int error_table[] = { E2BIG, EACCESS, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM, diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index 303f8905ad..ec363780af 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -27,6 +27,7 @@ extern value win_alloc_handle(HANDLE); #define Nothing ((value) 0) +extern void win32_maperr(unsigned long errcode); extern void unix_error (int errcode, char * cmdname, value arg); extern void uerror (char * cmdname, value arg); extern value unix_freeze_buffer (value); diff --git a/otherlibs/win32unix/windir.c b/otherlibs/win32unix/windir.c index 8a384764d8..d6b863abb8 100644 --- a/otherlibs/win32unix/windir.c +++ b/otherlibs/win32unix/windir.c @@ -18,7 +18,7 @@ #include <alloc.h> #include "unixsupport.h" -value win_findfirst(name) /* ML */ +CAMLprim value win_findfirst(name) value name; { int h; @@ -42,7 +42,7 @@ value win_findfirst(name) /* ML */ return v; } -value win_findnext(valh) /* ML */ +CAMLprim value win_findnext(valh) value valh; { int retcode; @@ -53,7 +53,7 @@ value win_findnext(valh) /* ML */ return copy_string(fileinfo.name); } -value win_findclose(valh) /* ML */ +CAMLprim value win_findclose(valh) value valh; { if (_findclose(Int_val(valh)) != 0) uerror("closedir", Nothing); diff --git a/otherlibs/win32unix/winwait.c b/otherlibs/win32unix/winwait.c index 97f889db0c..54ece1a62e 100644 --- a/otherlibs/win32unix/winwait.c +++ b/otherlibs/win32unix/winwait.c @@ -37,7 +37,7 @@ enum { CAML_WNOHANG = 1, CAML_WUNTRACED = 2 }; static int wait_flag_table[] = { CAML_WNOHANG, CAML_WUNTRACED }; -value win_waitpid(value vflags, value vpid_req) /* ML */ +CAMLprim value win_waitpid(value vflags, value vpid_req) { int status, flags; HANDLE pid_req = (HANDLE) Long_val(vpid_req); @@ -45,12 +45,12 @@ value win_waitpid(value vflags, value vpid_req) /* ML */ flags = convert_flag_list(vflags, wait_flag_table); if ((flags & CAML_WNOHANG) == 0) { if (WaitForSingleObject(pid_req, INFINITE) == WAIT_FAILED) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("waitpid", Nothing); } } if (! GetExitCodeProcess(pid_req, &status)) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("waitpid", Nothing); } if (status == STILL_ACTIVE) diff --git a/otherlibs/win32unix/write.c b/otherlibs/win32unix/write.c index 4864ea7aa2..6bd9c66378 100644 --- a/otherlibs/win32unix/write.c +++ b/otherlibs/win32unix/write.c @@ -19,7 +19,7 @@ #include <signals.h> #include "unixsupport.h" -value unix_write(value fd, value buf, value vofs, value vlen) /* ML */ +CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) { long ofs, len, written; DWORD numbytes, numwritten; @@ -38,7 +38,7 @@ value unix_write(value fd, value buf, value vofs, value vlen) /* ML */ ret = WriteFile(h, iobuf, numbytes, &numwritten, NULL); leave_blocking_section(); if (! ret) { - _dosmaperr(GetLastError()); + win32_maperr(GetLastError()); uerror("write", Nothing); } written += numwritten; diff --git a/tools/Makefile b/tools/Makefile index 7225eb4011..eeb2a9f0b4 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -22,7 +22,7 @@ INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \ COMPFLAGS=$(INCLUDES) LINKFLAGS=$(INCLUDES) -all: ocamldep ocamlprof ocamlcp ocamlmktop +all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib # The dependency generator @@ -73,6 +73,22 @@ install:: clean:: rm -f ocamlmktop +# To help building mixed-mode libraries (Caml + C) + +ocamlmklib: ocamlmklib.tpl ../config/Makefile + sed -e 's|%%BINDIR%%|$(BINDIR)|' \ + -e 's|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|' \ + -e 's|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|' \ + -e 's|%%RANLIB%%|$(RANLIB)|' \ + ocamlmklib.tpl > ocamlmklib + chmod +x ocamlmklib + +install:: + cp ocamlmklib $(BINDIR)/ocamlmklib + +clean:: + rm -f ocamlmklib + # Converter ocaml 2.04 to 3 OCAML299TO3= lexer299.cmo ocaml299to3.cmo diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 807eff6cae..3adbc9e96d 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -39,6 +39,7 @@ module Options = Main_args.Make_options (struct let _cclib s = option_with_arg "-cclib" s let _ccopt s = option_with_arg "-ccopt" s let _custom = option "-custom" + let _dllpath = option_with_arg "-dllpath" let _g = option "-g" let _i = option "-i" let _I s = option_with_arg "-I" s diff --git a/tools/ocamlmklib.tpl b/tools/ocamlmklib.tpl new file mode 100644 index 0000000000..8f44849af5 --- /dev/null +++ b/tools/ocamlmklib.tpl @@ -0,0 +1,108 @@ +#!/bin/sh +######################################################################### +# # +# Objective Caml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 2001 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$ + +bytecode_objs='' +native_objs='' +c_objs='' +c_libs='' +c_libs_caml='' +c_opts='' +c_opts_caml='' +caml_opts='' +caml_libs='' +ocamlc='%%BINDIR%%/ocamlc' +ocamlopt='%%BINDIR%%/ocamlopt' +output='a' +output_c='' + +while :; do + case "$1" in + "") + break;; + *.cmo|*.cma) + bytecode_objs="$bytecode_objs $1";; + *.cmx|*.cmxa) + native_objs="$native_objs $1";; + *.ml|*.mli) + bytecode_objs="$bytecode_objs $1" + native_objs="$native_objs $1";; + *.o|*.a) + c_objs="$c_objs $1";; + -cclib) + caml_libs="$caml_libs $1 $2";; + -l*) + c_libs="$c_libs $1" + c_libs_caml="$c_libs_caml -cclib $1";; + -L*) + c_opts="$c_libs $1" + c_opts_caml="$c_libs_caml -ccopt $1";; + -I) + caml_opts="$caml_opts $1 $2" + shift;; + -linkall) + caml_opts="$caml_opts $1" + shift;; + -ocamlc) + ocamlc="$2" + shift;; + -ocamlopt) + ocamlopt="$2" + shift;; + -o) + output="$2" + shift;; + -oc) + output_c="$2" + shift;; + -*) + echo "Unknown option `$1', ignored" 1>&2;; + *) + echo "Don't know what to do with `$1', ignored" 1>&2;; + esac + shift +done + +if test "$output_c" = ""; then output_c="$output"; fi + +set -e + +if %%SUPPORTS_SHARED_LIBRARIES%%; then + if test "$bytecode_objs" != ""; then + $ocamlc -a -o $output.cma $caml_opts $bytecode_objs -cclib -l$output_c $caml_libs + fi + if test "$native_objs" != ""; then + $ocamlopt -a -o $output.cmxa $caml_opts $native_objs -cclib -l$output_c $caml_libs + fi + if test "$c_objs" != ""; then + %%MKSHAREDLIB%% lib$output_c.so $c_objs $c_opts $c_libs + rm -f lib$output_c.a + ar rc lib$output_c.a $c_objs + %%RANLIB%% lib$output_c.a + fi +else + if test "$bytecode_objs" != ""; then + $ocamlc -a -custom -o $output.cma $caml_opts $bytecode_objs \ + -cclib -l$output_c $caml_libs $c_opts $c_libs + fi + if test "$native_objs" != ""; then + $ocamlopt -a -o $output.cmxa $caml_opts $native_objs \ + -cclib -l$output_c $caml_libs $c_opts $c_libs + fi + if test "$c_objs" != ""; then + rm -f lib$output_c.a + ar rc lib$output_c.a $c_objs + %%RANLIB%% lib$output_c.a + fi +fi diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index ba2715fbdf..ee7e8f36c2 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -35,8 +35,9 @@ let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit) (* To add a directory to the load path *) let dir_directory s = - Config.load_path := - expand_directory Config.standard_library s :: !Config.load_path; + let d = expand_directory Config.standard_library s in + Config.load_path := d :: !Config.load_path; + Dll.add_path [d]; Env.reset_cache() let _ = Hashtbl.add directive_table "directory" (Directive_string dir_directory) @@ -107,8 +108,14 @@ let dir_load ppf name = if buffer = Config.cma_magic_number then begin let toc_pos = input_binary_int ic in (* Go to table of contents *) seek_in ic toc_pos; - List.iter (load_compunit ic filename ppf) - (input_value ic : library).lib_units + let lib = (input_value ic : library) in + begin try + Dll.open_dlls (Dll.extract_dll_names lib.lib_ccobjs) + with Failure reason -> + fprintf ppf "Cannot load required shared library: %s.@." reason; + raise Load_failed + end; + List.iter (load_compunit ic filename ppf) lib.lib_units end else fprintf ppf "File %s is not a bytecode object file.@." name with Load_failed -> () end; diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index 70571267e1..230cd7d639 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -367,7 +367,6 @@ let empty_lexbuf lb = let _ = Sys.interactive := true; Symtable.init_toplevel(); - Clflags.thread_safe := true; Compile.init_path() let load_ocamlinit ppf = @@ -383,6 +382,7 @@ let loop ppf = but keep the directories that user code linked in with ocamlmktop may have added to load_path. *) load_path := "" :: (List.rev !Clflags.include_dirs @ !load_path); + Dll.add_path !load_path; toplevel_env := Compile.initial_env(); let lb = Lexing.from_function refill_lexbuf in Location.input_name := ""; diff --git a/utils/clflags.ml b/utils/clflags.ml index 722e343ed5..92e0143540 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -15,7 +15,7 @@ (* Command-line parameters *) let objfiles = ref ([] : string list) (* .cmo and .cma files *) -and ccobjs = ref ([] : string list) (* .o, .a and -lxxx files *) +and ccobjs = ref ([] : string list) (* .o, .a, .so and -lxxx files *) let compile_only = ref false (* -c *) and exec_name = ref "a.out" (* -o *) @@ -44,6 +44,7 @@ and gprofile = ref false (* -p *) and c_compiler = ref Config.bytecomp_c_compiler (* -cc *) and c_linker = ref Config.bytecomp_c_linker (* -cc *) and no_auto_link = ref false (* -noautolink *) +and dllpaths = ref ([] : string list) (* -dllpath *) let dump_parsetree = ref false (* -dparsetree *) and dump_rawlambda = ref false (* -drawlambda *) and dump_lambda = ref false (* -dlambda *) diff --git a/utils/config.mli b/utils/config.mli index 698fdddf3d..a82c96f20e 100644 --- a/utils/config.mli +++ b/utils/config.mli @@ -29,6 +29,9 @@ val bytecomp_c_linker: string with the bytecode compiler *) val bytecomp_c_libraries: string (* The C libraries to link with custom runtimes *) +val bytecomp_c_rpath: string + (* Option to [bytecomp_c_compiler] for specifying a + directory to search shared libraries at run-time *) val native_c_compiler: string (* The C compiler to use for compiling C files with the native-code compiler *) @@ -39,6 +42,9 @@ val native_c_libraries: string (* The C libraries to link with native-code programs *) val native_partial_linker: string (* The linker to use for partial links (-output-obj option) *) +val native_c_rpath: string + (* Option to [native_c_compiler] for specifying a + directory to search shared libraries at run-time *) val ranlib: string (* Command to randomize a library, or "" if not needed *) @@ -87,3 +93,5 @@ val ext_asm: string (* Extension for assembler files, e.g. [.s] under Unix. *) val ext_lib: string (* Extension for library files, e.g. [.a] under Unix. *) +val ext_dll: string + (* Extension for dynamically-loaded libraries, e.g. [.so] under Unix.*) diff --git a/utils/config.mlp b/utils/config.mlp index e63c314f51..cb22d81d1b 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -12,7 +12,7 @@ (* $Id$ *) -let version = "3.02+2 (2001-08-24)" +let version = "3.02+3 (2001-08-28)" let standard_library = try @@ -24,9 +24,11 @@ let standard_runtime = "%%BYTERUN%%" let bytecomp_c_compiler = "%%BYTECC%%" let bytecomp_c_linker = "%%BYTELINK%%" let bytecomp_c_libraries = "%%BYTECCLIBS%%" +let bytecomp_c_rpath = "%%BYTECCRPATH%%" let native_c_compiler = "%%NATIVECC%%" let native_c_linker = "%%NATIVELINK%%" let native_c_libraries = "%%NATIVECCLIBS%%" +let native_c_rpath = "%%NATIVECCRPATH%%" let native_partial_linker = "%%PARTIALLD%%" let ranlib = "%%RANLIBCMD%%" @@ -54,3 +56,4 @@ let system = "%%SYSTEM%%" let ext_obj = "%%EXT_OBJ%%" let ext_asm = "%%EXT_ASM%%" let ext_lib = "%%EXT_LIB%%" +let ext_dll = "%%EXT_DLL%%" |