# 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: