diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 10 | ||||
| -rw-r--r-- | generic/tclIntPlatDecls.h | 10 | ||||
| -rw-r--r-- | generic/tclTomMathDecls.h | 6 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 122 |
5 files changed, 38 insertions, 117 deletions
@@ -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. |