Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Perl6: /examples/life.p6 is broken #13

Closed
p6rt opened this issue May 11, 2004 · 8 comments
Closed

Perl6: /examples/life.p6 is broken #13

p6rt opened this issue May 11, 2004 · 8 comments

Comments

@p6rt
Copy link

p6rt commented May 11, 2004

Migrated from rt.perl.org#29509 (status was 'resolved')

Searchable as RT29509$

@p6rt
Copy link
Author

p6rt commented May 11, 2004

From alexg@ebi.ac.uk

Hi,

The example Perl6 'Game of Life' program
(parrot/languages/perl6/examples/life.p6) is broken. As it stands it
doesn't parse correctly but this is easily fixed by adding the correct
string concatenation operator '~'​:

--- ../../parrot_cvs/parrot/languages/perl6/examples/life.p6 Tue
Oct 8 08​:27​:32 2002
+++ examples/life.p6 Tue May 11 15​:46​:46 2004
@​@​ -57,21 +57,21 @​@​

sub main() {
  my $world =
- " " _
- " * " _
- " * " _
- "*** " _
- " " _
- " " _
- " " _
- " " _
- " " _
- " " _
- " " _
- " " _
- " * " _
- " * " _
- " *** " _
+ " " ~
+ " * " ~
+ " * " ~
+ "*** " ~
+ " " ~
+ " " ~
+ " " ~
+ " " ~
+ " " ~
+ " " ~
+ " " ~
+ " " ~
+ " * " ~
+ " * " ~
+ " *** " ~
  " "
  ;

However, now parrot crashes with a segfault somewhere in the Generate
subroutine​:

Error​: '/tmp_mnt/nfs6/vol_vol1_homes/alexg/parrot_cvs/parrot/parrot -r
languages/perl6/examples/life.imc ' failed
  died with signal 11 (SIGSEGV)
  and dumped core
Stopped at languages/perl6/perl6 line 346
  main​::mydie(139,
'/tmp_mnt/nfs6/vol_vol1_homes/alexg/parrot_cvs/parrot/parrot -r l...')
called at languages/perl6/perl6 line 829
  main​::pass4('languages/perl6/examples/life.imc',
'languages/perl6/examples/life.warn') called at languages/perl6/perl6
line 751
  main​::pass2('languages/perl6/examples/life.imc',
'languages/perl6/examples/life.warn') called at languages/perl6/perl6
line 444
  main​::output_tree('P6C​::prog=ARRAY(0x8e639fc)',
'languages/perl6/examples/life.p6',
'languages/perl6/examples/life.warn') called at languages/perl6/perl6
line 509
  main​::pass1('Parse​::RecDescent=HASH(0x8e9dac4)',
'languages/perl6/examples/life.p6',
'languages/perl6/examples/life.warn', undef) called at
languages/perl6/perl6 line 571
  main​::run() called at languages/perl6/perl6 line 226

I've had a look at the generated (and attached) imc file, and can't see
anything obviously crazy. I'm not sure how to go about debugging this
further.

This is using a fresh cvs checkout​: (May 11 2004 15​:54 GMT) running on
Linux 2.4.22 i686

--
Alex Gutteridge
European Bioinformatics Institute
Cambridge UK

Tel​: 01223 492537
Email​: alexg@​ebi.ac.uk

@p6rt
Copy link
Author

p6rt commented May 11, 2004

From alexg@ebi.ac.uk

.sub __main
  new_pad 0
  call __setup
  .local Sub map_sub
  newsub map_sub, .Sub, _map
  store_lex -1, "&map", map_sub
  .local Sub length_sub
  newsub length_sub, .Sub, _length
  store_lex -1, "&length", length_sub
  .local Sub join_sub
  newsub join_sub, .Sub, _join
  store_lex -1, "&join", join_sub
  .local Sub Print_sub
  newsub Print_sub, .Sub, _Print
  store_lex -1, "&Print", Print_sub
  .local Sub index_sub
  newsub index_sub, .Sub, _index
  store_lex -1, "&index", index_sub
  .local Sub print1_sub
  newsub print1_sub, .Sub, _print1
  store_lex -1, "&print1", print1_sub
  .local Sub main_sub
  newsub main_sub, .Sub, _main
  store_lex -1, "&main", main_sub
  .local Sub print_sub
  newsub print_sub, .Sub, _print
  store_lex -1, "&print", print_sub
  .local Sub install_catch_sub
  newsub install_catch_sub, .Sub, _install_catch
  store_lex -1, "&install_catch", install_catch_sub
  .local Sub reverse_sub
  newsub reverse_sub, .Sub, _reverse
  store_lex -1, "&reverse", reverse_sub
  .local Sub time_sub
  newsub time_sub, .Sub, _time
  store_lex -1, "&time", time_sub
  .local Sub sleep_sub
  newsub sleep_sub, .Sub, _sleep
  store_lex -1, "&sleep", sleep_sub
  .local Sub Generate_sub
  newsub Generate_sub, .Sub, _Generate
  store_lex -1, "&Generate", Generate_sub
  .local Sub grep_sub
  newsub grep_sub, .Sub, _grep
  store_lex -1, "&grep", grep_sub
  .local Sub substr_sub
  newsub substr_sub, .Sub, _substr
  store_lex -1, "&substr", substr_sub
  .local Sub die_sub
  newsub die_sub, .Sub, _die
  store_lex -1, "&die", die_sub
  .local Sub pop_catch_sub
  newsub pop_catch_sub, .Sub, _pop_catch
  store_lex -1, "&pop_catch", pop_catch_sub
  .local Sub warn_sub
  newsub warn_sub, .Sub, _warn
  store_lex -1, "&warn", warn_sub
  .local Sub exit_sub
  newsub exit_sub, .Sub, _exit
  store_lex -1, "&exit", exit_sub
  main_sub(P5)
  pop_pad
  end
.end
.sub _Print prototyped
  .param PerlHash Sunknown_named3 # named args
  .param PerlUndef _SV_world # Positional param $world
# Argument handling
  if I0 goto L_got_params182
  if I1 >= 2 goto L_skip_param__SV_world183
  exists $I466, Sunknown_named3["world"]
  unless $I466 goto L_skip_param__SV_world183
  _SV_world = Sunknown_named3["world"]
  delete Sunknown_named3["world"]
L_skip_param__SV_world183​:
L_got_params182​:
# Named locals​:
  .local PerlUndef _SV_i1
  _SV_i1 = new PerlUndef
# constructed from "sub" or "rule"
# source​: tree
  _SV_i1 = 0
  goto L_loop139
L_loop138​:
L_141​:

  find_lex $P306, "&print1"
  $P307 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlUndef $a)

  find_lex $P308, "&substr"
  $P309 = new PerlArray # slurpy array arg
  $P310 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P311 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P311 = 1
  $P311[0] = _SV_world
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P313 = new PerlUndef
# append $P311 to the end of $P309 ('push @​P309, *@​P311')
  $I314 = 0
  $I312 = $P311
L_append_loop_top144​:
  if $I314 >= $I312 goto L_append_loop_end145
  $P313 = $P311[$I314]
  push $P309, $P313
  inc $I314
  goto L_append_loop_top144
L_append_loop_end145​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P315 = new PerlUndef
  $P315 = 16 # primitive_in_context from P6C​::sv_literal​::val
  $P316 = new PerlUndef
  $P316 = _SV_i1 * $P315
  $P317 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P317 = 1
  $P317[0] = $P316
# scalar_in_context(array) from P6C​::Binop​::val END
  $P319 = new PerlUndef
# append $P317 to the end of $P309 ('push @​P309, *@​P317')
  $I320 = 0
  $I318 = $P317
L_append_loop_top146​:
  if $I320 >= $I318 goto L_append_loop_end147
  $P319 = $P317[$I320]
  push $P309, $P319
  inc $I320
  goto L_append_loop_top146
L_append_loop_end147​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P321 = new PerlUndef
  $P321 = 16 # primitive_in_context from P6C​::sv_literal​::val
  $P322 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P322 = 1
  $P322[0] = $P321
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P324 = new PerlUndef
# append $P322 to the end of $P309 ('push @​P309, *@​P322')
  $I325 = 0
  $I323 = $P322
L_append_loop_top148​:
  if $I325 >= $I323 goto L_append_loop_end149
  $P324 = $P322[$I325]
  push $P309, $P324
  inc $I325
  goto L_append_loop_top148
L_append_loop_end149​:
  $P326 = new PerlUndef
  $P327 = $P308($P309)
  $P328 = new PerlUndef
  $P306($P327)
L_140​:
L_143​:
  _SV_i1 = clone _SV_i1
  inc _SV_i1
L_loop139​:
  $P330 = new PerlUndef
  $I329 = 0
  $N331 = _SV_i1
  $P333 = new PerlUndef
  $P333 = 16 # primitive_in_context from P6C​::sv_literal​::val
  $N332 = $P333
  if $N331 < $N332 goto L_153
  goto L_comparison152
L_153​:
  $I329 = 1
L_comparison152​:
  $P330 = $I329
  if $P330 goto L_loop138
L_142​:

  find_lex $P334, "&print"
  $P335 = new PerlArray # slurpy array arg
  $P336 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P337 = new PerlUndef
  $P337 = "----------------\n" # primitive_in_context from P6C​::sv_literal​::val
  $P338 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P338 = 1
  $P338[0] = $P337
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P340 = new PerlUndef
# append $P338 to the end of $P335 ('push @​P335, *@​P338')
  $I341 = 0
  $I339 = $P338
L_append_loop_top154​:
  if $I341 >= $I339 goto L_append_loop_end155
  $P340 = $P338[$I341]
  push $P335, $P340
  inc $I341
  goto L_append_loop_top154
L_append_loop_end155​:
  $P342 = new PerlUndef
  $P334($P335)
  $P343 = new PerlArray
  $P343 = 0
  .pcc_begin_return
  .return $P343 # regular (non-rule) return
  .pcc_end_return
L_137​:
  .pcc_begin_return # fallback
  .pcc_end_return
.end
.sub _main prototyped
  .param PerlArray _AV_ARGS # Positional param @​ARGS
# Named locals​:
  .local PerlUndef _SV_te2
  .local PerlUndef _SV_world1
  .local PerlUndef _SV_j1
  .local PerlUndef _SV_ts1
  .local PerlUndef _SV_gen1
  _SV_te2 = new PerlUndef
  _SV_world1 = new PerlUndef
  _SV_j1 = new PerlUndef
  _SV_ts1 = new PerlUndef
  _SV_gen1 = new PerlUndef
# constructed from "sub" or "rule"
  $S387 = " "
  $S388 = " * "
  $S389 = $S387 . $S388
  $P390 = new PerlUndef
  $P390 = $S389 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S384 = $P390
  $S385 = " * "
  $S386 = $S384 . $S385
  $P391 = new PerlUndef
  $P391 = $S386 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S381 = $P391
  $S382 = "*** "
  $S383 = $S381 . $S382
  $P392 = new PerlUndef
  $P392 = $S383 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S378 = $P392
  $S379 = " "
  $S380 = $S378 . $S379
  $P393 = new PerlUndef
  $P393 = $S380 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S375 = $P393
  $S376 = " "
  $S377 = $S375 . $S376
  $P394 = new PerlUndef
  $P394 = $S377 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S372 = $P394
  $S373 = " "
  $S374 = $S372 . $S373
  $P395 = new PerlUndef
  $P395 = $S374 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S369 = $P395
  $S370 = " "
  $S371 = $S369 . $S370
  $P396 = new PerlUndef
  $P396 = $S371 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S366 = $P396
  $S367 = " "
  $S368 = $S366 . $S367
  $P397 = new PerlUndef
  $P397 = $S368 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S363 = $P397
  $S364 = " "
  $S365 = $S363 . $S364
  $P398 = new PerlUndef
  $P398 = $S365 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S360 = $P398
  $S361 = " "
  $S362 = $S360 . $S361
  $P399 = new PerlUndef
  $P399 = $S362 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S357 = $P399
  $S358 = " "
  $S359 = $S357 . $S358
  $P400 = new PerlUndef
  $P400 = $S359 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S354 = $P400
  $S355 = " * "
  $S356 = $S354 . $S355
  $P401 = new PerlUndef
  $P401 = $S356 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S351 = $P401
  $S352 = " * "
  $S353 = $S351 . $S352
  $P402 = new PerlUndef
  $P402 = $S353 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S348 = $P402
  $S349 = " *** "
  $S350 = $S348 . $S349
  $P403 = new PerlUndef
  $P403 = $S350 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
  $S345 = $P403
  $S346 = " "
  $S347 = $S345 . $S346
  $P404 = new PerlUndef
  $P404 = $S347 # primitive_in_context from P6C​::IMCC​::Binop​::do_concat
# ASSIGN TO $world
  _SV_world1 = clone $P404
# source​: tree
# Base for indexing
  $P406 = global "_AV_ARGS"
# done; result in $P406
# Indexing expression
# done; result in 0
  $I408 = 0
  $P407 = $P406[$I408]
# LOGICAL OR
  $P405 = $P407
  if $P405 goto L_logical_or158
  $P409 = new PerlUndef
  $P409 = 100 # primitive_in_context from P6C​::sv_literal​::val
  $P405 = $P409
# END_LOGICAL_OR
L_logical_or158​:
# ASSIGN TO $gen
  _SV_gen1 = clone $P405

  find_lex $P410, "&print"
  $P411 = new PerlArray # slurpy array arg
  $P412 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
# ValueList in array context
  $P413 = new PerlArray
# START array flattening.
  $I415 = 0
  $P413[$I415] = "Running "
  inc $I415
  $P418 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P418 = 1
  $P418[0] = _SV_gen1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $I414 = $P418
  goto L_160
L_159​:
  dec $I414
  $P417 = $P418[$I414]
  $I416 = $I415 + $I414
  $P413[$I416] = $P417

L_160​:
  if $I414 != 0 goto L_159
  $I414 = $P418
  $I415 = $I415 + $I414
  $P413[$I415] = " generations\n"
  inc $I415
# END array flattening
  $P420 = new PerlUndef
# append $P413 to the end of $P411 ('push @​P411, *@​P413')
  $I421 = 0
  $I419 = $P413
L_append_loop_top161​:
  if $I421 >= $I419 goto L_append_loop_end162
  $P420 = $P413[$I421]
  push $P411, $P420
  inc $I421
  goto L_append_loop_top161
L_append_loop_end162​:
  $P422 = new PerlUndef
  $P410($P411)

  find_lex $P423, "&Print"
  $P424 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlUndef $world)
  $P425 = new PerlUndef
  $P426 = $P423($P424, _SV_world1)

  find_lex $P427, "&time"
  $P428 = new PerlHash # dynamically-named args
  $P429 = new PerlUndef
  $P430 = $P427()
# ASSIGN TO $ts
  _SV_ts1 = clone $P430
  _SV_j1 = 0
  goto L_loop167
L_loop166​:
L_169​:
# Base for indexing

  find_lex $P431, "&Generate"
  $P432 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlUndef $input)
  $P433 = new PerlUndef
  $P434 = $P431($P432, _SV_world1)
# done; result in $P434
# Indexing expression
# done; result in 0
  $I436 = 0
  $P435 = $P434[$I436]
# ASSIGN TO $world
  _SV_world1 = clone $P435
L_168​:
L_171​:
  _SV_j1 = clone _SV_j1
  inc _SV_j1
L_loop167​:
  $P438 = new PerlUndef
  $I437 = 0
  $N439 = _SV_j1
  $N440 = _SV_gen1
  if $N439 < $N440 goto L_174
  goto L_comparison173
L_174​:
  $I437 = 1
L_comparison173​:
  $P438 = $I437
  if $P438 goto L_loop166
L_170​:

  find_lex $P441, "&time"
  $P442 = new PerlHash # dynamically-named args
  $P443 = new PerlUndef
  $P444 = $P441()
# ASSIGN TO $te
  _SV_te2 = clone $P444

  find_lex $P445, "&Print"
  $P446 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlUndef $world)
  $P447 = new PerlUndef
  $P448 = $P445($P446, _SV_world1)

  find_lex $P449, "&print"
  $P450 = new PerlArray # slurpy array arg
  $P451 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
# ValueList in array context
  $P452 = new PerlArray
# START array flattening.
  $I454 = 0
  $P452[$I454] = "Gens/s "
  inc $I454
  $P457 = new PerlUndef
  $P457 = _SV_te2 - _SV_ts1
  $P458 = new PerlUndef
  $P458 = _SV_gen1 / $P457
  $P459 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P459 = 1
  $P459[0] = $P458
# scalar_in_context(array) from P6C​::Binop​::val END
  $I453 = $P459
  goto L_178
L_177​:
  dec $I453
  $P456 = $P459[$I453]
  $I455 = $I454 + $I453
  $P452[$I455] = $P456

L_178​:
  if $I453 != 0 goto L_177
  $I453 = $P459
  $I454 = $I454 + $I453
  $P452[$I454] = "\n"
  inc $I454
# END array flattening
  $P461 = new PerlUndef
# append $P452 to the end of $P450 ('push @​P450, *@​P452')
  $I462 = 0
  $I460 = $P452
L_append_loop_top179​:
  if $I462 >= $I460 goto L_append_loop_end180
  $P461 = $P452[$I462]
  push $P450, $P461
  inc $I462
  goto L_append_loop_top179
L_append_loop_end180​:
  $P463 = new PerlUndef
  $P449($P450)
  $P464 = new PerlArray
  $P464 = 0
  .pcc_begin_return
  .return $P464 # regular (non-rule) return
  .pcc_end_return
L_157​:
  .pcc_begin_return # fallback
  .pcc_end_return
.end
.sub _Generate prototyped
  .param PerlHash Sunknown_named9 # named args
  .param PerlUndef _SV_input # Positional param $input
# Argument handling
  if I0 goto L_got_params185
  if I1 >= 2 goto L_skip_param__SV_input186
  exists $I468, Sunknown_named9["input"]
  unless $I468 goto L_skip_param__SV_input186
  _SV_input = Sunknown_named9["input"]
  delete Sunknown_named9["input"]
L_skip_param__SV_input186​:
L_got_params185​:
# Named locals​:
  .local PerlUndef _SV_n3
  .local PerlUndef _SV_cell1
  .local PerlUndef _SV_output1
  .local PerlUndef _SV_death1
  .local PerlUndef _SV_i1
  .local PerlUndef _SV_len1
  .local PerlUndef _SV_offset1
  .local PerlUndef _SV_neighbours1
  .local PerlUndef _SV_pos1
  _SV_n3 = new PerlUndef
  _SV_cell1 = new PerlUndef
  _SV_output1 = new PerlUndef
  _SV_death1 = new PerlUndef
  _SV_i1 = new PerlUndef
  _SV_len1 = new PerlUndef
  _SV_offset1 = new PerlUndef
  _SV_neighbours1 = new PerlUndef
  _SV_pos1 = new PerlUndef
# constructed from "sub" or "rule"
# source​: tree
  _SV_len1 = 256
# source​: tree
  _SV_death1 = " ** "
# ASSIGN TO $output
  _SV_output1 = clone _SV_input
  _SV_cell1 = 0
  goto L_loop3
L_loop2​:
L_5​:
  _SV_neighbours1 = 0
  $P1 = new PerlUndef
  $P1 = _SV_cell1 + _SV_len1
# ASSIGN TO $i
  _SV_i1 = clone $P1
  $P3 = new PerlUndef
  $I2 = 0

  find_lex $P4, "&substr"
  $P5 = new PerlArray # slurpy array arg
  $P6 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P7 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P7 = 1
  $P7[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P9 = new PerlUndef
# append $P7 to the end of $P5 ('push @​P5, *@​P7')
  $I10 = 0
  $I8 = $P7
L_append_loop_top9​:
  if $I10 >= $I8 goto L_append_loop_end10
  $P9 = $P7[$I10]
  push $P5, $P9
  inc $I10
  goto L_append_loop_top9
L_append_loop_end10​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P11 = new PerlUndef
  $P11 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P12 = new PerlUndef
  $P12 = _SV_i1 - $P11
  $P13 = new PerlUndef
  $P13 = $P12 % _SV_len1
  $P14 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P14 = 1
  $P14[0] = $P13
# scalar_in_context(array) from P6C​::Binop​::val END
  $P16 = new PerlUndef
# append $P14 to the end of $P5 ('push @​P5, *@​P14')
  $I17 = 0
  $I15 = $P14
L_append_loop_top11​:
  if $I17 >= $I15 goto L_append_loop_end12
  $P16 = $P14[$I17]
  push $P5, $P16
  inc $I17
  goto L_append_loop_top11
L_append_loop_end12​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P18 = new PerlUndef
  $P18 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P19 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P19 = 1
  $P19[0] = $P18
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P21 = new PerlUndef
# append $P19 to the end of $P5 ('push @​P5, *@​P19')
  $I22 = 0
  $I20 = $P19
L_append_loop_top13​:
  if $I22 >= $I20 goto L_append_loop_end14
  $P21 = $P19[$I22]
  push $P5, $P21
  inc $I22
  goto L_append_loop_top13
L_append_loop_end14​:
  $P23 = new PerlUndef
  $P24 = $P4($P5)
  $S25 = $P24
  $P27 = new PerlUndef
  $P27 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S26 = $P27
  if $S25 == $S26 goto L_16
  goto L_comparison8
L_16​:
  $I2 = 1
L_comparison8​:
  $P3 = $I2
  unless $P3 goto L_guard_if17
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if17​:
  $P29 = new PerlUndef
  $I28 = 0

  find_lex $P30, "&substr"
  $P31 = new PerlArray # slurpy array arg
  $P32 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P33 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P33 = 1
  $P33[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P35 = new PerlUndef
# append $P33 to the end of $P31 ('push @​P31, *@​P33')
  $I36 = 0
  $I34 = $P33
L_append_loop_top20​:
  if $I36 >= $I34 goto L_append_loop_end21
  $P35 = $P33[$I36]
  push $P31, $P35
  inc $I36
  goto L_append_loop_top20
L_append_loop_end21​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P37 = new PerlUndef
  $P37 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P38 = new PerlUndef
  $P38 = _SV_i1 + $P37
  $P39 = new PerlUndef
  $P39 = $P38 % _SV_len1
  $P40 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P40 = 1
  $P40[0] = $P39
# scalar_in_context(array) from P6C​::Binop​::val END
  $P42 = new PerlUndef
# append $P40 to the end of $P31 ('push @​P31, *@​P40')
  $I43 = 0
  $I41 = $P40
L_append_loop_top22​:
  if $I43 >= $I41 goto L_append_loop_end23
  $P42 = $P40[$I43]
  push $P31, $P42
  inc $I43
  goto L_append_loop_top22
L_append_loop_end23​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P44 = new PerlUndef
  $P44 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P45 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P45 = 1
  $P45[0] = $P44
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P47 = new PerlUndef
# append $P45 to the end of $P31 ('push @​P31, *@​P45')
  $I48 = 0
  $I46 = $P45
L_append_loop_top24​:
  if $I48 >= $I46 goto L_append_loop_end25
  $P47 = $P45[$I48]
  push $P31, $P47
  inc $I48
  goto L_append_loop_top24
L_append_loop_end25​:
  $P49 = new PerlUndef
  $P50 = $P30($P31)
  $S51 = $P50
  $P53 = new PerlUndef
  $P53 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S52 = $P53
  if $S51 == $S52 goto L_27
  goto L_comparison19
L_27​:
  $I28 = 1
L_comparison19​:
  $P29 = $I28
  unless $P29 goto L_guard_if28
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if28​:
  $P55 = new PerlUndef
  $I54 = 0

  find_lex $P56, "&substr"
  $P57 = new PerlArray # slurpy array arg
  $P58 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P59 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P59 = 1
  $P59[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P61 = new PerlUndef
# append $P59 to the end of $P57 ('push @​P57, *@​P59')
  $I62 = 0
  $I60 = $P59
L_append_loop_top31​:
  if $I62 >= $I60 goto L_append_loop_end32
  $P61 = $P59[$I62]
  push $P57, $P61
  inc $I62
  goto L_append_loop_top31
L_append_loop_end32​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P63 = new PerlUndef
  $P63 = 17 # primitive_in_context from P6C​::sv_literal​::val
  $P64 = new PerlUndef
  $P64 = _SV_i1 - $P63
  $P65 = new PerlUndef
  $P65 = $P64 % _SV_len1
  $P66 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P66 = 1
  $P66[0] = $P65
# scalar_in_context(array) from P6C​::Binop​::val END
  $P68 = new PerlUndef
# append $P66 to the end of $P57 ('push @​P57, *@​P66')
  $I69 = 0
  $I67 = $P66
L_append_loop_top33​:
  if $I69 >= $I67 goto L_append_loop_end34
  $P68 = $P66[$I69]
  push $P57, $P68
  inc $I69
  goto L_append_loop_top33
L_append_loop_end34​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P70 = new PerlUndef
  $P70 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P71 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P71 = 1
  $P71[0] = $P70
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P73 = new PerlUndef
# append $P71 to the end of $P57 ('push @​P57, *@​P71')
  $I74 = 0
  $I72 = $P71
L_append_loop_top35​:
  if $I74 >= $I72 goto L_append_loop_end36
  $P73 = $P71[$I74]
  push $P57, $P73
  inc $I74
  goto L_append_loop_top35
L_append_loop_end36​:
  $P75 = new PerlUndef
  $P76 = $P56($P57)
  $S77 = $P76
  $P79 = new PerlUndef
  $P79 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S78 = $P79
  if $S77 == $S78 goto L_38
  goto L_comparison30
L_38​:
  $I54 = 1
L_comparison30​:
  $P55 = $I54
  unless $P55 goto L_guard_if39
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if39​:
  $P81 = new PerlUndef
  $I80 = 0

  find_lex $P82, "&substr"
  $P83 = new PerlArray # slurpy array arg
  $P84 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P85 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P85 = 1
  $P85[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P87 = new PerlUndef
# append $P85 to the end of $P83 ('push @​P83, *@​P85')
  $I88 = 0
  $I86 = $P85
L_append_loop_top42​:
  if $I88 >= $I86 goto L_append_loop_end43
  $P87 = $P85[$I88]
  push $P83, $P87
  inc $I88
  goto L_append_loop_top42
L_append_loop_end43​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P89 = new PerlUndef
  $P89 = 17 # primitive_in_context from P6C​::sv_literal​::val
  $P90 = new PerlUndef
  $P90 = _SV_i1 + $P89
  $P91 = new PerlUndef
  $P91 = $P90 % _SV_len1
  $P92 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P92 = 1
  $P92[0] = $P91
# scalar_in_context(array) from P6C​::Binop​::val END
  $P94 = new PerlUndef
# append $P92 to the end of $P83 ('push @​P83, *@​P92')
  $I95 = 0
  $I93 = $P92
L_append_loop_top44​:
  if $I95 >= $I93 goto L_append_loop_end45
  $P94 = $P92[$I95]
  push $P83, $P94
  inc $I95
  goto L_append_loop_top44
L_append_loop_end45​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P96 = new PerlUndef
  $P96 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P97 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P97 = 1
  $P97[0] = $P96
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P99 = new PerlUndef
# append $P97 to the end of $P83 ('push @​P83, *@​P97')
  $I100 = 0
  $I98 = $P97
L_append_loop_top46​:
  if $I100 >= $I98 goto L_append_loop_end47
  $P99 = $P97[$I100]
  push $P83, $P99
  inc $I100
  goto L_append_loop_top46
L_append_loop_end47​:
  $P101 = new PerlUndef
  $P102 = $P82($P83)
  $S103 = $P102
  $P105 = new PerlUndef
  $P105 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S104 = $P105
  if $S103 == $S104 goto L_49
  goto L_comparison41
L_49​:
  $I80 = 1
L_comparison41​:
  $P81 = $I80
  unless $P81 goto L_guard_if50
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if50​:
  $P107 = new PerlUndef
  $I106 = 0

  find_lex $P108, "&substr"
  $P109 = new PerlArray # slurpy array arg
  $P110 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P111 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P111 = 1
  $P111[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P113 = new PerlUndef
# append $P111 to the end of $P109 ('push @​P109, *@​P111')
  $I114 = 0
  $I112 = $P111
L_append_loop_top53​:
  if $I114 >= $I112 goto L_append_loop_end54
  $P113 = $P111[$I114]
  push $P109, $P113
  inc $I114
  goto L_append_loop_top53
L_append_loop_end54​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P115 = new PerlUndef
  $P115 = 16 # primitive_in_context from P6C​::sv_literal​::val
  $P116 = new PerlUndef
  $P116 = _SV_i1 - $P115
  $P117 = new PerlUndef
  $P117 = $P116 % _SV_len1
  $P118 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P118 = 1
  $P118[0] = $P117
# scalar_in_context(array) from P6C​::Binop​::val END
  $P120 = new PerlUndef
# append $P118 to the end of $P109 ('push @​P109, *@​P118')
  $I121 = 0
  $I119 = $P118
L_append_loop_top55​:
  if $I121 >= $I119 goto L_append_loop_end56
  $P120 = $P118[$I121]
  push $P109, $P120
  inc $I121
  goto L_append_loop_top55
L_append_loop_end56​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P122 = new PerlUndef
  $P122 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P123 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P123 = 1
  $P123[0] = $P122
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P125 = new PerlUndef
# append $P123 to the end of $P109 ('push @​P109, *@​P123')
  $I126 = 0
  $I124 = $P123
L_append_loop_top57​:
  if $I126 >= $I124 goto L_append_loop_end58
  $P125 = $P123[$I126]
  push $P109, $P125
  inc $I126
  goto L_append_loop_top57
L_append_loop_end58​:
  $P127 = new PerlUndef
  $P128 = $P108($P109)
  $S129 = $P128
  $P131 = new PerlUndef
  $P131 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S130 = $P131
  if $S129 == $S130 goto L_60
  goto L_comparison52
L_60​:
  $I106 = 1
L_comparison52​:
  $P107 = $I106
  unless $P107 goto L_guard_if61
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if61​:
  $P133 = new PerlUndef
  $I132 = 0

  find_lex $P134, "&substr"
  $P135 = new PerlArray # slurpy array arg
  $P136 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P137 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P137 = 1
  $P137[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P139 = new PerlUndef
# append $P137 to the end of $P135 ('push @​P135, *@​P137')
  $I140 = 0
  $I138 = $P137
L_append_loop_top64​:
  if $I140 >= $I138 goto L_append_loop_end65
  $P139 = $P137[$I140]
  push $P135, $P139
  inc $I140
  goto L_append_loop_top64
L_append_loop_end65​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P141 = new PerlUndef
  $P141 = 16 # primitive_in_context from P6C​::sv_literal​::val
  $P142 = new PerlUndef
  $P142 = _SV_i1 + $P141
  $P143 = new PerlUndef
  $P143 = $P142 % _SV_len1
  $P144 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P144 = 1
  $P144[0] = $P143
# scalar_in_context(array) from P6C​::Binop​::val END
  $P146 = new PerlUndef
# append $P144 to the end of $P135 ('push @​P135, *@​P144')
  $I147 = 0
  $I145 = $P144
L_append_loop_top66​:
  if $I147 >= $I145 goto L_append_loop_end67
  $P146 = $P144[$I147]
  push $P135, $P146
  inc $I147
  goto L_append_loop_top66
L_append_loop_end67​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P148 = new PerlUndef
  $P148 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P149 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P149 = 1
  $P149[0] = $P148
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P151 = new PerlUndef
# append $P149 to the end of $P135 ('push @​P135, *@​P149')
  $I152 = 0
  $I150 = $P149
L_append_loop_top68​:
  if $I152 >= $I150 goto L_append_loop_end69
  $P151 = $P149[$I152]
  push $P135, $P151
  inc $I152
  goto L_append_loop_top68
L_append_loop_end69​:
  $P153 = new PerlUndef
  $P154 = $P134($P135)
  $S155 = $P154
  $P157 = new PerlUndef
  $P157 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S156 = $P157
  if $S155 == $S156 goto L_71
  goto L_comparison63
L_71​:
  $I132 = 1
L_comparison63​:
  $P133 = $I132
  unless $P133 goto L_guard_if72
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if72​:
  $P159 = new PerlUndef
  $I158 = 0

  find_lex $P160, "&substr"
  $P161 = new PerlArray # slurpy array arg
  $P162 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P163 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P163 = 1
  $P163[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P165 = new PerlUndef
# append $P163 to the end of $P161 ('push @​P161, *@​P163')
  $I166 = 0
  $I164 = $P163
L_append_loop_top75​:
  if $I166 >= $I164 goto L_append_loop_end76
  $P165 = $P163[$I166]
  push $P161, $P165
  inc $I166
  goto L_append_loop_top75
L_append_loop_end76​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P167 = new PerlUndef
  $P167 = 15 # primitive_in_context from P6C​::sv_literal​::val
  $P168 = new PerlUndef
  $P168 = _SV_i1 - $P167
  $P169 = new PerlUndef
  $P169 = $P168 % _SV_len1
  $P170 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P170 = 1
  $P170[0] = $P169
# scalar_in_context(array) from P6C​::Binop​::val END
  $P172 = new PerlUndef
# append $P170 to the end of $P161 ('push @​P161, *@​P170')
  $I173 = 0
  $I171 = $P170
L_append_loop_top77​:
  if $I173 >= $I171 goto L_append_loop_end78
  $P172 = $P170[$I173]
  push $P161, $P172
  inc $I173
  goto L_append_loop_top77
L_append_loop_end78​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P174 = new PerlUndef
  $P174 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P175 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P175 = 1
  $P175[0] = $P174
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P177 = new PerlUndef
# append $P175 to the end of $P161 ('push @​P161, *@​P175')
  $I178 = 0
  $I176 = $P175
L_append_loop_top79​:
  if $I178 >= $I176 goto L_append_loop_end80
  $P177 = $P175[$I178]
  push $P161, $P177
  inc $I178
  goto L_append_loop_top79
L_append_loop_end80​:
  $P179 = new PerlUndef
  $P180 = $P160($P161)
  $S181 = $P180
  $P183 = new PerlUndef
  $P183 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S182 = $P183
  if $S181 == $S182 goto L_82
  goto L_comparison74
L_82​:
  $I158 = 1
L_comparison74​:
  $P159 = $I158
  unless $P159 goto L_guard_if83
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if83​:
  $P185 = new PerlUndef
  $I184 = 0

  find_lex $P186, "&substr"
  $P187 = new PerlArray # slurpy array arg
  $P188 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P189 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P189 = 1
  $P189[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P191 = new PerlUndef
# append $P189 to the end of $P187 ('push @​P187, *@​P189')
  $I192 = 0
  $I190 = $P189
L_append_loop_top86​:
  if $I192 >= $I190 goto L_append_loop_end87
  $P191 = $P189[$I192]
  push $P187, $P191
  inc $I192
  goto L_append_loop_top86
L_append_loop_end87​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P193 = new PerlUndef
  $P193 = 15 # primitive_in_context from P6C​::sv_literal​::val
  $P194 = new PerlUndef
  $P194 = _SV_i1 + $P193
  $P195 = new PerlUndef
  $P195 = $P194 % _SV_len1
  $P196 = new PerlArray
# scalar_in_context(array) from P6C​::Binop​::val START
  $P196 = 1
  $P196[0] = $P195
# scalar_in_context(array) from P6C​::Binop​::val END
  $P198 = new PerlUndef
# append $P196 to the end of $P187 ('push @​P187, *@​P196')
  $I199 = 0
  $I197 = $P196
L_append_loop_top88​:
  if $I199 >= $I197 goto L_append_loop_end89
  $P198 = $P196[$I199]
  push $P187, $P198
  inc $I199
  goto L_append_loop_top88
L_append_loop_end89​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P200 = new PerlUndef
  $P200 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P201 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P201 = 1
  $P201[0] = $P200
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P203 = new PerlUndef
# append $P201 to the end of $P187 ('push @​P187, *@​P201')
  $I204 = 0
  $I202 = $P201
L_append_loop_top90​:
  if $I204 >= $I202 goto L_append_loop_end91
  $P203 = $P201[$I204]
  push $P187, $P203
  inc $I204
  goto L_append_loop_top90
L_append_loop_end91​:
  $P205 = new PerlUndef
  $P206 = $P186($P187)
  $S207 = $P206
  $P209 = new PerlUndef
  $P209 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S208 = $P209
  if $S207 == $S208 goto L_93
  goto L_comparison85
L_93​:
  $I184 = 1
L_comparison85​:
  $P185 = $I184
  unless $P185 goto L_guard_if94
  _SV_neighbours1 = clone _SV_neighbours1
  inc _SV_neighbours1
L_guard_if94​:
  $P211 = new PerlUndef
  $I210 = 0

  find_lex $P212, "&substr"
  $P213 = new PerlArray # slurpy array arg
  $P214 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P215 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P215 = 1
  $P215[0] = _SV_input
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P217 = new PerlUndef
# append $P215 to the end of $P213 ('push @​P213, *@​P215')
  $I218 = 0
  $I216 = $P215
L_append_loop_top99​:
  if $I218 >= $I216 goto L_append_loop_end100
  $P217 = $P215[$I218]
  push $P213, $P217
  inc $I218
  goto L_append_loop_top99
L_append_loop_end100​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P219 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P219 = 1
  $P219[0] = _SV_cell1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P221 = new PerlUndef
# append $P219 to the end of $P213 ('push @​P213, *@​P219')
  $I222 = 0
  $I220 = $P219
L_append_loop_top101​:
  if $I222 >= $I220 goto L_append_loop_end102
  $P221 = $P219[$I222]
  push $P213, $P221
  inc $I222
  goto L_append_loop_top101
L_append_loop_end102​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P223 = new PerlUndef
  $P223 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P224 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P224 = 1
  $P224[0] = $P223
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P226 = new PerlUndef
# append $P224 to the end of $P213 ('push @​P213, *@​P224')
  $I227 = 0
  $I225 = $P224
L_append_loop_top103​:
  if $I227 >= $I225 goto L_append_loop_end104
  $P226 = $P224[$I227]
  push $P213, $P226
  inc $I227
  goto L_append_loop_top103
L_append_loop_end104​:
  $P228 = new PerlUndef
  $P229 = $P212($P213)
  $S230 = $P229
  $P232 = new PerlUndef
  $P232 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $S231 = $P232
  if $S230 == $S231 goto L_106
  goto L_comparison98
L_106​:
  $I210 = 1
L_comparison98​:
  $P211 = $I210
  unless $P211 goto L_if97

  find_lex $P233, "&substr"
  $P234 = new PerlArray # slurpy array arg
  $P235 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P236 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P236 = 1
  $P236[0] = _SV_death1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P238 = new PerlUndef
# append $P236 to the end of $P234 ('push @​P234, *@​P236')
  $I239 = 0
  $I237 = $P236
L_append_loop_top107​:
  if $I239 >= $I237 goto L_append_loop_end108
  $P238 = $P236[$I239]
  push $P234, $P238
  inc $I239
  goto L_append_loop_top107
L_append_loop_end108​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P240 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P240 = 1
  $P240[0] = _SV_neighbours1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P242 = new PerlUndef
# append $P240 to the end of $P234 ('push @​P234, *@​P240')
  $I243 = 0
  $I241 = $P240
L_append_loop_top109​:
  if $I243 >= $I241 goto L_append_loop_end110
  $P242 = $P240[$I243]
  push $P234, $P242
  inc $I243
  goto L_append_loop_top109
L_append_loop_end110​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P244 = new PerlUndef
  $P244 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P245 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P245 = 1
  $P245[0] = $P244
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P247 = new PerlUndef
# append $P245 to the end of $P234 ('push @​P234, *@​P245')
  $I248 = 0
  $I246 = $P245
L_append_loop_top111​:
  if $I248 >= $I246 goto L_append_loop_end112
  $P247 = $P245[$I248]
  push $P234, $P247
  inc $I248
  goto L_append_loop_top111
L_append_loop_end112​:
  $P249 = new PerlUndef
  $P250 = $P233($P234)
# ASSIGN TO $n
  _SV_n3 = clone $P250

  find_lex $P251, "&substr"
  $P252 = new PerlArray # slurpy array arg
  $P253 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P254 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P254 = 1
  $P254[0] = _SV_output1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P256 = new PerlUndef
# append $P254 to the end of $P252 ('push @​P252, *@​P254')
  $I257 = 0
  $I255 = $P254
L_append_loop_top114​:
  if $I257 >= $I255 goto L_append_loop_end115
  $P256 = $P254[$I257]
  push $P252, $P256
  inc $I257
  goto L_append_loop_top114
L_append_loop_end115​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P258 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P258 = 1
  $P258[0] = _SV_cell1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P260 = new PerlUndef
# append $P258 to the end of $P252 ('push @​P252, *@​P258')
  $I261 = 0
  $I259 = $P258
L_append_loop_top116​:
  if $I261 >= $I259 goto L_append_loop_end117
  $P260 = $P258[$I261]
  push $P252, $P260
  inc $I261
  goto L_append_loop_top116
L_append_loop_end117​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P262 = new PerlUndef
  $P262 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P263 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P263 = 1
  $P263[0] = $P262
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P265 = new PerlUndef
# append $P263 to the end of $P252 ('push @​P252, *@​P263')
  $I266 = 0
  $I264 = $P263
L_append_loop_top118​:
  if $I266 >= $I264 goto L_append_loop_end119
  $P265 = $P263[$I266]
  push $P252, $P265
  inc $I266
  goto L_append_loop_top118
L_append_loop_end119​:
  # Computing value of arg 3 (bound to param PerlArray @​params)
  $P267 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P267 = 1
  $P267[0] = _SV_n3
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P269 = new PerlUndef
# append $P267 to the end of $P252 ('push @​P252, *@​P267')
  $I270 = 0
  $I268 = $P267
L_append_loop_top120​:
  if $I270 >= $I268 goto L_append_loop_end121
  $P269 = $P267[$I270]
  push $P252, $P269
  inc $I270
  goto L_append_loop_top120
L_append_loop_end121​:
  $P271 = new PerlUndef
  $P272 = $P251($P252)
# noreturn
# IF
  goto L_endif96
L_if97​:
  $P274 = new PerlUndef
  $I273 = 0
  $N275 = _SV_neighbours1
  $P277 = new PerlUndef
  $P277 = 3 # primitive_in_context from P6C​::sv_literal​::val
  $N276 = $P277
  if $N275 == $N276 goto L_125
  goto L_comparison124
L_125​:
  $I273 = 1
L_comparison124​:
  $P274 = $I273
  unless $P274 goto L_if123

  find_lex $P278, "&substr"
  $P279 = new PerlArray # slurpy array arg
  $P280 = new PerlHash # dynamically-named args
  # Computing value of arg 0 (bound to param PerlArray @​params)
  $P281 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P281 = 1
  $P281[0] = _SV_output1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P283 = new PerlUndef
# append $P281 to the end of $P279 ('push @​P279, *@​P281')
  $I284 = 0
  $I282 = $P281
L_append_loop_top126​:
  if $I284 >= $I282 goto L_append_loop_end127
  $P283 = $P281[$I284]
  push $P279, $P283
  inc $I284
  goto L_append_loop_top126
L_append_loop_end127​:
  # Computing value of arg 1 (bound to param PerlArray @​params)
  $P285 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P285 = 1
  $P285[0] = _SV_cell1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  $P287 = new PerlUndef
# append $P285 to the end of $P279 ('push @​P279, *@​P285')
  $I288 = 0
  $I286 = $P285
L_append_loop_top128​:
  if $I288 >= $I286 goto L_append_loop_end129
  $P287 = $P285[$I288]
  push $P279, $P287
  inc $I288
  goto L_append_loop_top128
L_append_loop_end129​:
  # Computing value of arg 2 (bound to param PerlArray @​params)
  $P289 = new PerlUndef
  $P289 = 1 # primitive_in_context from P6C​::sv_literal​::val
  $P290 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P290 = 1
  $P290[0] = $P289
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P292 = new PerlUndef
# append $P290 to the end of $P279 ('push @​P279, *@​P290')
  $I293 = 0
  $I291 = $P290
L_append_loop_top130​:
  if $I293 >= $I291 goto L_append_loop_end131
  $P292 = $P290[$I293]
  push $P279, $P292
  inc $I293
  goto L_append_loop_top130
L_append_loop_end131​:
  # Computing value of arg 3 (bound to param PerlArray @​params)
  $P294 = new PerlUndef
  $P294 = "*" # primitive_in_context from P6C​::sv_literal​::val
  $P295 = new PerlArray
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context START
  $P295 = 1
  $P295[0] = $P294
# scalar_in_context(array) from P6C​::IMCC​::primitive_in_context END
  $P297 = new PerlUndef
# append $P295 to the end of $P279 ('push @​P279, *@​P295')
  $I298 = 0
  $I296 = $P295
L_append_loop_top132​:
  if $I298 >= $I296 goto L_append_loop_end133
  $P297 = $P295[$I298]
  push $P279, $P297
  inc $I298
  goto L_append_loop_top132
L_append_loop_end133​:
  $P299 = new PerlUndef
  $P300 = $P278($P279)
# noreturn
# IF
  goto L_endif96
L_if123​:
L_endif96​: # END OF if
L_4​:
L_7​:
  _SV_cell1 = clone _SV_cell1
  inc _SV_cell1
L_loop3​:
  $P302 = new PerlUndef
  $I301 = 0
  $N303 = _SV_cell1
  $N304 = _SV_len1
  if $N303 < $N304 goto L_136
  goto L_comparison135
L_136​:
  $I301 = 1
L_comparison135​:
  $P302 = $I301
  if $P302 goto L_loop2
L_6​:
  $P305 = new PerlArray
# scalar_in_context(array) from P6C​::variable​::val_in_context START
  $P305 = 1
  $P305[0] = _SV_output1
# scalar_in_context(array) from P6C​::variable​::val_in_context END
  .return $P305
  goto L_1
  .pcc_begin_return
  .return $P305 # regular (non-rule) return
  .pcc_end_return
L_1​:
  .pcc_begin_return # fallback
  .pcc_end_return
.end

.sub _substr non_prototyped
  .param pmc params
  $P0 = params
# n paras
  $I0 = params
  $S0 = params[0]
  $I1 = params[1]
  if $I0 == 2 goto substr_2
  $I2 = params[2]
  if $I0 > 4 goto substr_die
  if $I0 < 2 goto substr_die
  length $I3, $S0
  $I4 = $I3
  if $I2 >= 0 goto substr_34
# len negative, leave -len of string
  $I3 = $I3 - $I1
  $I3 = $I3 + $I2
  $I2 = $I3
substr_34​:
  $S1 = ""
# # offset >= len?
  if $I1 >= $I4 goto substr_ret
  if $I0 == 4 goto substr_4
substr_3​:
  substr $S1, $S0, $I1, $I2
substr_ret​:
  $P1 = new PerlString
  $P1 = $S1
  .pcc_begin_return
  .return $P1
  .pcc_end_return
substr_4​:
  $S2 = params[3]
  substr $S1, $S0, $I1, $I2, $S2
  params[2] = $S1
  goto substr_ret
substr_2​:
  length $I2, $S0
  sub $I2, $I2, $I1
  goto substr_3
substr_die​:
  set $S0, "wrong number of args for substr"
  $P0 = new PerlArray
  $P0[0] = $S0
  _die($P0)
  goto substr_ret
  end
.end

.sub _length non_prototyped
  .param pmc s
  $S0 = s
  length $I0, $S0
  $P1 = new PerlInt
  set $P1, $I0
  .pcc_begin_return
  .return $P1
  .pcc_end_return
  end
.end

.sub _reverse non_prototyped
  .param pmc orig_array
  $I0 = orig_array
  dec $I0
  $I1 = 0
  $P1 = new PerlArray
reverse_loopstart​:
  $P2 = orig_array[$I0]
  $P1[$I1] = $P2
  inc $I1
  dec $I0
  if 0 <= $I0 goto reverse_loopstart
  .pcc_begin_return
  .return $P1
  .pcc_end_return
  end
.end

.sub _join non_prototyped
  .param pmc params
  .local int num_params
  num_params = params
  if num_params > 1 goto join_next
# Empty args​:
  $S0 = ""
  goto join_ret
# At least one arg​:
join_next​:
  .local string separator
  separator = params[0] # separator
  $S0 = params[1] # accumulated string
  .local int counter
  counter = 2 # arg number
  goto join_test
join_loopstart​:
  $S2 = params[counter]
  concat $S0, separator
  concat $S0, $S2
  inc counter
join_test​:
  if num_params != counter goto join_loopstart
join_ret​:
  $P2 = new PerlString
  $P2 = $S0
  .pcc_begin_return
  .return $P2
  .pcc_end_return
  end
.end

.sub _index non_prototyped
  .param pmc params
  $I2 = params
  if $I2 < 2 goto index_numarg_error
  $S0 = params[0]
  $S1 = params[1]
  $I0 = 0
  $P1 = new PerlInt
  $P1 = $I0
  if $I3 < 3 goto index_2_arg
  index $I0, $S0, $S1
  $P1 = $I0
  goto index_end
index_2_arg​:
  $I1 = params[2]
  index $I0, $S0, $S1, $I1
  $P1 = $I0
index_end​:
  .pcc_begin_return
  .return $P1
  .pcc_end_return
  end
index_numarg_error​:
  $S0 = "wrong number of args for index"
  $P0 = new PerlArray
  $P0[0] = $S0
  _die($P0)
  goto index_end
.end

.sub _time non_prototyped
  $P1 = new PerlNum
  time $N1
  set $P1, $N1
  .pcc_begin_return
  .return $P1
  .pcc_end_return
.end

.sub _sleep non_prototyped
  .param pmc wait
  $I0 = wait
  sleep $I0
.end

.sub _print1 non_prototyped
  .param object p
  print p
  print "\n"
.end

.sub _print non_prototyped
  .param pmc params
  .local int num_elem
  .local int counter
  num_elem = params
  counter = 0
print_loopstart​:
  if counter == num_elem goto print_loopend
  $P0 = params[counter]
  print $P0
  inc counter
  goto print_loopstart
print_loopend​:
.end

.sub _exit non_prototyped
  .param object message
  print message
  print "\n"
  end
.end

.sub _die non_prototyped
  .param object params

  # setup $!​: ####################
  .local object dollar_bang
  dollar_bang = new PerlString
  .local int num_params
  num_params = params
  if num_params == 0 goto die_unknown
  $P1 = new PerlString
  .local int counter
  counter = 0
die_loopstart​:
  if num_params == counter goto die_loopend
  $P1 = params[counter]
  dollar_bang = dollar_bang . $P1
  inc counter
  goto die_loopstart
die_unknown​:
  dollar_bang = "Unknown error."
die_loopend​:
  store_global "_SV__BANG_", dollar_bang

  # Look for a CATCH handler​: ###
  .local object try_stack
  find_global try_stack, "_AV_catchers"
  $I0 = try_stack
  if $I0 == 0 goto die_nohandler

  # Remove top catch handler
  dec $I0
  $P0 = try_stack[$I0]
  try_stack = $I0
  store_global "_AV_catchers", try_stack
  invoke $P0

die_nohandler​:
  print dollar_bang
  print "\nDied (no handler).\n"
  end
.end

.sub _warn non_prototyped
  .param object params
  $P1 = _print(params)
  .pcc_begin_return
  .return $P1
  .pcc_end_return
.end

.sub _grep non_prototyped
  .param Sub condition
  .param pmc params
  .local int tmp
  .local PerlArray result_list
  .local int ii
  .local pmc comparison_result
  .local pmc element
  result_list = new PerlArray
  set tmp, params
  lt tmp, 2, __grep_die_numargs
  shift condition, params
  typeof S0, condition
  ne S0, "Sub", __grep_die_arg1
  ii = 0
__grep_loop_top​:
  tmp = params
  ge ii, tmp, __grep_loop_end
  element = params[ii]
  comparison_result = condition(element)
  unless comparison_result, __grep_next
  push result_list, element
__grep_next​:
  inc ii
  branch __grep_loop_top
__grep_loop_end​:
  .pcc_begin_return
  .return result_list
  .pcc_end_return
__grep_die_numargs​:
  set S0, "wrong number of args for grep"
  condition = new PerlArray
  set condition[0], S0
  _die(condition)
  branch __grep_loop_end
__grep_die_arg1​:
  set S0, "First argument to grep must be a closure"
  condition = new PerlArray
  set condition[0], S0
  _die(condition)
  branch __grep_loop_end
.end

.sub _map non_prototyped
  .param pmc params
  $P2 = new PerlArray
  set $I3, params
  lt $I3, 2, __map_die_numargs
  set $P0, params[0]
  typeof S0, $P0
  ne S0, "Sub", __map_die_arg1
  set I0, 1
  set I1, 0
  set I2, params
__map_loop_start​:
# call closure with current array value as arg
  save $P0
  set $P3, params[I0]
  $P5 = new PerlArray
  set $P5, 1
  set $P5[0], $P3
  __map_closure($P5)
### restore $P4
  set $I3, $P4
  lt $I3, 1, __map_check_end
  dec $I3
  set $P6, $P4[$I3]
__map_return_check​:
  if $P6, __map_match_ok
  branch __map_check_end
__map_match_ok​:
  set $P2[I1], $P6
  inc I1
__map_check_end​:
  inc I0
  eq I0, I2, __map_loop_end
  branch __map_loop_start
__map_loop_end​:
  .pcc_begin_return
  .return $P2
  .pcc_end_return
__map_die_numargs​:
  set S0, "wrong number of args for map"
  $P0 = new PerlArray
  set $P0[0], S0
  _die($P0)
  branch __map_loop_end
__map_die_arg1​:
  set S0, "First argument to map must be a closure"
  $P0 = new PerlArray
  set $P0[0], S0
  _die($P0)
  branch __map_loop_end
__map_closure​:
  pushp
  save $P1
  invoke
  .pcc_begin_return
  .pcc_end_return
.end

.sub __setup
# P5 is array of commandline args
# -lt​: should we really preserve any registers here?
  $P1 = new PerlArray
  $P2 = new PerlString
  set I0, P5
# $0 / $$PROGRAM_NAME
  set $P2, P5[0]
  store_global "_SV_0", $P2
  store_global "_SV_$PROGRAM_NAME", $P2

# @​ARGS == @​ARGV[1..@​ARGV.length]
  set I1, 0
  set I2, 1
  dec I0
  set $P1, I0
  branch __setup_arg_end
__setup_arg​:
  set S0, P5[I2]
  set $P1[I1], S0
  inc I1
  inc I2
__setup_arg_end​:
  lt I1, I0, __setup_arg
  store_global "_AV_ARGS", $P1

# %ENV
  $P1 = new PerlEnv
  store_global "_HV_ENV", $P1

# exception handling​:
  $P0 = new PerlArray
  store_global "_AV_catchers", $P0
  $P0 = new PerlUndef
  store_global "_SV__BANG_", $P0
  ret # Only called from top level
.end

.sub _install_catch non_prototyped
  .param pmc continuation
  .local pmc try_stack
  find_global try_stack, "_AV_catchers"
  $I1 = try_stack
  try_stack[$I1] = continuation
  store_global "_AV_catchers", try_stack
.end

.sub _pop_catch non_prototyped
  .local pmc try_stack
  find_global try_stack, "_AV_catchers"
  $I1 = try_stack
  dec $I1
  try_stack = $I1
  store_global "_AV_catchers", try_stack
.end

@p6rt
Copy link
Author

p6rt commented May 25, 2004

From @allison

Alex Gutteridge wrote​:

The example Perl6 'Game of Life' program
(parrot/languages/perl6/examples/life.p6) is broken. As it stands it
doesn't parse correctly but this is easily fixed by adding the correct
string concatenation operator '~'​:

I've checked in your update to the concat operator.

However, now parrot crashes with a segfault somewhere in the Generate
subroutine​:
[...]
I've had a look at the generated (and attached) imc file, and can't see
anything obviously crazy. I'm not sure how to go about debugging this
further.

(My apologies for being so verbose, I'm hoping to be educational as well
as solve the problem. Leo, skip to the last 10 lines and scan
backwards.)

One good rule is to create the simplest code that duplicates the
problem. For one bug this was​:


sub Generate($input) {
  my $output = $input;
  return $output;
}

sub main() {
  my $world = "string";
  $world = Generate($world)[0];
  print "returned '$world' from Generate\n";
}


This made a much shorter generated .imc file (much easier to scan), and
I found an orphaned ".return" directive without the surrounding
".pcc_begin_return" and ".pcc_end_return" directives. This bug was
actually in the original generated output, just difficult to find​:

$P305\[0\] = \_SV\_output1

# scalar_in_context(array) from P6C​::variable​::val_in_context END
.return $P305
goto L_1

I fixed this in the "prefix_return" method in P6C​::IMCC​::prefix. This
fix was enough to get the code running on OSX.

Linux is a bit trickier. It was still segfaulting after the fix. With a
series of debug prints I managed to track the segfault down to a loop in
the Generate routine. The annoying thing was the segfault kept moving.
It would segfault in exactly the same place every time I ran the same
code (always on a line with a call to 'substr'), but as I added more
debug prints it would segfault earlier and earlier (still always on a
line with a call to 'substr'). This is when I started thinking "Oooh,
memory problems."

(The code loops 100 times. Each outer loop calls a subroutine that loops
256 times, and each inner loop calls 'substr' 10/11 times on a string
that's 256 characters long. That's a rather large number of string
allocations.)

This is the smallest bit of code I could get to segfault in my linux
dev box​:


sub main () {
  my $string =
"****************************************************************************************************************************************************************************************************************************************************************";
  for 1..11 {
  print1 "in loop $_\n";
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  substr ($string, $_, 1);
  }
  print "made it past substr\n";
}


15 calls to 'substr' in each loop segfaults (14 doesn't), and it always
segfaults on the 11th loop.

To confirm my suspicion, I ran gdb on the generated PIR code from the
original source​:

  $ gdb parrot

# and from the gdb prompt
  (gdb) run life.imc

# and when it segfaulted
  (gdb) back


#​0 0x401571b7 in memcpy () from /lib/libc.so.6
#​1 0x08158c41 in compact_pool (interpreter=0x82ebf90, pool=0x82ec770)
  at src/resources.c​:341
#​2 0x08158923 in mem_allocate (interpreter=0x82ebf90, req_size=0xbffff3e8,
  pool=0x82ec770, align_1=15) at src/resources.c​:154
#​3 0x081591f2 in Parrot_allocate (interpreter=0x82ebf90, buffer=0x4148e0d8,
  size=64) at src/resources.c​:603
#​4 0x0815922e in Parrot_allocate_zeroed (interpreter=0x82ebf90,
  buffer=0x4148e0d8, size=64) at src/resources.c​:625
#​5 0x080d7638 in allocate_chunk (interpreter=0x82ebf90, list=0x8416800,
  items=16, size=64) at src/list.c​:240
#​6 0x080d8013 in alloc_next_size (interpreter=0x82ebf90, list=0x8416800,
  where=1, idx=1) at src/list.c​:667
...


So, this is where I hand it off to Leo. It may be a known bug in Parrot,
or maybe not.

Allison

@p6rt
Copy link
Author

p6rt commented May 25, 2004

The RT System itself - Status changed from 'new' to 'open'

@p6rt
Copy link
Author

p6rt commented May 25, 2004

From @leo

Allison Randal <al@​shadowed.net> wrote​:

#​0 0x401571b7 in memcpy () from /lib/libc.so.6
#​1 0x08158c41 in compact_pool (interpreter=0x82ebf90, pool=0x82ec770)
at src/resources.c​:341

Fixed.

The code in smallobject.c that allocates new buffer memory did assume
that it gets zeroed memory, which of course depends on the OS and the
arena size. Now C<buflen>, which is used during GC, is cleared
explicitely.

Allison

leo

@p6rt
Copy link
Author

p6rt commented May 25, 2004

From nickg@glencros.demon.co.uk

Looks very much like my bug 29246, and a very similar example.

Nick

Allison Randal wrote​:

This is the smallest bit of code I could get to segfault in my linux

dev box​:

----
sub main () {
my $string =
"****************************************************************************************************************************************************************************************************************************************************************";
for 1..11 {
print1 "in loop $_\n";
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
substr ($string, $_, 1);
}
print "made it past substr\n";
}
----

15 calls to 'substr' in each loop segfaults (14 doesn't), and it always
segfaults on the 11th loop.

To confirm my suspicion, I ran gdb on the generated PIR code from the
original source​:

$ gdb parrot

# and from the gdb prompt
(gdb) run life.imc

# and when it segfaulted
(gdb) back

----
#​0 0x401571b7 in memcpy () from /lib/libc.so.6
#​1 0x08158c41 in compact_pool (interpreter=0x82ebf90, pool=0x82ec770)
at src/resources.c​:341
#​2 0x08158923 in mem_allocate (interpreter=0x82ebf90, req_size=0xbffff3e8,
pool=0x82ec770, align_1=15) at src/resources.c​:154
#​3 0x081591f2 in Parrot_allocate (interpreter=0x82ebf90, buffer=0x4148e0d8,
size=64) at src/resources.c​:603
#​4 0x0815922e in Parrot_allocate_zeroed (interpreter=0x82ebf90,
buffer=0x4148e0d8, size=64) at src/resources.c​:625
#​5 0x080d7638 in allocate_chunk (interpreter=0x82ebf90, list=0x8416800,
items=16, size=64) at src/list.c​:240
#​6 0x080d8013 in alloc_next_size (interpreter=0x82ebf90, list=0x8416800,
where=1, idx=1) at src/list.c​:667
...
----

So, this is where I hand it off to Leo. It may be a known bug in Parrot,
or maybe not.

Allison

@p6rt
Copy link
Author

p6rt commented May 25, 2004

From @allison

Leo wrote​:

Fixed.

The code in smallobject.c that allocates new buffer memory did assume
that it gets zeroed memory, which of course depends on the OS and the
arena size. Now C<buflen>, which is used during GC, is cleared
explicitely.

Yup, that fixed it. Thanks!

Allison

@p6rt
Copy link
Author

p6rt commented Jul 30, 2004

stephane@modxml.org - Status changed from 'open' to 'resolved'

@p6rt p6rt closed this as completed Jul 30, 2004
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant