home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / gofer / Sources / c / storage < prev    next >
Encoding:
Text File  |  1993-02-12  |  37.0 KB  |  1,367 lines
  1. /* --------------------------------------------------------------------------
  2.  * storage.c:   Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  * Primitives for manipulating global data structures
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. #include "prelude.h"
  10. #include "storage.h"
  11. #include "connect.h"
  12. #include "errors.h"
  13. #include <setjmp.h>
  14.  
  15. static List local insertName        Args((Name,List));
  16. static Void local patternError        Args((String));
  17. static Bool local stringMatch        Args((String,String));
  18.  
  19. static Int  local hash            Args((String));
  20. static Int  local saveText        Args((Text));
  21. static Cell local markCell        Args((Cell));
  22. static Void local markSnd        Args((Cell));
  23. static Cell local indirectChain        Args((Cell));
  24. static Void local garbageCollect    Args((Void));
  25. static Cell local lowLevelLastIn    Args((Cell));
  26. static Cell local lowLevelLastOut    Args((Cell));
  27. static Void local closeFile        Args((Int));
  28.  
  29. /* --------------------------------------------------------------------------
  30.  * Text storage:
  31.  *
  32.  * provides storage for the characters making up identifier and symbol
  33.  * names, string literals, character constants etc...
  34.  *
  35.  * All character strings are stored in a large character array, with textHw
  36.  * pointing to the next free position.    Lookup in the array is improved using
  37.  * a hash table.  Internally, text strings are represented by integer offsets
  38.  * from the beginning of the array to the string in question.
  39.  *
  40.  * Where memory permits, the use of multiple hashtables gives a significant
  41.  * increase in performance, particularly when large source files are used.
  42.  *
  43.  * Each string in the array is terminated by a zero byte.  No string is
  44.  * stored more than once, so that it is safe to test equality of strings by
  45.  * comparing the corresponding offsets.
  46.  *
  47.  * Special text values (beyond the range of the text array table) are used
  48.  * to generate unique `new variable names' as required.
  49.  *
  50.  * The same text storage is also used to hold text values stored in a saved
  51.  * expression.  This grows downwards from the top of the text table (and is
  52.  * not included in the hash table).
  53.  * ------------------------------------------------------------------------*/
  54.  
  55. #define TEXTHSZ 512            /* Size of Text hash table       */
  56. #define NOTEXT    ((Text)(~0))        /* Empty bucket in Text hash table */
  57. static    Text    textHw;            /* Next unused position           */
  58. static  Text    savedText = NUM_TEXT;    /* Start of saved portion of text  */
  59. static    Text    nextNewText;        /* Next new text value           */
  60. static  Text    nextNewDText;        /* Next new dict text value       */
  61. static    char    text[NUM_TEXT];        /* Storage of character strings       */
  62. static    Text    textHash[TEXTHSZ][NUM_TEXTH]; /* Hash table storage       */
  63.  
  64. String textToStr(t)               /* find string corresp to given Text*/
  65. Text t; {
  66.     static char newVar[16];
  67.  
  68.     if (0<=t && t<NUM_TEXT)            /* standard char string       */
  69.     return text + t;
  70.     if (t<0)
  71.     sprintf(newVar,"d%d",-t);        /* dictionary variable       */
  72.     else
  73.     sprintf(newVar,"v%d",t-NUM_TEXT);    /* normal variable       */
  74.     return newVar;
  75. }
  76.  
  77. Text inventText() {            /* return new unused variable name */
  78.     return nextNewText++;
  79. }
  80.  
  81. Text inventDictText() {            /* return new unused dictvar name  */
  82.     return nextNewDText--;
  83. }
  84.  
  85. static Int local hash(s)        /* Simple hash function on strings */
  86. String s; {
  87.     int v, j = 3;
  88.  
  89.     for (v=((int)(*s))*8; *s; s++)
  90.     v += ((int)(*s))*(j++);
  91.     return(v%TEXTHSZ);
  92. }
  93.  
  94. Text findText(s)               /* Locate string in Text array       */
  95. String s; {
  96.     int    h       = hash(s);
  97.     int    hashno  = 0;
  98.     Text   textPos = textHash[h][hashno];
  99.  
  100. #define TryMatch    {   Text   originalTextPos = textPos;           \
  101.                 String t;                       \
  102.                 for (t=s; *t==text[textPos]; textPos++,t++)       \
  103.                 if (*t=='\0')                   \
  104.                     return originalTextPos;           \
  105.             }
  106. #define Skip        while (text[textPos++]) ;
  107.  
  108.     while (textPos!=NOTEXT) {
  109.     TryMatch
  110.     if (++hashno<NUM_TEXTH)        /* look in next hashtable entry       */
  111.         textPos = textHash[h][hashno];
  112.     else {
  113.         Skip
  114.         while (textPos < textHw) {
  115.         TryMatch
  116.         Skip
  117.         }
  118.         break;
  119.     }
  120.     }
  121.  
  122. #undef TryMatch
  123. #undef Skip
  124.  
  125.     textPos = textHw;               /* if not found, save in array       */
  126.     if (textHw + strlen(s) + 1 > savedText) {
  127.     ERROR(0) "Character string storage space exhausted"
  128.     EEND;
  129.     }
  130.     while (text[textHw++] = *s++)
  131.     ;
  132.     if (hashno<NUM_TEXTH) {           /* updating hash table as necessary */
  133.     textHash[h][hashno] = textPos;
  134.     if (hashno<NUM_TEXTH-1)
  135.         textHash[h][hashno+1] = NOTEXT;
  136.     }
  137.  
  138.     return textPos;
  139. }
  140.  
  141. static Int local saveText(t)        /* Save text value in buffer       */
  142. Text t; {                /* at top of text table           */
  143.     String s = textToStr(t);
  144.     Int    l = strlen(s);
  145.  
  146.     if (textHw + strlen(s) + 1 > savedText) {
  147.     ERROR(0) "Character string storage space exhausted"
  148.     EEND;
  149.     }
  150.     savedText -= l+1;
  151.     strcpy(text+savedText,s);
  152.     return savedText;
  153. }
  154.  
  155. /* --------------------------------------------------------------------------
  156.  * Syntax storage:
  157.  *
  158.  * Operator declarations are stored in a table which associates Text values
  159.  * with Syntax values.
  160.  * ------------------------------------------------------------------------*/
  161.  
  162. static Int syntaxHw;               /* next unused syntax table entry   */
  163. static struct {                /* table of Text <-> Syntax values  */
  164.     Text   text;
  165.     Syntax syntax;
  166. } tabSyntax[NUM_SYNTAX];
  167.  
  168. Syntax syntaxOf(t)               /* look up syntax of operator symbol*/
  169. Text t; {
  170.     int i;
  171.  
  172.     for (i=0; i<syntaxHw; ++i)
  173.     if (tabSyntax[i].text==t)
  174.         return tabSyntax[i].syntax;
  175.     return defaultSyntax(t);
  176. }
  177.  
  178. Void addSyntax(line,t,sy)           /* add (t,sy) to syntax table       */
  179. Int    line;
  180. Text   t;
  181. Syntax sy; {
  182.     int i;
  183.  
  184.     for (i=0; i<syntaxHw; ++i)
  185.     if (tabSyntax[i].text==t) {
  186.         ERROR(line) "Attempt to redefine syntax of operator \"%s\"",
  187.             textToStr(t)
  188.         EEND;
  189.     }
  190.  
  191.     if (syntaxHw>=NUM_SYNTAX) {
  192.     ERROR(line) "Too many fixity declarations"
  193.     EEND;
  194.     }
  195.  
  196.     tabSyntax[syntaxHw].text   = t;
  197.     tabSyntax[syntaxHw].syntax = sy;
  198.     syntaxHw++;
  199. }
  200.  
  201. /* --------------------------------------------------------------------------
  202.  * Addr storage: records `next unused program location'
  203.  * ------------------------------------------------------------------------*/
  204.  
  205. static Addr addrHw;               /* next unused program location       */
  206.  
  207. Addr getMem(n)                   /* Get some more memory           */
  208. Int n; {
  209.     Addr newAddr = addrHw;
  210.     addrHw += n;
  211.     if (addrHw>=NUM_ADDRS) {
  212.     ERROR(0) "Program code storage space exhausted"
  213.     EEND;
  214.     }
  215.     return newAddr;
  216. }
  217.  
  218. /* --------------------------------------------------------------------------
  219.  * Tycon storage:
  220.  *
  221.  * A Tycon represents a user defined type constructor.    Tycons are indexed
  222.  * by Text values ... a very simple hash function is used to improve lookup
  223.  * times.  Tycon entries with the same hash code are chained together, with
  224.  * the most recent entry at the front of the list.
  225.  * ------------------------------------------------------------------------*/
  226.  
  227. #define TYCONHSZ 256            /* Size of Tycon hash table       */
  228. #define tHash(x) ((x)%TYCONHSZ)        /* Tycon hash function           */
  229. static    Tycon     tyconHw;        /* next unused Tycon           */
  230. static    Tycon     tyconHash[TYCONHSZ];    /* Hash table storage           */
  231.  
  232. struct    Tycon     tabTycon[NUM_TYCON];    /* Tycon storage            */
  233.  
  234. Tycon newTycon(t)            /* add new tycon to tycon table       */
  235. Text t; {
  236.     Int h = tHash(t);
  237.  
  238.     if (tyconHw-TYCMIN >= NUM_TYCON) {
  239.     ERROR(0) "Type constructor storage space exhausted"
  240.     EEND;
  241.     }
  242.     tycon(tyconHw).text      = t;    /* clear new tycon record       */
  243.     tycon(tyconHw).kind         = NIL;
  244.     tycon(tyconHw).defn      = NIL;
  245.     tycon(tyconHw).what         = NIL;
  246.     tycon(tyconHw).nextTyconHash = tyconHash[h];
  247.     tyconHash[h]         = tyconHw;
  248.  
  249.     return tyconHw++;
  250. }
  251.  
  252. Tycon findTycon(t)            /* locate Tycon in tycon table       */
  253. Text t; {
  254.     Tycon tc = tyconHash[tHash(t)];
  255.  
  256.     while (nonNull(tc) && tycon(tc).text!=t)
  257.     tc = tycon(tc).nextTyconHash;
  258.     return tc;
  259. }
  260.  
  261. Tycon addPrimTycon(s,kind,what,defn)    /* add new primitive type constr   */
  262. String s;
  263. Kind   kind;
  264. Cell   what;
  265. Cell   defn; {
  266.     Tycon tc       = newTycon(findText(s));
  267.     tycon(tc).line = 0;
  268.     tycon(tc).kind = kind;
  269.     tycon(tc).what = what;
  270.     tycon(tc).defn = defn;
  271.     return tc;
  272. }
  273.  
  274. /* --------------------------------------------------------------------------
  275.  * Name storage:
  276.  *
  277.  * A Name represents a top level binding of a value to an identifier.
  278.  * Such values may be any one of the following:
  279.  *    CFUN   constructor function
  280.  *    PRIM   primitive function
  281.  *    MFUN   member function in class
  282.  *    NIL    user defined (or machine generated) compiled function
  283.  *
  284.  * Names are indexed by Text values ... a very simple hash functions speeds
  285.  * access to the table of Names and Name entries with the same hash value
  286.  * are chained together, with the most recent entry at the front of the
  287.  * list.
  288.  * ------------------------------------------------------------------------*/
  289.  
  290. #define NAMEHSZ  256            /* Size of Name hash table       */
  291. #define nHash(x) ((x)%NAMEHSZ)        /* Name hash function :: Text->Int */
  292. static    Name     nameHw;        /* next unused name           */
  293. static    Name     nameHash[NAMEHSZ];    /* Hash table storage           */
  294.  
  295. struct    Name     tabName[NUM_NAME];    /* Name table storage           */
  296.  
  297. Name newName(t)                /* add new name to name table       */
  298. Text t; {
  299.     Int h = nHash(t);
  300.  
  301.     if (nameHw-NAMEMIN >= NUM_NAME) {
  302.     ERROR(0) "Name storage space exhausted"
  303.     EEND;
  304.     }
  305.     name(nameHw).text          = t;    /* clear new name record        */
  306.     name(nameHw).line          = 0;
  307.     name(nameHw).arity          = 0;
  308.     name(nameHw).number       = 0;
  309.     name(nameHw).defn          = NIL;
  310.     name(nameHw).type          = NIL;
  311.     name(nameHw).primDef      = 0;
  312.     name(nameHw).nextNameHash = nameHash[h];
  313.     nameHash[h]           = nameHw;
  314.  
  315.     return nameHw++;
  316. }
  317.  
  318. Name findName(t)            /* locate name in name table       */
  319. Text t; {
  320.     Name n = nameHash[nHash(t)];
  321.  
  322.     while (nonNull(n) && name(n).text!=t)
  323.     n = name(n).nextNameHash;
  324.     return n;
  325. }
  326.  
  327. Void addPrim(l,n,s,ty)            /* add primitive function value    */
  328. Int    l;
  329. Name   n;
  330. String s;
  331. Type   ty; {
  332.     Int  i;
  333.  
  334.     for (i=0; primitives[i].ref; ++i)
  335.         if (strcmp(s,primitives[i].ref)==0) {
  336.         name(n).line    = l;
  337.         name(n).arity   = primitives[i].arity;
  338.         name(n).number  = i;
  339.         name(n).defn    = NIL;
  340.         name(n).type    = ty;
  341.         name(n).primDef = primitives[i].imp;
  342.         return;
  343.     }
  344.     ERROR(l) "Unknown primitive reference \"%s\"", s
  345.     EEND;
  346. }
  347.  
  348. Name addPrimCfun(s,arity,no,type)    /* add primitive constructor func. */
  349. String s;
  350. Int    arity;
  351. Int    no;
  352. Cell   type; {
  353.     Name n        = newName(findText(s));
  354.     name(n).arity   = arity;
  355.     name(n).number  = no;
  356.     name(n).defn    = CFUN;
  357.     name(n).type    = type;
  358.     name(n).primDef = 0;
  359.     return n;
  360. }
  361.  
  362. static List local insertName(nm,ns)    /* insert name nm into sorted list */
  363. Name nm;                /* ns                   */
  364. List ns; {
  365.     Cell   prev = NIL;
  366.     Cell   curr = ns;
  367.     String s    = textToStr(name(nm).text);
  368.  
  369.     while (nonNull(curr) && strcmp(s,textToStr(name(hd(curr)).text))>=0) {
  370.     if (hd(curr)==nm)        /* just in case we get duplicates! */
  371.         return ns;
  372.     prev = curr;
  373.     curr = tl(curr);
  374.     }
  375.     if (nonNull(prev)) {
  376.     tl(prev) = cons(nm,curr);
  377.     return ns;
  378.     }
  379.     else
  380.     return cons(nm,curr);
  381. }
  382.  
  383. List addNamesMatching(pat,ns)        /* Add names matching pattern pat  */
  384. String pat;                /* to list of names ns           */
  385. List   ns; {                /* Null pattern matches every name */
  386.     Name nm;
  387.     for (nm=NAMEMIN; nm<nameHw; ++nm)
  388.     if (nonNull(name(nm).type) &&
  389.         (!pat || stringMatch(pat,textToStr(name(nm).text))))
  390.         ns = insertName(nm,ns);
  391.     return ns;
  392. }
  393.  
  394. /* --------------------------------------------------------------------------
  395.  * A simple string matching routine
  396.  *     `*'    matches any sequence of zero or more characters
  397.  *     `?'    matches any single character exactly 
  398.  *     `@str' matches the string str exactly (ignoring any special chars)
  399.  *     `\c'   matches the character c only (ignoring special chars)
  400.  *     c      matches the character c only
  401.  * ------------------------------------------------------------------------*/
  402.  
  403. static Void local patternError(s)    /* report error in pattern       */
  404. String s; {
  405.     ERROR(0) "%s in pattern", s
  406.     EEND;
  407. }
  408.  
  409. static Bool local stringMatch(pat,str)    /* match string against pattern       */
  410. String pat;
  411. String str; {
  412.  
  413.     for (;;)
  414.     switch (*pat) {
  415.         case '\0' : return (*str=='\0');
  416.  
  417.         case '*'  : do {
  418.                 if (stringMatch(pat+1,str))
  419.                 return TRUE;
  420.             } while (*str++);
  421.             return FALSE;
  422.  
  423.             case '?'  : if (*str++=='\0')
  424.                 return FALSE;
  425.             pat++;
  426.             break;
  427.  
  428.             case '['  : {   Bool found = FALSE;
  429.                 while (*++pat!='\0' && *pat!=']')
  430.                 if (!found && ( pat[0] == *str  ||
  431.                            (pat[1] == '-'   &&
  432.                         pat[2] != ']'   &&
  433.                         pat[2] != '\0'  &&
  434.                         pat[0] <= *str  &&
  435.                         pat[2] >= *str)))
  436.                                                
  437.                     found = TRUE;
  438.                 if (*pat != ']')
  439.                 patternError("missing `]'");
  440.                 if (!found)
  441.                 return FALSE;
  442.                 pat++;
  443.                 str++;
  444.             }
  445.                         break;
  446.  
  447.         case '\\' : if (*++pat == '\0')
  448.                 patternError("extra trailing `\\'");
  449.             /*fallthru!*/
  450.         default   : if (*pat++ != *str++)
  451.                 return FALSE;
  452.             break;
  453.     }
  454. }
  455.  
  456. /* --------------------------------------------------------------------------
  457.  * Storage of type classes, instances etc...:
  458.  * ------------------------------------------------------------------------*/
  459.  
  460. static Class classHw;               /* next unused class           */
  461. static Inst  instHw;               /* next unused instance record       */
  462. static Idx   idxHw;               /* next unused index tree record    */
  463. static Dict  dictHw;               /* next unused dictionary slot       */
  464.  
  465. struct Class    tabClass[NUM_CLASSES]; /* table of class records       */
  466. struct Inst far *tabInst;           /* (pointer to) table of instances  */
  467. struct Idx  far *tabIndex;           /* (pointer to) table of indices    */
  468. Cell        far *tabDict;           /* (pointer to) table of dict slots */
  469.  
  470. Class newClass(t)               /* add new class to class table       */
  471. Text t; {
  472.     if (classHw-CLASSMIN >= NUM_CLASSES) {
  473.     ERROR(0) "Class storage space exhausted"
  474.     EEND;
  475.     }
  476.     class(classHw).text      = t;
  477.     class(classHw).sig         = NIL;
  478.     class(classHw).head         = NIL;
  479.     class(classHw).supers    = NIL;
  480.     class(classHw).members   = NIL;
  481.     class(classHw).defaults  = NIL;
  482.     class(classHw).instances = NIL;
  483.     class(classHw).dictIndex = NOIDX;
  484.  
  485.     return classHw++;
  486. }
  487.  
  488. Class findClass(t)               /* look for named class in table    */
  489. Text t; {
  490.     Class c;
  491.  
  492.     for (c=CLASSMIN; c<classHw; c++)
  493.     if (class(c).text==t)
  494.         return c;
  495.     return NIL;
  496. }
  497.  
  498. Inst newInst() {               /* add new instance to table       */
  499.     if (instHw-INSTMIN >= NUM_INSTS) {
  500.     ERROR(0) "Instance storage space exhausted"
  501.     EEND;
  502.     }
  503.     inst(instHw).head         = NIL;
  504.     inst(instHw).specifics  = NIL;
  505.     inst(instHw).implements = NIL;
  506.  
  507.     return instHw++;
  508. }
  509.  
  510. Idx newIdx(test)               /* Add node to index tree, with       */
  511. Cell test; {                   /* specified test value            */
  512.     if (idxHw >= NUM_INDEXES) {
  513.     ERROR(0) "Index storage space exhausted"
  514.     EEND;
  515.     }
  516.     idx(idxHw).test  = test;
  517.     idx(idxHw).fail  = NOIDX;
  518.     idx(idxHw).match = NODICT;
  519.  
  520.     return idxHw++;
  521. }
  522.  
  523. Dict newDict(dictSize)               /* Allocate dictionary of given size*/
  524. Int dictSize; {
  525.     Dict dictStarts = dictHw;
  526.  
  527.     if ((dictHw+=dictSize) > NUM_DICTS) {
  528.     ERROR(0) "Dictionary storage space exhausted"
  529.     EEND;
  530.     }
  531.     return dictStarts;
  532. }
  533.  
  534. /* --------------------------------------------------------------------------
  535.  * Control stack:
  536.  *
  537.  * Various parts of the system use a stack of cells.  Most of the stack
  538.  * operations are defined as macros, expanded inline.
  539.  * ------------------------------------------------------------------------*/
  540.  
  541. Cell     cellStack[NUM_STACK];           /* Storage for cells on stack       */
  542. #ifndef  GLOBALsp
  543. StackPtr sp;                   /* stack pointer            */
  544. #endif
  545.  
  546. Void stackOverflow() {               /* Report stack overflow        */
  547.     ERROR(0) "Control stack overflow"
  548.     EEND;
  549. }
  550.  
  551. /* --------------------------------------------------------------------------
  552.  * Module storage:
  553.  *
  554.  * script files are read into the system one after another.  The state of
  555.  * the stored data structures (except the garbage-collected heap) is recorded
  556.  * before reading a new script.  In the event of being unable to read the
  557.  * script, or if otherwise requested, the system can be restored to its
  558.  * original state immediately before the file was read.
  559.  * ------------------------------------------------------------------------*/
  560.  
  561. typedef struct {               /* record of storage state prior to */
  562.     Text  textHw;               /* reading script/module        */
  563.     Text  nextNewText;
  564.     Text  nextNewDText;
  565.     Int   syntaxHw;
  566.     Addr  addrHw;
  567.     Tycon tyconHw;
  568.     Name  nameHw;
  569.     Class classHw;
  570.     Inst  instHw;
  571.     Idx   idxHw;
  572.     Dict  dictHw;
  573. } module;
  574.  
  575. static Module moduleHw;            /* next unused module number       */
  576. static module modules[NUM_MODULES];    /* storage for module records       */
  577.  
  578. Module startNewModule() {           /* start new module, keeping record */
  579.     if (moduleHw >= NUM_MODULES) {     /* of status for later restoration  */
  580.     ERROR(0) "Too many script/module files in use"
  581.     EEND;
  582.     }
  583.     modules[moduleHw].textHw       = textHw;
  584.     modules[moduleHw].nextNewText  = nextNewText;
  585.     modules[moduleHw].nextNewDText = nextNewDText;
  586.     modules[moduleHw].syntaxHw       = syntaxHw;
  587.     modules[moduleHw].addrHw       = addrHw;
  588.     modules[moduleHw].tyconHw       = tyconHw;
  589.     modules[moduleHw].nameHw       = nameHw;
  590.     modules[moduleHw].classHw       = classHw;
  591.     modules[moduleHw].instHw       = instHw;
  592.     modules[moduleHw].idxHw       = idxHw;
  593.     modules[moduleHw].dictHw       = dictHw;
  594.     return moduleHw++;
  595. }
  596.  
  597. Bool nameThisModule(n)            /* Test if given name is defined in*/
  598. Name n; {                /* current module           */
  599.     return moduleHw<1 || n>=modules[moduleHw-1].nameHw;
  600. }
  601.  
  602. Module moduleThisName(nm)        /* find module number for name       */
  603. Name nm; {
  604.     Module m;
  605.  
  606.     for (m=0; m<moduleHw && nm>=modules[m].nameHw; m++)
  607.     ;
  608.     if (m>=moduleHw)
  609.     internal("moduleThisName");
  610.     return m;
  611. }
  612.  
  613. Void dropModulesFrom(mno)        /* Restore storage to state prior  */
  614. Module mno; {                /* to reading module mno        */
  615.     if (mno<moduleHw) {            /* is there anything to restore?   */
  616.     int i;
  617.     textHw         = modules[mno].textHw;
  618.     nextNewText  = modules[mno].nextNewText;
  619.     nextNewDText = modules[mno].nextNewDText;
  620.     syntaxHw     = modules[mno].syntaxHw;
  621.     addrHw         = modules[mno].addrHw;
  622.     tyconHw      = modules[mno].tyconHw;
  623.     nameHw         = modules[mno].nameHw;
  624.     classHw      = modules[mno].classHw;
  625.     instHw         = modules[mno].instHw;
  626.     idxHw         = modules[mno].idxHw;
  627.     dictHw         = modules[mno].dictHw;
  628.  
  629.     for (i=0; i<TEXTHSZ; ++i) {
  630.         int j = 0;
  631.         while (j<NUM_TEXTH && textHash[i][j]!=NOTEXT
  632.                    && textHash[i][j]<textHw)
  633.         ++j;
  634.         if (j<NUM_TEXTH)
  635.         textHash[i][j] = NOTEXT;
  636.     }
  637.  
  638.     for (i=0; i<TYCONHSZ; ++i) {
  639.         Tycon tc = tyconHash[i];
  640.         while (nonNull(tc) && tc>=tyconHw)
  641.         tc = tycon(tc).nextTyconHash;
  642.         tyconHash[i] = tc;
  643.     }
  644.  
  645.     for (i=0; i<NAMEHSZ; ++i) {
  646.         Name n = nameHash[i];
  647.         while (nonNull(n) && n>=nameHw)
  648.         n = name(n).nextNameHash;
  649.         nameHash[i] = n;
  650.     }
  651.  
  652.     for (i=CLASSMIN; i<classHw; i++) {
  653.         List in = class(i).instances;
  654.         List is = NIL;
  655.  
  656.         if (class(i).dictIndex>=idxHw)
  657.         class(i).dictIndex = NOIDX;
  658.  
  659.         while (nonNull(in)) {
  660.         List temp = tl(in);
  661.         if (hd(in)<instHw) {
  662.             tl(in) = is;
  663.             is     = in;
  664.         }
  665.         in = temp;
  666.         }
  667.         class(i).instances = rev(is);
  668.     }
  669.  
  670.     for (i=0; i<idxHw; ++i)
  671.         if (idx(i).fail>=idxHw)
  672.         idx(i).fail = NOIDX;
  673.  
  674.     moduleHw = mno;
  675.     }
  676. }
  677.  
  678. /* --------------------------------------------------------------------------
  679.  * Heap storage:
  680.  * Provides a garbage collectable heap for storage of expressions etc.
  681.  * ------------------------------------------------------------------------*/
  682.  
  683. Int     heapSize = DEFAULTHEAP;        /* number of cells in heap       */
  684. Heap    heapCar;            /* array of fst component of pairs */
  685. Heap    heapCdr;            /* array of snd component of pairs */
  686. #ifndef GLOBALcar
  687. Heap    heapTopCar;
  688. #endif
  689. #ifndef GLOBALcdr
  690. Heap    heapTopCdr;
  691. #endif
  692. Long    numCells;
  693. Int     numberGcs;            /* number of garbage collections   */
  694.  
  695. static  Cell freeList;            /* free list of unused cells       */
  696.  
  697. Cell pair(l,r)                /* Allocate pair (l, r) from       */
  698. Cell l, r; {                /* heap, garbage collecting first  */
  699.     Cell c = freeList;            /* if necessary ...           */
  700.  
  701.     if (isNull(c)) {
  702.     garbageCollect();
  703.     c = freeList;
  704.     }
  705.     freeList = snd(freeList);
  706.     fst(c)   = l;
  707.     snd(c)   = r;
  708.     numCells++;
  709.     return c;
  710. }
  711.  
  712. Void overwrite(dst,src)            /* overwrite dst cell with src cell*/
  713. Cell dst, src; {            /* both *MUST* be pairs            */
  714.     if (isPair(dst) && isPair(src)) {
  715.         fst(dst) = fst(src);
  716.         snd(dst) = snd(src);
  717.     }
  718.     else
  719.         internal("overwrite");
  720. }
  721.  
  722. static Int *marks;
  723. static Int marksSize;
  724.  
  725. Cell markExpr(c)            /* External interface to markCell  */
  726. Cell c; {
  727.     return markCell(c);
  728. }
  729.  
  730. static Cell local markCell(c)        /* Traverse part of graph marking  */
  731. Cell c; {                /* cells reachable from given root */
  732.  
  733. mc: if (!isPair(c))
  734.     return c;
  735.  
  736.     if (fst(c)==INDIRECT) {
  737.     c = indirectChain(c);
  738.     goto mc;
  739.     }
  740.  
  741.     {   register place = placeInSet(c);
  742.     register mask  = maskInSet(c);
  743.     if (marks[place]&mask)
  744.         return c;
  745.     else
  746.         marks[place] |= mask;
  747.     }
  748.  
  749.     if (isPair(fst(c))) {
  750.     fst(c) = markCell(fst(c));
  751.     markSnd(c);
  752.     }
  753.     else if (isNull(fst(c)) || fst(c)>=BCSTAG)
  754.     markSnd(c);
  755.  
  756.     return c;
  757. }
  758.  
  759. static Void local markSnd(c)        /* Variant of markCell used to     */
  760. Cell c; {                /* update snd component of cell    */
  761.     Cell t;                /* using tail recursion           */
  762.  
  763. ma: t = snd(c);
  764. mb: if (!isPair(t))
  765.     return;
  766.  
  767.     if (fst(t)==INDIRECT) {
  768.     snd(c) = t = indirectChain(t);
  769.     goto mb;
  770.     }
  771.     c = snd(c) = t;
  772.  
  773.     {   register place = placeInSet(c);
  774.     register mask  = maskInSet(c);
  775.     if (marks[place]&mask)
  776.         return;
  777.     else
  778.         marks[place] |= mask;
  779.     }
  780.  
  781.     if (isPair(fst(c))) {
  782.     fst(c) = markCell(fst(c));
  783.     goto ma;
  784.     }
  785.     else if (isNull(fst(c)) || fst(c)>=BCSTAG)
  786.     goto ma;
  787.     return;
  788. }
  789.  
  790. static Cell local indirectChain(c)    /* Scan chain of indirections       */
  791. Cell c; {                /* Detecting loops of indirections */
  792.     Cell is = c;            /* Uses pointer reversal ...       */
  793.     c       = snd(is);
  794.     snd(is) = NIL;
  795.     fst(is) = INDIRECT1;
  796.  
  797.     while (isPair(c) && fst(c)==INDIRECT) {
  798.     register Cell temp = snd(c);
  799.     snd(c)  = is;
  800.     is      = c;
  801.     c       = temp;
  802.     fst(is) = INDIRECT1;
  803.     }
  804.  
  805.     if (isPair(c) && fst(c)==INDIRECT1)
  806.     c = nameBlackHole;
  807.  
  808.     do {
  809.     register Cell temp = snd(is);
  810.     fst(is) = INDIRECT;
  811.     snd(is) = c;
  812.     is    = temp;
  813.     } while (nonNull(is));
  814.  
  815.     return c;
  816. }
  817.  
  818. Void markWithoutMove(n)            /* Garbage collect cell at n, as if*/
  819. Cell n; {                /* it was a cell ref, but don't    */
  820.                     /* move cell (i.e. retain INDIRECT */
  821.                     /* at top level) so we don't have  */
  822.                     /* to modify the stored value of n */
  823.     if (isGenPair(n)) {
  824.     if (fst(n)==INDIRECT) {        /* special case for indirections   */
  825.         register place = placeInSet(n);
  826.         register mask  = maskInSet(n);
  827.         marks[place]  |= mask;
  828.         markSnd(n);
  829.     }
  830.     else
  831.         markCell(n);        /* normal pairs don't move anyway  */
  832.     }
  833. }
  834.  
  835. static Void local garbageCollect() {    /* Run garbage collector ...       */
  836.     Bool breakStat = breakOn(FALSE);    /* disable break checking       */
  837.     Int i,j;
  838.     register Int mask;
  839.     register Int place;
  840.     Int      recovered;
  841.     jmp_buf  regs;            /* save registers on stack       */
  842.     setjmp(regs);
  843.  
  844.     gcStarted();
  845.     for (i=0; i<marksSize; ++i)        /* initialise mark set to empty    */
  846.     marks[i] = 0;
  847.     everybody(MARK);            /* mark all components of system   */
  848.  
  849.     /* Just in case garbageCollect is triggered when free list is non-empty*/
  850.     /* (called by openFile for example), scan the free list and unmark all */
  851.     /* cells - which otherwise might have been marked from the Cstack      */
  852.     for (; nonNull(freeList); freeList=snd(freeList))
  853.     marks[placeInSet(freeList)] &= ~(maskInSet(freeList));
  854.  
  855.     gcScanning();            /* scan mark set           */
  856.     mask      = 1;
  857.     place     = 0;
  858.     recovered = 0;
  859.     j         = 0;
  860.     for (i=1; i<=heapSize; i++) {
  861.     if ((marks[place] & mask) == 0) {
  862.         if (fst(-i)==FILECELL) {
  863.         closeFile(intValOf(-i));
  864.         fst(-i) = INTCELL;
  865.         }
  866.         snd(-i)  = freeList;
  867.         freeList = -i;
  868.         recovered++;
  869.     }
  870.     mask <<= 1;
  871.     if (++j == bitsPerWord) {
  872.         place++;
  873.         mask = 1;
  874.         j    = 0;
  875.     }
  876.     }
  877.     gcRecovered(recovered);
  878.  
  879.     breakOn(breakStat);            /* restore break trapping if nec.  */
  880.  
  881.     /* can only return if freeList is nonempty on return. */
  882.     if (recovered<minRecovery || isNull(freeList)) {
  883.     ERROR(0) "Garbage collection fails to reclaim sufficient space"
  884.     EEND;
  885.     }
  886.     numberGcs++;
  887. }
  888.  
  889. /* --------------------------------------------------------------------------
  890.  * Code for saving last expression entered:
  891.  *
  892.  * This is a little tricky since some text values (e.g. strings or variable
  893.  * names) may not be defined or have the same value when the expression is
  894.  * recalled.  These text values are therefore saved in the top portion of
  895.  * the text table.
  896.  * ------------------------------------------------------------------------*/
  897.  
  898. static Cell lastExprSaved;        /* last expression to be saved       */
  899.  
  900. Void setLastExpr(e)            /* save expression for later recall*/
  901. Cell e; {
  902.     lastExprSaved = NIL;        /* in case attempt to save fails   */
  903.     savedText      = NUM_TEXT;
  904.     lastExprSaved = lowLevelLastIn(e);
  905. }
  906.  
  907. static Cell local lowLevelLastIn(c)    /* Duplicate expression tree (i.e. */
  908. Cell c; {                /* acyclic graph) for later recall */
  909.     if (isPair(c))            /* Duplicating any text strings    */
  910.     if (isBoxTag(fst(c)))        /* in case these are lost at some  */
  911.         switch (fst(c)) {        /* point before the expr is reused */
  912.         case VARIDCELL :
  913.         case VAROPCELL :
  914.         case DICTVAR   :
  915.         case CONIDCELL :
  916.         case CONOPCELL :
  917.         case STRCELL   : return pair(fst(c),saveText(textOf(c)));
  918.         default           : return pair(fst(c),snd(c));
  919.         }
  920.     else
  921.         return pair(lowLevelLastIn(fst(c)),lowLevelLastIn(snd(c)));
  922.     else
  923.     return c;
  924. }
  925.  
  926. Cell getLastExpr() {            /* recover previously saved expr   */
  927.     return lowLevelLastOut(lastExprSaved);
  928. }
  929.  
  930. static Cell local lowLevelLastOut(c)    /* As with lowLevelLastIn() above  */
  931. Cell c; {                /* except that Cells refering to   */
  932.     if (isPair(c))            /* Text values are restored to       */
  933.     if (isBoxTag(fst(c)))        /* appropriate values           */
  934.         switch (fst(c)) {
  935.         case VARIDCELL :
  936.         case VAROPCELL :
  937.         case DICTVAR   :
  938.         case CONIDCELL :
  939.         case CONOPCELL :
  940.         case STRCELL   : return pair(fst(c),
  941.                          findText(text+intValOf(c)));
  942.         default           : return pair(fst(c),snd(c));
  943.         }
  944.     else
  945.         return pair(lowLevelLastOut(fst(c)),lowLevelLastOut(snd(c)));
  946.     else
  947.     return c;
  948. }
  949.  
  950. /* --------------------------------------------------------------------------
  951.  * Miscellaneous operations on heap cells:
  952.  * ------------------------------------------------------------------------*/
  953.  
  954. /* profiling suggests that the number of calls to whatIs() is typically    */
  955. /* rather high.  The recoded version below attempts to improve the average */
  956. /* performance for whatIs() using a binary search for part of the analysis */
  957.  
  958. Cell whatIs(c)                   /* identify type of cell        */
  959. register Cell c; {
  960.     if (isPair(c)) {
  961.     register Cell fstc = fst(c);
  962.     return isTag(fstc) ? fstc : AP;
  963.     }
  964.     if (c<TUPMIN)    return c;
  965.     if (c>=INTMIN)   return INTCELL;
  966.  
  967.     if (c>=SELMIN)  if (c>=CLASSMIN)    if (c>=CHARMIN) return CHARCELL;
  968.                     else        return CLASS;
  969.             else        if (c>=INSTMIN) return INSTANCE;
  970.                     else        return SELECT;
  971.     else        if (c>=TYCMIN)    if (c>=NAMEMIN)    return NAME;
  972.                     else        return TYCON;
  973.             else        if (c>=OFFMIN)    return OFFSET;
  974.                     else        return TUPLE;
  975.  
  976. /*  if (c>=CHARMIN)  return CHARCELL;
  977.     if (c>=CLASSMIN) return CLASS;
  978.     if (c>=INSTMIN)  return INSTANCE;
  979.     if (c>=SELMIN)   return SELECT;
  980.     if (c>=NAMEMIN)  return NAME;
  981.     if (c>=TYCMIN)   return TYCON;
  982.     if (c>=OFFMIN)   return OFFSET;
  983.     if (c>=TUPMIN)   return TUPLE;
  984.     return c;*/
  985. }
  986.  
  987. Bool isVar(c)                /* is cell a VARIDCELL/VAROPCELL ? */
  988. Cell c; {                /* also recognises DICTVAR cells   */
  989.     return isPair(c) &&
  990.            (fst(c)==VARIDCELL || fst(c)==VAROPCELL || fst(c)==DICTVAR);
  991. }
  992.  
  993. Bool isCon(c)                   /* is cell a CONIDCELL/CONOPCELL ?  */
  994. Cell c; {
  995.     return isPair(c) && (fst(c)==CONIDCELL || fst(c)==CONOPCELL);
  996. }
  997.  
  998. Bool isInt(c)                   /* cell holds integer value?       */
  999. Cell c; {
  1000.     return isSmall(c) || (isPair(c) && fst(c)==INTCELL);
  1001. }
  1002.  
  1003. Int intOf(c)                   /* find integer value of cell?       */
  1004. Cell c; {
  1005.     return isPair(c) ? (Int)(snd(c)) : (Int)(c-INTZERO);
  1006. }
  1007.  
  1008. Cell mkInt(n)                   /* make cell representing integer   */
  1009. Int n; {
  1010.     return isSmall(INTZERO+n) ? INTZERO+n : pair(INTCELL,n);
  1011. }
  1012.  
  1013. /* --------------------------------------------------------------------------
  1014.  * List operations:
  1015.  * ------------------------------------------------------------------------*/
  1016.  
  1017. Int length(xs)                   /* calculate length of list xs       */
  1018. List xs; {
  1019.     Int n = 0;
  1020.     for (n=0; nonNull(xs); ++n)
  1021.     xs = tl(xs);
  1022.     return n;
  1023. }
  1024.  
  1025. List appendOnto(xs,ys)               /* Destructively prepend xs onto    */
  1026. List xs, ys; {                   /* ys by modifying xs ...       */
  1027.     if (isNull(xs))
  1028.     return ys;
  1029.     else {
  1030.     List zs = xs;
  1031.     while (nonNull(tl(zs)))
  1032.         zs = tl(zs);
  1033.     tl(zs) = ys;
  1034.     return xs;
  1035.     }
  1036. }
  1037.  
  1038. List revOnto(xs,ys)               /* Destructively reverse elements of*/
  1039. List xs, ys; {                   /* list xs onto list ys...       */
  1040.     Cell zs;
  1041.  
  1042.     while (nonNull(xs)) {
  1043.     zs     = tl(xs);
  1044.     tl(xs) = ys;
  1045.     ys     = xs;
  1046.     xs     = zs;
  1047.     }
  1048.     return ys;
  1049. }
  1050.  
  1051. Cell varIsMember(t,xs)               /* Test if variable is a member of  */
  1052. Text t;                    /* given list of variables       */
  1053. List xs; {
  1054.     for (; nonNull(xs); xs=tl(xs))
  1055.     if (t==textOf(hd(xs)))
  1056.         return hd(xs);
  1057.     return NIL;
  1058. }
  1059.  
  1060. Cell cellIsMember(x,xs)            /* Test for membership of specific  */
  1061. Cell x;                    /* cell x in list xs           */
  1062. List xs; {
  1063.     for (; nonNull(xs); xs=tl(xs))
  1064.     if (x==hd(xs))
  1065.         return hd(xs);
  1066.     return NIL;
  1067. }
  1068.  
  1069. List copy(n,x)                   /* create list of n copies of x       */
  1070. Int n;
  1071. Cell x; {
  1072.     List xs=NIL;
  1073.     while (0<n--)
  1074.     xs = cons(x,xs);
  1075.     return xs;
  1076. }
  1077.  
  1078. List diffList(from,take)           /* list difference: from\take       */
  1079. List from, take; {               /* result contains all elements of  */
  1080.     List result = NIL;               /* `from' not appearing in `take'   */
  1081.  
  1082.     while (nonNull(from)) {
  1083.     List next = tl(from);
  1084.     if (!cellIsMember(hd(from),take)) {
  1085.         tl(from) = result;
  1086.         result   = from;
  1087.     }
  1088.     from = next;
  1089.     }
  1090.     return rev(result);
  1091. }
  1092.  
  1093. List take(n,xs)                /* destructively trancate list to  */
  1094. Int  n;                    /* specified length           */
  1095. List xs; {
  1096.     List start = xs;
  1097.  
  1098.     if (n==0)
  1099.     return NIL;
  1100.     while (1<n-- && nonNull(xs))
  1101.     xs = tl(xs);
  1102.     if (nonNull(xs))
  1103.     tl(xs) = NIL;
  1104.     return start;
  1105. }
  1106.  
  1107. List removeCell(x,xs)            /* destructively remove cell from  */
  1108. Cell x;                    /* list                   */
  1109. List xs; {
  1110.     if (nonNull(xs)) {
  1111.     if (hd(xs)==x)
  1112.         return tl(xs);        /* element at front of list       */
  1113.     else {
  1114.         List prev = xs;
  1115.         List curr = tl(xs);
  1116.         for (; nonNull(curr); prev=curr, curr=tl(prev))
  1117.         if (hd(curr)==x) {
  1118.             tl(prev) = tl(curr);
  1119.             return xs;        /* element in middle of list       */
  1120.         }
  1121.     }
  1122.     }
  1123.     return xs;                /* here if element not found       */
  1124. }
  1125.  
  1126. /* --------------------------------------------------------------------------
  1127.  * Operations on applications:
  1128.  * ------------------------------------------------------------------------*/
  1129.  
  1130. Int argCount;                   /* number of args in application    */
  1131.  
  1132. Cell getHead(e)                /* get head cell of application       */
  1133. Cell e; {                   /* set number of args in argCount   */
  1134.     for (argCount=0; isAp(e); e=fun(e))
  1135.     argCount++;
  1136.     return e;
  1137. }
  1138.  
  1139. List getArgs(e)                /* get list of arguments in function*/
  1140. Cell e; {                   /* application:               */
  1141.     List as;                   /* getArgs(f e1 .. en) = [e1,..,en] */
  1142.  
  1143.     for (as=NIL; isAp(e); e=fun(e))
  1144.     as = cons(arg(e),as);
  1145.     return as;
  1146. }
  1147.  
  1148. Cell nthArg(n,e)               /* return nth arg in application    */
  1149. Int  n;                       /* of function to m args (m>=n)     */
  1150. Cell e; {                              /* nthArg n (f x0 x1 ... xm) = xn   */
  1151.     for (n=numArgs(e)-n-1; n>0; n--)
  1152.     e = fun(e);
  1153.     return arg(e);
  1154. }
  1155.  
  1156. Int numArgs(e)                   /* find number of arguments to expr */
  1157. Cell e; {
  1158.     Int n;
  1159.     for (n=0; isAp(e); e=fun(e))
  1160.     n++;
  1161.     return n;
  1162. }
  1163.  
  1164. Cell applyToArgs(f,args)           /* destructively apply list of args */
  1165. Cell f;                       /* to function f               */
  1166. List args; {
  1167.     while (nonNull(args)) {
  1168.     Cell temp = tl(args);
  1169.     tl(args)  = hd(args);
  1170.     hd(args)  = f;
  1171.     f      = args;
  1172.     args      = temp;
  1173.     }
  1174.     return f;
  1175. }
  1176.  
  1177. /* --------------------------------------------------------------------------
  1178.  * File operations:
  1179.  * ------------------------------------------------------------------------*/
  1180.  
  1181. static FILE *infiles[NUM_FILES];    /* file pointers for input files   */
  1182.  
  1183. Cell openFile(s)            /* create FILECELL object for named*/
  1184. String s; {                /* input file               */
  1185.     Int i;
  1186.  
  1187.     for (i=0; i<NUM_FILES && infiles[i]; ++i)    /* look for unused file .. */
  1188.     ;
  1189.     if (i>=NUM_FILES) {                /* if at first we don't    */
  1190.     garbageCollect();            /* succeed, garbage collect*/
  1191.     for (i=0; i<NUM_FILES && infiles[i]; ++i)
  1192.         ;                    /* and try again ...       */
  1193.     }
  1194.     if (i>=NUM_FILES) {                /* ... before we give up   */
  1195.     ERROR(0) "Too many files open; cannot open %s", s
  1196.     EEND;
  1197.     }
  1198.  
  1199.     if (infiles[i]=fopen(s,"r"))
  1200.     return ap(FILECELL,i);
  1201.     else
  1202.     return NIL;
  1203. }
  1204.  
  1205. Void evalFile(f)                /* read char from given    */
  1206. Cell f; {                    /* input file -- ensure       */
  1207.     Int c;                    /* only 1 copy of FILECELL */
  1208.     if ((c = fgetc(infiles[intValOf(f)]))==EOF) {
  1209.     closeFile(intValOf(f));
  1210.     fst(f) = INDIRECT;
  1211.     snd(f) = nameNil;
  1212.     }
  1213.     else {
  1214.     snd(f) = ap(FILECELL,intValOf(f));
  1215.     fst(f) = NIL;    /* avoid having 2 copies of FILECELL, so that file */
  1216.             /* is not closed prematurely by garbage collector  */
  1217.     fst(f) = consChar(c);
  1218.     }
  1219. }
  1220.  
  1221. static Void local closeFile(n)            /* close input file n       */
  1222. Int n; {                    /* only permitted when the */
  1223.     if (0<=n && n<NUM_FILES && infiles[n]) {    /* end of file is read or  */
  1224.     fclose(infiles[n]);            /* when discarded during gc*/
  1225.     infiles[n] = 0;
  1226.     }
  1227. }
  1228.  
  1229. /* --------------------------------------------------------------------------
  1230.  * storage control:
  1231.  * ------------------------------------------------------------------------*/
  1232.  
  1233. Void storage(what)
  1234. Int what; {
  1235.     Int i;
  1236.  
  1237.     switch (what) {
  1238.     case RESET   : clearStack();
  1239.  
  1240.                /* the next 2 statements are particularly important
  1241.                 * if you are using GLOBALcar or GLOBALcdr since the
  1242.             * corresponding registers may be reset to their
  1243.             * uninitialised initial values by a longjump.
  1244.             */
  1245.                heapTopCar = heapCar + heapSize;
  1246.                heapTopCdr = heapCdr + heapSize;
  1247.  
  1248.                if (isNull(lastExprSaved))
  1249.                savedText = NUM_TEXT;
  1250.                break;
  1251.  
  1252.     case MARK    : for (i=TYCMIN; i<tyconHw; ++i) {
  1253.                mark(tycon(i).defn);
  1254.                mark(tycon(i).kind);
  1255.                mark(tycon(i).what);
  1256.                }
  1257.  
  1258.                for (i=NAMEMIN; i<nameHw; ++i) {
  1259.                mark(name(i).defn);
  1260.                mark(name(i).type);
  1261.                }
  1262.  
  1263.                for (i=CLASSMIN; i<classHw; ++i) {
  1264.                mark(class(i).sig);
  1265.                mark(class(i).head);
  1266.                mark(class(i).supers);
  1267.                mark(class(i).members);
  1268.                mark(class(i).defaults);
  1269.                            mark(class(i).instances);
  1270.                }
  1271.  
  1272.                for (i=INSTMIN; i<instHw; ++i) {
  1273.                mark(inst(i).sig);
  1274.                mark(inst(i).head);
  1275.                mark(inst(i).specifics);
  1276.                mark(inst(i).implements);
  1277.                }
  1278.  
  1279.                for (i=0; i<=sp; ++i)
  1280.                mark(stack(i));
  1281.  
  1282.                        for (i=0; i<dictHw; ++i)
  1283.                            mark(dict(i));
  1284.  
  1285.                mark(lastExprSaved);
  1286.  
  1287.                        gcCStack();
  1288.  
  1289.                break;
  1290.  
  1291.     case INSTALL : clearStack();
  1292.  
  1293.                for (i=0; i<NUM_FILES; i++)
  1294.                infiles[i] = 0;
  1295.  
  1296.                heapCar = heapAlloc(heapSize);
  1297.                heapCdr = heapAlloc(heapSize);
  1298.  
  1299.                if (heapCar==(Heap)0 || heapCdr==(Heap)0) {
  1300.                ERROR(0) "Cannot allocate heap storage (%d cells)",
  1301.                     heapSize
  1302.                EEND;
  1303.                }
  1304.  
  1305.                heapTopCar = heapCar + heapSize;
  1306.                heapTopCdr = heapCdr + heapSize;
  1307.  
  1308.                for (i=1; i<heapSize; ++i)
  1309.                snd(-i) = -(i+1);
  1310.                snd(-heapSize) = NIL;
  1311.                freeList       = -1;
  1312.                numberGcs      = 0;
  1313.  
  1314.                marksSize  = bitArraySize(heapSize);
  1315.                if ((marks=(Int *)calloc(marksSize, sizeof(Int)))==0) {
  1316.                ERROR(0) "Unable to allocate gc markspace"
  1317.                EEND;
  1318.                }
  1319.  
  1320.                textHw         = 0;
  1321.                nextNewText   = NUM_TEXT;
  1322.                nextNewDText  = (-1);
  1323.                lastExprSaved = NIL;
  1324.                savedText     = NUM_TEXT;
  1325.                for (i=0; i<TEXTHSZ; ++i)
  1326.                textHash[i][0] = NOTEXT;
  1327.  
  1328.                syntaxHw = 0;
  1329.  
  1330.                addrHw    = 0;
  1331.  
  1332.                tyconHw    = TYCMIN;
  1333.                for (i=0; i<TYCONHSZ; ++i)
  1334.                tyconHash[i] = NIL;
  1335.  
  1336.                nameHw = NAMEMIN;
  1337.                for (i=0; i<NAMEHSZ; ++i)
  1338.                nameHash[i] = NIL;
  1339.  
  1340.                classHw    = CLASSMIN;
  1341.  
  1342.                instHw    = INSTMIN;
  1343.  
  1344.                idxHw    = 0;
  1345.  
  1346.                dictHw    = 0;
  1347.  
  1348.                tabInst    = (struct Inst far *)
  1349.                     farCalloc(NUM_INSTS,sizeof(struct Inst));
  1350.                tabIndex = (struct Idx far *)
  1351.                     farCalloc(NUM_INDEXES,sizeof(struct Idx));
  1352.                tabDict    = (Cell far *)
  1353.                     farCalloc(NUM_DICTS,sizeof(Cell));
  1354.  
  1355.                if (tabInst==0 || tabIndex==0 || tabDict==0) {
  1356.                ERROR(0) "Cannot allocate instance tables"
  1357.                EEND;
  1358.                }
  1359.  
  1360.                moduleHw = 0;
  1361.  
  1362.                break;
  1363.     }
  1364. }
  1365.  
  1366. /*-------------------------------------------------------------------------*/
  1367.