summaryrefslogtreecommitdiffstats
path: root/tools/genStubs.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/genStubs.tcl')
-rw-r--r--tools/genStubs.tcl95
1 files changed, 6 insertions, 89 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index c2b0b27..009db07 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -242,7 +242,7 @@ proc genStubs::addPlatformGuard {plat text} {
return "#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
}
}
- return "$text"
+ return $text
}
# genStubs::emitSlots --
@@ -451,71 +451,6 @@ proc genStubs::makeMacro {name decl index} {
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 " TCL_VARARGS_DEF($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 ") TCL_VARARGS_START(" \
- $type "," $argName ",argList);\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.
@@ -538,8 +473,11 @@ proc genStubs::makeSlot {name decl index} {
if {($rtype != "void") && ($rtype != "pascal void")} {
regsub -all void $rtype VOID rtype
}
- append text $rtype " (*" $lfname ") _ANSI_ARGS_("
-
+ if {[string range $rtype end-8 end] == "__stdcall"} {
+ append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") _ANSI_ARGS_("
+ } else {
+ append text $rtype " (*" $lfname ") _ANSI_ARGS_("
+ }
regsub -all void $args VOID args
set arg1 [lindex $args 0]
switch -exact $arg1 {
@@ -823,27 +761,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.