home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / steering.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  7KB  |  360 lines
  1. /* steering.c -- UMB Scheme, steering routines
  2.  
  3. UMB Scheme Interpreter                  $Revision: 2.12 $
  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. Public    jmp_buf    Top_Level_Loop;
  51. Public    jmp_buf    Debugging_Loop;
  52. Public    String    Prompt;
  53.  
  54. /* Internal routines. */
  55.  
  56. Private void Initializations();
  57. Private void Steering();
  58. Private    void Load_File();
  59. Private Boolean File_Exists();
  60.  
  61.  
  62. #define TOP_LEVEL_PROMPT "\n==> "
  63.  
  64. #ifndef STANDARD_PRELUDE_PATHNAME
  65. #define STANDARD_PRELUDE_PATHNAME "/usr/local/lib/prelude.scheme"
  66. #endif
  67.  
  68. Private String OPENING  =
  69. "Welcome to UMB Scheme, version      Copyright (c) 1988,1991 William R Campbell.\n\
  70. UMB Scheme comes with ABSOLUTELY NO WARRANTY. This is free software and\n\
  71. you are free to redistribute it under certain conditions.\n\
  72. See the UMB Scheme Release Notes for details. Type Control-d to exit.\n\n";
  73.  
  74. Private String Rev = "$Revision: 2.12 $";
  75.  
  76. Private    int    Argc;
  77. Private    char    **Argv;
  78.  
  79. Public void main( argc , argv )
  80.     int    argc;
  81.     char    *argv[];
  82. {
  83.     Argc = argc;
  84.     Argv = argv;
  85.     Steering();
  86. }
  87.  
  88. Private    Boolean Init_File_Complete = FALSE;
  89. Public    Boolean Prelude_Started = FALSE;
  90. Public    Boolean    Prelude_Complete = FALSE;
  91.  
  92. Private void Steering()
  93. {
  94.     Character Opening[400];
  95.     String    Init_Filename = getenv ("SCHEME_INIT");
  96.     Character Dot_Scheme_Filename [256];
  97.     sprintf (Opening, "%s", OPENING);
  98.     sprintf (Dot_Scheme_Filename, "%s/.scheme", getenv ("HOME"));
  99.  
  100.     Initializations();
  101.  
  102.  
  103.     Opening[31] = Rev[11];
  104.     Opening[32] = Rev[12];
  105.     Opening[33] = Rev[13];
  106.     Opening[34] = Rev[14];
  107.  
  108.  
  109.     Output( Opening );
  110.  
  111.     signal( SIGINT  , Handler );
  112.     signal( SIGFPE  , Handler );
  113.     signal( SIGILL  , Handler );
  114.     signal( SIGSEGV , Handler );
  115.     signal( SIGTERM , Handler );
  116.  
  117.     setjmp( Top_Level_Loop );    /* Return here upon Reset(). */
  118.  
  119.     clearerr( The_Standard_Input );
  120.  
  121.     Set_Printing( TRUE );
  122.  
  123.     Environment_Register = The_Global_Environment;
  124.     State_Register = Nil;
  125.     Value_Register = Nil;
  126.     Expression_Register = Nil;
  127.     Function_Register = Nil;
  128.     Arguments_Register = Nil;
  129.     Reset_Stack( 0 );
  130.  
  131.     State_Debugged = Nil;
  132.     Value_Debugged = Nil;
  133.  
  134.     Control_C = FALSE;
  135.     Evaluating = FALSE;
  136.     Evaluation_Broken = FALSE;
  137.     Go_Processed = FALSE;
  138.  
  139.     if ( ! Prelude_Started )
  140.     {
  141.         Prelude_Started = TRUE;
  142.         Load_File(STANDARD_PRELUDE_PATHNAME);
  143.     }
  144.     Prelude_Complete = TRUE;
  145.     
  146.     if ( ! Init_File_Complete )
  147.     {
  148.         Init_File_Complete = TRUE;
  149.  
  150.         if (Init_Filename != NULL)
  151.         {
  152.             Load_File (Init_Filename);
  153.         }
  154.         else if (File_Exists (Dot_Scheme_Filename))
  155.         {
  156.             Load_File (Dot_Scheme_Filename);
  157.         }
  158.     }
  159.  
  160.     while (--Argc > 0)
  161.     {
  162.         Load_File(*++Argv);
  163.     }
  164.  
  165.     Prompt = TOP_LEVEL_PROMPT;
  166.     Read_Eval_Print( The_Standard_Input );
  167.  
  168.     if (Arg_Stack_Ptr != 0)
  169.     {
  170.         Panic( "Non-zero argstack pointer on exit" );
  171.         Arg_Stack_Ptr = 0;
  172.     }
  173. }
  174.  
  175.  
  176. Private Boolean File_Exists(Filename)
  177.  
  178.     String      Filename;
  179. {
  180.     FILE * fp;
  181.     
  182.     fp = fopen (Filename, "r");
  183.     if (fp != NULL)
  184.     {
  185.         (void) fclose(fp);
  186.         return( TRUE );
  187.     }
  188.     return( FALSE );
  189. }
  190.  
  191. Private    void    Load_File(Filename)
  192.  
  193.     String      Filename;
  194. {
  195.     Make_Constant_String(Filename);
  196.     Push(Value_Register);
  197.     Load();
  198.     Pop(1);
  199. }
  200.  
  201. Public void Read_Eval_Print( input )
  202.     FILE*    input;    /* C file from which expressions are Read() */
  203. {
  204.     while ( ! Go_Processed )
  205.     {
  206.         if (Get_Printing_State()) Output( Prompt );
  207.  
  208.         Read( input );
  209.  
  210.         if (Value_Register == The_Eof_Object) break;
  211.  
  212.         Push( Value_Register );
  213.         Compile_Object( Top( 1 ));
  214.  
  215.         Debugger_Activated =  ! Debugging && Debugger_Switched_On;
  216.         Eval( Value_Register, Environment_Register );
  217.         Debugger_Activated = FALSE;
  218.  
  219.         if (Get_Printing_State()) 
  220.         {
  221.             Output( "\n" );
  222.             (void) Write_Object( Value_Register , 0 );
  223.         }
  224.     }
  225. }
  226.  
  227.  
  228. #define ERROR_PREFIX "\nError: "
  229. #define PANIC_PREFIX "\nFatal Error: "
  230.  
  231.  
  232. Public void Error( message )
  233.     String    message;
  234. {
  235.     Output( ERROR_PREFIX );
  236.     Output( message );
  237.     Output( ".\n" );
  238.     Break();
  239. }
  240.  
  241. Public void Error1(message, name)
  242.     String message, name;
  243. {
  244.     Character error_string[256];
  245.  
  246.     sprintf( error_string, message, name );
  247.  
  248.     Output( ERROR_PREFIX );
  249.     Output( error_string );
  250.     Output( ".\n" );
  251.     Break();
  252. }
  253.  
  254. Public void Display_Error(message, object)
  255.     String message;
  256.     Object object;
  257. {
  258.     Output( ERROR_PREFIX );
  259.     Output( message ); 
  260.     (void) Write_Object( object , 0 );
  261.     Output( "\n" );
  262.     Break();
  263. }
  264.  
  265.  
  266. Public void Panic( message )
  267.  
  268.     String    message;
  269. {
  270.     Output( PANIC_PREFIX );
  271.     Output( message );
  272.     Output( ".\n" );
  273.     Reset();
  274. }
  275.  
  276. Public    void Break()
  277. {
  278.     Import    jmp_buf    Eval_Loop;
  279.  
  280.     if ( Debugger_Activated )
  281.     {
  282.         Debugger_Activated = FALSE;
  283.  
  284.         if ( Evaluating )
  285.         {
  286.             Evaluation_Broken = TRUE;
  287.             longjmp( Eval_Loop , 1 );
  288.         }
  289.         else
  290.         {
  291.             Reset();
  292.         }
  293.     }
  294.     else if ( Debugging )
  295.     {
  296.         longjmp( Debugging_Loop , 1 );
  297.     }
  298.     else
  299.     {
  300.         Reset();
  301.     }
  302. }
  303.  
  304.  
  305. Public    void Reset()
  306. {
  307.     Debugger_Activated = FALSE;
  308.     Output( "\nReset (Use Control-d to quit UMB Scheme)" );
  309.     longjmp( Top_Level_Loop , 1 );
  310. }
  311.  
  312.  
  313. Public    void Handler( sig )
  314.  
  315.     Integer    sig ;
  316. {
  317.     switch ( sig )
  318.     {
  319.         case SIGINT:
  320.         /* Control-D */
  321.  
  322.         if ( Allocating )
  323.         {
  324.            Control_C = TRUE;
  325.            break;
  326.         }
  327.         else
  328.         {
  329.            Break();
  330.         }
  331.     
  332.         case SIGFPE:
  333.         Error( "Floating Point Exception" );
  334.  
  335.         case SIGILL:
  336.         Panic( "Illegal Instruction" );
  337.  
  338.         case SIGSEGV:
  339.         Panic( "Segmentation Violation" );
  340.  
  341.         case SIGTERM:
  342.         Error( "Terminated" );
  343.  
  344.         default:
  345.         Panic( "Unhandled Signal" );
  346.     }
  347. }
  348.  
  349. Private void Initializations()
  350. {
  351.     /* The order of these does matter. */
  352.  
  353.     Initialize_Architecture();
  354.     Initialize_Object();
  355.     Initialize_Number();
  356.     Initialize_Primitive();
  357.     Initialize_Debug();
  358. }
  359.  
  360.