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