[26298] in Perl-Users-Digest
Perl-Users Digest, Issue: 8477 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Oct 2 14:05:22 2005
Date: Sun, 2 Oct 2005 11:05:05 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 2 Oct 2005 Volume: 10 Number: 8477
Today's topics:
IO::All Socket <joe@rockhead.spamfree.freespam.com>
Re: IO::All Socket <1usa@llenroc.ude.invalid>
Re: Need help with pack <socyl@987jk.com.invalid>
Re: threads, XSUB allocated memory, destructors, destru <sisyphus1@nomail.afraid.org>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 02 Oct 2005 10:16:06 -0400
From: joe rockhead <joe@rockhead.spamfree.freespam.com>
Subject: IO::All Socket
Message-Id: <aeudnWM-3bo2dqLeRVn-pQ@speakeasy.net>
I found IO::All on CPAN.org
It includes some descriptions on accepting connections on a socket.
here's what I did with their examples:
#!/usr/bin/perl
use IO::All;
use Perl6::Say;
say "point A";
$server = io('10.0.0.123:12345')->fork; # Create a daemon socket
say "point B \$server = [$server]";
$connection = $server->accept; # Get a connection socket
say "point C \$connection = [$connection]";
$input < $connection; # Get some data from it
say "point D \$input = [$input]";
"Thank you!" > $connection; # Thank the caller
say "point E \$connection = [$connection]";
$connection->close; # Hang up
say "point F";
#io(':6666')->accept->slurp > io->devnull; # Take a complaint and file it
say "point G";
running the program, I get up to point B.
when a connection is made from a remote machine, I get up to point C
then it just seems to hang there no matter what the remote machine does.
the remote session seems to just hang also.
when the remote machine disconnects, I get "Can't open socket" error on the server side.
right now I just want to be able to accept input and perhaps print something out.
------------------------------
Date: Sun, 02 Oct 2005 15:26:15 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: IO::All Socket
Message-Id: <Xns96E3745A2623asu1cornelledu@127.0.0.1>
joe rockhead <joe@rockhead.spamfree.freespam.com> wrote in
news:aeudnWM-3bo2dqLeRVn-pQ@speakeasy.net:
> I found IO::All on CPAN.org
> It includes some descriptions on accepting connections on a socket.
>
> here's what I did with their examples:
>
> #!/usr/bin/perl
>
> use IO::All;
> use Perl6::Say;
You are missing
use strict;
use warnings;
>
> say "point A";
> $server = io('10.0.0.123:12345')->fork; # Create a
> daemon socket say "point B \$server = [$server]";
I think this creates an implicit while-accept loop around the following
code.
> $connection = $server->accept; # Get a connection socket
> say "point C \$connection = [$connection]";
> $input < $connection; # Get some data from it
The server is waiting for *all* the data to be received from the client.
The only way for that to happen is for the client to somehow signal it
will not be sending any more data. I don't know how to do that using
telnet, but in Perl, I would use shutdown. The only way I could do that
using telnet was to just close the connection.
> say "point D \$input = [$input]";
> "Thank you!" > $connection; # Thank the caller
So, by this time, the connection is closed.
By the way, if you really like useless right margin comments, at least
look into Smart::Comments. Note that, although it seemed to work, I was
getting warnings from it, so it is not used in the code below:
#!/usr/bin/perl
use strict;
use warnings;
use IO::All;
warn "### Create server\n";
my $server = io('127.0.0.1:12345')->fork;
warn "### Waiting for connection\n";
my $connection = $server->accept;
warn "### $connection\n";
warn "### Reading input\n";
my $input = $connection->getline;
warn "### Input = $input\n";
warn "### Sending response\n";
$connection->print("Thank you\n");
warn "### Response sent\n";
warn "### Closing connection\n";
$connection->close;
__END__
The server won't terminate. I am not sure how to get it to terminate
after serving one connection. When run, and sent "hello" using telnet,
the script produces:
### IO::All::Socket=GLOB(0x1d03558)
### Reading input
### Input = hello
### Sending response
### Response sent
### Closing connection
and I get:
Thank you
Connection to host lost.
In the telnet window.
Sinan
--
A. Sinan Unur <1usa@llenroc.ude.invalid>
(reverse each component and remove .invalid for email address)
comp.lang.perl.misc guidelines on the WWW:
http://mail.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html
------------------------------
Date: Sun, 2 Oct 2005 16:32:02 +0000 (UTC)
From: kj <socyl@987jk.com.invalid>
Subject: Re: Need help with pack
Message-Id: <dhp222$ljc$1@reader1.panix.com>
In <dhn80f$4vn$1@mamenchi.zrz.TU-Berlin.DE> anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
>kj <nomail@inval.id> wrote in comp.lang.perl.misc:
>I'll show how to generate a string (not an array) of zeroes and ones.
>You need two steps. First use the "f" template (single-precision float)
>to get the four bytes that make up a 32-bit float into a string. If
>the number is in $_:
> my $str = pack 'f', $_;
>Next, unpack the result as a bit string, using the "b" template
> my $bits = unpack 'b32', $str;
>Run it for a few examples
> printf "%.3f -> %s\n", $_, unpack 'b32', pack 'f', $_ for
> 1/8, 1/4, 1/2, 1, 2, 4, 8;
>and see if you can make heads or tails of the output. The bytes may not
>be in the expected order. On my machine, I get:
>0.125 -> 01111100000000000000000000000000
>0.250 -> 01111100000000010000000000000000
>0.500 -> 11111100000000000000000000000000
>1.000 -> 11111100000000010000000000000000
>2.000 -> 00000010000000000000000000000000
>4.000 -> 00000010000000010000000000000000
>8.000 -> 10000010000000000000000000000000
>If you want an array, either split the result in single characters, or
>use
> map vec( $str, $_, 1), 0 .. 31
>instead of unpacking with "b".
Thank you very much. That was very helpful.
BTW, I was surprised to discover that the vec alternative is about
2.5x faster than unpack+split:
0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1.1.1.1.1.1.1.0.0
0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1.1.1.1.1.1.1.0.0
Rate unp vec
unp 26305/s -- -61%
vec 67622/s 157% --
I give the code below.
kj
use Benchmark 'cmpthese';
$::f = pack 'f', 1;
my $subs = {vec => 'map vec($::f, $_, 1), 0..31',
unp => 'split "", unpack "b32", $::f'};
# check that both work and produce the same result
{
local ($\, $,) = ("\n", '.');
print eval('sub {'.$subs->{ $_ }.'}')->(), "\n" for qw(vec unp);
}
# benchmark
cmpthese -1, $subs;
__END__
--
NOTE: In my address everything before the first period is backwards;
and the last period, and everything after it, should be discarded.
------------------------------
Date: Sun, 2 Oct 2005 17:43:08 +1000
From: "Sisyphus" <sisyphus1@nomail.afraid.org>
Subject: Re: threads, XSUB allocated memory, destructors, destruction
Message-Id: <433f8fca$0$20355$afc38c87@news.optusnet.com.au>
"Andrew Torda" <please_no_mail@zbh.uni-hamburg.de> wrote in message
news:dhjp8d$a4l$1@rzsun03.rrz.uni-hamburg.de...
> I have a perl module built out of XSUBs.
> The functions malloc() space, build structures and return
> pointers to perl. Perl calls their destructor routines with no
> problems. The C structures go back to the perl interpreter, as
> T_PTROBJ things, specified in a typemap file.
>
> Now, if I use threads, I
> make lots of new data
> break my arrays into 2 pieces
> threads->new( myfunc, @array_to_read_from);
> threads->new( myfunc, @array_to_read_from);
> thread[0]->join
> thread[1]->join
>
> Unfortunately, at the join() stage, each thread decides to
> cleanup, and call the destructors for my @array_to_read_from.
> Obviously free() gets called multiple times, terrible things
> happen to the heap and everything dies.
>
Can't quite reproduce the exact problem. I gather that '@array_to_read_from'
is an array of these "pointer" objects. Below my sig is an Inline::C script
that (I think) does pretty much as described (and not much else). It doesn't
use a typemap, but I don't think there's any relevance in that.
I find that there's no problem at the join() stage. The cleanup of the
pointer objects does not take place (afaict) until the script is about to
exit (which is as it should be). At that time, however, a problem usually
(but not always) does arise - after the majority of the pointer objects have
been freed, I get (on Win32) the "Free to wrong pool...during global
destruction" error. (That's a problem - but it may be a Win32-specific
issue, so I won't go delving into that just yet. Which OS are you on ? I was
going to give the script a run on Linux .... but my perl on Linux wasn't
built with threads support.)
Anyway ... the output I get looks like this:
Thread started
Thread started
Thread started
200 400 650
All joined
destroying int object
int object destroyed
destroying int object
int object destroyed
.
.
.
destroying int object
int object destroyed
destroying int object
Free to wrong pool b39078 not c5d040 during global destruction.
If you already have (or can be bothered installing) Inline::C then you might
run the script and check that the problem really does occur when you think
it does. Otoh, I might have been way off-beam with my interpretation of what
you've said - and/or my script may be irrelevant to the problem you're
facing - in which case feel free to modify it to better demonstrate the
issue at hand.
(Btw, with that script, I've established that the cleanup problem *is*
associated with the using of threads. If I remove the threads stuff , then
the cleanup proceeds smoothly every time. I also tried replacing malloc/free
with New/Safefree, but it made no difference - which is not surprising.)
Hth - but don't stress too much if it doesn't :-)
Cheers,
Rob
use warnings;
use threads;
package Experimental;
use Inline C => Config =>
BUILD_NOISY => 1;
use Inline C => <<'EOC';
SV * create_int_obj(SV * x) {
int * int_obj, i, s;
SV * obj_ref, * obj;
s = (int)SvUV(x);
/* Allocate space for s ints */
/* New(1, int_obj, s, int); */
int_obj = malloc(sizeof(int) * s);
if(int_obj == NULL) croak("Failed to allocate memory in create_int_obj
function");
obj_ref = newSViv(0);
obj = newSVrv(obj_ref, "Experimental");
sv_setiv(obj, (IV)int_obj);
SvREADONLY_on(obj);
return obj_ref;
}
void DESTROY(SV * m) {
printf("destroying int object\n");
/* Safefree((int *) SvIV(SvRV(m))); */
free((int *) SvIV(SvRV(m)));
printf("int object destroyed\n");
}
EOC
# Create an array of 200 pointer objects
@array_to_read_from_1 = create_em(200);
# Create an array of 400 pointer objects.
@array_to_read_from_2 = create_em(400);
# Create an array of 650 pointers.
@array_to_read_from_3 = create_em(650);
$thread1 = threads->new("start_thread", @array_to_read_from_1);
$thread2 = threads->new("start_thread", @array_to_read_from_2);
$thread3 = threads->new("start_thread", @array_to_read_from_3);
$s1 = $thread1->join;
$s2 = $thread2->join;
$s3 = $thread3->join;
print "$s1 $s2 $s3\n";
print "All joined\n";
sleep(2);
# Then usually crashes at some time during the destruction of
# the pointer objects with the error "Free to wrong pool...during global
destruction"
sub start_thread {
print "Thread started\n";
return scalar(@_);
}
sub create_em {
# Return an array of pointer objects.
my @ret = ();
for(1..$_[0]) { push(@ret, create_int_obj(10 + int(rand(10))))}
return @ret;
}
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 8477
***************************************
