commit 910bb7eebc6a092c7e681e8b3febd4104af54836
parent 677fc0e8253ffffa12ccc7082c5d915c6b0fb079
Author: Kyle Milz <kyle@windows.krwm.net>
Date: Mon, 9 Jan 2017 22:16:35 -0800
t: add win32 memory map file support
Diffstat:
3 files changed, 100 insertions(+), 18 deletions(-)
diff --git a/t/mem_unix.pm b/t/mem_unix.pm
@@ -0,0 +1,23 @@
+package t::shm;
+
+use strict;
+use warnings;
+
+use POSIX;
+use Sys::Mmap;
+use autodie;
+
+our $page_mask = POSIX::sysconf(POSIX::_SC_PAGESIZE) - 1;
+
+sub get_mem {
+ my ($self, $procfile) = @_;
+
+ open( FH, "<", $procfile );
+
+ mmap( $self->{mem}, 0, PROT_READ, MAP_SHARED, FH ) or die "mmap: $!";
+ $self->{size} = length $self->{mem};
+
+ close FH;
+}
+
+1;
diff --git a/t/mem_win32.pm b/t/mem_win32.pm
@@ -0,0 +1,71 @@
+package t::shm;
+
+use strict;
+use warnings;
+
+use POSIX; # NULL
+use Win32::API;
+use autodie;
+
+our $page_mask = 64 * 1024 - 1;
+
+use constant GENERIC_READ => 0x80000000;
+use constant OPEN_EXISTING => 3;
+use constant INVALID_HANDLE_VALUE => -1;
+use constant PAGE_READONLY => 0x02;
+use constant FILE_MAP_READ => 0x0004;
+
+sub get_mem {
+ my ($self, $procfile) = @_;
+
+ # Roll our own Perl entry points into windows functions... wtf..
+ my $CreateFile = Win32::API::More->new(
+ 'kernel32', 'HANDLE WINAPI CreateFile(
+ LPCTSTR path,
+ DWORD a,
+ DWORD b,
+ LPSECURITY_ATTRIBUTES c,
+ DWORD d,
+ DWORD e,
+ HANDLE f)'
+ );
+ my $GetFileSize = Win32::API::More->new(
+ 'kernel32', 'HANDLE WINAPI GetFileSize(
+ HANDLE hFile,
+ LPWORD lpFileSizeHigh)'
+ );
+ my $CreateFileMapping = Win32::API::More->new(
+ 'kernel32', 'HANDLE WINAPI CreateFileMapping(
+ HANDLE h,
+ LPSECURITY_ATTRIBUTES lpAttr,
+ DWORD prot,
+ DWORD max_hi,
+ DWORD max_lo,
+ LPCTSTR lp)'
+ );
+ my $MapViewOfFile = Win32::API::More->new(
+ 'kernel32', 'UINT_PTR WINAPI MapViewOfFile(
+ HANDLE h,
+ DWORD acc,
+ DWORD off_hi,
+ DWORD off_lo,
+ SIZE_T len)'
+ );
+
+ my $handle = $CreateFile->Call($procfile, GENERIC_READ, 0, NULL, OPEN_EXISTING, 0, NULL);
+ die "CreateFile" if ($handle == INVALID_HANDLE_VALUE);
+
+ my $size = $GetFileSize->Call($handle, NULL);
+ #die "GetFileSize" if ($size == INVALID_FILE_SIZE);
+
+ my $fm = $CreateFileMapping->Call($handle, NULL, PAGE_READONLY, 0, 0, NULL);
+ die "CreateFileMapping" if ($fm == NULL);
+
+ my $mem = $MapViewOfFile->Call($fm, FILE_MAP_READ, 0, 0, $size);
+ die "MapViewOfFile" unless (defined $mem);
+
+ $self->{mem} = unpack "P$size", pack 'Q', $mem;
+ $self->{size} = $size;
+}
+
+1;
diff --git a/t/shm.pm b/t/shm.pm
@@ -1,26 +1,21 @@
package t::shm;
+
use strict;
use warnings;
+
use Inline 'C';
use POSIX;
-use Sys::Mmap;
+use if $^O eq 'MSWin32', 't::mem_win32';
+use if $^O ne 'MSWin32', 't::mem_unix';
use autodie;
-
sub new {
my ($class, $procfile) = @_;
my $self = {};
bless($self, $class);
- $self->{mem} = '';
- open(FH, "<", $procfile);
- if ($^O ne "MSWin32") {
- mmap($self->{mem}, 0, PROT_READ, MAP_SHARED, FH) or die "mmap: $!";
- }
- close FH;
-
- $self->{size} = length $self->{mem};
+ get_mem( $self, $procfile );
# These functions proved by C code at the end of this file.
my $header_size = citrun_header_size();
@@ -64,14 +59,7 @@ sub new {
sub get_aligned_size {
my ($unaligned_size) = @_;
- my $page_mask;
- if ($^O eq "MSWin32") {
- $page_mask = 64 * 1024 - 1;
- } else {
- $page_mask = POSIX::sysconf(POSIX::_SC_PAGESIZE) - 1;
- }
-
- return ($unaligned_size + $page_mask) & ~$page_mask;
+ return ($unaligned_size + $t::shm::page_mask) & ~$t::shm::page_mask;
}
sub get_buffers {
