Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
326 lines (276 sloc) 7.77 KB
# Copyright (C) 2002-2009, Parrot Foundation.
#
# ** globals used for debug purposes:
#
# step: boolean telling whether to stop at each step
#
# breakpoints: hash listing the existing breakpoints. the keys are
# either the char to break upon when reaching it, or a location "y,x",
# or a column "c:nn", or a row "r:nn"
# eg: { "<" => 1, "10,10" => 1, "r:6" => 1, "c:3" => 1, ... }
#
#
# debug_initialize()
#
# declare & initialize global debug variables
#
.sub "debug_initialize"
.local pmc step, breakpoints
step = new 'Integer'
step = 1
breakpoints = new 'Hash'
set_global "step", step
set_global "breakpoints", breakpoints
#repeat S10, "0", 128 # No char to break on.
.return()
.end
.sub "_debug__print_status_coordinates"
$P0 = get_global "status"
$I0 = $P0["x"]
$I1 = $P0["y"]
print "("
print $I0
print ","
print $I1
print ")"
.end
.sub "_debug__print_status_current_char"
$P0 = get_global "status"
$S0 = $P0["char"]
$I0 = $P0["val"]
print "'"
print $S0
print "' (ord="
print $I0
print ")"
.end
.sub "_debug__print_direction"
$P0 = get_global "status"
$I0 = $P0["dir"]
print "dir="
print $I0
.end
.sub "_debug__print_flags"
$P0 = get_global "status"
$I0 = $P0["flag"]
$S0 = '"'
if $I0 == 1 goto DEBUG__PRINT_FLAGS__PRINT
$S0 = '#'
if $I0 == 2 goto DEBUG__PRINT_FLAGS__PRINT
$S0 = '@'
if $I0 == 3 goto DEBUG__PRINT_FLAGS__PRINT
$S0 = '-'
DEBUG__PRINT_FLAGS__PRINT:
print $S0
.end
.sub "_debug__print_stack"
.local int i, len
print "stack="
$P0 = get_global "stack"
len = $P0
i = 0
if i >= len goto DEBUG_PRINT_STACK__END
DEBUG_PRINT_STACK__LOOP:
$I0 = $P0[i]
print $I0
inc i
if i >= len goto DEBUG_PRINT_STACK__END
print ","
goto DEBUG_PRINT_STACK__LOOP
DEBUG_PRINT_STACK__END:
.end
# Print the status of the instruction pointer:
# coordinates, current char, direction, flags and stack.
.sub "_debug__print_status"
_debug__print_status_coordinates()
print " - "
_debug__print_status_current_char()
print " "
_debug__print_direction()
print " "
_debug__print_flags()
print " "
_debug__print_stack()
print "\n"
.end
.sub "_debug__help"
print "Available commands are:\n"
print " status - print state of current IP\n"
print " dump - dump playfield\n"
print " break c - set a breakpoint on character c\n"
print " break x,y - set a breakpoint at coords (x,y)\n"
print " break c:x - set a breakpoint on column x\n"
print " break r:y - set a breakpoint on row y\n"
print " delete c - delete breakpoint on character c\n"
print " delete x,y - delete breakpoint at coords (x,y)\n"
print " delete c:x - delete breakpoint on column x\n"
print " delete r:y - delete breakpoint on row y\n"
print " list - list breakpoints\n"
print " next - step one befunge instruction\n"
print " continue - resume execution\n"
print " restart - restart execution\n"
print " quit - abort execution\n"
print " help - display this message\n"
print "\n"
.end
#
# _debug__dump_playfield()
#
# dump the playfield on stdout.
#
.sub "_debug__dump_playfield"
.local string divider, line
.local pmc playfield
playfield = get_global "playfield"
divider = repeat '-', 82
divider = concat divider, "\n"
print divider
$I0 = 0
DEBUG__DUMP_PLAYFIELD__NEXT_LINE:
if $I0 >= 25 goto DEBUG__DUMP_PLAYFIELD__END
$I1 = 0
line = "|"
DEBUG__DUMP_PLAYFIELD__NEXT_CHAR:
if $I1 >= 80 goto DEBUG__DUMP_PLAYFIELD__EOL
$I2 = playfield[$I0;$I1]
$S0 = chr $I2
line = concat line, $S0
inc $I1
goto DEBUG__DUMP_PLAYFIELD__NEXT_CHAR
DEBUG__DUMP_PLAYFIELD__EOL:
line = concat line, "|\n"
print line
inc $I0
goto DEBUG__DUMP_PLAYFIELD__NEXT_LINE
DEBUG__DUMP_PLAYFIELD__END:
print divider
print "\n"
.return()
.end
# The interpreter has reached a breakpoint. Let's
# stop and interact with user.
.sub "_debug__interact"
DEBUG__INTERACT__LOOP:
_debug__print_status()
print "bef> "
$P0 = getinterp
$P0 = $P0.'stdin_handle'()
$S0 = $P0.'readline'()
$S0 = chopn $S0, 1
$I0 = length $S0
if $I0 == 0 goto DEBUG__INTERACT__NEXT
$S1 = substr $S0, 0, 4
if $S1 == "dump" goto DEBUG__INTERACT__DUMP
if $S1 == "help" goto DEBUG__INTERACT__HELP
if $S1 == "list" goto DEBUG__INTERACT__LIST
if $S1 == "next" goto DEBUG__INTERACT__NEXT
if $S1 == "quit" goto DEBUG__INTERACT__QUIT
$S1 = substr $S0, 0, 5
if $S1 == "break" goto DEBUG__INTERACT__BREAK
$S1 = substr $S0, 0, 6
if $S1 == "delete" goto DEBUG__INTERACT__DELETE
if $S1 == "status" goto DEBUG__INTERACT__STATUS
$S1 = substr $S0, 0, 7
if $S1 == "restart" goto DEBUG__INTERACT__RESTART
$S1 = substr $S0, 0, 8
if $S1 == "continue" goto DEBUG__INTERACT__CONTINUE
print "Unknown instruction. Type help for help.\n"
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__BREAK:
$S0 = replace $S0, 0, 6, ""
$P0 = get_global "breakpoints"
$P0[$S0] = 1
set_global "breakpoints", $P0
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__CONTINUE:
$P0 = get_global "step"
$P0 = 0
set_global "step", $P0
goto DEBUG__INTERACT__END
DEBUG__INTERACT__DELETE:
$S0 = replace $S0, 0, 7, ""
$P0 = get_global "breakpoints"
delete $P0[$S0]
set_global "breakpoints", $P0
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__DUMP:
_debug__dump_playfield()
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__HELP:
_debug__help()
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__LIST:
print "Not yet implemented...\n"
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__NEXT:
.local pmc step
step = get_global "step"
step = 1
set_global "step", step
goto DEBUG__INTERACT__END
DEBUG__INTERACT__QUIT:
end
DEBUG__INTERACT__RESTART:
print "Not yet implemented...\n"
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__STATUS:
_debug__print_status()
goto DEBUG__INTERACT__LOOP
DEBUG__INTERACT__END:
.return()
.end
# Check whether we should stop the interpreter at the current
# moment, allowing user to play with the debugger.
.sub "debug__check_breakpoint"
.local pmc step
step = get_global "step"
if step == 0 goto DEBUG__CHECK_BREAKPOINT__CHAR
_debug__interact()
goto DEBUG__CHECK_BREAKPOINT__END
DEBUG__CHECK_BREAKPOINT__CHAR:
.local pmc breakpoints, status
breakpoints = get_global "breakpoints"
status = get_global "status"
$S0 = status["char"]
$I0 = exists breakpoints[$S0]
if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__COORD
_debug__interact()
goto DEBUG__CHECK_BREAKPOINT__END
DEBUG__CHECK_BREAKPOINT__COORD:
.local int x, y
x = status["x"]
y = status["y"]
$S0 = x
$S1 = y
$S0 = concat $S0, ","
$S0 = concat $S0, $S1
$I0 = exists breakpoints[$S0]
if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__ROW
_debug__interact()
goto DEBUG__CHECK_BREAKPOINT__END
DEBUG__CHECK_BREAKPOINT__ROW:
$S0 = "r:"
$S1 = y
$S0 = concat $S0, $S1
$I0 = exists breakpoints[$S0]
if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__COL
_debug__interact()
goto DEBUG__CHECK_BREAKPOINT__END
DEBUG__CHECK_BREAKPOINT__COL:
$S0 = "c:"
$S1 = x
$S0 = concat $S0, $S1
$I0 = exists breakpoints[$S0]
if $I0 == 0 goto DEBUG__CHECK_BREAKPOINT__END
_debug__interact()
# fallback
#goto DEBUG__CHECK_BREAKPOINT__END
DEBUG__CHECK_BREAKPOINT__END:
.return()
.end
########################################################################
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: