diff options
Diffstat (limited to 'tools/genStubs.tcl')
| -rw-r--r-- | tools/genStubs.tcl | 95 |
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. |