clisp-cvs Digest, Vol 48, Issue 5

[c***@lists.sourceforge.net]

Send clisp-cvs mailing list submissions to
clisp-***@lists.sourceforge.net

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
clisp-cvs-***@lists.sourceforge.net

You can reach the person managing the list at
clisp-cvs-***@lists.sourceforge.net

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.7301,1.7302 spvw.d,1.524,1.525
(Sam Steingold)
2. clisp/src ChangeLog, 1.7302, 1.7303 spvw.d, 1.525, 1.526
spvw_sigterm.d, 1.13, 1.14 (Sam Steingold)
3. clisp/src ChangeLog, 1.7303, 1.7304 spvw.d, 1.526, 1.527
spvw_sigterm.d, 1.14, 1.15 (Vladimir Tzankov)
4. clisp/src spvw.d,1.527,1.528 (Sam Steingold)
5. clisp/src ChangeLog,1.7304,1.7305 w32shell.c,1.11,1.12
(Arseny Slobodyuk)


----------------------------------------------------------------------

Message: 1
Date: Mon, 12 Apr 2010 18:29:34 +0000
From: Sam Steingold <***@users.sourceforge.net>
Subject: clisp/src ChangeLog,1.7301,1.7302 spvw.d,1.524,1.525
To: clisp-***@lists.sourceforge.net
Message-ID: <E1O1OO6-0002YM-***@sfp-cvsdas-2.v30.ch3.sourceforge.com>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv9794/src

Modified Files:
ChangeLog spvw.d
Log Message:
(quit_on_signal_in_progress) [MULTITHREAD]: add
(signal_handler_thread) [MULTITHREAD]: fix last patch:
set quit_on_signal_in_progress when terminating


Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.524
retrieving revision 1.525
diff -u -d -r1.524 -r1.525
--- spvw.d 4 Mar 2010 21:15:29 -0000 1.524
+++ spvw.d 12 Apr 2010 18:29:32 -0000 1.525
@@ -2491,7 +2491,7 @@
if (asciz_equal(arg,"-help-image")) {
p2->argv_help_image = true;
break;
- } else if (arg[2] != 0)
+ } else if (arg[2] != 0)
INVALID_ARG(arg);
else {
usage(delegating);
@@ -2526,7 +2526,7 @@
case 't': /* traditional, temporary directory */
if (asciz_equal(arg,"-traditional"))
p2->argv_ansi = 2; /* traditional */
- else
+ else
INVALID_ARG(arg);
break;
case 'd': /* -d (developer mode) or -disable-readline */
@@ -2534,7 +2534,7 @@
disable_readline = true;
else if (arg[2] == '\0')
p2->argv_developer = true;
- else
+ else
INVALID_ARG(arg);
break;
case 'B': /* lisplibdir */
@@ -2548,7 +2548,7 @@
case 'n':
if (asciz_equal(arg,"-norc"))
p2->argv_norc = true;
- else
+ else
INVALID_ARG(arg);
break;
#if defined(UNIX) || defined(WIN32_NATIVE)
@@ -2590,39 +2590,39 @@
argv_encoding_file = argv_encoding_pathname =
argv_encoding_terminal = argv_encoding_foreign =
argv_encoding_misc = *argptr++;
- else
+ else
INVALID_ARG(arg);
break;
case 'q': /* verbosity level */
p2->argv_verbose--;
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
break;
case 'v': /* verbosity level */
p2->argv_verbose++;
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
break;
case 'I': /* ILISP-friendly */
ilisp_mode = true;
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
break;
case 'C': /* set *LOAD-COMPILING* */
p2->argv_load_compiling = true;
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
break;
case 'r': /* -repl */
if (asciz_equal(&arg[1],"repl"))
p2->argv_repl = true;
- else
+ else
INVALID_ARG(arg);
break;
case 'i': /* initialization files */
if (arg[2] == '\0')
argv_for = for_init;
- else
+ else
INVALID_ARG(arg);
break;
case 'c': /* files to be compiled */
@@ -2630,10 +2630,10 @@
argv_for = for_compile;
if (arg[2] == 'l') {
p2->argv_compile_listing = true;
- if (arg[3] != '\0')
+ if (arg[3] != '\0')
INVALID_ARG(arg);
} else {
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
}
break;
@@ -2642,14 +2642,14 @@
p2->argv_compile_listing = true;
else if (arg[2] == 'p' && arg[3] == 0) {
argv_for = for_load_path;
- } else
+ } else
INVALID_ARG(arg);
break;
case 'o':
if (asciz_equal(&arg[1],"on-error")) {
if (argptr < argptr_limit)
arg = *argptr++;
- else
+ else
INVALID_ARG(arg);
if (asciz_equal(arg,"default"))
p2->argv_on_error = ON_ERROR_DEFAULT;
@@ -2668,10 +2668,10 @@
} else if (arg[2] == '\0') { /* target for files to be compiled */
OPTION_ARG;
if (!((p2->argv_compile_filecount > 0)
- && (p2->argv_compile_files[p2->argv_compile_filecount-1].output_file==NULL)))
+ && (p2->argv_compile_files[p2->argv_compile_filecount-1].output_file==NULL)))
INVALID_ARG(arg);
p2->argv_compile_files[p2->argv_compile_filecount-1].output_file = arg;
- } else
+ } else
INVALID_ARG(arg);
break;
case 'p': /* package: when repeated, only the last one counts. */
@@ -2681,17 +2681,17 @@
case 'a': /* ANSI CL Compliance */
if (asciz_equal(arg,"-ansi"))
p2->argv_ansi = 1; /* ANSI */
- else
+ else
INVALID_ARG(arg);
break;
case 'x': /* execute LISP-expression */
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
argv_for = for_expr;
break;
case 'w': /* wait for keypress after termination */
p2->argv_wait_keypress = true;
- if (arg[2] != '\0')
+ if (arg[2] != '\0')
INVALID_ARG(arg);
break;
case '-': /* -- GNU-style long options */
@@ -4547,6 +4547,7 @@

/* UP: The signal handler in MT build.

arg: not used. */

+global bool quit_on_signal_in_progress = false;
local void *signal_handler_thread(void *arg)
{
while (1) {
@@ -4659,6 +4660,7 @@
break;
#endif
default:
+ quit_on_signal_in_progress = true;
/* just terminate all threads - the last one will
kill the process from delete_thread */
WITH_STOPPED_WORLD(false,{

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7301
retrieving revision 1.7302
diff -u -d -r1.7301 -r1.7302
--- ChangeLog 11 Apr 2010 20:29:47 -0000 1.7301
+++ ChangeLog 12 Apr 2010 18:29:32 -0000 1.7302
@@ -1,3 +1,9 @@
[phone] Sam Steingold <***@gnu.org>
+
+ * spvw.d (quit_on_signal_in_progress) [MULTITHREAD]: add
+ (signal_handler_thread) [MULTITHREAD]: fix last patch:
+ set quit_on_signal_in_progress when terminating
+
2010-04-11 Sam Steingold <***@gnu.org>

fix bug#2795278: when quitting on signals, do not enter the debugger




------------------------------

Message: 2
Date: Mon, 12 Apr 2010 18:45:22 +0000
From: Sam Steingold <***@users.sourceforge.net>
Subject: clisp/src ChangeLog, 1.7302, 1.7303 spvw.d, 1.525, 1.526
spvw_sigterm.d, 1.13, 1.14
To: clisp-***@lists.sourceforge.net
Message-ID: <E1O1OdP-000459-***@sfp-cvsdas-2.v30.ch3.sourceforge.com>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv15680/src

Modified Files:
ChangeLog spvw.d spvw_sigterm.d
Log Message:
define quit_on_signal_in_progress just once, in spvw_sigterm,
independent of MULTITHREAD


Index: spvw_sigterm.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_sigterm.d,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- spvw_sigterm.d 11 Apr 2010 20:29:48 -0000 1.13
+++ spvw_sigterm.d 12 Apr 2010 18:45:20 -0000 1.14
@@ -1,4 +1,8 @@
/* Handling of terminating signals. */
+
+/* MULTITHREAD: set in spvw.d:signal_handler_thread() */
+global bool quit_on_signal_in_progress = false;
+
#if !defined(MULTITHREAD)

/* --------------------------- Specification ----------------------------- */
@@ -42,7 +46,6 @@
}


-global bool quit_on_signal_in_progress = false;
/* print the "exiting" message and quit */
local void quit_on_signal (int sig) {
#ifndef NO_ASYNC_INTERRUPTS

Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.525
retrieving revision 1.526
diff -u -d -r1.525 -r1.526
--- spvw.d 12 Apr 2010 18:29:32 -0000 1.525
+++ spvw.d 12 Apr 2010 18:45:20 -0000 1.526
@@ -4547,7 +4547,6 @@

/* UP: The signal handler in MT build.

arg: not used. */

-global bool quit_on_signal_in_progress = false;
local void *signal_handler_thread(void *arg)
{
while (1) {

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7302
retrieving revision 1.7303
diff -u -d -r1.7302 -r1.7303
--- ChangeLog 12 Apr 2010 18:29:32 -0000 1.7302
+++ ChangeLog 12 Apr 2010 18:45:20 -0000 1.7303
@@ -1,7 +1,7 @@
2010-04-12 Sam Steingold <***@gnu.org>

- * spvw.d (quit_on_signal_in_progress) [MULTITHREAD]: add
- (signal_handler_thread) [MULTITHREAD]: fix last patch:
+ * spvw_sigterm.d (quit_on_signal_in_progress): always define
+ * spvw.d (signal_handler_thread) [MULTITHREAD]: fix last patch:
set quit_on_signal_in_progress when terminating

2010-04-11 Sam Steingold <***@gnu.org>




------------------------------

Message: 3
Date: Mon, 12 Apr 2010 19:37:40 +0000
From: Vladimir Tzankov <***@users.sourceforge.net>
Subject: clisp/src ChangeLog, 1.7303, 1.7304 spvw.d, 1.526, 1.527
spvw_sigterm.d, 1.14, 1.15
To: clisp-***@lists.sourceforge.net
Message-ID: <E1O1PS0-0000LT-***@sfp-cvsdas-2.v30.ch3.sourceforge.com>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv843/src

Modified Files:
ChangeLog spvw.d spvw_sigterm.d
Log Message:
[MULTITHREAD]: fix process exit code on terminating signals


Index: spvw_sigterm.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_sigterm.d,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- spvw_sigterm.d 12 Apr 2010 18:45:20 -0000 1.14
+++ spvw_sigterm.d 12 Apr 2010 19:37:38 -0000 1.15
@@ -1,8 +1,6 @@
/* Handling of terminating signals. */

-/* MULTITHREAD: set in spvw.d:signal_handler_thread() */
-global bool quit_on_signal_in_progress = false;
-
+/* in MT signals are handled in spvw.d:signal_handler_thread()*/
#if !defined(MULTITHREAD)

/* --------------------------- Specification ----------------------------- */

Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.526
retrieving revision 1.527
diff -u -d -r1.526 -r1.527
--- spvw.d 12 Apr 2010 18:45:20 -0000 1.526
+++ spvw.d 12 Apr 2010 19:37:37 -0000 1.527
@@ -3904,6 +3904,7 @@
quit();

final_exitcode: 0 on normal exit, 1 on abort */

global int final_exitcode = 0;
+global bool quit_on_signal_in_progress = false;
local int quit_retry = 0;
nonreturning_function(global, quit, (void)) {
/* first "unwind" the STACK downto STACK-end: */
@@ -4280,27 +4281,35 @@
sigaddset(&sigblock_mask,SIGINT);
sigaddset(&sigblock_mask,SIGALRM);
sigaddset(&sigblock_mask,SIG_TIMEOUT_CALL);
+ #if defined(SIGWINCH)
+ sigaddset(&sigblock_mask,SIGWINCH);
+ #endif
+ /* following are terminating signals - handle them only if we are not
+ already being killed*/
+ if (!quit_on_signal_in_progress) {
#ifdef SIGHUP
- sigaddset(&sigblock_mask,SIGHUP);
+ sigaddset(&sigblock_mask,SIGHUP);
#endif
#ifdef SIGQUIT
- sigaddset(&sigblock_mask,SIGQUIT);
+ sigaddset(&sigblock_mask,SIGQUIT);
#endif
#ifdef SIGILL
- sigaddset(&sigblock_mask,SIGILL);
+ sigaddset(&sigblock_mask,SIGILL);
#endif
#ifdef SIGABRT
- sigaddset(&sigblock_mask,SIGABRT);
+ sigaddset(&sigblock_mask,SIGABRT);
#endif
#ifdef SIGKILL
- sigaddset(&sigblock_mask,SIGKILL);
+ sigaddset(&sigblock_mask,SIGKILL);
#endif
#ifdef SIGTERM
- sigaddset(&sigblock_mask,SIGTERM);
+ sigaddset(&sigblock_mask,SIGTERM);
#endif
- #if defined(SIGWINCH)
- sigaddset(&sigblock_mask,SIGWINCH);
+ #ifdef SIGTTOU
+ /* always ignored */
+ sigaddset(&sigblock_mask,SIGTTOU);
#endif
+ }
return sigblock_mask;
}

@@ -4659,12 +4668,14 @@
break;
#endif
default:
- quit_on_signal_in_progress = true;
/* just terminate all threads - the last one will
kill the process from delete_thread */
+ fprintf(stderr, "Exiting on signal %d\n", sig);
WITH_STOPPED_WORLD(false,{
- var bool some_failed=true;
+ var bool all_succeeded = true;
ENABLE_DUMMY_ALLOCCOUNT(true);
+ quit_on_signal_in_progress = true;
+ final_exitcode = -sig; /* set process exit code */
for_all_threads({
/* be sure the signal handler can be reentered */
spinlock_acquire(&thread->_signal_reenter_ok);
@@ -4672,12 +4683,12 @@
NC_pushSTACK(thread->_STACK,S(thread_throw_tag)); /* %THROW-TAG */
NC_pushSTACK(thread->_STACK,posfixnum(1)); /* 1 argument */
NC_pushSTACK(thread->_STACK,T); /* do not defer the interrupt */
- some_failed &= interrupt_thread(thread);
+ all_succeeded &= interrupt_thread(thread);
});
- if (some_failed) {
+ if (!all_succeeded) {
fputs("*** some threads were not signaled to terminate.",stderr);
- exit(sig); /* nothing we can do - exit immediately (cannot call quit
- from here) */
+ exit(-sig); /* nothing we can do - exit immediately (cannot call quit
+ from here) */
}
ENABLE_DUMMY_ALLOCCOUNT(false);
});

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7303
retrieving revision 1.7304
diff -u -d -r1.7303 -r1.7304
--- ChangeLog 12 Apr 2010 18:45:20 -0000 1.7303
+++ ChangeLog 12 Apr 2010 19:37:37 -0000 1.7304
@@ -1,3 +1,13 @@
[phone] Vladimir Tzankov <***@gmail.com>
+
+ * spvw_sigterm.d (quit_on_signal_in_progress): move to spvw.d
+ * spvw.d (quit_on_signal_in_progress): define it here
+ (async_signal_mask) [POSIX_THREADS]: do not add terminating signals if
+ process was already signaled with one of them
+ (signal_handler_thread): set proper exit code on terminating signal.
+ print to stderr "Exiting on signal ...". fix erroneous message on
+ terminating signal
+
2010-04-12 Sam Steingold <***@gnu.org>

* spvw_sigterm.d (quit_on_signal_in_progress): always define




------------------------------

Message: 4
Date: Mon, 12 Apr 2010 20:23:24 +0000
From: Sam Steingold <***@users.sourceforge.net>
Subject: clisp/src spvw.d,1.527,1.528
To: clisp-***@lists.sourceforge.net
Message-ID: <E1O1QAG-0004IY-***@sfp-cvsdas-2.v30.ch3.sourceforge.com>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv16513

Modified Files:
spvw.d
Log Message:
indentation


Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.527
retrieving revision 1.528
diff -u -d -r1.527 -r1.528
--- spvw.d 12 Apr 2010 19:37:37 -0000 1.527
+++ spvw.d 12 Apr 2010 20:23:22 -0000 1.528
@@ -4281,34 +4281,34 @@
sigaddset(&sigblock_mask,SIGINT);
sigaddset(&sigblock_mask,SIGALRM);
sigaddset(&sigblock_mask,SIG_TIMEOUT_CALL);
- #if defined(SIGWINCH)
- sigaddset(&sigblock_mask,SIGWINCH);
- #endif
+ #if defined(SIGWINCH)
+ sigaddset(&sigblock_mask,SIGWINCH);
+ #endif
/* following are terminating signals - handle them only if we are not
already being killed*/
if (!quit_on_signal_in_progress) {
- #ifdef SIGHUP
+ #ifdef SIGHUP
sigaddset(&sigblock_mask,SIGHUP);
- #endif
- #ifdef SIGQUIT
+ #endif
+ #ifdef SIGQUIT
sigaddset(&sigblock_mask,SIGQUIT);
- #endif
- #ifdef SIGILL
+ #endif
+ #ifdef SIGILL
sigaddset(&sigblock_mask,SIGILL);
- #endif
- #ifdef SIGABRT
+ #endif
+ #ifdef SIGABRT
sigaddset(&sigblock_mask,SIGABRT);
- #endif
- #ifdef SIGKILL
+ #endif
+ #ifdef SIGKILL
sigaddset(&sigblock_mask,SIGKILL);
- #endif
- #ifdef SIGTERM
+ #endif
+ #ifdef SIGTERM
sigaddset(&sigblock_mask,SIGTERM);
- #endif
- #ifdef SIGTTOU
- /* always ignored */
+ #endif
+ #ifdef SIGTTOU
+ /* always ignored */
sigaddset(&sigblock_mask,SIGTTOU);
- #endif
+ #endif
}
return sigblock_mask;
}




------------------------------

Message: 5
Date: Tue, 13 Apr 2010 03:25:17 +0000
From: Arseny Slobodyuk <***@users.sourceforge.net>
Subject: clisp/src ChangeLog,1.7304,1.7305 w32shell.c,1.11,1.12
To: clisp-***@lists.sourceforge.net
Message-ID: <E1O1WkX-0005tP-***@sfp-cvsdas-2.v30.ch3.sourceforge.com>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv22177

Modified Files:
ChangeLog w32shell.c
Log Message:
Fixed bug#1481218 - default drive directory not detected in -M argument


Index: w32shell.c
===================================================================
RCS file: /cvsroot/clisp/clisp/src/w32shell.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- w32shell.c 31 Mar 2010 01:12:21 -0000 1.11
+++ w32shell.c 13 Apr 2010 03:25:15 -0000 1.12
@@ -280,13 +280,14 @@
HANDLE h = NULL;
char * nametocheck;
char * nametocheck_end;
+ int name_len;
/* drive|dir1|dir2|name
^nametocheck
^nametocheck_end */
char saved_char;
BOOL next_name = 0;/* if we found an lnk and need to start over */
int try_counter = 33;
- if (strlen(namein) >= MAX_PATH) return FALSE;
+ if ((name_len = strlen(namein)) >= MAX_PATH) return FALSE;
strcpy(nameout,namein);
do { /* whole file names */
next_name = FALSE;
@@ -295,9 +296,26 @@
nametocheck = nameout;
if (((*nametocheck >= 'a' && *nametocheck <= 'z')
|| (*nametocheck >= 'A' && *nametocheck <= 'Z'))
- && nametocheck[1] == ':' && cpslashp(nametocheck[2]))
- /* drive */
- nametocheck += 3;
+ && nametocheck[1] == ':')
+ { if (cpslashp(nametocheck[2])) {
+ /* drive */
+ nametocheck += 3;
+ } else {
+ /* default directory on drive */
+ char drive[4] = "C:.", *name;
+ int default_len;
+ drive[0] = namein[0];
+ if (!GetFullPathName(drive,_MAX_PATH,nameout,&name)
+ || (default_len = strlen(nameout)) + name_len
+ >= _MAX_PATH) return FALSE;
+ nameout[default_len] = '\\';
+ strcpy(nameout + default_len + 1, namein + 2);
+ name_len += default_len - 1; /* Was C:lisp.exe
+ Now C:\clisp\lisp.exe
+ removed 2
+ added default_len + 1 chars */
+ nametocheck += default_len + 1;
+ } }
else if (nametocheck[0]=='\\' && nametocheck[1]=='\\') {
int i;
/* host */
@@ -325,8 +343,8 @@
{ char * cp = nametocheck;
for (;*cp=='.';cp++);
dots_only = !(*cp) && cp > nametocheck; }
- /* Stars in the middle of filename: error
- Stars as pathname: success */
+ /* Asterisks in the middle of filename: error
+ Asterisks as pathname: success */
{ char * cp = nametocheck;
for (;*cp && *cp!='*';cp++);
have_stars = *cp == '*'; }
@@ -350,26 +368,27 @@
h = FindFirstFile(nameout,&wfd);
if (h != INVALID_HANDLE_VALUE) {
/* make space for full (non 8.3) name component */
- int l = strlen(wfd.cFileName);
+ int l = strlen(wfd.cFileName),
+ oldl = nametocheck_end - nametocheck,
+ new_name_len = name_len + l - oldl;
FindClose(h);
- if (l != (nametocheck_end - nametocheck)) {
+ if (new_name_len >= _MAX_PATH) return FALSE;
+ if (l != oldl) {
int restlen =
- saved_char?(strlen(nametocheck_end+1)
- +1/*saved_char*/+1/*zero byte*/)
- :0;
- if (nametocheck - nameout + restlen + l + 2 > MAX_PATH)
- return FALSE;
- if (restlen) memmove(nametocheck+l,nametocheck_end,restlen);
+ saved_char?(name_len - (nametocheck_end - nameout)):0;
+ memmove(nametocheck+l,nametocheck_end,restlen);
}
strncpy(nametocheck,wfd.cFileName,l);
nametocheck_end = nametocheck + l;
+ name_len = new_name_len;
} else {/* try shortcut
- Note: In something\cyglink.lnk filename isn't resolved
- so one can read/write symlink .lnk files although
- they are not in DIRECTORY output.
+ Note: something\cyglink.lnk doesn't resolve to the contents
+ of cyglink.lnk so one can read/write symlink .lnk
+ files although they are not present in DIRECTORY output.
Is it bug or feature? */
char saved[4];
char resolved[MAX_PATH];
+ int resolved_len;
shell_shortcut_target_t rresult;
if (nametocheck_end - nameout + 4 > MAX_PATH) return FALSE;
strncpy(saved,nametocheck_end+1,4);
@@ -383,13 +402,15 @@
|| (saved_char ? rresult == shell_shortcut_file
: rresult == shell_shortcut_directory))
return FALSE;
+ resolved_len = strlen(resolved);
if (saved_char) {
/*need to subst nameout..nametocheck-1 with resolved path */
- int l1 = strlen(resolved);
- int l2 = strlen(nametocheck_end + 1);
- if (l1 + l2 + 2 > MAX_PATH) return FALSE;
- strncat(resolved,nametocheck_end + 1,l2+1);
+ int l2 = name_len - (nametocheck_end - nameout);
+ if (resolved_len + l2 + 2 > MAX_PATH) return FALSE;
+ strncpy(resolved + resolved_len, nametocheck_end + 1, l2);
+ name_len = l2 - 1;
}
+ name_len += resolved_len;
strcpy(nameout,resolved);
next_name = TRUE;
}

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7304
retrieving revision 1.7305
diff -u -d -r1.7304 -r1.7305
--- ChangeLog 12 Apr 2010 19:37:37 -0000 1.7304
+++ ChangeLog 13 Apr 2010 03:25:14 -0000 1.7305
@@ -1,3 +1,13 @@
[phone] Arseny Slobodyuk <***@users.sourceforge.net>
+
+ Fix for a bug#1481218 with default drive directory:
+ within CLISP default_directory_of() is used to fill missed
+ pathname directory component in pathnames like C:lisp.exe.
+ This functionality now added to real_path as well to
+ support lisp invocation like 'C:\>e:lisp.exe -M e:lispinit.mem'.
+ * w32shell.c (real_path): detect and handle default drive
+ directory references. Optimization: less use of strlen.
+
2010-04-12 Vladimir Tzankov <***@gmail.com>

* spvw_sigterm.d (quit_on_signal_in_progress): move to spvw.d




------------------------------

------------------------------------------------------------------------------
Download Intel&#174; Parallel Studio Eval
Try the new software tools for yourself. Speed compiling, find bugs
proactively, and fine-tune applications for parallel performance.
See why Intel Parallel Studio got high marks during beta.
http://p.sf.net/sfu/intel-sw-dev

------------------------------

_______________________________________________
clisp-cvs mailing list
clisp-***@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 48, Issue 5
****************************************

[Sam Steingold]

this patch broke win32 modules build:

before:

[2]> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")
#P"C:\\sds\\dev\\current\\utils\\modprep.lisp" ;
#P"C:\\sds\\dev\\current\\build-mingw-g-4\\linkkit\\modprep.lisp" ;
3480262844 ;
60472

after:
[43]> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")
NIL

please fix asap.

Post by c***@lists.sourceforge.net
------------------------------
Message: 5
Date: Tue, 13 Apr 2010 03:25:17 +0000
Subject: clisp/src ChangeLog,1.7304,1.7305 w32shell.c,1.11,1.12
Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv22177
ChangeLog w32shell.c
Fixed bug#1481218 - default drive directory not detected in -M argument
Index: w32shell.c
===================================================================
RCS file: /cvsroot/clisp/clisp/src/w32shell.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- w32shell.c 31 Mar 2010 01:12:21 -0000 1.11
+++ w32shell.c 13 Apr 2010 03:25:15 -0000 1.12
@@ -280,13 +280,14 @@
HANDLE h = NULL;
char * nametocheck;
char * nametocheck_end;
+ int name_len;
/* drive|dir1|dir2|name
^nametocheck
^nametocheck_end */
char saved_char;
BOOL next_name = 0;/* if we found an lnk and need to start over */
int try_counter = 33;
- if (strlen(namein) >= MAX_PATH) return FALSE;
+ if ((name_len = strlen(namein)) >= MAX_PATH) return FALSE;
strcpy(nameout,namein);
do { /* whole file names */
next_name = FALSE;
@@ -295,9 +296,26 @@
nametocheck = nameout;
if (((*nametocheck >= 'a' && *nametocheck <= 'z')
|| (*nametocheck >= 'A' && *nametocheck <= 'Z'))
- && nametocheck[1] == ':' && cpslashp(nametocheck[2]))
- /* drive */
- nametocheck += 3;
+ && nametocheck[1] == ':')
+ { if (cpslashp(nametocheck[2])) {
+ /* drive */
+ nametocheck += 3;
+ } else {
+ /* default directory on drive */
+ char drive[4] = "C:.", *name;
+ int default_len;
+ drive[0] = namein[0];
+ if (!GetFullPathName(drive,_MAX_PATH,nameout,&name)
+ || (default_len = strlen(nameout)) + name_len
+ >= _MAX_PATH) return FALSE;
+ nameout[default_len] = '\\';
+ strcpy(nameout + default_len + 1, namein + 2);
+ name_len += default_len - 1; /* Was C:lisp.exe
+ Now C:\clisp\lisp.exe
+ removed 2
+ added default_len + 1 chars */
+ nametocheck += default_len + 1;
+ } }
else if (nametocheck[0]=='\\' && nametocheck[1]=='\\') {
int i;
/* host */
@@ -325,8 +343,8 @@
{ char * cp = nametocheck;
for (;*cp=='.';cp++);
dots_only = !(*cp) && cp > nametocheck; }
- /* Stars in the middle of filename: error
- Stars as pathname: success */
+ /* Asterisks in the middle of filename: error
+ Asterisks as pathname: success */
{ char * cp = nametocheck;
for (;*cp && *cp!='*';cp++);
have_stars = *cp == '*'; }
@@ -350,26 +368,27 @@
h = FindFirstFile(nameout,&wfd);
if (h != INVALID_HANDLE_VALUE) {
/* make space for full (non 8.3) name component */
- int l = strlen(wfd.cFileName);
+ int l = strlen(wfd.cFileName),
+ oldl = nametocheck_end - nametocheck,
+ new_name_len = name_len + l - oldl;
FindClose(h);
- if (l != (nametocheck_end - nametocheck)) {
+ if (new_name_len >= _MAX_PATH) return FALSE;
+ if (l != oldl) {
int restlen =
- saved_char?(strlen(nametocheck_end+1)
- +1/*saved_char*/+1/*zero byte*/)
- :0;
- if (nametocheck - nameout + restlen + l + 2 > MAX_PATH)
- return FALSE;
- if (restlen) memmove(nametocheck+l,nametocheck_end,restlen);
+ saved_char?(name_len - (nametocheck_end - nameout)):0;
+ memmove(nametocheck+l,nametocheck_end,restlen);
}
strncpy(nametocheck,wfd.cFileName,l);
nametocheck_end = nametocheck + l;
+ name_len = new_name_len;
} else {/* try shortcut
- Note: In something\cyglink.lnk filename isn't resolved
- so one can read/write symlink .lnk files although
- they are not in DIRECTORY output.
+ Note: something\cyglink.lnk doesn't resolve to the contents
+ of cyglink.lnk so one can read/write symlink .lnk
+ files although they are not present in DIRECTORY output.
Is it bug or feature? */
char saved[4];
char resolved[MAX_PATH];
+ int resolved_len;
shell_shortcut_target_t rresult;
if (nametocheck_end - nameout + 4 > MAX_PATH) return FALSE;
strncpy(saved,nametocheck_end+1,4);
@@ -383,13 +402,15 @@
|| (saved_char ? rresult == shell_shortcut_file
: rresult == shell_shortcut_directory))
return FALSE;
+ resolved_len = strlen(resolved);
if (saved_char) {
/*need to subst nameout..nametocheck-1 with resolved path */
- int l1 = strlen(resolved);
- int l2 = strlen(nametocheck_end + 1);
- if (l1 + l2 + 2 > MAX_PATH) return FALSE;
- strncat(resolved,nametocheck_end + 1,l2+1);
+ int l2 = name_len - (nametocheck_end - nameout);
+ if (resolved_len + l2 + 2 > MAX_PATH) return FALSE;
+ strncpy(resolved + resolved_len, nametocheck_end + 1, l2);
+ name_len = l2 - 1;
}
+ name_len += resolved_len;
strcpy(nameout,resolved);
next_name = TRUE;
}
Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7304
retrieving revision 1.7305
diff -u -d -r1.7304 -r1.7305
--- ChangeLog 12 Apr 2010 19:37:37 -0000 1.7304
+++ ChangeLog 13 Apr 2010 03:25:14 -0000 1.7305
@@ -1,3 +1,13 @@
+
+ within CLISP default_directory_of() is used to fill missed
+ pathname directory component in pathnames like C:lisp.exe.
+ This functionality now added to real_path as well to
+ support lisp invocation like 'C:\>e:lisp.exe -M e:lispinit.mem'.
+ * w32shell.c (real_path): detect and handle default drive
+ directory references. Optimization: less use of strlen.
+
* spvw_sigterm.d (quit_on_signal_in_progress): move to spvw.d

[Arseny Slobodyuk]

Hello Sam,
[2]>> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")

Post by Sam Steingold
#P"C:\\sds\\dev\\current\\utils\\modprep.lisp" ;
#P"C:\\sds\\dev\\current\\build-mingw-g-4\\linkkit\\modprep.lisp" ;
3480262844 ;
60472

[43]>> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")

Post by Sam Steingold
NIL

I can't reproduce this. Are you in the proper directory? I.e. I
suppose, current drive is C and current directory is the build one?
Before commiting I did mingw build and wrote a test
program (attached). You could probably hit the new cygwin

Post by Sam Steingold
CYGWIN=winsymlinks is for the old behaviour, using old-style windows .lnk files
Since cygwin 1.7 the default is using a shorter magic symlink file.
The user has to set the env CYGWIN if a symlink cannot be resolved.
See http://cygwin.com/cygwin-ug-net/using-cygwinenv.html#winsymlinks

It also might be the smaller problem with link recognition (same lnk
format but with some fields changed that cygwin recognizes it but
clisp is not). This may be checked with (DIRECTORY "linkkit\\*") -
then it will list lnk files.

Alternatively, you might using wine or just Windows of different
version (I'm on XP).

Please load the attached file with the new executable - it
should give no error. Beware: it creates and then deletes folders and files.

my experience with linkkit:

E:\clisp-cvs\cygwclisp\bu10mw2>e:lisp -M e:lispinit.mem

[skipped]

[1]> (probe-pathname "e:linkkit\\modprep.lisp")
#P"E:\\clisp-cvs\\cygwclisp\\utils\\modprep.lisp" ;
#P"E:\\clisp-cvs\\cygwclisp\\bu10mw2\\linkkit\\modprep.lisp" ;
3478127278 ;
61764
[2]>

[Sam Steingold]

Hi Arseny,

Post by Arseny Slobodyuk
[2]>> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")

Post by Sam Steingold
#P"C:\\sds\\dev\\current\\utils\\modprep.lisp" ;
#P"C:\\sds\\dev\\current\\build-mingw-g-4\\linkkit\\modprep.lisp" ;
3480262844 ;
60472

[43]>> (PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")

Post by Sam Steingold
NIL

I can't reproduce this.

this is sad. I have
CYGWIN_NT-5.2 zzzzzzz 1.5.25(0.156/4/2) 2008-06-12 19:34 i686 Cygwin
on windows server 2003.
this is a non-cywgin (i.e., mingw) build.

Post by Arseny Slobodyuk
Are you in the proper directory?

yes, I am in the build directory.
the linkkit directories look identical

$ ls -l linkkit
clisp.h -> ../clisp.h
modprep.lisp -> ../modprep.lisp
modules.c -> ../modules.c

in both "old" and "new" build directories.

Post by Arseny Slobodyuk
I.e. I
suppose, current drive is C and current directory is the build one?

yes.

Post by Arseny Slobodyuk
Before commiting I did mingw build and wrote a test
program (attached). You could probably hit the new cygwin

Post by Sam Steingold
CYGWIN=winsymlinks is for the old behaviour, using old-style windows .lnk files
Since cygwin 1.7 the default is using a shorter magic symlink file.
The user has to set the env CYGWIN if a symlink cannot be resolved.
See http://cygwin.com/cygwin-ug-net/using-cygwinenv.html#winsymlinks

setting CYGWIN=winsymlinks makes no difference, and, at any rate, I am using
cyginw 1.5, not 1.7

Post by Arseny Slobodyuk
It also might be the smaller problem with link recognition (same lnk
format but with some fields changed that cygwin recognizes it but
clisp is not). This may be checked with (DIRECTORY "linkkit\\*") -
then it will list lnk files.

indeed:

new:

[2]> (directory "linkkit/*")
(#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modules.c.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modprep.lisp.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\clisp.h.lnk")
[3]> (cd)
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\"

old:

[1]> (directory "linkkit/*")
(#P"C:\\sds\\dev\\current\\src\\modules.c"
#P"C:\\sds\\dev\\current\\utils\\modprep.lisp"
#P"C:\\sds\\dev\\current\\build-mingw-g-4\\clisp.h")
[2]> (cd)
#P"C:\\sds\\dev\\current\\build-mingw-g-4\\"

Post by Arseny Slobodyuk
Please load the attached file with the new executable - it
should give no error. Beware: it creates and then deletes folders and files.

[4]> (load "../../cyglink.lsp")
;; Loading file ..\..\cyglink.lsp ...
*** - OPEN: File #P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\file1.lsp" does
not exist
The following restarts are available:
SKIP :R1 skip (WITH-OPEN-FILE # #)
STOP :R2 stop loading file C:\sds\dev\cyglink.lsp
ABORT :R3 Abort main loop
Break 1 [5]>


PS. are you still working on ext::launch? what remains to be done there?

[Arseny Slobodyuk]

Hello Sam,

Post by Sam Steingold

Post by Arseny Slobodyuk
It also might be the smaller problem with link recognition (same lnk
format but with some fields changed that cygwin recognizes it but
clisp is not). This may be checked with (DIRECTORY "linkkit\\*") -
then it will list lnk files.

[2]>> (directory "linkkit/*")

Post by Sam Steingold
(#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modules.c.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modprep.lisp.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\clisp.h.lnk")

[3]>> (cd)

Post by Sam Steingold
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\"

I see. It must be pzero check in my patch from March 30. It isn't
present in cygwin, but it's said in comments that these fields should
be zero.
Please send me one of those shortcut files in linkkit directory, I'll
check. Also, note the file attribute - it should be read-only - its
the part of the recognition. I havent recent sources by hand now, so quoting
from clisp-cvs if you'll want to fix it fast: it'll probably working without
&& pzero >= &file_header->run in return statement.


--- w32shell.c 12 Aug 2008 20:36:20 -0000 1.9
+++ w32shell.c 30 Mar 2010 09:00:39 -0000 1.10

...

+static int
+cmp_shortcut_header (struct win_shortcut_hdr *file_header)
+{
+ /* A Cygwin or U/Win shortcut only contains a description and a relpath.
+ Cygwin shortcuts also might contain an ITEMIDLIST. The run type is
+ always set to SW_NORMAL. */
+ DWORD * pzero = &file_header->attr;
+ /* FILETIME is two DWORDS so check it as array of DWORDS */
+ while (pzero < &file_header->run && !*pzero++);
+ return file_header->size == WINSHDRSIZE
+ && !memcmp (&file_header->magic, &GUID_shortcut, sizeof GUID_shortcut)
+ && (file_header->flags & ~WSH_FLAG_IDLIST)
+ == (WSH_FLAG_DESC | WSH_FLAG_RELPATH)
+ && pzero >= &file_header->run
+ && file_header->run == SW_NORMAL;
+}

Post by Sam Steingold
PS. are you still working on ext::launch? what remains to be done there?

I forgot :-( I will check.

[Sam Steingold]

Post by Arseny Slobodyuk

Post by Sam Steingold

Post by Arseny Slobodyuk
It also might be the smaller problem with link recognition (same lnk
format but with some fields changed that cygwin recognizes it but
clisp is not). This may be checked with (DIRECTORY "linkkit\\*") -
then it will list lnk files.

[2]>> (directory "linkkit/*")

Post by Sam Steingold
(#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modules.c.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\modprep.lisp.lnk"
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\linkkit\\clisp.h.lnk")

[3]>> (cd)

Post by Sam Steingold
#P"C:\\sds\\dev\\current\\build-mingw-g-mt-1\\"

I see. It must be pzero check in my patch from March 30. It isn't
present in cygwin, but it's said in comments that these fields should
be zero.
Please send me one of those shortcut files in linkkit directory, I'll

http://sds.podval.org/data/clisp.h.lnk

Post by Arseny Slobodyuk
check. Also, note the file attribute - it should be read-only - its
the part of the recognition. I havent recent sources by hand now, so quoting

it _is_ RO.

Post by Arseny Slobodyuk
from clisp-cvs if you'll want to fix it fast: it'll probably working without
&& pzero >= &file_header->run in return statement.
--- w32shell.c 12 Aug 2008 20:36:20 -0000 1.9
+++ w32shell.c 30 Mar 2010 09:00:39 -0000 1.10
...
+static int
+cmp_shortcut_header (struct win_shortcut_hdr *file_header)
+{
+ /* A Cygwin or U/Win shortcut only contains a description and a relpath.
+ Cygwin shortcuts also might contain an ITEMIDLIST. The run type is
+ always set to SW_NORMAL. */
+ DWORD * pzero = &file_header->attr;
+ /* FILETIME is two DWORDS so check it as array of DWORDS */
+ while (pzero < &file_header->run && !*pzero++);
+ return file_header->size == WINSHDRSIZE
+ && !memcmp (&file_header->magic, &GUID_shortcut, sizeof GUID_shortcut)
+ && (file_header->flags & ~WSH_FLAG_IDLIST)
+ == (WSH_FLAG_DESC | WSH_FLAG_RELPATH)
+ && pzero >= &file_header->run
+ && file_header->run == SW_NORMAL;
+}

yes, this is what I have.

Post by Arseny Slobodyuk

Post by Sam Steingold
PS. are you still working on ext::launch? what remains to be done there?

I forgot :-( I will check.

thanks.

[Arseny Slobodyuk]

Hello Sam,

Post by Sam Steingold

Post by Arseny Slobodyuk
+ return file_header->size == WINSHDRSIZE
+ && !memcmp (&file_header->magic, &GUID_shortcut, sizeof GUID_shortcut)
+ && (file_header->flags & ~WSH_FLAG_IDLIST)
+ == (WSH_FLAG_DESC | WSH_FLAG_RELPATH)
+ && pzero >= &file_header->run
+ && file_header->run == SW_NORMAL;
+}

yes, this is what I have.

Do you mean removing the check helps? It's surprising - the file you
gave has all relevant fields equal to 0, as it should. Probably then,
the fields are set by the system at the certain moments.

If it's not about zero fields, I'd suppose now that
the CreateFile flags are unsuitable for Windows Server 2003, maybe it's
something with security settings on the filesystem. So the CreateFile
returns INVALID_HANDLE_VALUE and it is treated as 'not a symlink'.
If the problem is with opening the file this patch could help.

Index: w32shell.c
===================================================================
RCS file: /cvsroot/clisp/clisp/src/w32shell.c,v
retrieving revision 1.12
diff -r1.12 w32shell.c
99c99
< handle = CreateFile(filename,GENERIC_READ,FILE_SHARE_READ|FILE_SHARE_WRITE,
---

Post by Sam Steingold
handle = CreateFile(filename,FILE_READ_DATA, FILE_SHARE_READ,

[Sam Steingold]

Hello Arseny,

Post by Arseny Slobodyuk

Post by Sam Steingold

Post by Arseny Slobodyuk
+ return file_header->size == WINSHDRSIZE
+ && !memcmp (&file_header->magic, &GUID_shortcut, sizeof GUID_shortcut)
+ && (file_header->flags & ~WSH_FLAG_IDLIST)
+ == (WSH_FLAG_DESC | WSH_FLAG_RELPATH)
+ && pzero >= &file_header->run
+ && file_header->run == SW_NORMAL;
+}

yes, this is what I have.

Do you mean removing the check helps?

no, I mean that this is the code I see in my tree now.

Post by Arseny Slobodyuk
If it's not about zero fields, I'd suppose now that
the CreateFile flags are unsuitable for Windows Server 2003, maybe it's
something with security settings on the filesystem. So the CreateFile
returns INVALID_HANDLE_VALUE and it is treated as 'not a symlink'.
If the problem is with opening the file this patch could help.
Index: w32shell.c
===================================================================
RCS file: /cvsroot/clisp/clisp/src/w32shell.c,v
retrieving revision 1.12
diff -r1.12 w32shell.c
99c99
< handle = CreateFile(filename,GENERIC_READ,FILE_SHARE_READ|FILE_SHARE_WRITE,
---

Post by Sam Steingold
handle = CreateFile(filename,FILE_READ_DATA, FILE_SHARE_READ,

this changes nothing (also, it would be nice if you sent context (-c) or
unified (-u) diffs, just add "diff -uwp" to your ~/.cvsrc).

actually, it appears that your patch is not at fault at all here, sorry.

I have two clisp builds: the regular debug and an MT debug build.
the regular debug works fine:

(PROBE-PATHNAME #P"C:linkkit\\modprep.lisp")
#P"C:\\sds\\dev\\current\\utils\\modprep.lisp" ;
#P"C:\\sds\\dev\\current\\build-mingw-g-5\\linkkit\\modprep.lisp" ;
3480262844 ;
60472

the multithreaded build fails:

is_cygwin_symlink() returns cygsym_issym, but
w32shell.c:134:
hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
returns hres=-2147221008 (in the MT build) instead of 0 (in the regular build).
and thus PROBE-PATHNAME fails.

the relevant difference in Makefiles is -DWIN32_THREADS in CFLAGS


Sorry about the confusion.
Sam.

[Vladimir Tzankov]

Post by Sam Steingold
is_cygwin_symlink() returns cygsym_issym, but
hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
returns hres=-2147221008 (in the MT build) instead of 0 (in the regular build).
and thus PROBE-PATHNAME fails.

hres=-2147221008 (0x800401F0) is "CoInitialize has not been called.".

This is MT issue - every thread (using COM) should call CoInitialize -
I've missed that. Will fix it this weekend.

[Sam Steingold]

Post by Vladimir Tzankov

Post by Sam Steingold
is_cygwin_symlink() returns cygsym_issym, but
hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
returns hres=-2147221008 (in the MT build) instead of 0 (in the regular build).
and thus PROBE-PATHNAME fails.

hres=-2147221008 (0x800401F0) is "CoInitialize has not been called.".
This is MT issue - every thread (using COM) should call CoInitialize -
I've missed that. Will fix it this weekend.

I'm not sure calling CoInitialize when starting each thread is right:
not all threads will need this and it might be costly.
I think it is better to do something like

my_CoCreateInstance (...) {
hres = CoCreateInstance(...);
if (hres == 0x800401F0) {
CoInitialize(...);
hres = CoCreateInstance(...);
}
return hres;
}

and use it instead of CoCreateInstance in calls.c and w32shell.c

[Arseny Slobodyuk]

Hello Sam,

Post by Sam Steingold
my_CoCreateInstance (...) {
hres = CoCreateInstance(...);
if (hres == 0x800401F0) {
CoInitialize(...);
hres = CoCreateInstance(...);
}
return hres;
}
and use it instead of CoCreateInstance in calls.c and w32shell.c

You right.

I'd use thread local variable here, because CoUninitialize must be
called after CoInitialize at the thread exit and COM could have other
uses where CoCreateInstance will be not the first call. Also, Windows
may detect not all improper calls, I'd not rely on this.

__declspec( thread ) bool com_initialized = false;

/* This has to be called before COM operations */
void my_CoInitAtDemand() {
if (!com_initialized) {
...
}}

void my_CoUninit() {
if (com_initialized) {
...
}}

Can do this after I realize how to do '__declspec( thread )' properly.

[Vladimir Tzankov]

Post by Arseny Slobodyuk
I'd use thread local variable here, because CoUninitialize must be
called after CoInitialize at the thread exit and COM could have other
uses where CoCreateInstance will  be not the first call. Also, Windows
may detect not all improper calls, I'd not rely on this.
__declspec( thread ) bool com_initialized = false;

This is very MSVC specific. Thread local variables should go to clisp_thread_t
struct, however I think this is not needed for this case.

On how many places COM is needed? If on all COM calls we check return
value for "CoInitialize has not been called" and actually retry call -
we should be fine.
I think at thread exit calling CoUninitialize() without matching
CoInitialize() will not do any harm - so we may always invoke it from
delete_thread().

Vladimir

[Sam Steingold]

Post by Vladimir Tzankov

Post by Arseny Slobodyuk
__declspec( thread ) bool com_initialized = false;

This is very MSVC specific. Thread local variables should go to clisp_thread_t
struct, however I think this is not needed for this case.

can a static variable be per_thread?

per_thread static bool com_initialized = false;

Post by Vladimir Tzankov
On how many places COM is needed? If on all COM calls we check return
value for "CoInitialize has not been called" and actually retry call -
we should be fine.

that's what I am proposing: for each COM function we need my_* version
which will initialize COM on demand

Post by Vladimir Tzankov
I think at thread exit calling CoUninitialize() without matching
CoInitialize() will not do any harm - so we may always invoke it from
delete_thread().

if indeed CoUninitialize is safe, you are right.

[Vladimir Tzankov]

Post by Sam Steingold
can a static variable be per_thread?
per_thread static bool com_initialized = false;

quick check shows that gcc accepts following:
static __thread int var1; (but not "__thread static int var1")

This is non-standard (as __thread itself). Adding var1 to clisp_thread
is preferable imho (but will be "global").

Post by Sam Steingold

Post by Vladimir Tzankov
I think at thread exit calling CoUninitialize() without matching
CoInitialize() will not do any harm - so we may always invoke it from
delete_thread().

if indeed CoUninitialize is safe, you are right.

It's not explicitly stated in the docs the standalone CoUninitialize
is safe. However successful CoInitialize invocations are referenced
counted so it looks safe.

[Vladimir Tzankov]

Post by Vladimir Tzankov

Post by Sam Steingold
can a static variable be per_thread?
per_thread static bool com_initialized = false;

static __thread int var1; (but not "__thread static int var1")

Also I remember that gcc on mingw does not support __thread qualifier
(I do not have access to win32 machine now to check).

[Arseny Slobodyuk]

Post by Vladimir Tzankov
Also I remember that gcc on mingw does not support __thread qualifier
(I do not have access to win32 machine now to check).

According to
http://www.mingw.org/wiki/GCCStatus
it seems to be true. This is sad. MSVS 6.0 is 12 years old and
it has TLS. It is very convenient.
Anyway, I believe TLS implementation in MSVC uses the Win API
(TlsSetValue, TlsGetValue etc):
from http://msdn.microsoft.com/en-us/library/6yh4a9k1.aspx
Thread Local Storage is implemented through the Win32 API layer
and the compiler.

[J***@t-systems.com]

Hi,

Post by Sam Steingold
that's what I am proposing: for each COM function we need my_* version
which will initialize COM on demand

The AFFI used the ALIVE bit (cf. FFI:VALIDP) for this and was able to
automatically open libraries when the function was called
(auto-open is a debatable feature).
If you really plan an "initialize on demand" kind of feature, I advise
you look into FFI:VALIDP and FFI:SET-FOREIGN-POINTER.
When I devised that 15 years ago, it looked like it would fit DDE (aka. COM)
as well -- judging from my hearsay about DDE.

http://clisp.cons.org/impnotes/dffi.html#ex-dffi-validity

Regards,
Jörg Höhle.