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
|
||||
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
|
||||
ANNOTATE = true
|
||||
|
|
|
|||
|
|
@ -683,7 +683,7 @@ ifndef REAL_OCAMLC
|
|||
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
||||
ifndef CREATE_LIB
|
||||
ifndef REAL_OCAMLFIND
|
||||
ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
|
||||
ALL_LDFLAGS := $(ALL_LDFLAGS)
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
|
@ -729,7 +729,7 @@ else
|
|||
ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
|
||||
ifndef CREATE_LIB
|
||||
ifndef REAL_OCAMLFIND
|
||||
ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
|
||||
ALL_LDFLAGS := $(ALL_LDFLAGS)
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
|
|
|||
|
|
@ -1,77 +1,77 @@
|
|||
(* C-Style strftime *)
|
||||
open Pdfutil
|
||||
|
||||
let strf_A t =
|
||||
match t.Unix.tm_wday with
|
||||
let strf_A t = ""
|
||||
(*match t.Unix.tm_wday with
|
||||
| 0 -> "Sunday" | 1 -> "Monday" | 2 -> "Tuesday"
|
||||
| 3 -> "Wednesday" | 4 -> "Thursday" | 5 -> "Friday"
|
||||
| 6 -> "Saturday"
|
||||
| _ -> "strf_AFail"
|
||||
| _ -> "strf_AFail" *)
|
||||
|
||||
let strf_a t =
|
||||
String.sub (strf_A t) 0 3
|
||||
|
||||
let strf_B t =
|
||||
match t.Unix.tm_mon with
|
||||
let strf_B t = ""
|
||||
(*match t.Unix.tm_mon with
|
||||
| 0 -> "January" | 1 -> "February" | 2 -> "March" | 3 -> "April"
|
||||
| 4 -> "May" | 5 -> "June" | 6 -> "July" | 7 -> "August"
|
||||
| 8 -> "September" | 9 -> "October" | 10 -> "November"
|
||||
| 11 -> "December" | _ -> "strf_Bfail"
|
||||
| 11 -> "December" | _ -> "strf_Bfail"*)
|
||||
|
||||
let strf_b t =
|
||||
String.sub (strf_B t) 0 3
|
||||
|
||||
let strf_d t =
|
||||
let s = string_of_int t.Unix.tm_mday in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_d t = ""
|
||||
(*let s = string_of_int t.Unix.tm_mday in
|
||||
if String.length s = 1 then "0" ^ s else s *)
|
||||
|
||||
let strf_e t =
|
||||
let s = string_of_int t.Unix.tm_mday in
|
||||
if String.length s = 1 then " " ^ s else s
|
||||
let strf_e t = ""
|
||||
(*let s = string_of_int t.Unix.tm_mday in
|
||||
if String.length s = 1 then " " ^ s else s*)
|
||||
|
||||
let strf_H t =
|
||||
let s = string_of_int t.Unix.tm_hour in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_H t = ""
|
||||
(*let s = string_of_int t.Unix.tm_hour in
|
||||
if String.length s = 1 then "0" ^ s else s*)
|
||||
|
||||
let strf_I t =
|
||||
let s = string_of_int (t.Unix.tm_hour mod 12) in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_I t = ""
|
||||
(*let s = string_of_int (t.Unix.tm_hour mod 12) in
|
||||
if String.length s = 1 then "0" ^ s else s *)
|
||||
|
||||
let strf_j t =
|
||||
let s = string_of_int t.Unix.tm_yday in
|
||||
let strf_j t = ""
|
||||
(*let s = string_of_int t.Unix.tm_yday in
|
||||
match String.length s with
|
||||
| 1 -> "00" ^ s
|
||||
| 2 -> "0" ^ s
|
||||
| _ -> s
|
||||
| _ -> s *)
|
||||
|
||||
let strf_m t =
|
||||
let s = string_of_int (t.Unix.tm_mon + 1) in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_m t = ""
|
||||
(*let s = string_of_int (t.Unix.tm_mon + 1) in
|
||||
if String.length s = 1 then "0" ^ s else s *)
|
||||
|
||||
let strf_M t =
|
||||
let s = string_of_int t.Unix.tm_min in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_M t = ""
|
||||
(*let s = string_of_int t.Unix.tm_min in
|
||||
if String.length s = 1 then "0" ^ s else s*)
|
||||
|
||||
let strf_p t =
|
||||
if t.Unix.tm_hour >= 12 then "p.m" else "a.m"
|
||||
let strf_p t = ""
|
||||
(*if t.Unix.tm_hour >= 12 then "p.m" else "a.m"*)
|
||||
|
||||
let strf_S t =
|
||||
let s = string_of_int t.Unix.tm_sec in
|
||||
if String.length s = 1 then "0" ^ s else s
|
||||
let strf_S t = ""
|
||||
(*let s = string_of_int t.Unix.tm_sec in
|
||||
if String.length s = 1 then "0" ^ s else s*)
|
||||
|
||||
let strf_T t =
|
||||
strf_H t ^ ":" ^ strf_M t ^ ":" ^ strf_S t
|
||||
|
||||
let strf_u t =
|
||||
match t.Unix.tm_wday with
|
||||
let strf_u t = ""
|
||||
(*match t.Unix.tm_wday with
|
||||
| 0 -> "7"
|
||||
| n -> string_of_int (n + 1)
|
||||
| n -> string_of_int (n + 1)*)
|
||||
|
||||
let strf_w t =
|
||||
string_of_int t.Unix.tm_wday
|
||||
let strf_w t = ""
|
||||
(*string_of_int t.Unix.tm_wday *)
|
||||
|
||||
let strf_Y t =
|
||||
string_of_int (t.Unix.tm_year + 1900)
|
||||
let strf_Y t = ""
|
||||
(*string_of_int (t.Unix.tm_year + 1900) *)
|
||||
|
||||
let strf_percent _ = "%"
|
||||
|
||||
|
|
@ -82,12 +82,12 @@ let strftime_pairs =
|
|||
"%p", strf_p; "%S", strf_S; "%T", strf_T; "%u", strf_u;
|
||||
"%w", strf_w; "%Y", strf_Y; "%%", strf_percent]
|
||||
|
||||
let strftime text =
|
||||
let time = Unix.localtime (Unix.gettimeofday ()) in
|
||||
let strftime text = ""
|
||||
(*let time = Unix.localtime (Unix.gettimeofday ()) in
|
||||
let text = ref text in
|
||||
iter
|
||||
(fun (search, replace_fun) ->
|
||||
text := string_replace_all search (replace_fun time) !text)
|
||||
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