ghc/rts/Prelude.c

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