ghc/rts/Prelude.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: Prelude.c,v 1.6 2000/04/14 16:47:43 panne 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_stackOverflow_closure;
  19 const StgClosure *ind_heapOverflow_closure;
  20 const StgClosure *ind_PutFullMVar_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   (void)ask_hugs_dynamic_linker;   /* keep gcc -Wall happy */
  99 #if defined(INTERPRETER)
 100   if (ask_hugs_dynamic_linker == NULL) {
 101
 102     /* Hugs standalone mode. */
 103     ind_True_closure               = NULL; /* True__closure; */
 104     ind_False_closure              = NULL; /* False_closure; */
 105     ind_PutFullMVar_closure        = NULL; /* PutFullMVar_closure; */
 106     ind_BlockedOnDeadMVar_closure  = NULL; /* BlockedOnDeadMVar_closure; */
 107     ind_NonTermination_closure     = NULL; /* NonTermination_closure; */
 108     ind_unpackCString_closure      = NULL; /* unpackCString_closure; */
 109
 110     ind_stackOverflow_closure = stackOverflow_closure;
 111     ind_heapOverflow_closure  = heapOverflow_closure;
 112
 113     ind_Czh_static_info       = &hugs_standalone_Czh_static_info;
 114     ind_Izh_static_info       = &hugs_standalone_Izh_static_info;
 115     ind_Fzh_static_info       = &hugs_standalone_Fzh_static_info;
 116     ind_Dzh_static_info       = &hugs_standalone_Dzh_static_info;
 117     ind_Azh_static_info       = &hugs_standalone_Azh_static_info;
 118     ind_Wzh_static_info       = &hugs_standalone_Wzh_static_info;
 119     ind_Czh_con_info          = &hugs_standalone_Czh_con_info;
 120     ind_Izh_con_info          = &hugs_standalone_Izh_con_info;
 121     ind_Fzh_con_info          = &hugs_standalone_Fzh_con_info;
 122     ind_Dzh_con_info          = &hugs_standalone_Dzh_con_info;
 123     ind_Azh_con_info          = &hugs_standalone_Azh_con_info;
 124     ind_Wzh_con_info          = &hugs_standalone_Wzh_con_info;
 125     ind_I64zh_con_info        = &hugs_standalone_I64zh_con_info;
 126     ind_W64zh_con_info        = &hugs_standalone_W64zh_con_info;
 127     ind_StablePtr_static_info = &hugs_standalone_StablePtr_static_info;
 128     ind_StablePtr_con_info    = &hugs_standalone_StablePtr_con_info;
 129
 130   } else {
 131
 132     /* Hugs combined mode. */
 133     void*(*ask)(char*) = ask_hugs_dynamic_linker;
 134
 135     ind_True_closure
 136        = ask("PrelBase_True_closure");
 137     ind_False_closure
 138        = ask("PrelBase_False_closure");
 139     ind_PutFullMVar_closure
 140        = ask("PrelException_PutFullMVar_closure");
 141     ind_BlockedOnDeadMVar_closure
 142        = ask("PrelException_BlockedOnDeadMVar_closure");
 143     ind_NonTermination_closure
 144        = ask("PrelException_NonTermination_closure");
 145
 146     ind_unpackCString_closure = ask("PrelPack_unpackCString_closure");
 147     ind_stackOverflow_closure = ask("PrelException_stackOverflow_closure");
 148     ind_heapOverflow_closure  = ask("PrelException_heapOverflow_closure");
 149
 150     ind_Czh_static_info       = ask("PrelBase_Czh_static_info");
 151     ind_Izh_static_info       = ask("PrelBase_Izh_static_info");
 152     ind_Fzh_static_info       = ask("PrelFloat_Fzh_static_info");
 153     ind_Dzh_static_info       = ask("PrelFloat_Dzh_static_info");
 154     ind_Azh_static_info       = ask("PrelAddr_Azh_static_info");
 155     ind_Wzh_static_info       = ask("PrelAddr_Wzh_static_info");
 156     ind_Czh_con_info          = ask("PrelBase_Czh_con_info");
 157     ind_Izh_con_info          = ask("PrelBase_Izh_con_info");
 158     ind_Fzh_con_info          = ask("PrelFloat_Fzh_con_info");
 159     ind_Dzh_con_info          = ask("PrelFloat_Dzh_con_info");
 160     ind_Azh_con_info          = ask("PrelAddr_Azh_con_info");
 161     ind_Wzh_con_info          = ask("PrelAddr_Wzh_con_info");
 162     ind_I64zh_con_info        = ask("PrelAddr_I64zh_con_info");
 163     ind_W64zh_con_info        = ask("PrelAddr_W64zh_con_info");
 164     ind_StablePtr_static_info = ask("PrelStable_StablePtr_static_info");
 165     ind_StablePtr_con_info    = ask("PrelStable_StablePtr_con_info");
 166
 167   }
 168 #endif
 169
 170   /* When the RTS and Prelude live in separate DLLs,
 171      we need to patch up the char- and int-like tables
 172      that the RTS keeps after both DLLs have been loaded,
 173      filling in the tables with references to where the
 174      static info tables have been loaded inside the running
 175      process.
 176   */
 177 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 178   {
 179     int i;
 180
 181     for(i=0;i<=255;i++)
 182       (CHARLIKE_closure[i]).header.info = Czh_static_info;
 183
 184     for(i=0;i<=32;i++)
 185       (INTLIKE_closure[i]).header.info = Izh_static_info;
 186   }
 187 #endif
 188 }