Revert most of [ae92de6078], since when we let cygwin share the win32 stub table this is no longer necessary

implement TclpInetNtoa for win32
Let cygwin share stub table with win32

1 files changed, 155 insertions, 21 deletions

diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 009db07..00888c9 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -31,6 +31,22 @@ namespace eval genStubs {
 
     variable curName "UNKNOWN"
 
+    # scspec --
+    #
+    #	Storage class specifier for external function declarations.
+    #	Normally "EXTERN", may be set to something like XYZAPI
+    #
+    variable scspec "EXTERN"
+
+    # epoch, revision --
+    #
+    #	The epoch and revision numbers of the interface currently being defined.
+    #   (@@@TODO: should be an array mapping interface names -> numbers)
+    #
+
+    variable epoch {}
+    variable revision 0
+
     # hooks --
     #
     #	An array indexed by interface name that contains the set of
@@ -92,6 +108,27 @@ proc genStubs::interface {name} {
     return
 }
 
+# genStubs::scspec --
+#
+#	Define the storage class macro used for external function declarations.
+#	Typically, this will be a macro like XYZAPI or EXTERN that
+#	expands to either DLLIMPORT or DLLEXPORT, depending on whether
+#	-DBUILD_XYZ has been set.
+#
+proc genStubs::scspec {value} {
+    variable scspec $value
+}
+
+# genStubs::epoch --
+#
+#	Define the epoch number for this library.  The epoch
+#	should be incrememented when a release is made that
+#	contains incompatible changes to the public API.
+#
+proc genStubs::epoch {value} {
+    variable epoch $value
+}
+
 # genStubs::hooks --
 #
 #	This function defines the subinterface hooks for the current
@@ -130,7 +167,9 @@ proc genStubs::hooks {names} {
 proc genStubs::declare {args} {
     variable stubs
     variable curName
+    variable revision
 
+    incr revision
     if {[llength $args] == 2} {
 	lassign $args index decl
 	set platformList generic
@@ -166,6 +205,25 @@ proc genStubs::declare {args} {
     return
 }
 
+# genStubs::export --
+#
+#	This function is used in the declarations file to declare a symbol
+#	that is exported from the library but is not in the stubs table.
+#
+# Arguments:
+#	decl		The C function declaration, or {} for an undefined
+#			entry.
+#
+# Results:
+#	None.
+
+proc genStubs::export {args} {
+    if {[llength $args] != 1} {
+	puts stderr "wrong # args: export $args"
+    }
+    return
+}
+
 # genStubs::rewriteFile --
 #
 #	This function replaces the machine generated portion of the
@@ -221,25 +279,55 @@ proc genStubs::rewriteFile {file text} {
 # Results:
 #	Returns the original text inside an appropriate #ifdef.
 
-proc genStubs::addPlatformGuard {plat text} {
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+    set text ""
     switch $plat {
 	win {
-	    return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
+	    append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* WIN */\n${eltxt}"
+	    }
+	    append text "#endif /* WIN */\n"
 	}
 	unix {
-	    return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n"
+	    append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL)\
+		    /* UNIX */\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* UNIX */\n${eltxt}"
+	    }
+	    append text "#endif /* UNIX */\n"
 	}		    
 	mac {
-	    return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n"
+	    append text "#ifdef MAC_TCL\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* MAC_TCL */\n${eltxt}"
+	    }
+	    append text "#endif /* MAC_TCL */\n"
 	}
 	macosx {
-	    return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
+	    append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* MACOSX */\n${eltxt}"
+	    }
+	    append text "#endif /* MACOSX */\n"
 	}
 	aqua {
-	    return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
+	    append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* AQUA */\n${eltxt}"
+	    }
+	    append text "#endif /* AQUA */\n"
 	}
 	x11 {
-	    return "#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
+	    append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_TCL) || defined(MAC_OSX_TK))\
+		    /* X11 */\n${iftxt}"
+	    if {$eltxt != ""} {
+		append text "#else /* X11 */\n${eltxt}"
+	    }
+	    append text "#endif /* X11 */\n"
+	}
+	default {
+	    append text "${iftxt}${eltxt}"
 	}
     }
     return $text
@@ -280,8 +368,8 @@ proc genStubs::emitSlots {name textVar} {
 
 proc genStubs::parseDecl {decl} {
     if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} {
-	puts stderr "Malformed declaration: $decl"
-	return
+	set prefix $decl
+	set args {}
     }
     set prefix [string trim $prefix]
     if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
@@ -289,19 +377,23 @@ proc genStubs::parseDecl {decl} {
 	return
     }
     set rtype [string trim $rtype]
+    if {$args == ""} {
+	return [list $rtype $fname {}]
+    }
     foreach arg [split $args ,] {
 	lappend argList [string trim $arg]
     }
     if {![string compare [lindex $argList end] "..."]} {
-	if {[llength $argList] != 2} {
-	    puts stderr "Only one argument is allowed in varargs form: $decl"
-	}
-	set arg [parseArg [lindex $argList 0]]
-	if {$arg == "" || ([llength $arg] != 2)} {
-	    puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'"
-	    return
+	set args TCL_VARARGS
+	foreach arg [lrange $argList 0 end-1] {
+	    set argInfo [parseArg $arg]
+	    if {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+		lappend args $argInfo
+	    } else {
+		puts stderr "Bad argument: '$arg' in '$decl'"
+		return
+	    }
 	}
-	set args [list TCL_VARARGS $arg]
     } else {
 	set args {}
 	foreach arg $argList {
@@ -359,13 +451,14 @@ proc genStubs::parseArg {arg} {
 #	Returns the formatted declaration string.
 
 proc genStubs::makeDecl {name decl index} {
+    variable scspec
     lassign $decl rtype fname args
 
     append text "/* $index */\n"
     if {($rtype != "void") && ($rtype != "pascal void")} {
 	regsub -all void $rtype VOID rtype
     }
-    set line "EXTERN $rtype"
+    set line "$scspec $rtype"
     set count [expr {2 - ([string length $line] / 8)}]
     append line [string range "\t\t\t" 0 $count]
     set pad [expr {24 - [string length $line]}]
@@ -373,6 +466,12 @@ proc genStubs::makeDecl {name decl index} {
 	append line " "
 	set pad 0
     }
+    if {$args eq ""} {
+	append line $fname
+	append text $line
+	append text ";\n"
+	return $text
+    }
     append line "$fname _ANSI_ARGS_("
 
     regsub -all void $args VOID args
@@ -470,6 +569,10 @@ proc genStubs::makeSlot {name decl index} {
     append lfname [string range $fname 1 end]
 
     set text "    "
+    if {$args == ""} {
+	append text $rtype " *" $lfname "; /* $index */\n"
+	return $text
+    }
     if {($rtype != "void") && ($rtype != "pascal void")} {
 	regsub -all void $rtype VOID rtype
     }
@@ -485,8 +588,16 @@ proc genStubs::makeSlot {name decl index} {
 	    append text "(void)"
 	}
 	TCL_VARARGS {
-	    set arg [lindex $args 1]
-	    append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
+	    set sep "("
+	    foreach arg [lrange $args 1 end] {
+		append text $sep [lindex $arg 0]
+		if {[string index $text end] != "*"} {
+		    append text " "
+		}
+		append text [lindex $arg 1] [lindex $arg 2]
+		set sep ", "
+	    }
+	    append text ", ...)"
 	}
 	default {
 	    set sep "("
@@ -519,7 +630,11 @@ proc genStubs::makeSlot {name decl index} {
 #	Returns the formatted declaration string.
 
 proc genStubs::makeInit {name decl index} {
-    append text "    " [lindex $decl 1] ", /* " $index " */\n"
+    if {[lindex $decl 2] eq ""} {
+	append text "    &" [lindex $decl 1] ", /* " $index " */\n"
+    } else {
+	append text "    " [lindex $decl 1] ", /* " $index " */\n"
+    }
     return $text
 }
 
@@ -728,10 +843,19 @@ proc genStubs::emitMacros {name textVar} {
 proc genStubs::emitHeader {name} {
     variable outDir
     variable hooks
+    variable epoch
+    variable revision
 
     set capName [string toupper [string index $name 0]]
     append capName [string range $name 1 end]
 
+    if {$epoch != ""} {
+	set CAPName [string toupper $name]
+	append text "\n"
+	append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
+	append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+    }
+
     emitDeclarations $name text
 
     if {[info exists hooks($name)]} {
@@ -745,6 +869,10 @@ proc genStubs::emitHeader {name} {
     }
     append text "\ntypedef struct ${capName}Stubs {\n"
     append text "    int magic;\n"
+    if {$epoch != ""} {
+	append text "    int epoch;\n"
+	append text "    int revision;\n"
+    }
     append text "    struct ${capName}StubHooks *hooks;\n\n"
 
     emitSlots $name text
@@ -774,6 +902,7 @@ proc genStubs::emitHeader {name} {
 
 proc genStubs::emitInit {name textVar} {
     variable hooks
+    variable epoch
     upvar $textVar text
 
     set capName [string toupper [string index $name 0]]
@@ -790,6 +919,11 @@ proc genStubs::emitInit {name textVar} {
     }
     append text "\n${capName}Stubs ${name}Stubs = \{\n"
     append text "    TCL_STUB_MAGIC,\n"
+    if {$epoch != ""} {
+	set CAPName [string toupper $name]
+	append text "    ${CAPName}_STUBS_EPOCH,\n"
+	append text "    ${CAPName}_STUBS_REVISION,\n"
+    }
     if {[info exists hooks($name)]} {
 	append text "    &${name}StubHooks,\n"
     } else {