* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.35 $
- * $Date: 2000/03/22 18:14:23 $
+ * $Revision: 1.45 $
+ * $Date: 2000/04/27 16:35:29 $
* ------------------------------------------------------------------------*/
-#define DEBUG_STORAGE
+#define DEBUG_STORAGE /* a moderate level of sanity checking */
+#define DEBUG_STORAGE_EXTRA /* max paranoia in sanity checks */
/* --------------------------------------------------------------------------
* Typedefs for main data types:
* -heapSize .. -1 cells in the heap
* 0 NIL
*
- * TAG_NONPTR_MIN(100) .. TAG_NONPTR_MAX(115) non pointer tags
+ * TAG_NONPTR_MIN(100) .. TAG_NONPTR_MAX(116) non pointer tags
* TAG_PTR_MIN(200) .. TAG_PTR_MAX(298) pointer tags
- * TAG_SPEC_MIN(400) .. TAG_SPEC_MAX(425) special tags
+ * TAG_SPEC_MIN(400) .. TAG_SPEC_MAX(431) special tags
* OFF_MIN(1,000) .. OFF_MAX(1,999) offsets
- * CHAR_MIN(3,000) .. CHAR_MAX(3,255) chars
+ * CHARR_MIN(3,000) .. CHARR_MAX(3,255) chars
*
* SMALL_INT_MIN(100,000) .. SMALL_INT_MAX(499,999) smallish ints
* (300,000 denotes 0)
* ------------------------------------------------------------------------*/
#define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell)))
-#define heapBuilt() (heapFst)
extern Int heapSize;
extern Heap heapFst, heapSnd;
extern Heap heapTopFst;
extern Pair pair ( Cell,Cell );
extern Void garbageCollect ( Void );
-
-extern Void overwrite ( Pair,Pair );
-extern Cell markExpr ( Cell );
-extern Void markWithoutMove ( Cell );
-
-#define mark(v) v=markExpr(v)
+extern Void mark ( Cell );
#define isPair(c) ((c)<0)
#define isGenPair(c) ((c)<0 && -heapSize<=(c))
* ------------------------------------------------------------------------*/
#define TAG_NONPTR_MIN 100
-#define TAG_NONPTR_MAX 115
+#define TAG_NONPTR_MAX 116
#define FREECELL 100 /* Free list cell: snd :: Cell */
#define VARIDCELL 101 /* Identifier variable: snd :: Text */
#define ADDPAT 108 /* (_+k) pattern discr: snd :: Int */
#define FLOATCELL 109 /* Floating Pt literal: snd :: Text */
#define BIGCELL 110 /* Integer literal: snd :: Text */
-#define PTRCELL 111 /* C Heap Pointer snd :: Ptr */
-#define CPTRCELL 112 /* Native code pointer snd :: Ptr */
+#define ADDRCELL 111 /* Address literal snd :: Ptr */
+#define MPTRCELL 112 /* C (malloc) Heap Pointer snd :: Ptr */
+#define CPTRCELL 113 /* Closure pointer snd :: Ptr */
#if IPARAM
-#define IPCELL 113 /* Imp Param Cell: snd :: Text */
-#define IPVAR 114 /* ?x: snd :: Text */
+#define IPCELL 114 /* Imp Param Cell: snd :: Text */
+#define IPVAR 115 /* ?x: snd :: Text */
#endif
#if TREX
-#define EXTCOPY 115 /* Copy of an Ext: snd :: Text */
+#define EXTCOPY 116 /* Copy of an Ext: snd :: Text */
#endif
#define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */
#define stringToBignum(s) pair(BIGCELL,findText(s))
#define bignumToString(b) textToStr(snd(b))
-#define isPtr(c) (isPair(c) && fst(c)==PTRCELL)
-extern Cell mkPtr ( Ptr );
-extern Ptr ptrOf ( Cell );
+#define isMPtr(c) (isPair(c) && fst(c)==MPTRCELL)
+extern Cell mkMPtr ( Ptr );
+extern Ptr mptrOf ( Cell );
#define isCPtr(c) (isPair(c) && fst(c)==CPTRCELL)
extern Cell mkCPtr ( Ptr );
extern Ptr cptrOf ( Cell );
+#define isAddr(c) (isPair(c) && fst(c)==ADDRCELL)
+extern Cell mkAddr ( Ptr );
+extern Ptr addrOf ( Cell );
/* --------------------------------------------------------------------------
* Tags for pointer cells.
* ------------------------------------------------------------------------*/
#define TAG_PTR_MIN 200
-#define TAG_PTR_MAX 298
+#define TAG_PTR_MAX 299
#define LETREC 200 /* LETREC snd :: ([Decl],Exp) */
#define COND 201 /* COND snd :: (Exp,Exp,Exp) */
#define ZTUP4 297 /* snd :: (Cell,(Cell,(Cell,Cell))) */
#define ZTUP5 298 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */
+#define MDOCOMP 299 /* MDOCOMP snd :: (Exp,[Qual]) */
/* --------------------------------------------------------------------------
* ------------------------------------------------------------------------*/
#define TAG_SPEC_MIN 400
-#define TAG_SPEC_MAX 428
+#define TAG_SPEC_MAX 431
#define isSpec(c) (TAG_SPEC_MIN<=(c) && (c)<=TAG_SPEC_MAX)
#define INVAR 427 /* whatIs code for isInventedVar */
#define INDVAR 428 /* whatIs code for isInventedDictVar */
+#define FM_SOURCE 429 /* denotes source module (FileMode) */
+#define FM_OBJECT 430 /* denotes object module */
+#define FM_EITHER 431 /* no restriction; either is allowed */
+
/* --------------------------------------------------------------------------
* Tuple data/type constructors:
List qualImports; /* Qualified imports. */
+ List codeList; /* [ Name | StgTree ] before code generation,
+ [ Name | CPtr ] afterwards */
+
Bool fake; /* TRUE if module exists only via GHC primop */
/* defn; usually FALSE */
Bool completed; /* Fully loaded or just parsed? */
Time lastStamp; /* Time of last parse */
- Bool fromSrc; /* is it from source ? */
- Text srcExt; /* if yes, ".lhs", ".hs", etc" */
+ Cell mode; /* FM_SOURCE or FM_OBJECT */
+ Text srcExt; /* if mode==FM_SOURCE ".lhs", ".hs", etc */
List uses; /* :: [CONID] -- names of mods imported by this one */
Text objName; /* Name of the primary object code file. */
extern List moduleGraph; /* :: [GRP_REC | GRP_NONREC] */
extern List prelModules; /* :: [CONID] */
extern List targetModules; /* :: [CONID] */
-
+extern Bool nukeModule_needs_major_gc; /* see comment in compiler.c */
extern Bool isValidModule ( Module );
extern Module newModule ( Text );
extern Module findModule ( Text );
extern Module findModid ( Cell );
extern Void setCurrModule ( Module );
+extern void addToCodeList ( Module, Cell );
+extern void setNameOrTupleClosure ( Cell c, Cell closure );
+extern Cell getNameOrTupleClosure ( Cell c );
+extern void setNameOrTupleClosureCPtr ( Cell c,
+ void* /* StgClosure* */ cptr );
+
extern void addOTabName ( Module,char*,void* );
extern void* lookupOTabName ( Module,char* );
extern void addSection ( Module,void*,void*,OSectionKind );
extern OSectionKind lookupSection ( void* );
-extern void* lookupOExtraTabName ( char* sym );
+extern void* lookupOExtraTabName ( char* sym );
+extern void* lookupOTabNameAbsolutelyEverywhere ( char* sym );
#define isPrelude(m) (m==modulePrelude)
Name conToTag; /* used in derived code */
Name tagToCon;
void* itbl; /* For tuples, the info tbl pointer */
+ Cell closure; /* Either StgTree, or (later) CPtr, which is the
+ address in the evaluator's heap. Only Tuples
+ use the closure field; all other tycons which
+ require actual code have associated name table
+ entries. */
Tycon nextTyconHash;
};
extern struct strTycon* tabTycon;
extern Int tabTyconSz;
-extern Tycon newTycon ( Text );
-extern Tycon findTycon ( Text );
-extern Tycon addTycon ( Tycon );
+extern Tycon newTycon ( Text );
+extern Tycon findTycon ( Text );
+extern Tycon addTycon ( Tycon );
extern Tycon findQualTycon ( Cell );
-extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell );
+extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell );
#define isSynonym(h) (isTycon(h) && tycon(h).what==SYNONYM)
#define isQualType(t) (isPair(t) && fst(t)==QUAL)
extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
+extern Int numQualifiers ( Type );
+
+
/* --------------------------------------------------------------------------
* Globally defined name values:
* ------------------------------------------------------------------------*/
Int number;
Cell type;
Cell defn;
- Cell stgVar; /* really StgVar */
+ Bool hasStrict; /* does constructor have strict components? */
Text callconv; /* for foreign import/export */
void* primop; /* really StgPrim* */
void* itbl; /* For constructors, the info tbl pointer */
+ Cell closure; /* Either StgTree, or (later) Ptr, an AsmBCO/
+ AsmCAF/AsmCon thing, or CPtr, which is the
+ address in the evaluator's heap */
Name nextNameHash;
};
extern Name addPrimCfun ( Text,Int,Int,Cell );
extern Name addPrimCfunREP ( Text,Int,Int,Int );
extern Int sfunPos ( Name,Name );
-extern Name nameFromStgVar ( Cell );
extern Name jrsFindQualName ( Text,Text );
extern Name findQualNameWithoutConsultingExportList ( QualId q );
* ------------------------------------------------------------------------*/
/* I think this assumes that NUM_CHARS==256. */
-#define CHAR_MIN 3000
-#define CHAR_MAX 3255
-#define isChar(c) (CHAR_MIN<=(c) && (c)<=CHAR_MAX)
-#define charOf(c) ((Char)((c)-CHAR_MIN))
-#define mkChar(c) (CHAR_MIN+(((Cell)(c)) & 0xFF))
+#define CHARR_MIN 3000
+#define CHARR_MAX 3255
+#define isChar(c) (CHARR_MIN<=(c) && (c)<=CHARR_MAX)
+#define charOf(c) ((Char)((c)-CHARR_MIN))
+#define mkChar(c) (CHARR_MIN+(((Cell)(c)) & 0xFF))
#define MAXCHARVAL (NUM_CHARS-1)
/* --------------------------------------------------------------------------
#define pushed(n) stack(sp-(n))
#define topfun(f) top()=ap((f),top())
#define toparg(x) top()=ap(top(),(x))
+#define getsp() sp
extern Void hugsStackOverflow ( Void );
projects / ghc-hetmet.git / blobdiff