Menu
▾
▴
clisp-cvs digest, Vol 1 #1126 - 8 msgs
|
From: <cli...@li...> - 2005-06-07 11:01:55
|
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 TODO,1.88,1.89 (Bruno Haible) 2. clisp/modules/clx/new-clx clx.f,2.38,2.39 (Bruno Haible) 3. clisp/src lispbibl.d,1.647,1.648 encoding.d,1.121,1.122 genclisph.d,1.191,1.192 ChangeLog,1.4680,1.4681 (Bruno Haible) 4. clisp/modules/syscalls calls.c,1.123,1.124 (Bruno Haible) 5. clisp/src unix.d,1.67,1.68 spvw.d,1.363,1.364 pathname.d,1.374,1.375 stream.d,1.522,1.523 hashtabl.d,1.120,1.121 debug.d,1.90,1.91 realtran.d,1.21,1.22 ChangeLog,1.4681,1.4682 (Bruno Haible) 6. clisp/src makemake.in,1.558,1.559 lispbibl.d,1.648,1.649 io.d,1.288,1.289 pathname.d,1.375,1.376 stream.d,1.523,1.524 foreign.d,1.139,1.140 ChangeLog,1.4682,1.4683 (Bruno Haible) 7. clisp/modules/syscalls calls.c,1.124,1.125 (Bruno Haible) 8. clisp/src lispbibl.d,1.649,1.650 unix.d,1.68,1.69 win32.d,1.57,1.58 pathname.d,1.376,1.377 stream.d,1.524,1.525 ChangeLog,1.4683,1.4684 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src TODO,1.88,1.89 Date: Tue, 07 Jun 2005 10:51:16 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17352 Modified Files: TODO Log Message: Many TODO items for Sam. Index: TODO =================================================================== RCS file: /cvsroot/clisp/clisp/src/TODO,v retrieving revision 1.88 retrieving revision 1.89 diff -u -d -r1.88 -r1.89 --- TODO 5 Jun 2005 22:57:08 -0000 1.88 +++ TODO 7 Jun 2005 10:51:14 -0000 1.89 @@ -4,6 +4,19 @@ MUST-FIX BEFORE NEXT RELEASE ============================ +bind-eval.tst failure on Linux/amd64 [sam] + +use LockFile instead of LockFileEx [sam] + +comments for addr_to_string, string_to_addr [sam] + +comments for open_file_stream_handle, file_stream_truename [sam] + +workaround for extra comma in _clisp.1 [sam] + +regression: resolution of logical pathnames is broken, try + (compile-file (logical-pathname "FOO.LISP")) [sam] + Readline interface problem: [2]> (macroexü *** - AREF: Index 9 für "(macroexü" ist zu groÃ. --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/modules/clx/new-clx clx.f,2.38,2.39 Date: Tue, 07 Jun 2005 10:53:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17741/modules/clx/new-clx Modified Files: clx.f Log Message: Make clisp.h more similar to lispbibl.d: Remove cslen_f, cstombs_f. Index: clx.f =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v retrieving revision 2.38 retrieving revision 2.39 diff -u -d -r2.38 -r2.39 --- clx.f 23 May 2005 02:08:09 -0000 2.38 +++ clx.f 7 Jun 2005 10:53:51 -0000 2.39 @@ -3670,7 +3670,7 @@ if (!nullp(encoding)/*&& TheEncoding(encoding)->max_bytes_per_char==1*/) { /* Special hack: use the font's encoding */ if (count > 0) { - cstombs_f(encoding,src,count,(uintB*)dst,count); + cstombs(encoding,src,count,(uintB*)dst,count); return 1; } } else --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src lispbibl.d,1.647,1.648 encoding.d,1.121,1.122 genclisph.d,1.191,1.192 ChangeLog,1.4680,1.4681 Date: Tue, 07 Jun 2005 10:53:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17741/src Modified Files: lispbibl.d encoding.d genclisph.d ChangeLog Log Message: Make clisp.h more similar to lispbibl.d: Remove cslen_f, cstombs_f. Index: encoding.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/encoding.d,v retrieving revision 1.121 retrieving revision 1.122 diff -u -d -r1.121 -r1.122 --- encoding.d 14 May 2005 13:45:45 -0000 1.121 +++ encoding.d 7 Jun 2005 10:53:48 -0000 1.122 @@ -1735,23 +1735,6 @@ #endif -/* -- for modules -- */ -#if defined(UNICODE) -uintL cslen_f (object encoding, const chart*src, uintL srclen) -#else -#define cslen_f(e,s,l) cslen_ff(s,l) -uintL cslen_ff (const chart*src, uintL srclen) -#endif -{ return cslen(encoding,src,srclen); } -#if defined(UNICODE) -void cstombs_f (object encoding, const chart *src, uintL srclen, - uintB* dest, uintL destlen) -#else -#define cstombs_f(e,s,l,d,n) cstombs_ff(s,l,d,n) -void cstombs_ff (const chart *src, uintL srclen, uintB* dest, uintL destlen) -#endif -{ cstombs(encoding,src,srclen,dest,destlen); } - /* ----------------------------------------------------------------------- */ #endif /* UNICODE */ Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.647 retrieving revision 1.648 diff -u -d -r1.647 -r1.648 --- lispbibl.d 6 Jun 2005 12:45:45 -0000 1.647 +++ lispbibl.d 7 Jun 2005 10:53:40 -0000 1.648 @@ -6378,6 +6378,23 @@ begin_system_call(); memcpy(dest,src,srclen); end_system_call(); \ } while(0) #endif +%% sprintf(buf,"struct { XRECORD_HEADER gcv_object_t enc_eol%s; gcv_object_t enc_towcs_error%s; gcv_object_t enc_tombs_error%s;",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); +%% #ifdef UNICODE +%% sprintf(buf+strlen(buf)," gcv_object_t enc_charset%s; gcv_object_t enc_mblen%s; gcv_object_t enc_mbstowcs%s; gcv_object_t enc_wcslen%s; gcv_object_t enc_wcstombs%s; gcv_object_t enc_range%s; gcv_object_t enc_table%s; uintL min_bytes_per_char; uintL max_bytes_per_char;",attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object,attribute_aligned_object); +%% #endif +%% strcat(buf," } *"); +%% emit_typedef(buf,"Encoding"); +%% #ifdef UNICODE +%% printf("#define Encoding_wcslen(encoding) ((uintL (*) (object, const chart*, const chart*)) ThePseudofun(TheEncoding(encoding)->enc_wcslen))\n"); +%% printf("#define Encoding_wcstombs(encoding) ((void (*) (object, object, const chart**, const chart*, uintB**, uintB*)) ThePseudofun(TheEncoding(encoding)->enc_wcstombs))\n"); +%% #endif +%% #ifdef UNICODE +%% printf("#define cslen(encoding,src,srclen) Encoding_wcslen(encoding)(encoding,src,(src)+(srclen))\n"); +%% printf("#define cstombs(encoding,src,srclen,dest,destlen) do { const chart* _srcptr = (src); const chart* _srcendptr = _srcptr+(srclen); uintB* _destptr = (dest); uintB* _destendptr = _destptr+(destlen); Encoding_wcstombs(encoding)(encoding,nullobj,&_srcptr,_srcendptr,&_destptr,_destendptr); } while(0)\n"); +%% #else +%% printf("#define cslen(encoding,src,srclen) (srclen)\n"); +%% printf("#define cstombs(encoding,src,srclen,dest,destlen) do { begin_system_call(); memcpy(dest,src,srclen); end_system_call(); } while(0)\n"); +%% #endif #ifdef FOREIGN # foreign pointer wrap @@ -7505,6 +7522,7 @@ %% printf("#define TheXrecord(obj) ((Xrecord)("); printf_type_pointable(ngci,stream_type|orecord_type); printf("))\n"); %% printf("#define ThePackage(obj) ((Package)("); printf_type_pointable(ngci,orecord_type); printf("))\n"); %% #endif +%% printf("#define TheEncoding(obj) ((Encoding)("); printf_type_pointable(ngci,orecord_type); printf("))\n"); %% #ifdef FOREIGN %% printf("#define TheFpointer(obj) ((Fpointer)("); printf_type_pointable(ngci,orecord_type); printf("))\n"); %% #endif @@ -7512,9 +7530,9 @@ %% printf("#define TheClosure(obj) ((Closure)("); printf_type_pointable(ngci,closure_type); printf("))\n"); %% printf("#define TheInstance(obj) ((Instance)("); printf_type_pointable(ngci,instance_type|closure_type); printf("))\n"); %% printf("#define TheSubr(obj) ((Subr)("); printf_type_pointable(cgci,subr_type); printf("))\n"); -%% #if notused %% printf("#define TheMachine(obj) ((void*)("); printf_type_pointable(cgci,machine_type); printf("))\n"); -%% #endif +%% printf("#define TheMachineCode(obj) TheMachine(obj)\n"); +%% printf("#define ThePseudofun(obj) ((Pseudofun)TheMachineCode(obj))\n"); %% #else %% printf1("#define TheCons(obj) ((Cons)(ngci_pointable(obj)-%d))\n",cons_bias); %% #if notused @@ -7540,6 +7558,7 @@ %% printf1("#define TheXrecord(obj) ((Xrecord)(ngci_pointable(obj)-%d))\n",varobject_bias); %% printf1("#define ThePackage(obj) ((Package)(ngci_pointable(obj)-%d))\n",varobject_bias); %% #endif +%% printf("#define TheEncoding(obj) ((Encoding)(ngci_pointable(obj)-%d))\n",varobject_bias); %% #ifdef FOREIGN %% printf("#define TheFpointer(obj) ((Fpointer)(ngci_pointable(obj)-%d))\n",varobject_bias); %% #endif @@ -7547,9 +7566,15 @@ %% printf1("#define TheClosure(obj) ((Closure)(ngci_pointable(obj)-%d))\n",varobject_bias); %% printf1("#define TheInstance(obj) ((Instance)(ngci_pointable(obj)-%d))\n",varobject_bias); %% printf1("#define TheSubr(obj) ((Subr)(cgci_pointable(obj)-%d))\n",subr_bias); -%% #if notused %% printf1("#define TheMachine(obj) ((void*)(cgci_pointable(obj)-%d))\n",machine_bias); +%% #if (log2_C_CODE_ALIGNMENT >= 2) +%% printf("#define TheMachineCode(obj) TheMachine(obj)\n"); +%% #elif defined(HPPA) +%% printf("#define TheMachineCode(obj) ((void*)((uintP)TheMachine(obj)+2))\n"); +%% #else +%% printf2("#define TheMachineCode(obj) ((void*)(((uintP)TheMachine(obj)>>%d)|%d))\n",2-log2_C_CODE_ALIGNMENT,CODE_ADDRESS_RANGE&~((~(uintP)0)>>(2-log2_C_CODE_ALIGNMENT))); %% #endif +%% printf("#define ThePseudofun(obj) ((Pseudofun)TheMachineCode(obj))\n"); %% #endif # Some acronyms @@ -11222,6 +11247,7 @@ # FUNCALL) or constant C data. # For SAVEMEM/LOADMEM we have a table of all such pseudofunctions. typedef const void * Pseudofun; # assume function pointers fit in a void* +%% printf("typedef const void * Pseudofun;\n"); # Declaration of the tables of relocatable pointers: #define PSEUDO PSEUDO_A @@ -13530,9 +13556,9 @@ %% printf(" var object ascizvar##_string = unpack_string_ro(string,&ascizvar##_len,&ascizvar##_offset);"); %% printf(" var const chart* ptr1;"); %% printf(" unpack_sstring_alloca(ascizvar##_string,ascizvar##_len,ascizvar##_offset, ptr1=);"); -%% printf(" {var uintL ascizvar##_bytelen = cslen_f(encoding,ptr1,ascizvar##_len);"); +%% printf(" {var uintL ascizvar##_bytelen = cslen(encoding,ptr1,ascizvar##_len);"); %% printf(" var DYNAMIC_ARRAY(ascizvar##_data,uintB,ascizvar##_bytelen+1);"); -%% printf(" cstombs_f(encoding,ptr1,ascizvar##_len,&ascizvar##_data[0],ascizvar##_bytelen);"); +%% printf(" cstombs(encoding,ptr1,ascizvar##_len,&ascizvar##_data[0],ascizvar##_bytelen);"); %% printf(" ascizvar##_data[ascizvar##_bytelen] = 0;"); %% printf(" {var char* ascizvar = (char*) &ascizvar##_data[0];"); %% printf(" statement"); @@ -13545,9 +13571,9 @@ %% printf(" {var uintL ascizvar##_len = Sstring_length(ascizvar##_string);"); %% printf(" var const chart* ptr1;"); %% printf(" unpack_sstring_alloca(ascizvar##_string,ascizvar##_len,0, ptr1=);"); -%% printf(" {var uintL ascizvar##_bytelen = cslen_f(encoding,ptr1,ascizvar##_len);"); +%% printf(" {var uintL ascizvar##_bytelen = cslen(encoding,ptr1,ascizvar##_len);"); %% printf(" var DYNAMIC_ARRAY(ascizvar##_data,uintB,ascizvar##_bytelen+1);"); -%% printf(" cstombs_f(encoding,ptr1,ascizvar##_len,&ascizvar##_data[0],ascizvar##_bytelen);"); +%% printf(" cstombs(encoding,ptr1,ascizvar##_len,&ascizvar##_data[0],ascizvar##_bytelen);"); %% printf(" ascizvar##_data[ascizvar##_bytelen] = 0;"); %% printf(" {var char* ascizvar = (char*) &ascizvar##_data[0];"); %% printf(" statement"); Index: genclisph.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/genclisph.d,v retrieving revision 1.191 retrieving revision 1.192 diff -u -d -r1.191 -r1.192 --- genclisph.d 6 Jun 2005 12:45:45 -0000 1.191 +++ genclisph.d 7 Jun 2005 10:53:48 -0000 1.192 @@ -226,16 +226,6 @@ #endif printf("#define LISPFUN LISPFUN_B\n"); - #if defined(UNICODE) - printf("extern uintL cslen_f (object encoding, const chart*src, uintL srclen);\n"); - printf("extern void cstombs_f (object encoding, const chart *src, uintL srclen, uintB* dest, uintL destlen);\n"); - #else - printf("#define cslen_f(e,s,l) cslen_ff(s,l)\n"); - printf("extern uintL cslen_ff (const chart*src, uintL srclen);\n"); - printf("#define cstombs_f(e,s,l,d,n) cstombs_ff(s,l,d,n)\n"); - printf("extern void cstombs_ff (const chart *src, uintL srclen, uintB* dest, uintL destlen);\n"); - #endif - /* Note: The following inline/macro definitions are _not_ in lispbibl.d! */ printf("#ifndef COMPILE_STANDALONE\n"); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4680 retrieving revision 1.4681 diff -u -d -r1.4680 -r1.4681 --- ChangeLog 6 Jun 2005 21:57:33 -0000 1.4680 +++ ChangeLog 7 Jun 2005 10:53:49 -0000 1.4681 @@ -1,3 +1,20 @@ +2005-06-04 Bruno Haible <br...@cl...> + + * lispbibl.d (Encoding, Encoding_wcslen, Encoding_wcstombs, cslen, + cstombs, TheEncoding, TheMachineCode, ThePseudofun, Pseudofun): Emit + to clisp.h. + (with_string_0, with_sstring_0): Use cslen instead of cslen_f, + cstombs instead of cstombs_f. + * encoding.d (cslen_f, cslen_ff, cstombs_f, cstombs_ff): Remove + functions. + * genclisph.d (main): Don't emit cslen_f, cslen_ff, cstombs_f, + cstombs_ff. + * modules/syscalls/calls.c (LispToPropVariant, PropSpecSetStr, + with_string_0w): Use cslen instead of cslen_f, cstombs instead of + cstombs_f. + * modules/clx/new-clx/clx.f (to_XChar2b): Use cstombs instead of + cstombs_f. + 2005-06-06 Sam Steingold <sd...@gn...> * socket.d (MACHINE-INSTANCE, socket_getlocalname_aux) --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/modules/syscalls calls.c,1.123,1.124 Date: Tue, 07 Jun 2005 10:53:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/syscalls In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17741/modules/syscalls Modified Files: calls.c Log Message: Make clisp.h more similar to lispbibl.d: Remove cslen_f, cstombs_f. Index: calls.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v retrieving revision 1.123 retrieving revision 1.124 diff -u -d -r1.123 -r1.124 --- calls.c 26 May 2005 20:24:52 -0000 1.123 +++ calls.c 7 Jun 2005 10:53:51 -0000 1.124 @@ -3038,22 +3038,22 @@ unpack_sstring_alloca(str_string,str_len,str_offset, ptr1=); if (typehint == VT_LPWSTR || typehint == VT_BSTR) { uintL str_bytelen = - cslen_f(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len); + cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len); LPWSTR str = SysAllocStringByteLen(NULL,str_bytelen+4); if (typehint == VT_BSTR) { /* it's ok, SysAllocStringByteLen returns pointer after DWORD */ *(((DWORD *)str)-1) = (DWORD)str_bytelen; } - cstombs_f(Symbol_value(S(unicode_16_little_endian)),ptr1, - str_len,(uintB *)str,str_bytelen); + cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len, + uintB *)str,str_bytelen); ((uintB *)str)[str_bytelen] = '\0'; ((uintB *)str)[str_bytelen+1] = '\0'; pvar->pwszVal = str; pvar->vt = typehint; } else { /* Win XP explorer seems to create ANSI strings. So do we. */ - uintL str_bytelen = cslen_f(GLO(misc_encoding),ptr1,str_len); + uintL str_bytelen = cslen(GLO(misc_encoding),ptr1,str_len); char * str = (char *) SysAllocStringByteLen(NULL, str_bytelen+2); - cstombs_f(GLO(misc_encoding),ptr1,str_len,(uintB *)str,str_bytelen); + cstombs(GLO(misc_encoding),ptr1,str_len,(uintB *)str,str_bytelen); str[str_bytelen] = '\0'; pvar->pszVal = str; pvar->vt = VT_LPSTR; @@ -3179,10 +3179,10 @@ const chart* ptr1; unpack_sstring_alloca(str_string,str_len,str_offset, ptr1=); { uintL str_bytelen = - cslen_f(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len); + cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len); pspec->lpwstr = (LPOLESTR) malloc(str_bytelen+2); - cstombs_f(Symbol_value(S(unicode_16_little_endian)),ptr1, - str_len,(uintB *)pspec->lpwstr,str_bytelen); + cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len, + (uintB *)pspec->lpwstr,str_bytelen); ((uintB *)pspec->lpwstr)[str_bytelen] = '\0'; ((uintB *)pspec->lpwstr)[str_bytelen+1] = '\0'; } @@ -3272,10 +3272,10 @@ var const chart* ptr1; \ unpack_sstring_alloca(wcvar##_string,wcvar##_len,wcvar##_offset, ptr1=); \ {var uintL wcvar##_bytelen = \ - cslen_f(Symbol_value(S(unicode_16_little_endian)),ptr1,wcvar##_len); \ + cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,wcvar##_len); \ var DYNAMIC_ARRAY(wcvar##_data,uintB,wcvar##_bytelen+2); \ - cstombs_f(Symbol_value(S(unicode_16_little_endian)),ptr1,\ - wcvar##_len,&wcvar##_data[0],wcvar##_bytelen); \ + cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,wcvar##_len,\ + &wcvar##_data[0],wcvar##_bytelen); \ wcvar##_data[wcvar##_bytelen] = '\0'; \ wcvar##_data[wcvar##_bytelen+1] = '\0'; \ {var WCHAR* wcvar = (WCHAR*) &wcvar##_data[0]; \ --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src unix.d,1.67,1.68 spvw.d,1.363,1.364 pathname.d,1.374,1.375 stream.d,1.522,1.523 hashtabl.d,1.120,1.121 debug.d,1.90,1.91 realtran.d,1.21,1.22 ChangeLog,1.4681,1.4682 Date: Tue, 07 Jun 2005 10:56:08 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19252/src Modified Files: unix.d spvw.d pathname.d stream.d hashtabl.d debug.d realtran.d ChangeLog Log Message: Avoid warnings emitted by gcc -Wstrict-prototypes. Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.374 retrieving revision 1.375 diff -u -d -r1.374 -r1.375 --- pathname.d 6 Jun 2005 11:30:37 -0000 1.374 +++ pathname.d 7 Jun 2005 10:55:55 -0000 1.375 @@ -1396,7 +1396,7 @@ #ifdef PATHNAME_NOEXT /* can trigger GC */ -local maygc void fix_parse_namestring_dot_file() +local maygc void fix_parse_namestring_dot_file (void) { /* make sure *PARSE-NAMESTRING-DOT-FILE* is valid */ Symbol_value(S(parse_namestring_dot_file)) = S(Ktype); /*CLISP default*/ pushSTACK(NIL); @@ -8332,7 +8332,7 @@ #ifdef UNIX /* /dev/null handle. */ -local Handle nullfile () { +local Handle nullfile (void) { var Handle result = INVALID_HANDLE_VALUE; begin_system_call(); result = open("/dev/null",O_RDWR); @@ -8353,7 +8353,7 @@ #elif defined(WIN32_NATIVE) /* /dev/null on NT/W95. */ -local Handle nullfile () { +local Handle nullfile (void) { var Handle result = NULL; begin_system_call(); result = CreateFile("NUL", GENERIC_READ | GENERIC_WRITE, @@ -8441,7 +8441,7 @@ /* paranoidal close */ #define ParaClose(h) if (!CloseHandle(h)) { end_system_call(); OS_error(); } -local maygc sintL interpret_launch_priority () { +local maygc sintL interpret_launch_priority (void) { var sintL pry = NORMAL_PRIORITY_CLASS; if (!boundp(STACK_0)) return NORMAL_PRIORITY_CLASS; var object priority_arg = STACK_0; Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.363 retrieving revision 1.364 diff -u -d -r1.363 -r1.364 --- spvw.d 3 Jun 2005 18:11:36 -0000 1.363 +++ spvw.d 7 Jun 2005 10:55:53 -0000 1.364 @@ -1687,7 +1687,7 @@ #include "spvw_calendar.c" # print the banner -local void print_banner () +local void print_banner (void) { const char * const banner0[] = { # some lines above 66 characters # |Column 0 |Column 20 |Col 66 # "012345678901234567890123456789012345678901234567890123456789012345678901" Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.120 retrieving revision 1.121 diff -u -d -r1.120 -r1.121 --- hashtabl.d 31 May 2005 15:18:05 -0000 1.120 +++ hashtabl.d 7 Jun 2005 10:56:04 -0000 1.121 @@ -2038,7 +2038,7 @@ } /* UP: fetches the value of *eq-hashfunction*. */ -local object get_eq_hashfunction () { +local object get_eq_hashfunction (void) { var object value = Symbol_value(S(eq_hashfunction)); if (eq(value,S(fasthash_eq)) || eq(value,S(stablehash_eq))) return value; @@ -2058,7 +2058,7 @@ } /* UP: fetches the value of *eql-hashfunction*. */ -local object get_eql_hashfunction () { +local object get_eql_hashfunction (void) { var object value = Symbol_value(S(eql_hashfunction)); if (eq(value,S(fasthash_eql)) || eq(value,S(stablehash_eql))) return value; @@ -2078,7 +2078,7 @@ } /* UP: fetches the value of *equal-hashfunction*. */ -local object get_equal_hashfunction () { +local object get_equal_hashfunction (void) { var object value = Symbol_value(S(equal_hashfunction)); if (eq(value,S(fasthash_equal)) || eq(value,S(stablehash_equal))) return value; Index: unix.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/unix.d,v retrieving revision 1.67 retrieving revision 1.68 diff -u -d -r1.67 -r1.68 --- unix.d 6 Jun 2005 12:43:42 -0000 1.67 +++ unix.d 7 Jun 2005 10:55:53 -0000 1.68 @@ -25,7 +25,7 @@ /* the table of the system error messages */ #include <errno.h> -extern int errno; /* last error code */ +/* extern int errno; */ /* last error code */ /* NB: errno may be a macro which expands to a function call. Therefore access and assignment to errno must be wrapped in begin_system_call()/end_system_call() */ Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.522 retrieving revision 1.523 diff -u -d -r1.522 -r1.523 --- stream.d 6 Jun 2005 11:54:40 -0000 1.522 +++ stream.d 7 Jun 2005 10:55:59 -0000 1.523 @@ -14883,7 +14883,7 @@ #ifdef GNU_READLINE local int next_line_virtual(int,int); local int previous_line_virtual(int,int); -local int get_col() { +local int get_col (void) { int col=rl_point; while(col && rl_line_buffer[col]!='\n') col--; return rl_point - col; Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4681 retrieving revision 1.4682 diff -u -d -r1.4681 -r1.4682 --- ChangeLog 7 Jun 2005 10:53:49 -0000 1.4681 +++ ChangeLog 7 Jun 2005 10:56:05 -0000 1.4682 @@ -1,5 +1,18 @@ 2005-06-04 Bruno Haible <br...@cl...> + Remove warnings emitted by gcc -Wstrict-prototypes. + * unix.d (errno): Don't declare. Assume <errno.h> does it. + * spvw.d (print_banner): Define with void argument list. + * stream.d (get_col): Likewise. + * pathname.d (fix_parse_namestring_dot_file, nullfile, + interpret_launch_priority): Likewise. + * hashtabl.d (get_eq_hashfunction, get_eql_hashfunction, + get_equal_hashfunction): Likewise. + * debug.d (ext_show_stack): Likewise. + * realtran.d (sin_stack, cos_stack): Likewise. + +2005-06-04 Bruno Haible <br...@cl...> + * lispbibl.d (Encoding, Encoding_wcslen, Encoding_wcstombs, cslen, cstombs, TheEncoding, TheMachineCode, ThePseudofun, Pseudofun): Emit to clisp.h. Index: debug.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/debug.d,v retrieving revision 1.90 retrieving revision 1.91 diff -u -d -r1.90 -r1.91 --- debug.d 14 May 2005 13:45:45 -0000 1.90 +++ debug.d 7 Jun 2005 10:56:05 -0000 1.91 @@ -1542,7 +1542,7 @@ /* For debugging: From within gdb, type: call ext_show_stack(). Equivalent to (ext:show-stack) from the Lisp prompt. */ -global void ext_show_stack () { +global void ext_show_stack (void) { pushSTACK(unbound); pushSTACK(unbound); pushSTACK(unbound); C_show_stack(); } Index: realtran.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/realtran.d,v retrieving revision 1.21 retrieving revision 1.22 diff -u -d -r1.21 -r1.22 --- realtran.d 14 May 2005 13:46:10 -0000 1.21 +++ realtran.d 7 Jun 2005 10:56:05 -0000 1.22 @@ -431,7 +431,7 @@ } /* compute the sin(r=STACK_0) with precision of STACK_2 */ -local maygc object sin_stack () +local maygc object sin_stack (void) { var object x = F_sqrt_F(F_sinx_F(STACK_0)); /* sin(r)/r */ x = F_F_mal_F(x,STACK_0); /* sin(r) = (sin(r)/r) * r */ @@ -439,7 +439,7 @@ } /* compute the cos(r=STACK_0) with precision of STACK_2 */ -local maygc object cos_stack () +local maygc object cos_stack (void) { var object s = F_I_scale_float_F(STACK_0,Fixnum_minus1); /* s := r/2 */ pushSTACK(s); --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src makemake.in,1.558,1.559 lispbibl.d,1.648,1.649 io.d,1.288,1.289 pathname.d,1.375,1.376 stream.d,1.523,1.524 foreign.d,1.139,1.140 ChangeLog,1.4682,1.4683 Date: Tue, 07 Jun 2005 10:58:01 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20228/src Modified Files: makemake.in lispbibl.d io.d pathname.d stream.d foreign.d ChangeLog Log Message: Compile with gcc -Wmissing-declarations. Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.375 retrieving revision 1.376 diff -u -d -r1.375 -r1.376 --- pathname.d 7 Jun 2005 10:55:55 -0000 1.375 +++ pathname.d 7 Jun 2005 10:57:54 -0000 1.376 @@ -886,7 +886,7 @@ /* error-message because of illegal pathname-argument. fehler_pathname_designator(thing); ( fehler_... = error_... ) > thing: (erroneous) argument */ -nonreturning_function(global, fehler_pathname_designator, (object thing)) { +nonreturning_function(local, fehler_pathname_designator, (object thing)) { pushSTACK(thing); /* TYPE-ERROR slot DATUM */ pushSTACK(O(type_designator_pathname)); /* TYPE-ERROR slot EXPECTED-TYPE */ pushSTACK(O(type_designator_pathname)); @@ -8326,9 +8326,6 @@ #if defined(UNIX) || defined (WIN32_NATIVE) -extern maygc void mkops_from_handles (Handle opipe, int process_id); -extern maygc void mkips_from_handles (Handle ipipe, int process_id); - #ifdef UNIX /* /dev/null handle. */ Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.523 retrieving revision 1.524 diff -u -d -r1.523 -r1.524 --- stream.d 7 Jun 2005 10:55:59 -0000 1.523 +++ stream.d 7 Jun 2005 10:57:54 -0000 1.524 @@ -8894,7 +8894,7 @@ throw_to(S(conversion_failure)); } # Completion of Lisp-Symbols -global maygc char** lisp_completion (char* text, int start, int end) { +local maygc char** lisp_completion (char* text, int start, int end) { # text[0..end-start-1] = the_line[start..end-1] # This is a Callback-Function, we must set the Stack correctly again: begin_callback(); @@ -12963,7 +12963,7 @@ VALUES1(add_to_open_streams(stream)); /* return stream */ } -/* mkops_from_handles +/* mkops_from_handles(pipe,process_id) Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id > STACK_0: buffered > STACK_1: element-type @@ -12997,7 +12997,7 @@ add_to_open_streams(STACK_0); /* return stream */ } -/* mkips_from_handles +/* mkips_from_handles(pipe,process_id) Make a PIPE-INPUT-STREAM from pipe handle and a process-id > STACK_0: buffered > STACK_1: element-type @@ -17557,9 +17557,6 @@ #endif # table of all pseudo-functions -#define PSEUDO PSEUDO_C -#include "pseudofun.c" -#undef PSEUDO global struct pseudocode_tab_ pseudocode_tab = { #define PSEUDO PSEUDO_D #include "pseudofun.c" Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.288 retrieving revision 1.289 diff -u -d -r1.288 -r1.289 --- io.d 14 May 2005 13:54:55 -0000 1.288 +++ io.d 7 Jun 2005 10:57:51 -0000 1.289 @@ -10053,7 +10053,7 @@ # > stream: Stream # < stream: Stream # can trigger GC -global maygc void print (const gcv_object_t* stream_, object obj) { +local maygc void print (const gcv_object_t* stream_, object obj) { pushSTACK(obj); # save Object write_ascii_char(stream_,NL); # print #\Newline obj = popSTACK(); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4682 retrieving revision 1.4683 diff -u -d -r1.4682 -r1.4683 --- ChangeLog 7 Jun 2005 10:56:05 -0000 1.4682 +++ ChangeLog 7 Jun 2005 10:57:55 -0000 1.4683 @@ -1,5 +1,20 @@ 2005-06-04 Bruno Haible <br...@cl...> + Compile with gcc -Wmissing-declarations. + * makemake.in (XCFLAGS): Add -Wmissing-declarations. + * lispbibl.d: Include pseudofun.c with PSEUDO_C. + (fehler_unencodable, mkops_from_handles, mkips_from_handles, + hashcode_lfloat, sigsegv_handler_failed, ext_show_stack): New + declarations. + * io.d (print): Make local. + * pathname.d (fehler_pathname_designator): Make local. + (mkops_from_handles, mkips_from_handles): Remove declarations. + * stream.d (lisp_completion): Make local. + Move pseudofun.c include with PSEUDO_C to lispbibl.d. + * foreign.d (convert_to_foreign_allocaing): Make local. + +2005-06-04 Bruno Haible <br...@cl...> + Remove warnings emitted by gcc -Wstrict-prototypes. * unix.d (errno): Don't declare. Assume <errno.h> does it. * spvw.d (print_banner): Define with void argument list. Index: makemake.in =================================================================== RCS file: /cvsroot/clisp/clisp/src/makemake.in,v retrieving revision 1.558 retrieving revision 1.559 diff -u -d -r1.558 -r1.559 --- makemake.in 6 Jun 2005 12:45:45 -0000 1.558 +++ makemake.in 7 Jun 2005 10:57:51 -0000 1.559 @@ -1041,7 +1041,7 @@ if [ $XCC_GCC = true ] ; then XCC_GCC_VERSION=`LC_ALL=C $XCC -v 2>&1 | grep version | sed -n -e '$p' | sed -e 's/.*version //g' -e 's/gcc //'` - XCFLAGS='-W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type ' + XCFLAGS='-W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wmissing-declarations ' if [ $CROSS = false ] ; then case "$XCC_GCC_VERSION" in # gcc 2.7 introduced an annoying warning, but gcc 2.8 has a workaround: Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.648 retrieving revision 1.649 diff -u -d -r1.648 -r1.649 --- lispbibl.d 7 Jun 2005 10:53:40 -0000 1.648 +++ lispbibl.d 7 Jun 2005 10:57:51 -0000 1.649 @@ -11265,6 +11265,12 @@ #undef PSEUDO # is used by STREAM, SPVW +# Declaration of the functions that can be stored in Lisp objects. +#define PSEUDO PSEUDO_C +#include "pseudofun.c" +#undef PSEUDO +# is used by STREAM, and to avoid gcc -Wmissing-declarations warnings + # Return an ADDRESS object encapsulating a pseudofunction. #ifdef TYPECODES #define P(fun) type_constpointer_object(machine_type,(Pseudofun)&(fun)) @@ -13624,6 +13630,11 @@ }}} while(0) # is used by PATHNAME +/* Error, when a character cannot be converted to an encoding. + fehler_unencodable(encoding,ch); */ +nonreturning_function(extern, fehler_unencodable, (object encoding, chart ch)); +# is used by STREAM + # ####################### ARRBIBL for ARRAY.D ############################## # # ARRAY-TOTAL-SIZE-LIMIT is chosen as large as possible, respecting the @@ -16553,6 +16564,32 @@ extern void stream_handles (object obj, bool check_open, bool* char_p, SOCKET* in_sock, SOCKET* out_sock); %% printf("extern void stream_handles (object obj, bool check_open, bool* char_p, SOCKET* in_sock, SOCKET* out_sock);\n"); +#ifdef PIPES +/* mkops_from_handles(pipe,process_id) + Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id + > STACK_0: buffered + > STACK_1: element-type + > STACK_2: encoding + < STACK_0: result - a PIPE-OUTPUT-STREAM + Used in LAUNCH + Can trigger GC */ +extern maygc void mkops_from_handles (Handle opipe, int process_id); +# is used by PATHNAME +#endif + +#ifdef PIPES +/* mkips_from_handles(pipe,process_id) + Make a PIPE-INPUT-STREAM from pipe handle and a process-id + > STACK_0: buffered + > STACK_1: element-type + > STACK_2: encoding + < STACK_0: result - a PIPE-INPUT-STREAM + Used in LAUNCH + Can trigger GC */ +extern maygc void mkips_from_handles (Handle ipipe, int process_id); +# is used by PATHNAME +#endif + # Makes a Broadcast-Stream using a Stream stream. # make_broadcast1_stream(stream) # can trigger GC @@ -17233,6 +17270,9 @@ extern void DF_to_c_double (object obj, dfloatjanus* val_); %% printf("extern void DF_to_c_double (object obj, dfloatjanus* val_);\n"); +/* hash-code of a Long-Float: mixture of exponent, length, first 32 bits */ +extern uint32 hashcode_lfloat (object obj); + /* (complex x (float 0 x)) */ extern object F_complex_C (object x); @@ -17565,5 +17605,16 @@ the executable was built. */ extern object built_flags (void); +# ####################### FOR DEBUGGING UNDER GDB ######################## # + +#ifdef GENERATIONAL_GC +# Put a breakpoint here if you want to catch CLISP just before it dies. +extern void sigsegv_handler_failed (void* address); +#endif + +/* For debugging: From within gdb, type: call ext_show_stack(). + Equivalent to (ext:show-stack) from the Lisp prompt. */ +extern void ext_show_stack (void); + /*************************************************************************/ Index: foreign.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign.d,v retrieving revision 1.139 retrieving revision 1.140 diff -u -d -r1.139 -r1.140 --- foreign.d 14 May 2005 13:45:48 -0000 1.139 +++ foreign.d 7 Jun 2005 10:57:54 -0000 1.140 @@ -2273,7 +2273,7 @@ allocaing_room_pointer = (void*)((uintP)allocaing_room_pointer + size); return result; } -global maygc void convert_to_foreign_allocaing (object fvd, object obj, void* data) +local maygc void convert_to_foreign_allocaing (object fvd, object obj, void* data) { converter_malloc = &allocaing; convert_to_foreign(fvd,obj,data); --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/modules/syscalls calls.c,1.124,1.125 Date: Tue, 07 Jun 2005 11:00:41 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/syscalls In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21611/modules/syscalls Modified Files: calls.c Log Message: Emulate Unix APIs on Woe32, not vice versa. Index: calls.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v retrieving revision 1.124 retrieving revision 1.125 diff -u -d -r1.124 -r1.125 --- calls.c 7 Jun 2005 10:53:51 -0000 1.124 +++ calls.c 7 Jun 2005 11:00:38 -0000 1.125 @@ -2516,7 +2516,10 @@ Handle new_handle = (Handle)check_uint_defaulted(popSTACK(),(uintL)-1); Handle old_handle = (Handle)I_to_uint(check_uint(popSTACK())); begin_system_call(); - new_handle = handle_dup(old_handle,new_handle); + if (new_handle == (Handle)(uintL)-1) + new_handle = handle_dup(old_handle); + else + new_handle = handle_dup2(old_handle,new_handle); end_system_call(); VALUES1(fixnum(new_handle)); } --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src lispbibl.d,1.649,1.650 unix.d,1.68,1.69 win32.d,1.57,1.58 pathname.d,1.376,1.377 stream.d,1.524,1.525 ChangeLog,1.4683,1.4684 Date: Tue, 07 Jun 2005 11:00:39 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21611/src Modified Files: lispbibl.d unix.d win32.d pathname.d stream.d ChangeLog Log Message: Emulate Unix APIs on Woe32, not vice versa. Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.376 retrieving revision 1.377 diff -u -d -r1.376 -r1.377 --- pathname.d 7 Jun 2005 10:57:54 -0000 1.376 +++ pathname.d 7 Jun 2005 11:00:32 -0000 1.377 @@ -8120,12 +8120,36 @@ #endif -/* duplicate the handle (maybe into new_handle) - must be surrounded with begin_system_call()/end_system_call() */ -global Handle handle_dup (Handle old_handle, Handle new_handle) { +/* Duplicate an open file handle. + handle_dup(oldfd) + Similar to dup(oldfd), with error checking. + To be called only inside begin/end_system_call(). */ +global Handle handle_dup (Handle old_handle) { + int new_handle; #if defined(UNIX) - new_handle = (HNULLP(new_handle) ? dup(old_handle) - : dup2(old_handle,new_handle)); + new_handle = dup(old_handle); + if (new_handle < 0) { OS_error(); } + #elif defined(WIN32_NATIVE) + new_handle = INVALID_HANDLE_VALUE; + if (!DuplicateHandle(GetCurrentProcess(),old_handle, + GetCurrentProcess(),&new_handle, + 0, true, DUPLICATE_SAME_ACCESS)) + OS_error(); + #else + NOTREACHED; + #endif + return new_handle; +} + +/* Duplicate an open file handle. + handle_dup2(oldfd,newfd) + Similar to dup2(oldfd,newfd), with error checking. The result may or may not + be equal to newfd. + To be called only inside begin/end_system_call(). */ +global Handle handle_dup2 (Handle old_handle, Handle new_handle) { + #if defined(UNIX) + new_handle = dup2(old_handle,new_handle); + if (new_handle < 0) { OS_error(); } #elif defined(WIN32_NATIVE) if (!DuplicateHandle(GetCurrentProcess(),old_handle, GetCurrentProcess(),&new_handle, @@ -8134,7 +8158,6 @@ #else NOTREACHED; #endif - if (HNULLP(new_handle)) OS_error(); return new_handle; } @@ -8330,7 +8353,7 @@ /* /dev/null handle. */ local Handle nullfile (void) { - var Handle result = INVALID_HANDLE_VALUE; + var Handle result; begin_system_call(); result = open("/dev/null",O_RDWR); end_system_call(); @@ -8351,7 +8374,7 @@ /* /dev/null on NT/W95. */ local Handle nullfile (void) { - var Handle result = NULL; + var Handle result; begin_system_call(); result = CreateFile("NUL", GENERIC_READ | GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, @@ -8365,12 +8388,12 @@ begin_system_call(); if (!CreatePipe(hin,hout,NULL,0)) { OS_error(); } if (dupinp) {/* make it inheritable */ - var Handle hin1 = handle_dup1(*hin); + var Handle hin1 = handle_dup(*hin); if (!CloseHandle(*hin)) { OS_error(); } *hin = hin1; } if (dupoutp) { - var Handle hout1 = handle_dup1(*hout); + var Handle hout1 = handle_dup(*hout); if (!CloseHandle(*hout)) { OS_error(); } *hout = hout1; } @@ -8384,35 +8407,39 @@ Handle * hnull, bool * wait_p) { var int handletype = 0; - *h = INVALID_HANDLE_VALUE; - *ph = INVALID_HANDLE_VALUE; + *h = INVALID_HANDLE; + *ph = INVALID_HANDLE; if (boundp(STACK_(istack)) && eq(STACK_(istack),S(Kterminal)) || !boundp(STACK_(istack))) - *h = handle_dup1(stdhandle); + *h = handle_dup(stdhandle); else if (nullp(STACK_(istack))) { - if (HNULLP(*hnull)) *hnull = nullfile(); - *h = handle_dup1(*hnull); + if (*hnull == INVALID_HANDLE) + *hnull = nullfile(); + *h = handle_dup(*hnull); } else if (eq(STACK_(istack),S(Kpipe))) { if (child_inputp) - /* make an input pipe for child, ph = parent's handle */ + /* make an input pipe for child, ph = parent's handle */ mkpipe(h,true,ph,false); - /* make an output pipe for child */ - else mkpipe(ph,false,h,true); - if (HNULLP(*ph) || HNULLP(*h)) return false; + else + /* make an output pipe for child */ + mkpipe(ph,false,h,true); + if (*ph == INVALID_HANDLE || *h == INVALID_HANDLE) + return false; *wait_p = false; /* TODO: error when wait_p */ } else { - *h = handle_dup1(stream_lend_handle(STACK_(istack), - child_inputp,/* child i/o direction is the same as lisp user i/o direction */ - &handletype)); - if (handletype!=1) return false; + *h = handle_dup(stream_lend_handle(STACK_(istack), + child_inputp,/* child i/o direction is the same as lisp user i/o direction */ + &handletype)); + if (handletype != 1) + return false; } - return !HNULLP(*h); + return (*h != INVALID_HANDLE); } local maygc void make_launch_pipe (int istack, bool parent_inputp, Handle hparent_pipe, int childpid) { - if (!HNULLP(hparent_pipe)) { + if (hparent_pipe != INVALID_HANDLE) { pushSTACK(STACK_7); /* encoding */ pushSTACK(STACK_(8+1)); /* element-type */ pushSTACK(STACK_(6+2)); /* buffered */ @@ -8484,19 +8511,22 @@ else STACK_5 = check_list(STACK_5); var long priority = interpret_launch_priority();/* from STACK_0 */ var bool wait_p = !nullp(STACK_4); /* default: do wait! */ - var Handle hnull = INVALID_HANDLE_VALUE; + var Handle hnull = INVALID_HANDLE; var Handle hinput; var Handle hparent_out; /* in case of pipe */ /* STACK_3 == input_stream_arg */ if (!init_launch_streamarg(3, true, stdin_handle, &hinput, &hparent_out, - &hnull,&wait_p)) OS_error(); + &hnull,&wait_p)) + OS_error(); var Handle houtput, hparent_in; /* STACK_2 == output_stream_arg */ if (!init_launch_streamarg(2, false, stdout_handle, &houtput, &hparent_in, - &hnull,&wait_p)) { + &hnull,&wait_p)) { begin_system_call(); - if (!HNULLP(hinput) && hinput!=stdin_handle) ParaClose(hinput); - if (!HNULLP(hparent_out)) ParaClose(hparent_out); + if (hinput != INVALID_HANDLE && hinput != stdin_handle) + ParaClose(hinput); + if (hparent_out != INVALID_HANDLE) + ParaClose(hparent_out); end_system_call(); OS_error(); } @@ -8505,14 +8535,18 @@ if (!init_launch_streamarg(1, false, stderr_handle, &herror, &hparent_errin, &hnull,&wait_p)) { begin_system_call(); - if (!HNULLP(hinput) && hinput!=stdin_handle) ParaClose(hinput); - if (!HNULLP(hparent_out)) ParaClose(hparent_out); - if (!HNULLP(houtput) && houtput != stdout_handle) ParaClose(houtput); - if (!HNULLP(hparent_in)) ParaClose(hparent_in); + if (hinput != INVALID_HANDLE && hinput != stdin_handle) + ParaClose(hinput); + if (hparent_out != INVALID_HANDLE) + ParaClose(hparent_out); + if (houtput != INVALID_HANDLE && houtput != stdout_handle) + ParaClose(houtput); + if (hparent_in != INVALID_HANDLE) + ParaClose(hparent_in); end_system_call(); OS_error(); } - if (!HNULLP(hnull)) { + if (hnull != INVALID_HANDLE) { begin_system_call(); ParaClose(hnull); end_system_call(); @@ -8551,21 +8585,22 @@ if (child_id == 0) {/* What ?! I am the clone ?! */ /* TODO: close ALL unused opened handles since unclosed handles (to previously opened pipes) can prevent childs to end up properly */ - #define CHILD_DUP(from,to) \ - if (handle_dup(from,to) == (Handle)-1) { \ - fprintf(stderr,"clisp/child: cannot duplicate %d to %d: %s\n", \ - from,to,strerror(errno)); \ - _exit(-1); \ - } \ - if (from>2) close(from) + #define CHILD_DUP(from,to) \ + if (dup2(from,to) < 0) { \ + fprintf(stderr,"clisp/child: cannot duplicate %d to %d: %s\n", \ + from,to,strerror(errno)); \ + _exit(-1); \ + } \ + if (from>2) \ + close(from) CHILD_DUP(hinput,0); CHILD_DUP(houtput,1); CHILD_DUP(herror,2); #undef CHILD_DUP /* close child copies of parent's handles */ - if (!HNULLP(hparent_out)) close(hparent_out); - if (!HNULLP(hparent_in)) close(hparent_in); - if (!HNULLP(hparent_errin)) close(hparent_errin); + if (hparent_out >= 0) close(hparent_out); + if (hparent_in >= 0) close(hparent_in); + if (hparent_errin >= 0) close(hparent_errin); #ifdef HAVE_NICE errno = 0; nice(priority); if (errno) { @@ -8667,9 +8702,9 @@ make_launch_pipe (1, true, hparent_errin, child_id); value1 = wait_p ? fixnum(exit_code) : fixnum(child_id); - value2 = (!HNULLP(hparent_out)) ? (object)STACK_3 : NIL; /* INPUT */ - value3 = (!HNULLP(hparent_in)) ? (object)STACK_2 : NIL; /* OUTPUT */ - value4 = (!HNULLP(hparent_errin)) ? (object)STACK_1 : NIL; /* ERROR */ + value2 = (hparent_out != INVALID_HANDLE) ? (object)STACK_3 : NIL; /* INPUT */ + value3 = (hparent_in != INVALID_HANDLE) ? (object)STACK_2 : NIL; /* OUTPUT */ + value4 = (hparent_errin != INVALID_HANDLE) ? (object)STACK_1 : NIL; /* ERROR */ mv_count = 4; skipSTACK(10); Index: win32.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/win32.d,v retrieving revision 1.57 retrieving revision 1.58 diff -u -d -r1.57 -r1.58 --- win32.d 6 Jun 2005 13:25:10 -0000 1.57 +++ win32.d 7 Jun 2005 11:00:31 -0000 1.58 @@ -82,6 +82,7 @@ /* Type of a file handle */ #define Handle HANDLE +#define INVALID_HANDLE INVALID_HANDLE_VALUE #define FOREIGN_HANDLE /* box them */ /* File handles of standard input, standard output, standard error */ Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.524 retrieving revision 1.525 diff -u -d -r1.524 -r1.525 --- stream.d 7 Jun 2005 10:57:54 -0000 1.524 +++ stream.d 7 Jun 2005 11:00:32 -0000 1.525 @@ -14677,7 +14677,7 @@ pushSTACK(buff_p); pushSTACK(ext_fmt); pushSTACK(eltype); - pushSTACK(allocate_handle(handle_dup1(fd))); + pushSTACK(allocate_handle(handle_dup(fd))); dir = check_direction(direction); #ifdef UNIX { /* set Filename to /dev/fd/<fd> */ Index: unix.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/unix.d,v retrieving revision 1.68 retrieving revision 1.69 diff -u -d -r1.68 -r1.69 --- unix.d 7 Jun 2005 10:55:53 -0000 1.68 +++ unix.d 7 Jun 2005 11:00:31 -0000 1.69 @@ -438,7 +438,8 @@ #define O_BINARY 0 #endif #define my_open_mask 0644 -#define Handle uintW /* the type of a file deskriptor */ +#define Handle int /* the type of a file descriptor */ +#define INVALID_HANDLE -1 extern_C off_t lseek (int fd, off_t offset, int whence); /* LSEEK(2V) */ #ifndef SEEK_SET /* e.g., UNIX_NEXTSTEP */ /* position modes, see <unistd.h> : */ @@ -714,7 +715,7 @@ #include <vfork.h> #endif /* vfork() declared in <vfork.h> or <unistd.h> */ -extern_C int dup2 (int fd1, int fd2); /* DUP(2V) */ +extern_C int dup2 (int oldfd, int newfd); /* DUP(2V) */ #if defined(HAVE_SETPGID) extern_C pid_t getpid (void); /* GETPID(2V) */ extern_C int setpgid (pid_t pid, pid_t pgid); /* SETPGID(2V), SETSID(2V), TERMIO(4) */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4683 retrieving revision 1.4684 diff -u -d -r1.4683 -r1.4684 --- ChangeLog 7 Jun 2005 10:57:55 -0000 1.4683 +++ ChangeLog 7 Jun 2005 11:00:32 -0000 1.4684 @@ -1,5 +1,25 @@ 2005-06-04 Bruno Haible <br...@cl...> + Emulate Unix APIs on Woe32, not vice versa. + * lispbibl.d (handle_dup): Remove declaration. + (INVALID_HANDLE_VALUE, HNULLP): Remove macro. + (handle_dup1): Remove macro. + (handle_dup): New declaration, replaces handle_dup1. + (handle_dup2): New declaration, replaces a case of handle_dup. + * unix.d (Handle): Change to 'int'. + (INVALID_HANDLE): New macro. + * win32.d (INVALID_HANDLE): New macro. + * pathname.d (handle_dup, handle_dup2): Replace old function + handle_dup. + (nullfile): Remove unused initializer. + (mkpipe, init_launch_streamarg, make_launch_pipe, LAUNCH): Update. + (LAUNCH) [UNIX]: Call dup2, not handle_dup2, since handle_dup2 does + unwanted error handling. + * stream.d (handle_to_stream): Update. + * modules/syscalls/calls.c (POSIX::DUPLICATE-HANDLE): Update. + +2005-06-04 Bruno Haible <br...@cl...> + Compile with gcc -Wmissing-declarations. * makemake.in (XCFLAGS): Add -Wmissing-declarations. * lispbibl.d: Include pseudofun.c with PSEUDO_C. Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.649 retrieving revision 1.650 diff -u -d -r1.649 -r1.650 --- lispbibl.d 7 Jun 2005 10:57:51 -0000 1.649 +++ lispbibl.d 7 Jun 2005 11:00:31 -0000 1.650 @@ -2084,7 +2084,6 @@ #if defined(UNIX_CYGWIN32) /* <sigsegv.h> includes <windows.h> */ #undef WIN32 - #undef INVALID_HANDLE_VALUE #endif #endif @@ -15946,16 +15945,20 @@ extern maygc void init_pathnames (void); # is used by SPVW -/* duplicate the handle (maybe into new_handle) - must be surrounded with begin_system_call()/end_system_call() */ -extern Handle handle_dup (Handle old_handle, Handle new_handle); -#if !defined(WIN32_NATIVE) -#define INVALID_HANDLE_VALUE ((Handle)(-1)) -#endif -#define HNULLP(h) ((h)==INVALID_HANDLE_VALUE) -#define handle_dup1(h) handle_dup(h,INVALID_HANDLE_VALUE) -/* used by STREAM */ -%% printf("extern Handle handle_dup (Handle old_handle, Handle new_handle);\n"); +/* Duplicate an open file handle. + handle_dup(oldfd) + Similar to dup(oldfd), with error checking. + To be called only inside begin/end_system_call(). */ +extern Handle handle_dup (Handle old_handle); +%% printf("extern Handle handle_dup (Handle old_handle);\n"); + +/* Duplicate an open file handle. + handle_dup2(oldfd,newfd) + Similar to dup2(oldfd,newfd), with error checking. The result may or may not + be equal to newfd. + To be called only inside begin/end_system_call(). */ +extern Handle handle_dup2 (Handle old_handle, Handle new_handle); +%% printf("extern Handle handle_dup2 (Handle old_handle, Handle new_handle);\n"); # Locates the executable program immediately after the program start. # find_executable(argv[0]) --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |
