- * Dynamic loading code (probably shouldn't be here)
- *
- * o .hi file explicitly says which .so file to load.
- * This avoids the need for a 1-to-1 relationship between .hi and .so files.
- *
- * ToDo: when doing a :reload, we ought to check the modification date
- * on the .so file.
- *
- * o module handles are unloaded (dlclosed) when we call dropScriptsFrom.
- *
- * ToDo: do the same for foreign functions - but with complication that
- * there may be multiple .so files
- * ------------------------------------------------------------------------*/
-
-typedef struct { char* name; void* addr; } RtsTabEnt;
-
-/* not really true */
-extern int stg_gc_enter_1;
-extern int stg_chk_1;
-extern int stg_update_PAP;
-extern int __ap_2_upd_info;
-
-RtsTabEnt rtsTab[]
- = {
- { "stg_gc_enter_1", &stg_gc_enter_1 },
- { "stg_chk_1", &stg_chk_1 },
- { "stg_update_PAP", &stg_update_PAP },
- { "__ap_2_upd_info", &__ap_2_upd_info },
- {0,0}
- };
-
-char* strsuffix ( char* s, char* suffix )
-{
- int sl = strlen(s);
- int xl = strlen(suffix);
- if (xl > sl) return NULL;
- if (0 == strcmp(s+sl-xl,suffix)) return s+sl-xl;
- return NULL;
-}
-
-char* lookupObjName ( char* nameT )
-{
- Text tm;
- Text tn;
- Text ts;
- Name naam;
- char* nm;
- char* ty;
- char* a;
- Int k;
- Pair pr;
-
- if (isupper(((int)(nameT[0])))) {
- // name defined in a module, eg Mod_xyz_static_closure
- // Place a zero after the module name, and after
- // the symbol name proper
- // --> Mod\0xyz\0static_closure
- nm = strchr(nameT, '_');
- if (!nm) internal ( "lookupObjName");
- *nm = 0;
- nm++;
- if ((ty=strsuffix(nm, "_static_closure")))
- { *ty = 0; ty++; ts = text_static_closure; }
- else
- if ((ty=strsuffix(nm, "_static_info" )))
- { *ty = 0; ty++; ts = text_static_info; }
- else
- if ((ty=strsuffix(nm, "_con_info" )))
- { *ty = 0; ty++; ts = text_con_info; }
- else
- if ((ty=strsuffix(nm, "_con_entry" )))
- { *ty = 0; ty++; ts = text_con_entry; }
- else
- if ((ty=strsuffix(nm, "_info" )))
- { *ty = 0; ty++; ts = text_info; }
- else
- if ((ty=strsuffix(nm, "_entry" )))
- { *ty = 0; ty++; ts = text_entry; }
- else
- if ((ty=strsuffix(nm, "_closure" )))
- { *ty = 0; ty++; ts = text_closure; }
- else {
- fprintf(stderr, "lookupObjName: unknown suffix on %s\n", nameT );
- return NULL;
- }
- tm = findText(nameT);
- tn = findText(nm);
- //printf ( "\nlooking at mod `%s' var `%s' ext `%s' \n",textToStr(tm),textToStr(tn),textToStr(ts));
- naam = jrsFindQualName(tm,tn);
- if (isNull(naam)) goto not_found;
- pr = cellAssoc ( ts, name(naam).ghc_names );
- if (isNull(pr)) goto no_info;
- return ptrOf(snd(pr));
- }
- else {
- // name presumably originating from the RTS
- a = NULL;
- for (k = 0; rtsTab[k].name; k++) {
- if (0==strcmp(nameT,rtsTab[k].name)) {
- a = rtsTab[k].addr;
- break;
- }
- }
- if (!a) goto not_found_rts;
- return a;
- }
-
-not_found:
- fprintf ( stderr,
- "lookupObjName: can't resolve name `%s'\n",
- nameT );
- return NULL;
-no_info:
- fprintf ( stderr,
- "lookupObjName: no info for name `%s'\n",
- nameT );
- return NULL;
-not_found_rts:
- fprintf ( stderr,
- "lookupObjName: can't resolve RTS name `%s'\n",
- nameT );
- return NULL;
-}
-
-
-/* --------------------------------------------------------------------------