Menu
▾
▴
clisp-cvs Digest, Vol 42, Issue 13
|
From: <cli...@li...> - 2009-10-13 12:04:17
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src ChangeLog,1.7161,1.7162 stream.d,1.661,1.662 (Sam Steingold) 2. clisp/src ChangeLog,1.7162,1.7163 stream.d,1.662,1.663 (Sam Steingold) 3. clisp/src stream.d,1.663,1.664 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Mon, 12 Oct 2009 19:23:27 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.7161,1.7162 stream.d,1.661,1.662 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv444/src Modified Files: ChangeLog stream.d Log Message: (handle_direction_compatible): implement for WIN32_NATIVE using NtQueryInformationFile (fixes check-script) Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.661 retrieving revision 1.662 diff -u -d -r1.661 -r1.662 --- stream.d 8 Oct 2009 14:57:29 -0000 1.661 +++ stream.d 12 Oct 2009 19:23:24 -0000 1.662 @@ -14910,12 +14910,29 @@ /* Streams in general ================== */ +#if defined(WIN32_NATIVE) +/* http://msdn.microsoft.com/en-us/library/ms804359.aspx */ +#include <ddk/ntifs.h> +typedef NTSTATUS (*QueryInformationFile_t) +(IN HANDLE FileHandle, OUT PIO_STATUS_BLOCK IoStatusBlock, + OUT PVOID FileInformation, IN ULONG Length, + IN FILE_INFORMATION_CLASS FileInformationClass); +static QueryInformationFile_t qif = (QueryInformationFile_t) -1; +static QueryInformationFile_t get_qif (void) { + if (qif == NULL) return qif; + var HMODULE ntdll = LoadLibrary("ntdll.dll"); + if (ntdll == NULL) return (qif = NULL); + return (qif = (QueryInformationFile_t) + GetProcAddress(ntdll, "NtQueryInformationFile")); +} +#endif + /* UP: find out whether the direction is compatible with the handle > fd: file handle > dir: direction > true is the direction is compatible with the handle */ local bool handle_direction_compatible (Handle fd, direction_t dir) { - #ifdef UNIX + #if defined(UNIX) begin_blocking_system_call(); var int fcntl_flags = fcntl(fd,F_GETFL,0); end_blocking_system_call(); @@ -14927,6 +14944,25 @@ DEBUG_OUT(("\nhandle_direction_compatible(%d,%d): 0x%x => %d\n", fd,dir,fcntl_flags,ret)); return ret; + #elif defined(WIN32_NATIVE) + #include <ddk/ntifs.h> + var bool ret = true; /* assume compatibility */ + begin_blocking_system_call(); + /* http://groups.google.com/group/microsoft.public.win32.programmer.kernel/browse_thread/thread/a446be4fb332aeba# */ + var QueryInformationFile_t qif = get_qif(); + if (qif != NULL) { + var IO_STATUS_BLOCK iosb; + var FILE_ACCESS_INFORMATION fai; + var NTSTATUS s = qif(fd,&iosb,(void*)&fai,sizeof(fai), + FileAccessInformation); + ret = (s != STATUS_SUCCESS + || ( (!READ_P(dir) || fai.AccessFlags & FILE_READ_DATA) + && (!WRITE_P(dir) || fai.AccessFlags & FILE_WRITE_DATA))); + DEBUG_OUT(("\nhandle_direction_compatible(%d,%d): 0x%x 0x%x => %d\n", + fd,dir,s,fai.AccessFlags,ret)); + } + end_blocking_system_call(); + return ret; #else return true; /* assume compatibility */ #endif Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7161 retrieving revision 1.7162 diff -u -d -r1.7161 -r1.7162 --- ChangeLog 9 Oct 2009 20:37:38 -0000 1.7161 +++ ChangeLog 12 Oct 2009 19:23:24 -0000 1.7162 @@ -1,3 +1,8 @@ +2009-10-12 Sam Steingold <sd...@gn...> + + * stream.d (handle_direction_compatible): implement for + WIN32_NATIVE using NtQueryInformationFile (fixes check-script) + 2009-10-09 Vladimir Tzankov <vtz...@gm...> [MULTITHREAD]: simplify alternative TLS on 32 bit builds ------------------------------ Message: 2 Date: Mon, 12 Oct 2009 22:00:29 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.7162,1.7163 stream.d,1.662,1.663 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv19596/src Modified Files: ChangeLog stream.d Log Message: (handle_pathname): extract from handle_to_stream and implement for WIN32_NATIVE (handle_to_stream): use it Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.662 retrieving revision 1.663 diff -u -d -r1.662 -r1.663 --- stream.d 12 Oct 2009 19:23:24 -0000 1.662 +++ stream.d 12 Oct 2009 22:00:27 -0000 1.663 @@ -14968,6 +14968,50 @@ #endif } +/* UP: find the pathname corresponding to the given handle + > fd: file handle + < pathname or NIL + can trigger GC */ +local maygc object handle_pathname (Handle fd) { + #if defined(UNIX) + var char buf[20]; + begin_system_call(); + sprintf(buf,"/dev/fd/%d",fd); + end_system_call(); + pushSTACK(ascii_to_string(buf)); funcall(L(pathname),1); + return value1; + #elif defined(WIN32_NATIVE) + var NTSTATUS s = ~STATUS_SUCCESS; + var WCHAR wbuf[MAXPATHLEN + sizeof(ULONG)]; + begin_blocking_system_call(); + switch (GetFileType(fd)) { + case FILE_TYPE_DISK: { + var QueryInformationFile_t qif = get_qif(); + if (qif != NULL) { + var IO_STATUS_BLOCK iosb; + s = qif(fd,&iosb,(void*)wbuf,MAXPATHLEN + sizeof(ULONG), + FileNameInformation); + } + } break; + case FILE_TYPE_CHAR: case FILE_TYPE_PIPE: case FILE_TYPE_REMOTE: + case FILE_TYPE_UNKNOWN: break; + } + end_blocking_system_call(); + if (s == STATUS_SUCCESS) { + var FILE_NAME_INFORMATION *fni = (FILE_NAME_INFORMATION*)&wbuf; + var char abuf[2 * MAXPATHLEN]; + var int n = WideCharToMultiByte(CP_ACP,0,fni->FileName, + fni->FileNameLength/sizeof(WCHAR), + abuf,2 * MAXPATHLEN,NULL,NULL); + pushSTACK(n_char_to_string(abuf,n,O(pathname_encoding))); + funcall(L(pathname),1); + return value1; + } else return NIL; + #else + return NIL; + #endif +} + /* Create a stream based on a handle can trigger GC */ local maygc object handle_to_stream (Handle fd, object direction, object buff_p, @@ -14980,21 +15024,15 @@ pushSTACK(eltype); pushSTACK(allocate_handle(handle_dup(fd))); dir = check_direction(direction); - #ifdef UNIX - { /* set Filename to /dev/fd/<fd> */ - var char buf[20]; - begin_system_call(); - sprintf(buf,"/dev/fd/%d",fd); - end_system_call(); - pushSTACK(ascii_to_string(buf)); funcall(L(pathname),1); - STACK_5 = value1; - } + STACK_5 = handle_pathname(fd); if (!handle_direction_compatible(fd,dir)) { - pushSTACK(STACK_5); /* FILE-ERROR slot PATHNAME */ - pushSTACK(STACK_0); pushSTACK(direction); - error(file_error,GETTEXT("Invalid direction ~S for accessing ~S")); + var condition_t errortype = nullp(STACK_5) + ? (pushSTACK(STACK_0), error_condition) + : (pushSTACK(STACK_5), /* FILE-ERROR slot PATHNAME */ + pushSTACK(STACK_0), file_error); + pushSTACK(direction); + error(errortype,GETTEXT("Invalid direction ~S for accessing ~S")); } - #endif return make_file_stream(dir,false,dir == DIRECTION_IO); } Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7162 retrieving revision 1.7163 diff -u -d -r1.7162 -r1.7163 --- ChangeLog 12 Oct 2009 19:23:24 -0000 1.7162 +++ ChangeLog 12 Oct 2009 22:00:27 -0000 1.7163 @@ -1,5 +1,11 @@ 2009-10-12 Sam Steingold <sd...@gn...> + * stream.d (handle_pathname): extract from handle_to_stream and + implement for WIN32_NATIVE + (handle_to_stream): use it + +2009-10-12 Sam Steingold <sd...@gn...> + * stream.d (handle_direction_compatible): implement for WIN32_NATIVE using NtQueryInformationFile (fixes check-script) ------------------------------ Message: 3 Date: Mon, 12 Oct 2009 22:16:48 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src stream.d,1.663,1.664 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv21465 Modified Files: stream.d Log Message: handle_direction_compatible: check whether GetLastError failed Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.663 retrieving revision 1.664 diff -u -d -r1.663 -r1.664 --- stream.d 12 Oct 2009 22:00:27 -0000 1.663 +++ stream.d 12 Oct 2009 22:16:46 -0000 1.664 @@ -14945,21 +14945,28 @@ fd,dir,fcntl_flags,ret)); return ret; #elif defined(WIN32_NATIVE) - #include <ddk/ntifs.h> var bool ret = true; /* assume compatibility */ + /* http://groups.google.com/group/microsoft.public.win32.programmer.kernel/browse_thread/thread/a446be4fb332aeba */ begin_blocking_system_call(); - /* http://groups.google.com/group/microsoft.public.win32.programmer.kernel/browse_thread/thread/a446be4fb332aeba# */ - var QueryInformationFile_t qif = get_qif(); - if (qif != NULL) { - var IO_STATUS_BLOCK iosb; - var FILE_ACCESS_INFORMATION fai; - var NTSTATUS s = qif(fd,&iosb,(void*)&fai,sizeof(fai), - FileAccessInformation); - ret = (s != STATUS_SUCCESS - || ( (!READ_P(dir) || fai.AccessFlags & FILE_READ_DATA) - && (!WRITE_P(dir) || fai.AccessFlags & FILE_WRITE_DATA))); - DEBUG_OUT(("\nhandle_direction_compatible(%d,%d): 0x%x 0x%x => %d\n", - fd,dir,s,fai.AccessFlags,ret)); + switch (GetFileType(fd)) { + case FILE_TYPE_CHAR: case FILE_TYPE_PIPE: case FILE_TYPE_REMOTE: + case FILE_TYPE_DISK: { + var QueryInformationFile_t qif = get_qif(); + if (qif != NULL) { + var IO_STATUS_BLOCK iosb; + var FILE_ACCESS_INFORMATION fai; + var NTSTATUS s = qif(fd,&iosb,(void*)&fai,sizeof(fai), + FileAccessInformation); + ret = (s == STATUS_SUCCESS + && (!READ_P(dir) || fai.AccessFlags & FILE_READ_DATA) + && (!WRITE_P(dir) || fai.AccessFlags & FILE_WRITE_DATA)); + DEBUG_OUT(("\nhandle_direction_compatible(%d,%d): 0x%x 0x%x => %d\n", + fd,dir,s,fai.AccessFlags,ret)); + } + } break; + case FILE_TYPE_UNKNOWN: + /* GetFileType failed => handle was invalid */ + if (GetLastError() != NO_ERROR) ret = false; } end_blocking_system_call(); return ret; ------------------------------ ------------------------------------------------------------------------------ Come build with us! The BlackBerry(R) Developer Conference in SF, CA is the only developer event you need to attend this year. Jumpstart your developing skills, take BlackBerry mobile applications to market and stay ahead of the curve. Join us from November 9 - 12, 2009. Register now! http://p.sf.net/sfu/devconference ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 42, Issue 13 ***************************************** |