diff options
Diffstat (limited to 'tools/genStubs.tcl')
| -rw-r--r-- | tools/genStubs.tcl | 123 |
1 files changed, 65 insertions, 58 deletions
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 163a354..37205b2 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -190,11 +190,13 @@ 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 ne ""} { + if {$decl != ""} { set stubs($curName,$platform,$index) $decl if {![info exists stubs($curName,$platform,lastNum)] \ || ($index > $stubs($curName,$platform,lastNum))} { @@ -279,18 +281,26 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { set text "" switch $plat { win { - append text "#ifdef __WIN32__ /* WIN */\n${iftxt}" + append text "#if defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " /* WIN */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__) && !defined(MAC_OSX_TCL)\ + append text "#if !defined(__WIN32__)" + if {$withCygwin} { + append text " && !defined(__CYGWIN__)" + } + append text " && !defined(MAC_OSX_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* UNIX */\n${eltxt}" @@ -312,7 +322,11 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { append text "#endif /* AQUA */\n" } x11 { - append text "#if !(defined(__WIN32__) || defined(MAC_OSX_TK))\ + append text "#if !(defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt ne ""} { append text "#else /* X11 */\n${eltxt}" @@ -342,7 +356,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { proc genStubs::emitSlots {name textVar} { upvar $textVar text - forAllStubs $name makeSlot 1 text {" void (*reserved$i)(void);\n"} + forAllStubs $name makeSlot 1 text {" VOID *reserved$i;\n"} return } @@ -370,7 +384,7 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] - if {$args eq ""} { + if {$args == ""} { return [list $rtype $fname {}] } foreach arg [split $args ,] { @@ -418,14 +432,14 @@ proc genStubs::parseDecl {decl} { proc genStubs::parseArg {arg} { if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { - if {$arg eq "void"} { + if {$arg == "void"} { return $arg } else { return } } set result [list [string trim $type] $name] - if {$array ne ""} { + if {$array != ""} { lappend result $array } return $result @@ -448,6 +462,9 @@ proc genStubs::makeDecl {name decl index} { lassign $decl rtype fname args append text "/* $index */\n" + if {$rtype != "void"} { + regsub -all void $rtype VOID rtype + } set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] @@ -464,9 +481,10 @@ 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 { @@ -489,9 +507,6 @@ 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 "(" @@ -515,7 +530,9 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - return "$text$line;\n" + append text $line ";" + format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \ + $fname $fname $text } # genStubs::makeMacro -- @@ -536,12 +553,12 @@ proc genStubs::makeMacro {name decl index} { set lfname [string tolower [string index $fname 0]] append lfname [string range $fname 1 end] - set text "#define $fname \\\n\t(" - if {$args eq ""} { + set text "#ifndef $fname\n#define $fname \\\n\t(" + if {$args == ""} { append text "*" } append text "${name}StubsPtr->$lfname)" - append text " /* $index */\n" + append text " /* $index */\n#endif\n" return $text } @@ -564,18 +581,22 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " - if {$args eq ""} { + if {$args == ""} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - if {[string range $rtype end-7 end] eq "CALLBACK"} { - append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") " + if {$rtype ne "void"} { + regsub -all void $rtype VOID rtype + } + if {[string range $rtype end-8 end] == "__stdcall"} { + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $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 { @@ -589,9 +610,6 @@ 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 "(" @@ -624,7 +642,7 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] eq ""} { + if {[lindex $decl 2] == ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" @@ -799,7 +817,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar eval {append temp} $skipString } } - append text [addPlatformGuard $plat $temp] + append text [addPlatformGuard $plat $temp {} true] } ## win ## if {$block(win)} { @@ -813,10 +831,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar eval {append temp} $skipString } } - append text [addPlatformGuard $plat $temp] + append text [addPlatformGuard $plat $temp {} true] } ## macosx ## - if {$block(macosx) && !$block(aqua) && !$block(x11)} { + if {($block(unix) || $block(macosx)) && !$block(aqua) && !$block(x11)} { set temp {} set lastNum -1 foreach plat {unix macosx} { @@ -885,7 +903,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar } else { eval {set etxt} $skipString append temp [addPlatformGuard $plat [$slotProc \ - $name $stubs($name,$plat,$i) $i] $etxt] + $name $stubs($name,$plat,$i) $i] $etxt true] } set emit 1 break @@ -895,7 +913,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar eval {append temp} $skipString } } - append text [addPlatformGuard x11 $temp] + append text [addPlatformGuard x11 $temp {} true] } } } @@ -935,12 +953,14 @@ proc genStubs::emitMacros {name textVar} { upvar $textVar text set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS)\n" + append text "\n#if defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" forAllStubs $name makeMacro 0 text - append text "\n#endif /* defined(USE_${upName}_STUBS) */\n" + append text "\n#endif /* defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS) */\n" return } @@ -964,13 +984,15 @@ proc genStubs::emitHeader {name} { set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] - if {$epoch ne ""} { + 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" } + append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + emitDeclarations $name text if {[info exists hooks($name)]} { @@ -978,24 +1000,23 @@ 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 " const struct ${capHook}Stubs *${hook}Stubs;\n" + append text " struct ${capHook}Stubs *${hook}Stubs;\n" } append text "} ${capName}StubHooks;\n" } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" - if {$epoch ne ""} { + if {$epoch != ""} { append text " int epoch;\n" append text " int revision;\n" } - append text " const struct ${capName}StubHooks *hooks;\n\n" + append text " struct ${capName}StubHooks *hooks;\n\n" emitSlots $name text append text "} ${capName}Stubs;\n\n" - append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" - append text "extern const ${capName}Stubs *${name}StubsPtr;\n" + append text "extern ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text @@ -1017,16 +1038,14 @@ proc genStubs::emitHeader {name} { proc genStubs::emitInit {name textVar} { 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 const ${capName}StubHooks ${name}StubHooks = \{\n" + append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" @@ -1034,21 +1053,9 @@ proc genStubs::emitInit {name textVar} { } append text "\n\};\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 ""} { + 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" @@ -1056,10 +1063,10 @@ proc genStubs::emitInit {name textVar} { if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { - append text " 0,\n" + append text " NULL,\n" } - forAllStubs $name makeInit 1 text {" 0, /* $i */\n"} + forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} append text "\};\n" return |
