Skip to content

Instantly share code, notes, and snippets.

@FROGGS

FROGGS/hyper_MT.pir Secret

Last active December 20, 2015 20:49
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save FROGGS/2f7a18016440db081f99 to your computer and use it in GitHub Desktop.
Save FROGGS/2f7a18016440db081f99 to your computer and use it in GitHub Desktop.
Download ZIP
perl6 -e 'my @A = ^1001; my Mu $rpa := nqp::hyper_MT(@A, @A, Array, Int); my Mu $s := nqp::shift($rpa); say nqp::istype($s, Int); say $s; say "done"'
Raw
hyper_MT.pir
.include 'cclass.pasm'
.include 'except_severity.pasm'
.include 'except_types.pasm'
.include 'iglobals.pasm'
.include 'interpinfo.pasm'
.include 'iterator.pasm'
.include 'sysinfo.pasm'
.include 'stat.pasm'
.include 'datatypes.pasm'
.include 'libpaths.pasm'
.include 'nqp_const.pir'
.HLL "perl6"
.namespace []
.sub "" :subid("cuid_2_1376052386.6525") :anon :lex
.annotate 'file', "-e"
.annotate 'line', 1
.param pmc __args__ :slurpy
.const 'Sub' $P5003 = 'cuid_1_1376052386.6525'
capture_lex $P5003
.const 'Sub' $P5001 = 'cuid_1_1376052386.6525'
capture_lex $P5001
$P5002 = $P5001()
.return ($P5002)
.end
.loadlib "nqp_group"
.loadlib "nqp_ops"
.loadlib "perl6_ops"
.loadlib "bit_ops"
.loadlib "math_ops"
.loadlib "trans_ops"
.loadlib "io_ops"
.loadlib "obscure_ops"
.loadlib "os"
.loadlib "file"
.loadlib "sys_ops"
.loadlib "nqp_bigint_ops"
.loadlib "nqp_dyncall_ops"
.HLL "perl6"
.namespace []
.sub "" :subid("cuid_1_1376052386.6525") :anon :lex :outer("cuid_2_1376052386.6525")
.annotate 'file', "-e"
.annotate 'line', 1
.lex "GLOBALish", $P101
.lex "EXPORT", $P102
.lex "$?PACKAGE", $P103
.lex "::?PACKAGE", $P104
.lex "$_", $P105
.lex "$/", $P106
.lex "$!", $P107
.lex "@a", $P108
.lex "$rpa", $P109
.lex "$s", $P110
.lex "$=pod", $P111
.lex "!UNIT_MARKER", $P112
.local pmc ctxsave
.local pmc sink_1
.local pmc sink_2
find_dynamic_lex $P5001, "$*CTXSAVE"
set ctxsave, $P5001
isnull $I5001, ctxsave
if $I5001 goto unless10_end11
can $I5002, ctxsave, "ctxsave"
perl6_box_int $P5004, $I5002
set $P5003, $P5004
unless $I5002 goto if11_end13
$P5002 = ctxsave."ctxsave"()
set $P5003, $P5002
if11_end13:
unless10_end11:
nqp_get_sc_object $P5001, "EF065C03B74235EF71A810072903C8B8075E5893", 17
nqp_get_sc_object $P5002, "EF065C03B74235EF71A810072903C8B8075E5893", 20
$P108."STORE"($P5002)
.local pmc task, operation, starter, offset, end, interp, tasks, array_a, array_b, number
.local int offset_i
tasks = new ['ResizablePMCArray']
$P5006 = $P108."FLATTENABLE_LIST"()
set array_a, $P5006
$P5007 = $P108."FLATTENABLE_LIST"()
set array_b, $P5007
nqp_get_sc_object $P5003, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647", 41
$P5004 = $P5003."new"()
$P5005 = $P5004."FLATTENABLE_LIST"()
offset = new ['Integer']
offset = 0
end = new ['Integer']
end = 1000
number = new ['Integer']
offset_i = offset
spawn_tasks:
task = new ['Task']
push task, $P5005
push task, array_a
push task, array_b
.const 'Sub' $P0 = 'hyper_task'
setattribute task, 'code', $P0
number = new ['Integer']
number = offset_i
setattribute task, 'data', number
push tasks, task
schedule task
inc offset_i
if end >= offset_i goto spawn_tasks
offset_i = offset
join_tasks:
task = tasks[offset_i]
wait task
inc offset_i
if end >= offset_i goto join_tasks
nqp_get_sc_object $P5011, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647", 16
perl6_assert_bind_ok $P5005, $P5011
set $P109, $P5005
shift $P5002, $P109
nqp_get_sc_object $P5003, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647", 16
perl6_assert_bind_ok $P5002, $P5003
set $P110, $P5002
nqp_get_sc_object $P5002, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647", 34
type_check $I5001, $P110, $P5002
$P5003 = "&say"($I5001)
set sink_1, $P5003
repr_defined $I5002, sink_1
set $I5004, $I5002
unless $I5002 goto if13_end17
can $I5003, sink_1, "sink"
set $I5004, $I5003
if13_end17:
perl6_box_int $P5006, $I5004
set $P5005, $P5006
unless $I5004 goto if12_end15
$P5004 = sink_1."sink"()
set $P5005, $P5004
if12_end15:
$P5003 = $P110."hurz"()
nqp_hllize $P5002, $P5003
set sink_2, $P5002
repr_defined $I5001, sink_2
set $I5003, $I5001
unless $I5001 goto if15_end21
can $I5002, sink_2, "sink"
set $I5003, $I5002
if15_end21:
perl6_box_int $P5006, $I5003
set $P5005, $P5006
unless $I5003 goto if14_end19
$P5004 = sink_2."sink"()
set $P5005, $P5004
if14_end19:
nqp_get_sc_object $P5002, "EF065C03B74235EF71A810072903C8B8075E5893", 16
$P5003 = "&say"($P5002)
.return ($P5003)
.end
.namespace []
.sub "" :subid("hyper_task")
.annotate 'file', "-e"
.param pmc offset
.local pmc interp, task, results, array_a, array_b, write_task
.local int a, b, c
interp = getinterp
task = interp.'current_task'()
array_b = pop task
array_a = pop task
results = pop task
a = array_a[offset]
b = array_b[offset]
perl6_box_int $P5008, a
perl6_box_int $P5009, b
nqp_get_sc_object $P5002, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647", 34
nqp_bigint_add $P5010, $P5008, $P5009, $P5002
write_task = new ['Task']
push write_task, offset
push write_task, $P5010
.const 'Sub' $P0 = 'write_task'
setattribute write_task, 'code', $P0
setattribute write_task, 'data', results
interp.'schedule_proxied'(write_task, results)
wait write_task
.end
.namespace []
.sub "" :subid("write_task")
.annotate 'file', "-e"
.param pmc results
.local pmc interp, task, offset, number
interp = getinterp
task = interp.'current_task'()
number = pop task
offset = pop task
results[offset] = number
.end
.HLL "perl6"
.namespace []
.sub "" :subid("cuid_4_1376052386.6525") :load :init
.annotate 'file', "-e"
.const 'Sub' $P5001 = 'cuid_3_1376052386.6525'
capture_lex $P5001
.local pmc cur_sc
.local pmc conflicts
nqp_dynop_setup
nqp_bigint_setup
nqp_native_call_setup
rakudo_dynop_setup
getinterp $P5001
get_class $P5002, "LexPad"
get_class $P5003, "NQPLexPad"
$P5004 = $P5001."hll_map"($P5002, $P5003)
load_bytecode "ModuleLoader.pbc"
new $P5002, 'ResizableStringArray'
push $P5002, "nqp"
get_root_global $P5001, $P5002, "ModuleLoader"
$P5001."load_module"("Perl6::ModuleLoader")
.const 'Sub' $P5001 = "cuid_2_1376052386.6525"
get_hll_global $P5002, "ModuleLoader"
$P5003 = $P5002."load_setting"("CORE")
$P5004 = $P5001."set_outer_ctx"($P5003)
nqp_create_sc $P5001, "EF065C03B74235EF71A810072903C8B8075E5893"
set cur_sc, $P5001
$P5002 = cur_sc."set_description"("-e")
new $P5003, 'ResizablePMCArray'
set conflicts, $P5003
new $P5004, 'ResizableStringArray'
null $S5001
push $P5004, $S5001
push $P5004, "Uninstantiable"
push $P5004, "9CB83CEF6AFA5CD07175630CC94DD25CC32CF441"
push $P5004, "src/gen/CORE.setting"
push $P5004, "6C0827CF8DE94CF91BE4A49425594048FCA5DCE1-1376052134.94337"
push $P5004, "src/gen/Metamodel.nqp"
push $P5004, "F6A32C1D039F571A5BA215B40F3FEBE332C858B6-1376052143.83647"
push $P5004, "src/gen/BOOTSTRAP.nqp"
push $P5004, "$_"
push $P5004, "$/"
push $P5004, "$!"
push $P5004, "@a"
push $P5004, "7A67D46DDEA3C60BB73DFB1CA4F76715F3D1212C-1375731965.44192"
push $P5004, "src/stage2/NQPCORE.setting"
push $P5004, "1001"
push $P5004, "$rpa"
push $P5004, "$s"
push $P5004, "done"
push $P5004, "GLOBAL"
push $P5004, "EXPORT"
push $P5004, "!UNIT_MARKER"
.const 'Sub' $P5005 = 'cuid_3_1376052386.6525'
capture_lex $P5005
$P5006 = $P5005()
nqp_deserialize_sc "BgAAAEAAAAAEAAAAYAAAAAMAAACEAAAAaAEAACAAAABoAwAA1gUAAAAAAADWBQAAAAAAANYFAADWBQAAAAAAAAIAAAADAAAABAAAAAUAAAAGAAAABwAAAAwAAAANAAAAAQAAAAAAAABMAAAAAQAAAEwAAACYAAAAAQAAAJgAAADkAAAAAAAAABUAAAAAAAAAAAAAAAIAAAAAABYAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAAEAAAACAAAAAAAYAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGQAAAAAAAAASAAAAAgAAAAAAGgAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAABAAAAdgAAAAAAAAABAAAAAgAAAC4AAAAYAAAAAQAAAAEAAAB0AAAAOAAAAAEAAAACAAAALgAAAE4AAAABAAAAAQAAAHQAAABuAAAAAQAAAAIAAAAuAAAAhAAAAAEAAAABAAAAdAAAAKQAAAABAAAAAgAAAC4AAAC6AAAAAQAAAAEAAADsAAAA2gAAAAEAAAABAAAArwAAAOoAAAABAAAAAgAAAC4AAADuAAAAAQAAAAEAAAB0AAAADgEAAAEAAAACAAAALgAAACQBAAABAAAAAQAAAHQAAABEAQAAAQAAAAEAAADdAAAAWgEAAAEAAAABAAAA7AAAAF4BAAABAAAAAAAAAAIAAAB2AQAAAAAAAAEAAAAIAQAAdgEAAAEAAAABAAAAbwAAAIwBAAABAAAAAQAAAAUCAAC0AQAAAQAAAAEAAAAFAQAAxgEAAAEAAAABAAAABQIAAM4BAAABAAAAAQAAAAUBAADgAQAAAQAAAAEAAAAFAgAA6AEAAAEAAAABAAAABQEAAPoBAAABAAAAAQAAAOYAAAACAgAAAQAAAAEAAAB0AAAAFgIAAAEAAAABAAAAdAAAACwCAAABAAAAAQAAAHQAAABCAgAAAQAAAAEAAAB0AAAAWAIAAAEAAAALAAAAAAAAAAAAAgAAAAAAEwAAAAMAAQACAAMAAAAQAAAAAQAAAAAAAAAIAAAAAgADAAAAEQAAAAIAAAAAAAMAAAACAAMAAAARAAAAAQACAAMAAAAQAAAAAQAAAAAAAAAJAAAAAgADAAAAEQAAAAIAAAAAAAUAAAACAAMAAAARAAAAAQACAAMAAAAQAAAAAQAAAAAAAAAKAAAAAgADAAAAEQAAAAIAAAAAAAcAAAACAAMAAAARAAAAAQACAAMAAAAQAAAAAQAAAAAAAAALAAAAAgAEAAAAGgAAAAEAAQABAAIAAAAAAAkAAAAOAAAAAgADAAAAEAAAAAEAAAAAAAAADwAAAAIAAwAAABAAAAACAAAAAAAMAAAAAgADAAAAEAAAAAEAAgADAAAAEAAAAAEAAAAAAAAAEAAAAAIAAwAAABAAAAACAAAAAAAOAAAAAgADAAAAEAAAAAEAEQAAAAEAAgADAAAAhAAAAAIAAAAAABsAAAABAAcAAAAAAAEAAQABAAIAAAAAAAIAAAACAAAAAAAcAAAAAgAAAAAAHQAAAAIAAAAAAB4AAAACAAAAAAAfAAAABAABAAAAAAAAAAYAEgAAAAEACgAAAAAAAQAEAAEAAAAAAAAABgATAAAAAQAKAAAAAAABAAQAAQAAAAAAAAAGABQAAAABAAoAAAAAAAEAAQABAAcAAAAAAAIAAAAAABEAAAACAAEAAAAUPQAAAgABAAAAcgAAAAEAAgABAAAAFj0AAAIAAAAAAAsAAAABAAIAAQAAABg9AAACAAMAAACDAAAAAQACAAEAAAAaPQAAAgADAAAAhAAAAAEA", cur_sc, $P5004, $P5006, conflicts
unless conflicts goto if16_end23
get_hll_global $P5007, "ModuleLoader"
$P5008 = $P5007."resolve_repossession_conflicts"(conflicts)
if16_end23:
.const 'Sub' $P5001 = "cuid_1_1376052386.6525"
nqp_get_sc_object $P5002, "EF065C03B74235EF71A810072903C8B8075E5893", 2
set_sub_code_object $P5001, $P5002
nqp_get_sc_object $P5001, "EF065C03B74235EF71A810072903C8B8075E5893", 0
set_hll_global "GLOBAL", $P5001
.const "LexInfo" $P5001 = "cuid_1_1376052386.6525"
new $P5002, 'ResizableStringArray'
push $P5002, "GLOBALish"
push $P5002, "EXPORT"
push $P5002, "$?PACKAGE"
push $P5002, "::?PACKAGE"
push $P5002, "$_"
push $P5002, "$/"
push $P5002, "$!"
push $P5002, "@a"
push $P5002, "$rpa"
push $P5002, "$s"
push $P5002, "$=pod"
push $P5002, "!UNIT_MARKER"
new $P5003, 'ResizablePMCArray'
nqp_get_sc_object $P5004, "EF065C03B74235EF71A810072903C8B8075E5893", 0
push $P5003, $P5004
nqp_get_sc_object $P5005, "EF065C03B74235EF71A810072903C8B8075E5893", 1
push $P5003, $P5005
nqp_get_sc_object $P5006, "EF065C03B74235EF71A810072903C8B8075E5893", 0
push $P5003, $P5006
nqp_get_sc_object $P5007, "EF065C03B74235EF71A810072903C8B8075E5893", 0
push $P5003, $P5007
nqp_get_sc_object $P5008, "EF065C03B74235EF71A810072903C8B8075E5893", 4
push $P5003, $P5008
nqp_get_sc_object $P5009, "EF065C03B74235EF71A810072903C8B8075E5893", 6
push $P5003, $P5009
nqp_get_sc_object $P5010, "EF065C03B74235EF71A810072903C8B8075E5893", 8
push $P5003, $P5010
nqp_get_sc_object $P5011, "EF065C03B74235EF71A810072903C8B8075E5893", 10
push $P5003, $P5011
nqp_get_sc_object $P5012, "EF065C03B74235EF71A810072903C8B8075E5893", 13
push $P5003, $P5012
nqp_get_sc_object $P5013, "EF065C03B74235EF71A810072903C8B8075E5893", 15
push $P5003, $P5013
nqp_get_sc_object $P5014, "EF065C03B74235EF71A810072903C8B8075E5893", 17
push $P5003, $P5014
nqp_get_sc_object $P5015, "EF065C03B74235EF71A810072903C8B8075E5893", 18
push $P5003, $P5015
new $P5016, 'ResizableIntegerArray'
push $P5016, 0
push $P5016, 0
push $P5016, 0
push $P5016, 0
push $P5016, 1
push $P5016, 1
push $P5016, 1
push $P5016, 1
push $P5016, 1
push $P5016, 1
push $P5016, 0
push $P5016, 0
$P5017 = $P5001."setup_static_lexpad"($P5002, $P5003, $P5016)
.return ($P5017)
.end
.HLL "perl6"
.namespace []
.sub "" :subid("cuid_3_1376052386.6525") :anon :lex :outer("cuid_4_1376052386.6525")
.annotate 'file', "-e"
new $P5001, 'ResizablePMCArray'
.const 'Sub' $P5002 = "cuid_1_1376052386.6525"
push $P5001, $P5002
.return ($P5001)
.end
.HLL "perl6"
.namespace []
.sub "" :subid("cuid_5_1376052386.6525") :load
.annotate 'file', "-e"
.const 'Sub' $P5001 = "cuid_2_1376052386.6525"
$P5002 = $P5001()
.return ($P5002)
.end
Raw
hyper_MT.pl
$ops.add_hll_op('perl6', 'hyper_MT', :inlinable(1), -> $qastcomp, $op {
if +$op.list != 4 {
nqp::die("Operation 'hyper_MT' needs 4 operands");
}
my $obj := $qastcomp.coerce($qastcomp.as_post( $op[3] ), 'P');
# the array we write the results to
my $rreg := $qastcomp.coerce($qastcomp.as_post( QAST::Op.new( :op<callmethod>, :name<FLATTENABLE_LIST>,
QAST::Op.new( :op<callmethod>, :name<new>, $op[2] ) ) ), 'P');
# input array a and b
my $arr_a := $qastcomp.coerce($qastcomp.as_post( QAST::Op.new( :op<callmethod>, :name<FLATTENABLE_LIST>, $op[0] ) ), 'P');
my $arr_b := $qastcomp.coerce($qastcomp.as_post( QAST::Op.new( :op<callmethod>, :name<FLATTENABLE_LIST>, $op[1] ) ), 'P');
# create a proxy (green thread) that will write to a "shared" variable
my $write_ops := PIRT::Ops.new();
$write_ops.push_pirop(".param pmc results");
$write_ops.push_pirop(".local pmc interp, task, offset, number");
$write_ops.push_pirop("interp = getinterp");
$write_ops.push_pirop("task = interp.'current_task'()");
$write_ops.push_pirop("number = pop task");
$write_ops.push_pirop("offset = pop task");
$write_ops.push_pirop("results[offset] = number");
my $write_sub := PIRT::Sub.new();
$write_sub.push($write_ops);
$write_sub.subid('write_task');
# create the op itself
my $add_i_ops := PIRT::Ops.new();
$add_i_ops.push($write_sub);
$add_i_ops.push_pirop(".param pmc offset");
$add_i_ops.push_pirop(".local pmc interp, task, results, array_a, array_b, write_task");
$add_i_ops.push_pirop(".local int a, b, c");
$add_i_ops.push_pirop("interp = getinterp");
$add_i_ops.push_pirop("task = interp.'current_task'()");
$add_i_ops.push_pirop("array_b = pop task");
$add_i_ops.push_pirop("array_a = pop task");
$add_i_ops.push_pirop("results = pop task");
$add_i_ops.push_pirop("a = array_a[offset]");
$add_i_ops.push_pirop("b = array_b[offset]");
my $a := $*REGALLOC.fresh_p();
my $b := $*REGALLOC.fresh_p();
my $c := $*REGALLOC.fresh_p();
$add_i_ops.push($obj);
my $reg := add_sc_object($op[3], $obj); # <--- here it gets Int
$add_i_ops.push_pirop('perl6_box_int', $a, 'a');
$add_i_ops.push_pirop('perl6_box_int', $b, 'b');
$add_i_ops.push_pirop('nqp_bigint_add', $c, $a, $b, $reg);
$add_i_ops.push_pirop("write_task = new ['Task']");
$add_i_ops.push_pirop("push write_task, offset");
$add_i_ops.push_pirop('push', 'write_task', $c); # we pass it to the green thread because this one is allowed to write
$add_i_ops.push_pirop(".const 'Sub' \$P0 = 'write_task'");
$add_i_ops.push_pirop("setattribute write_task, 'code', \$P0");
$add_i_ops.push_pirop("setattribute write_task, 'data', results");
$add_i_ops.push_pirop("interp.'schedule_proxied'(write_task, results)");
$add_i_ops.push_pirop("wait write_task");
my $add_i_sub := PIRT::Sub.new();
$add_i_sub.push($add_i_ops);
$add_i_sub.subid('hyper_task');
# the main sub, it iterates over the input arrays and creates threads (tasks)
my $ops := PIRT::Ops.new();
$ops.push($add_i_sub);
$ops.push_pirop(".local pmc task, operation, starter, offset, end, interp, tasks, array_a, array_b, number");
$ops.push_pirop(".local int offset_i");
$ops.push_pirop("tasks = new ['ResizablePMCArray']");
$ops.push($arr_a);
$ops.push_pirop('set', 'array_a', $arr_a);
$ops.push($arr_b);
$ops.push_pirop('set', 'array_b', $arr_b);
$ops.push($rreg);
#~ $ops.push_pirop('set', 'results', $rreg);
$ops.push_pirop("offset = new ['Integer']");
$ops.push_pirop("offset = 0");
$ops.push_pirop("end = new ['Integer']");
$ops.push_pirop("end = 1000");
$ops.push_pirop("number = new ['Integer']");
$ops.push_pirop("offset_i = offset");
$ops.push_pirop("spawn_tasks:");
$ops.push_pirop("task = new ['Task']");
$ops.push_pirop('push', 'task', $rreg);
$ops.push_pirop("push task, array_a");
$ops.push_pirop("push task, array_b");
$ops.push_pirop(".const 'Sub' \$P0 = 'hyper_task'");
$ops.push_pirop("setattribute task, 'code', \$P0");
$ops.push_pirop("number = new ['Integer']");
$ops.push_pirop("number = offset_i");
$ops.push_pirop("setattribute task, 'data', number");
$ops.push_pirop("push tasks, task");
$ops.push_pirop("schedule task");
$ops.push_pirop("inc offset_i");
$ops.push_pirop("if end >= offset_i goto spawn_tasks");
$ops.push_pirop("offset_i = offset");
$ops.push_pirop("join_tasks:");
$ops.push_pirop("task = tasks[offset_i]");
$ops.push_pirop("wait task");
$ops.push_pirop("inc offset_i");
$ops.push_pirop("if end >= offset_i goto join_tasks");
$ops.result($rreg);
$ops
});
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment