home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / debug.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  9KB  |  415 lines
  1.  
  2. /* debug.c -- UMB Scheme, debugging routines.
  3.  
  4. UMB Scheme Interpreter                  $Revision: 2.12 $
  5. Copyright (C) 1988, 1991 William R Campbell
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 1, or (at your option)
  10. any later version.
  11.  
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. UMB Scheme was written by Bill Campbell with help from Karl Berry,
  22. Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
  23. Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni and Thang Quoc Tran.
  24.  
  25. For additional information about UMB Scheme, contact the author:
  26.  
  27.     Bill Campbell
  28.     Department of Mathematics and Computer Science
  29.     University of Massachusetts at Boston
  30.     Harbor Campus
  31.     Boston, MA 02125
  32.  
  33.     Telephone: 617-287-6449        Internet: bill@cs.umb.edu
  34.  
  35. */
  36.  
  37. #include  <setjmp.h>
  38. #include  <signal.h>
  39.  
  40. #include "portable.h"
  41. #include "eval.h"
  42. #include "object.h"
  43. #include "primitive.h"
  44. #include "steering.h"
  45. #include "debug.h"
  46. #include "architecture.h"
  47. #include "io.h"
  48. #include "number.h"
  49.  
  50. /* Public Variables */
  51.  
  52. Public    Boolean    Control_C = FALSE;
  53. Public    Boolean Debugger_Activated = FALSE;
  54. Public    Boolean    Debugger_Switched_On = FALSE;
  55. Public    Boolean    Debugging = FALSE;
  56. Public    Boolean    Go_Processed = FALSE;
  57. Public    Boolean Evaluating = FALSE;
  58. Public    Boolean    Evaluation_Broken = FALSE;
  59. Public    Boolean    At_Top_Level = TRUE;
  60. Public    Boolean    Tracing = FALSE;
  61. Public    Boolean    Tracing_All = FALSE;
  62. Public    Integer    Stepping = 0;
  63. Public    Integer    Stepper = 0;
  64.  
  65. Public    Integer Trace_Margin = 0;
  66. Public    Object    Traced_Procedures;
  67.  
  68. #define DEBUGGING_PROMPT "\ndebug> "
  69.  
  70. Public    void Steer_Debugging()
  71. {
  72.     String    saved_prompt = Prompt;
  73.     Import    jmp_buf    Debugging_Loop;
  74.  
  75.     Debugger_Activated = FALSE;
  76.  
  77.     Value_Debugged = Value_Register;
  78.     Save();
  79.     State_Debugged = State_Register;
  80.  
  81.     setjmp( Debugging_Loop );
  82.     Debugging = TRUE;
  83.  
  84.     clearerr( The_Standard_Input );
  85.  
  86.     State_Register = Nil;
  87.     Expression_Register = Nil;
  88.     Function_Register = Nil;
  89.     Arguments_Register = Nil;
  90.     Environment_Register = Get_State_Frame_Environment( State_Debugged );
  91.     Reset_Stack( Get_State_Frame_Top( State_Debugged ) );
  92.  
  93.     Prompt = DEBUGGING_PROMPT;
  94.     Read_Eval_Print( The_Standard_Input );
  95.     Prompt = saved_prompt;
  96.     clearerr( The_Standard_Input );
  97.  
  98.     State_Register = State_Debugged;
  99.     Restore();
  100.     Value_Register = Value_Debugged;
  101.  
  102.     Debugging = FALSE;
  103.     Debugger_Activated = TRUE;
  104. }
  105.  
  106. /* Debugging Primitives */
  107.  
  108. Private    void    Debug()        /* (debug) */
  109. {
  110.     Debugger_Switched_On = TRUE;
  111.     Value_Register = Nil;
  112. }
  113.  
  114. Private    void    Debug_Off()    /* (debug-off) */
  115. {
  116.     Debugger_Switched_On = FALSE ;
  117.     Reset();
  118.     Value_Register = Nil;
  119. }
  120.  
  121.  
  122. Private    void    Step()        /* (step n) */
  123. {
  124.     Stepping = Stepper =  Number_To_Integer( Top(1) );
  125.     Value_Register = Top(1);
  126.  
  127.     if ( Evaluating )
  128.     {
  129.         /* State was saved in Eval() -- get right out */
  130.         Restore();
  131.     }
  132. }
  133.  
  134.  
  135. Private    void    Trace()        /* (trace)
  136.                    (trace proc...) */
  137. {
  138.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  139.  
  140.         if ( arg_count == 0 )
  141.     {
  142.         Tracing_All = TRUE;
  143.     }
  144.     else while ( arg_count )
  145.     {
  146.         if ( Is_Procedure( Top( arg_count ) ) )
  147.         {
  148.             Get_Procedure_Tracing( Top( arg_count ) ) = TRUE;
  149.         }
  150.         else if ( Is_Primitive( Top( arg_count ) ) )
  151.         {
  152.             Get_Primitive_Tracing( Top( arg_count ) ) = TRUE;
  153.         }
  154.         else
  155.         {
  156.             Display_Error( "Attempt to trace a non-procedure object: ",
  157.                     Top( arg_count ) );
  158.         }
  159.         Push( Top( arg_count ) );
  160.         Push( Traced_Procedures );
  161.         Make_Pair();
  162.         Traced_Procedures = Value_Register;
  163.         arg_count -- ;
  164.     }
  165.  
  166.     Tracing = TRUE;
  167.     Value_Register = Nil;
  168.  
  169.     if ( Evaluating )
  170.  
  171.     {
  172.         /* State was saved in Eval() -- get right out */
  173.         Restore();
  174.     }
  175. }
  176.  
  177. Private    void    Untrace()     /* (untrace)
  178.                    (untrace proc...) */
  179. {
  180.     Integer arg_count = Get_Apply_Numargs( Expression_Register );
  181.     
  182.     if ( arg_count == 0 )
  183.     {
  184.         Tracing = Tracing_All = FALSE;
  185.         
  186.         while ( Traced_Procedures != Nil )
  187.         {
  188.             Object proc = First( Traced_Procedures );
  189.  
  190.             if ( Is_Procedure( proc ))
  191.             {
  192.                 Get_Procedure_Tracing( proc ) = FALSE;
  193.             }
  194.             else if ( Is_Primitive( proc ))
  195.             {
  196.                 Get_Primitive_Tracing( proc ) = FALSE;
  197.             }
  198.             else
  199.             {
  200.                 Display_Error( 
  201.                    "Attempt to trace a non-procedure object: ",
  202.                    proc );
  203.             }
  204.             Traced_Procedures = Rest( Traced_Procedures );
  205.         }
  206.     }
  207.     else while ( arg_count )
  208.     {
  209.         if ( Is_Procedure( Top( arg_count ) ) )
  210.         {
  211.             Get_Procedure_Tracing( Top( arg_count ) ) = FALSE;
  212.         }
  213.         else if ( Is_Primitive( Top( arg_count ) ) )
  214.         {
  215.             Get_Primitive_Tracing( Top( arg_count ) ) = FALSE;
  216.         }
  217.         else
  218.         {
  219.             Display_Error( "Attempt to trace a non-procedure object: ",
  220.                     Top( arg_count ) );
  221.         }
  222.         arg_count--;
  223.     }
  224.  
  225.     Value_Register = Nil;
  226.  
  227.     if ( Evaluating )
  228.  
  229.     {
  230.         /* State was saved in Eval() -- get right out */
  231.         Restore();
  232.     }
  233. }
  234.  
  235.  
  236.  
  237. Private void    GoN()        /*  (#_go k obj)  */
  238. {
  239.     Integer    k = Number_To_Integer( Top(2) ); /* State Frames to descend */
  240.     Object    state = State_Debugged;
  241.     Object    last = Nil;
  242.  
  243.     while ( k-- && state != Nil )
  244.     {
  245.         if ( Get_State_Frame_Expression( state ) != last )
  246.         {
  247.             last = Get_State_Frame_Expression( state );
  248.         }
  249.         state = Get_State_Frame_State( state );
  250.     }
  251.     if ( Debugging )
  252.     {
  253.         if ( state != Nil )
  254.         {
  255.             State_Debugged = state;
  256.             Value_Debugged = Top( 1 );
  257.             Go_Processed = TRUE;
  258.         }
  259.         else
  260.         {
  261.             Error( "k too large in (go# k obj)" );
  262.         }
  263.     }
  264.     else
  265.     {
  266.         Error( "(go k obj) executed outside of debugging mode" );
  267.     }
  268.     Value_Register = Nil;
  269. }
  270.  
  271.  
  272. Private    void    Show_Proc_Env()    /* (show-proc-env proc) */
  273. {
  274.     Object    frame = Get_Procedure_Environment( Top(1) );
  275.     Integer    dummy;
  276.  
  277.     Output( "\n" );
  278.     dummy = Environment_Frame_Show( frame , 0 );
  279.  
  280.     Value_Register = Nil;
  281. }
  282.  
  283.  
  284.  
  285. Private void    Show_Global_Binding( Symaddr )
  286.  
  287.     Object    *Symaddr;
  288. {
  289.     Object    Sym = * Symaddr;
  290.     if ( Get_Symbol_User_Defined( Sym ) )
  291.     {
  292.         Integer m = 0;
  293.         Output( "\n" );
  294.         m = Show_Object( Sym , 0 ); 
  295.         Output( "\t= " ); m = 12;
  296.         m = Show_Object( Get_Global_Binding( Sym ) , m );
  297.     }
  298. }
  299.  
  300.  
  301. Private    void    Show_Global_Env()
  302. {
  303.     Output( "\nUser-defined Global Symbols:\n" );
  304.     Symbol_Hash_Iterate( Show_Global_Binding ); 
  305.     Value_Register = Nil;
  306.     
  307. }
  308.  
  309.  
  310. Private    void    Show_Env()    /* (show-env k) -- we ignore k */
  311. {
  312.     Object    frame = Get_State_Frame_Environment( State_Debugged );
  313.     Integer    dummy;
  314.  
  315.     Output( "\n" );
  316.     dummy = Environment_Frame_Show( frame , 0 );
  317.  
  318.     Value_Register = Nil;
  319. }
  320.  
  321. Private    void    Where()        /* (where k) */
  322. {
  323.     Integer    k;     /* expressions to show */
  324.     Integer    counter = 0;
  325.     Object    state = State_Debugged;
  326.     Object    last = Nil;
  327.     Character countstr[20];
  328.     k = Number_To_Integer( Top( 1 ) );
  329.  
  330.     while ( k-- && state != Nil )
  331.     {
  332.         if ( Get_State_Frame_Expression( state ) != last )
  333.         {
  334.             last = Get_State_Frame_Expression( state );
  335.  
  336.             sprintf( countstr , "\n\n%2d>  " , counter++ );
  337.             Output( countstr );
  338.             (void) Write_Object( last , 5 );
  339.         }
  340.         state = Get_State_Frame_State( state );
  341.     }
  342.     Value_Register = Nil;
  343. }
  344.  
  345.  
  346. Private    void    How()    /*  (#_how symbol)  */
  347. {
  348.     Object    env = Debugging ? Get_State_Frame_Environment( State_Debugged )
  349.                 : The_Global_Environment;
  350.     Object    sym = Top( 1 );
  351.     Integer    displacement;
  352.     
  353.     while ( env != The_Global_Environment )
  354.     {
  355.         for ( displacement = 0; 
  356.               displacement < Get_Environment_Frame_Size( env );
  357.               displacement++ )
  358.         {
  359.             if (Get_Environment_Frame_Binding_Symbol( env,
  360.                             displacement ) == sym )
  361.             {
  362.                 Show_Object(
  363.                  Get_Environment_Frame_Binding_How(env,displacement),                     0 );
  364.                 Value_Register = Nil;
  365.                 return;
  366.             }
  367.         }
  368.         env = Get_Environment_Frame_Previous( env );
  369.     }
  370.     Show_Object( Get_Symbol_How( sym ) , 0 );
  371.     Value_Register = Nil;
  372. }
  373.  
  374.  
  375.  
  376.  
  377. Public void Initialize_Debug()
  378. {
  379.     Traced_Procedures = Nil;
  380.  
  381.     Make_Primitive("debug", Debug , 0, The_Undefined_Type, 
  382.         The_Undefined_Type, The_Undefined_Type);
  383.  
  384.     Make_Primitive("debug-off", Debug_Off , 0, The_Undefined_Type, 
  385.         The_