1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#ifdef _WIN32
#include <wtypes.h>
#include <winbase.h>
#include <winsock.h>
#endif
#include <tcl.h>
#include <tk.h>
#include <caml/mlvalues.h>
#include "camltk.h"
/*
* File descriptor callbacks
*/
void FileProc(ClientData clientdata, int mask)
{
callback2(*handler_code,Val_int(clientdata),Val_int(0));
}
/* Map Unix.file_descr values to Tcl file handles */
#ifndef _WIN32
/* Unix system */
#if TCL_MAJOR_VERSION >= 8
#define tcl_filehandle(fd) Int_val(fd)
#define Tcl_File int
#define Tcl_FreeFile(fd)
#else
static Tcl_File tcl_filehandle(value fd)
{
return Tcl_GetFile((ClientData)Long_val(fd), TCL_UNIX_FD);
}
#endif
#else
/* Windows */
#define Handle_val(v) (*((HANDLE *)(v)))
static Tcl_File tcl_filehandle(value fd)
{
HANDLE h = Handle_val(fd);
int type;
int optval, optsize;
optsize = sizeof(optval);
if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, &optval, &optsize) == 0)
type = TCL_WIN_SOCKET;
else
switch (GetFileType(h)) {
case FILE_TYPE_CHAR:
type = TCL_WIN_CONSOLE;
case FILE_TYPE_PIPE:
type = TCL_WIN_PIPE;
case FILE_TYPE_DISK:
default: /* use WIN_FILE for unknown handles */
type = TCL_WIN_FILE;
}
return Tcl_GetFile(h, type);
}
#endif
value camltk_add_file_input(fd, cbid) /* ML */
value fd;
value cbid;
{
CheckInit();
Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_READABLE,
FileProc, (ClientData)(Long_val(cbid)));
return Val_unit;
}
/* We have to free the Tcl handle when we are finished using it (Tcl
* asks us to, and moreover it is probably dangerous to keep the same
* handle over two allocations of the same fd by the kernel).
* But we don't know when we are finished with the fd, so we free it
* 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(fd) /* ML */
value fd;
{
Tcl_File fh = tcl_filehandle(fd);
Tcl_DeleteFileHandler(fh);
Tcl_FreeFile(fh);
return Val_unit;
}
value camltk_add_file_output(fd, cbid) /* ML */
value fd;
value cbid;
{
CheckInit();
Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_WRITABLE,
FileProc, (ClientData) (Long_val(cbid)));
return Val_unit;
}
value camltk_rem_file_output(fd) /* ML */
value fd;
{
Tcl_File fh = tcl_filehandle(fd);
Tcl_DeleteFileHandler(fh);
Tcl_FreeFile(fh);
return Val_unit;
}
|
