* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.73 $
- * $Date: 2000/05/12 13:41:59 $
+ * $Revision: 1.78 $
+ * $Date: 2000/06/28 10:42:17 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static Bool showStats = FALSE; /* TRUE => print stats after eval */
static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
static Bool addType = FALSE; /* TRUE => print type with value */
-static Bool useDots = RISCOS; /* TRUE => use dots in progress */
static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE;
#ifdef DIET_HEP
+#include "StgDLL.h"
#include "DietHEP.h"
+extern void setRtsFlags ( int );
+
static int diet_hep_initialised = 0;
+static FILE* dh_logfile;
+
+static
+void printf_now ( void )
+{
+ time_t now = time(NULL);
+ printf("\n=== DietHEP event at %s",ctime(&now));
+}
static
void diet_hep_initialise ( void* cstackbase )
List modConIds; /* :: [CONID] */
Bool prelOK;
String s;
- String fakeargv[1] = { "diet_hep" };
-
+ String fakeargv[] = { "diet_hep", "+RTS",
+ "-D0", "-RTS", NULL };
+ // GC = 32
+ // sanity = 128
if (diet_hep_initialised) return;
diet_hep_initialised = 1;
CStackBase = cstackbase;
+
+ dh_logfile = freopen("diet_hep_logfile.txt","a",stdout);
+ assert(dh_logfile);
+
+ printf_now();
+ printf("===---===---=== DietHEP initialisation ===---===---===\n\n");
+ fflush(stdout);
+
EnableOutput(1);
setInstallDir ( "diet_hep" );
/* The following copied from interpreter() */
setBreakAction ( HugsIgnoreBreak );
- modConIds = initialize(1,fakeargv);
+ modConIds = initialize(sizeof(fakeargv)/sizeof(String)-1,fakeargv);
+ //setRtsFlags(4 | 128 | 32);
assert(isNull(modConIds));
setBreakAction ( HugsIgnoreBreak );
prelOK = loadThePrelude();
if (!prelOK) {
- fprintf(stderr, "diet_hep_initialise: fatal error: "
- "can't load the Prelude.\n" );
+ printf("diet_hep_initialise: fatal error: "
+ "can't load the Prelude.\n" );
exit(1);
}
if (isModule(m)) return m; else return 0;
}
-DH_MODULE DH_LoadLibrary ( DH_LPCSTR modname )
-{
- int xxx;
- DH_MODULE hdl;
- diet_hep_initialise ( &xxx );
- hdl = DH_LoadLibrary_wrk ( modname );
- printf ( "hdl = %d\n", hdl );
- return hdl;
-}
-
-
static
void* DH_GetProcAddress_wrk ( DH_CALLCONV cconv,
DH_MODULE hModule,
return adj_thunk;
}
-void* DH_GetProcAddress ( DH_CALLCONV cconv,
- DH_MODULE hModule,
- DH_LPCSTR lpProcName )
+/*----------- EXPORTS -------------*/
+ __attribute__((__stdcall__))
+DH_MODULE
+DH_LoadLibrary ( DH_LPCSTR modname )
+{
+ int xxx;
+ DH_MODULE hdl;
+ diet_hep_initialise ( &xxx );
+ printf_now();
+ printf("=== DH_LoadLibrary: request to load `%s'\n\n", modname );
+ fflush(stdout);
+ hdl = DH_LoadLibrary_wrk ( modname );
+ return hdl;
+}
+
+
+ __attribute__((__stdcall__))
+void*
+DH_GetProcAddress ( DH_CALLCONV cconv,
+ DH_MODULE hModule,
+ DH_LPCSTR lpProcName )
{
int xxx;
diet_hep_initialise ( &xxx );
+ printf_now();
+ printf("=== DH_GetProcAddress: request for `%s'\n\n", lpProcName );
+ fflush(stdout);
return DH_GetProcAddress_wrk ( cconv, hModule, lpProcName );
}
+
+#if 0
+BOOL APIENTRY
+DllMain (
+ HINSTANCE hInst /* Library instance handle. */ ,
+ DWORD reason /* Reason this function is being called. */ ,
+ LPVOID reserved /* Not used. */ )
+{
+
+ switch (reason)
+ {
+ case DLL_PROCESS_ATTACH:
+ break;
+
+ case DLL_PROCESS_DETACH:
+ break;
+
+ case DLL_THREAD_ATTACH:
+ break;
+
+ case DLL_THREAD_DETACH:
+ break;
+ }
+ return TRUE;
+}
+#endif
+
//---------------------------------
//--- testing it ...
+#if 0
int main ( int argc, char** argv )
{
void* proc;
fprintf ( stderr, "exiting safely\n");
return 0;
}
+#endif
#else
readOptions("-p\"%s> \" -r$$");
readOptions(fromEnv("STGHUGSFLAGS",""));
-# if DEBUG
+# ifdef DEBUG
{
char exe_name[N_INSTALLDIR + 6];
strcpy(exe_name, installDir);
{'g', 1, "Print no. cells recovered after gc", &gcMessages},
{'l', 1, "Literate modules as default", &literateScripts},
{'e', 1, "Warn about errors in literate modules", &literateErrors},
- {'.', 1, "Print dots to show progress", &useDots},
{'q', 1, "Print nothing to show progress", &quiet},
{'w', 1, "Always show which modules are loaded", &listScripts},
{'k', 1, "Show kind errors in full", &kindExpert},
{
HugsBreakAction tmp = currentBreakAction;
currentBreakAction = newAction;
+
+# if defined(mingw32_TARGET_OS)
+ /* Be wierd. You can't longjmp in a signal handler,
+ and posix signals are not supported.
+ */
+ if (newAction == HugsRtsInterrupt) {
+ setHandler ( handler_RtsInterrupt );
+ } else {
+ signal(SIGINT,SIG_IGN);
+ }
+# else
+ /* do it Right */
switch (newAction) {
case HugsIgnoreBreak:
setHandler ( handler_IgnoreBreak ); break;
default:
internal("setBreakAction");
}
+# endif
+
return tmp;
}
u = hd(t);
switch (whatIs(u)) {
case GRP_NONREC:
- FPrintf ( stderr, " %s\n", textToStr(textOf(snd(u))));
+ Printf ( " %s\n", textToStr(textOf(snd(u))));
break;
case GRP_REC:
- FPrintf ( stderr, " {" );
+ Printf ( " {" );
for (v = snd(u); nonNull(v); v=tl(v))
- FPrintf ( stderr, "%s ", textToStr(textOf(hd(v))) );
- FPrintf ( stderr, "}\n" );
+ Printf ( "%s ", textToStr(textOf(hd(v))) );
+ Printf ( "}\n" );
break;
default:
internal("ppMG");
static Void local listNames() { /* list names matching optional pat*/
String pat = readFilename();
List names = NIL;
- Int width = getTerminalWidth() - 1;
+ Int width = 72;
Int count = 0;
Int termPos;
Module mod = currentModule;
#endif
currTarget = (t?t:1);
aiming = TRUE;
- if (useDots) {
- currPos = strlen(what);
- maxPos = getTerminalWidth() - 1;
- Printf("%s",what);
- }
- else
- for (charCount=0; *what; charCount++)
- Putchar(*what++);
+ for (charCount=0; *what; charCount++)
+ Putchar(*what++);
FlushStdout();
}
if (showInstRes)
return;
#endif
- if (useDots) {
- Int newPos = (Int)((maxPos * ((long)t))/currTarget);
-
- if (newPos>maxPos)
- newPos = maxPos;
-
- if (newPos>currPos) {
- do
- Putchar('.');
- while (newPos>++currPos);
- FlushStdout();
- }
- FlushStdout();
- }
}
Void done() { /* Goal has now been achieved */
if (showInstRes)
return;
#endif
- if (useDots) {
- while (maxPos>currPos++)
- Putchar('.');
- Putchar('\n');
+ for (; charCount>0; charCount--) {
+ Putchar('\b');
+ Putchar(' ');
+ Putchar('\b');
}
- else
- for (; charCount>0; charCount--) {
- Putchar('\b');
- Putchar(' ');
- Putchar('\b');
- }
aiming = FALSE;
FlushStdout();
}
typeChecker(what);
compiler(what);
codegen(what);
+ interfayce(what);
if (what == MARK) {
mark(moduleGraph);
projects / ghc-hetmet.git / blobdiff