/* -------------------------------------------------------------------------- * Defines storage datatypes: Text, Name, Module, Tycon, Cell, List, Pair, * Triple, ... * * 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.45 $ * $Date: 2000/04/27 16:35:29 $ * ------------------------------------------------------------------------*/ #define DEBUG_STORAGE /* a moderate level of sanity checking */ #define DEBUG_STORAGE_EXTRA /* max paranoia in sanity checks */ /* -------------------------------------------------------------------------- * Typedefs for main data types: * Many of these type names are used to indicate the intended us of a data * item, rather than for type checking purposes. Sadly (although sometimes, * fortunately), the C compiler cannot distinguish between the use of two * different names defined to be synonyms for the same types. * ------------------------------------------------------------------------*/ typedef Int Text; /* text string */ typedef Unsigned Syntax; /* syntax (assoc,preced) */ typedef Int Cell; /* general cell value */ typedef Cell far *Heap; /* storage of heap */ typedef Cell Pair; /* pair cell */ typedef Int StackPtr; /* stack pointer */ typedef Cell Offset; /* offset/generic variable*/ typedef Int Module; /* module */ typedef Cell Tycon; /* type constructor */ typedef Cell Type; /* type expression */ typedef Cell Kind; /* kind expression */ typedef Cell Kinds; /* list of kinds */ typedef Cell Constr; /* constructor expression */ typedef Cell Name; /* named value */ typedef Cell Class; /* type class */ typedef Cell Inst; /* instance of type class */ typedef Cell Triple; /* triple of cell values */ typedef Cell List; /* list of cells */ typedef Cell Bignum; /* bignum integer */ typedef Cell Float; /* floating pt literal */ #if TREX typedef Cell Ext; /* extension label */ #endif typedef Cell ConId; typedef Cell VarId; typedef Cell QualId; typedef Cell ConVarId; /* -------------------------------------------------------------------------- * Address ranges. * * -heapSize .. -1 cells in the heap * 0 NIL * * 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(431) special tags * OFF_MIN(1,000) .. OFF_MAX(1,999) offsets * 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) * * NAME_BASE_ADDR (1,000,000 .. 1,899,999) names * TYCON_BASE_ADDR (2,000,000 .. 2,899,999) tycons * CCLASS_BASE_ADDR (3,000,000 .. 3,899,999) classes * INST_BASE_ADDR (4,000,000 .. 4,899,999) instances * MODULE_BASE_ADDR (5,000,000 .. 5,899,999) modules * INVAR_BASE_ADDR (6,000,000 .. 6,899,999) invented var names * INDVAR_BASE_ADDR (7,000,000 .. 7,899,999) invented dict var names * TEXT_BASE_ADDR (8,000,000 .. 8M +TEXT_SIZE-1) text * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * Text storage: * provides storage for the characters making up identifier and symbol * names, string literals, character constants etc... * ------------------------------------------------------------------------*/ extern String textToStr ( Text ); extern Text findText ( String ); extern Text inventText ( Void ); extern Text inventDictText ( Void ); extern Bool inventedText ( Text ); extern Text enZcodeThenFindText ( String ); extern Text unZcodeThenFindText ( String ); /* Variants of textToStr and syntaxOf which work for idents, ops whether * qualified or unqualified. */ extern String identToStr ( Cell ); extern Text fixLitText ( Text ); extern Syntax identSyntax ( Cell ); extern Syntax defaultSyntax ( Text ); #define INVAR_BASE_ADDR 6000000 #define INVAR_MAX_AVAIL 900000 #define isInventedVar(c) (INVAR_BASE_ADDR<=(c) \ && (c)>2) #define mkSyntax(a,p) ((a)|((p)<<2)) #define DEF_OPSYNTAX mkSyntax(DEF_ASS,DEF_PREC) #define NO_SYNTAX (-1) extern Void addSyntax ( Int,Text,Syntax ); extern Syntax syntaxOf ( Text ); /* -------------------------------------------------------------------------- * Heap storage: * Provides a garbage collectable heap for storage of expressions etc. * ------------------------------------------------------------------------*/ #define heapAlloc(s) (Heap)(farCalloc(s,sizeof(Cell))) extern Int heapSize; extern Heap heapFst, heapSnd; extern Heap heapTopFst; extern Heap heapTopSnd; extern Bool consGC; /* Set to FALSE to turn off gc from*/ /* C stack; use with extreme care! */ extern Int cellsRecovered; /* cells recovered by last gc */ #define fst(c) heapTopFst[c] #define snd(c) heapTopSnd[c] extern Pair pair ( Cell,Cell ); extern Void garbageCollect ( Void ); extern Void mark ( Cell ); #define isPair(c) ((c)<0) #define isGenPair(c) ((c)<0 && -heapSize<=(c)) extern Cell whatIs ( Cell ); /* -------------------------------------------------------------------------- * Pairs in the heap fall into three categories. * * pair(TAG_NONPTR,y) * used to denote that the second element of the pair is to be treated * in some special way (eg is a integer or Text), and specifically is not * a heap pointer * * pair(TAG_PTR,y) * to indicate that the second element of the pair is a normal * heap pointer, which should be followed at GC time * * pair(x,y) * is a genuine pair, where both components are heap pointers. * ------------------------------------------------------------------------*/ #if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT) #error SIZEOF_VOID_P or SIZEOF_INT is not defined #endif #define isTagNonPtr(c) (TAG_NONPTR_MIN<=(c) && (c)<=TAG_NONPTR_MAX) #define isTagPtr(c) (TAG_PTR_MIN<=(c) && (c)<=TAG_PTR_MAX) #define isTag(c) (isTagNonPtr(c) || isTagPtr(c)) /* -------------------------------------------------------------------------- * Tags for non-pointer cells. * ------------------------------------------------------------------------*/ #define TAG_NONPTR_MIN 100 #define TAG_NONPTR_MAX 116 #define FREECELL 100 /* Free list cell: snd :: Cell */ #define VARIDCELL 101 /* Identifier variable: snd :: Text */ #define VAROPCELL 102 /* Operator variable: snd :: Text */ #define DICTVAR 103 /* Dictionary variable: snd :: Text */ #define CONIDCELL 104 /* Identifier constructor: snd :: Text */ #define CONOPCELL 105 /* Operator constructor: snd :: Text */ #define STRCELL 106 /* String literal: snd :: Text */ #define INTCELL 107 /* Int literal: snd :: Int */ #define ADDPAT 108 /* (_+k) pattern discr: snd :: Int */ #define FLOATCELL 109 /* Floating Pt literal: snd :: Text */ #define BIGCELL 110 /* Integer literal: snd :: Text */ #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 114 /* Imp Param Cell: snd :: Text */ #define IPVAR 115 /* ?x: snd :: Text */ #endif #if TREX #define EXTCOPY 116 /* Copy of an Ext: snd :: Text */ #endif #define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */ #define qtextOf(c) (textOf(snd(snd(c)))) /* c :: QUALIDENT */ #define mkVar(t) ap(VARIDCELL,t) #define mkVarop(t) ap(VAROPCELL,t) #define mkCon(t) ap(CONIDCELL,t) #define mkConop(t) ap(CONOPCELL,t) #define mkQVar(m,t) ap(QUALIDENT,pair(mkCon(m),mkVar(t))) #define mkQCon(m,t) ap(QUALIDENT,pair(mkCon(m),mkCon(t))) #define mkQVarOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkVarop(t))) #define mkQConOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkConop(t))) #define mkQualId(m,t) ap(QUALIDENT,pair(m,t)) #define intValOf(c) (snd(c)) #define inventVar() mkVar(inventText()) #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 ( Cell ); extern Bool isCon ( Cell ); extern Bool isQVar ( Cell ); extern Bool isQCon ( Cell ); extern Bool isQualIdent ( Cell ); extern Bool eqQualIdent ( QualId c1, QualId c2 ); extern Bool isIdent ( Cell ); extern String stringNegate ( String ); extern Text textOf ( Cell ); #define isFloat(c) (isPair(c) && fst(c)==FLOATCELL) #define stringToFloat(s) pair(FLOATCELL,findText(s)) #define floatToString(f) textToStr(snd(f)) #define floatOf(f) atof(floatToString(f)) #define mkFloat(f) (f) /* ToDo: is this right? */ #define floatNegate(f) stringToFloat(stringNegate(floatToString(f))) #define stringToBignum(s) pair(BIGCELL,findText(s)) #define bignumToString(b) textToStr(snd(b)) #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 299 #define LETREC 200 /* LETREC snd :: ([Decl],Exp) */ #define COND 201 /* COND snd :: (Exp,Exp,Exp) */ #define LAMBDA 202 /* LAMBDA snd :: Alt */ #define FINLIST 203 /* FINLIST snd :: [Exp] */ #define DOCOMP 204 /* DOCOMP snd :: (Exp,[Qual]) */ #define BANG 205 /* BANG snd :: Type */ #define COMP 206 /* COMP snd :: (Exp,[Qual]) */ #define ASPAT 207 /* ASPAT snd :: (Var,Exp) */ #define ESIGN 208 /* ESIGN snd :: (Exp,Type) */ #define RSIGN 209 /* RSIGN snd :: (Rhs,Type) */ #define CASE 210 /* CASE snd :: (Exp,[Alt]) */ #define NUMCASE 211 /* NUMCASE snd :: (Exp,Disc,Rhs) */ #define FATBAR 212 /* FATBAR snd :: (Exp,Exp) */ #define LAZYPAT 213 /* LAZYPAT snd :: Exp */ #define DERIVE 214 /* DERIVE snd :: Cell */ #define BOOLQUAL 215 /* BOOLQUAL snd :: Exp */ #define QWHERE 216 /* QWHERE snd :: [Decl] */ #define FROMQUAL 217 /* FROMQUAL snd :: (Exp,Exp) */ #define DOQUAL 218 /* DOQUAL snd :: Exp */ #define MONADCOMP 219 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/ #define GUARDED 220 /* GUARDED snd :: [guarded exprs] */ #define ARRAY 221 /* Array snd :: (Bounds,[Values]) */ #define MUTVAR 222 /* Mutvar snd :: Cell */ #define HUGSOBJECT 223 /* HUGSOBJECT snd :: Cell */ #if IPARAM #define WITHEXP 224 /* WITHEXP snd :: [(Var,Exp)] */ #endif #define POLYTYPE 225 /* POLYTYPE snd :: (Kind,Type) */ #define QUAL 226 /* QUAL snd :: ([Classes],Type) */ #define RANK2 227 /* RANK2 snd :: (Int,Type) */ #define EXIST 228 /* EXIST snd :: (Int,Type) */ #define POLYREC 229 /* POLYREC snd :: (Int,Type) */ #define BIGLAM 230 /* BIGLAM snd :: (vars,patterns) */ #define CDICTS 231 /* CDICTS snd :: ([Pred],Type) */ #define LABC 232 /* LABC snd :: (con,[(Vars,Type)]) */ #define CONFLDS 233 /* CONFLDS snd :: (con,[Field]) */ #define UPDFLDS 234 /* UPDFLDS snd :: (Exp,[con],[Field]) */ #if TREX #define RECORD 235 /* RECORD snd :: [Val] */ #define EXTCASE 236 /* EXTCASE snd :: (Exp,Disc,Rhs) */ #define RECSEL 237 /* RECSEL snd :: Ext */ #endif #define IMPDEPS 238 /* IMPDEPS snd :: [Binding] */ #define QUALIDENT 239 /* Qualified identifier snd :: (Id,Id) */ #define HIDDEN 240 /* hiding import list snd :: [Entity] */ #define MODULEENT 241 /* module in export list snd :: con */ #define INFIX 242 /* INFIX snd :: (see tidyInfix) */ #define ONLY 243 /* ONLY snd :: Exp */ #define NEG 244 /* NEG snd :: Exp */ /* Used when parsing GHC interface files */ #define DICTAP 245 /* DICTAP snd :: (QClassId,[Type]) */ #define UNBOXEDTUP 246 /* UNBOXEDTUP snd :: [Type] */ #if SIZEOF_VOID_P != SIZEOF_INT #define PTRCELL 247 /* C Heap Pointer snd :: (Int,Int) */ #endif /* STG syntax */ #define STGVAR 248 /* STGVAR snd :: (StgRhs,info) */ #define STGAPP 249 /* STGAPP snd :: (StgVar,[Arg]) */ #define STGPRIM 250 /* STGPRIM snd :: (PrimOp,[Arg]) */ #define STGCON 251 /* STGCON snd :: (StgCon,[Arg]) */ #define PRIMCASE 252 /* PRIMCASE snd :: (Expr,[PrimAlt]) */ #define DEEFALT 253 /* DEEFALT snd :: (Var,Expr) */ #define CASEALT 254 /* CASEALT snd :: (Con,[Var],Expr) */ #define PRIMALT 255 /* PRIMALT snd :: ([Var],Expr) */ /* Module groups */ #define GRP_REC 256 /* GRP_REC snd :: [CONID] */ #define GRP_NONREC 257 /* GRP_NONREC snd :: CONID */ /* Top-level interface entities type Line = Int -- a line number type ConVarId = CONIDCELL | VARIDCELL type ExportListEntry = ConVarId | (ConId, [ConVarId]) type Associativity = mkInt of LEFT_ASS | RIGHT_ASS | NON_ASS type Constr = ((ConId, [((Type,VarId,Int))])) ((constr name, [((type, field name if any, strictness))])) strictness: 0 => none, 1 => !, 2 => !! (unpacked) All 2/3/4/5 tuples in the interface abstract syntax are done with z-tuples. */ #define I_INTERFACE 260 /* snd :: ((ConId, [I_IMPORT..I_VALUE])) interface name, list of iface entities */ #define I_IMPORT 261 /* snd :: ((ConId, [ConVarId])) module name, list of entities */ #define I_INSTIMPORT 262 /* snd :: NIL -- not used at present */ #define I_EXPORT 263 /* snd :: ((ConId, [ExportListEntry])) this module name?, entities to export */ #define I_FIXDECL 264 /* snd :: ((NIL|Int, Associativity, ConVarId)) fixity, associativity, name */ #define I_INSTANCE 265 /* snd :: ((Line, [((VarId,Kind))], Type, VarId, Inst)) lineno, forall-y bit (eg __forall [a b] =>), other bit, eg { C a1 } -> { C2 a2 } -> ... -> { Cn an }, name of dictionary builder, (after startGHCInstance) the instance table location */ #define I_TYPE 266 /* snd :: ((Line, ConId, [((VarId,Kind))], Type)) lineno, tycon, kinded tyvars, the type expr */ #define I_DATA 267 /* snd :: ((Line, [((QConId,VarId))], ConId, [((VarId,Kind))], [Constr]) lineno, context, tycon, kinded tyvars, constrs An empty constr list means exported abstractly. */ #define I_NEWTYPE 268 /* snd :: ((Line, [((QConId,VarId))], ConId, [((VarId,Kind))], ((ConId,Type)) )) lineno, context, tycon, kinded tyvars, constr constr==NIL means exported abstractly. */ #define I_CLASS 269 /* snd :: ((Line, [((QConId,VarId))], ConId, [((VarId,Kind))], [((VarId,Type))])) lineno, context, classname, kinded tyvars, method sigs */ #define I_VALUE 270 /* snd :: ((Line, VarId, Type)) */ /* Top-level module entities. type Export = ? */ #define M_MODULE 280 /* snd :: ((ConId, [Export], M_IMPORT_Q .. M_VALUE])) module name, export spec, top level entities */ #define M_IMPORT_Q 281 /* snd :: ((?,?)) */ #define M_IMPORT_UNQ 282 /* snd :: ((?,?)) */ #define M_TYCON 283 /* snd :: ((Line,?,?,?)) */ #define M_CLASS 284 /* snd :: ((Line,?,?,?)) */ #define M_INST 285 /* snd :: ((Line,?,?)) */ #define M_DEFAULT 286 /* snd :: ((Line,?)) */ #define M_FOREIGN_EX 289 /* snd :: ((Line,?,?,?,?)) */ #define M_FOREIGN_IM 290 /* snd :: ((Line,?,?,?,?)) */ #define M_VALUE 291 /* snd :: ? */ /* Tagged tuples. */ #define ZTUP2 295 /* snd :: (Cell,Cell) */ #define ZTUP3 296 /* snd :: (Cell,(Cell,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]) */ /* -------------------------------------------------------------------------- * Special cell values. * ------------------------------------------------------------------------*/ #define TAG_SPEC_MIN 400 #define TAG_SPEC_MAX 431 #define isSpec(c) (TAG_SPEC_MIN<=(c) && (c)<=TAG_SPEC_MAX) #define NONE 400 /* Dummy stub */ #define STAR 401 /* Representing the kind of types */ #if TREX #define ROW 402 /* Representing the kind of rows */ #endif #define WILDCARD 403 /* Wildcard pattern */ #define SKOLEM 404 /* Skolem constant */ #define DOTDOT 405 /* ".." in import/export list */ #define NAME 406 /* whatIs code for isName */ #define TYCON 407 /* whatIs code for isTycon */ #define CLASS 408 /* whatIs code for isClass */ #define MODULE 409 /* whatIs code for isModule */ #define INSTANCE 410 /* whatIs code for isInst */ #define TUPLE 411 /* whatIs code for tuple constructor */ #define OFFSET 412 /* whatis code for offset */ #define AP 413 /* whatIs code for application node */ #define CHARCELL 414 /* whatIs code for isChar */ #if TREX #define EXT 415 /* whatIs code for isExt */ #endif #define SIGDECL 416 /* Signature declaration */ #define FIXDECL 417 /* Fixity declaration */ #define FUNBIND 418 /* Function binding */ #define PATBIND 419 /* Pattern binding */ #define DATATYPE 420 /* Datatype type constructor */ #define NEWTYPE 421 /* Newtype type constructor */ #define SYNONYM 422 /* Synonym type constructor */ #define RESTRICTSYN 423 /* Synonym with restricted scope */ #define NODEPENDS 424 /* Stop calculation of deps in type check*/ #define PREDEFINED 425 /* Predefined name, not yet filled */ #define TEXTCELL 426 /* whatIs code for isText */ #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: * ------------------------------------------------------------------------*/ extern Text ghcTupleText ( Tycon ); extern Text ghcTupleText_n ( Int ); #if TREX #error TREX not supported #define EXTMIN 301 #define isExt(c) (EXTMIN<=(c) && (c)=0) #define tupleOf(n) (tycon(n).tuple) extern Tycon mkTuple ( Int ); struct strTycon { Bool inUse; Name nextFree; Text text; Int line; Module mod; /* module that defines it */ Int tuple; /* tuple number, or -1 if not tuple */ Int arity; Kind kind; /* kind (includes arity) of Tycon */ Cell what; /* DATATYPE/SYNONYM/RESTRICTSYN... */ Cell defn; 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 findQualTycon ( 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) #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)) #define bang(t) ap(BANG,t) extern Tycon findQualTyconWithoutConsultingExportList ( QualId q ); extern Int numQualifiers ( Type ); /* -------------------------------------------------------------------------- * Globally defined name values: * ------------------------------------------------------------------------*/ #define NAME_BASE_ADDR 1000000 #define NAME_MAX_SIZE 900000 #define NAME_INIT_SIZE 4 #ifdef DEBUG_STORAGE extern struct strName* generate_name_ref ( Cell ); #define name(nm) (*generate_name_ref(nm)) #else #define name(nm) tabName[(nm)-NAME_BASE_ADDR] #endif #define mkName(n) (NAME_BASE_ADDR+(n)) #define isName(c) (NAME_BASE_ADDR<=(c) \ && (c)=1 * EXECNAME = code for executable name (bytecodes or primitive) * SELNAME = code for selector function * DFUNNAME = code for dictionary builder or selector * cfunNo(i) = code for data constructor * datatypes with only one constructor uses cfunNo(0) * datatypes with multiple constructors use cfunNo(n), n>=1 */ #define EXECNAME 0 #define SELNAME 1 #define DFUNNAME 2 #define CFUNNAME 3 #define isSfun(n) (name(n).number==SELNAME) #define isDfun(n) (name(n).number==DFUNNAME) #define isCfun(n) (name(n).number>=CFUNNAME) #define cfunOf(n) (name(n).number-CFUNNAME) #define cfunNo(i) ((i)+CFUNNAME) #define hasCfun(cs) (nonNull(cs) && isCfun(hd(cs))) #define isMfun(n) (name(n).number<0) #define mfunOf(n) ((-1)-name(n).number) #define mfunNo(i) ((-1)-(i)) extern Name newName ( Text,Cell ); extern Name findName ( Text ); extern Name addName ( Name ); 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 jrsFindQualName ( Text,Text ); extern Name findQualNameWithoutConsultingExportList ( QualId q ); /* -------------------------------------------------------------------------- * Type class values: * ------------------------------------------------------------------------*/ #define INST_BASE_ADDR 4000000 #define INST_MAX_SIZE 900000 #define INST_INIT_SIZE 4 #ifdef DEBUG_STORAGE extern struct strInst* generate_inst_ref ( Cell ); #define inst(in) (*generate_inst_ref(in)) #else #define inst(in) tabInst[(in)-INST_BASE_ADDR] #endif #define mkInst(n) (INST_BASE_ADDR+(n)) #define instOf(c) ((Int)((c)-INST_BASE_ADDR)) #define isInst(c) (INST_BASE_ADDR<=(c) \ && (c)=NUM_STACK-(n)) hugsStackOverflow() #define push(c) do { chkStack(1); onto(c); } while (0) #define onto(c) stack(++sp)=(c); #define pop() stack(sp--) #define drop() sp-- #define top() stack(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 ); #if SYMANTEC_C #include #define STACK_HEADROOM 16384 #define STACK_CHECK if (StackSpace() <= STACK_HEADROOM) \ internal("Macintosh function parameter stack overflow."); #else #define STACK_CHECK #endif /* -------------------------------------------------------------------------- * Misc: * ------------------------------------------------------------------------*/ extern Void setLastExpr ( Cell ); extern Cell getLastExpr ( Void ); extern List addTyconsMatching ( String,List ); extern List addNamesMatching ( String,List ); extern Tycon findTyconInAnyModule ( Text t ); extern Class findClassInAnyModule ( Text t ); extern Name findNameInAnyModule ( Text t ); extern Void print ( Cell, Int ); extern void dumpTycon ( Int t ); extern void dumpName ( Int n ); extern void dumpClass ( Int c ); extern void dumpInst ( Int i ); extern void locateSymbolByName ( Text t ); /*-------------------------------------------------------------------------*/