Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

SysV shared memory (Look-Alike) -- pure perl

by flexvault (Parson)
on Jul 20, 2014 at 20:42 UTC ( #1094397=CUFP: print w/ replies, xml ) Need Help??

Dear Monks,

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 zentara's excellent work 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 zentara, 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!

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 zentara'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.

Update: Do not use this code as it mixes buffered and unbuffered I/O. See later for a sample that I believe works correctly!

####### 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_IWU +SR 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 Elap +sed time Writes/second # ------------- +---------------------------- my $stime = gettimeofday; my $i = 0; # Result: 2000000 9.27 +134203910828 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 Ela +psed time Writes/second # ------------ +----------------------------- my $file = "/dev/shm/FlexBase/__env.index"; # Result: 2000000 5.7 +3024797439575 349025/second # my $file = "/__env.index"; # Result: 2000000 6.8 +8051080703735 290676/second # my $file = "/flexvault/__env.index"; # Result: 2000000 9.0 +2671384811401 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 fil +e 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 fil +e 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 unp +ack? 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__

Regards...Ed

"Well done is better than well said." - Benjamin Franklin

Comment on SysV shared memory (Look-Alike) -- pure perl
Download Code
Re: SysV shared memory (Look-Alike) -- pure perl
by BrowserUk (Pope) on Jul 21, 2014 at 00:30 UTC
    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.)

    Not to detract from your code -- if it achieves your goals, its perfect -- but by way of comparison with using real shared ram.

    The following does 32 million fully interlocked writes (32 threads x 1e6) to real shared memory in 4.17 seconds (7.6M wps):

    C:\test\lockfree>type lockfree.c #include <windows.h> #include <stdio.h> #include <time.h> #include <process.h> typedef struct { int i; int loops; } shared; void worker( void *arg ) { shared *s = (shared*)arg; int i = 0; for( i=0; i < s->loops; ++i ) { _InterlockedIncrement( &s->i ); } return; } void main( int argc, char **argv ) { int i = 0, nThreads = 4; clock_t start, finish; double elapsed; uintptr_t threads[32]; shared s = { 0, 1000000 };; if( argc > 1 ) nThreads = atol( argv[1] ); if( argc > 2 ) s.loops = atol( argv[2] ); printf( "threads:%d loops:%d\n", nThreads, s.loops ); start = clock(); for( i=0; i < nThreads; ++i ) threads[ i ] = _beginthread( &worker, 0, &s ); WaitForMultipleObjects( nThreads, (HANDLE*)&threads, 1, INFINITE ) +; finish = clock(); elapsed = (double)(finish - start) / CLOCKS_PER_SEC; printf( "count: %lu time:%.6f\n", s.i, elapsed ); }

    A run:

    C:\test\lockfree>lockfree 32 1000000 threads:32 loops:1000000 count: 32000000 time:4.171000

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      Good Day BrowserUk,

      Your 'C' example brought up a very good point, and one that I've been pulling my hair out ever since your response. I re-wrote the script to use 'fork' to see how multiple processes would run. To my amazement the higher the fork number the greater the throughput. Since the test machine has 6 core and with 6 forks, all cores are running at 100%, adding more processes should not improve the wps. But it did! I just got better and better throughput.

      But, because I'm using a file, I could look at the contents and the more processes, the more corrupt the file became. A little while ago, I found my problem.

      The 'flock' function wasn't working with the 'sys...' functions ( sysread, syswrite, etc ). I still want to check this out, but I wanted you to know that my new good numbers are way less than what I originally published.

      Regards...Ed

      "Well done is better than well said." - Benjamin Franklin

Re: SysV shared memory (Look-Alike) -- pure perl
by oiskuu (Friar) on Jul 22, 2014 at 22:52 UTC

    There's hardly any reason to use SysV shared memory these days. Not for performance, anyway. Plain mmap of a regular file, or anonymous mapping (parent/child scenario) will accomplish much the same. The SysV interface could be convenient in some cases; one example is/was postgres:

    PostgreSQL uses System V shared memory, because it provides a feature that is available via neither of the other two systems: the ability to atomically determine the number of processes attached to the shared memory segment.

    In your code, the shmwrite() usage is not particularity efficient. (On Linux) each of those writes translate to three system calls — shmctl/shmat/shmdt — and a full memcpy/memset of the segment. IPC::SysV provides shmat, memwrite; the idea of shared memory is to avoid syscalls in the first place.

    Finally, to benchmark message passing, one needs both a reader and a writer...

      oiskuu,

      Thanks for the response! Some points:

        There's hardly any reason to use SysV shared memory these days.
      Hopefully, that was my point in the first place. I wanted to have an alternative that didn't require SysV ( or mmap ) operating system support. My 1st attempt didn't work since I used both buffered and unbuffered I/O.

        PostgreSQL uses System V shared memory, because it...

      That is how I'm hoping to use this technique. I have a pure-Perl database engine that is basically single user for writing and multi-user for reading within the same environment. It's very fast, but when any single DB within an environment goes past 10MM records the writes drop sharply. Up to about 10MM records the writes are about 3,000/second. Above 10MM records that drops to 1,000 writes/second or worse. But that's not the problem either. The problem is that when the 'writer' is taken longer, the multiple 'readers' performance degradates significantly. Reading sequentially ( 'ReadNext' or 'ReadPrev" ) within the same DB the 'readers' usually perform about 100K reads / second. Above 10MM the reads drop to 20-25K reads / second. This technique would be to allow the writer to indicate which tree leaf the writer is working within. If the reader needs a record from that leaf, they have to wait, but if not then they can proceed with any other leaf.

        to benchmark message passing, one needs both a reader and a writer...

      Agreed, but I was testing that the writers didn't clobber the shared memory. In production, I can 'flock' with 'LOCK_SH' for readers. Each tree leaf is independent of any other tree leaf, so maybe I'll be able to have multi-writers

      I'm going to add the code in the main thread, but I'd appreciate any comments on what it is doing.

      Regards...Ed

      "Well done is better than well said." - Benjamin Franklin

Re: SysV shared memory (Look-Alike) -- pure perl
by flexvault (Parson) on Jul 23, 2014 at 15:34 UTC

    Dear Monks,

    The original code I posted mixed both unbuffered and buffered I/O. With this version, I'm only using unbuffered I/O and hopefully the file does not get clobbered during the processing. The file should allways end with '999999' without a line feed. Your comments are welcome...Ed

    #!/usr/bin/perl use warnings; use strict; use Time::HiRes qw( gettimeofday usleep ); use Fcntl qw( :DEFAULT :flock ); ## Part of core perl my $file = "/dev/shm/FlexBase/__env.index"; # my $file = "/__env.index"; # my $file = "/flexvault/__env.index"; our $PREFORK = 0; our $children = 0; our @CHILDREN = (); our $list + = ""; for $PREFORK ( 1..6 ) { open( my $indexdb,">", $file ) or die "Not open1: $!"; close $ind +exdb; $SIG{CHLD} = 'IGNORE'; $children = 0; @CHILDREN = (); $list = ""; my $stime = gettimeofday; for ( 1 .. $PREFORK ) { my $pid = fork; if ( $pid ) { # parent $CHILDREN[$children] = $pid; $children++; if ( $list ) { $list .= ", $pid"; } else { $list = $pid; } } elsif ( defined $pid ) { # child sysopen( $indexdb, $file, O_RDWR | O_SYNC | O_NONBLOCK ) o +r die "Not open2: $!"; my $i = 0; while( 1 ) { &write_mem($indexdb, $i); $i++; if ( $i >= 1_000_000 ) { last; } } close $indexdb; exit; } else { die "Can't fork: $!"; } } print "$PREFORK children started by $$: $list\n"; while ( 1 ) { usleep 15000; my $child = 0; for my $no ( 0..$#CHILDREN ) { my $pid = $CHILDREN[$no] + 0; if ( kill 0 => $pid ) { $child++; } } if ( $child == 0 ) { last; } } my $Total = $PREFORK * 1_000_000; $stime = gettimeofday - $stime; my $rpm = int( $Total / $stime ); print " $Total $stime $rpm/second \`cat $file\` = "; system("cat $file"); print "\n"; } unlink $file; exit; sub write_mem() { # Write a string to the shared file. my $indexdb = shift; my $message = shift; if ( flock( $indexdb, LOCK_EX ) ) { my $ret = sysseek( $indexdb, 0, 0); # move to beginning of fi +le if ( ! defined $ret ) { die "$$ O04. $message sysseek faile +d: $!\n"; } $ret = syswrite ( $indexdb, $message, length($message), 0 ); if ( $ret != length($message) ) { die "$$ O05. $message|$ret s +yswrite failed! $!\n"; } flock( $indexdb, LOCK_UN ); } else { print "$$ O07. flock failed! $!"; } return 0; } 1; __END__

    Regards...Ed

    "Well done is better than well said." - Benjamin Franklin

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1094397]
Approved by AppleFritter
Front-paged by Old_Gray_Bear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2014-12-18 01:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (41 votes), past polls