summaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
Diffstat (limited to 'tools')
-rw-r--r--tools/genStubs.tcl52
1 files changed, 48 insertions, 4 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 81752d6..3e896a1 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.43 2010/09/13 21:17:03 nijtmans Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.44 2010/09/15 07:33:56 nijtmans Exp $
package require Tcl 8.4
@@ -42,6 +42,15 @@ namespace eval genStubs {
#
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
@@ -114,6 +123,16 @@ 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
@@ -152,12 +171,18 @@ proc genStubs::hooks {names} {
proc genStubs::declare {args} {
variable stubs
variable curName
-
- if {[llength $args] != 3} {
+ variable revision
+
+ incr revision
+ if {[llength $args] == 2} {
+ lassign $args index decl
+ set platformList generic
+ } elseif {[llength $args] == 3} {
+ lassign $args index platformList decl
+ } else {
puts stderr "wrong # args: declare $args"
return
}
- lassign $args index platformList decl
# Check for duplicate declarations, then add the declaration and
# bump the lastNum counter if necessary.
@@ -929,10 +954,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 ne ""} {
+ 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)]} {
@@ -946,6 +980,10 @@ proc genStubs::emitHeader {name} {
}
append text "\ntypedef struct ${capName}Stubs {\n"
append text " int magic;\n"
+ if {$epoch ne ""} {
+ append text " int epoch;\n"
+ append text " int revision;\n"
+ }
append text " const struct ${capName}StubHooks *hooks;\n\n"
emitSlots $name text
@@ -976,6 +1014,7 @@ proc genStubs::emitHeader {name} {
proc genStubs::emitInit {name textVar} {
variable hooks
variable interfaces
+ variable epoch
upvar $textVar text
set root 1
@@ -1005,6 +1044,11 @@ proc genStubs::emitInit {name textVar} {
append text "static "
}
append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n"
+ if {$epoch ne ""} {
+ 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 {