gcc/f/where.c

   1 /* where.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   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, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23
  24    Description:
  25       Simple data abstraction for Fortran source lines (called card images).
  26
  27    Modifications:
  28 */
  29
  30 /* Include files. */
  31
  32 #include "proj.h"
  33 #include "where.h"
  34 #include "lex.h"
  35 #include "malloc.h"
  36 #include "ggc.h"
  37
  38 /* Externals defined here. */
  39
  40 struct _ffewhere_line_ ffewhere_unknown_line_
  41 =
  42 {NULL, NULL, 0, 0, 0, {0}};
  43
  44 /* Simple definitions and enumerations. */
  45
  46
  47 /* Internal typedefs. */
  48
  49 typedef struct _ffewhere_ll_ *ffewhereLL_;
  50
  51 /* Private include files. */
  52
  53
  54 /* Internal structure definitions. */
  55
  56 struct _ffewhere_ll_ GTY (())
  57   {
  58     ffewhereLL_ next;
  59     ffewhereLL_ previous;
  60     ffewhereFile wf;
  61     ffewhereLineNumber line_no; /* ffelex_line_number() at time of creation. */
  62     ffewhereLineNumber offset;  /* User-desired offset (usually 1). */
  63   };
  64
  65 struct _ffewhere_root_ll_ GTY (())
  66   {
  67     ffewhereLL_ first;
  68     ffewhereLL_ last;
  69   };
  70
  71 struct _ffewhere_root_line_
  72   {
  73     ffewhereLine first;
  74     ffewhereLine last;
  75     ffewhereLineNumber none;
  76   };
  77
  78 /* Static objects accessed by functions in this module. */
  79
  80 static GTY (()) struct _ffewhere_root_ll_ *ffewhere_root_ll_;
  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 \f
  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 /* Create file object.  */
 113
 114 ffewhereFile
 115 ffewhere_file_new (const char *name, size_t length)
 116 {
 117   ffewhereFile wf;
 118   wf = ggc_alloc (offsetof (struct _ffewhere_file_, text) + length + 1);
 119   wf->length = length;
 120   memcpy (&wf->text[0], name, length);
 121   wf->text[length] = '\0';
 122
 123   return wf;
 124 }
 125
 126 /* Set file and first line number.
 127
 128    Pass FALSE if no line number is specified.  */
 129
 130 void
 131 ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
 132 {
 133   ffewhereLL_ ll;
 134   ll = ggc_alloc (sizeof (*ll));
 135   ll->next = (ffewhereLL_) &ffewhere_root_ll_->first;
 136   ll->previous = ffewhere_root_ll_->last;
 137   ll->next->previous = ll;
 138   ll->previous->next = ll;
 139   if (wf == NULL)
 140     {
 141       if (ll->previous == ll->next)
 142         ll->wf = NULL;
 143       else
 144         ll->wf = ll->previous->wf;
 145     }
 146   else
 147     ll->wf = wf;
 148   ll->line_no = ffelex_line_number ();
 149   if (have_num)
 150     ll->offset = ln;
 151   else
 152     {
 153       if (ll->previous == ll->next)
 154         ll->offset = 1;
 155       else
 156         ll->offset
 157           = ll->line_no - ll->previous->line_no + ll->previous->offset;
 158     }
 159 }
 160
 161 /* Do initializations.  */
 162
 163 void
 164 ffewhere_init_1 (void)
 165 {
 166   ffewhere_root_line_.first = ffewhere_root_line_.last
 167   = (ffewhereLine) &ffewhere_root_line_.first;
 168   ffewhere_root_line_.none = 0;
 169
 170   /* The sentinel is (must be) GGC-allocated.  It is accessed as a
 171      struct _ffewhere_ll_/ffewhereLL_ though its type contains just the
 172      first two fields (layout-wise).  */
 173   ffewhere_root_ll_ = ggc_alloc_cleared (sizeof (struct _ffewhere_ll_));
 174   ffewhere_root_ll_->first = ffewhere_root_ll_->last
 175     = (ffewhereLL_) &ffewhere_root_ll_->first;
 176 }
 177
 178 /* Return the textual content of the line.  */
 179
 180 char *
 181 ffewhere_line_content (ffewhereLine wl)
 182 {
 183   assert (wl != NULL);
 184   return wl->content;
 185 }
 186
 187 /* Look up file object from line object.  */
 188
 189 ffewhereFile
 190 ffewhere_line_file (ffewhereLine wl)
 191 {
 192   ffewhereLL_ ll;
 193
 194   assert (wl != NULL);
 195   ll = ffewhere_ll_lookup_ (wl->line_num);
 196   return ll->wf;
 197 }
 198
 199 /* Lookup file object from line object, calc line#.  */
 200
 201 ffewhereLineNumber
 202 ffewhere_line_filelinenum (ffewhereLine wl)
 203 {
 204   ffewhereLL_ ll;
 205
 206   assert (wl != NULL);
 207   ll = ffewhere_ll_lookup_ (wl->line_num);
 208   return wl->line_num + ll->offset - ll->line_no;
 209 }
 210
 211 /* Decrement use count for line, deallocate if no uses left.  */
 212
 213 void
 214 ffewhere_line_kill (ffewhereLine wl)
 215 {
 216 #if 0
 217   if (!ffewhere_line_is_unknown (wl))
 218     fprintf (dmpout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
 219              ffewhereUses_f_ "u\n",
 220              wl->line_num, wl->uses);
 221 #endif
 222   assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
 223   if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
 224     {
 225       wl->previous->next = wl->next;
 226       wl->next->previous = wl->previous;
 227       malloc_kill_ks (ffe_pool_file (), wl,
 228                       offsetof (struct _ffewhere_line_, content)
 229                       + wl->length + 1);
 230     }
 231 }
 232
 233 /* Make a new line or increment use count of existing one.
 234
 235    Find out where line object is, if anywhere.  If in lexer, it might also
 236    be at the end of the list of lines, else put it on the end of the list.
 237    Then, if in the list of lines, increment the use count and return the
 238    line object.  Else, make an empty line object (no line) and return
 239    that.  */
 240
 241 ffewhereLine
 242 ffewhere_line_new (ffewhereLineNumber ln)
 243 {
 244   ffewhereLine wl = ffewhere_root_line_.last;
 245
 246   /* If this is the lexer's current line, see if it is already at the end of
 247      the list, and if not, make it and return it. */
 248
 249   if (((ln == 0)                /* Presumably asking for EOF pointer. */
 250        || (wl->line_num != ln))
 251       && (ffelex_line_number () == ln))
 252     {
 253 #if 0
 254       fprintf (dmpout,
 255                "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
 256                ln);
 257 #endif
 258       wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
 259                           offsetof (struct _ffewhere_line_, content)
 260                           + (size_t) ffelex_line_length () + 1);
 261       wl->next = (ffewhereLine) &ffewhere_root_line_;
 262       wl->previous = ffewhere_root_line_.last;
 263       wl->previous->next = wl;
 264       wl->next->previous = wl;
 265       wl->line_num = ln;
 266       wl->uses = 1;
 267       wl->length = ffelex_line_length ();
 268       strcpy (wl->content, ffelex_line ());
 269       return wl;
 270     }
 271
 272   /* See if line is on list already. */
 273
 274   while (wl->line_num > ln)
 275     wl = wl->previous;
 276
 277   /* If line is there, increment its use count and return. */
 278
 279   if (wl->line_num == ln)
 280     {
 281 #if 0
 282       fprintf (dmpout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
 283                ffewhereUses_f_ "u\n", ln,
 284                wl->uses);
 285 #endif
 286       wl->uses++;
 287       return wl;
 288     }
 289
 290   /* Else, make a new one with a blank line (since we've obviously lost it,
 291      which should never happen) and return it. */
 292
 293   fprintf (stderr,
 294            "(Cannot resurrect line %lu for error reporting purposes.)\n",
 295            ln);
 296
 297   wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
 298                       offsetof (struct _ffewhere_line_, content)
 299                       + 1);
 300   wl->next = (ffewhereLine) &ffewhere_root_line_;
 301   wl->previous = ffewhere_root_line_.last;
 302   wl->previous->next = wl;
 303   wl->next->previous = wl;
 304   wl->line_num = ln;
 305   wl->uses = 1;
 306   wl->length = 0;
 307   *(wl->content) = '\0';
 308   return wl;
 309 }
 310
 311 /* Increment use count of line, as in a copy.  */
 312
 313 ffewhereLine
 314 ffewhere_line_use (ffewhereLine wl)
 315 {
 316 #if 0
 317   fprintf (dmpout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
 318            "u\n", wl->line_num, wl->uses);
 319 #endif
 320   assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
 321   if (!ffewhere_line_is_unknown (wl))
 322     ++wl->uses;
 323   return wl;
 324 }
 325
 326 /* Set an ffewhere object based on a track index.
 327
 328    Determines the absolute line and column number of a character at a given
 329    index into an ffewhereTrack array.  wr* is the reference position, wt is
 330    the tracking information, and i is the index desired.  wo* is set to wr*
 331    plus the continual offsets described by wt[0...i-1], or unknown if any of
 332    the continual offsets are not known.  */
 333
 334 void
 335 ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
 336                          ffewhereLine wrl, ffewhereColumn wrc,
 337                          ffewhereTrack wt, ffewhereIndex i)
 338 {
 339   ffewhereLineNumber ln;
 340   ffewhereColumnNumber cn;
 341   ffewhereIndex j;
 342   ffewhereIndex k;
 343
 344   if ((i == 0) || (i >= FFEWHERE_indexMAX))
 345     {
 346       *wol = ffewhere_line_use (wrl);
 347       *woc = ffewhere_column_use (wrc);
 348     }
 349   else
 350     {
 351       ln = ffewhere_line_number (wrl);
 352       cn = ffewhere_column_number (wrc);
 353       for (j = 0, k = 0; j < i; ++j, k += 2)
 354         {
 355           if ((wt[k] == FFEWHERE_indexUNKNOWN)
 356               || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
 357             {
 358               *wol = ffewhere_line_unknown ();
 359               *woc = ffewhere_column_unknown ();
 360               return;
 361             }
 362           if (wt[k] == 0)
 363             cn += wt[k + 1] + 1;
 364           else
 365             {
 366               ln += wt[k];
 367               cn = wt[k + 1] + 1;
 368             }
 369         }
 370       if (ln == ffewhere_line_number (wrl))
 371         {                       /* Already have the line object, just use it
 372                                    directly. */
 373           *wol = ffewhere_line_use (wrl);
 374         }
 375       else                      /* Must search for the line object. */
 376         *wol = ffewhere_line_new (ln);
 377       *woc = ffewhere_column_new (cn);
 378     }
 379 }
 380
 381 /* Build next tracking index.
 382
 383    Set wt[i-1] continual offset so that it offsets from w* to (ln,cn).  Update
 384    w* to contain (ln,cn).  DO NOT call this routine if i >= FFEWHERE_indexMAX
 385    or i == 0.  */
 386
 387 void
 388 ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
 389                 ffewhereIndex i, ffewhereLineNumber ln,
 390                 ffewhereColumnNumber cn)
 391 {
 392   unsigned int lo;
 393   unsigned int co;
 394
 395   if ((ffewhere_line_is_unknown (*wl))
 396       || (ffewhere_column_is_unknown (*wc))
 397       || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
 398     {
 399       wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
 400       ffewhere_line_kill (*wl);
 401       ffewhere_column_kill (*wc);
 402       *wl = FFEWHERE_lineUNKNOWN;
 403       *wc = FFEWHERE_columnUNKNOWN;
 404     }
 405   else if (lo == 0)
 406     {
 407       wt[i * 2 - 2] = 0;
 408       if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
 409         {
 410           wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
 411           ffewhere_line_kill (*wl);
 412           ffewhere_column_kill (*wc);
 413           *wl = FFEWHERE_lineUNKNOWN;
 414           *wc = FFEWHERE_columnUNKNOWN;
 415         }
 416       else
 417         {
 418           wt[i * 2 - 1] = co - 1;
 419           ffewhere_column_kill (*wc);
 420           *wc = ffewhere_column_use (ffewhere_column_new (cn));
 421         }
 422     }
 423   else
 424     {
 425       wt[i * 2 - 2] = lo;
 426       wt[i * 2 - 1] = cn - 1;
 427       ffewhere_line_kill (*wl);
 428       ffewhere_column_kill (*wc);
 429       *wl = ffewhere_line_use (ffewhere_line_new (ln));
 430       *wc = ffewhere_column_use (ffewhere_column_new (cn));
 431     }
 432 }
 433
 434 /* Clear tracking index for internally created track.
 435
 436    Set the tracking information to indicate that the tracking is at its
 437    simplest (no spaces or newlines within the tracking).  This means set
 438    everything to zero in the current implementation.  Length is the total
 439    length of the token; length must be 2 or greater, since length-1 tracking
 440    characters are set.  */
 441
 442 void
 443 ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
 444 {
 445   ffewhereIndex i;
 446
 447   if (length > FFEWHERE_indexMAX)
 448     length = FFEWHERE_indexMAX;
 449
 450   for (i = 1; i < length; ++i)
 451     wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
 452 }
 453
 454 /* Copy tracking index from one place to another.
 455
 456    Copy tracking information from swt[start] to dwt[0] and so on, presumably
 457    after an ffewhere_set_from_track call.  Length is the total
 458    length of the token; length must be 2 or greater, since length-1 tracking
 459    characters are set.  */
 460
 461 void
 462 ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
 463                      ffewhereIndex length)
 464 {
 465   ffewhereIndex i;
 466   ffewhereIndex copy;
 467
 468   if (length > FFEWHERE_indexMAX)
 469     length = FFEWHERE_indexMAX;
 470
 471   if (length + start > FFEWHERE_indexMAX)
 472     copy = FFEWHERE_indexMAX - start;
 473   else
 474     copy = length;
 475
 476   for (i = 1; i < copy; ++i)
 477     {
 478       dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
 479       dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
 480     }
 481
 482   for (; i < length; ++i)
 483     {
 484       dwt[i * 2 - 2] = 0;
 485       dwt[i * 2 - 1] = 0;
 486     }
 487 }
 488
 489 /* Kill tracking data.
 490
 491    Kill all the tracking information by killing incremented lines from the
 492    first line number.  */
 493
 494 void
 495 ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED,
 496                      ffewhereTrack wt, ffewhereIndex length)
 497 {
 498   ffewhereLineNumber ln;
 499   unsigned int lo;
 500   ffewhereIndex i;
 501
 502   ln = ffewhere_line_number (wrl);
 503
 504   if (length > FFEWHERE_indexMAX)
 505     length = FFEWHERE_indexMAX;
 506
 507   for (i = 0; i < length - 1; ++i)
 508     {
 509       if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
 510         break;
 511       else if (lo != 0)
 512         {
 513           ln += lo;
 514           wrl = ffewhere_line_new (ln);
 515           ffewhere_line_kill (wrl);
 516         }
 517     }
 518 }
 519
 520 #include "gt-f-where.h"