summaryrefslogtreecommitdiffstats
path: root/tools/genStubs.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/genStubs.tcl')
-rw-r--r--tools/genStubs.tcl151
1 files changed, 108 insertions, 43 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 464ba50..163a354 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -33,6 +33,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
@@ -94,6 +110,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
@@ -132,7 +169,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
@@ -151,13 +190,11 @@ 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]
foreach platform $platformList {
- if {$decl != ""} {
+ if {$decl ne ""} {
set stubs($curName,$platform,$index) $decl
if {![info exists stubs($curName,$platform,lastNum)] \
|| ($index > $stubs($curName,$platform,lastNum))} {
@@ -207,6 +244,7 @@ proc genStubs::rewriteFile {file text} {
}
set in [open ${file} r]
set out [open ${file}.new w]
+ fconfigure $out -translation lf
while {![eof $in]} {
set line [gets $in]
@@ -304,7 +342,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
proc genStubs::emitSlots {name textVar} {
upvar $textVar text
- forAllStubs $name makeSlot 1 text {" VOID *reserved$i;\n"}
+ forAllStubs $name makeSlot 1 text {" void (*reserved$i)(void);\n"}
return
}
@@ -332,7 +370,7 @@ proc genStubs::parseDecl {decl} {
return
}
set rtype [string trim $rtype]
- if {$args == ""} {
+ if {$args eq ""} {
return [list $rtype $fname {}]
}
foreach arg [split $args ,] {
@@ -380,14 +418,14 @@ proc genStubs::parseDecl {decl} {
proc genStubs::parseArg {arg} {
if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
- if {$arg == "void"} {
+ if {$arg eq "void"} {
return $arg
} else {
return
}
}
set result [list [string trim $type] $name]
- if {$array != ""} {
+ if {$array ne ""} {
lappend result $array
}
return $result
@@ -406,13 +444,11 @@ 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"} {
- 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]}]
@@ -420,7 +456,7 @@ proc genStubs::makeDecl {name decl index} {
append line " "
set pad 0
}
- if {$args == ""} {
+ if {$args eq ""} {
append line $fname
append text $line
append text ";\n"
@@ -428,10 +464,9 @@ 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 {
@@ -454,6 +489,9 @@ proc genStubs::makeDecl {name decl index} {
set sep ", "
}
append line ", ...)"
+ if {[lindex $args end] eq "{const char *} format"} {
+ append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
+ }
}
default {
set sep "("
@@ -477,9 +515,7 @@ proc genStubs::makeDecl {name decl index} {
append line ")"
}
}
- append text $line ";"
- format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \
- $fname $fname $text
+ return "$text$line;\n"
}
# genStubs::makeMacro --
@@ -500,12 +536,12 @@ 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 \\\n\t("
- if {$args == ""} {
+ set text "#define $fname \\\n\t("
+ if {$args eq ""} {
append text "*"
}
append text "${name}StubsPtr->$lfname)"
- append text " /* $index */\n#endif\n"
+ append text " /* $index */\n"
return $text
}
@@ -528,22 +564,18 @@ proc genStubs::makeSlot {name decl index} {
append lfname [string range $fname 1 end]
set text " "
- if {$rtype != "void"} {
- regsub -all void $rtype VOID rtype
- }
- if {$args == ""} {
+ if {$args eq ""} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
}
- if {[string range $rtype end-7 end] == "CALLBACK"} {
+ if {[string range $rtype end-7 end] eq "CALLBACK"} {
append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") "
} 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 {
@@ -557,6 +589,9 @@ proc genStubs::makeSlot {name decl index} {
set sep ", "
}
append text ", ...)"
+ if {[lindex $args end] eq "{const char *} format"} {
+ append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
+ }
}
default {
set sep "("
@@ -589,7 +624,7 @@ proc genStubs::makeSlot {name decl index} {
# Returns the formatted declaration string.
proc genStubs::makeInit {name decl index} {
- if {[lindex $decl 2] == ""} {
+ if {[lindex $decl 2] eq ""} {
append text " &" [lindex $decl 1] ", /* " $index " */\n"
} else {
append text " " [lindex $decl 1] ", /* " $index " */\n"
@@ -900,14 +935,12 @@ proc genStubs::emitMacros {name textVar} {
upvar $textVar text
set upName [string toupper $libraryName]
- append text "\n#if defined(USE_${upName}_STUBS) &&\
- !defined(USE_${upName}_STUB_PROCS)\n"
+ append text "\n#if defined(USE_${upName}_STUBS)\n"
append text "\n/*\n * Inline function declarations:\n */\n\n"
forAllStubs $name makeMacro 0 text
- append text "\n#endif /* defined(USE_${upName}_STUBS) &&\
- !defined(USE_${upName}_STUB_PROCS) */\n"
+ append text "\n#endif /* defined(USE_${upName}_STUBS) */\n"
return
}
@@ -925,10 +958,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)]} {
@@ -936,20 +978,24 @@ proc genStubs::emitHeader {name} {
foreach hook $hooks($name) {
set capHook [string toupper [string index $hook 0]]
append capHook [string range $hook 1 end]
- append text " struct ${capHook}Stubs *${hook}Stubs;\n"
+ append text " const struct ${capHook}Stubs *${hook}Stubs;\n"
}
append text "} ${capName}StubHooks;\n"
}
append text "\ntypedef struct ${capName}Stubs {\n"
append text " int magic;\n"
- append text " struct ${capName}StubHooks *hooks;\n\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
- append text "} ${capName}Stubs;\n"
+ append text "} ${capName}Stubs;\n\n"
- append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
- append text "extern ${capName}Stubs *${name}StubsPtr;\n"
+ append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+ append text "extern const ${capName}Stubs *${name}StubsPtr;\n"
append text "#ifdef __cplusplus\n}\n#endif\n"
emitMacros $name text
@@ -970,15 +1016,17 @@ proc genStubs::emitHeader {name} {
# Returns the formatted output.
proc genStubs::emitInit {name textVar} {
- variable stubs
variable hooks
+ variable interfaces
+ variable epoch
upvar $textVar text
+ set root 1
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
if {[info exists hooks($name)]} {
- append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
+ append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
set sep " "
foreach sub $hooks($name) {
append text $sep "&${sub}Stubs"
@@ -986,15 +1034,32 @@ proc genStubs::emitInit {name textVar} {
}
append text "\n\};\n"
}
- append text "\n${capName}Stubs ${name}Stubs = \{\n"
- append text " TCL_STUB_MAGIC,\n"
+ foreach intf [array names interfaces] {
+ if {[info exists hooks($intf)]} {
+ if {[lsearch -exact $hooks($intf) $name] >= 0} {
+ set root 0
+ break
+ }
+ }
+ }
+
+ append text "\n"
+ if {!$root} {
+ 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 {
- append text " NULL,\n"
+ append text " 0,\n"
}
- forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"}
+ forAllStubs $name makeInit 1 text {" 0, /* $i */\n"}
append text "\};\n"
return
generated by cgit v0.12 at 2024-07-03 09:34:47 (GMT)