ghc/rts/Prelude.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: Prelude.c,v 1.7 2000/05/22 13:09:29 simonmar Exp $
   4  *
   5  * (c) The GHC Team, 1998-2000
   6  *
   7  * Prelude identifiers that we sometimes need to refer to in the RTS.
   8  *
   9  * ---------------------------------------------------------------------------*/
  10
  11 #include "Rts.h"
  12 #include "Prelude.h"
  13
  14 #if defined(INTERPRETER)
  15 const StgClosure *ind_True_closure;
  16 const StgClosure *ind_False_closure;
  17 const StgClosure *ind_unpackCString_closure;
  18 const StgClosure *ind_runFinalizerBatch_closure;
  19
  20 const StgClosure *ind_stackOverflow_closure;
  21 const StgClosure *ind_heapOverflow_closure;
  22 const StgClosure *ind_PutFullMVar_closure;
  23 const StgClosure *ind_BlockedOnDeadMVar_closure;
  24 const StgClosure *ind_NonTermination_closure;
  25
  26 const StgInfoTable *ind_Czh_static_info;
  27 const StgInfoTable *ind_Izh_static_info;
  28 const StgInfoTable *ind_Fzh_static_info;
  29 const StgInfoTable *ind_Dzh_static_info;
  30 const StgInfoTable *ind_Azh_static_info;
  31 const StgInfoTable *ind_Wzh_static_info;
  32 const StgInfoTable *ind_Czh_con_info;
  33 const StgInfoTable *ind_Izh_con_info;
  34 const StgInfoTable *ind_Fzh_con_info;
  35 const StgInfoTable *ind_Dzh_con_info;
  36 const StgInfoTable *ind_Azh_con_info;
  37 const StgInfoTable *ind_Wzh_con_info;
  38 const StgInfoTable *ind_I64zh_con_info;
  39 const StgInfoTable *ind_W64zh_con_info;
  40 const StgInfoTable *ind_StablePtr_static_info;
  41 const StgInfoTable *ind_StablePtr_con_info;
  42
  43 INFO_TABLE_CONSTR(hugs_standalone_Czh_con_info,Hugs_CONSTR_entry,
  44                   0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
  45 INFO_TABLE_CONSTR(hugs_standalone_Izh_con_info,Hugs_CONSTR_entry,
  46                   0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
  47 INFO_TABLE_CONSTR(hugs_standalone_I64zh_con_info,Hugs_CONSTR_entry,
  48                   0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
  49 INFO_TABLE_CONSTR(hugs_standalone_W64zh_con_info,Hugs_CONSTR_entry,
  50                   0,sizeofW(StgWord64),0,CONSTR,,EF_,0,0);
  51 INFO_TABLE_CONSTR(hugs_standalone_Fzh_con_info,Hugs_CONSTR_entry,
  52                   0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
  53 INFO_TABLE_CONSTR(hugs_standalone_Dzh_con_info,Hugs_CONSTR_entry,
  54                   0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
  55 INFO_TABLE_CONSTR(hugs_standalone_Azh_con_info,Hugs_CONSTR_entry,
  56                   0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
  57 INFO_TABLE_CONSTR(hugs_standalone_Wzh_con_info,Hugs_CONSTR_entry,
  58                   0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
  59 INFO_TABLE_CONSTR(hugs_standalone_StablePtr_con_info,Hugs_CONSTR_entry,
  60                   0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
  61
  62 INFO_TABLE_CONSTR(hugs_standalone_Czh_static_info,Hugs_CONSTR_entry,
  63                   0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  64 INFO_TABLE_CONSTR(hugs_standalone_Izh_static_info,Hugs_CONSTR_entry,
  65                   0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  66 INFO_TABLE_CONSTR(hugs_standalone_I64zh_static_info,Hugs_CONSTR_entry,
  67                   0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  68 INFO_TABLE_CONSTR(hugs_standalone_Fzh_static_info,Hugs_CONSTR_entry,
  69                   0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  70 INFO_TABLE_CONSTR(hugs_standalone_Dzh_static_info,Hugs_CONSTR_entry,
  71                   0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  72 INFO_TABLE_CONSTR(hugs_standalone_Azh_static_info,Hugs_CONSTR_entry,
  73                   0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  74 INFO_TABLE_CONSTR(hugs_standalone_Wzh_static_info,Hugs_CONSTR_entry,
  75                   0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  76 INFO_TABLE_CONSTR(hugs_standalone_StablePtr_static_info,Hugs_CONSTR_entry,
  77                   0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
  78 #endif
  79
  80
  81 /* Fix up references to various Prelude symbols.  For Hugs, we
  82    pass either NULL, to denote standalone mode, or the address of
  83    a lookup function which finds the specified symbol in the
  84    compiled Prelude which Hugs has just loaded.
  85
  86    In combined mode, call here when POSTPREL is signalled in link.c
  87    (since before that point, there are no symbols to link to).
  88    In standalone mode, call here at any time, preferably as early
  89    as possible -- when PREPREL is signalled.
  90
  91    At the moment, standalone mode does not link True, False,
  92    PutFullMVar or NonTermination.  That might change (if we
  93    implement them in the Hugs standalone Prelude), but then
  94    we (1) need a way to ask hugs the address of the BCOs, and
  95    (2) this can only be done at POSTPREL time.
  96 */
  97 void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
  98 {
  99   (void)ask_hugs_dynamic_linker;   /* keep gcc -Wall happy */
 100 #if defined(INTERPRETER)
 101   if (ask_hugs_dynamic_linker == NULL) {
 102
 103     /* Hugs standalone mode. */
 104     ind_True_closure               = NULL; /* True__closure; */
 105     ind_False_closure              = NULL; /* False_closure; */
 106     ind_runFinalizerBatch_closure  = NULL; /* runFinalizerBatch_closure; */
 107     ind_PutFullMVar_closure        = NULL; /* PutFullMVar_closure; */
 108     ind_BlockedOnDeadMVar_closure  = NULL; /* BlockedOnDeadMVar_closure; */
 109     ind_NonTermination_closure     = NULL; /* NonTermination_closure; */
 110     ind_unpackCString_closure      = NULL; /* unpackCString_closure; */
 111
 112     ind_stackOverflow_closure = stackOverflow_closure;
 113     ind_heapOverflow_closure  = heapOverflow_closure;
 114
 115     ind_Czh_static_info       = &hugs_standalone_Czh_static_info;
 116     ind_Izh_static_info       = &hugs_standalone_Izh_static_info;
 117     ind_Fzh_static_info       = &hugs_standalone_Fzh_static_info;
 118     ind_Dzh_static_info       = &hugs_standalone_Dzh_static_info;
 119     ind_Azh_static_info       = &hugs_standalone_Azh_static_info;
 120     ind_Wzh_static_info       = &hugs_standalone_Wzh_static_info;
 121     ind_Czh_con_info          = &hugs_standalone_Czh_con_info;
 122     ind_Izh_con_info          = &hugs_standalone_Izh_con_info;
 123     ind_Fzh_con_info          = &hugs_standalone_Fzh_con_info;
 124     ind_Dzh_con_info          = &hugs_standalone_Dzh_con_info;
 125     ind_Azh_con_info          = &hugs_standalone_Azh_con_info;
 126     ind_Wzh_con_info          = &hugs_standalone_Wzh_con_info;
 127     ind_I64zh_con_info        = &hugs_standalone_I64zh_con_info;
 128     ind_W64zh_con_info        = &hugs_standalone_W64zh_con_info;
 129     ind_StablePtr_static_info = &hugs_standalone_StablePtr_static_info;
 130     ind_StablePtr_con_info    = &hugs_standalone_StablePtr_con_info;
 131
 132   } else {
 133
 134     /* Hugs combined mode. */
 135     void*(*ask)(char*) = ask_hugs_dynamic_linker;
 136
 137     ind_True_closure
 138        = ask("PrelBase_True_closure");
 139     ind_False_closure
 140        = ask("PrelBase_False_closure");
 141     ind_runFinalizerBatch_closure
 142        = ask("PrelWeak_runFinalizzerBatch_closure");
 143     ind_PutFullMVar_closure
 144        = ask("PrelException_PutFullMVar_closure");
 145     ind_BlockedOnDeadMVar_closure
 146        = ask("PrelException_BlockedOnDeadMVar_closure");
 147     ind_NonTermination_closure
 148        = ask("PrelException_NonTermination_closure");
 149
 150     ind_unpackCString_closure = ask("PrelPack_unpackCString_closure");
 151     ind_stackOverflow_closure = ask("PrelException_stackOverflow_closure");
 152     ind_heapOverflow_closure  = ask("PrelException_heapOverflow_closure");
 153
 154     ind_Czh_static_info       = ask("PrelBase_Czh_static_info");
 155     ind_Izh_static_info       = ask("PrelBase_Izh_static_info");
 156     ind_Fzh_static_info       = ask("PrelFloat_Fzh_static_info");
 157     ind_Dzh_static_info       = ask("PrelFloat_Dzh_static_info");
 158     ind_Azh_static_info       = ask("PrelAddr_Azh_static_info");
 159     ind_Wzh_static_info       = ask("PrelAddr_Wzh_static_info");
 160     ind_Czh_con_info          = ask("PrelBase_Czh_con_info");
 161     ind_Izh_con_info          = ask("PrelBase_Izh_con_info");
 162     ind_Fzh_con_info          = ask("PrelFloat_Fzh_con_info");
 163     ind_Dzh_con_info          = ask("PrelFloat_Dzh_con_info");
 164     ind_Azh_con_info          = ask("PrelAddr_Azh_con_info");
 165     ind_Wzh_con_info          = ask("PrelAddr_Wzh_con_info");
 166     ind_I64zh_con_info        = ask("PrelAddr_I64zh_con_info");
 167     ind_W64zh_con_info        = ask("PrelAddr_W64zh_con_info");
 168     ind_StablePtr_static_info = ask("PrelStable_StablePtr_static_info");
 169     ind_StablePtr_con_info    = ask("PrelStable_StablePtr_con_info");
 170
 171   }
 172 #endif
 173
 174   /* When the RTS and Prelude live in separate DLLs,
 175      we need to patch up the char- and int-like tables
 176      that the RTS keeps after both DLLs have been loaded,
 177      filling in the tables with references to where the
 178      static info tables have been loaded inside the running
 179      process.
 180   */
 181 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 182   {
 183     int i;
 184
 185     for(i=0;i<=255;i++)
 186       (CHARLIKE_closure[i]).header.info = Czh_static_info;
 187
 188     for(i=0;i<=32;i++)
 189       (INTLIKE_closure[i]).header.info = Izh_static_info;
 190   }
 191 #endif
 192 }