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 )