- * Script file storage:
- *
- * script files are read into the system one after another. The state of
- * the stored data structures (except the garbage-collected heap) is recorded
- * before reading a new script. In the event of being unable to read the
- * script, or if otherwise requested, the system can be restored to its
- * original state immediately before the file was read.
- * ------------------------------------------------------------------------*/
-
-typedef struct { /* record of storage state prior to */
- Text file; /* reading script/module */
- Text textHw;
- Text nextNewText;
- Text nextNewDText;
- Module moduleHw;
- Tycon tyconHw;
- Name nameHw;
- Class classHw;
- Inst instHw;
-#if TREX
- Ext extHw;
-#endif
-} script;
-
-#ifdef DEBUG_SHOWUSE
-static Void local showUse(msg,val,mx)
-String msg;
-Int val, mx; {
- Printf("%6s : %5d of %5d (%2d%%)\n",msg,val,mx,(100*val)/mx);
-}
-#endif
-
-static Script scriptHw; /* next unused script number */
-static script scripts[NUM_SCRIPTS]; /* storage for script records */
-
-
-void ppScripts ( void )
-{
- Int i;
- fflush(stderr); fflush(stdout);
- printf ( "begin SCRIPTS\n" );
- for (i = scriptHw-1; i >= 0; i--)
- printf ( " %2d: %16s tH=%d mH=%d yH=%d "
- "nH=%d cH=%d iH=%d nnS=%d,%d\n",
- i, textToStr(scripts[i].file),
- scripts[i].textHw, scripts[i].moduleHw,
- scripts[i].tyconHw, scripts[i].nameHw,
- scripts[i].classHw, scripts[i].instHw,
- scripts[i].nextNewText, scripts[i].nextNewDText
- );
- printf ( "end SCRIPTS\n" );
- fflush(stderr); fflush(stdout);
-}
-
-Script startNewScript(f) /* start new script, keeping record */
-String f; { /* of status for later restoration */
- if (scriptHw >= NUM_SCRIPTS) {
- ERRMSG(0) "Too many script files in use"
- EEND;
- }
-#ifdef DEBUG_SHOWUSE
- showUse("Text", textHw, NUM_TEXT);
- showUse("Module", moduleHw-MODMIN, NUM_MODULE);
- showUse("Tycon", tyconHw-TYCMIN, NUM_TYCON);
- showUse("Name", nameHw-NAMEMIN, NUM_NAME);
- showUse("Class", classHw-CLASSMIN, NUM_CLASSES);
- showUse("Inst", instHw-INSTMIN, NUM_INSTS);
-#if TREX
- showUse("Ext", extHw-EXTMIN, NUM_EXT);
-#endif
-#endif
- scripts[scriptHw].file = findText( f ? f : "<nofile>" );
- scripts[scriptHw].textHw = textHw;
- scripts[scriptHw].nextNewText = nextNewText;
- scripts[scriptHw].nextNewDText = nextNewDText;
- scripts[scriptHw].moduleHw = moduleHw;
- scripts[scriptHw].tyconHw = tyconHw;
- scripts[scriptHw].nameHw = nameHw;
- scripts[scriptHw].classHw = classHw;
- scripts[scriptHw].instHw = instHw;
-#if TREX
- scripts[scriptHw].extHw = extHw;
-#endif
- return scriptHw++;
-}
-
-Bool isPreludeScript() { /* Test whether this is the Prelude*/
- return (scriptHw < N_PRELUDE_SCRIPTS /*==0*/ );
-}
-
-Bool moduleThisScript(m) /* Test if given module is defined */
-Module m; { /* in current script file */
- return scriptHw < 1
- || m>=scripts[scriptHw-1].moduleHw;
-}
-
-Module lastModule() { /* Return module in current script file */
- return (moduleHw>MODMIN ? moduleHw-1 : modulePrelude);
-}
-
-#define scriptThis(nm,t,tag) Script nm(x) \
- t x; { \
- Script s=0; \
- while (s<scriptHw \
- && x>=scripts[s].tag) \
- s++; \
- return s; \
- }
-scriptThis(scriptThisName,Name,nameHw)
-scriptThis(scriptThisTycon,Tycon,tyconHw)
-scriptThis(scriptThisInst,Inst,instHw)
-scriptThis(scriptThisClass,Class,classHw)
-#undef scriptThis
-
-Module moduleOfScript(s)
-Script s; {
- return (s==0) ? modulePrelude : scripts[s-1].moduleHw;
-}
-
-String fileOfModule(m)
-Module m; {
- Script s;
- if (m == modulePrelude) {
- return STD_PRELUDE;
- }
- for(s=0; s<scriptHw; ++s) {
- if (scripts[s].moduleHw == m) {
- return textToStr(scripts[s].file);
- }
- }
- return 0;
-}
-
-Script scriptThisFile(f)
-Text f; {
- Script s;
- for (s=0; s < scriptHw; ++s) {
- if (scripts[s].file == f) {
- return s+1;
- }
- }
- if (f == findText(STD_PRELUDE)) {
- return 0;
- }
- return (-1);
-}
-
-Void dropScriptsFrom(sno) /* Restore storage to state prior */
-Script sno; { /* to reading script sno */
- if (sno<scriptHw) { /* is there anything to restore? */
- int i;
- textHw = scripts[sno].textHw;
- nextNewText = scripts[sno].nextNewText;
- nextNewDText = scripts[sno].nextNewDText;
- moduleHw = scripts[sno].moduleHw;
- tyconHw = scripts[sno].tyconHw;
- nameHw = scripts[sno].nameHw;
- classHw = scripts[sno].classHw;
- instHw = scripts[sno].instHw;
-#if USE_DICTHW
- dictHw = scripts[sno].dictHw;
-#endif
-#if TREX
- extHw = scripts[sno].extHw;
-#endif
-
-#if 0
- for (i=moduleHw; i >= scripts[sno].moduleHw; --i) {
- if (module(i).objectFile) {
- printf("[bogus] closing objectFile for module %d\n",i);
- /*dlclose(module(i).objectFile);*/
- }
- }
- moduleHw = scripts[sno].moduleHw;
-#endif
- for (i=0; i<TEXTHSZ; ++i) {
- int j = 0;
- while (j<NUM_TEXTH && textHash[i][j]!=NOTEXT
- && textHash[i][j]<textHw)
- ++j;
- if (j<NUM_TEXTH)
- textHash[i][j] = NOTEXT;
- }
-
- currentModule=NIL;
- for (i=0; i<TYCONHSZ; ++i) {
- tyconHash[i] = NIL;
- }
- for (i=0; i<NAMEHSZ; ++i) {
- nameHash[i] = NIL;
- }
-
- for (i=CLASSMIN; i<classHw; i++) {
- List ins = cclass(i).instances;
- List is = NIL;
-
- while (nonNull(ins)) {
- List temp = tl(ins);
- if (hd(ins)<instHw) {
- tl(ins) = is;
- is = ins;
- }
- ins = temp;
- }
- cclass(i).instances = rev(is);
- }
-
- scriptHw = sno;
- }
-}
-
-/* --------------------------------------------------------------------------