X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstorage.h;h=da74ecb2bf0cc3124d2aff780ada97983e1b2418;hb=170d1670295c7cb9731f8d0eb034cf21f3e613ee;hp=7cb8c411c557ffcc3532bb4b813103ca57777a19;hpb=b9ad54f9b2bb99d2d3d62c61e2da71e076938f18;p=ghc-hetmet.git

diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h
index 7cb8c41..da74ecb 100644
--- a/ghc/interpreter/storage.h
+++ b/ghc/interpreter/storage.h
@@ -3,14 +3,15 @@
  * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair,
  * Triple, ...
  *
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved.  It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
  *
  * $RCSfile: storage.h,v $
- * $Revision: 1.6 $
- * $Date: 1999/04/27 10:07:06 $
+ * $Revision: 1.10 $
+ * $Date: 1999/10/16 02:17:25 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
@@ -62,6 +63,7 @@ extern  Bool         inventedText       Args((Text));
  * qualified or unqualified.
  */
 extern  String       identToStr         Args((Cell));
+extern	Text	     fixLitText	 	Args((Text));
 extern  Syntax       identSyntax        Args((Cell));
 extern  Syntax       defaultSyntax      Args((Text));
 
@@ -132,7 +134,7 @@ extern  Cell         whatIs    Args((Cell));
  * ------------------------------------------------------------------------*/
 
 #define TAGMIN       1            /* Box and constructor cell tag values   */
-#define BCSTAG       20           /* Box=TAGMIN..BCSTAG-1                  */
+#define BCSTAG       30           /* Box=TAGMIN..BCSTAG-1                  */
 #define isTag(c)     (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values       */
 #define isBoxTag(c)  (TAGMIN<=(c) && (c)<BCSTAG)  /* Box cell tag values   */
 #define isConTag(c)  (BCSTAG<=(c) && (c)<SPECMIN) /* Constr cell tag values*/
@@ -150,12 +152,37 @@ extern  Cell         whatIs    Args((Cell));
 #define BIGCELL      16           /* Integer literal:         snd :: Text  */
 #if PTR_ON_HEAP
 #define PTRCELL      17           /* C Heap Pointer           snd :: Ptr   */
+#if IPARAM
+#define IPCELL       19		  /* Imp Param Cell:	      snd :: Text  */
+#define IPVAR	     20		  /* ?x:		      snd :: Text  */
+#endif
+#define CPTRCELL     21           /* Native code pointer      snd :: Ptr   */
 #endif
 #if TREX
-#define EXTCOPY      18           /* Copy of an Ext:          snd :: Text  */
+#define EXTCOPY      22           /* Copy of an Ext:          snd :: Text  */
+#endif
+
+//#define textOf(c)       ((Text)(snd(c)))         /* c ::  (VAR|CON)(ID|OP) */
+
+#if 1
+static Text textOf( Cell c )
+{
+   Bool ok = 
+          (whatIs(c)==VARIDCELL
+           || whatIs(c)==CONIDCELL
+           || whatIs(c)==VAROPCELL
+           || whatIs(c)==CONOPCELL
+           || whatIs(c)==STRCELL
+           || whatIs(c)==DICTVAR
+          );
+   if (!ok) {
+fprintf(stderr, "\ntextOf -- tag %d\n",whatIs(c) );
+      assert(ok);
+   }
+   return snd(c);
+}
 #endif
 
-#define textOf(c)       ((Text)(snd(c)))         /* c ::  (VAR|CON)(ID|OP) */
 #define qmodOf(c)       (textOf(fst(snd(c))))    /* c ::  QUALIDENT        */
 #define qtextOf(c)      (textOf(snd(snd(c))))    /* c ::  QUALIDENT        */
 #define mkVar(t)        ap(VARIDCELL,t)
@@ -171,6 +198,14 @@ extern  Cell         whatIs    Args((Cell));
 #define mkDictVar(t)    ap(DICTVAR,t)
 #define inventDictVar() mkDictVar(inventDictText())
 #define mkStr(t)        ap(STRCELL,t)
+#if IPARAM
+#define mkIParam(c)	ap(IPCELL,snd(c))
+#define isIP(p)		(whatIs(p) == IPCELL)
+#define ipMatch(pi, t)	(isIP(fun(pi)) && textOf(fun(pi)) == t)
+#define ipVar(pi)	textOf(fun(pi))
+#else
+#define isIP(p)		FALSE
+#endif
 extern  Bool            isVar       Args((Cell));
 extern  Bool            isCon       Args((Cell));
 extern  Bool            isQVar      Args((Cell));
@@ -195,6 +230,9 @@ extern  String           stringNegate Args((String));
 #define isPtr(c)        (isPair(c) && fst(c)==PTRCELL)
 extern  Cell            mkPtr           Args((Ptr));
 extern  Ptr             ptrOf           Args((Cell));
+#define isCPtr(c)       (isPair(c) && fst(c)==CPTRCELL)
+extern  Cell            mkCPtr          Args((Ptr));
+extern  Ptr             cptrOf          Args((Cell));
 #endif
 
 /* --------------------------------------------------------------------------
@@ -206,67 +244,75 @@ extern  Ptr             ptrOf           Args((Cell));
  * element is a special cell will be treated as an application node.
  * ------------------------------------------------------------------------*/
 
-#define LETREC       20           /* LETREC     snd :: ([Decl],Exp)        */
-#define COND         21           /* COND       snd :: (Exp,Exp,Exp)       */
-#define LAMBDA       22           /* LAMBDA     snd :: Alt                 */
-#define FINLIST      23           /* FINLIST    snd :: [Exp]               */
-#define DOCOMP       24           /* DOCOMP     snd :: (Exp,[Qual])        */
-#define BANG         25           /* BANG       snd :: Type                */
-#define COMP         26           /* COMP       snd :: (Exp,[Qual])        */
-#define ASPAT        27           /* ASPAT      snd :: (Var,Exp)           */
-#define ESIGN        28           /* ESIGN      snd :: (Exp,Type)          */
-#define RSIGN        29           /* RSIGN      snd :: (Rhs,Type)          */
-#define CASE         30           /* CASE       snd :: (Exp,[Alt])         */
-#define NUMCASE      31           /* NUMCASE    snd :: (Exp,Disc,Rhs)      */
-#define FATBAR       32           /* FATBAR     snd :: (Exp,Exp)           */
-#define LAZYPAT      33           /* LAZYPAT    snd :: Exp                 */
-#define DERIVE       35           /* DERIVE     snd :: Cell                */
+#define LETREC       30           /* LETREC     snd :: ([Decl],Exp)        */
+#define COND         31           /* COND       snd :: (Exp,Exp,Exp)       */
+#define LAMBDA       32           /* LAMBDA     snd :: Alt                 */
+#define FINLIST      33           /* FINLIST    snd :: [Exp]               */
+#define DOCOMP       34           /* DOCOMP     snd :: (Exp,[Qual])        */
+#define BANG         35           /* BANG       snd :: Type                */
+#define COMP         36           /* COMP       snd :: (Exp,[Qual])        */
+#define ASPAT        37           /* ASPAT      snd :: (Var,Exp)           */
+#define ESIGN        38           /* ESIGN      snd :: (Exp,Type)          */
+#define RSIGN        39           /* RSIGN      snd :: (Rhs,Type)          */
+#define CASE         40           /* CASE       snd :: (Exp,[Alt])         */
+#define NUMCASE      41           /* NUMCASE    snd :: (Exp,Disc,Rhs)      */
+#define FATBAR       42           /* FATBAR     snd :: (Exp,Exp)           */
+#define LAZYPAT      43           /* LAZYPAT    snd :: Exp                 */
+#define DERIVE       45           /* DERIVE     snd :: Cell                */
 #if BREAK_FLOATS
-#define FLOATCELL    36           /* FLOATCELL  snd :: (Int,Int)           */
+#define FLOATCELL    46           /* FLOATCELL  snd :: (Int,Int)           */
 #endif
 
-#define BOOLQUAL     39           /* BOOLQUAL   snd :: Exp                 */
-#define QWHERE       40           /* QWHERE     snd :: [Decl]              */
-#define FROMQUAL     41           /* FROMQUAL   snd :: (Exp,Exp)           */
-#define DOQUAL       42           /* DOQUAL     snd :: Exp                 */
-#define MONADCOMP    43           /* MONADCOMP  snd :: ((m,m0),(Exp,[Qual])*/
+#define BOOLQUAL     49           /* BOOLQUAL   snd :: Exp                 */
+#define QWHERE       50           /* QWHERE     snd :: [Decl]              */
+#define FROMQUAL     51           /* FROMQUAL   snd :: (Exp,Exp)           */
+#define DOQUAL       52           /* DOQUAL     snd :: Exp                 */
+#define MONADCOMP    53           /* MONADCOMP  snd :: ((m,m0),(Exp,[Qual])*/
 
-#define GUARDED      44           /* GUARDED    snd :: [guarded exprs]     */
+#define GUARDED      54           /* GUARDED    snd :: [guarded exprs]     */
 
-#define ARRAY        45           /* Array      snd :: (Bounds,[Values])   */
-#define MUTVAR       46           /* Mutvar     snd :: Cell                */
+#define ARRAY        55           /* Array      snd :: (Bounds,[Values])   */
+#define MUTVAR       56           /* Mutvar     snd :: Cell                */
 #if INTERNAL_PRIMS
-#define HUGSOBJECT   47           /* HUGSOBJECT snd :: Cell                */
+#define HUGSOBJECT   57           /* HUGSOBJECT snd :: Cell                */
+#endif
+
+#if IPARAM
+#define WITHEXP      58 	  /* WITHEXP    snd :: [(Var,Exp)]	   */
 #endif
 
-#define POLYTYPE     50           /* POLYTYPE   snd :: (Kind,Type)         */
-#define QUAL         51           /* QUAL       snd :: ([Classes],Type)    */
-#define RANK2        52           /* RANK2      snd :: (Int,Type)          */
-#define EXIST        53           /* EXIST      snd :: (Int,Type)          */
-#define POLYREC      54           /* POLYREC    snd :: (Int,Type)          */
-#define BIGLAM       55           /* BIGLAM     snd :: (vars,patterns)     */
-#define CDICTS       56           /* CDICTS     snd :: ([Pred],Type)       */
-
-#define LABC         60           /* LABC       snd :: (con,[(Vars,Type)]) */
-#define CONFLDS      61           /* CONFLDS    snd :: (con,[Field])       */
-#define UPDFLDS      62           /* UPDFLDS    snd :: (Exp,[con],[Field]) */
+
+#define POLYTYPE     60           /* POLYTYPE   snd :: (Kind,Type)         */
+#define QUAL         61           /* QUAL       snd :: ([Classes],Type)    */
+#define RANK2        62           /* RANK2      snd :: (Int,Type)          */
+#define EXIST        63           /* EXIST      snd :: (Int,Type)          */
+#define POLYREC      64           /* POLYREC    snd :: (Int,Type)          */
+#define BIGLAM       65           /* BIGLAM     snd :: (vars,patterns)     */
+#define CDICTS       66           /* CDICTS     snd :: ([Pred],Type)       */
+
+#define LABC         67           /* LABC       snd :: (con,[(Vars,Type)]) */
+#define CONFLDS      68           /* CONFLDS    snd :: (con,[Field])       */
+#define UPDFLDS      69           /* UPDFLDS    snd :: (Exp,[con],[Field]) */
 #if TREX
-#define RECORD       63           /* RECORD     snd :: [Val]               */
-#define EXTCASE      64           /* EXTCASE    snd :: (Exp,Disc,Rhs)      */
-#define RECSEL       65           /* RECSEL     snd :: Ext                 */
+#define RECORD       70           /* RECORD     snd :: [Val]               */
+#define EXTCASE      71           /* EXTCASE    snd :: (Exp,Disc,Rhs)      */
+#define RECSEL       72           /* RECSEL     snd :: Ext                 */
 #endif
-#define IMPDEPS      68           /* IMPDEPS    snd :: [Binding]           */
+#define IMPDEPS      73           /* IMPDEPS    snd :: [Binding]           */
+
+#define QUALIDENT    74           /* Qualified identifier  snd :: (Id,Id)  */
+#define HIDDEN       75           /* hiding import list    snd :: [Entity] */
+#define MODULEENT    76           /* module in export list snd :: con      */
 
-#define QUALIDENT    70           /* Qualified identifier  snd :: (Id,Id)  */
-#define HIDDEN       71           /* hiding import list    snd :: [Entity] */
-#define MODULEENT    72           /* module in export list snd :: con      */
+#define INFIX        77           /* INFIX      snd :: (see tidyInfix)     */
+#define ONLY         78           /* ONLY       snd :: Exp                 */
+#define NEG          79           /* NEG        snd :: Exp                 */
 
-#define INFIX        80           /* INFIX      snd :: (see tidyInfix)     */
-#define ONLY         81           /* ONLY       snd :: Exp                 */
-#define NEG          82           /* NEG        snd :: Exp                 */
+/* Used when parsing GHC interface files */
+#define DICTAP       80          /* DICTTYPE   snd :: (QClassId,[Type])   */
 
 #if SIZEOF_INTP != SIZEOF_INT
-#define PTRCELL      90           /* C Heap Pointer snd :: (Int,Int)       */
+#define PTRCELL      81           /* C Heap Pointer snd :: (Int,Int)       */
 #endif
 
 #define STGVAR       92           /* STGVAR     snd :: (StgRhs,info)       */
@@ -362,6 +408,26 @@ extern Ext           mkExt Args((Text));
 #define mkOffset(o)  (OFFMIN+(o))
 
 /* --------------------------------------------------------------------------
+ * Object symbols:
+ * ------------------------------------------------------------------------*/
+
+/* An entry in a very crude object symbol table */
+typedef struct { char* nm; void* ad; } 
+   OSym;
+
+/* Indication of section kinds for loaded objects.  Needed by
+   the GC for deciding whether or not a pointer on the stack
+   is a code pointer.
+*/
+typedef enum { HUGS_DL_SECTION_CODE_OR_RODATA,
+               HUGS_DL_SECTION_RWDATA,
+               HUGS_DL_SECTION_OTHER } 
+   DLSect;
+
+typedef struct { void* start; void* end; DLSect sect; } 
+   DLTabEnt;
+
+/* --------------------------------------------------------------------------
  * Modules:
  * ------------------------------------------------------------------------*/
 
@@ -392,7 +458,20 @@ struct Module {
      * evaluating an expression in the context of the current module.
      */
     List  qualImports;
-    ObjectFile objectFile; /* usually unused */
+
+    /* ptr to malloc'd lump of memory holding the obj file */
+    void* oImage;
+
+    /* ptr to object symbol table; lives in mallocville.  
+       Dynamically expands. */
+    OSym* oTab;
+    Int   sizeoTab;
+    Int   usedoTab;
+
+    /* The section-kind entries for this object module.  Dynamically expands. */    
+    DLTabEnt* dlTab;
+    Int       sizedlTab;
+    Int       useddlTab;        
 };
 
 extern Module currentModule;           /* Module currently being processed */
@@ -404,6 +483,14 @@ extern Module findModule    Args((Text));
 extern Module findModid     Args((Cell));
 extern Void   setCurrModule Args((Module));
 
+extern void      addOTabName     Args((Module,char*,void*));
+extern void*     lookupOTabName  Args((Module,char*));
+extern char*     nameFromOPtr    Args((void*));
+
+extern void      addDLSect    Args((Module,void*,void*,DLSect));
+extern DLSect    lookupDLSect Args((void*));
+
+
 #define isPrelude(m) (m==modulePrelude)
 
 /* --------------------------------------------------------------------------
@@ -416,16 +503,16 @@ extern Void   setCurrModule Args((Module));
 #define tycon(n)     tabTycon[(n)-TYCMIN]
 
 struct strTycon {
-    Text  text;
-    Int   line;
+    Text   text;
+    Int    line;
     Module mod;                         /* module that defines it          */
-    Int   arity;
-    Kind  kind;                         /* kind (includes arity) of Tycon  */
-    Cell  what;                         /* DATATYPE/SYNONYM/RESTRICTSYN... */
-    Cell  defn;
-    Name  conToTag;                     /* used in derived code            */
-    Name  tagToCon;
-    Tycon nextTyconHash;
+    Int    arity;
+    Kind   kind;                        /* kind (includes arity) of Tycon  */
+    Cell   what;                        /* DATATYPE/SYNONYM/RESTRICTSYN... */
+    Cell   defn;
+    Name   conToTag;                    /* used in derived code            */
+    Name   tagToCon;
+    Tycon  nextTyconHash;
 };
 
 extern struct strTycon DECTABLE(tabTycon);
@@ -437,8 +524,10 @@ extern Tycon findQualTycon Args((Cell));
 extern Tycon addPrimTycon Args((Text,Kind,Int,Cell,Cell));
 
 #define isSynonym(h)    (isTycon(h) && tycon(h).what==SYNONYM)
+#define isQualType(t)	(isPair(t) && fst(t)==QUAL)
 #define mkPolyType(n,t) pair(POLYTYPE,pair(n,t))
 #define isPolyType(t)   (isPair(t) && fst(t)==POLYTYPE)
+#define isPolyOrQualType(t) (isPair(t) && (fst(t)==POLYTYPE || fst(t)==QUAL))
 #define polySigOf(t)    fst(snd(t))
 #define monotypeOf(t)   snd(snd(t))
 
@@ -511,6 +600,7 @@ extern Name   addPrimCfun     Args((Text,Int,Int,Cell));
 extern Name   addPrimCfunREP  Args((Text,Int,Int,Int));
 extern Int    sfunPos         Args((Name,Name));
 extern Name   nameFromStgVar  Args((Cell));
+extern Name   jrsFindQualName Args((Text,Text));
 
 /* --------------------------------------------------------------------------
  * Type class values:
@@ -523,15 +613,15 @@ extern Name   nameFromStgVar  Args((Cell));
 #define inst(in)     tabInst[(in)-INSTMIN]
 
 struct strInst {
-    Class c;                            /* class C                         */
-    Int   line;
-  //Module mod;                         /* module that defines it          */
-    Kinds kinds;                        /* Kinds of variables in head      */
-    Cell  head;                         /* :: Pred                         */
-    List  specifics;                    /* :: [Pred]                       */
-    Int   numSpecifics;                 /* length(specifics)               */
-    List  implements;
-    Name  builder;                      /* Dictionary constructor function */
+    Class  c;                           /* class C                         */
+    Int    line;
+    Module mod;                         /* module that defines it          */
+    Kinds  kinds;                       /* Kinds of variables in head      */
+    Cell   head;                        /* :: Pred                         */
+    List   specifics;                   /* :: [Pred]                       */
+    Int    numSpecifics;                /* length(specifics)               */
+    List   implements;
+    Name   builder;                     /* Dictionary constructor function */
 };
 
 /* a predicate (an element :: Pred) is an application of a Class to one or
@@ -550,6 +640,7 @@ struct strClass {
     Int    level;                       /* Level in class hierarchy        */
     Int    arity;                       /* Number of arguments             */
     Kinds  kinds;                       /* Kinds of constructors in class  */
+    List   fds;				/* Functional Dependencies	   */
     Cell   head;                        /* Head of class                   */
     Name   dcon;                        /* Dictionary constructor function */
     List   supers;                      /* :: [Pred]                       */
@@ -557,7 +648,6 @@ struct strClass {
     List   dsels;                       /* Superclass dictionary selectors */
     List   members;                     /* :: [Name]                       */
     Int    numMembers;                  /* length(members)                 */
-    Name   dbuild;                      /* Default dictionary builder      */
     List   defaults;                    /* :: [Name]                       */
     List   instances;                   /* :: [Inst]                       */
 };
@@ -646,6 +736,7 @@ extern  List         splitAt      Args((Int,List));     /* non-destructive */
 extern  Cell         nth          Args((Int,List));
 extern  List         removeCell   Args((Cell,List));    /* destructive     */
 extern  List         dupListOnto  Args((List,List));    /* non-destructive */ 
+extern  List         nubList      Args((List));         /* non-destructive */
 
 /* The following macros provide `inline expansion' of some common ways of
  * traversing, using and modifying lists:
@@ -714,7 +805,7 @@ extern  StackPtr sp;
     chkStack(1);     \
     onto(c);         \
   } while (0)
-#define onto(c)      stack(++sp)=(c)
+#define onto(c)      stack(++sp)=(c);
 #define pop()        stack(sp--)
 #define drop()       sp--
 #define top()        stack(sp)
@@ -724,6 +815,15 @@ extern  StackPtr sp;
 
 extern  Void hugsStackOverflow Args((Void));
 
+#if SYMANTEC_C
+#include <Memory.h>
+#define STACK_HEADROOM 16384
+#define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \
+		      internal("Macintosh function parameter stack overflow.");
+#else
+#define STACK_CHECK
+#endif
+
 /* --------------------------------------------------------------------------
  * Script file control:
  * The implementation of script file storage is hidden.