I am having some trouble with a Perl - Tk script.
The script follows at the end of this post.
What I am doing is this: I have a GPS satellite clock
connected to serial port /dev/ttyS1 of my x86 linux PC.
This clock spews out 7 lines of information every second.
My script reads these and extracts the UT time from
one of the lines, and then formats it into 2 lines
which are displayed as label widgets.
The trouble is that after about 45 minutes, the script
dumps core with a comment about being "out of memory",
and indeed when I run gdb on the core file, and ask for
a backtrace, I see an endless pattern of calls that fill
the stack. My impression is that every fileevent puts a new
frame on the stack and after enough of this we get into
quite a mess.
A typical session ends like this:
(/u1/tom) trona $ date ; gps ; date
Sun Feb 27 20:05:58 MST 2000
Segmentation fault (core dumped)
Sun Feb 27 20:53:40 MST 2000
(/u1/tom) trona $
As you can see this session went for almost 48 minutes.
If I then do this, and then type "bt" to get a backtrace, I get:
(/u1/tom) trona $ gdb /usr/bin/perl core
Core was generated by `perl ./gps'.
Program terminated with signal 11, Segmentation fault.
Reading symbols from /lib/libnsl.so.1...done.
Reading symbols from /lib/libdb.so.3...done.
Reading symbols from /usr/lib/libgdbm.so.2...done.
Reading symbols from /lib/libdl.so.2...done.
Reading symbols from /lib/libm.so.6...done.
Reading symbols from /lib/libc.so.6...done.
Reading symbols from /lib/libcrypt.so.1...done.
Reading symbols from /lib/ld-linux.so.2...done.
Reading symbols from /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Tk/Event/Event.so...done.
Reading symbols from /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Tk/Tk.so...
done.
Reading symbols from /usr/X11R6/lib/libX11.so.6...done.
Reading symbols from /usr/lib/perl5/5.00503/i386-linux/auto/IO/IO.so...done.
Reading symbols from /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Tk/IO/IO.so...done.
#0 0x808c0f1 in Perl_sv_gets ()
(gdb) bt
#0 0x808c0f1 in Perl_sv_gets ()
#1 0x808578e in Perl_do_readline ()
#2 0x80838a3 in Perl_pp_readline ()
#3 0x80b148d in Perl_runops_standard ()
#4 0x8059951 in perl_call_sv ()
#5 0x8059559 in perl_call_method ()
#6 0x80854b1 in Perl_do_readline ()
#7 0x80838a3 in Perl_pp_readline ()
#8 0x80b148d in Perl_runops_standard ()
#9 0x8059951 in perl_call_sv ()
#10 0x401b006f in LangCallCallback ()
#11 0x401ad0b4 in PerlIOEventProc ()
#12 0x401b0a33 in Tcl_ServiceEvent ()
#13 0x401b0c41 in Tcl_DoOneEvent ()
#14 0x401cefb3 in XS_Tk_DoOneEvent ()
#15 0x8087616 in Perl_pp_entersub ()
#16 0x80b148d in Perl_runops_standard ()
#17 0x8059951 in perl_call_sv ()
#18 0x401b006f in LangCallCallback ()
#19 0x401ad0b4 in PerlIOEventProc ()
#20 0x401b0a33 in Tcl_ServiceEvent ()
#21 0x401b0c41 in Tcl_DoOneEvent ()
#22 0x401cefb3 in XS_Tk_DoOneEvent ()
#23 0x8087616 in Perl_pp_entersub ()
#24 0x80b148d in Perl_runops_standard ()
#25 0x8059951 in perl_call_sv ()
#26 0x401b006f in LangCallCallback ()
#27 0x401ad0b4 in PerlIOEventProc ()
#28 0x401b0a33 in Tcl_ServiceEvent ()
#29 0x401b0c41 in Tcl_DoOneEvent ()
#30 0x401cefb3 in XS_Tk_DoOneEvent ()
#31 0x8087616 in Perl_pp_entersub ()
#32 0x80b148d in Perl_runops_standard ()
#33 0x8059951 in perl_call_sv ()
#34 0x401b006f in LangCallCallback ()
#35 0x401ad0b4 in PerlIOEventProc ()
#36 0x401b0a33 in Tcl_ServiceEvent ()
#37 0x401b0c41 in Tcl_DoOneEvent ()
#38 0x401cefb3 in XS_Tk_DoOneEvent ()
#39 0x8087616 in Perl_pp_entersub ()
.
.
.
And then the stack is filled with the repeating pattern
shown.
-------------------------------------------------------
I am at a bit of a loss of how better to handle this business.
Am I doing something really wrong, or is this some kind of bug?
I am right now in the process of getting Tk800.018 on the odd
chance that this is a bug and has been fixed in the newer version,
but I thought I would post this in any event while I investigate
that, in case some expert out there might be willing to lend a
hand.
In any case perhaps folks could suggest a different
approach that would ultimately be a workaround.
-------------------------
I am running linux (Red Hat 6.0).
I have 128M of physical memory.
perl -v shows me:
This is perl, version 5.005_03 built for i386-linux
I am running Tk800.015.tar.gz, installed with no special twists.
------------------------------ Here is my script.
#!/usr/bin/perl
use Tk;
my $ut,$xx,$lat,$latns,$long,$longew;
# Here is a typical "squirt" of GPS info (without lock)
# Coordinates are at the summit of Mt. Hopkins.
# $GPRMC,000421,V,3141.3453,N,11053.1667,W,000.0,000.0,250200,011.8,E*7F
# $GPGSA,A,1,,,,,,,,,,,,,,,*1E
# $GPGSV,3,1,09,04,12,048,,05,69,195,,06,27,304,,08,21,242,*75
# $GPGSV,3,2,09,09,11,207,,10,52,149,,13,02,103,,24,50,030,*75
# $GPGSV,3,3,09,30,43,309,,,,,,,,,,,,,*4E
# $PGRMV,,,*72
# $PGRME,,,,,,*4D
# Here is a typical "squirt" of GPS info (with lock)
# Coordinates are at my house, 2404 E. Aleppo Place.
# $GPRMC,000319,A,3209.4733,N,11056.1647,W,000.0,259.7,250200,011.9,E*66
# $GPGSA,A,3,04,05,06,09,10,,,24,30,,,,1.8,1.1,1.4*34
# $GPGSV,3,1,09,04,16,047,36,05,73,228,51,06,26,303,50,09,10,205,37*76
# $GPGSV,3,2,09,10,55,137,51,13,02,100,,17,06,236,33,24,54,027,50*70
# $GPGSV,3,3,09,30,47,306,53,,,,,,,,,,,,*43
# $PGRMV,0.0,0.0,0.0*5C
# $PGRME,34.7,M,45.0,M,56.9,M*15
# ---------------------------------------------------------
# initialize serial i/o
$gpssio = "/dev/ttyS1";
system ( "stty speed 9600 < $gpssio >/dev/null" );
$_ = `stty speed < $gpssio`;
# print "line speed = $_";
die "Cannot set line speed for $gpssio" unless /9600/;
# ---------------------------------------------------------
open ( SIO, $gpssio ) or die "Cannot open gps device: $gpssio";
my $mw = MainWindow->new();
$mw->title ( GPS );
$mw->geometry ( "+50+50" );
$mw->Label ( -textvariable => \$cut ) -> pack ();
$mw->Label ( -textvariable => \$clt ) -> pack ();
$mw->fileevent ( SIO, 'readable', [\&gps_line] );
MainLoop;
sub gps_line
{
my $key;
my $hut, $mut, $sut;
if ( $_ = <SIO> ) {
return if /^$/;
next unless /^\$GPRMC/;
($key,$ut,$xx,$lat,$latns,$long,$longew) = split /,/, $_, 7;
($cut = $ut) =~ s/(..)(..)(..)/$1:$2:$3/;
$hut = $1 + 5;
if ( $hut > 23 ) { $hut -= 24 };
$mut = $2;
$sut = $3;
$clt = "$hut:$mut:$sut";
$cut =~ s/^0//;
} else {
$mw->fileevent ( SIO, 'readable', "" );
close SIO;
exit;
}
Quote:
}
# THE END
--
Tom Trebisky MMT Observatory
http://www.*-*-*.com/ ; Tucson, Arizona 85721
(520) 621-5135