[project @ 2000-04-03 12:50:25 by simonmar]
[ghc-hetmet.git] / ghc / interpreter / storage.c
index 3fb6502..ee0363b 100644 (file)
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.53 $
- * $Date: 2000/03/23 14:54:21 $
+ * $Revision: 1.57 $
+ * $Date: 2000/03/31 04:13:27 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -107,17 +107,18 @@ Cell v; {
         case CONIDCELL  :
         case CONOPCELL  : return text+textOf(v);
 
-        case QUALIDENT  : {   Text pos = textHw;
-                              Text t   = qmodOf(v);
-                              while (pos+1 < savedText && text[t]!=0) {
-                                  text[pos++] = text[t++];
+        case QUALIDENT  : {   String qmod = textToStr(qmodOf(v));
+                             String qtext = textToStr(qtextOf(v));
+                             Text pos = textHw;
+                             
+                             while (pos+1 < savedText && *qmod!=0) {
+                                  text[pos++] = *qmod++;
                               }
                               if (pos+1 < savedText) {
                                   text[pos++] = '.';
                               }
-                              t = qtextOf(v);
-                              while (pos+1 < savedText && text[t]!=0) {
-                                  text[pos++] = text[t++];
+                              while (pos+1 < savedText && *qtext!=0) {
+                                  text[pos++] = *qtext++;
                               }
                               text[pos] = '\0';
                               return text+textHw;
@@ -513,8 +514,8 @@ Text t; {
             newTab[i].inUse = FALSE;                                    \
             newTab[i].nextFree = i-1+TAB_BASE_ADDR;                     \
          }                                                              \
-          fprintf(stderr, "Expanding " #type_name                     \
-                    "table to size %d\n", newSz );                    \
+         /* fprintf(stderr, "Expanding " #type_name                     \
+           "table to size %d\n", newSz );*/                    \
          newTab[tab_size].nextFree = TAB_BASE_ADDR-1;                   \
          free_list = newSz-1+TAB_BASE_ADDR;                             \
          tab_size = newSz;                                              \
@@ -1609,7 +1610,7 @@ void nukeModule ( Module m )
    ObjectCode* oc2;
    Int         i;
 assert(isModule(m));
-fprintf(stderr, "NUKEMODULE `%s'\n", textToStr(module(m).text));
+/*fprintf(stderr, "NUKEMODULE `%s'\n", textToStr(module(m).text)); */
    oc = module(m).object;
    while (oc) {
       oc2 = oc->next;
@@ -1717,7 +1718,7 @@ Void setCurrModule(m)              /* set lookup tables for current module */
 Module m; {
     Int i;
     assert(isModule(m));
-fprintf(stderr, "SET CURR MODULE %s\n", textToStr(module(m).text));
+    /* fprintf(stderr, "SET CURR MODULE %s %d\n", textToStr(module(m).text),m);*/
     {List t;
      for (t = module(m).names; nonNull(t); t=tl(t))
         assert(isName(hd(t)));
@@ -1993,12 +1994,14 @@ Cell n; {                               /* it was a cell ref, but don't    */
 }
 
 Void garbageCollect()     {             /* Run garbage collector ...       */
-    Bool breakStat = breakOn(FALSE);    /* disable break checking          */
+                                        /* disable break checking          */
     Int i,j;
     register Int mask;
     register Int place;
     Int      recovered;
     jmp_buf  regs;                      /* save registers on stack         */
+    HugsBreakAction oldBrk
+       = setBreakAction ( HugsIgnoreBreak );
 fprintf ( stderr, "wa-hey!  garbage collection!  too difficult!  bye!\n" );
 exit(0);
     setjmp(regs);
@@ -2032,7 +2035,7 @@ exit(0);
     }
 
     gcRecovered(recovered);
-    breakOn(breakStat);                 /* restore break trapping if nec.  */
+    setBreakAction ( oldBrk );
 
     everybody(GCDONE);