mirror of
https://github.com/johnwhitington/cpdf-source.git
synced 2025-02-09 08:28:52 +01:00
Unix back in
This commit is contained in:
John Whitington
parent
cfd453cca0
commit
ace1c4f3f2
6
Makefile
6
Makefile
@ -1,7 +1,7 @@
|
||||
# Build the cpdf command line tools and top level
|
||||
MODS = cpdfstrftime cpdf cpdfcommand
|
||||
|
||||
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
|
||||
SOURCES = $(foreach x,$(MODS),$(x).ml $(x).mli) cpdfcommandrun.ml
|
||||
|
||||
RESULT = cpdf
|
||||
ANNOTATE = true
|
||||
@ -13,8 +13,8 @@ OCAMLLDFLAGS = -g
|
||||
|
||||
all : native-code native-code-library byte-code-library top htdoc
|
||||
|
||||
LIBINSTALL_FILES = cpdf.a cpdf.cma cpdf.cmxa libcpdf_stubs.a \
|
||||
dllcpdf_stubs.* $(foreach x,$(MODS),$x.mli) $(foreach x,$(MODS),$x.cmi)
|
||||
LIBINSTALL_FILES = cpdf.a cpdf.cma cpdf.cmxa \
|
||||
$(foreach x,$(MODS),$x.mli) $(foreach x,$(MODS),$x.cmi)
|
||||
|
||||
install : libinstall
|
||||
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
open Pdfutil
|
||||
|
||||
let strf_A t =
|
||||
match t.Cpdfunix.tm_wday with
|
||||
match t.Unix.tm_wday with
|
||||
| 0 -> "Sunday" | 1 -> "Monday" | 2 -> "Tuesday"
|
||||
| 3 -> "Wednesday" | 4 -> "Thursday" | 5 -> "Friday"
|
||||
| 6 -> "Saturday"
|
||||
@ -12,7 +12,7 @@ let strf_a t =
|
||||
String.sub (strf_A t) 0 3
|
||||
|
||||
let strf_B t =
|
||||
match t.Cpdfunix.tm_mon with
|
||||
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"
|
||||
@ -22,56 +22,56 @@ let strf_b t =
|
||||
String.sub (strf_B t) 0 3
|
||||
|
||||
let strf_d t =
|
||||
let s = string_of_int t.Cpdfunix.tm_mday in
|
||||
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.Cpdfunix.tm_mday in
|
||||
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.Cpdfunix.tm_hour in
|
||||
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.Cpdfunix.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
|
||||
|
||||
let strf_j t =
|
||||
let s = string_of_int t.Cpdfunix.tm_yday in
|
||||
let s = string_of_int t.Unix.tm_yday in
|
||||
match String.length s with
|
||||
| 1 -> "00" ^ s
|
||||
| 2 -> "0" ^ s
|
||||
| _ -> s
|
||||
|
||||
let strf_m t =
|
||||
let s = string_of_int (t.Cpdfunix.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
|
||||
|
||||
let strf_M t =
|
||||
let s = string_of_int t.Cpdfunix.tm_min in
|
||||
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.Cpdfunix.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 s = string_of_int t.Cpdfunix.tm_sec in
|
||||
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.Cpdfunix.tm_wday with
|
||||
match t.Unix.tm_wday with
|
||||
| 0 -> "7"
|
||||
| n -> string_of_int (n + 1)
|
||||
|
||||
let strf_w t =
|
||||
string_of_int t.Cpdfunix.tm_wday
|
||||
string_of_int t.Unix.tm_wday
|
||||
|
||||
let strf_Y t =
|
||||
string_of_int (t.Cpdfunix.tm_year + 1900)
|
||||
string_of_int (t.Unix.tm_year + 1900)
|
||||
|
||||
let strf_percent _ = "%"
|
||||
|
||||
@ -83,7 +83,7 @@ let strftime_pairs =
|
||||
"%w", strf_w; "%Y", strf_Y; "%%", strf_percent]
|
||||
|
||||
let strftime text =
|
||||
let time = Cpdfunix.localtime (Cpdfunix.gettimeofday ()) in
|
||||
let time = Unix.localtime (Unix.gettimeofday ()) in
|
||||
let text = ref text in
|
||||
iter
|
||||
(fun (search, replace_fun) ->
|
||||
|
||||
103
cpdfunix.ml
103
cpdfunix.ml
@ -1,103 +0,0 @@
|
||||
(***********************************************************************)
|
||||
(* *)
|
||||
(* 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. *)
|
||||
(* *)
|
||||
(***********************************************************************)
|
||||
|
||||
type error =
|
||||
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 of int
|
||||
|
||||
exception Unix_error of error * string * string
|
||||
|
||||
let _ = Callback.register_exception "Unix.Unix_error"
|
||||
(Unix_error(E2BIG, "", ""))
|
||||
|
||||
type tm =
|
||||
{ tm_sec : int;
|
||||
tm_min : int;
|
||||
tm_hour : int;
|
||||
tm_mday : int;
|
||||
tm_mon : int;
|
||||
tm_year : int;
|
||||
tm_wday : int;
|
||||
tm_yday : int;
|
||||
tm_isdst : bool }
|
||||
|
||||
external gettimeofday : unit -> float = "unix_gettimeofday"
|
||||
external localtime : float -> tm = "unix_localtime"
|
||||
|
||||
29
cpdfunix.mli
29
cpdfunix.mli
@ -1,29 +0,0 @@
|
||||
(***********************************************************************)
|
||||
(* *)
|
||||
(* 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. *)
|
||||
(* *)
|
||||
(***********************************************************************)
|
||||
|
||||
type tm =
|
||||
{ tm_sec : int; (** Seconds 0..60 *)
|
||||
tm_min : int; (** Minutes 0..59 *)
|
||||
tm_hour : int; (** Hours 0..23 *)
|
||||
tm_mday : int; (** Day of month 1..31 *)
|
||||
tm_mon : int; (** Month of year 0..11 *)
|
||||
tm_year : int; (** Year - 1900 *)
|
||||
tm_wday : int; (** Day of week (Sunday is 0) *)
|
||||
tm_yday : int; (** Day of year 0..365 *)
|
||||
tm_isdst : bool; (** Daylight time savings in effect *)
|
||||
}
|
||||
|
||||
val gettimeofday : unit -> float
|
||||
|
||||
val localtime : float -> tm
|
||||
|
||||
24
cst2constr.c
24
cst2constr.c
@ -1,24 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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);
|
||||
}
|
||||
14
cst2constr.h
14
cst2constr.h
@ -1,14 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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);
|
||||
@ -1,36 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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
|
||||
93
gmtime.c
93
gmtime.c
@ -1,93 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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
|
||||
309
unixsupport.c
309
unixsupport.c
@ -1,309 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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);
|
||||
}
|
||||
@ -1,27 +0,0 @@
|
||||
/***********************************************************************/
|
||||
/* */
|
||||
/* 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…
x
Reference in New Issue
Block a user