From 4cdefd0f0e6e24b0189eba7244134d7981900914 Mon Sep 17 00:00:00 2001 From: nijtmans Date: Wed, 2 Dec 2009 20:45:16 +0000 Subject: tools/genStubs.tcl Add support for win32 CALLBACK functions and remove obsolete "emitStubs" and "genStubs" functions. win/Makefile.in Use tcltest86.dll for all tests, and add .PHONY rules to preemptively stop trouble that plagued Tk from hitting Tcl too. --- ChangeLog | 8 +++++ tools/genStubs.tcl | 95 ++++-------------------------------------------------- win/Makefile.in | 30 +++++++++-------- 3 files changed, 31 insertions(+), 102 deletions(-) diff --git a/ChangeLog b/ChangeLog index f6fc1b6..534d4d3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2009-12-02 Jan Nijtmans + + * tools/genStubs.tcl Add support for win32 CALLBACK functions + and remove obsolete "emitStubs" and "genStubs" functions. + * win/Makefile.in Use tcltest86.dll for all tests, and add + .PHONY rules to preemptively stop trouble that plagued Tk + from hitting Tcl too. + 2009-11-30 Jan Nijtmans * generic/tcl.h Don't use EXPORT for Tcl_InitStubs diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 7b89fe9..cfac1f6 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.32 2009/07/26 11:26:14 ferrieux Exp $ +# RCS: @(#) $Id: genStubs.tcl,v 1.33 2009/12/02 20:45:16 nijtmans Exp $ package require Tcl 8.4 @@ -503,71 +503,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 " ($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 ") (va_start(argList, " \ - $argName "), " $argName ");\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. @@ -591,8 +526,11 @@ proc genStubs::makeSlot {name decl index} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - append text $rtype " (*" $lfname ") " - + if {[string range $rtype end-7 end] == "CALLBACK"} { + append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") " + } else { + append text $rtype " (*" $lfname ") " + } set arg1 [lindex $args 0] switch -exact $arg1 { void { @@ -1008,27 +946,6 @@ proc genStubs::emitHeader {name} { return } -# genStubs::emitStubs -- -# -# This function emits the body of the 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. diff --git a/win/Makefile.in b/win/Makefile.in index 66d0110..9df2d0d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.168 2009/11/30 23:10:38 nijtmans Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.169 2009/12/02 20:45:17 nijtmans Exp $ VERSION = @TCL_VERSION@ @@ -414,7 +414,7 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) -$(TCLTEST): testMain.$(OBJEXT) ${TEST_LIB_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES) +$(TCLTEST): testMain.$(OBJEXT) ${TEST_DLL_FILE} @LIBRARIES@ $(TCL_STUB_LIB_FILE) $(CAT32) tclsh.$(RES) $(CC) $(CFLAGS) testMain.$(OBJEXT) ${TEST_LIB_FILE} $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @@ -473,18 +473,9 @@ ${REG_LIB_FILE}: ${REG_OBJS} @MAKE_LIB@ ${REG_OBJS} @POST_MAKE_LIB@ -${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TEST_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}.sav - @-$(COPY) ${TEST_LIB_FILE} ${TEST_LIB_FILE}.sav +${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} + @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${TEST_LIB_FILE} - @-$(COPY) ${TEST_LIB_FILE}.sav ${TEST_LIB_FILE} - @-$(RM) ${TEST_LIB_FILE}.sav - -${TEST_LIB_FILE}: ${TCLTEST_OBJS} - @$(RM) ${TEST_LIB_FILE} - @MAKE_LIB@ ${TCLTEST_OBJS} - @POST_MAKE_LIB@ # use pre-built zlib1.dll ${ZLIB_DLL_FILE}: $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} @@ -882,3 +873,16 @@ html-tcl: $(TCLSH) html-tk: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" +# +# The list of all the targets that do not correspond to real files. This stops +# 'make' from getting confused when someone makes an error in a rule. +# + +.PHONY: all tcltest binaries libraries doc gendate gentommath_h install +.PHONY: install-binaries install-libraries install-tzdata install-msgs +.PHONY: install-doc install-private-headers test test-tcl runtest shell +.PHONY: gdb depend cleanhelp clean distclean packages install-packages +.PHONY: test-packages clean-packages distclean-packages genstubs html +.PHONY: html-tcl html-tk + +# DO NOT DELETE THIS LINE -- make depend depends on it. -- cgit v0.12