CUFP
flexvault
<p><a href="http://www.perlmonks.org/?node_id=109">Dear Monks</a>,</p>
<p>I have stayed away from using shared memory because of the statement: "This function is available only on machines supporting System V IPC." in the documentation for use. I decided I had a good use and did a Super Search and found <a href="http://www.perlmonks.org/?node_id=131741">zentara</a>'s excellent <a href="http://www.perlmonks.org/?node_id=428839">work</a> which I used as a starting point for this discussion. I re-read the documentation and looked at the books 'Programming Perl' and the 'Perl Cookbook', and wondered if I could do something similar with a RAM disk and not have a dependency on System V IPC support. So taking the code provided by <a href="http://www.perlmonks.org/?node_id=131741">zentara</a>, and using it as a benchmark for my requirements, I started testing on a 8GB RAM disk on a Debian 64bit Linux box using a 32-bit 5.14.2 Perl. I found that I could get approximately 216K System V IPC writes per second(wps). WOW!</p><p>
Since I only needed 20-25K writes per second, I started working on my "shared memory look-alike". What I found was that I could do better than 349K wps. Actually the 1st run produced 800K wps, but I realized I didn't follow the format of <a href="http://www.perlmonks.org/?node_id=131741">zentara</a>'s script, so I modified the script to call a subroutine, flock the file, test return codes, etc. Currently, 349K wps is the worse case on a RAM disk, 291K wps on a 7,200 rpm hard disk, and 221K wps on a 5,400 rpm disk. (Note: I didn't have a SSD on the test system.) The code follows, and if I did something to make my numbers look better, I'd like to know.</p><p>
<b>Update: Do not use this code as it mixes buffered and unbuffered I/O. See later for a sample that I believe works correctly!</b>
<code>
####### shmem-init.pl ############################
#!/usr/bin/perl
use warnings;
use strict;
use Time::HiRes qw( gettimeofday usleep );
use Fcntl qw( :DEFAULT :flock ); ## Part of core perl
use IPC::SysV qw(IPC_STAT IPC_PRIVATE IPC_CREAT IPC_EXCL S_IRUSR S_IWUSR IPC_RMID);
# see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV"
# big difference from c is attach and detach is automatic in Perl
# it attaches to read or write, then detaches
my $go = 1;
$SIG{INT} = sub{ $go = 0;
&close_m(); #close up the shared mem
exit;
};
my $segment_hbytes = 0x640; # hex bytes, a multiple of 4k
my ($segment_id, $segment_size) = &init_m($segment_hbytes);
print "shmid-> $segment_id\tsize-> $segment_size\n";
# Counter Elapsed time Writes/second
# -----------------------------------------
my $stime = gettimeofday; my $i = 0; # Result: 2000000 9.27134203910828 215718/second
while($go)
{ &write_m($i);
$i++;
if ( $i >= 2_000_000 )
{ $stime = gettimeofday - $stime; my $rpm = int( 2_000_000 / $stime );
print "$i\t$stime\t$rpm/second\n\n"; last;
}
#select(undef,undef,undef,.001);
last if ! $go;
}
our $indexdb;
# Counter Elapsed time Writes/second
# -----------------------------------------
my $file = "/dev/shm/FlexBase/__env.index"; # Result: 2000000 5.73024797439575 349025/second
# my $file = "/__env.index"; # Result: 2000000 6.88051080703735 290676/second
# my $file = "/flexvault/__env.index"; # Result: 2000000 9.02671384811401 221564/second
open( $indexdb,"+<", $file ) or die "Not open: $!";
$stime = gettimeofday; $i = 0;
while( 1 )
{ &write_mem($i);
$i++;
if ( $i >= 2_000_000 )
{ $stime = gettimeofday - $stime; my $rpm = int( 2_000_000 / $stime );
print "$i\t$stime\t$rpm/second\n"; last;
}
}
close $indexdb;
exit;
sub write_mem()
{ our $indexdb;
# Write a string to the shared file.
my $message = shift;
if ( flock( $indexdb, LOCK_EX ) )
{ my $ret = sysseek( $indexdb, 0, 0); # move to beginning of file
if ( ! defined $ret ) { die "O04. sysseek failed: $!"; }
$ret = syswrite ( $indexdb, $i, length($i) );
if ( $ret != length($i) ) { die "O05. syswrite failed! $!"; }
}
##
## Make test ( 1==1 ) to verify syswrite worked correctly.
## Make test ( 1==2 ) to test speed of syswrite to filesystem.
##
if ( ( 1==2 )&&( flock( $indexdb, LOCK_SH ) ) )
{ my $ret = sysseek( $indexdb, 0, 0); # move to beginning of file
if ( ! defined $ret ) { die "O06. sysseek failed: $!"; }
$ret = sysread ( $indexdb, my $ni, length($i) );
if ( $ni != $i ) { die "O07. |$ni|$i| $!"; }
}
return 0;
}
#################################################################
sub init_m(){
my $segment_hbytes = shift;
# Allocate a shared memory segment.
my $segment_id = shmget (IPC_PRIVATE, $segment_hbytes,
IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR);
# Verify the segment's size.
my $shmbuffer = '';
shmctl ($segment_id, IPC_STAT, $shmbuffer);
my @mdata = unpack("i*",$shmbuffer); #not sure if that is right unpack? works :-)
return($segment_id, $mdata[9] );
}
sub write_m() {
# Write a string to the shared memory segment.
my $message = shift;
shmwrite($segment_id, $message, 0, $segment_size) || die "$!";
#the 0, $segment_size can be broke up into substrings like 0,60
# or 61,195, etc
return 0;
}
sub close_m(){
# Deallocate the shared memory segment.
shmctl ($segment_id, IPC_RMID, 0);
return 0;
}
1;
__END__
</code>
</p>
<p>Regards...Ed</p>
<div class="pmsig"><div class="pmsig-733061">
<p><b>"Well done is better than well said." - Benjamin Franklin</b></p>
</div></div>