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