X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstorage.h;h=0cbf7df748991aabe2e18266adaf374abbbd8d44;hb=087fdd53c7d6bb6cb17574133abc2de4f1816c7e;hp=747cbee9ffb04b3151d04381329ef35f5b680c99;hpb=e3bb5d64a61847a306ef38f14b39768adb721cf6;p=ghc-hetmet.git diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h index 747cbee..0cbf7df 100644 --- a/ghc/interpreter/storage.h +++ b/ghc/interpreter/storage.h @@ -10,11 +10,12 @@ * included in the distribution. * * $RCSfile: storage.h,v $ - * $Revision: 1.36 $ - * $Date: 2000/03/23 14:54:21 $ + * $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: @@ -59,9 +60,9 @@ typedef Cell ConVarId; * -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 * CHARR_MIN(3,000) .. CHARR_MAX(3,255) chars * @@ -146,7 +147,6 @@ extern Syntax syntaxOf ( Text ); * ------------------------------------------------------------------------*/ #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell))) -#define heapBuilt() (heapFst) extern Int heapSize; extern Heap heapFst, heapSnd; extern Heap heapTopFst; @@ -160,12 +160,7 @@ extern Int cellsRecovered; /* cells recovered by last gc */ 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)) @@ -201,7 +196,7 @@ extern Cell whatIs ( Cell ); * ------------------------------------------------------------------------*/ #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 */ @@ -214,16 +209,17 @@ extern Cell whatIs ( Cell ); #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 */ @@ -271,19 +267,22 @@ extern Text textOf ( Cell ); #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) */ @@ -449,6 +448,7 @@ extern Ptr cptrOf ( Cell ); #define ZTUP4 297 /* snd :: (Cell,(Cell,(Cell,Cell))) */ #define ZTUP5 298 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */ +#define MDOCOMP 299 /* MDOCOMP snd :: (Exp,[Qual]) */ /* -------------------------------------------------------------------------- @@ -456,7 +456,7 @@ extern Ptr cptrOf ( Cell ); * ------------------------------------------------------------------------*/ #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) @@ -499,6 +499,10 @@ extern Ptr cptrOf ( Cell ); #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: @@ -594,6 +598,9 @@ struct strModule { 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 */ @@ -601,8 +608,8 @@ struct strModule { 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. */ @@ -620,7 +627,7 @@ extern Module currentModule; /* Module currently being processed */ 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 ); @@ -628,6 +635,12 @@ extern Void nukeModule ( Module ); 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* ); @@ -635,7 +648,8 @@ extern char* nameFromOPtr ( void* ); 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) @@ -683,17 +697,22 @@ struct strTycon { 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) @@ -706,6 +725,9 @@ extern Tycon addPrimTycon ( Text,Kind,Int,Cell,Cell ); extern Tycon findQualTyconWithoutConsultingExportList ( QualId q ); +extern Int numQualifiers ( Type ); + + /* -------------------------------------------------------------------------- * Globally defined name values: * ------------------------------------------------------------------------*/ @@ -738,10 +760,13 @@ struct strName { 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; }; @@ -786,7 +811,6 @@ extern Name findQualName ( Cell ); 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 ); @@ -1064,6 +1088,7 @@ extern StackPtr sp; #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 );