tcl-extensions

Check-in [feb760fc97]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fix silly errors: now compiles
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | winlock
Files: files | file ages | folders
SHA1:feb760fc97dd11f5d699d10bbc5a2079b6b5ac81
User & Date: aspect 2015-12-15 01:53:06
Context
2015-12-15
02:34
fix name of init function Leaf check-in: 419ca30322 user: aspect tags: winlock
01:53
fix silly errors: now compiles check-in: feb760fc97 user: aspect tags: winlock
01:03
move windows source to windows platform .. what if there is nothing to build on unix? check-in: 983cf52a87 user: aspect tags: winlock
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to win/tclwinlock.c.

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
..
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
int Tcl_WinLockObjCmd(
        ClientData cdata,
        Tcl_Interp *interp,
        int objc,
        Tcl_Obj *const objv[])
{
    Tcl_Channel channel;
    ClientData  *hread, *hwrite;

    DWORD                       flags;
    DWORD                       nb_low, nb_high;
    LPOVERLAPPED                ovl;
    BY_HANDLE_FILE_INFORMATION  fileinfo;

    int f_exclusive = 0;

    /*  ?-exclusive? */
    if(objc < 2) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc > 3) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc == 3) {
        const char* name = Tcl_GetString(objv[1]);
        if(strcmp(name, "-exclusive", strlen(name)) == 0) {
            f_exclusive = 1;
        } else {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid option \"%s\"! Expected ?-exclusive?", name));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
    }

    /* obtain channel from last argument */
    channel = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[objc-1], NULL), NULL);
    if(channel == (Tcl_Channel) NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetStringFromObj(objv[objc-1])));
        return TCL_ERROR;
    }

    /* get the underlying file handles */
    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
        hread = NULL;
    }
    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
        hwrite = NULL;
    }
    if(hread == NULL) { hread = hwrite; }
    if(hwrite == hread) { hwrite = NULL; }
    if(hwrite != NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Two handles!  Unable to lock (%p, %p)", hread, hwrite));
        return TCL_ERROR;
................................................................................
        goto getLastError;
    } else {
        nb_high = fileinfo.nFileSizeHigh;
        nb_low  = fileinfo.nFileSizeLow;
    }

    /* prepare for LockFileEx() */
    memset(ovl, 0, sizeof(ovl));
    ovl->hEvent = 0;

    flags = LOCKFILE_FAIL_IMMEDIATELY;
    if(f_exclusive) {
        flags |= LOCKFILE_EXCLUSIVE_LOCK;
    }

    /* call LockFileEx */
    if(LockFileEx(hread, flags, 0, nb_low, nb_high, ovl)) {

        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Locked %p", hread));
        /* we don't care about the overlay structure; it would be needed for unlocking if we did */
        return TCL_OK;
    }

getLastError:
    {
        /* handle Windows error - cribbed from AppendSystemError in tclWinReg.c */
        DWORD error;
        TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
	char *msgPtr;



        Tcl_DString ds;
        DWORD length;

        error = GetLastError();
        length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
                             NULL, error,
                             MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,







|



|






|




|





|









|

|




|


|







 







|
|







|











|
>
>
>







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
..
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
int Tcl_WinLockObjCmd(
        ClientData cdata,
        Tcl_Interp *interp,
        int objc,
        Tcl_Obj *const objv[])
{
    Tcl_Channel channel;
    ClientData  hread, hwrite;

    DWORD                       flags;
    DWORD                       nb_low, nb_high;
    OVERLAPPED                  ovl;
    BY_HANDLE_FILE_INFORMATION  fileinfo;

    int f_exclusive = 0;

    /*  ?-exclusive? */
    if(objc < 2) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc > 3) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc == 3) {
        const char* name = Tcl_GetString(objv[1]);
        if(strncmp(name, "-exclusive", strlen(name)) == 0) {
            f_exclusive = 1;
        } else {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid option \"%s\"! Expected ?-exclusive?", name));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
    }

    /* obtain channel from last argument */
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[objc-1]), NULL);
    if(channel == (Tcl_Channel) NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetString(objv[objc-1])));
        return TCL_ERROR;
    }

    /* get the underlying file handles */
    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
        hread = NULL;
    }
    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
        hwrite = NULL;
    }
    if(hread == NULL) { hread = hwrite; }
    if(hwrite == hread) { hwrite = NULL; }
    if(hwrite != NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Two handles!  Unable to lock (%p, %p)", hread, hwrite));
        return TCL_ERROR;
................................................................................
        goto getLastError;
    } else {
        nb_high = fileinfo.nFileSizeHigh;
        nb_low  = fileinfo.nFileSizeLow;
    }

    /* prepare for LockFileEx() */
    memset(&ovl, 0, sizeof(ovl));
    ovl.hEvent = 0;

    flags = LOCKFILE_FAIL_IMMEDIATELY;
    if(f_exclusive) {
        flags |= LOCKFILE_EXCLUSIVE_LOCK;
    }

    /* call LockFileEx */
    if(LockFileEx(hread, flags, 0, nb_low, nb_high, &ovl)) {

        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Locked %p", hread));
        /* we don't care about the overlay structure; it would be needed for unlocking if we did */
        return TCL_OK;
    }

getLastError:
    {
        /* handle Windows error - cribbed from AppendSystemError in tclWinReg.c */
        DWORD error;
        TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
        char *msgPtr;
        char id[16];
        char msgBuf[1024];
        char *msg;
        Tcl_DString ds;
        DWORD length;

        error = GetLastError();
        length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
                             NULL, error,
                             MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,