# New Ticket Created by "Clinton A. Pierce"
# Please include the string: [perl #22767]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=22767 >
I apologize for the length of this example. I've spent a goodly part of
this afternoon trying to track this one down and can't get a handle on a
smaller example.
Running this on any recent build of Parrot (Win32 or Linux) leaks like a
seive and will eventually give a segmentation fault. On my Linux machine
it takes 26K repetitions. On my Win32 machine, much fewer. Removing any
of the following will cause the segfault to go away:
either of the "call _BUILTIN_DISPLAY" statements.
the "call _set_nonblock" statement
*ALL* of the references to the global PRINTCOL.
The i=i+1 logic.
** Using IMCC to produce PASM, and then assembling the PASM works fine! **
[The odd look of this example is because it's a compiled BASIC
program. Bits of the runtime are included in here, seriously hacked up for
brevity. Whenever I remove these last few pieces, the segfault goes away.]
Help! And thanks.
.const int TYPE = 0
.const int VALUE = 1
.local string JUMPLABEL
.sub _main
$P0=new PerlHash
$P0["value"]=0
store_global "PRINTCOL", $P0
call _basicmain_run
end
.end
.sub _basicmain
.local float i
.local string t_string
.sub _basicmain_run # Always jump here.
call _basicmain_main
ret
.end
.sub _basicmain_main
saveall
USERLABEL_0: # For user branch (100)
#
# Evaluating t$ = inkey$ ( )
# Result in t_string of type S
.arg 0 # argc
call _POSIX_INKEY
.result $S0
t_string = $S0
#
# Evaluating i = i + 1
# Result in i of type N
$N0 = 1.0 + i
i = $N0
#
# Evaluating i
# Result in i of type N
.arg i
.arg 1
call _BUILTIN_DISPLAY
.arg "\n"
.arg 1
call _BUILTIN_DISPLAY
branch USERLABEL_0 # Goto 100
#
# ###################
# Program Termination
# ###################
restoreall
ret # back to _main
.end # main segment
.end # outer segment
.const int FLOAT = 2
.const int STRING = 3
.sub _BUILTIN_DISPLAY # void display(string|float thingy[,
string|floa
t thingy2])
saveall
.param int argc
.local string buf
.local int intver
.local string s
.local int PRINTCOL
find_global $P0, "PRINTCOL"
set PRINTCOL, $P0["value"]
set buf, ""
NEXT: eq argc, 0, END_DISPLAY
dec argc
entrytype $I0, 0
eq $I0, STRING, DISPSTRING
ne $I0, FLOAT, DISPERR
# Now, do floats
.param float number
set intver, number
set $N0, intver
eq $N0, number, DISPINT # Nope, it's an integer.
# Integers display -1234_
# or _1234
DISPINT:set $S0, intver
lt intver, 0, NEGINT
concat buf, " "
NEGINT: concat buf, $S0
concat buf, " "
branch NEXT
DISPSTRING:
.param string str
length $I0, str
concat buf, str
eq str, "\n", DISPNL
add PRINTCOL, PRINTCOL, $I0
branch NEXT
DISPNL: set PRINTCOL, 0
branch NEXT
END_DISPLAY:
print buf
set $P0["value"], PRINTCOL
store_global "PRINTCOL", $P0
restoreall
ret
DISPERR:print "Unknown type on stack to print\n"
end
.end
.sub _set_nonblock # void _set_nonblock
$P0=new PerlHash
#set $P0["value"], I11
store_global "fcntl_mode", $P0
ret
.end
.sub _POSIX_INKEY
saveall
call _set_nonblock
.return "" # Normally this returns the retrieved keystroke...
restoreall
ret
.end
