* Re: FW: Can't build Insight with Cygwin
[not found] <200512231852.jBNIq9cM007525@mx1.redhat.com>
@ 2005-12-23 23:19 ` Keith Seitz
2005-12-24 0:55 ` Peter Rockett
2005-12-24 18:00 ` Spen
0 siblings, 2 replies; 12+ messages in thread
From: Keith Seitz @ 2005-12-23 23:19 UTC (permalink / raw)
To: Spen; +Cc: p.rockett, 'insight'
Spen wrote:
> I have built 6.4 both from the tar.gz release and cvs head
I updated my cygwin box to latest:
CYGWIN_NT-5.0 cocoa 1.5.18(0.132/4/2) 2005-07-02 20:30 i686 unknown
unknown Cygwin
and gcc version 3.4.4 (cygming special) (gdc 0.12, using dmd 0.125).
I saw the DLL problem which Dave Korn's patch fixed. This fixed
everything. [Of course, gdb (not insight) segfaults on me in about three
seconds flag -- try debugging gdb.exe on gdb.exe. Break in main. Try
stepping into the "return gdb_main (&args);" part. It crashes in
handle_inferior_event.]
So, yes, there must be some sort of weird build dependency that neither
Spen nor I are seeing.
Spen, are you using Win2k, WinNT, or WinXP? Like I mentioned before, I
only have Win2k.
Keith
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 23:19 ` FW: Can't build Insight with Cygwin Keith Seitz
@ 2005-12-24 0:55 ` Peter Rockett
2005-12-24 18:00 ` Spen
1 sibling, 0 replies; 12+ messages in thread
From: Peter Rockett @ 2005-12-24 0:55 UTC (permalink / raw)
To: 'insight'
I am using WinXP(SP2).
Keith, Not sure what you mean about the segmentation fault - I can't get
Insight to build at all (although I can get gdb to build fine as a
standalone). I did try installing autoconf and automake since configure
looks for these - but it made only a minor difference in that a few things
(that hadn't previously been flagged as errors) got 'resolved'. So I'm no
nearer.
I would be curious to know what Spen has installed under cygwin - Spen, any
chance of posting a directory listing of /cygwin/bin? Maybe there's
something there that I have missed?
Peter
> -----Original Message-----
> From: Keith Seitz [mailto:keiths@redhat.com]
> Sent: 23 December 2005 21:47
> To: Spen
> Cc: p.rockett@sheffield.ac.uk; 'insight'
> Subject: Re: FW: Can't build Insight with Cygwin
>
>
> Spen wrote:
> > I have built 6.4 both from the tar.gz release and cvs head
>
> I updated my cygwin box to latest:
>
> CYGWIN_NT-5.0 cocoa 1.5.18(0.132/4/2) 2005-07-02 20:30 i686 unknown
> unknown Cygwin
>
> and gcc version 3.4.4 (cygming special) (gdc 0.12, using dmd 0.125).
>
> I saw the DLL problem which Dave Korn's patch fixed. This fixed
> everything. [Of course, gdb (not insight) segfaults on me in
> about three
> seconds flag -- try debugging gdb.exe on gdb.exe. Break in main. Try
> stepping into the "return gdb_main (&args);" part. It crashes in
> handle_inferior_event.]
>
> So, yes, there must be some sort of weird build dependency
> that neither
> Spen nor I are seeing.
>
> Spen, are you using Win2k, WinNT, or WinXP? Like I mentioned
> before, I
> only have Win2k.
>
> Keith
>
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 23:19 ` FW: Can't build Insight with Cygwin Keith Seitz
2005-12-24 0:55 ` Peter Rockett
@ 2005-12-24 18:00 ` Spen
1 sibling, 0 replies; 12+ messages in thread
From: Spen @ 2005-12-24 18:00 UTC (permalink / raw)
To: 'Keith Seitz'; +Cc: p.rockett, 'insight'
[-- Attachment #1: Type: text/plain, Size: 1337 bytes --]
I am using winxp sp2 (laptop) and win2000 (desktop) - builds ok on both.
Attached is a dir listing from my laptop and the build log which I record
for every build.
Configure-Build options:
${INSIGHT}/configure --target=${TARGET} --prefix=${OUTPUTDIR}
--enable-interwork --enable-multilib --disable-nls --disable-win32-registry
make all install 2>&1 | tee make.log
Regards
Spen
-----Original Message-----
From: Keith Seitz [mailto:keiths@redhat.com]
Sent: 23 December 2005 21:47
To: Spen
Cc: p.rockett@sheffield.ac.uk; 'insight'
Subject: Re: FW: Can't build Insight with Cygwin
Spen wrote:
> I have built 6.4 both from the tar.gz release and cvs head
I updated my cygwin box to latest:
CYGWIN_NT-5.0 cocoa 1.5.18(0.132/4/2) 2005-07-02 20:30 i686 unknown unknown
Cygwin
and gcc version 3.4.4 (cygming special) (gdc 0.12, using dmd 0.125).
I saw the DLL problem which Dave Korn's patch fixed. This fixed everything.
[Of course, gdb (not insight) segfaults on me in about three seconds flag --
try debugging gdb.exe on gdb.exe. Break in main. Try stepping into the
"return gdb_main (&args);" part. It crashes in handle_inferior_event.]
So, yes, there must be some sort of weird build dependency that neither Spen
nor I are seeing.
Spen, are you using Win2k, WinNT, or WinXP? Like I mentioned before, I only
have Win2k.
Keith
[-- Attachment #2: dir.rar --]
[-- Type: application/octet-stream, Size: 37405 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FW: Can't build Insight with Cygwin
2005-12-23 21:41 ` Peter Rockett
@ 2005-12-24 14:00 ` Keith Seitz
0 siblings, 0 replies; 12+ messages in thread
From: Keith Seitz @ 2005-12-24 14:00 UTC (permalink / raw)
To: p.rockett; +Cc: 'insight'
Peter Rockett wrote:
> Can anybody confirm that they have definitely built Insight 6.4 with the
> latest cygwin tools (gcc v3.4.4)?
In case it gets lost, I have definitely built Cygwin native on Win2k
using latest (this AM) cygwin & gcc (using the patches mentioned
earlier. Now onto your other problem...
> undefined reference to `_cp_demangled_name_to_comp'
> undefined reference to `_cp_comp_to_string'
Both are from cp-names.y and declared in cp-support.h.
> undefined reference to `_objc_parse'
> undefined reference to `_objc_error'
> undefined reference to `_c_error'
All from in c-exp.y and declared in objc_lang.h and c_lang.h.
> undefined reference to `_ada_parse'
From ada-exp.y and ada-lang.h.
Do you have yacc or bison installed? Do the files
BUILDDIR/gdb/{ada,c,cp,jv}-exp.c exist? Are build errors around this?
[Try removing those C files from the build dir and then make again.]
Keith
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
[not found] <cmu-lmtpd-20522-1135363936-1@impala>
@ 2005-12-23 22:58 ` Peter Rockett
0 siblings, 0 replies; 12+ messages in thread
From: Peter Rockett @ 2005-12-23 22:58 UTC (permalink / raw)
To: 'insight'
Spen
Is that with gcc 3.4.4 (the latest gcc version)? If so then I guess there
must be some very odd dependency somewhere that is not flagged by the
build...
Peter
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of Spen
> Sent: 23 December 2005 18:57
> To: p.rockett@sheffield.ac.uk; 'insight'
> Subject: RE: FW: Can't build Insight with Cygwin
>
>
> I have built 6.4 both from the tar.gz release and cvs head
>
> Regards
> Spen
>
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of Peter Rockett
> Sent: 23 December 2005 16:25
> To: 'insight'
> Subject: RE: FW: Can't build Insight with Cygwin
>
> Spen
>
> Thanks but I have already run this one down. Is it definitely
> Insight 6.4 you have built (and not any earlier version)?
>
> Peter
>
>
> > -----Original Message-----
> > From: insight-owner@sourceware.org
> > [mailto:insight-owner@sourceware.org] On Behalf Of Spen
> > Sent: 23 December 2005 16:22
> > To: wilfried.fauvel@laposte.net; 'insight'
> > Subject: RE: FW: Can't build Insight with Cygwin
> >
> >
> > Just to let you know that it does build under cygwin. I
> only make one
> > patch to enable building under the follow config.
> >
> > Cygwin: 1.5.18
> > GCC 3.4.4
> >
> > The patch can be found here:
> > http://sourceware.org/ml/insight/2005-q3/msg00021.html
> >
> > I did run into one build problem after updating other
> cygwin pakages,
> > reinstalling gcc fixed the problems, could be with a try.
> >
> > Regards
> > Spen
> >
> > -----Original Message-----
> > From: insight-owner@sourceware.org
> > [mailto:insight-owner@sourceware.org] On Behalf Of
> > wilfried.fauvel@laposte.net
> > Sent: 23 December 2005 13:38
> > To: insight
> > Subject: Re:FW: Can't build Insight with Cygwin
> >
> > Hi,
> >
> > I think you can use the patch command
> > (http://www.gnu.org/software/patch/patch.html) with the
> .diff file, I
> > have made it manually : you only have to open the three
> files listed
> > ("RCS
> > file:") in the .diff file, and replace the - lines by the +
> lines at
> > the corresponding patterns. I have tested to build on
> another config
> > (with the same cygwin version :
> > 1.5.18(0.132/4/2), and the same sources), and it seems to
> crash still
> > ...
> >
> > Good luck.
> >
> > > Hi
> > >
> > > Thanks, Wilfred! This at least confirms my view that there did not
> > > seem to be any regular way this source could build. If I read it
> > > right, Dave Korn has confirmed that the Win32Dll.c code
> > relies on an
> > > idiosyncrasy of an earlier version of gcc. Wilfred, can you post a
> > > patch? I have read Dave Korn's fix but as I have always
> studiously
> > > avoided assembler I just don't understand what to do to
> > implement it!
> > >
> > > BTW: Keith, I have used the latest cygwin download which
> I think is
> > > gcc 3.4... (see Dave Korn's post). I am interested in
> Insight under
> > > Windows because I have used MSVC in the past (great
> debugger!) but
> > > want to migrate to gnu for cross-platform reasons.
> There's a lot of
> > > IDEs available for gcc but debugging support is generally
> > poor. Hence the
> > interest in Insight.
> > > Keith, I guess the cygwin compiler on your Win2K box is an old
> > > version...
> > >
> > > Finally, I tried building with mingw 3.4.4 and the
> offending section
> > > in tcl/win seems to build OK!! But mingw breaks on the ./bfd
> > sub-directory.
> > > Output below. Any ideas on this one? This looks like something has
> > > coughed in the make file - again, I've studiously avoided
> > using make...
> > >
> > >
> > > Peter
> > >
> > >
> >
> ######################################################################
> > > ######
> > > #############################
> > > >
> > > > make[2]: Entering directory `/c/insight-6.4/bfd'
> > > > Making info in doc
> > > > make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> > > > restore=: && backupdir=".am$$" && \ am__cwd=`pwd` && cd
> > > > ../.././bfd/doc && \ rm -rf
> > $backupdir && mkdir
> > > > $backupdir && \ for f in ../.././bfd/doc/bfd.info
> > > > ../.././bfd/doc/bfd.info-[0-9]
> ../.././bfd/doc/bfd.info-[0-9][0-9]
> > > > ../.././bfd/doc/bfd.i[0-9]
> > ../.././bfd/doc/bfd.i[0-9][0-9]; do \ if
> > > > test -f $f; then mv $f $backupdir; restore=mv; else :;
> > fi; \ done; \
> > > > cd "$am__cwd"; \ if makeinfo --split-size=5000000
> > > > --split-size=5000000 -I ../.././bfd/doc \ -o
> > > > ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \
> > then \ rc=0;
> > > > \ cd ../.././bfd/doc; \ else \ rc=$?; \ cd ../.././bfd/doc && \
> > > > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" | sed
> > > > 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc section
> > > > mapping'.ss reference to nonexistent node `mmo a New Hash Table
> > > > Type'.ference to nonexistent node `Deriving
> > > > makeinfo: Removing output file
> `../.././bfd/doc/bfd.info' due to
> > > > errors; use --force to preserve.
> > > > make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> > > > make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> > > > make[2]: *** [info-recursive] Error 1
> > > > make[2]: Leaving directory `/c/insight-6.4/bfd'
> > > > make[1]: *** [all-bfd] Error 2
> > > > make[1]: Leaving directory `/c/insight-6.4'
> > > > make: *** [all] Error 2
> > > >
> > >
> >
> > Accédez au courrier électronique de La Poste :
> > www.laposte.net ; Jusqu'au 25 décembre, participez au grand jeu du
> > Calendrier de l'Avent et
> > gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu !
> >
> >
> >
> >
> >
>
>
>
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 18:52 ` Peter Rockett
2005-12-23 21:41 ` Peter Rockett
@ 2005-12-23 21:47 ` Spen
1 sibling, 0 replies; 12+ messages in thread
From: Spen @ 2005-12-23 21:47 UTC (permalink / raw)
To: p.rockett, 'insight'
I have built 6.4 both from the tar.gz release and cvs head
Regards
Spen
-----Original Message-----
From: insight-owner@sourceware.org [mailto:insight-owner@sourceware.org] On
Behalf Of Peter Rockett
Sent: 23 December 2005 16:25
To: 'insight'
Subject: RE: FW: Can't build Insight with Cygwin
Spen
Thanks but I have already run this one down. Is it definitely Insight 6.4
you have built (and not any earlier version)?
Peter
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of Spen
> Sent: 23 December 2005 16:22
> To: wilfried.fauvel@laposte.net; 'insight'
> Subject: RE: FW: Can't build Insight with Cygwin
>
>
> Just to let you know that it does build under cygwin. I only make one
> patch to enable building under the follow config.
>
> Cygwin: 1.5.18
> GCC 3.4.4
>
> The patch can be found here:
> http://sourceware.org/ml/insight/2005-q3/msg00021.html
>
> I did run into one build problem after updating other cygwin pakages,
> reinstalling gcc fixed the problems, could be with a try.
>
> Regards
> Spen
>
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of
> wilfried.fauvel@laposte.net
> Sent: 23 December 2005 13:38
> To: insight
> Subject: Re:FW: Can't build Insight with Cygwin
>
> Hi,
>
> I think you can use the patch command
> (http://www.gnu.org/software/patch/patch.html) with the .diff file, I
> have made it manually : you only have to open the three files listed
> ("RCS
> file:") in the .diff file, and replace the - lines by the + lines at
> the corresponding patterns. I have tested to build on another config
> (with the same cygwin version :
> 1.5.18(0.132/4/2), and the same sources), and it seems to crash still
> ...
>
> Good luck.
>
> > Hi
> >
> > Thanks, Wilfred! This at least confirms my view that there did not
> > seem to be any regular way this source could build. If I read it
> > right, Dave Korn has confirmed that the Win32Dll.c code
> relies on an
> > idiosyncrasy of an earlier version of gcc. Wilfred, can you post a
> > patch? I have read Dave Korn's fix but as I have always studiously
> > avoided assembler I just don't understand what to do to
> implement it!
> >
> > BTW: Keith, I have used the latest cygwin download which I think is
> > gcc 3.4... (see Dave Korn's post). I am interested in Insight under
> > Windows because I have used MSVC in the past (great debugger!) but
> > want to migrate to gnu for cross-platform reasons. There's a lot of
> > IDEs available for gcc but debugging support is generally
> poor. Hence the
> interest in Insight.
> > Keith, I guess the cygwin compiler on your Win2K box is an old
> > version...
> >
> > Finally, I tried building with mingw 3.4.4 and the offending section
> > in tcl/win seems to build OK!! But mingw breaks on the ./bfd
> sub-directory.
> > Output below. Any ideas on this one? This looks like something has
> > coughed in the make file - again, I've studiously avoided
> using make...
> >
> >
> > Peter
> >
> >
> ######################################################################
> > ######
> > #############################
> > >
> > > make[2]: Entering directory `/c/insight-6.4/bfd'
> > > Making info in doc
> > > make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> > > restore=: && backupdir=".am$$" && \ am__cwd=`pwd` && cd
> > > ../.././bfd/doc && \ rm -rf
> $backupdir && mkdir
> > > $backupdir && \ for f in ../.././bfd/doc/bfd.info
> > > ../.././bfd/doc/bfd.info-[0-9] ../.././bfd/doc/bfd.info-[0-9][0-9]
> > > ../.././bfd/doc/bfd.i[0-9]
> ../.././bfd/doc/bfd.i[0-9][0-9]; do \ if
> > > test -f $f; then mv $f $backupdir; restore=mv; else :;
> fi; \ done; \
> > > cd "$am__cwd"; \ if makeinfo --split-size=5000000
> > > --split-size=5000000 -I ../.././bfd/doc \ -o
> > > ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \
> then \ rc=0;
> > > \ cd ../.././bfd/doc; \ else \ rc=$?; \ cd ../.././bfd/doc && \
> > > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" | sed
> > > 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc section
> > > mapping'.ss reference to nonexistent node `mmo a New Hash Table
> > > Type'.ference to nonexistent node `Deriving
> > > makeinfo: Removing output file `../.././bfd/doc/bfd.info' due to
> > > errors; use --force to preserve.
> > > make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> > > make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> > > make[2]: *** [info-recursive] Error 1
> > > make[2]: Leaving directory `/c/insight-6.4/bfd'
> > > make[1]: *** [all-bfd] Error 2
> > > make[1]: Leaving directory `/c/insight-6.4'
> > > make: *** [all] Error 2
> > >
> >
>
> Accédez au courrier électronique de La Poste :
> www.laposte.net ; Jusqu'au 25 décembre, participez au grand jeu du
> Calendrier de l'Avent et
> gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu !
>
>
>
>
>
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 18:52 ` Peter Rockett
@ 2005-12-23 21:41 ` Peter Rockett
2005-12-24 14:00 ` Keith Seitz
2005-12-23 21:47 ` Spen
1 sibling, 1 reply; 12+ messages in thread
From: Peter Rockett @ 2005-12-23 21:41 UTC (permalink / raw)
To: 'insight'
Now then! The story so far...
I have managed (with help) to fix a couple of issues in /tcl/win - see
earlier post. My problem then was that the build broke in /gdb. So I
downloaded gdb 6.4 from the gdb website and lo and behold, it builds, no
problems!!! Same toolset - I haven't changed anything. I have even diffed
the files in the two sources that give problems and (no surprises)they are
identical. Which only leaves me side-effects in the build process, I think.
Completely stumped on this one! Any suggestions where I go from here?
Can anybody confirm that they have definitely built Insight 6.4 with the
latest cygwin tools (gcc v3.4.4)? If there's an existence proof out there,
maybe there is something missing from my cygwin setup that don't cause
configure/make to bomb-out but turn-out to be critical somewhere down the
track. (Earlier I noticed that I needed bison and flex at some point which I
hadn't downloaded.)
For the record, below is the latest log of woe from trying to build in /gdb.
Peter
############################################################################
#################################
$ make
Making init.c
mv: overwrite `init.c', overriding mode 0644? y
gcc -c -g -O2 -I. -I. -I./config
-DLOCALEDIR="\"/usr/local/share/locale\"" -D
HAVE_CONFIG_H -I./../include/opcode -I./../readline/.. -I../bfd -I./../bfd
-I./.
./include -I../intl -I./../intl -DMI_OUT=1 -DGDBTK -Wimplicit -Wreturn-type
-Wc
omment -Wtrigraphs -Wformat -Wparentheses -Wpointer-arith
-Wformat-nonliteral -W
unused-label -Wunused-function -Wuninitialized init.c
rm -f libgdb.a
ar q libgdb.a i386-tdep.o i386-cygwin-tdep.o i387-tdep.o ser-base.o
ser-unix.o s
er-pipe.o ser-tcp.o i386-nat.o win32-nat.o corelow.o remote.o dcache.o
remote-ut
ils.o tracepoint.o ax-general.o ax-gdb.o remote-fileio.o cli-dump.o
cli-decode.
o cli-script.o cli-cmds.o cli-setshow.o cli-utils.o cli-logging.o
cli-interp.o m
i-out.o mi-console.o mi-cmds.o mi-cmd-env.o mi-cmd-var.o mi-cmd-break.o
mi-cmd-s
tack.o mi-cmd-file.o mi-cmd-disas.o mi-symbol-cmds.o mi-interp.o mi-main.o
mi-pa
rse.o mi-getopt.o mi-common.o gdbtk.o gdbtk-bp.o gdbtk-cmds.o gdbtk-hooks.o
gdbt
k-interp.o gdbtk-register.o gdbtk-stack.o gdbtk-varobj.o gdbtk-wrapper.o
gdbres.
o c-exp.o cp-name-parser.o objc-exp.o ada-exp.o jv-exp.o f-exp.o m2-exp.o
p-exp.
o version.o annotate.o auxv.o bfd-target.o blockframe.o breakpoint.o
findvar.o r
egcache.o charset.o disasm.o dummy-frame.o source.o value.o eval.o valops.o
vala
rith.o valprint.o printcmd.o block.o symtab.o symfile.o symmisc.o linespec.o
dic
tionary.o infcall.o infcmd.o infrun.o expprint.o environ.o stack.o thread.o
exce
ptions.o inf-child.o interps.o main.o macrotab.o macrocmd.o macroexp.o
macroscop
e.o event-loop.o event-top.o inf-loop.o completer.o gdbarch.o arch-utils.o
gdbty
pes.o osabi.o copying.o memattr.o mem-break.o target.o parse.o language.o
builds
ym.o std-regs.o signals.o kod.o kod-cisco.o gdb-events.o exec.o bcache.o
objfile
s.o observer.o minsyms.o maint.o demangle.o dbxread.o coffread.o
coff-pe-read.o
elfread.o dwarfread.o dwarf2read.o mipsread.o stabsread.o corefile.o
dwarf2expr.
o dwarf2loc.o dwarf2-frame.o ada-lang.o c-lang.o f-lang.o objc-lang.o
ui-out.o c
li-out.o varobj.o wrapper.o jv-lang.o jv-valprint.o jv-typeprint.o m2-lang.o
p-l
ang.o p-typeprint.o p-valprint.o scm-exp.o scm-lang.o scm-valprint.o
sentinel-fr
ame.o complaints.o typeprint.o ada-typeprint.o c-typeprint.o f-typeprint.o
m2-ty
peprint.o ada-valprint.o c-valprint.o cp-valprint.o f-valprint.o
m2-valprint.o n
lmread.o serial.o mdebugread.o top.o utils.o ui-file.o user-regs.o frame.o
frame
-unwind.o doublest.o frame-base.o gnu-v2-abi.o gnu-v3-abi.o hpacc-abi.o
cp-abi.o
cp-support.o cp-namespace.o reggroups.o regset.o trad-frame.o tramp-frame.o
sol
ib.o solib-null.o inflow.o init.o
ar: creating libgdb.a
ranlib libgdb.a
rm -f gdb.exe
gcc -g -O2 -Wl,--subsystem,console \
-o gdb.exe gdb.o libgdb.a \
../readline/libreadline.a ../opcodes/libopcodes.a ../bfd/libbfd.a
..
/libiberty/libiberty.a ../libgui/src/libgui.a
-L/cygdrive/c/insight-6.4/itcl/
itcl -litcl32 -L/cygdrive/c/insight-6.4/itcl/itk -litk32
-L/cygdrive/c/insight-6
.4/tk/win -ltk84 -L/cygdrive/c/insight-6.4/tcl/win -ltcl84 -lgdi32
-lcomdlg32
-limm32 -lcomctl32 -lshell32 -ltermcap -lm -liconv ../libiberty/libiberty.a
-lu
ser32 -limagehlp -lshell32 -lgdi32 -lcomdlg32 -ladvapi32
libgdb.a(cp-support.o): In function `cp_canonicalize_string':
/cygdrive/c/insight-6.4/gdb/cp-support.c:90: undefined reference to
`_cp_demangl
ed_name_to_comp'
/cygdrive/c/insight-6.4/gdb/cp-support.c:94: undefined reference to
`_cp_comp_to
_string'
libgdb.a(cp-support.o): In function `mangled_name_to_comp':
/cygdrive/c/insight-6.4/gdb/cp-support.c:133: undefined reference to
`_cp_demang
led_name_to_comp'
libgdb.a(cp-support.o): In function `cp_class_name_from_physname':
/cygdrive/c/insight-6.4/gdb/cp-support.c:223: undefined reference to
`_cp_comp_t
o_string'
libgdb.a(cp-support.o): In function `method_name_from_physname':
/cygdrive/c/insight-6.4/gdb/cp-support.c:309: undefined reference to
`_cp_comp_t
o_string'
libgdb.a(cp-support.o): In function `cp_func_name':
/cygdrive/c/insight-6.4/gdb/cp-support.c:331: undefined reference to
`_cp_demang
led_name_to_comp'
/cygdrive/c/insight-6.4/gdb/cp-support.c:339: undefined reference to
`_cp_comp_t
o_string'
libgdb.a(cp-support.o): In function `overload_list_add_symbol':
/cygdrive/c/insight-6.4/gdb/cp-support.c:360: undefined reference to
`_cp_demang
led_name_to_comp'
/cygdrive/c/insight-6.4/gdb/cp-support.c:384: undefined reference to
`_cp_comp_t
o_string'
libgdb.a(scm-lang.o): In function `scm_printstr':
/cygdrive/c/insight-6.4/gdb/scm-lang.c:56: undefined reference to `_c_error'
libgdb.a(objc-lang.o): In function `lookup_struct_typedef':
/cygdrive/c/insight-6.4/gdb/objc-lang.c:99: undefined reference to
`_objc_parse'
/cygdrive/c/insight-6.4/gdb/objc-lang.c:102: undefined reference to
`_objc_error
'
libgdb.a(c-lang.o): In function `c_preprocess_and_parse':
/cygdrive/c/insight-6.4/gdb/c-lang.c:472: undefined reference to `_c_parse'
libgdb.a(c-lang.o): In function `c_emit_char':
/cygdrive/c/insight-6.4/gdb/c-lang.c:71: undefined reference to `_c_error'
/cygdrive/c/insight-6.4/gdb/c-lang.c:71: undefined reference to `_c_error'
libgdb.a(c-lang.o): In function `c_printchar':
/cygdrive/c/insight-6.4/gdb/c-lang.c:79: undefined reference to `_c_error'
libgdb.a(c-lang.o): In function `c_printstr':
/cygdrive/c/insight-6.4/gdb/c-lang.c:132: undefined reference to `_c_error'
libgdb.a(ada-lang.o): In function `parse':
/cygdrive/c/insight-6.4/gdb/ada-lang.c:8736: undefined reference to
`_ada_parse'
libgdb.a(ada-lang.o): In function `ada_print_array_index':
/cygdrive/c/insight-6.4/gdb/ada-lang.c:313: undefined reference to
`_ada_error'
collect2: ld returned 1 exit status
make: *** [gdb.exe] Error 1
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
[not found] <cmu-lmtpd-21756-1135354673-4@impala>
@ 2005-12-23 18:52 ` Peter Rockett
2005-12-23 21:41 ` Peter Rockett
2005-12-23 21:47 ` Spen
0 siblings, 2 replies; 12+ messages in thread
From: Peter Rockett @ 2005-12-23 18:52 UTC (permalink / raw)
To: 'insight'
Spen
Thanks but I have already run this one down. Is it definitely Insight 6.4
you have built (and not any earlier version)?
Peter
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of Spen
> Sent: 23 December 2005 16:22
> To: wilfried.fauvel@laposte.net; 'insight'
> Subject: RE: FW: Can't build Insight with Cygwin
>
>
> Just to let you know that it does build under cygwin. I only
> make one patch to enable building under the follow config.
>
> Cygwin: 1.5.18
> GCC 3.4.4
>
> The patch can be found here:
> http://sourceware.org/ml/insight/2005-q3/msg00021.html
>
> I did run into one build problem after updating other cygwin
> pakages, reinstalling gcc fixed the problems, could be with a try.
>
> Regards
> Spen
>
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of
> wilfried.fauvel@laposte.net
> Sent: 23 December 2005 13:38
> To: insight
> Subject: Re:FW: Can't build Insight with Cygwin
>
> Hi,
>
> I think you can use the patch command
> (http://www.gnu.org/software/patch/patch.html) with the .diff
> file, I have made it manually : you only have to open the
> three files listed ("RCS
> file:") in the .diff file, and replace the - lines by the +
> lines at the corresponding patterns. I have tested to build
> on another config (with the same cygwin version :
> 1.5.18(0.132/4/2), and the same sources), and it seems to
> crash still ...
>
> Good luck.
>
> > Hi
> >
> > Thanks, Wilfred! This at least confirms my view that there did not
> > seem to be any regular way this source could build. If I read it
> > right, Dave Korn has confirmed that the Win32Dll.c code
> relies on an
> > idiosyncrasy of an earlier version of gcc. Wilfred, can you post a
> > patch? I have read Dave Korn's fix but as I have always studiously
> > avoided assembler I just don't understand what to do to
> implement it!
> >
> > BTW: Keith, I have used the latest cygwin download which I think is
> > gcc 3.4... (see Dave Korn's post). I am interested in Insight under
> > Windows because I have used MSVC in the past (great debugger!) but
> > want to migrate to gnu for cross-platform reasons. There's a lot of
> > IDEs available for gcc but debugging support is generally
> poor. Hence the
> interest in Insight.
> > Keith, I guess the cygwin compiler on your Win2K box is an old
> > version...
> >
> > Finally, I tried building with mingw 3.4.4 and the offending section
> > in tcl/win seems to build OK!! But mingw breaks on the ./bfd
> sub-directory.
> > Output below. Any ideas on this one? This looks like something has
> > coughed in the make file - again, I've studiously avoided
> using make...
> >
> >
> > Peter
> >
> >
> ######################################################################
> > ######
> > #############################
> > >
> > > make[2]: Entering directory `/c/insight-6.4/bfd'
> > > Making info in doc
> > > make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> > > restore=: && backupdir=".am$$" && \
> > > am__cwd=`pwd` && cd ../.././bfd/doc && \ rm -rf
> $backupdir && mkdir
> > > $backupdir && \ for f in ../.././bfd/doc/bfd.info
> > > ../.././bfd/doc/bfd.info-[0-9] ../.././bfd/doc/bfd.info-[0-9][0-9]
> > > ../.././bfd/doc/bfd.i[0-9]
> ../.././bfd/doc/bfd.i[0-9][0-9]; do \ if
> > > test -f $f; then mv $f $backupdir; restore=mv; else :;
> fi; \ done; \
> > > cd "$am__cwd"; \ if makeinfo --split-size=5000000
> > > --split-size=5000000 -I ../.././bfd/doc \ -o
> > > ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \
> then \ rc=0;
> > > \ cd ../.././bfd/doc; \ else \ rc=$?; \ cd ../.././bfd/doc && \
> > > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" | sed
> > > 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc section
> > > mapping'.ss reference to nonexistent node `mmo a New Hash Table
> > > Type'.ference to nonexistent node `Deriving
> > > makeinfo: Removing output file `../.././bfd/doc/bfd.info' due to
> > > errors; use --force to preserve.
> > > make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> > > make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> > > make[2]: *** [info-recursive] Error 1
> > > make[2]: Leaving directory `/c/insight-6.4/bfd'
> > > make[1]: *** [all-bfd] Error 2
> > > make[1]: Leaving directory `/c/insight-6.4'
> > > make: *** [all] Error 2
> > >
> >
>
> Accédez au courrier électronique de La Poste :
> www.laposte.net ; Jusqu'au 25 décembre, participez au grand
> jeu du Calendrier de l'Avent et
> gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu !
>
>
>
>
>
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: FW: Can't build Insight with Cygwin
[not found] <200512231618.jBNGI4BD085002@mail.cso.atmel.com>
@ 2005-12-23 18:10 ` Eric Weddington
0 siblings, 0 replies; 12+ messages in thread
From: Eric Weddington @ 2005-12-23 18:10 UTC (permalink / raw)
To: Spen; +Cc: wilfried.fauvel, 'insight'
Spen wrote:
> Just to let you know that it does build under cygwin. I only make one patch
> to enable building under the follow config.
>
> Cygwin: 1.5.18
> GCC 3.4.4
>
> The patch can be found here:
> http://sourceware.org/ml/insight/2005-q3/msg00021.html
>
> I did run into one build problem after updating other cygwin pakages,
> reinstalling gcc fixed the problems, could be with a try.
>
Thanks for pointing out that patch.
Sorry to go slightly off topic here...
I'm going to be building the latest version of Insight for the AVR
target. I have done this before on a semi-regular basis, but it's been
awhile. I would much rather build Insight on MinGW, but I don't know if
that is possible yet. Are patches still required to do this? Does anyone
have a set of patches to do this?
Alternatively, if it can't been done on MinGW, then I will have to fall
back to building on Cygwin again, so I appreciate everyone's input on
this thread and the link to the patch above.
Thanks
--
Eric Weddington
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 16:17 wilfried.fauvel
2005-12-23 16:21 ` FW: " Peter Rockett
@ 2005-12-23 16:24 ` Spen
1 sibling, 0 replies; 12+ messages in thread
From: Spen @ 2005-12-23 16:24 UTC (permalink / raw)
To: wilfried.fauvel, 'insight'
Just to let you know that it does build under cygwin. I only make one patch
to enable building under the follow config.
Cygwin: 1.5.18
GCC 3.4.4
The patch can be found here:
http://sourceware.org/ml/insight/2005-q3/msg00021.html
I did run into one build problem after updating other cygwin pakages,
reinstalling gcc fixed the problems, could be with a try.
Regards
Spen
-----Original Message-----
From: insight-owner@sourceware.org [mailto:insight-owner@sourceware.org] On
Behalf Of wilfried.fauvel@laposte.net
Sent: 23 December 2005 13:38
To: insight
Subject: Re:FW: Can't build Insight with Cygwin
Hi,
I think you can use the patch command
(http://www.gnu.org/software/patch/patch.html) with the .diff file, I have
made it manually : you only have to open the three files listed ("RCS
file:") in the .diff file, and replace the - lines by the + lines at the
corresponding patterns.
I have tested to build on another config (with the same cygwin version :
1.5.18(0.132/4/2), and the same sources), and it seems to crash still ...
Good luck.
> Hi
>
> Thanks, Wilfred! This at least confirms my view that there did not
> seem to be any regular way this source could build. If I read it
> right, Dave Korn has confirmed that the Win32Dll.c code relies on an
> idiosyncrasy of an earlier version of gcc. Wilfred, can you post a
> patch? I have read Dave Korn's fix but as I have always studiously
> avoided assembler I just don't understand what to do to implement it!
>
> BTW: Keith, I have used the latest cygwin download which I think is
> gcc 3.4... (see Dave Korn's post). I am interested in Insight under
> Windows because I have used MSVC in the past (great debugger!) but
> want to migrate to gnu for cross-platform reasons. There's a lot of
> IDEs available for gcc but debugging support is generally poor. Hence the
interest in Insight.
> Keith, I guess the cygwin compiler on your Win2K box is an old version...
>
> Finally, I tried building with mingw 3.4.4 and the offending section
> in tcl/win seems to build OK!! But mingw breaks on the ./bfd
sub-directory.
> Output below. Any ideas on this one? This looks like something has
> coughed in the make file - again, I've studiously avoided using make...
>
>
> Peter
>
> ######################################################################
> ######
> #############################
> >
> > make[2]: Entering directory `/c/insight-6.4/bfd'
> > Making info in doc
> > make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> > restore=: && backupdir=".am$$" && \
> > am__cwd=`pwd` && cd ../.././bfd/doc && \ rm -rf $backupdir && mkdir
> > $backupdir && \ for f in ../.././bfd/doc/bfd.info
> > ../.././bfd/doc/bfd.info-[0-9] ../.././bfd/doc/bfd.info-[0-9][0-9]
> > ../.././bfd/doc/bfd.i[0-9] ../.././bfd/doc/bfd.i[0-9][0-9]; do \ if
> > test -f $f; then mv $f $backupdir; restore=mv; else :; fi; \ done; \
> > cd "$am__cwd"; \ if makeinfo --split-size=5000000
> > --split-size=5000000 -I ../.././bfd/doc \ -o
> > ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \ then \ rc=0;
> > \ cd ../.././bfd/doc; \ else \ rc=$?; \ cd ../.././bfd/doc && \
> > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" | sed
> > 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc section
> > mapping'.ss reference to nonexistent node `mmo a New Hash Table
> > Type'.ference to nonexistent node `Deriving
> > makeinfo: Removing output file `../.././bfd/doc/bfd.info' due to
> > errors; use --force to preserve.
> > make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> > make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> > make[2]: *** [info-recursive] Error 1
> > make[2]: Leaving directory `/c/insight-6.4/bfd'
> > make[1]: *** [all-bfd] Error 2
> > make[1]: Leaving directory `/c/insight-6.4'
> > make: *** [all] Error 2
> >
>
Accédez au courrier électronique de La Poste : www.laposte.net ; Jusqu'au 25
décembre, participez au grand jeu du Calendrier de l'Avent et
gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu !
^ permalink raw reply [flat|nested] 12+ messages in thread
* RE: FW: Can't build Insight with Cygwin
2005-12-23 16:17 wilfried.fauvel
@ 2005-12-23 16:21 ` Peter Rockett
2005-12-23 16:24 ` Spen
1 sibling, 0 replies; 12+ messages in thread
From: Peter Rockett @ 2005-12-23 16:21 UTC (permalink / raw)
To: 'insight'
[-- Attachment #1: Type: text/plain, Size: 4532 bytes --]
Thanks for the advice Wilfred but I have sorted this problem myself in the
meantime after a little Googling. The tcl/win branch now builds fine. Keith:
Attached the three files with all changes clearly annotated (with "pir").
That's the good news...
The bad news is that gdb breaks. I have managed to solve one problem - an
obvious problem in a source file which clearly the latest version of gcc
will not tolerate. Other problems remain but I guess this is not the
appropriate list for raising purely gdb problems....
Peter
> -----Original Message-----
> From: insight-owner@sourceware.org
> [mailto:insight-owner@sourceware.org] On Behalf Of
> wilfried.fauvel@laposte.net
> Sent: 23 December 2005 13:38
> To: insight
> Subject: Re:FW: Can't build Insight with Cygwin
>
>
> Hi,
>
> I think you can use the patch command
> (http://www.gnu.org/software/patch/patch.html) with the .diff
> file, I have made it manually : you only have to open the
> three files listed ("RCS file:") in the .diff file, and
> replace the - lines by the + lines at the corresponding
> patterns. I have tested to build on another config (with the
> same cygwin version : 1.5.18(0.132/4/2), and the same
> sources), and it seems to crash still ...
>
> Good luck.
>
> > Hi
> >
> > Thanks, Wilfred! This at least confirms my view that there did not
> > seem to be any regular way this source could build. If I read it
> > right, Dave Korn has confirmed that the Win32Dll.c code
> relies on an
> > idiosyncrasy of an earlier version of gcc. Wilfred, can you post a
> > patch? I have read Dave Korn's fix but as I have always studiously
> > avoided assembler I just don't understand what to do to
> implement it!
> >
> > BTW: Keith, I have used the latest cygwin download which I think is
> > gcc 3.4... (see Dave Korn's post). I am interested in Insight under
> > Windows because I have used MSVC in the past (great debugger!) but
> > want to migrate to gnu for cross-platform reasons. There's a lot of
> > IDEs available for gcc but debugging support is generally
> poor. Hence
> > the interest in Insight. Keith, I guess the cygwin compiler on your
> > Win2K box is an old version...
> >
> > Finally, I tried building with mingw 3.4.4 and the
> offending section
> > in tcl/win seems to build OK!! But mingw breaks on the ./bfd
> > sub-directory. Output below. Any ideas on this one? This looks like
> > something has coughed in the make file - again, I've studiously
> > avoided using make...
> >
> >
> > Peter
> >
> >
> ######################################################################
> > ######
> > #############################
> > >
> > > make[2]: Entering directory `/c/insight-6.4/bfd'
> > > Making info in doc
> > > make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> > > restore=: && backupdir=".am$$" && \
> > > am__cwd=`pwd` && cd ../.././bfd/doc && \
> > > rm -rf $backupdir && mkdir $backupdir && \
> > > for f in ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.info-[0-9]
> > > ../.././bfd/doc/bfd.info-[0-9][0-9]
> > > ../.././bfd/doc/bfd.i[0-9] ../.././bfd/doc/bfd.i[0-9][0-9]; do \
> > > if test -f $f; then mv $f $backupdir; restore=mv; else :;
> > > fi; \ done; \ cd "$am__cwd"; \
> > > if makeinfo --split-size=5000000 --split-size=5000000 -I
> > > ../.././bfd/doc \
> > > -o ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \ then \
> > > rc=0; \
> > > cd ../.././bfd/doc; \
> > > else \
> > > rc=$?; \
> > > cd ../.././bfd/doc && \
> > > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" |
> > > sed 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc
> > > section mapping'.ss reference to nonexistent node `mmo a New
> > > Hash Table Type'.ference to nonexistent node `Deriving
> > > makeinfo: Removing output file `../.././bfd/doc/bfd.info' due
> > > to errors; use --force to preserve.
> > > make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> > > make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> > > make[2]: *** [info-recursive] Error 1
> > > make[2]: Leaving directory `/c/insight-6.4/bfd'
> > > make[1]: *** [all-bfd] Error 2
> > > make[1]: Leaving directory `/c/insight-6.4'
> > > make: *** [all] Error 2
> > >
> >
>
> Accédez au courrier électronique de La Poste :
> www.laposte.net ; Jusqu'au 25 décembre, participez au grand
> jeu du Calendrier de l'Avent et
> gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu !
>
>
>
>
[-- Attachment #2: tclWinFCmd.c --]
[-- Type: application/octet-stream, Size: 56790 bytes --]
/* used attribute added on line 472 - pir (23.12.2005) */
/*
* tclWinFCmd.c
*
* This file implements the Windows specific portion of file manipulation
* subcommands of the "file" command.
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclWinFCmd.c,v 1.34 2003/02/04 17:06:53 vincentdarley Exp $
*/
#include "tclWinInt.h"
/*
* The following constants specify the type of callback when
* TraverseWinTree() calls the traverseProc()
*/
#define DOTREE_PRED 1 /* pre-order directory */
#define DOTREE_POSTD 2 /* post-order directory */
#define DOTREE_F 3 /* regular file */
/*
* Callbacks for file attributes code.
*/
static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
/*
* Constants and variables necessary for file attributes subcommand.
*/
enum {
WIN_ARCHIVE_ATTRIBUTE,
WIN_HIDDEN_ATTRIBUTE,
WIN_LONGNAME_ATTRIBUTE,
WIN_READONLY_ATTRIBUTE,
WIN_SHORTNAME_ATTRIBUTE,
WIN_SYSTEM_ATTRIBUTE
};
static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
CONST char *tclpFileAttrStrings[] = {
"-archive", "-hidden", "-longname", "-readonly",
"-shortname", "-system", (char *) NULL
};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileShortName, CannotSetAttribute},
{GetWinFileAttributes, SetWinFileAttributes}};
#if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)
static void *INITIAL_ESP,
*INITIAL_EBP,
*INITIAL_HANDLER,
*RESTORED_ESP,
*RESTORED_EBP,
*RESTORED_HANDLER;
#endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */
/*
* Prototype for the TraverseWinTree callback function.
*/
typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
/*
* Declarations for local procedures defined in this file:
*/
static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int ConvertFileNameFormat(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName, int longShort,
Tcl_Obj **attributePtrPtr);
static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
static int DoCreateDirectory(CONST TCHAR *pathPtr);
static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
int ignoreError, Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
Tcl_DString *errorPtr);
static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr);
static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
Tcl_DString *errorPtr);
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
* and returns success. Otherwise if dst already exists, it will be
* deleted and replaced by src subject to the following conditions:
* If src is a directory, dst may be an empty directory.
* If src is a file, dst may be a file.
* In any other situation where dst already exists, the rename will
* fail.
*
* Results:
* If the file or directory was successfully renamed, returns TCL_OK.
* Otherwise the return value is TCL_ERROR and errno is set to
* indicate the error. Some possible values for errno are:
*
* ENAMETOOLONG: src or dst names are too long.
* EACCES: src or dst parent directory can't be read and/or written.
* EEXIST: dst is a non-empty directory.
* EINVAL: src is a root directory or dst is a subdirectory of src.
* EISDIR: dst is a directory, but src is not.
* ENOENT: src doesn't exist. src or dst is "".
* ENOTDIR: src is a directory, but dst is not.
* EXDEV: src and dst are on different filesystems.
*
* EACCES: exists an open file already referring to src or dst.
* EACCES: src or dst specify the current working directory (NT).
* EACCES: src specifies a char device (nul:, com1:, etc.)
* EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT)
* EACCES: dst specifies a char device (nul:, com1:, etc.) (95)
*
* Side effects:
* The implementation supports cross-filesystem renames of files,
* but the caller should be prepared to emulate cross-filesystem
* renames of directories if errno is EXDEV.
*
*---------------------------------------------------------------------------
*/
int
TclpObjRenameFile(srcPathPtr, destPathPtr)
Tcl_Obj *srcPathPtr;
Tcl_Obj *destPathPtr;
{
return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
Tcl_FSGetNativePath(destPathPtr));
}
static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
DWORD srcAttr, dstAttr;
int retval = -1;
/*
* The MoveFile API acts differently under Win95/98 and NT
* WRT NULL and "". Avoid passing these values.
*/
if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
nativeDst == NULL || nativeDst[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
/*
* The MoveFile API would throw an exception under NT
* if one of the arguments is a char block device.
*/
#ifdef HAVE_NO_SEH
# ifdef TCL_MEM_DEBUG
__asm__ __volatile__ (
"movl %%esp, %0" "\n\t"
"movl %%ebp, %1" "\n\t"
"movl %%fs:0, %2" "\n\t"
: "=m"(INITIAL_ESP),
"=m"(INITIAL_EBP),
"=r"(INITIAL_HANDLER) );
# endif /* TCL_MEM_DEBUG */
__asm__ __volatile__ (
"pushl %ebp" "\n\t"
"pushl $__except_dorenamefile_handler" "\n\t"
"pushl %fs:0" "\n\t"
"movl %esp, %fs:0");
#else
__try {
#endif /* HAVE_NO_SEH */
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
retval = TCL_OK;
}
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"jmp dorenamefile_pop" "\n"
"dorenamefile_reentry:" "\n\t"
"movl %%fs:0, %%eax" "\n\t"
"movl 0x8(%%eax), %%esp" "\n\t"
"movl 0x8(%%esp), %%ebp" "\n"
"dorenamefile_pop:" "\n\t"
"movl (%%esp), %%eax" "\n\t"
"movl %%eax, %%fs:0" "\n\t"
"add $12, %%esp" "\n\t"
:
:
: "%eax");
# ifdef TCL_MEM_DEBUG
__asm__ __volatile__ (
"movl %%esp, %0" "\n\t"
"movl %%ebp, %1" "\n\t"
"movl %%fs:0, %2" "\n\t"
: "=m"(RESTORED_ESP),
"=m"(RESTORED_EBP),
"=r"(RESTORED_HANDLER) );
if (INITIAL_ESP != RESTORED_ESP)
panic("ESP restored incorrectly");
if (INITIAL_EBP != RESTORED_EBP)
panic("EBP restored incorrectly");
if (INITIAL_HANDLER != RESTORED_HANDLER)
panic("HANDLER restored incorrectly");
# endif /* TCL_MEM_DEBUG */
#else
} __except (EXCEPTION_EXECUTE_HANDLER) {}
#endif /* HAVE_NO_SEH */
/*
* Avoid using control flow statements in the SEH guarded block!
*/
if (retval != -1)
return retval;
TclWinConvertError(GetLastError());
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
dstAttr = 0;
}
if (errno == EBADF) {
errno = EACCES;
return TCL_ERROR;
}
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
CONST char **srcArgv, **dstArgv;
int size, srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
CONST char *src, *dst;
size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
(*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
(*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) {
/*
* Trying to move a directory into itself.
*/
errno = EINVAL;
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return TCL_ERROR;
}
Tcl_SplitPath(src, &srcArgc, &srcArgv);
Tcl_SplitPath(dst, &dstArgc, &dstArgv);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
if (srcArgc == 1) {
/*
* They are trying to move a root directory. Whether
* or not it is across filesystems, this cannot be
* done.
*/
Tcl_SetErrno(EINVAL);
} else if ((srcArgc > 0) && (dstArgc > 0) &&
(strcmp(srcArgv[0], dstArgv[0]) != 0)) {
/*
* If src is a directory and dst filesystem != src
* filesystem, errno should be EXDEV. It is very
* important to get this behavior, so that the caller
* can respond to a cross filesystem rename by
* simulating it with copy and delete. The MoveFile
* system call already handles the case of moving a
* file between filesystems.
*/
Tcl_SetErrno(EXDEV);
}
ckfree((char *) srcArgv);
ckfree((char *) dstArgv);
}
/*
* Other types of access failure is that dst is a read-only
* filesystem, that an open file referred to src or dest, or that
* src or dest specified the current working directory on the
* current filesystem. EACCES is returned for those cases.
*/
} else if (Tcl_GetErrno() == EEXIST) {
/*
* Reports EEXIST any time the target already exists. If it makes
* sense, remove the old file and try renaming again.
*/
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Overwrite empty dst directory with src directory. The
* following call will remove an empty directory. If it
* fails, it's because it wasn't empty.
*/
if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
* directory back, for completeness.
*/
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
/*
* Some new error has occurred. Don't know what it
* could be, but report this one.
*/
TclWinConvertError(GetLastError());
(*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
} else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
Tcl_SetErrno(ENOTDIR);
}
} else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
Tcl_SetErrno(EISDIR);
} else {
/*
* Overwrite existing file by:
*
* 1. Rename existing file to temp name.
* 2. Rename old file to new name.
* 3. If success, delete temp file. If failure,
* put temp file back to old name.
*/
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
WCHAR tempBuf[MAX_PATH];
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
nativeTmp = (TCHAR *) tempBuf;
((char *) nativeRest)[0] = '\0';
((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
nativePrefix = (tclWinProcs->useWide)
? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
* other app comes along in the meantime and creates the
* same temp file.
*/
nativeTmp = (TCHAR *) tempBuf;
(*tclWinProcs->deleteFileProc)(nativeTmp);
if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
(*tclWinProcs->setFileAttributesProc)(nativeTmp,
FILE_ATTRIBUTE_NORMAL);
(*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
} else {
(*tclWinProcs->deleteFileProc)(nativeDst);
(*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
}
/*
* Can't backup dst file or move src file. Return that
* error. Could happen if an open file refers to dst.
*/
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
return result;
}
}
}
return TCL_ERROR;
}
#ifdef HAVE_NO_SEH
static
__attribute__ ((used, /* pir - 23.12.2005 */ cdecl))
EXCEPTION_DISPOSITION
_except_dorenamefile_handler(
struct _EXCEPTION_RECORD *ExceptionRecord,
void *EstablisherFrame,
struct _CONTEXT *ContextRecord,
void *DispatcherContext)
{
__asm__ __volatile__ (
"jmp dorenamefile_reentry");
/* Nuke compiler warning about unused static function */
_except_dorenamefile_handler(NULL, NULL, NULL, NULL);
return 0; /* Function does not return */
}
#endif /* HAVE_NO_SEH */
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
*
* Results:
* If the file was successfully copied, returns TCL_OK. Otherwise
* the return value is TCL_ERROR and errno is set to indicate the
* error. Some possible values for errno are:
*
* EACCES: src or dst parent directory can't be read and/or written.
* EISDIR: src or dst is a directory.
* ENOENT: src doesn't exist. src or dst is "".
*
* EACCES: exists an open file already referring to dst (95).
* EACCES: src specifies a char device (nul:, com1:, etc.) (NT)
* ENOENT: src specifies a char device (nul:, com1:, etc.) (95)
*
* Side effects:
* It is not an error to copy to a char device.
*
*---------------------------------------------------------------------------
*/
int
TclpObjCopyFile(srcPathPtr, destPathPtr)
Tcl_Obj *srcPathPtr;
Tcl_Obj *destPathPtr;
{
return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
Tcl_FSGetNativePath(destPathPtr));
}
static int
DoCopyFile(
CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
int retval = -1;
/*
* The CopyFile API acts differently under Win95/98 and NT
* WRT NULL and "". Avoid passing these values.
*/
if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
nativeDst == NULL || nativeDst[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
/*
* The CopyFile API would throw an exception under NT if one
* of the arguments is a char block device.
*/
#ifdef HAVE_NO_SEH
# ifdef TCL_MEM_DEBUG
__asm__ __volatile__ (
"movl %%esp, %0" "\n\t"
"movl %%ebp, %1" "\n\t"
"movl %%fs:0, %2" "\n\t"
: "=m"(INITIAL_ESP),
"=m"(INITIAL_EBP),
"=r"(INITIAL_HANDLER) );
# endif /* TCL_MEM_DEBUG */
__asm__ __volatile__ (
"pushl %ebp" "\n\t"
"pushl $__except_docopyfile_handler" "\n\t"
"pushl %fs:0" "\n\t"
"movl %esp, %fs:0");
#else
__try {
#endif /* HAVE_NO_SEH */
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
retval = TCL_OK;
}
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"jmp docopyfile_pop" "\n"
"docopyfile_reentry:" "\n\t"
"movl %%fs:0, %%eax" "\n\t"
"movl 0x8(%%eax), %%esp" "\n\t"
"movl 0x8(%%esp), %%ebp" "\n"
"docopyfile_pop:" "\n\t"
"movl (%%esp), %%eax" "\n\t"
"movl %%eax, %%fs:0" "\n\t"
"add $12, %%esp" "\n\t"
:
:
: "%eax");
# ifdef TCL_MEM_DEBUG
__asm__ __volatile__ (
"movl %%esp, %0" "\n\t"
"movl %%ebp, %1" "\n\t"
"movl %%fs:0, %2" "\n\t"
: "=m"(RESTORED_ESP),
"=m"(RESTORED_EBP),
"=r"(RESTORED_HANDLER) );
if (INITIAL_ESP != RESTORED_ESP)
panic("ESP restored incorrectly");
if (INITIAL_EBP != RESTORED_EBP)
panic("EBP restored incorrectly");
if (INITIAL_HANDLER != RESTORED_HANDLER)
panic("HANDLER restored incorrectly");
# endif /* TCL_MEM_DEBUG */
#else
} __except (EXCEPTION_EXECUTE_HANDLER) {}
#endif /* HAVE_NO_SEH */
/*
* Avoid using control flow statements in the SEH guarded block!
*/
if (retval != -1)
return retval;
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
/* Source is a symbolic link -- copy it */
if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) {
return TCL_OK;
}
}
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
(*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
/*
* Still can't copy onto dst. Return that error, and
* restore attributes of dst.
*/
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
return TCL_ERROR;
}
#ifdef HAVE_NO_SEH
static
__attribute__ ((cdecl))
EXCEPTION_DISPOSITION
_except_docopyfile_handler(
struct _EXCEPTION_RECORD *ExceptionRecord,
void *EstablisherFrame,
struct _CONTEXT *ContextRecord,
void *DispatcherContext)
{
__asm__ __volatile__ (
"jmp docopyfile_reentry");
_except_docopyfile_handler(NULL,NULL,NULL,NULL);
return 0; /* Function does not return */
}
#endif /* HAVE_NO_SEH */
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjDeleteFile, TclpDeleteFile --
*
* Removes a single file (not a directory).
*
* Results:
* If the file was successfully deleted, returns TCL_OK. Otherwise
* the return value is TCL_ERROR and errno is set to indicate the
* error. Some possible values for errno are:
*
* EACCES: a parent directory can't be read and/or written.
* EISDIR: path is a directory.
* ENOENT: path doesn't exist or is "".
*
* EACCES: exists an open file already referring to path.
* EACCES: path is a char device (nul:, com1:, etc.)
*
* Side effects:
* The file is deleted, even if it is read-only.
*
*---------------------------------------------------------------------------
*/
int
TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
int
TclpDeleteFile(
CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
/*
* The DeleteFile API acts differently under Win95/98 and NT
* WRT NULL and "". Avoid passing these values.
*/
if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/* It is a symbolic link -- remove it */
if (TclWinSymLinkDelete(nativePath, 0) == 0) {
return TCL_OK;
}
}
/*
* If we fall through here, it is a directory.
*
* Windows NT reports removing a directory as EACCES instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
!= FALSE)) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (res != 0) {
(*tclWinProcs->setFileAttributesProc)(nativePath, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows 95 reports removing a directory as ENOENT instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
}
}
} else if (Tcl_GetErrno() == EINVAL) {
/*
* Windows NT reports removing a char device as EINVAL instead of
* EACCES.
*/
Tcl_SetErrno(EACCES);
}
return TCL_ERROR;
}
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
* automatically created with permissions so that user can access
* the new directory and create new files or subdirectories in it.
*
* Results:
* If the directory was successfully created, returns TCL_OK.
* Otherwise the return value is TCL_ERROR and errno is set to
* indicate the error. Some possible values for errno are:
*
* EACCES: a parent directory can't be read and/or written.
* EEXIST: path already exists.
* ENOENT: a parent directory doesn't exist.
*
* Side effects:
* A directory is created.
*
*---------------------------------------------------------------------------
*/
int
TclpObjCreateDirectory(pathPtr)
Tcl_Obj *pathPtr;
{
return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
DoCreateDirectory(
CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
{
DWORD error;
if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
error = GetLastError();
TclWinConvertError(error);
return TCL_ERROR;
}
return TCL_OK;
}
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
* directory hierarchies, even if the target directory is an an
* empty directory.
*
* Results:
* If the directory was successfully copied, returns TCL_OK.
* Otherwise the return value is TCL_ERROR, errno is set to indicate
* the error, and the pathname of the file that caused the error
* is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
* for a description of possible values for errno.
*
* Side effects:
* An exact copy of the directory hierarchy src will be created
* with the name dst. If an error occurs, the error will
* be returned immediately, and remaining files will not be
* processed.
*
*---------------------------------------------------------------------------
*/
int
TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
Tcl_Obj *srcPathPtr;
Tcl_Obj *destPathPtr;
Tcl_Obj **errorPtr;
{
Tcl_DString ds;
Tcl_DString srcString, dstString;
int ret;
Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
-1, &srcString);
Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),
-1, &dstString);
ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
if (ret != TCL_OK) {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
}
return ret;
}
\f
/*
*----------------------------------------------------------------------
*
* TclpObjRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
* Results:
* If the directory was successfully removed, returns TCL_OK.
* Otherwise the return value is TCL_ERROR, errno is set to indicate
* the error, and the pathname of the file that caused the error
* is stored in errorPtr. Some possible values for errno are:
*
* EACCES: path directory can't be read and/or written.
* EEXIST: path is a non-empty directory.
* EINVAL: path is root directory or current directory.
* ENOENT: path doesn't exist or is "".
* ENOTDIR: path is not a directory.
*
* EACCES: path is a char device (nul:, com1:, etc.) (95)
* EINVAL: path is a char device (nul:, com1:, etc.) (NT)
*
* Side effects:
* Directory removed. If an error occurs, the error will be returned
* immediately, and remaining files will not be deleted.
*
*----------------------------------------------------------------------
*/
int
TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
Tcl_Obj *pathPtr;
int recursive;
Tcl_Obj **errorPtr;
{
Tcl_DString ds;
int ret;
if (recursive) {
/*
* In the recursive case, the string rep is used to construct a
* Tcl_DString which may be used extensively, so we can't
* optimize this case easily.
*/
Tcl_DString native;
Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
-1, &native);
ret = DoRemoveDirectory(&native, recursive, &ds);
Tcl_DStringFree(&native);
} else {
ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr),
0, &ds);
}
if (ret != TCL_OK) {
int len = Tcl_DStringLength(&ds);
if (len > 0) {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_IncrRefCount(*errorPtr);
}
Tcl_DStringFree(&ds);
}
return ret;
}
static int
DoRemoveJustDirectory(
CONST TCHAR *nativePath, /* Pathname of directory to be removed
* (native). */
int ignoreError, /* If non-zero, don't initialize the
* errorPtr under some circumstances
* on return. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
/*
* The RemoveDirectory API acts differently under Win95/98 and NT
* WRT NULL and "". Avoid passing these values.
*/
if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
* EACCES, not an ENOTDIR.
*/
Tcl_SetErrno(ENOTDIR);
goto end;
}
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/* It is a symbolic link -- remove it */
if (TclWinSymLinkDelete(nativePath, 1) != 0) {
goto end;
}
}
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
/*
* Windows 95 and Win32s report removing a non-empty directory
* as EACCES, not EEXIST. If the directory is not empty,
* change errno so caller knows what's going on.
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
CONST char *path, *find;
HANDLE handle;
WIN32_FIND_DATAA data;
Tcl_DString buffer;
int len;
path = (CONST char *) nativePath;
Tcl_DStringInit(&buffer);
len = strlen(path);
find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
Tcl_DStringAppend(&buffer, "\\", 1);
}
find = Tcl_DStringAppend(&buffer, "*.*", 3);
handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
if ((strcmp(data.cFileName, ".") != 0)
&& (strcmp(data.cFileName, "..") != 0)) {
/*
* Found something in this directory.
*/
Tcl_SetErrno(EEXIST);
break;
}
if (FindNextFileA(handle, &data) == FALSE) {
break;
}
}
FindClose(handle);
}
Tcl_DStringFree(&buffer);
}
}
}
if (Tcl_GetErrno() == ENOTEMPTY) {
/*
* The caller depends on EEXIST to signify that the directory is
* not empty, not ENOTEMPTY.
*/
Tcl_SetErrno(EEXIST);
}
if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* If we're being recursive, this error may actually
* be ok, so we don't want to initialise the errorPtr
* yet.
*/
return TCL_ERROR;
}
end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
}
static int
DoRemoveDirectory(
Tcl_DString *pathPtr, /* Pathname of directory to be removed
* (native). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
errorPtr);
if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* The directory is nonempty, but the recursive flag has been
* specified, so we recursively remove all the files in the directory.
*/
return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
} else {
return res;
}
}
\f
/*
*---------------------------------------------------------------------------
*
* TraverseWinTree --
*
* Traverse directory tree specified by sourcePtr, calling the function
* traverseProc for each file and directory encountered. If destPtr
* is non-null, each of name in the sourcePtr directory is appended to
* the directory specified by destPtr and passed as the second argument
* to traverseProc() .
*
* Results:
* Standard Tcl result.
*
* Side effects:
* None caused by TraverseWinTree, however the user specified
* traverseProc() may change state. If an error occurs, the error will
* be returned immediately, and remaining files will not be processed.
*
*---------------------------------------------------------------------------
*/
static int
TraverseWinTree(
TraversalProc *traverseProc,/* Function to call for every file and
* directory in source hierarchy. */
Tcl_DString *sourcePtr, /* Pathname of source directory to be
* traversed (native). */
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
* parallel with source directory (native),
* may be NULL. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
DWORD sourceAttr;
TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
HANDLE handle;
WIN32_FIND_DATAT data;
nativeErrfile = NULL;
result = TCL_OK;
oldTargetLen = 0; /* lint. */
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
nativeTarget = (TCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
oldSourceLen = Tcl_DStringLength(sourcePtr);
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
}
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Process the regular file
*/
return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
if (tclWinProcs->useWide) {
Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
} else {
Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
}
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory
*/
TclWinConvertError(GetLastError());
nativeErrfile = nativeSource;
goto end;
}
nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
}
sourceLen = oldSourceLen;
if (tclWinProcs->useWide) {
sourceLen += sizeof(WCHAR);
Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
Tcl_DStringSetLength(sourcePtr, sourceLen);
} else {
sourceLen += 1;
Tcl_DStringAppend(sourcePtr, "\\", 1);
}
if (targetPtr != NULL) {
oldTargetLen = Tcl_DStringLength(targetPtr);
targetLen = oldTargetLen;
if (tclWinProcs->useWide) {
targetLen += sizeof(WCHAR);
Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
Tcl_DStringSetLength(targetPtr, targetLen);
} else {
targetLen += 1;
Tcl_DStringAppend(targetPtr, "\\", 1);
}
}
found = 1;
for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
TCHAR *nativeName;
int len;
if (tclWinProcs->useWide) {
WCHAR *wp;
wp = data.w.cFileName;
if (*wp == '.') {
wp++;
if (*wp == '.') {
wp++;
}
if (*wp == '\0') {
continue;
}
}
nativeName = (TCHAR *) data.w.cFileName;
len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);
} else {
if ((strcmp(data.a.cFileName, ".") == 0)
|| (strcmp(data.a.cFileName, "..") == 0)) {
continue;
}
nativeName = (TCHAR *) data.a.cFileName;
len = strlen(data.a.cFileName);
}
/*
* Append name after slash, and recurse on the file.
*/
Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
if (targetPtr != NULL) {
Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
}
result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
errorPtr);
if (result != TCL_OK) {
break;
}
/*
* Remove name after slash.
*/
Tcl_DStringSetLength(sourcePtr, sourceLen);
if (targetPtr != NULL) {
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
FindClose(handle);
/*
* Strip off the trailing slash we added
*/
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
if (targetPtr != NULL) {
Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
Tcl_DStringSetLength(targetPtr, oldTargetLen);
}
if (result == TCL_OK) {
/*
* Call traverseProc() on a directory after visiting all the
* files in that directory.
*/
result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
return result;
}
\f
/*
*----------------------------------------------------------------------
*
* TraversalCopy
*
* Called from TraverseUnixTree in order to execute a recursive
* copy of a directory.
*
* Results:
* Standard Tcl result.
*
* Side effects:
* Depending on the value of type, src may be copied to dst.
*
*----------------------------------------------------------------------
*/
static int
TraversalCopy(
CONST TCHAR *nativeSrc, /* Source pathname to copy. */
CONST TCHAR *nativeDst, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
switch (type) {
case DOTREE_F: {
if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
if (DoCreateDirectory(nativeDst) == TCL_OK) {
DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
}
break;
}
case DOTREE_POSTD: {
return TCL_OK;
}
}
/*
* There shouldn't be a problem with src, because we already
* checked it to get here.
*/
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
\f
/*
*----------------------------------------------------------------------
*
* TraversalDelete --
*
* Called by procedure TraverseWinTree for every file and
* directory that it encounters in a directory hierarchy. This
* procedure unlinks files, and removes directories after all the
* containing files have been processed.
*
* Results:
* Standard Tcl result.
*
* Side effects:
* Files or directory specified by src will be deleted. If an
* error occurs, the windows error is converted to a Posix error
* and errno is set accordingly.
*
*----------------------------------------------------------------------
*/
static int
TraversalDelete(
CONST TCHAR *nativeSrc, /* Source pathname to delete. */
CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
switch (type) {
case DOTREE_F: {
if (TclpDeleteFile(nativeSrc) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
return TCL_OK;
}
case DOTREE_POSTD: {
if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
}
}
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
\f
/*
*----------------------------------------------------------------------
*
* StatError --
*
* Sets the object result with the appropriate error.
*
* Results:
* None.
*
* Side effects:
* The interp's object result is set with an error message
* based on the objIndex, fileName and errno.
*
*----------------------------------------------------------------------
*/
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
TclWinConvertError(GetLastError());
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not read \"", Tcl_GetString(fileName),
"\": ", Tcl_PosixError(interp),
(char *) NULL);
}
\f
/*
*----------------------------------------------------------------------
*
* GetWinFileAttributes --
*
* Returns a Tcl_Obj containing the value of a file attribute.
* This routine gets the -hidden, -readonly or -system attribute.
*
* Results:
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
*
* Side effects:
* A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
static int
GetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
CONST TCHAR *nativeName;
int attr;
nativeName = Tcl_FSGetNativePath(fileName);
result = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (result == 0xffffffff) {
StatError(interp, fileName);
return TCL_ERROR;
}
attr = (int)(result & attributeArray[objIndex]);
if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
/*
* It is hidden. However there is a bug on some Windows
* OSes in which root volumes (drives) formatted as NTFS
* are declared hidden when they are not (and cannot be).
*
* We test for, and fix that case, here.
*/
int len;
char *str = Tcl_GetStringFromObj(fileName,&len);
if (len < 4) {
if (len == 0) {
/*
* Not sure if this is possible, but we pass it on
* anyway
*/
} else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
/* Path is pointing to the root volume */
attr = 0;
} else if ((str[1] == ':')
&& (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
/* Path is of the form 'x:' or 'x:/' or 'x:\' */
attr = 0;
}
}
}
*attributePtrPtr = Tcl_NewBooleanObj(attr);
return TCL_OK;
}
\f
/*
*----------------------------------------------------------------------
*
* ConvertFileNameFormat --
*
* Returns a Tcl_Obj containing either the long or short version of the
* file name.
*
* Results:
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
*
* Warning: if you pass this function a drive name like 'c:' it
* will actually return the current working directory on that
* drive. To avoid this, make sure the drive name ends in a
* slash, like this 'c:/'.
*
* Side effects:
* A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
Tcl_Obj *splitPath;
int result = TCL_OK;
splitPath = Tcl_FSSplitPath(fileName, &pathc);
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not read \"", Tcl_GetString(fileName),
"\": no such file or directory",
(char *) NULL);
}
result = TCL_ERROR;
goto cleanup;
}
for (i = 0; i < pathc; i++) {
Tcl_Obj *elt;
char *pathv;
int pathLen;
Tcl_ListObjIndex(NULL, splitPath, i, &elt);
pathv = Tcl_GetStringFromObj(elt, &pathLen);
if ((pathv[0] == '/')
|| ((pathLen == 3) && (pathv[1] == ':'))
|| (strcmp(pathv, ".") == 0)
|| (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
* copying the string literally. Uppercase the drive letter,
* just because it looks better under Windows to do so.
*/
simple:
/* Here we are modifying the string representation in place */
/* I believe this is legal, since this won't affect any
* file representation this thing may have. */
pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
} else {
Tcl_Obj *tempPath;
Tcl_DString ds;
Tcl_DString dsTemp;
TCHAR *nativeName;
char *tempString;
int tempLen;
WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
tempPath = Tcl_FSJoinPath(splitPath, i+1);
Tcl_IncrRefCount(tempPath);
/*
* We'd like to call Tcl_FSGetNativePath(tempPath)
* but that is likely to lead to infinite loops
*/
Tcl_DStringInit(&ds);
tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
Tcl_DecrRefCount(tempPath);
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We
* would only get a root directory here if the caller
* specified "c:" or "c:." and the current directory on the
* drive was the root directory
*/
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
}
}
if (handle == INVALID_HANDLE_VALUE) {
Tcl_DStringFree(&ds);
if (interp != NULL) {
StatError(interp, fileName);
}
result = TCL_ERROR;
goto cleanup;
}
if (tclWinProcs->useWide) {
nativeName = (TCHAR *) data.w.cAlternateFileName;
if (longShort) {
if (data.w.cFileName[0] != '\0') {
nativeName = (TCHAR *) data.w.cFileName;
}
} else {
if (data.w.cAlternateFileName[0] == '\0') {
nativeName = (TCHAR *) data.w.cFileName;
}
}
} else {
nativeName = (TCHAR *) data.a.cAlternateFileName;
if (longShort) {
if (data.a.cFileName[0] != '\0') {
nativeName = (TCHAR *) data.a.cFileName;
}
} else {
if (data.a.cAlternateFileName[0] == '\0') {
nativeName = (TCHAR *) data.a.cFileName;
}
}
}
/*
* Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
* to dereference nativeName as a Unicode string. I have proven
* to myself that purify is wrong by running the following
* example when nativeName == data.w.cAlternateFileName and
* noting that purify doesn't complain about the first line,
* but does complain about the second.
*
* fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
Tcl_DStringInit(&dsTemp);
Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
/* Deal with issues of tildes being absolute */
if (Tcl_DStringValue(&dsTemp)[0] == '~') {
tempPath = Tcl_NewStringObj("./",2);
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
} else {
tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
*attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
cleanup:
if (splitPath != NULL) {
Tcl_DecrRefCount(splitPath);
}
return result;
}
\f
/*
*----------------------------------------------------------------------
*
* GetWinFileLongName --
*
* Returns a Tcl_Obj containing the long version of the file
* name.
*
* Results:
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
*
* Side effects:
* A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
static int
GetWinFileLongName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
}
\f
/*
*----------------------------------------------------------------------
*
* GetWinFileShortName --
*
* Returns a Tcl_Obj containing the short version of the file
* name.
*
* Results:
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
*
* Side effects:
* A new object is allocated if the file is valid.
*
*----------------------------------------------------------------------
*/
static int
GetWinFileShortName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
}
\f
/*
*----------------------------------------------------------------------
*
* SetWinFileAttributes --
*
* Set the file attributes to the value given by attributePtr.
* This routine sets the -hidden, -readonly, or -system attributes.
*
* Results:
* Standard TCL error.
*
* Side effects:
* The file's attribute is set.
*
*----------------------------------------------------------------------
*/
static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
int yesNo;
int result;
CONST TCHAR *nativeName;
nativeName = Tcl_FSGetNativePath(fileName);
fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
return TCL_ERROR;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
return result;
}
if (yesNo) {
fileAttributes |= (attributeArray[objIndex]);
} else {
fileAttributes &= ~(attributeArray[objIndex]);
}
if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
return result;
}
\f
/*
*----------------------------------------------------------------------
*
* SetWinFileLongName --
*
* The attribute in question is a readonly attribute and cannot
* be set.
*
* Results:
* TCL_ERROR
*
* Side effects:
* The object result is set to a pertinent error message.
*
*----------------------------------------------------------------------
*/
static int
CannotSetAttribute(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot set attribute \"", tclpFileAttrStrings[objIndex],
"\" for file \"", Tcl_GetString(fileName),
"\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
\f
/*
*---------------------------------------------------------------------------
*
* TclpObjListVolumes --
*
* Lists the currently mounted volumes
*
* Results:
* The list of volumes.
*
* Side effects:
* None
*
*---------------------------------------------------------------------------
*/
Tcl_Obj*
TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
char buf[40 * 4]; /* There couldn't be more than 30 drives??? */
int i;
char *p;
resultPtr = Tcl_NewObj();
/*
* On Win32s:
* GetLogicalDriveStrings() isn't implemented.
* GetLogicalDrives() returns incorrect information.
*/
if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
/*
* GetVolumeInformation() will detects all drives, but causes
* chattering on empty floppy drives. We only do this if
* GetLogicalDriveStrings() didn't work. It has also been reported
* that on some laptops it takes a while for GetVolumeInformation()
* to return when pinging an empty floppy drive, another reason to
* try to avoid calling it.
*/
buf[1] = ':';
buf[2] = '/';
buf[3] = '\0';
for (i = 0; i < 26; i++) {
buf[0] = (char) ('a' + i);
if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
|| (GetLastError() == ERROR_NOT_READY)) {
elemPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
} else {
for (p = buf; *p != '\0'; p += 4) {
p[2] = '/';
elemPtr = Tcl_NewStringObj(p, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
Tcl_IncrRefCount(resultPtr);
return resultPtr;
}
[-- Attachment #3: tclWin32Dll.c --]
[-- Type: application/octet-stream, Size: 17963 bytes --]
/* used attribute added on line 396 - pir (23.12.2005) */
/*
* tclWin32Dll.c --
*
* This file contains the DLL entry point.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclWin32Dll.c,v 1.16 2002/06/13 09:40:01 vincentdarley Exp $
*/
#include "tclWinInt.h"
/*
* The following data structures are used when loading the thunking
* library for execing child processes under Win32s.
*/
typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
LPVOID *lpTranslationList);
typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
FARPROC UT32Callback, LPVOID Buff);
typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
/*
* The following variables keep track of information about this DLL
* on a per-instance basis. Each time this DLL is loaded, it gets its own
* new data segment with its own copy of all static and global information.
*/
static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
static int platformId; /* Running under NT, or 95/98? */
#ifdef HAVE_NO_SEH
static void *ESP;
static void *EBP;
#endif /* HAVE_NO_SEH */
/*
* The following function tables are used to dispatch to either the
* wide-character or multi-byte versions of the operating system calls,
* depending on whether the Unicode calls are available.
*/
static TclWinProcs asciiProcs = {
0,
(BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
(TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
(BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
(HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
DWORD, DWORD, HANDLE)) CreateFileA,
(BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
(BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
(HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
(BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
(BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
(DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
(DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
TCHAR **)) GetFullPathNameA,
(DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
(DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
(UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
WCHAR *)) GetTempFileNameA,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
(BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
WCHAR *, DWORD)) GetVolumeInformationA,
(HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
(TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
(BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
(DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
WCHAR *, TCHAR **)) SearchPathA,
(BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
(BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
NULL,
NULL,
};
static TclWinProcs unicodeProcs = {
1,
(BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
(TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
(BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
(HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
DWORD, DWORD, HANDLE)) CreateFileW,
(BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
(BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
(HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
(BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
(BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
(DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
(DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
TCHAR **)) GetFullPathNameW,
(DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
(DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
(UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
WCHAR *)) GetTempFileNameW,
(DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
(BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
WCHAR *, DWORD)) GetVolumeInformationW,
(HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
(TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
(BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
(DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
WCHAR *, TCHAR **)) SearchPathW,
(BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
(BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
NULL,
NULL,
};
TclWinProcs *tclWinProcs;
static Tcl_Encoding tclWinTCharEncoding;
/*
* The following declaration is for the VC++ DLL entry point.
*/
BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
LPVOID reserved);
#ifdef __WIN32__
#ifndef STATIC_BUILD
\f
/*
*----------------------------------------------------------------------
*
* DllEntryPoint --
*
* This wrapper function is used by Borland to invoke the
* initialization code for Tcl. It simply calls the DllMain
* routine.
*
* Results:
* See DllMain.
*
* Side effects:
* See DllMain.
*
*----------------------------------------------------------------------
*/
BOOL APIENTRY
DllEntryPoint(hInst, reason, reserved)
HINSTANCE hInst; /* Library instance handle. */
DWORD reason; /* Reason this function is being called. */
LPVOID reserved; /* Not used. */
{
return DllMain(hInst, reason, reserved);
}
\f
/*
*----------------------------------------------------------------------
*
* DllMain --
*
* This routine is called by the VC++ C run time library init
* code, or the DllEntryPoint routine. It is responsible for
* initializing various dynamically loaded libraries.
*
* Results:
* TRUE on sucess, FALSE on failure.
*
* Side effects:
* Establishes 32-to-16 bit thunk and initializes sockets library.
*
*----------------------------------------------------------------------
*/
BOOL APIENTRY
DllMain(hInst, reason, reserved)
HINSTANCE hInst; /* Library instance handle. */
DWORD reason; /* Reason this function is being called. */
LPVOID reserved; /* Not used. */
{
switch (reason) {
case DLL_PROCESS_ATTACH:
TclWinInit(hInst);
return TRUE;
case DLL_PROCESS_DETACH:
if (hInst == hInstance) {
Tcl_Finalize();
}
break;
}
return TRUE;
}
#endif /* !STATIC_BUILD */
#endif /* __WIN32__ */
\f
/*
*----------------------------------------------------------------------
*
* TclWinGetTclInstance --
*
* Retrieves the global library instance handle.
*
* Results:
* Returns the global library instance handle.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
HINSTANCE
TclWinGetTclInstance()
{
return hInstance;
}
\f
/*
*----------------------------------------------------------------------
*
* TclWinInit --
*
* This function initializes the internal state of the tcl library.
*
* Results:
* None.
*
* Side effects:
* Initializes the tclPlatformId variable.
*
*----------------------------------------------------------------------
*/
void
TclWinInit(hInst)
HINSTANCE hInst; /* Library instance handle. */
{
OSVERSIONINFO os;
hInstance = hInst;
os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&os);
platformId = os.dwPlatformId;
/*
* We no longer support Win32s, so just in case someone manages to
* get a runtime there, make sure they know that.
*/
if (platformId == VER_PLATFORM_WIN32s) {
panic("Win32s is not a supported platform");
}
tclWinProcs = &asciiProcs;
}
\f
/*
*----------------------------------------------------------------------
*
* TclWinGetPlatformId --
*
* Determines whether running under NT, 95, or Win32s, to allow
* runtime conditional code.
*
* Results:
* The return value is one of:
* VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
* VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
* VER_PLATFORM_WIN32_NT Win32 on Windows NT
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclWinGetPlatformId()
{
return platformId;
}
\f
/*
*-------------------------------------------------------------------------
*
* TclWinNoBackslash --
*
* We're always iterating through a string in Windows, changing the
* backslashes to slashes for use in Tcl.
*
* Results:
* All backslashes in given string are changed to slashes.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
char *
TclWinNoBackslash(
char *path) /* String to change. */
{
char *p;
for (p = path; *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
}
}
return path;
}
\f
/*
*----------------------------------------------------------------------
*
* TclpCheckStackSpace --
*
* Detect if we are about to blow the stack. Called before an
* evaluation can happen when nesting depth is checked.
*
* Results:
* 1 if there is enough stack space to continue; 0 if not.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclpCheckStackSpace()
{
int retval = 0;
/*
* We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
* bytes of stack space left. alloca() is cheap on windows; basically
* it just subtracts from the stack pointer causing the OS to throw an
* exception if the stack pointer is set below the bottom of the stack.
*/
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"movl %esp, _ESP" "\n\t"
"movl %ebp, _EBP");
__asm__ __volatile__ (
"pushl $__except_checkstackspace_handler" "\n\t"
"pushl %fs:0" "\n\t"
"mov %esp, %fs:0");
#else
__try {
#endif /* HAVE_NO_SEH */
alloca(TCL_WIN_STACK_THRESHOLD);
retval = 1;
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"jmp checkstackspace_pop" "\n"
"checkstackspace_reentry:" "\n\t"
"movl _ESP, %esp" "\n\t"
"movl _EBP, %ebp");
__asm__ __volatile__ (
"checkstackspace_pop:" "\n\t"
"mov (%esp), %eax" "\n\t"
"mov %eax, %fs:0" "\n\t"
"add $8, %esp");
#else
} __except (EXCEPTION_EXECUTE_HANDLER) {}
#endif /* HAVE_NO_SEH */
/*
* Avoid using control flow statements in the SEH guarded block!
*/
return retval;
}
#ifdef HAVE_NO_SEH
static
__attribute__ ((used, /* pir - 23.12.2005 */cdecl))
EXCEPTION_DISPOSITION
_except_checkstackspace_handler(
struct _EXCEPTION_RECORD *ExceptionRecord,
void *EstablisherFrame,
struct _CONTEXT *ContextRecord,
void *DispatcherContext)
{
__asm__ __volatile__ (
"jmp checkstackspace_reentry");
return 0; /* Function does not return */
}
#endif /* HAVE_NO_SEH */
\f
/*
*----------------------------------------------------------------------
*
* TclWinGetPlatform --
*
* This is a kludge that allows the test library to get access
* the internal tclPlatform variable.
*
* Results:
* Returns a pointer to the tclPlatform variable.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
TclPlatformType *
TclWinGetPlatform()
{
return &tclPlatform;
}
\f
/*
*---------------------------------------------------------------------------
*
* TclWinSetInterfaces --
*
* A helper proc that allows the test library to change the
* tclWinProcs structure to dispatch to either the wide-character
* or multi-byte versions of the operating system calls, depending
* on whether Unicode is the system encoding.
*
* As well as this, we can also try to load in some additional
* procs which may/may not be present depending on the current
* Windows version (e.g. Win95 will not have the procs below).
*
* Results:
* None.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
void
TclWinSetInterfaces(
int wide) /* Non-zero to use wide interfaces, 0
* otherwise. */
{
Tcl_FreeEncoding(tclWinTCharEncoding);
if (wide) {
tclWinProcs = &unicodeProcs;
tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
if (tclWinProcs->getFileAttributesExProc == NULL) {
HINSTANCE hInstance = LoadLibraryA("kernel32");
if (hInstance != NULL) {
tclWinProcs->getFileAttributesExProc =
(BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
tclWinProcs->createHardLinkProc =
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
"CreateHardLinkW");
FreeLibrary(hInstance);
}
}
} else {
tclWinProcs = &asciiProcs;
tclWinTCharEncoding = NULL;
if (tclWinProcs->getFileAttributesExProc == NULL) {
HINSTANCE hInstance = LoadLibraryA("kernel32");
if (hInstance != NULL) {
tclWinProcs->getFileAttributesExProc =
(BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
tclWinProcs->createHardLinkProc =
(BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
"CreateHardLinkA");
FreeLibrary(hInstance);
}
}
}
}
\f
/*
*---------------------------------------------------------------------------
*
* Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
*
* Convert between UTF-8 and Unicode when running Windows NT or
* the current ANSI code page when running Windows 95.
*
* On Mac, Unix, and Windows 95, all strings exchanged between Tcl
* and the OS are "char" oriented. We need only one Tcl_Encoding to
* convert between UTF-8 and the system's native encoding. We use
* NULL to represent that encoding.
*
* On NT, some strings exchanged between Tcl and the OS are "char"
* oriented, while others are in Unicode. We need two Tcl_Encoding
* APIs depending on whether we are targeting a "char" or Unicode
* interface.
*
* Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
* encoding of NULL should always used to convert between UTF-8
* and the system's "char" oriented encoding. The following two
* functions are used in Windows-specific code to convert between
* UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
* you the trouble of writing the following type of fragment over and
* over:
*
* if (running NT) {
* encoding <- Tcl_GetEncoding("unicode");
* nativeBuffer <- UtfToExternal(encoding, utfBuffer);
* Tcl_FreeEncoding(encoding);
* } else {
* nativeBuffer <- UtfToExternal(NULL, utfBuffer);
* }
*
* By convention, in Windows a TCHAR is a character in the ANSI code
* page on Windows 95, a Unicode character on Windows NT. If you
* plan on targeting a Unicode interfaces when running on NT and a
* "char" oriented interface while running on 95, these functions
* should be used. If you plan on targetting the same "char"
* oriented function on both 95 and NT, use Tcl_UtfToExternal()
* with an encoding of NULL.
*
* Results:
* The result is a pointer to the string in the desired target
* encoding. Storage for the result string is allocated in
* dsPtr; the caller must call Tcl_DStringFree() when the result
* is no longer needed.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
TCHAR *
Tcl_WinUtfToTChar(string, len, dsPtr)
CONST char *string; /* Source string in UTF-8. */
int len; /* Source string length in bytes, or < 0 for
* strlen(). */
Tcl_DString *dsPtr; /* Uninitialized or free DString in which
* the converted string is stored. */
{
return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
string, len, dsPtr);
}
char *
Tcl_WinTCharToUtf(string, len, dsPtr)
CONST TCHAR *string; /* Source string in Unicode when running
* NT, ANSI when running 95. */
int len; /* Source string length in bytes, or < 0 for
* platform-specific string length. */
Tcl_DString *dsPtr; /* Uninitialized or free DString in which
* the converted string is stored. */
{
return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
(CONST char *) string, len, dsPtr);
}
[-- Attachment #4: tclWinChan.c --]
[-- Type: application/octet-stream, Size: 36738 bytes --]
/* used attribute added on line 1109 - pir (23.12.2005) */
/*
* tclWinChan.c
*
* Channel drivers for Windows channels based on files, command
* pipes and TCP sockets.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclWinChan.c,v 1.24 2002/07/08 10:08:58 vincentdarley Exp $
*/
#include "tclWinInt.h"
/*
* State flags used in the info structures below.
*/
#define FILE_PENDING (1<<0) /* Message is pending in the queue. */
#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */
#define FILE_APPEND (1<<2) /* File is in append mode. */
#define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1)
#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
/*
* The following structure contains per-instance data for a file based channel.
*/
typedef struct FileInfo {
Tcl_Channel channel; /* Pointer to channel structure. */
int validMask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which operations are valid on the file. */
int watchMask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which events should be reported. */
int flags; /* State flags, see above for a list. */
HANDLE handle; /* Input/output file. */
struct FileInfo *nextPtr; /* Pointer to next registered file. */
int dirty; /* Boolean flag. Set if the OS may have data
* pending on the channel */
} FileInfo;
typedef struct ThreadSpecificData {
/*
* List of all file channels currently open.
*/
FileInfo *firstFilePtr;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* The following structure is what is added to the Tcl event queue when
* file events are generated.
*/
typedef struct FileEvent {
Tcl_Event header; /* Information that is standard for
* all events. */
FileInfo *infoPtr; /* Pointer to file info structure. Note
* that we still have to verify that the
* file exists before dereferencing this
* pointer. */
} FileEvent;
/*
* Static routines for this file:
*/
static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,
int mode));
static void FileChannelExitHandler _ANSI_ARGS_((
ClientData clientData));
static void FileCheckProc _ANSI_ARGS_((ClientData clientData,
int flags));
static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
int flags));
static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
int direction, ClientData *handlePtr));
static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
CONST char *buf, int toWrite, int *errorCode));
static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
Tcl_WideInt offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
/*
* This structure describes the channel type structure for file based IO.
*/
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_3, /* v3 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
FileSeekProc, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
FileGetHandleProc, /* Get an OS handle from channel. */
NULL, /* close2proc. */
FileBlockProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
FileWideSeekProc, /* Wide seek proc. */
};
#ifdef HAVE_NO_SEH
static void *ESP;
static void *EBP;
#endif /* HAVE_NO_SEH */
\f
/*
*----------------------------------------------------------------------
*
* FileInit --
*
* This function creates the window used to simulate file events.
*
* Results:
* None.
*
* Side effects:
* Creates a new window and creates an exit handler.
*
*----------------------------------------------------------------------
*/
static ThreadSpecificData *
FileInit()
{
ThreadSpecificData *tsdPtr =
(ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->firstFilePtr = NULL;
Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
}
return tsdPtr;
}
\f
/*
*----------------------------------------------------------------------
*
* FileChannelExitHandler --
*
* This function is called to cleanup the channel driver before
* Tcl is unloaded.
*
* Results:
* None.
*
* Side effects:
* Destroys the communication window.
*
*----------------------------------------------------------------------
*/
static void
FileChannelExitHandler(clientData)
ClientData clientData; /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
}
\f
/*
*----------------------------------------------------------------------
*
* FileSetupProc --
*
* This procedure is invoked before Tcl_DoOneEvent blocks waiting
* for an event.
*
* Results:
* None.
*
* Side effects:
* Adjusts the block time if needed.
*
*----------------------------------------------------------------------
*/
void
FileSetupProc(data, flags)
ClientData data; /* Not used. */
int flags; /* Event flags as passed to Tcl_DoOneEvent. */
{
FileInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Check to see if there is a ready file. If so, poll.
*/
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
break;
}
}
}
\f
/*
*----------------------------------------------------------------------
*
* FileCheckProc --
*
* This procedure is called by Tcl_DoOneEvent to check the file
* event source for events.
*
* Results:
* None.
*
* Side effects:
* May queue an event.
*
*----------------------------------------------------------------------
*/
static void
FileCheckProc(data, flags)
ClientData data; /* Not used. */
int flags; /* Event flags as passed to Tcl_DoOneEvent. */
{
FileEvent *evPtr;
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Queue events for any ready files that don't already have events
* queued (caused by persistent states that won't generate WinSock
* events).
*/
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
}
\f
/*----------------------------------------------------------------------
*
* FileEventProc --
*
* This function is invoked by Tcl_ServiceEvent when a file event
* reaches the front of the event queue. This procedure invokes
* Tcl_NotifyChannel on the file.
*
* Results:
* Returns 1 if the event was handled, meaning it should be removed
* from the queue. Returns 0 if the event was not handled, meaning
* it should stay on the queue. The only time the event isn't
* handled is if the TCL_FILE_EVENTS flag bit isn't set.
*
* Side effects:
* Whatever the notifier callback does.
*
*----------------------------------------------------------------------
*/
static int
FileEventProc(evPtr, flags)
Tcl_Event *evPtr; /* Event to service. */
int flags; /* Flags that indicate what events to
* handle, such as TCL_FILE_EVENTS. */
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
}
/*
* Search through the list of watched files for the one whose handle
* matches the event. We do this rather than simply dereferencing
* the handle in the event so that files can be deleted while the
* event is in the queue.
*/
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (fileEvPtr->infoPtr == infoPtr) {
infoPtr->flags &= ~(FILE_PENDING);
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
break;
}
}
return 1;
}
\f
/*
*----------------------------------------------------------------------
*
* FileBlockProc --
*
* Set blocking or non-blocking mode on channel.
*
* Results:
* 0 if successful, errno when failed.
*
* Side effects:
* Sets the device into blocking or non-blocking mode.
*
*----------------------------------------------------------------------
*/
static int
FileBlockProc(instanceData, mode)
ClientData instanceData; /* Instance data for channel. */
int mode; /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
/*
* Files on Windows can not be switched between blocking and nonblocking,
* hence we have to emulate the behavior. This is done in the input
* function by checking against a bit in the state. We set or unset the
* bit here to cause the input function to emulate the correct behavior.
*/
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= FILE_ASYNC;
} else {
infoPtr->flags &= ~(FILE_ASYNC);
}
return 0;
}
\f
/*
*----------------------------------------------------------------------
*
* FileCloseProc --
*
* Closes the IO channel.
*
* Results:
* 0 if successful, the value of errno if failed.
*
* Side effects:
* Closes the physical channel
*
*----------------------------------------------------------------------
*/
static int
FileCloseProc(instanceData, interp)
ClientData instanceData; /* Pointer to FileInfo structure. */
Tcl_Interp *interp; /* Not used. */
{
FileInfo *fileInfoPtr = (FileInfo *) instanceData;
FileInfo **nextPtrPtr;
int errorCode = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Remove the file from the watch list.
*/
FileWatchProc(instanceData, 0);
/*
* Don't close the Win32 handle if the handle is a standard channel
* during the exit process. Otherwise, one thread may kill the stdio
* of another.
*/
if (!TclInExit()
|| ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
if (CloseHandle(fileInfoPtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
errorCode = errno;
}
}
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == fileInfoPtr) {
(*nextPtrPtr) = fileInfoPtr->nextPtr;
break;
}
}
ckfree((char *)fileInfoPtr);
return errorCode;
}
\f
/*
*----------------------------------------------------------------------
*
* FileSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
*
* Results:
* -1 if failed, the new position if successful. If failed, it
* also sets *errorCodePtr to the error code.
*
* Side effects:
* Moves the location at which the channel will be accessed in
* future operations.
*
*----------------------------------------------------------------------
*/
static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
ClientData instanceData; /* File state. */
long offset; /* Offset to seek to. */
int mode; /* Relative to where should we seek? */
int *errorCodePtr; /* To store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD moveMethod;
DWORD newPos, newPosHigh;
DWORD oldPos, oldPosHigh;
*errorCodePtr = 0;
if (mode == SEEK_SET) {
moveMethod = FILE_BEGIN;
} else if (mode == SEEK_CUR) {
moveMethod = FILE_CURRENT;
} else {
moveMethod = FILE_END;
}
/*
* Save our current place in case we need to roll-back the seek.
*/
oldPosHigh = (DWORD)0;
oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
FILE_CURRENT);
if (oldPos == INVALID_SET_FILE_POINTER) {
int winError = GetLastError();
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
moveMethod);
if (newPos == INVALID_SET_FILE_POINTER) {
int winError = GetLastError();
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
/*
* Check for expressability in our return type, and roll-back otherwise.
*/
if (newPosHigh != 0) {
*errorCodePtr = EOVERFLOW;
SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
return -1;
}
return (int) newPos;
}
\f
/*
*----------------------------------------------------------------------
*
* FileWideSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
*
* Results:
* -1 if failed, the new position if successful. If failed, it
* also sets *errorCodePtr to the error code.
*
* Side effects:
* Moves the location at which the channel will be accessed in
* future operations.
*
*----------------------------------------------------------------------
*/
static Tcl_WideInt
FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
ClientData instanceData; /* File state. */
Tcl_WideInt offset; /* Offset to seek to. */
int mode; /* Relative to where should we seek? */
int *errorCodePtr; /* To store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD moveMethod;
DWORD newPos, newPosHigh;
*errorCodePtr = 0;
if (mode == SEEK_SET) {
moveMethod = FILE_BEGIN;
} else if (mode == SEEK_CUR) {
moveMethod = FILE_CURRENT;
} else {
moveMethod = FILE_END;
}
newPosHigh = (DWORD)(offset >> 32);
newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
moveMethod);
if (newPos == INVALID_SET_FILE_POINTER) {
int winError = GetLastError();
if (winError != NO_ERROR) {
TclWinConvertError(winError);
*errorCodePtr = errno;
return -1;
}
}
return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
}
\f
/*
*----------------------------------------------------------------------
*
* FileInputProc --
*
* Reads input from the IO channel into the buffer given. Returns
* count of how many bytes were actually read, and an error indication.
*
* Results:
* A count of how many bytes were read is returned and an error
* indication is returned in an output argument.
*
* Side effects:
* Reads input from the actual channel.
*
*----------------------------------------------------------------------
*/
static int
FileInputProc(instanceData, buf, bufSize, errorCode)
ClientData instanceData; /* File state. */
char *buf; /* Where to store data read. */
int bufSize; /* How much space is available
* in the buffer? */
int *errorCode; /* Where to store error code. */
{
FileInfo *infoPtr;
DWORD bytesRead;
*errorCode = 0;
infoPtr = (FileInfo *) instanceData;
/*
* Note that we will block on reads from a console buffer until a
* full line has been entered. The only way I know of to get
* around this is to write a console driver. We should probably
* do this at some point, but for now, we just block. The same
* problem exists for files being read over the network.
*/
if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
(LPOVERLAPPED) NULL) != FALSE) {
return bytesRead;
}
TclWinConvertError(GetLastError());
*errorCode = errno;
if (errno == EPIPE) {
return 0;
}
return -1;
}
\f
/*
*----------------------------------------------------------------------
*
* FileOutputProc --
*
* Writes the given output on the IO channel. Returns count of how
* many characters were actually written, and an error indication.
*
* Results:
* A count of how many characters were written is returned and an
* error indication is returned in an output argument.
*
* Side effects:
* Writes output on the actual channel.
*
*----------------------------------------------------------------------
*/
static int
FileOutputProc(instanceData, buf, toWrite, errorCode)
ClientData instanceData; /* File state. */
CONST char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCode; /* Where to store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD bytesWritten;
*errorCode = 0;
/*
* If we are writing to a file that was opened with O_APPEND, we need to
* seek to the end of the file before writing the current buffer.
*/
if (infoPtr->flags & FILE_APPEND) {
SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
}
if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
(LPOVERLAPPED) NULL) == FALSE) {
TclWinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
infoPtr->dirty = 1;
return bytesWritten;
}
\f
/*
*----------------------------------------------------------------------
*
* FileWatchProc --
*
* Called by the notifier to set up to watch for events on this
* channel.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
FileWatchProc(instanceData, mask)
ClientData instanceData; /* File state. */
int mask; /* What events to watch for; OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
Tcl_Time blockTime = { 0, 0 };
/*
* Since the file is always ready for events, we set the block time
* to zero so we will poll.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
}
}
\f
/*
*----------------------------------------------------------------------
*
* FileGetHandleProc --
*
* Called from Tcl_GetChannelHandle to retrieve OS handles from
* a file based channel.
*
* Results:
* Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
* there is no handle for the specified direction.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
FileGetHandleProc(instanceData, direction, handlePtr)
ClientData instanceData; /* The file state. */
int direction; /* TCL_READABLE or TCL_WRITABLE */
ClientData *handlePtr; /* Where to store the handle. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
if (direction & infoPtr->validMask) {
*handlePtr = (ClientData) infoPtr->handle;
return TCL_OK;
} else {
return TCL_ERROR;
}
}
\f
/*
*----------------------------------------------------------------------
*
* TclpOpenFileChannel --
*
* Open an File based channel on Unix systems.
*
* Results:
* The new channel or NULL. If NULL, the output argument
* errorCodePtr is set to a POSIX error.
*
* Side effects:
* May open the channel and may cause creation of a file on the
* file system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
TclpOpenFileChannel(interp, pathPtr, mode, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
Tcl_Obj *pathPtr; /* Name of file to open. */
int mode; /* POSIX mode. */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
{
Tcl_Channel channel = 0;
int channelPermissions;
DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
CONST TCHAR *nativeName;
DCB dcb;
HANDLE handle;
char channelName[16 + TCL_INTEGER_SPACE];
TclFile readFile = NULL;
TclFile writeFile = NULL;
nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
return NULL;
}
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
accessMode = GENERIC_READ;
channelPermissions = TCL_READABLE;
break;
case O_WRONLY:
accessMode = GENERIC_WRITE;
channelPermissions = TCL_WRITABLE;
break;
case O_RDWR:
accessMode = (GENERIC_READ | GENERIC_WRITE);
channelPermissions = (TCL_READABLE | TCL_WRITABLE);
break;
default:
panic("TclpOpenFileChannel: invalid mode value");
break;
}
/*
* Map the creation flags to the NT create mode.
*/
switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
case (O_CREAT | O_EXCL):
case (O_CREAT | O_EXCL | O_TRUNC):
createMode = CREATE_NEW;
break;
case (O_CREAT | O_TRUNC):
createMode = CREATE_ALWAYS;
break;
case O_CREAT:
createMode = OPEN_ALWAYS;
break;
case O_TRUNC:
case (O_TRUNC | O_EXCL):
createMode = TRUNCATE_EXISTING;
break;
default:
createMode = OPEN_EXISTING;
break;
}
/*
* If the file is being created, get the file attributes from the
* permissions argument, else use the existing file attributes.
*/
if (mode & O_CREAT) {
if (permissions & S_IWRITE) {
flags = FILE_ATTRIBUTE_NORMAL;
} else {
flags = FILE_ATTRIBUTE_READONLY;
}
} else {
flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
}
/*
* Set up the file sharing mode. We want to allow simultaneous access.
*/
shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
/*
* Now we get to create the file.
*/
handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
shareMode, NULL, createMode, flags, (HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"",
Tcl_GetString(pathPtr), "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
type = GetFileType(handle);
/*
* If the file is a character device, we need to try to figure out
* whether it is a serial port, a console, or something else. We
* test for the console case first because this is more common.
*/
if (type == FILE_TYPE_CHAR) {
if (GetConsoleMode(handle, &consoleParams)) {
type = FILE_TYPE_CONSOLE;
} else {
dcb.DCBlength = sizeof( DCB ) ;
if (GetCommState(handle, &dcb)) {
type = FILE_TYPE_SERIAL;
}
}
}
channel = NULL;
switch (type) {
case FILE_TYPE_SERIAL:
/*
* Reopen channel for OVERLAPPED operation
* Normally this shouldn't fail, because the channel exists
*/
handle = TclWinSerialReopen(handle, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't reopen serial \"",
Tcl_GetString(pathPtr), "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
channel = TclWinOpenSerialChannel(handle, channelName,
channelPermissions);
break;
case FILE_TYPE_CONSOLE:
channel = TclWinOpenConsoleChannel(handle, channelName,
channelPermissions);
break;
case FILE_TYPE_PIPE:
if (channelPermissions & TCL_READABLE) {
readFile = TclWinMakeFile(handle);
}
if (channelPermissions & TCL_WRITABLE) {
writeFile = TclWinMakeFile(handle);
}
channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
break;
case FILE_TYPE_CHAR:
case FILE_TYPE_DISK:
case FILE_TYPE_UNKNOWN:
channel = TclWinOpenFileChannel(handle, channelName,
channelPermissions,
(mode & O_APPEND) ? FILE_APPEND : 0);
break;
default:
/*
* The handle is of an unknown type, probably /dev/nul equivalent
* or possibly a closed handle.
*/
channel = NULL;
Tcl_AppendResult(interp, "couldn't open \"",
Tcl_GetString(pathPtr), "\": ",
"bad file type", (char *) NULL);
break;
}
return channel;
}
\f
/*
*----------------------------------------------------------------------
*
* Tcl_MakeFileChannel --
*
* Creates a Tcl_Channel from an existing platform specific file
* handle.
*
* Results:
* The Tcl_Channel created around the preexisting file.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_MakeFileChannel(rawHandle, mode)
ClientData rawHandle; /* OS level handle */
int mode; /* ORed combination of TCL_READABLE and
* TCL_WRITABLE to indicate file mode. */
{
char channelName[16 + TCL_INTEGER_SPACE];
Tcl_Channel channel = NULL;
HANDLE handle = (HANDLE) rawHandle;
HANDLE dupedHandle;
DCB dcb;
DWORD consoleParams, type;
TclFile readFile = NULL;
TclFile writeFile = NULL;
BOOL result;
if (mode == 0) {
return NULL;
}
/*
* GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles.
*/
type = GetFileType(handle);
/*
* If the file is a character device, we need to try to figure out
* whether it is a serial port, a console, or something else. We
* test for the console case first because this is more common.
*/
if (type == FILE_TYPE_CHAR) {
if (GetConsoleMode(handle, &consoleParams)) {
type = FILE_TYPE_CONSOLE;
} else {
dcb.DCBlength = sizeof( DCB ) ;
if (GetCommState(handle, &dcb)) {
type = FILE_TYPE_SERIAL;
}
}
}
switch (type)
{
case FILE_TYPE_SERIAL:
channel = TclWinOpenSerialChannel(handle, channelName, mode);
break;
case FILE_TYPE_CONSOLE:
channel = TclWinOpenConsoleChannel(handle, channelName, mode);
break;
case FILE_TYPE_PIPE:
if (mode & TCL_READABLE)
{
readFile = TclWinMakeFile(handle);
}
if (mode & TCL_WRITABLE)
{
writeFile = TclWinMakeFile(handle);
}
channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
break;
case FILE_TYPE_DISK:
case FILE_TYPE_CHAR:
channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
break;
case FILE_TYPE_UNKNOWN:
default:
/*
* The handle is of an unknown type. Test the validity of this OS
* handle by duplicating it, then closing the dupe. The Win32 API
* doesn't provide an IsValidHandle() function, so we have to emulate
* it here. This test will not work on a console handle reliably,
* which is why we can't test every handle that comes into this
* function in this way.
*/
result = DuplicateHandle(GetCurrentProcess(), handle,
GetCurrentProcess(), &dupedHandle, 0, FALSE,
DUPLICATE_SAME_ACCESS);
if (result != 0) {
/*
* Unable to make a duplicate. It's definately invalid at this
* point.
*/
return NULL;
}
/*
* Use structured exception handling (Win32 SEH) to protect the close
* of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
*/
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"movl %esp, _ESP" "\n\t"
"movl %ebp, _EBP");
__asm__ __volatile__ (
"pushl $__except_makefilechannel_handler" "\n\t"
"pushl %fs:0" "\n\t"
"mov %esp, %fs:0");
result = 0;
#else
__try {
#endif /* HAVE_NO_SEH */
CloseHandle(dupedHandle);
#ifdef HAVE_NO_SEH
__asm__ __volatile__ (
"jmp makefilechannel_pop" "\n"
"makefilechannel_reentry:" "\n\t"
"movl _ESP, %esp" "\n\t"
"movl _EBP, %ebp");
result = 1; /* True when exception was raised */
__asm__ __volatile__ (
"makefilechannel_pop:" "\n\t"
"mov (%esp), %eax" "\n\t"
"mov %eax, %fs:0" "\n\t"
"add $8, %esp");
if (result)
return NULL;
#else
}
__except (EXCEPTION_EXECUTE_HANDLER) {
/*
* Definately an invalid handle. So, therefore, the original
* is invalid also.
*/
return NULL;
}
#endif /* HAVE_NO_SEH */
/* Fall through, the handle is valid. */
/*
* Create the undefined channel, anyways, because we know the handle
* is valid to something.
*/
channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
}
return channel;
}
#ifdef HAVE_NO_SEH
static
__attribute__ ((used,/* pir - 23.12.2005 */cdecl))
EXCEPTION_DISPOSITION
_except_makefilechannel_handler(
struct _EXCEPTION_RECORD *ExceptionRecord,
void *EstablisherFrame,
struct _CONTEXT *ContextRecord,
void *DispatcherContext)
{
__asm__ __volatile__ (
"jmp makefilechannel_reentry");
return 0; /* Function does not return */
}
#endif
\f
/*
*----------------------------------------------------------------------
*
* TclpGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
* Results:
* Returns the specified default standard channel, or NULL.
*
* Side effects:
* May cause the creation of a standard channel and the underlying
* file.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
TclpGetDefaultStdChannel(type)
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel;
HANDLE handle;
int mode;
char *bufMode;
DWORD handleId; /* Standard handle to retrieve. */
switch (type) {
case TCL_STDIN:
handleId = STD_INPUT_HANDLE;
mode = TCL_READABLE;
bufMode = "line";
break;
case TCL_STDOUT:
handleId = STD_OUTPUT_HANDLE;
mode = TCL_WRITABLE;
bufMode = "line";
break;
case TCL_STDERR:
handleId = STD_ERROR_HANDLE;
mode = TCL_WRITABLE;
bufMode = "none";
break;
default:
panic("TclGetDefaultStdChannel: Unexpected channel type");
break;
}
handle = GetStdHandle(handleId);
/*
* Note that we need to check for 0 because Windows may return 0 if this
* is not a console mode application, even though this is not a valid
* handle.
*/
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
return (Tcl_Channel) NULL;
}
channel = Tcl_MakeFileChannel(handle, mode);
if (channel == NULL) {
return (Tcl_Channel) NULL;
}
/*
* Set up the normal channel options for stdio handles.
*/
if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
"auto") == TCL_ERROR)
|| (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
"\032 {}") == TCL_ERROR)
|| (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
"-buffering", bufMode) == TCL_ERROR)) {
Tcl_Close((Tcl_Interp *) NULL, channel);
return (Tcl_Channel) NULL;
}
return channel;
}
\f
/*
*----------------------------------------------------------------------
*
* TclWinOpenFileChannel --
*
* Constructs a File channel for the specified standard OS handle.
* This is a helper function to break up the construction of
* channels into File, Console, or Serial.
*
* Results:
* Returns the new channel, or NULL.
*
* Side effects:
* May open the channel and may cause creation of a file on the
* file system.
*
*----------------------------------------------------------------------
*/
Tcl_Channel
TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
HANDLE handle;
char *channelName;
int permissions;
int appendMode;
{
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr;
tsdPtr = FileInit();
/*
* See if a channel with this handle already exists.
*/
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->handle == (HANDLE) handle) {
return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
}
}
infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
infoPtr->nextPtr = tsdPtr->firstFilePtr;
tsdPtr->firstFilePtr = infoPtr;
infoPtr->validMask = permissions;
infoPtr->watchMask = 0;
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
wsprintfA(channelName, "file%lx", (int) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
(ClientData) infoPtr, permissions);
/*
* Files have default translation of AUTO and ^Z eof char, which
* means that a ^Z will be accepted as EOF when reading.
*/
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
return infoPtr->channel;
}
/*
*----------------------------------------------------------------------
*
* TclWinFlushDirtyChannels --
*
* Flush all dirty channels to disk, so that requesting the
* size of any file returns the correct value.
*
* Results:
* None.
*
* Side effects:
* Information is actually written to disk now, rather than
* later. Don't call this too often, or there will be a
* performance hit (i.e. only call when we need to ask for
* the size of a file).
*
*----------------------------------------------------------------------
*/
void
TclWinFlushDirtyChannels ()
{
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr;
tsdPtr = FileInit();
/*
* Flush all channels which are dirty, i.e. may have data pending
* in the OS
*/
for (infoPtr = tsdPtr->firstFilePtr;
infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->dirty) {
FlushFileBuffers(infoPtr->handle);
infoPtr->dirty = 0;
}
}
}
^ permalink raw reply [flat|nested] 12+ messages in thread
* FW: Can't build Insight with Cygwin
@ 2005-12-23 16:09 Peter Rockett
0 siblings, 0 replies; 12+ messages in thread
From: Peter Rockett @ 2005-12-23 16:09 UTC (permalink / raw)
To: insight
Hi
Thanks, Wilfred! This at least confirms my view that there did not seem to
be any regular way this source could build. If I read it right, Dave Korn
has confirmed that the Win32Dll.c code relies on an idiosyncrasy of an
earlier version of gcc. Wilfred, can you post a patch? I have read Dave
Korn's fix but as I have always studiously avoided assembler I just don't
understand what to do to implement it!
BTW: Keith, I have used the latest cygwin download which I think is gcc
3.4... (see Dave Korn's post). I am interested in Insight under Windows
because I have used MSVC in the past (great debugger!) but want to migrate
to gnu for cross-platform reasons. There's a lot of IDEs available for gcc
but debugging support is generally poor. Hence the interest in Insight.
Keith, I guess the cygwin compiler on your Win2K box is an old version...
Finally, I tried building with mingw 3.4.4 and the offending section in
tcl/win seems to build OK!! But mingw breaks on the ./bfd sub-directory.
Output below. Any ideas on this one? This looks like something has coughed
in the make file - again, I've studiously avoided using make...
Peter
############################################################################
#############################
>
> make[2]: Entering directory `/c/insight-6.4/bfd'
> Making info in doc
> make[3]: Entering directory `/c/insight-6.4/bfd/doc'
> restore=: && backupdir=".am$$" && \
> am__cwd=`pwd` && cd ../.././bfd/doc && \
> rm -rf $backupdir && mkdir $backupdir && \
> for f in ../.././bfd/doc/bfd.info
> ../.././bfd/doc/bfd.info-[0-9]
> ../.././bfd/doc/bfd.info-[0-9][0-9]
> ../.././bfd/doc/bfd.i[0-9] ../.././bfd/doc/bfd.i[0-9][0-9]; do \
> if test -f $f; then mv $f $backupdir; restore=mv; else :;
> fi; \ done; \ cd "$am__cwd"; \
> if makeinfo --split-size=5000000 --split-size=5000000 -I
> ../.././bfd/doc \
> -o ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \ then \
> rc=0; \
> cd ../.././bfd/doc; \
> else \
> rc=$?; \
> cd ../.././bfd/doc && \
> $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" |
> sed 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc
> section mapping'.ss reference to nonexistent node `mmo a New
> Hash Table Type'.ference to nonexistent node `Deriving
> makeinfo: Removing output file `../.././bfd/doc/bfd.info' due
> to errors; use --force to preserve.
> make[3]: *** [../.././bfd/doc/bfd.info] Error 2
> make[3]: Leaving directory `/c/insight-6.4/bfd/doc'
> make[2]: *** [info-recursive] Error 1
> make[2]: Leaving directory `/c/insight-6.4/bfd'
> make[1]: *** [all-bfd] Error 2
> make[1]: Leaving directory `/c/insight-6.4'
> make: *** [all] Error 2
>
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2005-12-24 0:55 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <200512231852.jBNIq9cM007525@mx1.redhat.com>
2005-12-23 23:19 ` FW: Can't build Insight with Cygwin Keith Seitz
2005-12-24 0:55 ` Peter Rockett
2005-12-24 18:00 ` Spen
[not found] <cmu-lmtpd-20522-1135363936-1@impala>
2005-12-23 22:58 ` Peter Rockett
[not found] <cmu-lmtpd-21756-1135354673-4@impala>
2005-12-23 18:52 ` Peter Rockett
2005-12-23 21:41 ` Peter Rockett
2005-12-24 14:00 ` Keith Seitz
2005-12-23 21:47 ` Spen
[not found] <200512231618.jBNGI4BD085002@mail.cso.atmel.com>
2005-12-23 18:10 ` Eric Weddington
2005-12-23 16:17 wilfried.fauvel
2005-12-23 16:21 ` FW: " Peter Rockett
2005-12-23 16:24 ` Spen
-- strict thread matches above, loose matches on Subject: below --
2005-12-23 16:09 Peter Rockett
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).