home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / lib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  19.2 KB  |  757 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #include "hdr.h"
  10. #include "vars.h"
  11. #include "libhdr.h"
  12. #include "ifile.h"
  13. #include "dbxprots.h"
  14. #include "miscprots.h"
  15. #include "smiscprots.h"
  16. #include "setprots.h"
  17. #include "libfprots.h"
  18. #include "librprots.h"
  19. #include "libprots.h"
  20.  
  21. static char *update_lib_maps_remove(char *, int);
  22. static void sym_restore(Symbol);
  23.  
  24. /* keeping unit_nodes as tuple, unit_nodes_now is number of actual elements */
  25. void unit_nodes_add();
  26.  
  27. /*
  28.  *   Procedures in this module serve two phases of the compiler:
  29.  *
  30.  *     (1)  maintaining a program library during semantic translation,
  31.  *
  32.  *     (2)  reading in and writing out the intermediate files associated with
  33.  *        semantic processing.
  34.  *
  35.  *   Three types of files are used here:
  36.  *
  37.  *    AIS files    information generated during the translation of a source 
  38.  *             file,
  39.  *
  40.  *    TRE files    intermediate code
  41.  *
  42.  *    LIB files    directory to units in AIS files,
  43.  *
  44.  *    LIB files and AIS files are each organized as a pair of maps whose
  45.  *    domain elements are unique compilation unit names such as:
  46.  *
  47.  *    ['subprog spec', 'MAIN']
  48.  *
  49.  *    ['spec', 'MATH_PACK']
  50.  *
  51.  *    ['subprog', 'SIN', 'MATH_PACK']
  52.  *
  53.  *   The first string in these names is gives the unit's class as seen
  54.  *   by the binder:
  55.  *
  56.  *    'subprog spec', 'subprog'  -- subprogram specifications & bodies
  57.  *
  58.  *    'spec', 'body'    -- package specifications & module bodies
  59.  *
  60.  *   The second string is the name of the compilation unit itself.  If
  61.  *   this is a subunit, the remaining names are those of its enclosing
  62.  *   scopes.
  63.  *
  64.  *   A LIB file is a pair of maps from these unique names to the
  65.  *   appropriate AIS files names:
  66.  *
  67.  *    (1)  LIB_UNIT, which indicates the file containing the
  68.  *         translation of each compilation unit, and
  69.  *
  70.  *    (2)  LIB_STUB, which indicates the file containing the
  71.  *         translation of the stub of the subunit.
  72.  *
  73.  *   Each AIS file is a parallel pair of maps, again from unique names,
  74.  *   containing the translation of each compilation unit and the
  75.  *   environment of each stub.    For convenience, these two maps are split
  76.  *   into five within the translator itself:
  77.  *
  78.  *   COMP_DATE
  79.  *    A map for each compilation unit to compilation dates & times
  80.  *    checking consistency).    Dates themselves are a tuple including
  81.  *    the date and clock time of translation, and an indication of
  82.  *    the order of compilation within a single session.
  83.  *
  84.  *   PRE_COMP
  85.  *    List of units that should have been compiled before this one.
  86.  *
  87.  *   UNIT_DECL
  88.  *    The declarations that can be seen by other units, or that will
  89.  *    be needed later by the translator.
  90.  *
  91.  *   STUB_ENV
  92.  *    The environment at the point where the stub was declared.
  93.  *
  94.  *   During the initialization of the compiler, several predefined
  95.  *   library units are read in and permanently installed.  These units
  96.  *   are not included explicitly in the library, but may be accessed
  97.  *   as if they were.  The information from their AIS files is stored in
  98.  *   the map 'predef_map' (local to this module), and a set of those
  99.  *   currently available (not displaced by a user's unit) is maintained
  100.  *   in the global variable PREDEF_UNITS.  For simplicity, these
  101.  *   predefined units may not have stubs.
  102.  *
  103.  *   The semantic analyser has access to compilation information in the
  104.  *   AIS files through the procedures RETRIEVE and STUB_RETRIEVE.  When
  105.  *   called, these two procedures try to make the requested information
  106.  *   available in the five compilation maps listed above (it may read
  107.  *   an AIS file, copy from predef_map or the information may
  108.  *   already be present). If successful, they return the value TRUE,
  109.  *   otherwise they return FALSE.
  110.  *
  111.  *   UPDATE_LIB_MAPS is called to do some housekeeping when a new 
  112.  *   compilation unit is started.
  113.  *
  114.  *   The user may choose to not use the separate compilation facility
  115.  *   and put every compilation unit into one file.  In this case,
  116.  *   the LIB file can be omitted, since its role is to group several
  117.  *   AIS files together.  Furthermore, since AIS files contain all of
  118.  *   the information produced by a translation session, more than
  119.  *   one LIB file may refer to a single AIS file.
  120.  */
  121.  
  122.  
  123.  
  124. extern IFILE *LIBFILE;
  125.  
  126. int init_predef()                /*;init_predef*/
  127. {
  128.     char *lname;
  129.     char *t_name;
  130.     extern char *PREDEFNAME;
  131.  
  132.     lname = libset(PREDEFNAME); /* set PREDEF library as library */
  133.     LIBFILE = ifopen("predef", "lib", "r", "l", iot_lib_r, 0);
  134.     t_name =libset(lname); /* restore prior library */
  135.     return(read_lib());    /* number of units read */
  136. }
  137.  
  138. char *predef_unit_name(int i)                            /*;predef_unit_name*/
  139. {
  140.     static    char *predef_unit_names[15] = { "",
  141.      "spSYSTEM", "spIO_EXCEPTIONS", "spSEQUENTIAL_IO", 
  142.      "boSEQUENTIAL_IO", "spDIRECT_IO", "boDIRECT_IO", 
  143.       "spTEXT_IO", "boTEXT_IO", "spCALENDAR", "boCALENDAR",
  144.       "ssUNCHECKED_DEALLOCATION", "suUNCHECKED_DEALLOCATION",
  145.       "ssUNCHECKED_CONVERSION", "suUNCHECKED_CONVERSION"};
  146.     return predef_unit_names[i];
  147. }
  148.  
  149. int predef_node_count(int i)                            /*;predef_node_count*/
  150. {
  151.     static int node_count[15] = {0,166, 29, 449, 5, 620, 5, 2654, 17, 470, 5,
  152.       20, 21, 19, 32};
  153.     return node_count[i];
  154. }
  155.  
  156. int predef_symbol_count(int i)                        /*;predef_symbol_count*/
  157. {
  158.     static int symbol_count[15] = {0,31, 13, 61, 0, 88, 0, 409, 1, 83, 1,
  159.       5, 0 ,4 ,1};
  160.     return symbol_count[i];
  161. }
  162.  
  163. int retrieve(char *name)                            /*;retrieve*/
  164. {
  165.     char    *fname;
  166.     /*
  167.      * If the unit 'name' has not previously been read from
  168.      * an AIS file, the file is read and its the unit's contents added
  169.      * to the compilation maps.
  170.      */
  171.  
  172. #ifdef TBSN
  173.     if (getdebug) TO_ERRFILE(strjoin("RETRIEVE ", name));
  174. #endif
  175.     fname = lib_unit_get(name);
  176.     if (fname == NULL) return FALSE;
  177.     if (!streq(fname, AISFILENAME) && !in_aisunits_read(name)){
  178.         if (read_ais(fname, FALSE, name, 0, TRUE) == NULL) { 
  179.             return FALSE;  /* Message emitted by READ_AIS.*/
  180.         }
  181.     }
  182.     return TRUE;
  183. }
  184.  
  185. int last_comp_index(IFILE *ifile)                        /*;last_comp_index*/
  186. {
  187.     /* determine the number of comp units in ifile. */
  188.     long    rec;
  189.     int        i;
  190.  
  191.     i=0;
  192.     for (rec=read_init(ifile); rec!=0; rec=read_next(ifile,rec)) i++; 
  193.     return i;
  194. }
  195.  
  196. int stub_retrieve(char *name)                    /*;stub_retrieve*/
  197. {
  198.     char    *fname;
  199.     Tuple    stubtup, tup;
  200.     int        si, n, i;
  201.  
  202.     /*
  203.      * Reads, if necessary, information from the file in which the stub
  204.      * 'name' was declared.
  205.      */
  206. #ifdef TBSN
  207.     if (putdebug) TO_ERRFILE(strjoin("STUB_RETRIEVE ", name));
  208. #endif
  209.     fname = lib_stub_get(name);
  210.     if (fname == NULL) return FALSE;
  211.     if (!streq(fname, AISFILENAME)) {
  212.         si = stub_numbered(name);
  213.         stubtup = (Tuple) stub_info[si];
  214.         tup = (Tuple) stubtup[4];
  215.         n = tup_size(tup);
  216.         for (i = 1;i <= n; i++) {
  217.              retrieve(pUnits[(int)tup[i]]->name);
  218.         }
  219.         if (!read_stub(fname, name, "st1")) return FALSE;
  220.     }
  221.     return TRUE;
  222. }
  223.  
  224. void update_lib_maps(char *name, char unit_typ)                /*;update_lib_maps*/
  225. {
  226.     char    *uname, *body, *typ, *other, *unit;
  227.     int    i;
  228.  
  229.     /*
  230.      * Add current unit -name- to lib map, and remove references in
  231.      * library maps to previously compiled units with the same name.
  232.      * 
  233.      * The effect of constant map 'remove' in SETL version is achieved
  234.      * in C using procedure update_lib_maps_remove, which is to be
  235.      * found after this procedure.
  236.      */
  237.  
  238.     uname = unit_name_type(name);
  239.     if (unit_typ == 'u') {
  240.         if (streq(uname , "sp") && lib_unit_get(name) != NULL) {
  241.             body = strjoin("bo", unit_name_names(name));
  242.             if (lib_unit_get(body) != NULL)
  243.             lib_unit_put(body, NULL);
  244.         }
  245.     /*
  246.      * If no other units points to the AISCODE in question, remove it
  247.      * from LIB_AIS.  In principle, something analoguous should may be done
  248.      * for systems that allows deletion of a file.
  249.      */
  250.         lib_unit_put(name, AISFILENAME);
  251.         for (i = 1;i <= 2; i++) {
  252.             typ = update_lib_maps_remove(uname, i);
  253.             /*(forall typ in (remove(name(1)) ? {}) )*/
  254.             if (typ == NULL) continue;
  255.             /*other := [typ] + name(2..);*/
  256.             other = strjoin(typ, unit_name_names(name));
  257.             if (lib_unit_get(other) != NULL) {
  258.                 lib_unit_put(other, NULL);
  259.                 empty_unit_slots++;
  260.              }
  261.         }
  262.     }
  263.     else if  (unit_typ == 's') {
  264.         lib_stub_put(name, AISFILENAME);
  265.         if (streq(uname, "su"))
  266.             unit = strjoin("bo", unit_name_names(name));
  267.         else if (streq(uname, "bo"))
  268.             unit = strjoin("su", unit_name_names(name));
  269.         if (lib_stub_get(unit) != NULL) 
  270.             lib_stub_put(unit, NULL);
  271.     }
  272. }
  273.  
  274. static char *update_lib_maps_remove(char *nam, int lev)
  275. {
  276.     /*
  277.      *    const remove = {
  278.      *    ['ss', {'sp', 'bo'} ],
  279.      *    ['su', {'sp', 'bo'} ],
  280.      *    ['sp', {'ss', 'su'} ],
  281.      *    ['bo', {'ss', 'su'} ] };
  282.      */
  283.     if (streq(nam, "ss") || streq(nam, "su")) {
  284.         if (lev == 1) return "sp";
  285.         else return "bo";
  286.     }
  287.     else if (streq(nam, "sp") || streq(nam, "bo")) {
  288.        if (lev == 1) return "ss";
  289.        else return "su";
  290.     }
  291.     else return NULL;
  292. }
  293.  
  294. /* unit_name... procedures */
  295. char *unit_name_name(char *u)
  296. {
  297.     int    n;
  298.     char    *s1, *s2;
  299.  
  300.     n  = strlen(u);
  301.     if ( n <= 2) return NULL;
  302.     s1 = u + 2;                /* point to start of name*/
  303.     s2 = strchr(s1, '.');    /* look for dot after first name */
  304.     if (s2 == NULL)            /* if no dot take rest of string */
  305.         s2 = u + n;            /* find end */
  306.     n = s2 - s1;
  307.     s2 = smalloc((unsigned) n+1);
  308.     strncpy(s2, s1, n);
  309.     s2[n] = '\0';            /* terminate result */
  310.     return (s2);
  311. }
  312.  
  313. int stub_parent_get(char *stub)                    /*;stub_parent_get*/
  314. {
  315.     int    si;
  316.     Tuple    stubtup;
  317.  
  318.     /*
  319.      * return the comp unit number of the parent unit for stub. 
  320.      */
  321.     si = stub_numbered(stub);
  322.     if (si == 0) return 0;
  323.     stubtup = (Tuple) stub_info[si];
  324.     return (int) stubtup[5];
  325. }
  326.  
  327. void stub_parent_put(char *stub, char *parent)                /*;stub_parent_put*/
  328. {
  329.     int    si;
  330.     Tuple    stubtup;
  331.     si = stub_numbered(stub);
  332.     stubtup = (Tuple) stub_info[si];
  333.     stubtup[5] = (char *) unit_numbered(parent);
  334. }
  335.  
  336. char *unit_name_names(char *u)                /*;unit_name_names*/
  337. {
  338.     char    *s1;
  339.  
  340.     if (u == NULL || strlen(u) <= 2)
  341.         chaos("unit_name_names: invalid unit name");
  342.     s1 = u+2;        /* point to start of names fields */
  343.     return strjoin("", s1);
  344. }
  345.  
  346. char *stub_ancestors(char *u)                    /*;stub_ancestors*/
  347. {
  348.     char    *s1;
  349.  
  350.     if (strlen(u) <= 2) return strjoin("", "");
  351.     s1 = strchr(u+2, '.');        /* look for dot after first name */
  352.     if (s1 == NULL) return strjoin("", "");
  353.     return strjoin(s1+1, "");
  354. }
  355.     
  356. char *stub_ancestor(char *u)                    /*;stub_ancestor*/
  357. {
  358.     char    *s1;
  359.  
  360.     if (strlen(u) <= 2) return strjoin("", "");
  361.     s1 = strrchr(u, '.');        /* seek last dot of name*/
  362.     if (s1 == NULL) s1 = u+1;    /* called on unit name which is not stub*/
  363.     return strjoin("", s1+1);    /* return rest of string */
  364. }
  365.  
  366. int is_subunit(char *u)                /*;is_subunit*/
  367. {
  368.     char    *s1, *s2;
  369.  
  370.     if (u == NULL) chaos("is_subunit: null pointer");
  371.  
  372.     if (strlen(u) <= 2) return FALSE;
  373.     s1 = u+2;                /* point to start of name*/
  374.     s2 = strchr(s1, '.');    /* look for dot after first name */
  375.     if (s2 == NULL)            /* if no dot take rest of string */
  376.         return FALSE;
  377.     return TRUE; /* if subunit*/
  378. }
  379.  
  380. void unit_nodes_add(Node node)                 /*;unit_nodes_add*/
  381. {
  382.     if (node == (Node)0 || N_UNIT(node) == 0) return;
  383.     if (N_UNIT(node) != unit_number_now) return;
  384.     if (tup_mem((char *) node, unit_nodes))  return;
  385.     unit_nodes = tup_with(unit_nodes, (char *)node);
  386. }
  387.  
  388. Unitdecl unit_decl_new()                /*;unit_decl_new*/
  389. {
  390.  
  391.     return (Unitdecl) ecalloct(sizeof(Unitdecl_s), 1, "unit-decl-new");
  392. }
  393.  
  394. Stubenv stubenv_new()                    /*;stubenv_new*/
  395. {
  396.     return (Stubenv) ecalloct(sizeof(Stubenv_s), 1, "stubenv-new");
  397. }
  398.  
  399. void unit_decl_put(char *u, Unitdecl t)                /*;unit_decl_put*/
  400. {
  401.     int    i;
  402.     if (t->ud_unam != (Symbol)0)
  403.          NEEDNAME(t->ud_unam) = TRUE;
  404.     i = unit_number(u);
  405.     pUnits[i]->aisInfo.unitDecl = (char *) t;
  406. }
  407.  
  408. Unitdecl unit_decl_get(char *u)                /*;unit_decl_get*/
  409. {
  410.     int    i;
  411.     i = unit_numbered(u);
  412.     if (i == 0) return (Unitdecl)0;        /* if not yet defined */
  413.     return (Unitdecl) pUnits[i]->aisInfo.unitDecl; /*UNIT_DECL*/
  414. }
  415.  
  416. char *lib_unit_get(char *name)                /*;lib_unit_get*/
  417. {
  418.     int    i;
  419.  
  420.     i = unit_numbered(name);
  421.     if (i == 0) return NULL;
  422.     if (streq(pUnits[i]->libInfo.obsolete, string_ok))
  423.         return pUnits[i]->libInfo.fname;
  424.     else
  425.         return NULL;
  426. }
  427.  
  428. void lib_unit_put(char *uname, char *fname)            /*;lib_unit_put*/
  429. {
  430.     int    i;
  431.     struct unit *pUnit;
  432.  
  433.     i = unit_numbered(uname);
  434.     if (i == 0) return;
  435.     pUnit = pUnits[i];
  436.     if (fname == NULL) {
  437.         pUnit->libInfo.obsolete = string_ds;
  438.         pUnit->libUnit = string_ds;
  439.         pUnit->isMain = 0;
  440.     }
  441.     else {
  442.         pUnit->libInfo.fname = fname;
  443.         pUnit->libInfo.obsolete =string_ok;    /*"ok"*/
  444.         pUnit->libUnit = strjoin(uname, "");
  445.     }
  446. }
  447.  
  448. char *lib_stub_get(char *name)                /*;lib_stub_get*/
  449. {
  450.     int    i;
  451.     Tuple    tup;
  452.     i = stub_numbered(name);
  453.     if (i == 0) return NULL; 
  454.     tup = (Tuple) stub_info[i];
  455.     return tup[1];
  456. }
  457.  
  458. void lib_stub_put(char *sname, char *fname)                /*;lib_stub_put*/
  459. {
  460.     int    i;
  461.     Tuple    tup;
  462.  
  463.     i = stub_number(sname);
  464.     if (fname == NULL)
  465.         lib_stub[i] = strjoin(string_ds, "");
  466.     else {
  467.         tup = (Tuple) stub_info[i];
  468.         tup[1] = fname;
  469.     }
  470. }
  471.  
  472. int current_level_get(char *sname)                        /*;current_level_get*/
  473. {
  474.     Tuple    tup;
  475.     int    i,cur_level;
  476.  
  477.     i = stub_numbered(sname);
  478.     if (i == 0) return 0; 
  479.     tup = (Tuple) stub_info[i];
  480.     cur_level = (int) tup[3] ;
  481.     return cur_level;
  482. }
  483.  
  484. void current_level_put(char *sname, int cur_level)        /*;current_level_put*/
  485. {
  486.     int    i;
  487.     Tuple    tup;
  488.  
  489.     i = stub_numbered(sname);
  490.     tup = (Tuple) stub_info[i];
  491.     tup[3] = (char *) cur_level;
  492. }
  493.  
  494. int stub_number(char *name)                    /*;stub_number*/
  495. {
  496.     int i, n;
  497.     Tuple  stubtup;
  498.  
  499.     n = tup_size(lib_stub);
  500.     for (i = 1; i <= n; i++)
  501.         if (streq(lib_stub[i], name)) return i;
  502.     lib_stub = tup_exp(lib_stub, (unsigned) n+1);
  503.     lib_stub[n+1] = strjoin(name, ""); 
  504.     stub_info = tup_exp(stub_info, (unsigned) n+1);
  505.     stubtup = tup_new(5);
  506.     /*
  507.      * [1] == stub filename 
  508.      * [2] == Stubenv
  509.      * [3] == current level
  510.      * [4] == tuple of stub node units
  511.      * [5] == stub parent
  512.      */
  513.     stubtup[4] = (char *) tup_new(0);
  514.     stub_info[n+1] = (char *) stubtup;
  515.     return n+1;
  516. }
  517.  
  518. int stub_numbered(char *name)                    /*;stub_numbered*/
  519. {
  520.     int i, n;
  521.  
  522.     n = tup_size(lib_stub);
  523.     for (i = 1; i <= n; i++)
  524.         if (streq(lib_stub[i], name)) return i;
  525.     return 0;
  526. }
  527.  
  528. int unit_number(char *name)                    /*;unit_number*/
  529. {
  530.     int i;
  531.  
  532.     for (i = 1;i <= unit_numbers; i++) {
  533.          if (pUnits[i]->name != NULL && 
  534.         streq(pUnits[i]->name, name)) return i;
  535.     }
  536. /*
  537.     if (empty_unit_slots) {
  538.         for (i = 1;i <= unit_numbers; i++) {
  539.         if (pUnits[i]->name == NULL) {
  540.            empty_unit_slots--;
  541.            break;
  542.         }
  543.         }
  544.     }
  545.     else {
  546. */
  547.         i = unit_numbers + 1;
  548.         unit_number_expand(i);
  549. /*
  550.     }
  551. */
  552.     pUnits[i]->name = strjoin(name, "");
  553.     return i;
  554. }
  555.  
  556. void unit_number_expand(int n)                /*;unit_number_expand */
  557. {
  558.     struct unit *pUnit;
  559.  
  560.     if (n > MAX_UNITS) {    /* Figure out the way we die. bp */
  561.         fprintf(stderr, "Too many units\n");
  562.         exit(1);
  563.     }
  564.     /* expand unit_names et. al. to permit up to n entries */
  565.     if (n <= unit_numbers) return;
  566.     while (unit_numbers <n) {
  567.         unit_numbers += 1;
  568.         pUnit = pUnits[unit_numbers]
  569.           = (struct unit *)emalloc(sizeof(struct unit));
  570.         pUnit->name = strjoin(string_ds, "");
  571.         pUnit->isMain = 0;
  572.         pUnit->libUnit = strjoin(string_ds, "");
  573.         /* initially current ais file (tre file) name*/
  574.         pUnit->libInfo.fname = AISFILENAME;
  575.         pUnit->libInfo.obsolete = string_ok;
  576.         pUnit->libInfo.currCodeSeg = NULL;
  577.         pUnit->libInfo.localRefMap = (char *)tup_new(0);
  578.         pUnit->libInfo.compDate = NULL;
  579.         pUnit->aisInfo.compDate = NULL;
  580.         pUnit->aisInfo.preComp = NULL;
  581.         pUnit->aisInfo.unitDecl = NULL;
  582.         pUnit->aisInfo.pragmaElab = NULL;
  583.         pUnit->aisInfo.numberSymbols = 0;
  584.         pUnit->aisInfo.symbols = NULL;
  585.         pUnit->treInfo.nodeCount = 0;
  586.         pUnit->treInfo.tableAllocated = NULL;
  587.     }
  588. }
  589.  
  590. int unit_numbered(char *name)                /*;unit_numbered*/
  591. {
  592.     int i;
  593.     
  594.     for (i = 1; i <= unit_numbers; i++)
  595.          if (streq(pUnits[i]->name, name)) return i;
  596.     return 0;
  597. }
  598.  
  599. int in_aisunits_read(char *f)                    /*;in_aisunits_read*/
  600. {
  601.     int i, n;
  602.  
  603.     n = tup_size(aisunits_read);
  604.     for (i = 1; i <= n; i++)
  605.         if (streq(aisunits_read[i], f)) return TRUE;
  606.     return FALSE;
  607. }
  608.  
  609. Symbol getsymptr(int seq, int unit)        /*;getsymptr*/
  610. {
  611.     /* here to convert seq and unit to pointer to symbol.
  612.      * we require that the symbol has already been allocated
  613.      */
  614.     Tuple    symptr;
  615.     Symbol    sym;
  616.     int    items;
  617.     /* here to convert seq and unit to pointer to symbol.
  618.      * we require that the symbol has already been allocated
  619.      */
  620.     /* TBSL: need to get SEQPTR table for unit, and return address
  621.      */
  622.  
  623.     if (unit == 0 ) {
  624.         if (seq == 0) return (Symbol)0;
  625.         if (seq>0 && seq <= tup_size(init_symbols)) {
  626.             sym = (Symbol) init_symbols[seq];
  627.             return sym;
  628.         }    
  629.         else
  630.             chaos("unit 0 error getsymptr");
  631.     }
  632.     if (unit <= unit_numbers) {
  633.         struct unit *pUnit = pUnits[unit];
  634.         symptr = (Tuple) pUnit->aisInfo.symbols;
  635.         if (symptr == (Tuple)0) {
  636.             items = pUnit->aisInfo.numberSymbols;
  637.             symptr = tup_new(items);
  638.             pUnit->aisInfo.symbols = (char *) symptr;
  639.         }
  640.         if (seq <= tup_size(symptr)) {
  641.             sym = (Symbol) symptr[seq];
  642.             if (sym == (Symbol)0) {
  643.                  sym = sym_new_noseq(na_void);
  644.                  symptr[seq] = (char *) sym;
  645.                  S_SEQ(sym) = seq;
  646.                  S_UNIT(sym) = unit;
  647.             }
  648. #ifdef DEBUG
  649.             if (trapss>0 && seq == trapss && unit == trapsu) traps(sym);
  650. #endif
  651.             return sym; /* return newly allocated symbol */
  652.         }
  653.         else
  654.             chaos("getsymptr error"); return (Symbol) 0;
  655.      }
  656.     chaos("getsymptr unable to find node"); return (Symbol) 0;
  657. }
  658.  
  659. void symtab_restore(Tuple s_info)        /*;symtab_restore*/
  660. {
  661.     int        i, n;
  662.  
  663.     n = tup_size(s_info);
  664.     for (i = 1; i <= n; i++)
  665.         sym_restore((Symbol)s_info[i]);
  666. }
  667.  
  668. static void sym_restore(Symbol sym)                /*;sym_restore*/
  669. {
  670.     Symbol    unam;
  671.     
  672.     unam = getsymptr(S_SEQ(sym), S_UNIT(sym));
  673.     sym_copy(unam, sym);
  674. }
  675.  
  676. Tuple sym_save(Tuple m, Symbol sym, char unit_typ)            /*;sym_save*/
  677. {
  678.     /* we maintain the SETL symbtab_map map from symbol table pointers to 
  679.      * symbol table entries as a tuple of symbol table pointers. From
  680.      * each symbol table pointer we can obtain the symbol table entries
  681.      * contained in the SETL map.
  682.      */
  683.     int    i, n, seq, unit, exists;
  684.  
  685.     seq = S_SEQ(sym);
  686.     unit = S_UNIT(sym);
  687.     /* save only if in current unit */
  688.     if (unit != unit_number_now && unit_typ == 'u') return m; 
  689.     n = tup_size(m);
  690.     exists = FALSE;
  691.     for (i = 1; i <= n; i++) {
  692.         if (S_SEQ((Symbol) m[i]) == seq && S_UNIT((Symbol) m[i]) == unit) {
  693.             exists = TRUE;
  694.             break;
  695.         }
  696.     }
  697.     if (!exists) {            /* expand and allocate new symbol entry */
  698.         m = (Tuple) tup_exp(m, (unsigned) n+1);
  699.         i = n + 1;
  700.         m[i] = (char *) sym_new_noseq(na_void);
  701.     }
  702.     sym_copy((Symbol) m[i], sym);
  703.     return m;
  704. }
  705.  
  706. void libnodt(IFILE *ofile, Node node, int fnums, int has_n_list)    /*;libnodt*/
  707. {
  708.     /* write info for node to file */
  709.     /* this is called only if trace desired, it writes no data */
  710.     
  711.     unsigned    int nk;
  712.     Node    nod;
  713.     Symbol    sym;
  714.  
  715.     /* copy standard info */
  716. #ifdef IOT
  717.     nk = N_KIND(node);
  718.     printf("%d %s =n(%d,%d)", nk, kind_str(nk), N_SEQ(node), N_UNIT(node));
  719.     if (N_LIST_DEFINED(nk))
  720.         printf(" n_list %d ", has_n_list);
  721.     if (N_UNQ_DEFINED(nk)) {
  722.         sym = N_UNQ(node);
  723.         if (sym != (Symbol)0)
  724.             printf(" n_unq(%d,%d)", S_SEQ(sym), S_UNIT(sym));
  725.     }
  726.     if (N_TYPE_DEFINED(nk)) {
  727.         sym = N_TYPE(node);
  728.         if (sym != (Symbol)0)
  729.             printf(" n_type(%d,%d)", S_SEQ(sym), S_UNIT(sym));
  730.     }
  731.     printf("\n ast");
  732.     if (N_AST1_DEFINED(nk)) {
  733.         nod = N_AST1(node);
  734.         if (nod != (Node)0)
  735.             printf(" 1(%d,%d)", N_SEQ(nod), N_UNIT(nod));
  736.     }
  737.     if (N_AST2_DEFINED(nk)) {
  738.         nod = N_AST2(node);
  739.         if (nod != (Node)0)
  740.             printf(" 2(%d,%d)", N_SEQ(nod), N_UNIT(nod));
  741.     }
  742.     if (N_AST3_DEFINED(nk)) {
  743.         nod = N_AST3(node);
  744.         if (nod != (Node)0)
  745.             printf(" 3(%d,%d)", N_SEQ(nod), N_UNIT(nod));
  746.     }
  747.     if (N_AST4_DEFINED(nk)) {
  748.         nod = N_AST4(node);
  749.         if (nod != (Node)0)
  750.             printf(" 4(%d,%d)", N_SEQ(nod), N_UNIT(nod));
  751.     }
  752.  
  753.     printf(" span %d:%d..%d:%d side %d\n",
  754.       N_SPAN0(node), N_SPAN1(node), N_SIDE(node));
  755. #endif
  756. }
  757.