[project @ 2001-01-17 15:11:04 by simonmar]
[ghc-hetmet.git] / ghc / interpreter / hugs.c
index 1da17a1..bdb4bf6 100644 (file)
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.62 $
- * $Date: 2000/04/07 10:00:28 $
+ * $Revision: 1.78 $
+ * $Date: 2000/06/28 10:42:17 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -27,6 +27,8 @@
 #include "RtsAPI.h"
 #include "Schedule.h"
 #include "Assembler.h"                                /* DEBUG_LoadSymbols */
+#include "ForeignCall.h"                                 /* createAdjThunk */
+
 
 Bool haskell98 = TRUE;                  /* TRUE => Haskell 98 compatibility*/
 Bool initDone = FALSE;
@@ -70,9 +72,6 @@ static Void   local listNames         ( Void );
 static Void   local toggleSet         ( Char,Bool );
 static Void   local togglesIn         ( Bool );
 static Void   local optionInfo        ( Void );
-#if USE_REGISTRY
-static String local optionsToStr      ( Void );
-#endif
 static Void   local readOptions       ( String );
 static Bool   local processOption     ( String );
 static Void   local setHeapSize       ( String );
@@ -83,6 +82,12 @@ static Void   local failed            ( Void );
 static String local strCopy           ( String );
 static Void   local browseit         ( Module,String,Bool );
 static Void   local browse           ( Void );
+static void   local clearCurrentFile  ( void );
+
+static void loadActions ( List loadModules /* :: [CONID] */ );
+static void addActions ( List extraModules /* :: [CONID] */ );
+static Bool loadThePrelude ( void );
+
 
 /* --------------------------------------------------------------------------
  * Machine dependent code for Hugs interpreter:
@@ -98,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;
 
@@ -123,43 +127,214 @@ static Bool   disableOutput = FALSE;    /* TRUE => quiet                   */
 
        List  ifaces_outstanding = NIL;
 
+static ConId currentModule_failed = NIL; /* Remember failed module from :r */
+
+
 
 /* --------------------------------------------------------------------------
  * Hugs entry point:
  * ------------------------------------------------------------------------*/
 
-#ifndef NO_MAIN /* we omit main when building the "Hugs server" */
-Main main ( Int, String [] );       /* now every func has a prototype  */
+#ifdef DIET_HEP
 
-Main main(argc,argv)
-int  argc;
-char *argv[]; {
-#ifdef HAVE_CONSOLE_H /* Macintosh port */
-    _ftype = 'TEXT';
-    _fcreator = 'R*ch';       /*  // 'KAHL';      //'*TEX';       //'ttxt'; */
+#include "StgDLL.h"
+#include "DietHEP.h"
 
-    console_options.top = 50;
-    console_options.left = 20;
+extern void setRtsFlags ( int );
 
-    console_options.nrows = 32;
-    console_options.ncols = 80;
+static int diet_hep_initialised = 0;
+static FILE* dh_logfile;
 
-    console_options.pause_atexit = 1;
-    console_options.title = "\pHugs";
+static 
+void printf_now ( void )
+{
+  time_t now = time(NULL);
+  printf("\n=== DietHEP event at %s",ctime(&now));
+}
 
-    console_options.procID = 5;
-    argc = ccommand(&argv);
-#endif
+static
+void diet_hep_initialise ( void* cstackbase )
+{
+    List   modConIds; /* :: [CONID] */
+    Bool   prelOK;
+    String s;
+    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(sizeof(fakeargv)/sizeof(String)-1,fakeargv);
+    //setRtsFlags(4 | 128 | 32);
+    assert(isNull(modConIds));
+    setBreakAction ( HugsIgnoreBreak );
+    prelOK    = loadThePrelude();
+
+    if (!prelOK) {
+       printf("diet_hep_initialise: fatal error: "
+              "can't load the Prelude.\n" );
+       exit(1);
+    }    
+
+    loadActions(NIL);
+
+    if (combined) everybody(POSTPREL);
+    /* we now leave, and wait for requests */
+}
+
+
+static
+DH_MODULE DH_LoadLibrary_wrk ( DH_LPCSTR modname )
+{
+   Text   t;
+   Module m;
+   t = findText(modname);
+   addActions ( singleton(mkCon(t)) );
+   m = findModule(t);
+   if (isModule(m)) return m; else return 0;
+}
+
+static
+void* DH_GetProcAddress_wrk ( DH_CALLCONV cconv,
+                              DH_MODULE   hModule,
+                              DH_LPCSTR   lpProcName )
+{
+   Name  n;
+   Text  typedescr;
+   void* adj_thunk;
+   StgStablePtr stableptr;
+
+   if (!isModule(hModule)) return NULL;
+   setCurrModule(hModule);
+   n = findName ( findText(lpProcName) );
+   if (!isName(n)) return NULL;
+   assert(isCPtr(name(n).closure));
+
+   /* n is the function which we want to f-x-d,
+      n :: prim_arg* -> IO prim_result.
+      Assume that name(n).closure is a cptr which points to n's BCO.
+
+      Make ns a stable pointer to n.
+      Manufacture a type descriptor string for n's type.
+      use createAdjThunk to build the adj thunk.
+   */
+   typedescr = makeTypeDescrText ( name(n).type );
+   if (!isText(typedescr)) return NULL;
+   if (cconv != dh_stdcall && cconv != dh_ccall) return NULL;
+
+   stableptr = getStablePtr( cptrOf(name(n).closure) );
+   adj_thunk = createAdjThunk ( stableptr,
+                                textToStr(typedescr), 
+                                cconv==dh_stdcall ? 's' : 'c' );
+   return adj_thunk;
+}
+
+/*----------- 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 );
+}
 
-    CStackBase = &argc;                 /* Save stack base for use in gc   */
 
-#ifdef DEBUG
 #if 0
-    checkBytecodeCount();              /* check for too many bytecodes    */
+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;
+   DH_MODULE hdl;
+   hdl = DH_LoadLibrary("FooBar");
+   assert(isModule(hdl));
+   proc = DH_GetProcAddress ( dh_ccall, hdl, "wurble" );
+fprintf ( stderr, "just before calling it\n");
+   ((void(*)(int)) proc)  (33);
+   ((void(*)(int)) proc)  (34);
+   ((void(*)(int)) proc)  (35);
+   fprintf ( stderr, "exiting safely\n");
+   return 0;
+}
 #endif
 
+#else
+
+Main main ( Int, String [] );       /* now every func has a prototype  */
+
+Main main(argc,argv)
+int  argc;
+char *argv[]; {
+    CStackBase = &argc;                 /* Save stack base for use in gc   */
+
+#   ifdef DEBUG
+#   if 0
+    checkBytecodeCount();              /* check for too many bytecodes    */
+#   endif
+#   endif
+
     /* If first arg is +Q or -Q, be entirely silent, and automatically run
        main after loading scripts.  Useful for running the nofib suite.    */
     if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
@@ -171,7 +346,7 @@ char *argv[]; {
 
     Printf("__   __ __  __  ____   ___      _________________________________________\n");
     Printf("||   || ||  || ||  || ||__      STGHugs: Based on the Haskell 98 standard\n");
-    Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-1999\n");
+    Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-2000\n");
     Printf("||---||         ___||           World Wide Web: http://haskell.org/hugs\n");
     Printf("||   ||                         Report bugs to: hugs-bugs@haskell.org\n");
     Printf("||   || Version: %s _________________________________________\n\n",HUGS_VERSION);
@@ -183,9 +358,6 @@ char *argv[]; {
     */
     setInstallDir ( argv[0] );
 
-#if SYMANTEC_C
-    Printf("   Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
-#endif
     FlushStdout();
     interpreter(argc,argv);
     Printf("[Leaving Hugs]\n");
@@ -197,17 +369,15 @@ char *argv[]; {
     MainDone();
 }
 
-#endif
+#endif /* DIET_HEP */
 
 /* --------------------------------------------------------------------------
  * Initialization, interpret command line args and read prelude:
  * ------------------------------------------------------------------------*/
 
-static List /*CONID*/ initialize(argc,argv)  /* Interpreter initialization */
-Int    argc;
-String argv[]; {
-   Int    i;
-   char   argv_0_orig[1000];
+static List /*CONID*/ initialize ( Int argc, String argv[] )
+{
+   Int    i, j;
    List   initialModules;
 
    setLastEdit((String)0,0);
@@ -221,20 +391,9 @@ String argv[]; {
 #endif
    hugsPath      = strCopy(HUGSPATH);
    readOptions("-p\"%s> \" -r$$");
-#if USE_REGISTRY
-   projectPath   = strCopy(readRegChildStrings(HKEY_LOCAL_MACHINE,ProjectRoot,
-                                                "HUGSPATH", PATHSEP, ""));
-   readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
-   readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
-#endif /* USE_REGISTRY */
    readOptions(fromEnv("STGHUGSFLAGS",""));
 
-   strncpy(argv_0_orig,argv[0],1000);   /* startupHaskell mangles argv[0] */
-   startupHaskell (argc,argv,NULL);
-   argc = prog_argc; 
-   argv = prog_argv;
-
-#  if DEBUG
+#  ifdef DEBUG
    { 
       char exe_name[N_INSTALLDIR + 6];
       strcpy(exe_name, installDir);
@@ -243,29 +402,37 @@ String argv[]; {
    }
 #  endif
 
+   /* startupHaskell extracts args between +RTS ... -RTS, and sets
+      prog_argc/prog_argv to the rest.  We want to further process 
+      the rest, so we then get hold of them again.
+   */
+   startupHaskell ( argc, argv, NULL );
+   getProgArgv ( &argc, &argv );
+
    /* Find out early on if we're in combined mode or not.
       everybody(PREPREL) needs to know this.  Also, establish the
       heap size;
    */ 
-   for (i=1; i < argc; ++i) {
+   for (i = 1; i < argc; ++i) {
       if (strcmp(argv[i], "--")==0) break;
       if (strcmp(argv[i], "-c")==0) combined = FALSE;
       if (strcmp(argv[i], "+c")==0) combined = TRUE;
 
-      if (strncmp(argv[i],"+h",2)==0 ||
-          strncmp(argv[i],"-h",2)==0)
+      if (strncmp(argv[i],"+h",2)==0 || strncmp(argv[i],"-h",2)==0)
          setHeapSize(&(argv[i][2]));
    }
 
    everybody(PREPREL);
    initialModules = NIL;
 
-   for (i=1; i < argc; ++i) {            /* process command line arguments  */
-      if (strcmp(argv[i], "--")==0) break;
-      if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/
-          && !processOption(argv[i])) {
-         initialModules
-            = cons ( mkCon(findText(argv[i])), initialModules );
+   for (i = 1; i < argc; ++i) {          /* process command line arguments  */
+      if (strcmp(argv[i], "--")==0) 
+         { argv[i] = NULL; break; }
+      if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/) {
+         if (!processOption(argv[i]))
+            initialModules
+               = cons ( mkCon(findText(argv[i])), initialModules );
+         argv[i] = NULL;
       }
    }
 
@@ -285,6 +452,16 @@ String argv[]; {
               " combined mode\n\n" );
    }
 
+   /* slide args back over the deleted ones. */
+   j = 1;
+   for (i = 1; i < argc; i++)
+      if (argv[i])
+         argv[j++] = argv[i];
+
+   argc = j;
+
+   setProgArgv ( argc, argv );
+
    initDone = TRUE;
    return initialModules;
 }
@@ -310,8 +487,9 @@ Bool state; {
             *toggle[i].flag = state;
             return;
         }
+    clearCurrentFile();
     ERRMSG(0) "Unknown toggle `%c'", c
-    EEND;
+    EEND_NO_LONGJMP;
 }
 
 static Void local togglesIn(state)      /* Print current list of toggles in*/
@@ -380,65 +558,6 @@ ToDo
     Putchar('\n');
 }
 
-#if USE_REGISTRY
-#define PUTC(c)                         \
-    *next++=(c)
-
-#define PUTS(s)                         \
-    strcpy(next,s);                     \
-    next+=strlen(next)
-
-#define PUTInt(optc,i)                  \
-    sprintf(next,"-%c%d",optc,i);       \
-    next+=strlen(next)
-
-#define PUTStr(c,s)                     \
-    next=PUTStr_aux(next,c,s)
-
-static String local PUTStr_aux ( String,Char, String));
-
-static String local PUTStr_aux(next,c,s)
-String next;
-Char   c;
-String s; {
-    if (s) { 
-        String t = 0;
-        sprintf(next,"-%c\"",c); 
-        next+=strlen(next);      
-        for(t=s; *t; ++t) {
-            PUTS(unlexChar(*t,'"'));
-        }
-        next+=strlen(next);      
-        PUTS("\" ");
-    }
-    return next;
-}
-
-static String local optionsToStr() {          /* convert options to string */
-    static char buffer[2000];
-    String next = buffer;
-
-    Int i;
-    for (i=0; toggle[i].c; ++i) {
-        PUTC(*toggle[i].flag ? '+' : '-');
-        PUTC(toggle[i].c);
-        PUTC(' ');
-    }
-    PUTS(haskell98 ? "+98 " : "-98 ");
-    PUTInt('h',hpSize);  PUTC(' ');
-    PUTStr('p',prompt);
-    PUTStr('r',repeatStr);
-    PUTStr('P',hugsPath);
-    PUTStr('E',hugsEdit);
-    PUTInt('c',cutoff);  PUTC(' ');
-#if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
-    PUTStr('F',preprocessor);
-#endif
-    PUTC('\0');
-    return buffer;
-}
-#endif /* USE_REGISTRY */
-
 #undef PUTC
 #undef PUTS
 #undef PUTInt
@@ -545,11 +664,7 @@ String s; {
             hpSize = MAXIMUMHEAP;
         if (initDone && hpSize != heapSize) {
             /* ToDo: should this use a message box in winhugs? */
-#if USE_REGISTRY
-            FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
-#else
             FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
-#endif
         } else {
             heapSize = hpSize;
         }
@@ -624,8 +739,8 @@ static struct cmd cmds[] = {
  {":reload", RELOAD}, {":gc",   COLLECT}, {":edit",    EDIT},
  {":quit",   QUIT},   {":set",  SET},     {":find",    FIND},
  {":names",  NAMES},  {":info", INFO},    {":project", PROJECT},
- {":dump",   DUMP},   {":ztats", STATS},
- {":module",SETMODULE}, 
+ {":dump",   DUMP},
+ {":module", SETMODULE}, 
  {":browse", BROWSE},
 #if EXPLAIN_INSTANCE_RESOLUTION
  {":xplain", XPLAIN},
@@ -663,9 +778,6 @@ static Void local menu() {
     Printf(":gc                 force garbage collection\n");
     Printf(":version            print Hugs version\n");
     Printf(":dump <name>        print STG code for named fn\n");
-#ifdef CRUDE_PROFILING
-    Printf(":ztats <name>       print reduction stats\n");
-#endif
     Printf(":quit               exit Hugs interpreter\n");
 }
 
@@ -688,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},
@@ -711,12 +822,9 @@ static Void local set() {               /* change command line options from*/
         do {
             if (!processOption(s)) {
                 ERRMSG(0) "Option string must begin with `+' or `-'"
-                EEND;
+                EEND_NO_LONGJMP;
             }
         } while ((s=readFilename())!=0);
-#if USE_REGISTRY
-        writeRegString("Options", optionsToStr());
-#endif
     }
     else
         optionInfo();
@@ -730,7 +838,7 @@ static Void local changeDir() {         /* change directory                */
     String s = readFilename();
     if (s && chdir(s)) {
         ERRMSG(0) "Unable to change to directory \"%s\"", s
-        EEND;
+        EEND_NO_LONGJMP;
     }
 }
 
@@ -765,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;
@@ -775,6 +895,8 @@ HugsBreakAction setBreakAction ( HugsBreakAction newAction )
       default:
          internal("setBreakAction");
    }
+#  endif
+
    return tmp;
 }
 
@@ -842,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");
@@ -1589,26 +1711,56 @@ static Bool loadThePrelude ( void )
 }
 
 
+/* Refresh the current target modules, and attempt to set the
+   current module to what it was before (ie currentModule):
+     if currentModule_failed is different from currentModule,
+        use that instead
+     if nextCurrMod is non null, try to set it to that instead
+     if the one we're after insn't available, select a target
+       from the end of the module group list.
+*/
 static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
 {
    List t;
-   ConId tryFor = mkCon(module(currentModule).text);
+   ConId tryFor; 
+
+   /* Remember what the old current module was. */
+   tryFor = mkCon(module(currentModule).text);
+
+   /* Do the Real Work. */
    achieveTargetModules(FALSE);
+
+   /* Remember if the current module was invalidated by this
+      refresh, so later refreshes can attempt to reload it. */
+   if (!elemMG(tryFor))
+      currentModule_failed = tryFor;
+
+   /* If a previous refresh failed to get an old current module, 
+      try for that instead. */
+   if (nonNull(currentModule_failed) 
+       && textOf(currentModule_failed) != textOf(tryFor)
+       && elemMG(currentModule_failed))
+      tryFor = currentModule_failed;
+   /* If our caller specified a new current module, that overrides
+      all historical settings. */
    if (nonNull(nextCurrMod))
       tryFor = nextCurrMod;
+   /* Finally, if we can't actually get hold of whatever it was we
+      were after, select something which is possible. */
    if (!elemMG(tryFor))
       tryFor = selectLatestMG();
+
    /* combined mode kludge, to get Prelude rather than PrelHugs */
    if (combined && textOf(tryFor)==findText("PrelHugs"))
       tryFor = mkCon(findText("Prelude"));
 
    if (cleanAfter) {
-   /* delete any targetModules which didn't actually get loaded  */
-   t = targetModules;
-   targetModules = NIL;
-   for (; nonNull(t); t=tl(t))
-      if (elemMG(hd(t)))
-         targetModules = cons(hd(t),targetModules);
+      /* delete any targetModules which didn't actually get loaded  */
+      t = targetModules;
+      targetModules = NIL;
+      for (; nonNull(t); t=tl(t))
+         if (elemMG(hd(t)))
+            targetModules = cons(hd(t),targetModules);
    }
 
    setCurrModule ( findModule(textOf(tryFor)) );
@@ -1791,6 +1943,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
         bd = type;
 
     if (whatIs(bd)==QUAL) {
+       printing = FALSE;
+       clearCurrentFile();
        ERRMSG(0) "Unresolved overloading" ETHEN
        ERRTEXT   "\n*** Type       : "    ETHEN ERRTYPE(type);
        ERRTEXT   "\n*** Expression : "    ETHEN ERREXPR(inputExpr);
@@ -1800,6 +1954,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
     }
   
 #if 1
+    printing      = TRUE;
+    numEnters     = 0;
     if (isProgType(ks,bd)) {
         inputExpr = ap(nameRunIO_toplevel,inputExpr);
         evalExp();
@@ -1807,6 +1963,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
     } else {
         Cell d = provePred(ks,NIL,ap(classShow,bd));
         if (isNull(d)) {
+           clearCurrentFile();
+           printing = FALSE;
            ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
            ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
            ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
@@ -1841,6 +1999,7 @@ static Void local evaluator() {        /* evaluate expr and print value    */
    nukeModule(evalMod);
    setCurrModule(currMod);
    setCurrentFile(currMod);
+   stopAnyPrinting();
 }
 
 
@@ -2317,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;
@@ -2330,6 +2489,7 @@ static Void local listNames() {         /* list names matching optional pat*/
         names = addNamesMatching((String)0,names);
     }
     if (isNull(names)) {                /* Then print them out             */
+        clearCurrentFile();
         ERRMSG(0) "No names selected"
         EEND_NO_LONGJMP;
         return;
@@ -2393,7 +2553,6 @@ String argv[]; {
     modConIds = initialize(argc,argv);  /* the initial modules to load     */
     setBreakAction ( HugsIgnoreBreak );
     prelOK    = loadThePrelude();
-    if (combined) everybody(POSTPREL);
 
     if (!prelOK) {
        if (autoMain)
@@ -2403,6 +2562,7 @@ String argv[]; {
        exit(1);
     }    
 
+    if (combined) everybody(POSTPREL);
     loadActions(modConIds);
 
     if (autoMain) {
@@ -2433,8 +2593,10 @@ String argv[]; {
             case FIND   : find();
                           break;
             case LOAD   : modConIds = NIL;
-                          while ((s=readFilename())!=0)
-                             modConIds = cons(mkCon(findText(s)),modConIds);
+               while ((s=readFilename())!=0) {
+                          modConIds = cons(mkCon(findText(s)),modConIds);
+
+               }
                           loadActions(modConIds);
                           modConIds = NIL;
                           break;
@@ -2467,11 +2629,6 @@ String argv[]; {
                           break;
             case SET    : set();
                           break;
-            case STATS:
-#ifdef CRUDE_PROFILING
-                          cp_show();
-#endif
-                          break;
             case SYSTEM : if (shellEsc(readLine()))
                               Printf("Warning: Shell escape terminated abnormally\n");
                           break;
@@ -2519,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();
 }
 
@@ -2538,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       */
@@ -2561,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();
 }
@@ -2594,10 +2725,7 @@ static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
         Putchar('\n');
         if (showStats) {
 #define plural(v)   v, (v==1?"":"s")
-            Printf("%lu cell%s",plural(numCells));
-            if (numGcs>0)
-                Printf(", %u garbage collection%s",plural(numGcs));
-            Printf(")\n");
+           Printf("(%lu enter%s)\n",plural(numEnters));
 #undef plural
         }
         FlushStdout();
@@ -2815,11 +2943,15 @@ Int what; {                     /* system to respond as appropriate ...    */
     typeChecker(what);
     compiler(what);   
     codegen(what);
-
-    mark(moduleGraph);
-    mark(prelModules);
-    mark(targetModules);
-    mark(daSccs);
+    interfayce(what);
+
+    if (what == MARK) {
+       mark(moduleGraph);
+       mark(prelModules);
+       mark(targetModules);
+       mark(daSccs);
+       mark(currentModule_failed);
+    }
 }
 
 /*-------------------------------------------------------------------------*/