Removed dependency on Unix
This commit is contained in:
John Whitington
parent
ad7fb1e4d8
commit
c721b085b8
2
Makefile
2
Makefile
|
|
@ -1,7 +1,7 @@
|
||||||
# Build the cpdf command line tools and top level
|
# Build the cpdf command line tools and top level
|
||||||
MODS = cpdfstrftime cpdf cpdfcommand
|
MODS = cpdfstrftime cpdf cpdfcommand
|
||||||
|
|
||||||
SOURCES = $(foreach x,$(MODS),$(x).ml $(x).mli) cpdfcommandrun.ml
|
SOURCES = cst2constr.h cst2constr.c unixsupport.h unixsupport.c gmtime.c gettimeofday.c cpdfunix.ml cpdfunix.mli $(foreach x,$(MODS),$(x).ml $(x).mli) cpdfcommandrun.ml
|
||||||
|
|
||||||
RESULT = cpdf
|
RESULT = cpdf
|
||||||
ANNOTATE = true
|
ANNOTATE = true
|
||||||
|
|
|
||||||
|
|
@ -683,7 +683,7 @@ ifndef REAL_OCAMLC
|
||||||
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
||||||
ifndef CREATE_LIB
|
ifndef CREATE_LIB
|
||||||
ifndef REAL_OCAMLFIND
|
ifndef REAL_OCAMLFIND
|
||||||
ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
|
ALL_LDFLAGS := $(ALL_LDFLAGS)
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
@ -729,7 +729,7 @@ else
|
||||||
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
||||||
ifndef CREATE_LIB
|
ifndef CREATE_LIB
|
||||||
ifndef REAL_OCAMLFIND
|
ifndef REAL_OCAMLFIND
|
||||||
ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
|
ALL_LDFLAGS := $(ALL_LDFLAGS)
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
|
||||||
|
|
@ -1,77 +1,77 @@
|
||||||
(* C-Style strftime *)
|
(* C-Style strftime *)
|
||||||
open Pdfutil
|
open Pdfutil
|
||||||
|
|
||||||
let strf_A t =
|
let strf_A t = ""
|
||||||
match t.Unix.tm_wday with
|
(*match t.Unix.tm_wday with
|
||||||
| 0 -> "Sunday" | 1 -> "Monday" | 2 -> "Tuesday"
|
| 0 -> "Sunday" | 1 -> "Monday" | 2 -> "Tuesday"
|
||||||
| 3 -> "Wednesday" | 4 -> "Thursday" | 5 -> "Friday"
|
| 3 -> "Wednesday" | 4 -> "Thursday" | 5 -> "Friday"
|
||||||
| 6 -> "Saturday"
|
| 6 -> "Saturday"
|
||||||
| _ -> "strf_AFail"
|
| _ -> "strf_AFail" *)
|
||||||
|
|
||||||
let strf_a t =
|
let strf_a t =
|
||||||
String.sub (strf_A t) 0 3
|
String.sub (strf_A t) 0 3
|
||||||
|
|
||||||
let strf_B t =
|
let strf_B t = ""
|
||||||
match t.Unix.tm_mon with
|
(*match t.Unix.tm_mon with
|
||||||
| 0 -> "January" | 1 -> "February" | 2 -> "March" | 3 -> "April"
|
| 0 -> "January" | 1 -> "February" | 2 -> "March" | 3 -> "April"
|
||||||
| 4 -> "May" | 5 -> "June" | 6 -> "July" | 7 -> "August"
|
| 4 -> "May" | 5 -> "June" | 6 -> "July" | 7 -> "August"
|
||||||
| 8 -> "September" | 9 -> "October" | 10 -> "November"
|
| 8 -> "September" | 9 -> "October" | 10 -> "November"
|
||||||
| 11 -> "December" | _ -> "strf_Bfail"
|
| 11 -> "December" | _ -> "strf_Bfail"*)
|
||||||
|
|
||||||
let strf_b t =
|
let strf_b t =
|
||||||
String.sub (strf_B t) 0 3
|
String.sub (strf_B t) 0 3
|
||||||
|
|
||||||
let strf_d t =
|
let strf_d t = ""
|
||||||
let s = string_of_int t.Unix.tm_mday in
|
(*let s = string_of_int t.Unix.tm_mday in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s *)
|
||||||
|
|
||||||
let strf_e t =
|
let strf_e t = ""
|
||||||
let s = string_of_int t.Unix.tm_mday in
|
(*let s = string_of_int t.Unix.tm_mday in
|
||||||
if String.length s = 1 then " " ^ s else s
|
if String.length s = 1 then " " ^ s else s*)
|
||||||
|
|
||||||
let strf_H t =
|
let strf_H t = ""
|
||||||
let s = string_of_int t.Unix.tm_hour in
|
(*let s = string_of_int t.Unix.tm_hour in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s*)
|
||||||
|
|
||||||
let strf_I t =
|
let strf_I t = ""
|
||||||
let s = string_of_int (t.Unix.tm_hour mod 12) in
|
(*let s = string_of_int (t.Unix.tm_hour mod 12) in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s *)
|
||||||
|
|
||||||
let strf_j t =
|
let strf_j t = ""
|
||||||
let s = string_of_int t.Unix.tm_yday in
|
(*let s = string_of_int t.Unix.tm_yday in
|
||||||
match String.length s with
|
match String.length s with
|
||||||
| 1 -> "00" ^ s
|
| 1 -> "00" ^ s
|
||||||
| 2 -> "0" ^ s
|
| 2 -> "0" ^ s
|
||||||
| _ -> s
|
| _ -> s *)
|
||||||
|
|
||||||
let strf_m t =
|
let strf_m t = ""
|
||||||
let s = string_of_int (t.Unix.tm_mon + 1) in
|
(*let s = string_of_int (t.Unix.tm_mon + 1) in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s *)
|
||||||
|
|
||||||
let strf_M t =
|
let strf_M t = ""
|
||||||
let s = string_of_int t.Unix.tm_min in
|
(*let s = string_of_int t.Unix.tm_min in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s*)
|
||||||
|
|
||||||
let strf_p t =
|
let strf_p t = ""
|
||||||
if t.Unix.tm_hour >= 12 then "p.m" else "a.m"
|
(*if t.Unix.tm_hour >= 12 then "p.m" else "a.m"*)
|
||||||
|
|
||||||
let strf_S t =
|
let strf_S t = ""
|
||||||
let s = string_of_int t.Unix.tm_sec in
|
(*let s = string_of_int t.Unix.tm_sec in
|
||||||
if String.length s = 1 then "0" ^ s else s
|
if String.length s = 1 then "0" ^ s else s*)
|
||||||
|
|
||||||
let strf_T t =
|
let strf_T t =
|
||||||
strf_H t ^ ":" ^ strf_M t ^ ":" ^ strf_S t
|
strf_H t ^ ":" ^ strf_M t ^ ":" ^ strf_S t
|
||||||
|
|
||||||
let strf_u t =
|
let strf_u t = ""
|
||||||
match t.Unix.tm_wday with
|
(*match t.Unix.tm_wday with
|
||||||
| 0 -> "7"
|
| 0 -> "7"
|
||||||
| n -> string_of_int (n + 1)
|
| n -> string_of_int (n + 1)*)
|
||||||
|
|
||||||
let strf_w t =
|
let strf_w t = ""
|
||||||
string_of_int t.Unix.tm_wday
|
(*string_of_int t.Unix.tm_wday *)
|
||||||
|
|
||||||
let strf_Y t =
|
let strf_Y t = ""
|
||||||
string_of_int (t.Unix.tm_year + 1900)
|
(*string_of_int (t.Unix.tm_year + 1900) *)
|
||||||
|
|
||||||
let strf_percent _ = "%"
|
let strf_percent _ = "%"
|
||||||
|
|
||||||
|
|
@ -82,12 +82,12 @@ let strftime_pairs =
|
||||||
"%p", strf_p; "%S", strf_S; "%T", strf_T; "%u", strf_u;
|
"%p", strf_p; "%S", strf_S; "%T", strf_T; "%u", strf_u;
|
||||||
"%w", strf_w; "%Y", strf_Y; "%%", strf_percent]
|
"%w", strf_w; "%Y", strf_Y; "%%", strf_percent]
|
||||||
|
|
||||||
let strftime text =
|
let strftime text = ""
|
||||||
let time = Unix.localtime (Unix.gettimeofday ()) in
|
(*let time = Unix.localtime (Unix.gettimeofday ()) in
|
||||||
let text = ref text in
|
let text = ref text in
|
||||||
iter
|
iter
|
||||||
(fun (search, replace_fun) ->
|
(fun (search, replace_fun) ->
|
||||||
text := string_replace_all search (replace_fun time) !text)
|
text := string_replace_all search (replace_fun time) !text)
|
||||||
strftime_pairs;
|
strftime_pairs;
|
||||||
!text
|
!text*)
|
||||||
|
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,24 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/fail.h>
|
||||||
|
#include "cst2constr.h"
|
||||||
|
|
||||||
|
value cst_to_constr(int n, int *tbl, int size, int deflt)
|
||||||
|
{
|
||||||
|
int i;
|
||||||
|
for (i = 0; i < size; i++)
|
||||||
|
if (n == tbl[i]) return Val_int(i);
|
||||||
|
return Val_int(deflt);
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,14 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
extern value cst_to_constr(int n, int * tbl, int size, int deflt);
|
||||||
|
|
@ -0,0 +1,36 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/alloc.h>
|
||||||
|
#include <caml/fail.h>
|
||||||
|
#include "unixsupport.h"
|
||||||
|
|
||||||
|
#ifdef HAS_GETTIMEOFDAY
|
||||||
|
|
||||||
|
#include <sys/types.h>
|
||||||
|
#include <sys/time.h>
|
||||||
|
|
||||||
|
CAMLprim value unix_gettimeofday(value unit)
|
||||||
|
{
|
||||||
|
struct timeval tp;
|
||||||
|
if (gettimeofday(&tp, NULL) == -1) uerror("gettimeofday", Nothing);
|
||||||
|
return copy_double((double) tp.tv_sec + (double) tp.tv_usec / 1e6);
|
||||||
|
}
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
CAMLprim value unix_gettimeofday(value unit)
|
||||||
|
{ invalid_argument("gettimeofday not implemented"); }
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
@ -0,0 +1,93 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/alloc.h>
|
||||||
|
#include <caml/fail.h>
|
||||||
|
#include <caml/memory.h>
|
||||||
|
#include "unixsupport.h"
|
||||||
|
#include <time.h>
|
||||||
|
#include <errno.h>
|
||||||
|
|
||||||
|
static value alloc_tm(struct tm *tm)
|
||||||
|
{
|
||||||
|
value res;
|
||||||
|
res = alloc_small(9, 0);
|
||||||
|
Field(res,0) = Val_int(tm->tm_sec);
|
||||||
|
Field(res,1) = Val_int(tm->tm_min);
|
||||||
|
Field(res,2) = Val_int(tm->tm_hour);
|
||||||
|
Field(res,3) = Val_int(tm->tm_mday);
|
||||||
|
Field(res,4) = Val_int(tm->tm_mon);
|
||||||
|
Field(res,5) = Val_int(tm->tm_year);
|
||||||
|
Field(res,6) = Val_int(tm->tm_wday);
|
||||||
|
Field(res,7) = Val_int(tm->tm_yday);
|
||||||
|
Field(res,8) = tm->tm_isdst ? Val_true : Val_false;
|
||||||
|
return res;
|
||||||
|
}
|
||||||
|
|
||||||
|
CAMLprim value unix_gmtime(value t)
|
||||||
|
{
|
||||||
|
time_t clock;
|
||||||
|
struct tm * tm;
|
||||||
|
clock = (time_t) Double_val(t);
|
||||||
|
tm = gmtime(&clock);
|
||||||
|
if (tm == NULL) unix_error(EINVAL, "gmtime", Nothing);
|
||||||
|
return alloc_tm(tm);
|
||||||
|
}
|
||||||
|
|
||||||
|
CAMLprim value unix_localtime(value t)
|
||||||
|
{
|
||||||
|
time_t clock;
|
||||||
|
struct tm * tm;
|
||||||
|
clock = (time_t) Double_val(t);
|
||||||
|
tm = localtime(&clock);
|
||||||
|
if (tm == NULL) unix_error(EINVAL, "localtime", Nothing);
|
||||||
|
return alloc_tm(tm);
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef HAS_MKTIME
|
||||||
|
|
||||||
|
CAMLprim value unix_mktime(value t)
|
||||||
|
{
|
||||||
|
struct tm tm;
|
||||||
|
time_t clock;
|
||||||
|
value res;
|
||||||
|
value tmval = Val_unit, clkval = Val_unit;
|
||||||
|
|
||||||
|
Begin_roots2(tmval, clkval);
|
||||||
|
tm.tm_sec = Int_val(Field(t, 0));
|
||||||
|
tm.tm_min = Int_val(Field(t, 1));
|
||||||
|
tm.tm_hour = Int_val(Field(t, 2));
|
||||||
|
tm.tm_mday = Int_val(Field(t, 3));
|
||||||
|
tm.tm_mon = Int_val(Field(t, 4));
|
||||||
|
tm.tm_year = Int_val(Field(t, 5));
|
||||||
|
tm.tm_wday = Int_val(Field(t, 6));
|
||||||
|
tm.tm_yday = Int_val(Field(t, 7));
|
||||||
|
tm.tm_isdst = -1; /* tm.tm_isdst = Bool_val(Field(t, 8)); */
|
||||||
|
clock = mktime(&tm);
|
||||||
|
if (clock == (time_t) -1) unix_error(ERANGE, "mktime", Nothing);
|
||||||
|
tmval = alloc_tm(&tm);
|
||||||
|
clkval = copy_double((double) clock);
|
||||||
|
res = alloc_small(2, 0);
|
||||||
|
Field(res, 0) = clkval;
|
||||||
|
Field(res, 1) = tmval;
|
||||||
|
End_roots ();
|
||||||
|
return res;
|
||||||
|
}
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
CAMLprim value unix_mktime(value t)
|
||||||
|
{ invalid_argument("mktime not implemented"); }
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
@ -0,0 +1,309 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/alloc.h>
|
||||||
|
#include <caml/callback.h>
|
||||||
|
#include <caml/memory.h>
|
||||||
|
#include <caml/fail.h>
|
||||||
|
#include "unixsupport.h"
|
||||||
|
#include "cst2constr.h"
|
||||||
|
#include <errno.h>
|
||||||
|
|
||||||
|
#ifndef E2BIG
|
||||||
|
#define E2BIG (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EACCES
|
||||||
|
#define EACCES (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EAGAIN
|
||||||
|
#define EAGAIN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EBADF
|
||||||
|
#define EBADF (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EBUSY
|
||||||
|
#define EBUSY (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ECHILD
|
||||||
|
#define ECHILD (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EDEADLK
|
||||||
|
#define EDEADLK (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EDOM
|
||||||
|
#define EDOM (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EEXIST
|
||||||
|
#define EEXIST (-1)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifndef EFAULT
|
||||||
|
#define EFAULT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EFBIG
|
||||||
|
#define EFBIG (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EINTR
|
||||||
|
#define EINTR (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EINVAL
|
||||||
|
#define EINVAL (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EIO
|
||||||
|
#define EIO (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EISDIR
|
||||||
|
#define EISDIR (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EMFILE
|
||||||
|
#define EMFILE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EMLINK
|
||||||
|
#define EMLINK (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENAMETOOLONG
|
||||||
|
#define ENAMETOOLONG (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENFILE
|
||||||
|
#define ENFILE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENODEV
|
||||||
|
#define ENODEV (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOENT
|
||||||
|
#define ENOENT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOEXEC
|
||||||
|
#define ENOEXEC (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOLCK
|
||||||
|
#define ENOLCK (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOMEM
|
||||||
|
#define ENOMEM (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOSPC
|
||||||
|
#define ENOSPC (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOSYS
|
||||||
|
#define ENOSYS (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTDIR
|
||||||
|
#define ENOTDIR (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTEMPTY
|
||||||
|
#define ENOTEMPTY (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTTY
|
||||||
|
#define ENOTTY (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENXIO
|
||||||
|
#define ENXIO (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EPERM
|
||||||
|
#define EPERM (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EPIPE
|
||||||
|
#define EPIPE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ERANGE
|
||||||
|
#define ERANGE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EROFS
|
||||||
|
#define EROFS (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ESPIPE
|
||||||
|
#define ESPIPE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ESRCH
|
||||||
|
#define ESRCH (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EXDEV
|
||||||
|
#define EXDEV (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EWOULDBLOCK
|
||||||
|
#define EWOULDBLOCK (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EINPROGRESS
|
||||||
|
#define EINPROGRESS (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EALREADY
|
||||||
|
#define EALREADY (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTSOCK
|
||||||
|
#define ENOTSOCK (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EDESTADDRREQ
|
||||||
|
#define EDESTADDRREQ (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EMSGSIZE
|
||||||
|
#define EMSGSIZE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EPROTOTYPE
|
||||||
|
#define EPROTOTYPE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOPROTOOPT
|
||||||
|
#define ENOPROTOOPT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EPROTONOSUPPORT
|
||||||
|
#define EPROTONOSUPPORT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ESOCKTNOSUPPORT
|
||||||
|
#define ESOCKTNOSUPPORT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EOPNOTSUPP
|
||||||
|
# ifdef ENOTSUP
|
||||||
|
# define EOPNOTSUPP ENOTSUP
|
||||||
|
# else
|
||||||
|
# define EOPNOTSUPP (-1)
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
#ifndef EPFNOSUPPORT
|
||||||
|
#define EPFNOSUPPORT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EAFNOSUPPORT
|
||||||
|
#define EAFNOSUPPORT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EADDRINUSE
|
||||||
|
#define EADDRINUSE (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EADDRNOTAVAIL
|
||||||
|
#define EADDRNOTAVAIL (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENETDOWN
|
||||||
|
#define ENETDOWN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENETUNREACH
|
||||||
|
#define ENETUNREACH (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENETRESET
|
||||||
|
#define ENETRESET (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ECONNABORTED
|
||||||
|
#define ECONNABORTED (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ECONNRESET
|
||||||
|
#define ECONNRESET (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOBUFS
|
||||||
|
#define ENOBUFS (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EISCONN
|
||||||
|
#define EISCONN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTCONN
|
||||||
|
#define ENOTCONN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ESHUTDOWN
|
||||||
|
#define ESHUTDOWN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ETOOMANYREFS
|
||||||
|
#define ETOOMANYREFS (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ETIMEDOUT
|
||||||
|
#define ETIMEDOUT (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ECONNREFUSED
|
||||||
|
#define ECONNREFUSED (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EHOSTDOWN
|
||||||
|
#define EHOSTDOWN (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EHOSTUNREACH
|
||||||
|
#define EHOSTUNREACH (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ENOTEMPTY
|
||||||
|
#define ENOTEMPTY (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef ELOOP
|
||||||
|
#define ELOOP (-1)
|
||||||
|
#endif
|
||||||
|
#ifndef EOVERFLOW
|
||||||
|
#define EOVERFLOW (-1)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
int error_table[] = {
|
||||||
|
E2BIG, EACCES, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM,
|
||||||
|
EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK,
|
||||||
|
ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC,
|
||||||
|
ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE,
|
||||||
|
EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY,
|
||||||
|
ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT,
|
||||||
|
EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT,
|
||||||
|
EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH,
|
||||||
|
ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN,
|
||||||
|
ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN,
|
||||||
|
EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */
|
||||||
|
};
|
||||||
|
|
||||||
|
static value * unix_error_exn = NULL;
|
||||||
|
|
||||||
|
value unix_error_of_code (int errcode)
|
||||||
|
{
|
||||||
|
int errconstr;
|
||||||
|
value err;
|
||||||
|
|
||||||
|
#if defined(ENOTSUP) && (EOPNOTSUPP != ENOTSUP)
|
||||||
|
if (errcode == ENOTSUP)
|
||||||
|
errcode = EOPNOTSUPP;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
errconstr =
|
||||||
|
cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
|
||||||
|
if (errconstr == Val_int(-1)) {
|
||||||
|
err = alloc_small(1, 0);
|
||||||
|
Field(err, 0) = Val_int(errcode);
|
||||||
|
} else {
|
||||||
|
err = errconstr;
|
||||||
|
}
|
||||||
|
return err;
|
||||||
|
}
|
||||||
|
|
||||||
|
extern int code_of_unix_error (value error)
|
||||||
|
{
|
||||||
|
if (Is_block(error)) {
|
||||||
|
return Int_val(Field(error, 0));
|
||||||
|
} else {
|
||||||
|
return error_table[Int_val(error)];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void unix_error(int errcode, char *cmdname, value cmdarg)
|
||||||
|
{
|
||||||
|
value res;
|
||||||
|
value name = Val_unit, err = Val_unit, arg = Val_unit;
|
||||||
|
|
||||||
|
Begin_roots3 (name, err, arg);
|
||||||
|
arg = cmdarg == Nothing ? copy_string("") : cmdarg;
|
||||||
|
name = copy_string(cmdname);
|
||||||
|
err = unix_error_of_code (errcode);
|
||||||
|
if (unix_error_exn == NULL) {
|
||||||
|
unix_error_exn = caml_named_value("Unix.Unix_error");
|
||||||
|
if (unix_error_exn == NULL)
|
||||||
|
invalid_argument("Exception Unix.Unix_error not initialized,"
|
||||||
|
" please link unix.cma");
|
||||||
|
}
|
||||||
|
res = alloc_small(4, 0);
|
||||||
|
Field(res, 0) = *unix_error_exn;
|
||||||
|
Field(res, 1) = err;
|
||||||
|
Field(res, 2) = name;
|
||||||
|
Field(res, 3) = arg;
|
||||||
|
End_roots();
|
||||||
|
mlraise(res);
|
||||||
|
}
|
||||||
|
|
||||||
|
void uerror(char *cmdname, value cmdarg)
|
||||||
|
{
|
||||||
|
unix_error(errno, cmdname, cmdarg);
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,27 @@
|
||||||
|
/***********************************************************************/
|
||||||
|
/* */
|
||||||
|
/* OCaml */
|
||||||
|
/* */
|
||||||
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||||
|
/* */
|
||||||
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||||
|
/* en Automatique. All rights reserved. This file is distributed */
|
||||||
|
/* under the terms of the GNU Library General Public License, with */
|
||||||
|
/* the special exception on linking described in file ../../LICENSE. */
|
||||||
|
/* */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
#ifdef HAS_UNISTD
|
||||||
|
#include <unistd.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define Nothing ((value) 0)
|
||||||
|
|
||||||
|
extern value unix_error_of_code (int errcode);
|
||||||
|
extern int code_of_unix_error (value error);
|
||||||
|
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
|
||||||
|
extern void uerror (char * cmdname, value arg) Noreturn;
|
||||||
|
|
||||||
|
#define UNIX_BUFFER_SIZE 65536
|
||||||
|
|
||||||
|
#define DIR_Val(v) *((DIR **) &Field(v, 0))
|
||||||
Loading…
Reference in New Issue