home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / where.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  15KB  |  587 lines
  1. /* where.c -- Implementation File (module.c template V1.0)
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  4.  
  5. This file is part of GNU Fortran.
  6.  
  7. GNU Fortran is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Fortran is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Fortran; see the file COPYING.  If not, write to
  19. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.    Related Modules:
  22.  
  23.    Description:
  24.       Simple data abstraction for Fortran source lines (called card images).
  25.  
  26.    Modifications:
  27. */
  28.  
  29. /* Include files. */
  30.  
  31. #include "proj.h"
  32. #include "where.h"
  33. #include "lex.h"
  34. #include "malloc.h"
  35.  
  36. /* Externals defined here. */
  37.  
  38. struct _ffewhere_line_ ffewhere_unknown_line_
  39. =
  40. {NULL, NULL, 0, 0, 0};
  41.  
  42. /* Simple definitions and enumerations. */
  43.  
  44.  
  45. /* Internal typedefs. */
  46.  
  47. typedef struct _ffewhere_ll_ *ffewhereLL_;
  48.  
  49. /* Private include files. */
  50.  
  51.  
  52. /* Internal structure definitions. */
  53.  
  54. struct _ffewhere_ll_
  55.   {
  56.     ffewhereLL_ next;
  57.     ffewhereLL_ previous;
  58.     ffewhereFile wf;
  59.     ffewhereLL_ parent;
  60.     ffewhereLineNumber line_no;    /* ffelex_line_number() at time of creation. */
  61.     ffewhereLineNumber offset;    /* User-desired offset (usually 1). */
  62.   };
  63.  
  64. struct _ffewhere_root_ll_
  65.   {
  66.     ffewhereLL_ first;
  67.     ffewhereLL_ last;
  68.   };
  69.  
  70. struct _ffewhere_root_line_
  71.   {
  72.     ffewhereLine first;
  73.     ffewhereLine last;
  74.     ffewhereLineNumber none;
  75.   };
  76.  
  77. /* Static objects accessed by functions in this module. */
  78.  
  79. static struct _ffewhere_root_ll_ ffewhere_root_ll_;
  80. static ffewhereLL_ ffewhere_parent_ll_;    /* Parent of last _begin'd file. */
  81. static struct _ffewhere_root_line_ ffewhere_root_line_;
  82.  
  83. /* Static functions (internal). */
  84.  
  85. static ffewhereLL_ ffewhere_ll_lookup_ (ffewhereLineNumber ln);
  86.  
  87. /* Internal macros. */
  88.  
  89.  
  90. /* Look up line-to-line object from absolute line num.  */
  91.  
  92. static ffewhereLL_
  93. ffewhere_ll_lookup_ (ffewhereLineNumber ln)
  94. {
  95.   ffewhereLL_ ll;
  96.  
  97.   if (ln == 0)
  98.     return ffewhere_root_ll_.first;
  99.  
  100.   for (ll = ffewhere_root_ll_.last;
  101.        ll != (ffewhereLL_) &ffewhere_root_ll_.first;
  102.        ll = ll->previous)
  103.     {
  104.       if (ll->line_no <= ln)
  105.     return ll;
  106.     }
  107.  
  108.   assert ("no line num" == NULL);
  109.   return NULL;
  110. }
  111.  
  112. /* Start reading from a new file instead of an old one.  */
  113.  
  114. void
  115. ffewhere_file_begin (ffewhereFile old_wf, ffewhereFile new_wf)
  116. {
  117.   if (old_wf != NULL)
  118.     assert (ffewhere_root_ll_.last->wf == old_wf);
  119.  
  120.   ffewhere_parent_ll_ = ffewhere_root_ll_.last;
  121.   ffewhere_file_set (new_wf, TRUE, 0);
  122. }
  123.  
  124. /* Stop reading from a new file, back to an old one.  */
  125.  
  126. void
  127. ffewhere_file_end (ffewhereFile new_wf, ffewhereFile old_wf)
  128. {
  129.   ffewhereLL_ parent;
  130.   ffewhereLineNumber ln;
  131.  
  132.   assert (ffewhere_root_ll_.last->wf == new_wf);
  133.  
  134.   if (old_wf != NULL)
  135.     {
  136.       parent = ffewhere_parent_ll_;
  137.       assert (parent != NULL);
  138.       assert (parent->wf == old_wf);
  139.  
  140.       ln = parent->next->line_no - parent->line_no + parent->offset;
  141.  
  142.       ffewhere_parent_ll_ = parent->parent;
  143.       ffewhere_file_set (old_wf, TRUE, ln);
  144.     }
  145. }
  146.  
  147. /* Kill file object.
  148.  
  149.    Note that this object must not have been passed in a call
  150.    to any other ffewhere function except ffewhere_file_name and
  151.    ffewhere_file_namelen.  */
  152.  
  153. void
  154. ffewhere_file_kill (ffewhereFile wf)
  155. {
  156.   malloc_kill_ks (ffe_pool_file (), wf,
  157.           offsetof (struct _ffewhere_file_, text)
  158.           + wf->length + 1);
  159. }
  160.  
  161. /* Create file object.  */
  162.  
  163. ffewhereFile
  164. ffewhere_file_new (char *name, size_t length)
  165. {
  166.   ffewhereFile wf;
  167.  
  168.   wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
  169.               offsetof (struct _ffewhere_file_, text)
  170.               + length + 1);
  171.   wf->length = length;
  172.   memcpy (&wf->text[0], name, length);
  173.   wf->text[length] = '\0';
  174.  
  175.   return wf;
  176. }
  177.  
  178. /* Set file and first line number.
  179.  
  180.    Pass FALSE if no line number is specified.  */
  181.  
  182. void
  183. ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
  184. {
  185.   ffewhereLL_ ll;
  186.  
  187.   ll = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", sizeof (*ll));
  188.   ll->next = (ffewhereLL_) &ffewhere_root_ll_.first;
  189.   ll->previous = ffewhere_root_ll_.last;
  190.   ll->next->previous = ll;
  191.   ll->previous->next = ll;
  192.   if (wf == NULL)
  193.     {
  194.       if (ll->previous == ll->next)
  195.     ll->wf = NULL;
  196.       else
  197.     ll->wf = ll->previous->wf;
  198.     }
  199.   else
  200.     ll->wf = wf;
  201.   ll->parent = ffewhere_parent_ll_;    /* Last _begin'd ll object. */
  202.   ll->line_no = ffelex_line_number ();
  203.   if (have_num)
  204.     ll->offset = ln;
  205.   else
  206.     {
  207.       if (ll->previous == ll->next)
  208.     ll->offset = 1;
  209.       else
  210.     ll->offset
  211.       = ll->line_no - ll->previous->line_no + ll->previous->offset;
  212.     }
  213. }
  214.  
  215. /* Do initializations.  */
  216.  
  217. void
  218. ffewhere_init_1 ()
  219. {
  220.   ffewhere_root_line_.first = ffewhere_root_line_.last
  221.   = (ffewhereLine) &ffewhere_root_line_.first;
  222.   ffewhere_root_line_.none = 0;
  223.  
  224.   ffewhere_root_ll_.first = ffewhere_root_ll_.last
  225.     = (ffewhereLL_) &ffewhere_root_ll_.first;
  226.  
  227.   ffewhere_parent_ll_ = NULL;
  228. }
  229.  
  230. /* Return the textual content of the line.  */
  231.  
  232. char *
  233. ffewhere_line_content (ffewhereLine wl)
  234. {
  235.   assert (wl != NULL);
  236.   return wl->content;
  237. }
  238.  
  239. /* Look up file object from line object.  */
  240.  
  241. ffewhereFile
  242. ffewhere_line_file (ffewhereLine wl)
  243. {
  244.   ffewhereLL_ ll;
  245.  
  246.   assert (wl != NULL);
  247.   ll = ffewhere_ll_lookup_ (wl->line_num);
  248.   return ll->wf;
  249. }
  250.  
  251. /* Lookup file object from line object, calc line#.  */
  252.  
  253. ffewhereLineNumber
  254. ffewhere_line_filelinenum (ffewhereLine wl)
  255. {
  256.   ffewhereLL_ ll;
  257.  
  258.   assert (wl != NULL);
  259.   ll = ffewhere_ll_lookup_ (wl->line_num);
  260.   return wl->line_num + ll->offset - ll->line_no;
  261. }
  262.  
  263. /* Decrement use count for line, deallocate if no uses left.  */
  264.  
  265. void
  266. ffewhere_line_kill (ffewhereLine wl)
  267. {
  268. #if 0
  269.   if (!ffewhere_line_is_unknown (wl))
  270.     fprintf (stdout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
  271.          ffewhereUses_f_ "u\n",
  272.          wl->line_num, wl->uses);
  273. #endif
  274.   assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
  275.   if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
  276.     {
  277.       wl->previous->next = wl->next;
  278.       wl->next->previous = wl->previous;
  279.       malloc_kill_ks (ffe_pool_file (), wl,
  280.               offsetof (struct _ffewhere_line_, content)
  281.               + wl->length + 1);
  282.     }
  283. }
  284.  
  285. /* Make a new line or increment use count of existing one.
  286.  
  287.    Find out where line object is, if anywhere.    If in lexer, it might also
  288.    be at the end of the list of lines, else put it on the end of the list.
  289.    Then, if in the list of lines, increment the use count and return the
  290.    line object.     Else, make an empty line object (no line) and return
  291.    that.  */
  292.  
  293. ffewhereLine
  294. ffewhere_line_new (ffewhereLineNumber ln)
  295. {
  296.   ffewhereLine wl = ffewhere_root_line_.last;
  297.  
  298.   /* If this is the lexer's current line, see if it is already at the end of
  299.      the list, and if not, make it and return it. */
  300.  
  301.   if (((ln == 0)        /* Presumably asking for EOF pointer. */
  302.        || (wl->line_num != ln))
  303.       && (ffelex_line_number () == ln))
  304.     {
  305. #if 0
  306.       fprintf (stdout,
  307.            "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
  308.            ln);
  309. #endif
  310.       wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
  311.               offsetof (struct _ffewhere_line_, content)
  312.               + ffelex_line_length () + 1);
  313.       wl->next = (ffewhereLine) &ffewhere_root_line_;
  314.       wl->previous = ffewhere_root_line_.last;
  315.       wl->previous->next = wl;
  316.       wl->next->previous = wl;
  317.       wl->line_num = ln;
  318.       wl->uses = 1;
  319.       wl->length = ffelex_line_length ();
  320.       strcpy (wl->content, ffelex_line ());
  321.       return wl;
  322.     }
  323.  
  324.   /* See if line is on list already. */
  325.  
  326.   while (wl->line_num > ln)
  327.     wl = wl->previous;
  328.  
  329.   /* If line is there, increment its use count and return. */
  330.  
  331.   if (wl->line_num == ln)
  332.     {
  333. #if 0
  334.       fprintf (stdout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
  335.            ffewhereUses_f_ "u\n", ln,
  336.            wl->uses);
  337. #endif
  338.       wl->uses++;
  339.       return wl;
  340.     }
  341.  
  342.   /* Else, make a new one with a blank line (since we've obviously lost it,
  343.      which should never happen) and return it. */
  344.  
  345.   fprintf (stderr,
  346.        "(Cannot resurrect line %lu for error reporting purposes.)\n",
  347.        ln);
  348.  
  349.   wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
  350.               offsetof (struct _ffewhere_line_, content)
  351.               + 1);
  352.   wl->next = (ffewhereLine) &ffewhere_root_line_;
  353.   wl->previous = ffewhere_root_line_.last;
  354.   wl->previous->next = wl;
  355.   wl->next->previous = wl;
  356.   wl->line_num = ln;
  357.   wl->uses = 1;
  358.   wl->length = 0;
  359.   *(wl->content) = '\0';
  360.   return wl;
  361. }
  362.  
  363. /* Increment use count of line, as in a copy.  */
  364.  
  365. ffewhereLine
  366. ffewhere_line_use (ffewhereLine wl)
  367. {
  368. #if 0
  369.   fprintf (stdout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
  370.        "u\n", wl->line_num, wl->uses);
  371. #endif
  372.   assert (wl->uses != 0);
  373.   ++wl->uses;
  374.   return wl;
  375. }
  376.  
  377. /* Set an ffewhere object based on a track index.
  378.  
  379.    Determines the absolute line and column number of a character at a given
  380.    index into an ffewhereTrack array.  wr* is the reference position, wt is
  381.    the tracking information, and i is the index desired.  wo* is set to wr*
  382.    plus the continual offsets described by wt[0...i-1], or unknown if any of
  383.    the continual offsets are not known.     */
  384.  
  385. void
  386. ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
  387.              ffewhereLine wrl, ffewhereColumn wrc,
  388.              ffewhereTrack wt, ffewhereIndex i)
  389. {
  390.   ffewhereLineNumber ln;
  391.   ffewhereColumnNumber cn;
  392.   ffewhereIndex j;
  393.   ffewhereIndex k;
  394.  
  395.   if (i == 0)
  396.     {
  397.       *wol = ffewhere_line_use (wrl);
  398.       *woc = ffewhere_column_use (wrc);
  399.     }
  400.   else if (i >= FFEWHERE_indexMAX)
  401.     {
  402.       assert ("i >= FFEWHERE_indexMAX" == NULL);
  403.       *wol = ffewhere_line_unknown ();
  404.       *woc = ffewhere_column_unknown ();
  405.     }
  406.   else
  407.     {
  408.       ln = ffewhere_line_number (wrl);
  409.       cn = ffewhere_column_number (wrc);
  410.       for (j = 0, k = 0; j < i; ++j, k += 2)
  411.     {
  412.       if ((wt[k] == FFEWHERE_indexUNKNOWN)
  413.           || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
  414.         {
  415.           *wol = ffewhere_line_unknown ();
  416.           *woc = ffewhere_column_unknown ();
  417.           return;
  418.         }
  419.       if (wt[k] == 0)
  420.         cn += wt[k + 1] + 1;
  421.       else
  422.         {
  423.           ln += wt[k];
  424.           cn = wt[k + 1] + 1;
  425.         }
  426.     }
  427.       if (ln == ffewhere_line_number (wrl))
  428.     {            /* Already have the line object, just use it
  429.                    directly. */
  430.       *wol = ffewhere_line_use (wrl);
  431.     }
  432.       else            /* Must search for the line object. */
  433.     *wol = ffewhere_line_new (ln);
  434.       *woc = ffewhere_column_new (cn);
  435.     }
  436. }
  437.  
  438. /* Build next tracking index.
  439.  
  440.    Set wt[i-1] continual offset so that it offsets from w* to (ln,cn).    Update
  441.    w* to contain (ln,cn).  DO NOT call this routine if i >= FFEWHERE_indexMAX
  442.    or i == 0.  */
  443.  
  444. void
  445. ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
  446.         ffewhereIndex i, ffewhereLineNumber ln,
  447.         ffewhereColumnNumber cn)
  448. {
  449.   unsigned int lo;
  450.   unsigned int co;
  451.  
  452.   if ((ffewhere_line_is_unknown (*wl))
  453.       || (ffewhere_column_is_unknown (*wc))
  454.       || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
  455.     {
  456.       wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
  457.       ffewhere_line_kill (*wl);
  458.       ffewhere_column_kill (*wc);
  459.       *wl = FFEWHERE_lineUNKNOWN;
  460.       *wc = FFEWHERE_columnUNKNOWN;
  461.     }
  462.   else if (lo == 0)
  463.     {
  464.       wt[i * 2 - 2] = 0;
  465.       if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
  466.     {
  467.       wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
  468.       ffewhere_line_kill (*wl);
  469.       ffewhere_column_kill (*wc);
  470.       *wl = FFEWHERE_lineUNKNOWN;
  471.       *wc = FFEWHERE_columnUNKNOWN;
  472.     }
  473.       else
  474.     {
  475.       wt[i * 2 - 1] = co - 1;
  476.       ffewhere_column_kill (*wc);
  477.       *wc = ffewhere_column_use (ffewhere_column_new (cn));
  478.     }
  479.     }
  480.   else
  481.     {
  482.       wt[i * 2 - 2] = lo;
  483.       if (cn > FFEWHERE_indexUNKNOWN)
  484.     {
  485.       wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
  486.       ffewhere_line_kill (*wl);
  487.       ffewhere_column_kill (*wc);
  488.       *wl = ffewhere_line_unknown ();
  489.       *wc = ffewhere_column_unknown ();
  490.     }
  491.       else
  492.     {
  493.       wt[i * 2 - 1] = cn - 1;
  494.       ffewhere_line_kill (*wl);
  495.       ffewhere_column_kill (*wc);
  496.       *wl = ffewhere_line_use (ffewhere_line_new (ln));
  497.       *wc = ffewhere_column_use (ffewhere_column_new (cn));
  498.     }
  499.     }
  500. }
  501.  
  502. /* Clear tracking index for internally created track.
  503.  
  504.    Set the tracking information to indicate that the tracking is at its
  505.    simplest (no spaces or newlines within the tracking).  This means set
  506.    everything to zero in the current implementation.  Length is the total
  507.    length of the token; length must be 2 or greater, since length-1 tracking
  508.    characters are set.    */
  509.  
  510. void
  511. ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
  512. {
  513.   ffewhereIndex i;
  514.  
  515.   if (length > FFEWHERE_indexMAX)
  516.     length = FFEWHERE_indexMAX;
  517.  
  518.   for (i = 1; i < length; ++i)
  519.     wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
  520. }
  521.  
  522. /* Copy tracking index from one place to another.
  523.  
  524.    Copy tracking information from swt[start] to dwt[0] and so on, presumably
  525.    after an ffewhere_set_from_track call.  Length is the total
  526.    length of the token; length must be 2 or greater, since length-1 tracking
  527.    characters are set.    */
  528.  
  529. void
  530. ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
  531.              ffewhereIndex length)
  532. {
  533.   ffewhereIndex i;
  534.   ffewhereIndex copy;
  535.  
  536.   if (length > FFEWHERE_indexMAX)
  537.     length = FFEWHERE_indexMAX;
  538.  
  539.   if (length + start > FFEWHERE_indexMAX)
  540.     copy = FFEWHERE_indexMAX - start;
  541.   else
  542.     copy = length;
  543.  
  544.   for (i = 1; i < copy; ++i)
  545.     {
  546.       dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
  547.       dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
  548.     }
  549.  
  550.   for (; i < length; ++i)
  551.     {
  552.       dwt[i * 2 - 2] = 0;
  553.       dwt[i * 2 - 1] = 0;
  554.     }
  555. }
  556.  
  557. /* Kill tracking data.
  558.  
  559.    Kill all the tracking information by killing incremented lines from the
  560.    first line number.  */
  561.  
  562. void
  563. ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt,
  564.              ffewhereIndex length)
  565. {
  566.   ffewhereLineNumber ln;
  567.   unsigned int lo;
  568.   ffewhereIndex i;
  569.  
  570.   ln = ffewhere_line_number (wrl);
  571.  
  572.   if (length > FFEWHERE_indexMAX)
  573.     length = FFEWHERE_indexMAX;
  574.  
  575.   for (i = 0; i < length - 1; ++i)
  576.     {
  577.       if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
  578.     break;
  579.       else if (lo != 0)
  580.     {
  581.       ln += lo;
  582.       wrl = ffewhere_line_new (ln);
  583.       ffewhere_line_kill (wrl);
  584.     }
  585.     }
  586. }
  587.