Make sure to use CONST/VOID in stead of

const/void when appropriate. This allows to
use const/void in the *.decls file always,
genStubs will do the right thing.

5 files changed, 38 insertions, 117 deletions

diff --git a/ChangeLog b/ChangeLog
index 4a03fe2..a53a3e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-01-19  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* tools/genStubs.tcl:       Make sure to use CONST/VOID in stead of
+	* generic/tclIntDecls.h     const/void when appropriate. This allows to
+	* generic/tclIntPlatDecls.h use const/void in the *.decls file always,
+	* generic/tclTomMathDecls.h genStubs will do the right thing.
+
 2011-01-18  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclBasic.c:      Various mismatches between Tcl_Panic 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 7d34296..9933fd5 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.112.2.6 2010/11/30 20:59:27 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.112.2.7 2011/01/19 08:04:49 nijtmans Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -730,7 +730,7 @@ EXTERN void *		TclGetInstructionTable(void);
 #ifndef TclExpandCodeArray_TCL_DECLARED
 #define TclExpandCodeArray_TCL_DECLARED
 /* 164 */
-EXTERN void		TclExpandCodeArray(void *envPtr);
+EXTERN void		TclExpandCodeArray(VOID *envPtr);
 #endif
 #ifndef TclpSetInitialEncodings_TCL_DECLARED
 #define TclpSetInitialEncodings_TCL_DECLARED
@@ -930,7 +930,7 @@ EXTERN void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
 #ifndef TclStackFree_TCL_DECLARED
 #define TclStackFree_TCL_DECLARED
 /* 216 */
-EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
+EXTERN void		TclStackFree(Tcl_Interp *interp, VOID *freePtr);
 #endif
 #ifndef TclPushStackFrame_TCL_DECLARED
 #define TclPushStackFrame_TCL_DECLARED
@@ -1220,7 +1220,7 @@ typedef struct TclIntStubs {
     int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
     void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
     void * (*tclGetInstructionTable) (void); /* 163 */
-    void (*tclExpandCodeArray) (void *envPtr); /* 164 */
+    void (*tclExpandCodeArray) (VOID *envPtr); /* 164 */
     void (*tclpSetInitialEncodings) (void); /* 165 */
     int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
     void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
@@ -1272,7 +1272,7 @@ typedef struct TclIntStubs {
     Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
     void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
     void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
-    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
+    void (*tclStackFree) (Tcl_Interp *interp, VOID *freePtr); /* 216 */
     int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
     void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
     void *reserved219;
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index cd9d2b3..73805af 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -9,7 +9,7 @@
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.32.2.3 2010/02/07 22:16:54 nijtmans Exp $
+ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.32.2.4 2011/01/19 08:04:49 nijtmans Exp $
  */
 
 #ifndef _TCLINTPLATDECLS
@@ -216,7 +216,7 @@ EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
 #ifndef TclWinAddProcess_TCL_DECLARED
 #define TclWinAddProcess_TCL_DECLARED
 /* 20 */
-EXTERN void		TclWinAddProcess(void *hProcess, unsigned long id);
+EXTERN void		TclWinAddProcess(VOID *hProcess, unsigned long id);
 #endif
 /* Slot 21 is reserved */
 #ifndef TclpCreateTempFile_TCL_DECLARED
@@ -369,7 +369,7 @@ EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
 #define TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
 /* 19 */
 EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				CONST void *runLoopMode);
+				CONST VOID *runLoopMode);
 #endif
 #endif /* MACOSX */
 
@@ -415,7 +415,7 @@ typedef struct TclIntPlatStubs {
     void *reserved17;
     TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
     TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */
-    void (*tclWinAddProcess) (void *hProcess, unsigned long id); /* 20 */
+    void (*tclWinAddProcess) (VOID *hProcess, unsigned long id); /* 20 */
     void *reserved21;
     TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */
     char * (*tclpGetTZName) (int isdst); /* 23 */
@@ -446,7 +446,7 @@ typedef struct TclIntPlatStubs {
     int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
     int (*tclMacOSXCopyFileAttributes) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr); /* 17 */
     int (*tclMacOSXMatchType) (Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
-    void (*tclMacOSXNotifierAddRunLoopMode) (CONST void *runLoopMode); /* 19 */
+    void (*tclMacOSXNotifierAddRunLoopMode) (CONST VOID *runLoopMode); /* 19 */
 #endif /* MACOSX */
 } TclIntPlatStubs;
 
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index d3986b4..e485f41 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTomMathDecls.h,v 1.2.4.2 2010/11/30 20:59:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclTomMathDecls.h,v 1.2.4.3 2011/01/19 08:04:49 nijtmans Exp $
  */
 
 #ifndef _TCLTOMMATHDECLS
@@ -325,7 +325,7 @@ EXTERN int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);
 #ifndef TclBN_mp_read_radix_TCL_DECLARED
 #define TclBN_mp_read_radix_TCL_DECLARED
 /* 36 */
-EXTERN int		TclBN_mp_read_radix(mp_int *a, const char *str,
+EXTERN int		TclBN_mp_read_radix(mp_int *a, CONST char *str,
 				int radix);
 #endif
 #ifndef TclBN_mp_rshd_TCL_DECLARED
@@ -504,7 +504,7 @@ typedef struct TclTomMathStubs {
     int (*tclBN_mp_neg) (mp_int *a, mp_int *b); /* 33 */
     int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
     int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
-    int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
+    int (*tclBN_mp_read_radix) (mp_int *a, CONST char *str, int radix); /* 36 */
     void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
     int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
     void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index ab36d00..43c65e4 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: genStubs.tcl,v 1.22.2.5 2011/01/03 10:08:22 nijtmans Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.22.2.6 2011/01/19 08:04:49 nijtmans Exp $
 
 package require Tcl 8.4
 
@@ -18,7 +18,7 @@ namespace eval genStubs {
     # libraryName --
     #
     #	The name of the entire library.  This value is used to compute
-    #	the USE_*_STUB_PROCS macro and the name of the init file.
+    #	the USE_*_STUBS macro and the name of the init file.
 
     variable libraryName "UNKNOWN"
 
@@ -153,6 +153,8 @@ proc genStubs::declare {args} {
 	    puts stderr "Duplicate entry: declare $args"
 	}
     }
+    regsub -all const $decl CONST decl
+    regsub -all _XCONST $decl _Xconst decl
     regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
     set decl [parseDecl $decl]
 
@@ -181,14 +183,9 @@ proc genStubs::declare {args} {
 #	None.
 
 proc genStubs::export {args} {
-    variable stubs
-    variable curName
-
     if {[llength $args] != 1} {
 	puts stderr "wrong # args: export $args"
     }
-    lassign $args decl
-
     return
 }
 
@@ -307,7 +304,6 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
 #	None.
 
 proc genStubs::emitSlots {name textVar} {
-    variable stubs
     upvar $textVar text
 
     forAllStubs $name makeSlot 1 text {"    void *reserved$i;\n"}
@@ -415,6 +411,9 @@ proc genStubs::makeDecl {name decl index} {
     lassign $decl rtype fname args
 
     append text "/* $index */\n"
+    if {$rtype eq "VOID"} {
+	set rtype void
+    }
     set line "EXTERN $rtype"
     set count [expr {2 - ([string length $line] / 8)}]
     append line [string range "\t\t\t" 0 $count]
@@ -431,9 +430,10 @@ proc genStubs::makeDecl {name decl index} {
     }
     append line $fname
 
+    regsub -all void $args VOID args
     set arg1 [lindex $args 0]
     switch -exact $arg1 {
-	void {
+	VOID {
 	    append line "(void)"
 	}
 	TCL_VARARGS {
@@ -502,82 +502,15 @@ proc genStubs::makeMacro {name decl index} {
     set lfname [string tolower [string index $fname 0]]
     append lfname [string range $fname 1 end]
 
-    set text "#ifndef $fname\n#define $fname"
+    set text "#ifndef $fname\n#define $fname \\\n\t("
     if {$args == ""} {
-	append text " \\\n\t(*${name}StubsPtr->$lfname)"
-	append text " /* $index */\n#endif\n"
-	return $text
+	append text "*"
     }
-    append text " \\\n\t(${name}StubsPtr->$lfname)"
+    append text "${name}StubsPtr->$lfname)"
     append text " /* $index */\n#endif\n"
     return $text
 }
 
-# genStubs::makeStub --
-#
-#	Emits a stub function definition.
-#
-# Arguments:
-#	name	The interface name.
-#	decl	The function declaration.
-#	index	The slot index for this function.
-#
-# Results:
-#	Returns the formatted stub function definition.
-
-proc genStubs::makeStub {name decl index} {
-    lassign $decl rtype fname args
-
-    set lfname [string tolower [string index $fname 0]]
-    append lfname [string range $fname 1 end]
-
-    append text "/* Slot $index */\n" $rtype "\n" $fname
-
-    set arg1 [lindex $args 0]
-
-    if {![string compare $arg1 "TCL_VARARGS"]} {
-	lassign [lindex $args 1] type argName
-	append text " ($type$argName, ...)\n\{\n"
-	append text "    " $type " var;\n    va_list argList;\n"
-	if {[string compare $rtype "void"]} {
-	    append text "    " $rtype " resultValue;\n"
-	}
-	append text "\n    var = (" $type ") (va_start(argList, " \
-		$argName "), " $argName ");\n\n    "
-	if {[string compare $rtype "void"]} {
-	    append text "resultValue = "
-	}
-	append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n"
-	append text "    va_end(argList);\n"
-	if {[string compare $rtype "void"]} {
-	    append text "return resultValue;\n"
-	}
-	append text "\}\n\n"
-	return $text
-    }
-
-    if {![string compare $arg1 "void"]} {
-	set argList "()"
-	set argDecls ""
-    } else {
-	set argList ""
-	set sep "("
-	foreach arg $args {
-	    append argList $sep [lindex $arg 1]
-	    append argDecls "    " [lindex $arg 0] " " \
-		    [lindex $arg 1] [lindex $arg 2] ";\n"
-	    set sep ", "
-	}
-	append argList ")"
-    }
-    append text $argList "\n" $argDecls "{\n    "
-    if {[string compare $rtype "void"]} {
-	append text "return "
-    }
-    append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n"
-    return $text
-}
-
 # genStubs::makeSlot --
 #
 #	Generate the stub table entry for a function.
@@ -597,6 +530,9 @@ proc genStubs::makeSlot {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "    "
+    if {$rtype eq "VOID"} {
+	set rtype void
+    }
     if {$args == ""} {
 	append text $rtype " *" $lfname "; /* $index */\n"
 	return $text
@@ -606,9 +542,10 @@ proc genStubs::makeSlot {name decl index} {
     } else {
 	append text $rtype " (*" $lfname ") "
     }
+    regsub -all void $args VOID args
     set arg1 [lindex $args 0]
     switch -exact $arg1 {
-	void {
+	VOID {
 	    append text "(void)"
 	}
 	TCL_VARARGS {
@@ -683,7 +620,7 @@ proc genStubs::makeInit {name decl index} {
 # Results:
 #	None.
 
-proc genStubs::forAllStubs {name slotProc onAll textVar \
+proc genStubs::forAllStubs {name slotProc onAll textVar
 	{skipString {"/* Slot $i is reserved */\n"}}} {
     variable stubs
     upvar $textVar text
@@ -942,7 +879,6 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
 #	None.
 
 proc genStubs::emitDeclarations {name textVar} {
-    variable stubs
     upvar $textVar text
 
     append text "\n/*\n * Exported function declarations:\n */\n\n"
@@ -962,7 +898,6 @@ proc genStubs::emitDeclarations {name textVar} {
 #	None.
 
 proc genStubs::emitMacros {name textVar} {
-    variable stubs
     variable libraryName
     upvar $textVar text
 
@@ -1025,27 +960,6 @@ proc genStubs::emitHeader {name} {
     return
 }
 
-# genStubs::emitStubs --
-#
-#	This function emits the body of the <name>Stubs.c file for
-#	the specified interface.
-#
-# Arguments:
-#	name	The name of the interface being emitted.
-#
-# Results:
-#	None.
-
-proc genStubs::emitStubs {name} {
-    variable outDir
-
-    append text "\n/*\n * Exported stub functions:\n */\n\n"
-    forAllStubs $name makeStub 0 text
-
-    rewriteFile [file join $outDir ${name}Stubs.c] $text
-    return
-}
-
 # genStubs::emitInit --
 #
 #	Generate the table initializers for an interface.