X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fhugs.c;h=bdb4bf62601e86dbaa10a55bf3d765b54d78dc37;hb=770d95e5634608f7dc6fc0ff57bac674919edc83;hp=3decee2990aa20fbf00b4b54d4cf3df13ce4b4e1;hpb=79609941480b832d00eeff5f143e4da4b735dd9e;p=ghc-hetmet.git diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 3decee2..bdb4bf6 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: hugs.c,v $ - * $Revision: 1.72 $ - * $Date: 2000/05/12 13:34:06 $ + * $Revision: 1.78 $ + * $Date: 2000/06/28 10:42:17 $ * ------------------------------------------------------------------------*/ #include @@ -103,7 +103,6 @@ static Bool printing = FALSE; /* TRUE => currently printing value*/ 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; @@ -138,9 +137,20 @@ static ConId currentModule_failed = NIL; /* Remember failed module from :r */ #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 ) @@ -148,25 +158,36 @@ 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); } @@ -178,7 +199,7 @@ void diet_hep_initialise ( void* cstackbase ) static -HMODULE LoadLibrary_wrk ( LPCSTR modname ) +DH_MODULE DH_LoadLibrary_wrk ( DH_LPCSTR modname ) { Text t; Module m; @@ -188,21 +209,10 @@ HMODULE LoadLibrary_wrk ( LPCSTR modname ) if (isModule(m)) return m; else return 0; } -HMODULE LoadLibrary ( LPCSTR modname ) -{ - int xxx; - HMODULE hdl; - diet_hep_initialise ( &xxx ); - hdl = LoadLibrary_wrk ( modname ); - printf ( "hdl = %d\n", hdl ); - return hdl; -} - - static -void* GetProcAddr_wrk ( DHCALLCONV cconv, - HMODULE hModule, - LPCSTR lpProcName ) +void* DH_GetProcAddress_wrk ( DH_CALLCONV cconv, + DH_MODULE hModule, + DH_LPCSTR lpProcName ) { Name n; Text typedescr; @@ -234,24 +244,73 @@ void* GetProcAddr_wrk ( DHCALLCONV cconv, return adj_thunk; } -void* GetProcAddr ( DHCALLCONV cconv, - HMODULE hModule, - LPCSTR lpProcName ) +/*----------- EXPORTS -------------*/ + __attribute__((__stdcall__)) +DH_MODULE +DH_LoadLibrary ( DH_LPCSTR modname ) { int xxx; + DH_MODULE hdl; diet_hep_initialise ( &xxx ); - return GetProcAddr_wrk ( cconv, hModule, lpProcName ); + 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; - HMODULE hdl; - hdl = LoadLibrary("FooBar"); + DH_MODULE hdl; + hdl = DH_LoadLibrary("FooBar"); assert(isModule(hdl)); - proc = GetProcAddr ( dh_ccall, hdl, "wurble" ); + proc = DH_GetProcAddress ( dh_ccall, hdl, "wurble" ); fprintf ( stderr, "just before calling it\n"); ((void(*)(int)) proc) (33); ((void(*)(int)) proc) (34); @@ -259,6 +318,7 @@ fprintf ( stderr, "just before calling it\n"); fprintf ( stderr, "exiting safely\n"); return 0; } +#endif #else @@ -333,7 +393,7 @@ static List /*CONID*/ initialize ( Int argc, String argv[] ) readOptions("-p\"%s> \" -r$$"); readOptions(fromEnv("STGHUGSFLAGS","")); -# if DEBUG +# ifdef DEBUG { char exe_name[N_INSTALLDIR + 6]; strcpy(exe_name, installDir); @@ -740,7 +800,6 @@ struct options toggle[] = { /* List of command line toggles */ {'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}, @@ -814,6 +873,18 @@ HugsBreakAction setBreakAction ( HugsBreakAction newAction ) { 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; @@ -824,6 +895,8 @@ HugsBreakAction setBreakAction ( HugsBreakAction newAction ) default: internal("setBreakAction"); } +# endif + return tmp; } @@ -891,13 +964,13 @@ static void ppMG ( void ) 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"); @@ -2403,7 +2476,7 @@ Inst in; { 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; @@ -2603,14 +2676,8 @@ Target t; { #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(); } @@ -2622,20 +2689,6 @@ Target t; { /* has now reached t */ 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 */ @@ -2645,17 +2698,11 @@ 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(); } @@ -2896,6 +2943,7 @@ Int what; { /* system to respond as appropriate ... */ typeChecker(what); compiler(what); codegen(what); + interfayce(what); if (what == MARK) { mark(moduleGraph);