Language-Haskell

 view release on metacpan or  search on metacpan

hugs98-Nov2003/src/server.c  view on Meta::CPAN

    }
}

/* --------------------------------------------------------------------------
 * Error handling
 *
 * We buffer error messages and refuse to execute commands until
 * the error is cleared.
 * ------------------------------------------------------------------------*/

#define ErrorBufferSize 10000

static char  serverErrMsg[ErrorBufferSize];   /* Buffer for error messages */
char* lastError = NULL;

String ClearError()
{
    String err = lastError;
    lastError  = NULL;
    ClearOutputBuffer();

    if (err && (numLoadedScripts() > 0)) 
    {
        everybody(RESET);        
        dropScriptsFrom(numLoadedScripts()-1);  /* remove partially loaded scripts */
    }
    return err;
}

Void setError(s)            /* Format an error message        */
String s; {
    Int    n = 0;
    String err = ClearOutputBuffer();

    if (NULL == err) {
	n = snprintf(serverErrMsg, ErrorBufferSize, "%s\n", s);
    } else {
	n = snprintf(serverErrMsg, ErrorBufferSize, "%s\n%s\n", s, err);
    }
    if (0 <= n && n <= ErrorBufferSize) {
	lastError = serverErrMsg;
    } else {
	lastError = "error buffer overflowed\n";
    }
}

/* All server entry points set CStackBase for the benefit of the (conservative)
 * GC and do error catching.  Any calls to Hugs functions should be "protected"
 * by being placed inside this macro.
 *
 *   void entryPoint(arg1, arg2, result)
 *   T1 arg1;
 *   T2 arg2;
 *   T3 *result;
 *   {
 *       protect(doNothing(),
 *           ...
 *       );
 *   }
 *
 * Macro decomposed into BEGIN_PROTECT and END_PROTECT pieces so that i
 * can be used on some compilers (Mac?) that have limits on the size of
 * macro arguments.
 */
#define BEGIN_PROTECT \
  if (NULL == lastError) { \
      Cell dummy; \
      CStackBase = &dummy;              /* Save stack base for use in gc  */ \
      consGC = TRUE;                    /* conservative GC is the default */ \
      if (!setjmp(catch_error)) {
#define END_PROTECT \
      } else { \
	setError("Error occurred"); \
	normalTerminal(); \
      }	\
  }
#define protect(s)	BEGIN_PROTECT s; END_PROTECT

/* --------------------------------------------------------------------------
 * Initialisation
 * ------------------------------------------------------------------------*/

/* I've added a special case for the server.  Probably should just add
   another entry point but what the heck.  If argc = -1 then the hugs
   server should NOT read registry or default hugs path stuff.  Instead,
   all options are in the first argument in argv.   -- jcp

*/

DLLEXPORT(HugsServerAPI*) initHugsServer(argc, argv) /*server initialisation*/
Int    argc;
String argv[]; {

    static Bool is_initialized = FALSE;

    if (!is_initialized) {
      is_initialized = TRUE;
      setHugsAPI();
      
      BEGIN_PROTECT			/* Too much text for protect()	   */
      Int i;

      startEvaluator();

      if (argc == -1) {
	readOptions(argv[0],FALSE);
      } else {
	readOptionSettings();
	/* re-parse options for the benefit of #! (which takes only one arg) */
	for (i=1; i<argc && (argv[i][0]=='+' || argv[i][0]=='-'); ++i) {
	  if (!readOptions2(argv[i])) {
	    setError("Unrecognised option");
	    return NULL;
	  }
	}
      }
      EnableOutput(FALSE);
      loadPrelude();

#ifndef NO_DYNAMIC_TYPES
      addScriptName("Hugs.Dynamic",TRUE);



( run in 1.164 second using v1.01-cache-2.11-cpan-39bf76dae61 )