Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

BrowserUk's scratchpad

by BrowserUk (Pope)
on Jun 01, 2004 at 22:28 UTC ( #358718=scratchpad: print w/ replies, xml ) Need Help??

For erix

#! perl -slw use strict; our $N //= 10e3; open O, '>', 'clusters.dat' or die $!; my( $n, %uniq ) = 0; while( $n < $N ) { my $fac = ('A'..'Z')[ rand 26 ]; my $seq = 'seq'.int(rand 25); my $pos = int( rand 10000 ); next if exists $uniq{ join $;, $fac, $seq, $pos }; undef $uniq{ join $;, $fac, $seq, $pos }; print O join ' ', $fac, $seq, $pos; ++$n; } close O; open O, '>', 'queries.dat' or die $!; for my $a ( 'A' .. 'Z' ){ for my $b ( 'A' .. 'Z' ){ for my $c ( 'A' .. 'Z' ){ print O join ' ', $a,$b,$c; } } } close O; __END__ copy clusters from 'clusters.dat' delimiter ' '; copy queries from 'queries.dat' delimiter ' ';

Can you suggest a better formulation of the following query? Or what indexes might be used to trim the extreme time and memory usage?

Table "public.clusters" Column | Type | Modifiers ----------+---------------+----------- factor | character(1) | not null sequence | character(10) | not null position | integer | not null Indexes: "clusters_pkey" PRIMARY KEY, btree (sequence, factor, "position") test=# \d queries Table "public.queries" Column | Type | Modifiers --------+--------------+----------- first | character(1) | second | character(1) | third | character(1) | test=# select * from clusters limit 10; factor | sequence | position --------+------------+---------- I | seq23 | 6801 K | seq17 | 6247 Q | seq0 | 8514 Z | seq12 | 5542 Q | seq9 | 6334 Q | seq13 | 5472 K | seq18 | 6167 F | seq20 | 9064 F | seq2 | 4083 U | seq7 | 340 (10 rows) test=# select count(*) from clusters; count ------- 10001 (1 row) test=# select * from queries limit 10; first | second | third -------+--------+------- A | A | A A | A | B A | A | C A | A | D A | A | E A | A | F A | A | G A | A | H A | A | I A | A | J (10 rows) test=# select count(*) from queries; count ------- 17576 (1 row) test=# explain select a.*, b.*,c.* from clusters as a, clusters as b, clusters as c, (select * from queries) as d where a.sequence = b.sequence and a.sequence = b.sequence and a.factor = d.first and b.factor = d.second and c.factor = d.third; QUERY PLAN ---------------------------------------------------------------------- +------------------------------------- Hash Join (cost=4767418.33..456638449.34 rows=40093902426 width=51) Hash Cond: (c.factor = queries.third) -> Seq Scan on clusters c (cost=0.00..164.01 rows=10001 width=17) -> Hash (cost=2650170.83..2650170.83 rows=104233720 width=36) -> Merge Join (cost=815926.44..2650170.83 rows=104233720 wi +dth=36) Merge Cond: ((queries.first = a.factor) AND (queries.se +cond = b.factor)) -> Sort (cost=1492.98..1536.92 rows=17576 width=6) Sort Key: queries.first, queries.second -> Seq Scan on queries (cost=0.00..253.76 rows= +17576 width=6) -> Materialize (cost=814433.46..834478.40 rows=400898 +9 width=34) -> Sort (cost=814433.46..824455.93 rows=4008989 + width=34) Sort Key: a.factor, b.factor -> Hash Join (cost=289.02..45880.96 rows= +4008989 width=34) Hash Cond: (a.sequence = b.sequence) -> Seq Scan on clusters a (cost=0.0 +0..164.01 rows=10001 width=17) -> Hash (cost=164.01..164.01 rows=1 +0001 width=17) -> Seq Scan on clusters b (co +st=0.00..164.01 rows=10001 width=17) (17 rows) test=#

For Limbic~Region.

Try this:

#! perl -slw use strict; use Win32::GuiTest qw[ FindWindowLike SetFocus SendKeys ];; system 1, 'notepad.exe'; my @w = FindWindowLike( undef, qr/Notepad/ );; sleep 1; SetFocus( $w[0] ); SendKeys( "%{SPACE}M{DOWN}{RIGHT}{DOWN}{RIGHT}{DOWN}{RIGHT}{DOWN}{RIGH +T}{DOWN}{RIGHT}{DOWN}{RIGHT}{ENTER}" );;

For Limbic~Region.

Regarding thought 1 (Only leverage cache if I used the same number of hits):

Any board A (that requires more than 1 move) is board A' + that move; where board A' is what remains of board A after that move.

Of course board A may can have more than 1 first move, so it may result in many A's for different first moves.

And it is common that several first moves on A can result in the same board A'.

But the (my; not yet conclusive) bottom line is that if you have already accessed board A'; then whatever statistics you have gathered for previously assessed boards (min.moves/max.moves/number of different solutions/etc.) can be combined with the data gathered so far for board A to produce As stats (for the (set of) first move(s) that took A -> A').

If you can store/retrieve those stats efficiently, then you can accumulate the stats in a hierarchal manner that means you build up a DB of previously accessed boards that will avoid having to fully access new boards.

That is to say, rather than storing the full stats/analysis for board A; you can store the set of valid first moves, plus a reference to the resultant A' for each of those first moves. And for each of the A's, they in turn store the set of their first moves; and references to their A'' resultants.

Whilst there are 5^30 possible boards; there are far, far less A' boards because for any given A board, many of the possible first moves result in the same A' board.

Take

10101 01010 10101 00000 01010 10101

This can be solved in two moves (no more nor less) many different ways:

[0, 6], [0, 8], [0, 21], [0, 23], [2, 6], [2, 8], [2, 21], [2, 23], [4, 6], [4, 8], [4, 21], [4, 23], [6, 0], [6, 2], [6, 4], [6, 10], [6, 12], [6, 14], [6, 25], [6, 27], [ +6, 29], [8, 0], [8, 2], [8, 4], [8, 10], [8, 12], [8, 14], [8, 25], [8, 27], [ +8, 29], [10, 6], [10, 8], [10, 21], [10, 23], [12, 6], [12, 8], [12, 21], [12, 23], [14, 6], [14, 8], [14, 21], [14, 23], [21, 0], [21, 2], [21, 4], [21, 10], [21, 12], [21, 14], [21, 25], [21 +, 27], [21, 29], [23, 0], [23, 2], [23, 4], [23, 10], [23, 12], [23, 14], [23, 25], [23 +, 27], [23, 29], [25, 6], [25, 8], [25, 21], [25, 23], [27, 6], [27, 8], [27, 21], [27, 23], [29, 6], [29, 8], [29, 21], [29, 23],

But, if you look carefully, there are only two possible A' boards:

00000 01010 00000 00000 01010 00000 10101 00000 10101 00000 00000 10101

Which means if the 13 possible first moves; 9 result in (point to) one A'; and 4 result in (point to) the other A'.

Which should mean that after some few (probably millions?) of assessments; you reach a point where even new board quickly resolves to its first moves + pointers to previously solved boards.

I haven't wrapped my brain around the math or the scale of the storage problem. But it does strike me that for many boards (that will be A's for more complex boards; you will know that they require too may moves and can simply store a marker indicating that; so preventing costly assessment of any boards more complex that lead to this A'.

With regard to thought 2: (disk storage):

There wouldn't be a need to hit the disk for every A'. It should be possible to store the knowledge that a given A' has already been assessed + a basic set of stats in memory; and only hit the disk if full stats are required.

As for how to store the stats -- memory and disk -- could be done very efficiently using something line LibSQLite.

That's as far as my thought train goes. As I said, you probably want to dismiss this unless I get back to you with something that works; And maybe even then as you seem to have working code that does what you need. But I thought I'd lay it out where my brain has been going for the last few days. :)


For perlbotics

Here's my version of flipbits32() and flipbits64() and the benchmark results:

typedef unsigned __int64 U64; typedef unsigned int U32; typedef unsigned char U8; void flipbits32( SV *sv ) { STRLEN len; char *p = SvPV( sv, len ); while( len > 3 ) *((U32*)p)++ = ~*((U32*)p), len -= 4; while( len > 0 ) *((U8 *)p)++ = ~*((U8 *)p), len -= 1; } void flipbits64( SV *sv ) { STRLEN len; char *p = SvPV( sv, len ); while( len > 7 ) *((U64*)p)++ = ~*((U64*)p), len -= 8; while( len > 0 ) *((U8 *)p)++ = ~*((U8 *)p), len -= 1; return; } C:\test>1046579 =N=2**30 Rate str translate C8bits C32bits C64bits str 527355/s -- -57% -68% -79% -84% translate 1231678/s 134% -- -25% -51% -63% C8bits 1644457/s 212% 34% -- -34% -50% C32bits 2494674/s 373% 103% 52% -- -24% C64bits 3287236/s 523% 167% 100% 32% -- C:\test>1046579 =N=2**20 Rate str translate C8bits C32bits C64bits str 505846/s -- -55% -70% -79% -85% translate 1121547/s 122% -- -34% -53% -66% C8bits 1708547/s 238% 52% -- -28% -48% C32bits 2370166/s 369% 111% 39% -- -27% C64bits 3264306/s 545% 191% 91% 38% --

For hdb:

Here's an example of a pattern I just found in another sample. Might help or be a complete red herring.

Here are two chunks of the sample, that match for a bit, and then diverge with no apparent pattern to the divergence:

1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2 4 3 2 3 1 2 3 1 3 3 2 1 2 3 1 3 2 1 2 1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2 7 2 3 1 5 1 3 3 2 3 3 1 5 1 2 1 6 6 2

But then I looked at the first divergence and noticed that the pattern after the divergence appeared to align but slipped a bit, and the two values at and after the divergence in the top row, summed to the single value in the bottom row:

1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2*4+3*2 3 1 2 3 1 3 3 2 1 2 3 1 3 2 1 2 1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2 7 2 3 1 5 1 3 3 2 3 3 1 5 1 2 1 6 6 2

And then the next two, and the next and the next ...:

1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2*4+3*2 3 1*2+3*1 3 3 2*1+2*3 1*3+2*1 2 1 2 1 2 3 1 3 2 1 2 3 3 1 3 2 1 3 2 3 4 2 1 2 1 + 2 7 2 3 1 5 1 3 3 2 3 3 1 5 1 2 1 6 6 2

And that continues until the sub-samples completely align and the next rep starts.

I haven't got a clue how to begin to write a program to look for things like that?


For Corion:

From what you said, this ought to display the symptoms that the take sub would produce non-matching pairs of linenumbers because one is closed over when the sub is instantiated and assigned to the symbol table and the other is provided at run time, but they do not. I always strictly matching pairs?

#! perl -slw use strict; use threads; sub take; sub gather(&$) { my( $code, $tag ) = @_; local *take = sub { print "$tag, $_[0]"; }; &async( $code )->detach; } gather{ sleep( 1 ), take( __LINE__ ) for 1 .. 1000; } __LINE__; gather{ sleep( 1 ), take( __LINE__ ) for 1 .. 1000; } __LINE__; gather{ sleep( 1 ), take( __LINE__ ) for 1 .. 1000; } __LINE__; gather{ sleep( 1 ), take( __LINE__ ) for 1 .. 1000; } __LINE__; sleep 1000; __END__ C:\test>t-take.pl 13, 13 14, 14 15, 15 16, 16 13, 13 14, 14 15, 15 16, 16 13, 13 14, 14 15, 15 16, 16 14, 14 13, 13 15, 15 16, 16 13, 13 14, 14 15, 15 16, 16 14, 14 13, 13 15, 15 16, 16 13, 13 14, 14 15, 15 16, 16 14, 14 13, 13 ...

For davido:

This works! That is, it allows users to use Some::Foo and then my $obj = Some::Foo->new;.

It's a little bit 'trick'; but not so much to concern anyone.

package Some::Foo; package Some; use strict; use Inline CPP => Config => BUILD_NOISY => 1; use Inline CPP => <<'END'; #include <iostream> using namespace std; class Foo { int data; public: Foo(); ~Foo(); int get() { return data; } void set(int a) { data = a; } }; Foo::Foo() { cout << "creating a Foo()" << endl; } Foo::~Foo() { cout << "deleting a Foo()" << endl; } END package Some::Foo; return 1 if caller; package main; my $foo = Some::Foo->new(); $foo->set( 1 ); print $foo->get();
For syphilis:
#include <stdio.h> int main( int argc, char **argv ) { unsigned __int64 u64 = 0xffffffff7fffffff; double d = *(double*)&u64; printf( "%f\n", d ); } C:\test>cl qnan.c Microsoft (R) C/C++ Optimizing Compiler Version 15.00.21022.08 for x64 Copyright (C) Microsoft Corporation. All rights reserved. qnan.c Microsoft (R) Incremental Linker Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. /out:qnan.exe qnan.obj C:\test>qnan -1.#QNAN0

For syphilis:
c:\test>type bitvector.typemap U64 UV_T c:\test>type \perl64\lib\ExtUtils\typemap # basic C types int T_IV unsigned T_UV unsigned int T_UV long T_IV unsigned long T_UV short T_IV unsigned short T_UV char T_CHAR unsigned char T_U_CHAR char * T_PV unsigned char * T_PV const char * T_PV caddr_t T_PV wchar_t * T_PV wchar_t T_IV # bool_t is defined in <rpc/rpc.h> bool_t T_IV size_t T_UV ssize_t T_IV time_t T_NV unsigned long * T_OPAQUEPTR char ** T_PACKEDARRAY void * T_PTR Time_t * T_PV SV * T_SV SVREF T_SVREF AV * T_AVREF HV * T_HVREF CV * T_CVREF IV T_IV UV T_UV U64 t_UV NV T_NV I32 T_IV I16 T_IV I8 T_IV STRLEN T_UV U32 T_U_LONG U16 T_U_SHORT U8 T_UV Result T_U_CHAR Boolean T_BOOL float T_FLOAT double T_DOUBLE SysRet T_SYSRET SysRetLong T_SYSRET FILE * T_STDIO PerlIO * T_INOUT FileHandle T_PTROBJ InputStream T_IN InOutStream T_INOUT OutputStream T_OUT bool T_BOOL ###################################################################### +####### INPUT T_SV $var = $arg T_SVREF if (SvROK($arg)) $var = (SV*)SvRV($arg); else Perl_croak(aTHX_ \"%s: %s is not a reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_AVREF if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) $var = (AV*)SvRV($arg); else Perl_croak(aTHX_ \"%s: %s is not an array reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_HVREF if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) $var = (HV*)SvRV($arg); else Perl_croak(aTHX_ \"%s: %s is not a hash reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_CVREF if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV) $var = (CV*)SvRV($arg); else Perl_croak(aTHX_ \"%s: %s is not a code reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_SYSRET $var NOT IMPLEMENTED T_UV $var = ($type)SvUV($arg) T_IV $var = ($type)SvIV($arg) T_INT $var = (int)SvIV($arg) T_ENUM $var = ($type)SvIV($arg) T_BOOL $var = (bool)SvTRUE($arg) T_U_INT $var = (unsigned int)SvUV($arg) T_SHORT $var = (short)SvIV($arg) T_U_SHORT $var = (unsigned short)SvUV($arg) T_LONG $var = (long)SvIV($arg) T_U_LONG $var = (unsigned long)SvUV($arg) T_CHAR $var = (char)*SvPV_nolen($arg) T_U_CHAR $var = (unsigned char)SvUV($arg) T_FLOAT $var = (float)SvNV($arg) T_NV $var = ($type)SvNV($arg) T_DOUBLE $var = (double)SvNV($arg) T_PV $var = ($type)SvPV_nolen($arg) T_PTR $var = INT2PTR($type,SvIV($arg)) T_PTRREF if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not a reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_REF_IV_REF if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type *, tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") T_REF_IV_PTR if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type, tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") T_PTROBJ if (sv_derived_from($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") T_PTRDESC if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); ${type}_desc = (\U${type}_DESC\E*) tmp; $var = ${type}_desc->ptr; } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") T_REFREF if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not a reference\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\") T_REFOBJ if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *INT2PTR($type,tmp); } else Perl_croak(aTHX_ \"%s: %s is not of type %s\", ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]}, \"$var\", \"$ntype\") T_OPAQUE $var = *($type *)SvPV_nolen($arg) T_OPAQUEPTR $var = ($type)SvPV_nolen($arg) T_PACKED $var = XS_unpack_$ntype($arg) T_PACKEDARRAY $var = XS_unpack_$ntype($arg) T_CALLBACK $var = make_perl_cb_$type($arg) T_ARRAY U32 ix_$var = $argoff; $var = $ntype(items -= $argoff); while (items--) { DO_ARRAY_ELEM; ix_$var++; } /* this is the number of elements in the array */ ix_$var -= $argoff T_STDIO $var = PerlIO_findFILE(IoIFP(sv_2io($arg))) T_IN $var = IoIFP(sv_2io($arg)) T_INOUT $var = IoIFP(sv_2io($arg)) T_OUT $var = IoOFP(sv_2io($arg)) ###################################################################### +####### OUTPUT T_SV $arg = $var; T_SVREF $arg = newRV((SV*)$var); T_AVREF $arg = newRV((SV*)$var); T_HVREF $arg = newRV((SV*)$var); T_CVREF $arg = newRV((SV*)$var); T_IV sv_setiv($arg, (IV)$var); T_UV sv_setuv($arg, (UV)$var); T_INT sv_setiv($arg, (IV)$var); T_SYSRET if ($var != -1) { if ($var == 0) sv_setpvn($arg, "0 but true", 10); else sv_setiv($arg, (IV)$var); } T_ENUM sv_setiv($arg, (IV)$var); T_BOOL $arg = boolSV($var); T_U_INT sv_setuv($arg, (UV)$var); T_SHORT sv_setiv($arg, (IV)$var); T_U_SHORT sv_setuv($arg, (UV)$var); T_LONG sv_setiv($arg, (IV)$var); T_U_LONG sv_setuv($arg, (UV)$var); T_CHAR sv_setpvn($arg, (char *)&$var, 1); T_U_CHAR sv_setuv($arg, (UV)$var); T_FLOAT sv_setnv($arg, (double)$var); T_NV sv_setnv($arg, (NV)$var); T_DOUBLE sv_setnv($arg, (double)$var); T_PV sv_setpv((SV*)$arg, $var); T_PTR sv_setiv($arg, PTR2IV($var)); T_PTRREF sv_setref_pv($arg, Nullch, (void*)$var); T_REF_IV_REF sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); T_REF_IV_PTR sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTROBJ sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTRDESC sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)) +; T_REFREF NOT_IMPLEMENTED T_REFOBJ NOT IMPLEMENTED T_OPAQUE sv_setpvn($arg, (char *)&$var, sizeof($var)); T_OPAQUEPTR sv_setpvn($arg, (char *)$var, sizeof(*$var)); T_PACKED XS_pack_$ntype($arg, $var); T_PACKEDARRAY XS_pack_$ntype($arg, $var, count_$ntype); T_DATAUNIT sv_setpvn($arg, $var.chp(), $var.size()); T_CALLBACK sv_setpvn($arg, $var.context.value().chp(), $var.context.value().size()); T_ARRAY { U32 ix_$var; EXTEND(SP,size_$var); for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } } T_STDIO { GV *gv = newGVgen("$Package"); PerlIO *fp = PerlIO_importFILE($var,0); if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package", +1))); else $arg = &PL_sv_undef; } T_IN { GV *gv = newGVgen("$Package"); if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package", +1))); else $arg = &PL_sv_undef; } T_INOUT { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package", +1))); else $arg = &PL_sv_undef; } T_OUT { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package", +1))); else $arg = &PL_sv_undef; }
Sure looks (to me) like the typemap isn't being seen, despite that it is listed in the output from the build) (maybe I'm down-level on I::C? (it lists 0.49 in C.pm)):
/* * This file was generated automatically by ExtUtils::ParseXS version +2.22 from the * contents of bitvector.xs. Do not edit this file, edit bitvector.xs +instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "bitvector.xs" #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "INLINE.h" typedef unsigned __int64 U64; char *newxz( U64 bytes ) { char *p; Newxz( p, bytes, char ); if( !p ) croak( "Couldn't allocate %I64u bytes\n", bytes ); return p; } SV* new( const char *classname, SV *bits ) { U64 bytes = ( SvUV( bits )+7 ) / 8; unsigned char *vector = newxz( bytes ); SV *obj = newSV_type( SVt_PV ); SV *obj_ref = newRV_noinc( obj ); SvPOK_only( obj ); SvPV_set( obj, vector ); SvCUR_set( obj, bytes-1 ); SvLEN_set( obj, bytes ); sv_bless( obj_ref, gv_stashpv( classname, GV_ADD) ); return obj_ref; } U64 setbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; //return _bittestandset64( vec+quad, bit ); return vec[ quad ] |= 1ULL << bit; } U64 tstbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; //return _bittest64( vec+quad, bit ); return ( vec[ quad ] & ( 1ULL << bit ) ) ? 1 : 0; } U64 clrbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; //return _bittestandreset64( vec+quad, bit ); return vec[ quad ] &= ~( 1ULL << bit ); } _inline int _popcnt( U64 x ) { x -=( x >> 1 ) & 0x5555555555555555ULL; x = ( x & 0x3333333333333333Ul ) + ( ( x >> 2 ) & 0x33333333333333 +33ULL ); x = ( x + (x >> 4)) & 0x0f0f0f0f0f0f0f0fULL; return ( x * 0x0101010101010101ULL ) >> 56; } U64 cntbit( SV *self ) { STRLEN l = 0; U64 *vec = (U64*)SvPV( SvRV( self ), l ); U64 cnt = 0ULL; int i; l /= 8; ++l; for( i = 0; i <l; ++i ) { cnt += _popcnt( vec[ i ] ); } return cnt; } #line 89 "bitvector.c" #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) /* prototype to pass -Wmissing-prototypes */ STATIC void S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params); STATIC void S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) { const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, para +ms); else Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here +. */ Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), par +ams); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #ifdef PERL_IMPLICIT_CONTEXT #define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) #else #define croak_xs_usage S_croak_xs_usage #endif #endif /* NOTE: the prototype of newXSproto() is different in versions of per +ls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(nam +e, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)new +XS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv) #endif /* !defined(newXS_flags) */ #line 141 "bitvector.c" XS(XS_main_new); /* prototype to pass -Wmissing-prototypes */ XS(XS_main_new) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) croak_xs_usage(cv, "classname, bits"); { const char * classname = (const char *)SvPV_nolen(ST(0)); SV * bits = ST(1); SV * RETVAL; RETVAL = new(classname, bits); ST(0) = RETVAL; sv_2mortal(ST(0)); } XSRETURN(1); } #ifdef __cplusplus extern "C" #endif XS(boot_bitvector); /* prototype to pass -Wmissing-prototypes */ XS(boot_bitvector) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif #if (PERL_REVISION == 5 && PERL_VERSION < 9) char* file = __FILE__; #else const char* file = __FILE__; #endif PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ XS_VERSION_BOOTCHECK ; newXS("main::new", XS_main_new, file); #if (PERL_REVISION == 5 && PERL_VERSION >= 9) if (PL_unitcheckav) call_list(PL_scopestack_ix, PL_unitcheckav); #endif XSRETURN_YES; }

For syphilis: The output from mine then yours (with '+' removed):
C:\test>IDrand62xN 2**20 main=SCALAR(0x3e8c608) : 131071 1048576 0 C:\test>bitvec2 2**20 main=SCALAR(0x4062568) : 131071 1048576 0

For syphilis: Using this typemap:
U64 UV_T

Compiling this goes clean, but the methods aren't visible (bound?) at runtime? Switch the method return types to UV and they are. (The hope is eventually use the typedef to hide platform/architecture differences.).

The typemap (bitvector.typemap) is being seen, but ... (sorry!) "doesn't work!". Build log at the bottom. :

#! perl -slw use strict; use Config; use Inline C => Config => BUILD_NOISY => 1, CCFLAGS => $Config{ccflags +}." -DDEBUG=1", TYPEMAPS => './bitvector.typemap'; use Inline C => <<'END_C', NAME => 'bitvector', CLEAN_AFTER_BUILD => +0; typedef unsigned __int64 U64; char *newxz( U64 bytes ) { char *p; Newxz( p, bytes, char ); if( !p ) croak( "Couldn't allocate %I64u bytes\n", bytes ); return p; } SV* new( const char *classname, SV *bits ) { U64 bytes = ( SvUV( bits )+7 ) / 8; unsigned char *vector = newxz( bytes ); SV *obj = newSV_type( SVt_PV ); SV *obj_ref = newRV_noinc( obj ); SvPOK_only( obj ); SvPV_set( obj, vector ); SvCUR_set( obj, bytes-1 ); SvLEN_set( obj, bytes ); sv_bless( obj_ref, gv_stashpv( classname, GV_ADD) ); return obj_ref; } U64 setbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; return _bittestandset64( vec+quad, bit ); //vec[ quad ] |= 1ULL << + bit; } U64 tstbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; return _bittest64( vec+quad, bit ); //( vec[ quad ] & ( 1ULL << bi +t ) ) ? 1 : 0; } U64 clrbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = SvUV( offset ) & 0x000000000000003fULL; U64 quad = SvUV( offset ) >> 6; return _bittestandreset64( vec+quad, bit ); //vec[ quad ] &= ~( 1U +LL << bit ); } _inline int _popcnt( U64 x ) { x -=( x >> 1 ) & 0x5555555555555555ULL; x = ( x & 0x3333333333333333Ul ) + ( ( x >> 2 ) & 0x33333333333333 +33ULL ); x = ( x + (x >> 4)) & 0x0f0f0f0f0f0f0f0fULL; return ( x * 0x0101010101010101 ) >> 56; } U64 cntbit( SV *self ) { STRLEN l = 0; U64 *vec = (U64*)SvPV( SvRV( self ), l ); U64 cnt = 0ULL; int i; l /= 8; ++l; for( i = 0; i <l; ++i ) { cnt += _popcnt( vec[ i ] ); } return cnt; } END_C use Devel::Peek; my $size = eval $ARGV[ 0 ]; my $v = new( 'main', $size ); print $v, ' : ', length $$v; for my $bit ( 0 .. $size - 1 ) { $v->tstbit( $bit ) and warn "Bit $bit unexpectely set"; $v->setbit( $bit ); $v->tstbit( $bit ) or warn "Bit $bit unexpectely unset";; } print $v->cntbit(); for my $bit ( 0 .. $size - 1 ) { $v->clrbit( $bit ); $v->tstbit( $bit ) and warn "Bit $bit unexpectely set";; } print $v->cntbit();

Build and run:

C:\test>IDrand62xN 2**31 validate Stage get_maps Stage Writing Makefile for bitvector Microsoft (R) Program Maintenance Utility Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. C:\Perl64\bin\perl.exe C:\Perl64\lib\ExtUtils\xsubpp -typemap + "C:\Perl64\lib\ExtUtils\typemap" -typemap "C:\test\bitvector.typemap +" bitvector.xs > bitvector.xsc && C:\Perl64\bin\perl.exe -MExtUtils: +:Command -e "mv" -- bitvector.xsc bitvector.c cl -c -I"C:/test" -nologo -GF -W3 -MD -Zi -DNDEBUG -Ox -GL - +Wp64 -fp:precise -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DW +IN64 -DCONSERVATIVE -DUSE_SITECUSTOMIZE -DPRIVLIB_LAST_IN_INC -DPERL_ +IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READF +IX -DDEBUG=1 -MD -Zi -DNDEBUG -Ox -GL -Wp64 -fp:precise -DVERSION= +\"0.00\" -DXS_VERSION=\"0.00\" "-IC:\Perl64\lib\CORE" bitvector.c cl : Command line warning D9035 : option 'Wp64' has been deprecated an +d will be removed in a future release cl : Command line warning D9035 : option 'Wp64' has been deprecated an +d will be removed in a future release bitvector.c Running Mkbootstrap for bitvector () C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 b +itvector.bs C:\Perl64\bin\perl.exe -MExtUtils::Mksymlists -e "Mksymlists( +'NAME'=>\"bitvector\", 'DLBASE' => 'bitvector', 'DL_FUNCS' => { }, ' +FUNCLIST' => [], 'IMPORTS' => { }, 'DL_VARS' => []);" link -out:blib\arch\auto\bitvector\bitvector.dll -dll -nologo +-nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"C:\Perl64\lib\CORE +" -machine:AMD64 bitvector.obj C:\Perl64\lib\CORE\perl510.lib oldn +ames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib + advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.l +ib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib +comctl32.lib bufferoverflowU.lib msvcrt.lib -def:bitvector.def Creating library blib\arch\auto\bitvector\bitvector.lib and object +blib\arch\auto\bitvector\bitvector.exp Generating code Finished generating code if exist blib\arch\auto\bitvector\bitvector.dll.manifest mt -n +ologo -manifest blib\arch\auto\bitvector\bitvector.dll.manifest -outp +utresource:blib\arch\auto\bitvector\bitvector.dll;2 if exist blib\arch\auto\bitvector\bitvector.dll.manifest del b +lib\arch\auto\bitvector\bitvector.dll.manifest C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 755 b +lib\arch\auto\bitvector\bitvector.dll C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- bitvecto +r.bs blib\arch\auto\bitvector\bitvector.bs C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 b +lib\arch\auto\bitvector\bitvector.bs Microsoft (R) Program Maintenance Utility Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. Files found in blib\arch: installing files in blib\lib into architectu +re dependent library tree Installing C:\test\_Inline\lib\auto\bitvector\bitvector.dll Installing C:\test\_Inline\lib\auto\bitvector\bitvector.exp Installing C:\test\_Inline\lib\auto\bitvector\bitvector.lib Installing C:\test\_Inline\lib\auto\bitvector\bitvector.pdb main=SCALAR(0x40ff688) : 268435455 Can't locate auto/main/tstbit.al in @INC (@INC contains: C:\test\_Inli +ne\lib c:/Perl64/site/lib c:/Perl64/lib .) at C:\test\IDrand62xN.pl l +ine 84

For Syphilis

The (slightly tweaked) code:

#! perl -slw use strict; use Inline C => Config => BUILD_NOISY => 1; use Inline C => <<'END_C', NAME => 'JobObject', CLEAN_AFTER_BUILD => +0; #include <windows.h> #ifndef JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE #define JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE 0x2000 #endif int createJobObject( char *name ) { HANDLE job; JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = { 0, }; jeli.B6, 2$var\asicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_ +KILL_ON_JO$Packagel; ++i ) { cnt += _popcnt( vecB_CLOSE; job = (int)CreateJobObjectA( NULL, name ); SetInformationJobObject( job, 9, &jeli, sizeof(jeli) ); return job; } int assignProcessToJobObject( int job, int pid ) { HANDLE hProc = OpenProcess( PROCESS_SET_QUOTA |PROCESS_TERMINATE, +0, pid ); return (int)AssignProcessToJobObject( job, hProc ); } int closeHandle( int handle ) { return (int)CloseHandle( (HANDLE)handle ); } END_C #use Win32::JobAdd; my $job = createJobObject( 'fred' ); print $job; my $pid = open IN, q[\perl64\bin\perl.exe -E"system 1, 'calc.exe'; sys +tem 1, 'notepad.exe'; sleep 100" |] or die $^E; print assignProcessToJobObject( $job, $pid ); sleep 10; print closeHandle( $job ); #kill 21, $pid; __END__

And the build:

C:\test>JobObj.pl validate Shttp://www.sqlite.org/c3ref/intro.html|LibSQLitetage Starting Build Preprocess Stage get_maps Stage Finished Build Preprocess Stage Starting Build Parse Stage Finished Build Parse Stage Starting Build Glue 1 Stage Finished Build Glue 1 Stage Starting Build Glue 2 Stage Finished Build Glue 2 Stage Starting Build Glue 3 Stage Finished Build Glue 3 Stage Starting Build Compile Stage Starting "perl Makefile.PL" Stage Writing Makefile for JobObject Finished "perl Makefile.PL" Stage Starting "make" Stage Microsoft (R) Program Maintenance Utility Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. C:\Perl64\bin\perl.exe C:\Perl64\lib\ExtUtils\xsubpp -typemap + "C:\Perl64\lib\ExtUtils\typemap" JobObject.xs > JobObject.xsc && C: +\Perl64\bin\perl.exe -MExtUtils::Command -e "mv" -- JobObject.xsc Job +Object.c cl -c -I"C:/test" -nologo -GF -W3 -MD -Zi -DNDEBUG -Ox -GL - +Wp64 -fp:precise -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DW +IN64 -DCONSERVATIVE -DUSE_SITECUSTOMIZE -DPRIVLIB_LAST_IN_INC -DPERL_ +IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READF +IX -MD -Zi -DNDEBUG -Ox -GL -Wp64 -fp:precise -DVERSION=\"0.00\" +-DXS_VERSION=\"0.00\" "-IC:\Perl64\lib\CORE" JobObject.c cl : Command line warning D9035 : option 'Wp64' has been deprecated an +d will be removed in a future release cl : Command line warning D9035 : option 'Wp64' has been deprecated an +d will be removed in a future release JobObject.c JobObject.xs(16) : warning C4013: 'CreateJobObjectA' undefined; assumi +ng extern returning int JobObject.xs(16) : warning C4047: '=' : 'HANDLE' differs in levels of +indirection from 'int' JobObject.xs(17) : warning C4013: 'SetInformationJobObject' undefined; + assuming extern returning int JobObject.xs(18) : warning C4047: 'return' : 'int' differs in levels o +f indirection from 'HANDLE' JobObject.xs(23) : warning C4013: 'AssignProcessToJobObject' undefined +; assuming extern returning int JobObject.xs(27) : warning C4312: 'type cast' : conversion from 'int' +to 'HANDLE' of greater size Running Mkbootstrap for JobObject () C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 J +obObject.bs C:\Perl64\bin\perl.exe -MExtUtils::Mksymlists -e "Mksymlists( +'NAME'=>\"JobObject\", 'DLBASE' => 'JobObject', 'DL_FUNCS' => { }, ' +FUNCLIST' => [], 'IMPORTS' => { }, 'DL_VARS' => []);" link -out:blib\arch\auto\JobObject\JobObject.dll -dll -nologo +-nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"C:\Perl64\lib\CORE +" -machine:AMD64 JobObject.obj C:\Perl64\lib\CORE\perl510.lib oldn +ames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib + a Config =dvapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.l +ib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbc +cp32.lib comctl32.lib bufferoverflowU.lib msvcrt.lib -def:JobObject.d +ef Creating library blib\arch\auto\JobObject\JobObject.lib and object +blib\arch\auto\JobObject\JobObject.exp Generating code Finish ); print $job; my $pid = open IN, qed generating code if exist blib\arch\auto\JobObject\JobObject.dll.manifest mt -n +ologo -manifest blib\arch\auto\JobObject\JobObject.dll.manifest -outp +utresource:blib\arch\auto\JobObject\JobObject.dll;2 if exist blib\arch\auto\JobObject\JobObject.dll.manifest del b +lib\arch\auto\JobObject\JobObject.dll.manifest C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 755 b +lib\arch\auto\JobObject\JobObject.dll C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- JobObjec +t.bs blib\arch\auto\JobObject\JobObject.bs C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 b +lib\arch\auto\JobObject\JobObject.bs Finished "make" Stage Starting "make install" Stage Microsoft (R) Program Maintenance Utility Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. Files found in blib\arch: installing files in blib\lib into architectu +re dependent library tree Installing C:\test\_Inline\lib\auto\JobObject\JobObject.dll Installing C:\test\_Inline\lib\auto\JobObject\JobObject.exp Installing C:\test\_Inline\lib\auto\JobObject\JobObject.lib Installing C:\test\_Inline\lib\auto\JobObject\JobObject.pdb Finished "make install" Stage Starting Cleaning Up Stage Finished Cleaning Up Stage Finished Build Compile Stage Name "main::IN" used only once: possible typo at C:\test\JobObj.pl lin +e 36. 152 1 1 C:\test>

For zwon

See "For the sake of completeness, the COPACOBANA FPGA implementation tops 2^16 Mencryptions/s.".

  1. 1 FPGA hardware setup does 2^16 Millions SHA512 encrypts/second.
  2. The typical 8-characters x 96 char alphabet 96^8 = 218340105584896;

B / A = 110,075 seconds or a bit over 30.5 hrs. Divide that by the number of FPGA setups you can afford.

Sure, if you can enforce your 16-chars and persuade people to use !"$%^&*(... et al, the task becomes significantly harder.

But the point remains that it is not the size of the hash (2^512), but the size of the input (96^8, 62^16 etc.) that is the limiting factor.

Length is key. Alphabet size is second.

But keeping the salt secure goes a long way to ensuring the length, and making brute forcing completely infeasible.


For cdarke

This source:

#include <windows.h> #include <stdio.h> void main( void ) { printf( "%p\n", (HANDLE)-1 ); printf( "%p\n", ((HANDLE)((LONG_PTR)-1)) ); }

Compiled for 64-bit:

C:\test\lockfree>cl /MT junk.c Microsoft (R) C/C++ Optimizing Compiler Version 15.00.21022.08 for x64 Copyright (C) Microsoft Corporation. All rights reserved. junk.c Microsoft (R) Incremental Linker Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. /out:junk.exe jun size_$var; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } } T_STDIO { GV *gv = newGVgen(k.obj

Produces:

C:\test\lockfree>junk FFFFFFFFFFFFFFFF FFFFFFFFFFF endl; } END package Some::Foo; return 1 if caller; package main; my $foo = Some::Foo-, ${$ALIAS?\q quad FFFFF

And INVALID_HANDLE_VALUE is defined variously as:

Windows\v6.1\Include\MAPIWin.h:#define INVALID_HANDLE_VALUE + ((HANDLE)(-1)) Windows\v6.1\Include\Pdh.h:#define INVALID_HANDLE_VALUE ((HANDLE)((LO +NG_PTR)-1)) Windows\v6.1\Include\WinBase.h:\, PTR2UV(cv), params); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #ifdef PERL_IMPLICIT_CONTEXT #define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) #else #define croak_xs_usage S_croak_xs_usage #endif #endif /* NOTE: the prototype of newXSproto() is different in versions of per +ls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_ |= 1ULL For impl, file, proto) newXS_flags(name, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)new +XS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv) #endif /* !defined(newXS_flags) */ #line 141 main #define INVALID_HANDLE_VALUE ((HANDLE)(LONG_PTR)-1)

I don't see the scope for being stung by the difference?


For davido

Here is the console of the makefile/nmake part of building the package with teh latest makefile. I do not understand why it is trying to build a dll called cpp.dll?

C:\Perl64\packages>tar -zxf Inline-CPP-0.33_001.tar.gz C:\Perl64\packages>cd Inline-CPP-0.33_001 C:\Perl64\packages\Inline-CPP-0.33_001>tp Makefile.PL ## I EDITED THE + MAKEFILE.PL WITH THE LATEST CHANGES C:\Perl64\packages\Inline-CPP-0.33_001>makefile This will configure and build Inline::C++. What default C++ compiler would you like to use? [cl -TP] What default libraries would you like to include? [MSVCIRT.LIB] Microsoft (R) C/C++ Optimizing Compiler Version 15.00.21022.08 for x64 Copyright (C) Microsoft Corporation. All rights reserved. ilcpptest.cpp c:\Program Files (x86)\Microsoft Visual Studio 9.0\VC\Include\xlocale( +342) : warning C4530: C++ exception handler used, but unwind semantic +s are not enabled. Specify /EHsc Microsoft (R) Incremental Linker Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. /out:ilcpptest.exe ilcpptest.obj Detected <iostream> style headers. ('.h' not needed.) Checking if your kit is complete... Looks good Writing Makefile for Inline::CPP::grammar Writing Makefile for Inline::CPP C:\Perl64\packages\Inline-CPP-0.33_001>nmake Microsoft (R) Program Maintenance Utility Version 9.00.21022.08, \); if ( do_open(gv, t allocate %I64u bytes\nchmod Copyright (C) Microsoft Corporation. All rights reserved. cp CPP.pm blib\lib\Inline\CPP.pm cp li${ntype}\); if ( do_open(gv, DLBASEb/Inline/CPP.pod blib\lib\Inline\CPP.po +d c:\PROGRA~2\MICROS~1.0\VC\Bin\amd64\nmake.exe -f Makefile all +-nologo cp grammar.pm ..\blib\lib\Inline\CPP\grammar.pm cd .. Running Mkbootstrap for Inline::CPP () C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 C +PP.bs C:\Perl64\bin\perl.exe -MExtUtils::Mksymlists -e "Mksymlists( +'NAME'=>\"Inline::CPP\", 'DLBASE' => 'CPP', 'DL_FUNCS' => { }, 'FUNC + 0x000000000000003fULL; U64 quad = SvUV( offset ) LIST' => [], 'IMPORTS' => { }, 'DL_VARS +' => []);" link -out:blib\arch\auto\Inline\CPP\CPP.dll -dll -nologo -nodefau +ltlib -debug -opt:ref,icf -ltcg -libpath:"C:\Perl64\lib\CORE" -mach +ine:AMD64 CPP.obj C:\Perl64\lib\CORE\perl510.lib oldnames.lib kerne +l32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib +shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib +mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib b +ufferoverflowU.lib msvcrt.lib -def:CPP.def LINK : fatal error LNK1181: cannot open input file 'CPP.obj' NMAKE : fatal error U1077: '"c:\Program Files (x86)\Microsoft Visual S +tudio 9.0\VC\Bin\amd64\link.EXE"' : return code '0x49d' Stop. C:\Perl64\packages\Inline-CPP-0.33_001>

For Rob. PM is denying my attempts to post you a reply at the moment?

at which point it crashes. (Irrespective of how many threads I specify it always crashes when *all* threads have reached the stage of having to allocate the memory.)

Probably none of the started threads will get any time slice until your main thread enters the join wait state. Try adding a 1 second sleep inside the loop and it will probably crash as soon as the first one tries to run.


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 SvTYPE(SvRV($arg))==SVt_PVCV) $var = (CV*)SvRV($arg); else Perl_croak(aTHX_ \bitvector.xschmod { }, 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.
#! perl -slw package Node; use Inline C =, \ Microsoft (R) C/C++ Optimizing Compiler Version 15.00.21022.08 for x64 Copyright (C) Microsoft Corporation. All rights reserved. ilcpptest.cpp c:\Program Files (x86)\Microsoft Visual Studio 9.0\VC\Include\xlocale(342) : warning C4530: C++ exception handler used, but unwind semantics are not enabled. Specify /EHsc Microsoft (R) Incremental Linker Version 9.00.21022.08 Copyright (C) Microsoft Corporation. All rights reserved. /out:ilcpptest.exe ilcpptest.obj Detected

For Boldra

For a test suite, I'd do the following:

Create a VM (VirtualBox or MS VirtualPC) with a fresh install of a relevant version of windows.

Create a file with a snapshot of the filesystem & registry.

Make a copy of that VM (w%s: %s is not a reference\code undefined; assuming extern returning int JobObject.xs(16) : warning C4047: #include ith snapshot).

In the copy, use the legacy system to install/configure a small selection of typical and awkward apps.

M${ntype}\ake another snapshot of the filesystem and registry.

Perform a diff of the two snapshots.

You now have you test suite and pass/fail crteria.

To test your new system, you make another copy of the original VM with snapshot.

Attempt the install with the new system.

Take the second snapshot & diff with the first.

Now export both diffs and diff them.


I would like to port these 3 C programs to *nix:

freerun.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 ) { ++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 ); bit ) ) ? 1 : 0; } U64 clrbit( SV *self, SV *offset ) { U64 *vec = (U64*)SvPVX( SvRV( self ) ); U64 bit = Sv #include UV( offset ) WaitForMultipleObjects( nThreads, (HANDLE*)&th +reads, 1, INFINITE ); finish = clock(); elapsed = (double)(finish - start) / CLOCKS_PER_SEC; printf( "count: %lu time:%.6f\n", s.i, elapsed ); }

Port to gcc by Illuminatus: freerun.c:

#include <pthread.h> #include <stdio.h> #include <time.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 ) { ++s->i; } return; } int main( int argc, char **argv ) { int i = 0, nThreads = 4; clock_t start, finish; double elapsed; pthread_t threads[32]; shared s = { 0, 1000000 }; if( argc > 1 ) nThreads = atoi( argv[1] ); if( argc > 2 ) s.loops = atoi( argv[2] ); printf( "threads:%d loops:%d\n", nThreads, s.loops ); start = clock(); for( i=0; i < nThreads; ++i ) pthread_create( &threads[ i ], NULL, &worker, &s ); for( i=0; i < nThreads; ++i ) pthread_join( threads[ i ], NULL ); finish = clock(); elapsed = (double)(finish - start) / CLOCKS_PER_SEC; printf( "count: %u time:%.6f\n", s.i, elapsed ); return 0; }

mutex.c:

#include <windows.h> #include <stdio.h> #include <time.h> #include <process.h> typedef struct { int i; int loops; HANDLE mutex; } shared; void worker( void *arg ) { shared *s = (shared*)arg; int i = 0; for( i=0; i < s->loops; ++i ) { WaitForSingleObject( s->mutex, INFINITE ); ++s->i; ReleaseMutex( s->mutex ); } 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 };; s.mutex = CreateMutex( NULL, 0, NULL ); 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 ); }

Port to gcc by Illuminatus: mutex.c:

#include <pthread.h> #include <stdio.h> #include <time.h> typedef struct { int i; int loops; pthread_mutex_t mutex; } shared; void *worker( void *arg ) { shared *s = (shared*)arg; int i = 0; for( i=0; i < s->loops; ++i ) { pthread_mutex_lock( &s->mutex ); ++s->i; pthread_mutex_unlock( &s->mutex ); } return; } int main( int argc, char **argv ) { int i = 0, nThreads = 4; clock_t start, finish; double elapsed; pthread_t threads[32]; shared s = { 0, 1000000 };; pthread_mutex_init( &s.mutex, NULL ); if( argc > 1 ) nThreads = atoi( argv[1] ); if( argc > 2 ) s.loops = atoi( argv[2] ); printf( "threads:%d loops:%d\n", nThreads, s.loops ); start = clock(); for( i=0; i < nThreads; ++i ) pthread_create( &threads[ i ], NULL, &worker, &s ); for( i=0; i < nThreads; ++i ) pthread_join( threads[ i ], NULL ); finish = clock(); elapsed = (double)(finish - start) / CLOCKS_PER_SEC; printf( "count: %u time:%.6f\n", s.i, elapsed ); return 0; }

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 ); }

Port to gcc by Illuminatus: lockfree.c:

#include <pthread.h> #include <stdio.h> #include <time.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 ) { __sync_fetch_and_add( &s->i, 1 ); } return; } void main( int argc, char **argv ) { int i = 0, nThreads = 4; clock_t start, finish; double elapsed; pthread_t threads[32]; shared s = { 0, 1000000 };; if( argc > 1 ) nThreads = atoi( argv[1] ); if( argc > 2 ) s.loops = atoi( argv[2] ); printf( "threads:%d loops:%d\n", nThreads, s.loops ); start = clock(); for( i=0; i < nThreads; ++i ) pthread_create( &threads[ i ], NULL, &worker, &s ); for( i=0; i < nThreads; ++i ) pthread_join( threads[ i ], NULL ); finish = clock(); elapsed = (double)(finish - start) / CLOCKS_PER_SEC; printf( "count: %u time:%.6f\n", s.i, elapsed ); return 0; }
For 32worker, 0,
Homage ); if( argc P ); printf( ; shared s = { 0, 1000000 };; if( argc network sites: s ); for( i=0; i s- ); printf( For P, s.i, elapsed ); return 0; } i pp 2 ) s.loops = atoi( argvcode
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (11)
As of 2014-12-18 21:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

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





    Results (66 votes), past polls