← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mtasc/trusty-proposed

« back to all changes in this revision

Viewing changes to ocaml/extc/extc_stubs.c

  • Committer: Bazaar Package Importer
  • Author(s): Paul Wise
  • Date: 2006-03-25 17:15:45 UTC
  • Revision ID: james.westby@ubuntu.com-20060325171545-zjh6rxeqehxiv4v2
Tags: upstream-1.12
Import upstream version 1.12

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/extc/extc_stubs.c
 
1
/*
 
2
 *  Extc : C common OCaml bindings
 
3
 *  Copyright (c)2004 Nicolas Cannasse
 
4
 *
 
5
 *  This program is free software; you can redistribute it and/or modify
 
6
 *  it under the terms of the GNU General Public License as published by
 
7
 *  the Free Software Foundation; either version 2 of the License, or
 
8
 *  (at your option) any later version.
 
9
 *
 
10
 *  This program is distributed in the hope that it will be useful,
 
11
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
 *  GNU General Public License for more details.
 
14
 *
 
15
 *  You should have received a copy of the GNU General Public License
 
16
 *  along with this program; if not, write to the Free Software
 
17
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
18
 */
 
19
 
 
20
#include <caml/alloc.h>
 
21
#include <caml/mlvalues.h>
 
22
#include <caml/fail.h>
 
23
#include <zlib.h>
 
24
#ifdef _WIN32
 
25
#       include <windows.h>
 
26
#else
 
27
#       include <unistd.h>
 
28
#endif
 
29
#ifdef __APPLE__
 
30
#       include <sys/param.h>
 
31
#       include <mach-o/dyld.h>
 
32
#endif
 
33
 
 
34
#define zval(z)         ((z_streamp)(z))
 
35
 
 
36
value zlib_new_stream() {
 
37
        value z = alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value),Abstract_tag);
 
38
        z_stream *s = zval(z);
 
39
        s->zalloc = NULL;
 
40
        s->zfree = NULL;
 
41
        s->opaque = NULL;
 
42
        s->next_in = NULL;
 
43
        s->next_out = NULL;
 
44
        return z;
 
45
}
 
46
 
 
47
CAMLprim value zlib_deflate_init(value lvl) {
 
48
        value z = zlib_new_stream();
 
49
        if( deflateInit(zval(z),Int_val(lvl)) != Z_OK )
 
50
                failwith("zlib_deflate_init");
 
51
        return z;
 
52
}
 
53
 
 
54
CAMLprim value zlib_deflate( value zv, value src, value spos, value slen, value dst, value dpos, value dlen, value flush ) {
 
55
        z_streamp z = zval(zv);
 
56
        value res;
 
57
        int r;
 
58
 
 
59
        z->next_in = String_val(src) + Int_val(spos);
 
60
        z->next_out = String_val(dst) + Int_val(dpos);
 
61
        z->avail_in = Int_val(slen);
 
62
        z->avail_out = Int_val(dlen);
 
63
        if( (r = deflate(z,Int_val(flush))) < 0 )
 
64
                failwith("zlib_deflate");
 
65
 
 
66
        z->next_in = NULL;
 
67
        z->next_out = NULL;
 
68
 
 
69
        res = alloc_small(3, 0);
 
70
        Field(res, 0) = Val_bool(r == Z_STREAM_END);
 
71
        Field(res, 1) = Val_int(Int_val(slen) - z->avail_in);
 
72
        Field(res, 2) = Val_int(Int_val(dlen) - z->avail_out);
 
73
        return res;
 
74
}
 
75
 
 
76
CAMLprim value zlib_deflate_bytecode(value * arg, int nargs) {
 
77
        return zlib_deflate(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],arg[7]);
 
78
}
 
79
 
 
80
CAMLprim value zlib_deflate_end(value zv) {
 
81
        if( deflateEnd(zval(zv)) != 0 )
 
82
                failwith("zlib_deflate_end");
 
83
        return Val_unit;
 
84
}
 
85
 
 
86
CAMLprim value zlib_inflate_init() {
 
87
        value z = zlib_new_stream();
 
88
        if( inflateInit(zval(z)) != Z_OK )
 
89
                failwith("zlib_inflate_init");
 
90
        return z;
 
91
}
 
92
 
 
93
CAMLprim value zlib_inflate( value zv, value src, value spos, value slen, value dst, value dpos, value dlen, value flush ) {
 
94
        z_streamp z = zval(zv);
 
95
        value res;
 
96
        int r;
 
97
 
 
98
        z->next_in = String_val(src) + Int_val(spos);
 
99
        z->next_out = String_val(dst) + Int_val(dpos);
 
100
        z->avail_in = Int_val(slen);
 
101
        z->avail_out = Int_val(dlen);
 
102
        if( (r = inflate(z,Int_val(flush))) < 0 )
 
103
                failwith("zlib_inflate");
 
104
 
 
105
        z->next_in = NULL;
 
106
        z->next_out = NULL;
 
107
 
 
108
        res = alloc_small(3, 0);
 
109
        Field(res, 0) = Val_bool(r == Z_STREAM_END);
 
110
        Field(res, 1) = Val_int(Int_val(slen) - z->avail_in);
 
111
        Field(res, 2) = Val_int(Int_val(dlen) - z->avail_out);
 
112
        return res;
 
113
}
 
114
 
 
115
CAMLprim value zlib_inflate_bytecode(value * arg, int nargs) {
 
116
        return zlib_inflate(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],arg[7]);
 
117
}
 
118
 
 
119
CAMLprim value zlib_inflate_end(value zv) {
 
120
        if( inflateEnd(zval(zv)) != 0 )
 
121
                failwith("zlib_inflate_end");
 
122
        return Val_unit;
 
123
}
 
124
 
 
125
CAMLprim value executable_path(value u) {
 
126
#ifdef _WIN32
 
127
        char path[MAX_PATH];
 
128
        if( GetModuleFileName(NULL,path,MAX_PATH) == 0 )
 
129
                failwith("executable_path");
 
130
        return caml_copy_string(path);
 
131
#elif __APPLE__
 
132
        char path[MAXPATHLEN+1];
 
133
        unsigned long path_len = MAXPATHLEN;
 
134
        if ( _NSGetExecutablePath(path, &path_len) )
 
135
                failwith("executable_path");
 
136
        return caml_copy_string(path);
 
137
#else
 
138
        const char *p = getenv("_");
 
139
        if( p != NULL )
 
140
                return caml_copy_string(p);
 
141
        {
 
142
                char path[200];
 
143
                int length = readlink("/proc/self/exe", path, sizeof(path));
 
144
                if( length < 0 || length >= 200 )
 
145
                        failwith("executable_path");
 
146
            path[length] = '\0';
 
147
                return caml_copy_string(path);
 
148
        }
 
149
#endif
 
150
}