ghc/rts/Prelude.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: Prelude.c,v 1.9 2000/08/07 23:37:23 qrczak 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
  79 #ifdef XMLAMBDA
  80 /* The Inj constructor: data Inj = forall a. Inj a Int#
  81    Since this one is not present in Haskell compiled stuff, we bind it statically.
  82 */
  83 INFO_TABLE_CONSTR(xmlambda_Inj_con_info,Hugs_CONSTR_entry,
  84                   sizeofW(StgPtr),sizeofW(StgInt),0,CONSTR,,EF_,0,0);
  85
  86 const StgInfoTable* ind_Inj_con_info = &xmlambda_Inj_con_info;
  87 #endif /* XMLAMBDA */
  88
  89 #endif
  90
  91
  92 /* Fix up references to various Prelude symbols.  For Hugs, we
  93    pass either NULL, to denote standalone mode, or the address of
  94    a lookup function which finds the specified symbol in the
  95    compiled Prelude which Hugs has just loaded.
  96
  97    In combined mode, call here when POSTPREL is signalled in link.c
  98    (since before that point, there are no symbols to link to).
  99    In standalone mode, call here at any time, preferably as early
 100    as possible -- when PREPREL is signalled.
 101
 102    At the moment, standalone mode does not link True, False,
 103    PutFullMVar or NonTermination.  That might change (if we
 104    implement them in the Hugs standalone Prelude), but then
 105    we (1) need a way to ask hugs the address of the BCOs, and
 106    (2) this can only be done at POSTPREL time.
 107 */
 108 void fixupRTStoPreludeRefs ( void*(*ask_hugs_dynamic_linker)(char*) )
 109 {
 110   (void)ask_hugs_dynamic_linker;   /* keep gcc -Wall happy */
 111 #if defined(INTERPRETER)
 112   if (ask_hugs_dynamic_linker == NULL) {
 113
 114     /* Hugs standalone mode. */
 115     ind_True_closure               = NULL; /* True__closure; */
 116     ind_False_closure              = NULL; /* False_closure; */
 117     ind_runFinalizerBatch_closure  = NULL; /* runFinalizerBatch_closure; */
 118     ind_PutFullMVar_closure        = NULL; /* PutFullMVar_closure; */
 119     ind_BlockedOnDeadMVar_closure  = NULL; /* BlockedOnDeadMVar_closure; */
 120     ind_NonTermination_closure     = NULL; /* NonTermination_closure; */
 121     ind_unpackCString_closure      = NULL; /* unpackCString_closure; */
 122
 123     ind_stackOverflow_closure = stackOverflow_closure;
 124     ind_heapOverflow_closure  = heapOverflow_closure;
 125
 126     ind_Czh_static_info       = &hugs_standalone_Czh_static_info;
 127     ind_Izh_static_info       = &hugs_standalone_Izh_static_info;
 128     ind_Fzh_static_info       = &hugs_standalone_Fzh_static_info;
 129     ind_Dzh_static_info       = &hugs_standalone_Dzh_static_info;
 130     ind_Azh_static_info       = &hugs_standalone_Azh_static_info;
 131     ind_Wzh_static_info       = &hugs_standalone_Wzh_static_info;
 132     ind_Czh_con_info          = &hugs_standalone_Czh_con_info;
 133     ind_Izh_con_info          = &hugs_standalone_Izh_con_info;
 134     ind_Fzh_con_info          = &hugs_standalone_Fzh_con_info;
 135     ind_Dzh_con_info          = &hugs_standalone_Dzh_con_info;
 136     ind_Azh_con_info          = &hugs_standalone_Azh_con_info;
 137     ind_Wzh_con_info          = &hugs_standalone_Wzh_con_info;
 138     ind_I64zh_con_info        = &hugs_standalone_I64zh_con_info;
 139     ind_W64zh_con_info        = &hugs_standalone_W64zh_con_info;
 140     ind_StablePtr_static_info = &hugs_standalone_StablePtr_static_info;
 141     ind_StablePtr_con_info    = &hugs_standalone_StablePtr_con_info;
 142
 143   } else {
 144
 145     /* Hugs combined mode. */
 146     void*(*ask)(char*) = ask_hugs_dynamic_linker;
 147
 148     ind_True_closure
 149        = ask("PrelBase_True_closure");
 150     ind_False_closure
 151        = ask("PrelBase_False_closure");
 152     ind_runFinalizerBatch_closure
 153        = ask("PrelWeak_runFinalizzerBatch_closure");
 154     ind_PutFullMVar_closure
 155        = ask("PrelException_PutFullMVar_closure");
 156     ind_BlockedOnDeadMVar_closure
 157        = ask("PrelException_BlockedOnDeadMVar_closure");
 158     ind_NonTermination_closure
 159        = ask("PrelException_NonTermination_closure");
 160
 161     ind_unpackCString_closure = ask("PrelPack_unpackCString_closure");
 162     ind_stackOverflow_closure = ask("PrelException_stackOverflow_closure");
 163     ind_heapOverflow_closure  = ask("PrelException_heapOverflow_closure");
 164
 165     ind_Czh_static_info       = ask("PrelBase_Czh_static_info");
 166     ind_Izh_static_info       = ask("PrelBase_Izh_static_info");
 167     ind_Fzh_static_info       = ask("PrelFloat_Fzh_static_info");
 168     ind_Dzh_static_info       = ask("PrelFloat_Dzh_static_info");
 169     ind_Azh_static_info       = ask("PrelAddr_Azh_static_info");
 170     ind_Wzh_static_info       = ask("PrelAddr_Wzh_static_info");
 171     ind_Czh_con_info          = ask("PrelBase_Czh_con_info");
 172     ind_Izh_con_info          = ask("PrelBase_Izh_con_info");
 173     ind_Fzh_con_info          = ask("PrelFloat_Fzh_con_info");
 174     ind_Dzh_con_info          = ask("PrelFloat_Dzh_con_info");
 175     ind_Azh_con_info          = ask("PrelAddr_Azh_con_info");
 176     ind_Wzh_con_info          = ask("PrelAddr_Wzh_con_info");
 177     ind_I64zh_con_info        = ask("PrelAddr_I64zh_con_info");
 178     ind_W64zh_con_info        = ask("PrelAddr_W64zh_con_info");
 179     ind_StablePtr_static_info = ask("PrelStable_StablePtr_static_info");
 180     ind_StablePtr_con_info    = ask("PrelStable_StablePtr_con_info");
 181
 182   }
 183 #endif
 184
 185   /* When the RTS and Prelude live in separate DLLs,
 186      we need to patch up the char- and int-like tables
 187      that the RTS keeps after both DLLs have been loaded,
 188      filling in the tables with references to where the
 189      static info tables have been loaded inside the running
 190      process.
 191   */
 192 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 193   {
 194     int i;
 195
 196     for(i=0; i<=MAX_CHARLIKE-MIN_CHARLIKE; i++)
 197       (CHARLIKE_closure[i]).header.info = Czh_static_info;
 198
 199     for(i=0; i<=MAX_INTLIKE-MIN_INTLIKE; i++)
 200       (INTLIKE_closure[i]).header.info = Izh_static_info;
 201   }
 202 #endif
 203 }