gcc/f/where.c

   1 /* where.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995 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_
  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_
  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 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 /* A somewhat evil way to prevent the garbage collector
 113    from collecting 'file' structures.  */
 114 #define NUM_FFEWHERE_HEAD_FILES 31
 115 static struct ffewhere_ggc_tracker
 116 {
 117   struct ffewhere_ggc_tracker *next;
 118   ffewhereFile files[NUM_FFEWHERE_HEAD_FILES];
 119 } *ffewhere_head = NULL;
 120
 121 static void
 122 mark_ffewhere_head (void *arg)
 123 {
 124   struct ffewhere_ggc_tracker *head;
 125   int i;
 126
 127   for (head = * (struct ffewhere_ggc_tracker **) arg;
 128        head != NULL;
 129        head = head->next)
 130   {
 131     ggc_mark (head);
 132     for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++)
 133       ggc_mark (head->files[i]);
 134   }
 135 }
 136
 137
 138 /* Kill file object.
 139
 140    Note that this object must not have been passed in a call
 141    to any other ffewhere function except ffewhere_file_name and
 142    ffewhere_file_namelen.  */
 143
 144 void
 145 ffewhere_file_kill (ffewhereFile wf)
 146 {
 147   struct ffewhere_ggc_tracker *head;
 148   int i;
 149
 150   for (head = ffewhere_head; head != NULL; head = head->next)
 151     for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++)
 152       if (head->files[i] == wf)
 153         {
 154           head->files[i] = NULL;
 155           return;
 156         }
 157   /* Called on a file that has already been deallocated... */
 158   abort();
 159 }
 160
 161 /* Create file object.  */
 162
 163 ffewhereFile
 164 ffewhere_file_new (const char *name, size_t length)
 165 {
 166   ffewhereFile wf;
 167   int filepos;
 168
 169   wf = ggc_alloc (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   if (ffewhere_head == NULL)
 176     {
 177       ggc_add_root (&ffewhere_head, 1, sizeof ffewhere_head,
 178                     mark_ffewhere_head);
 179       filepos = NUM_FFEWHERE_HEAD_FILES;
 180     }
 181   else
 182     {
 183       for (filepos = 0; filepos < NUM_FFEWHERE_HEAD_FILES; filepos++)
 184         if (ffewhere_head->files[filepos] == NULL)
 185           {
 186             ffewhere_head->files[filepos] = wf;
 187             break;
 188           }
 189     }
 190   if (filepos == NUM_FFEWHERE_HEAD_FILES)
 191     {
 192       /* Need to allocate a new block.  */
 193       struct ffewhere_ggc_tracker *old_head = ffewhere_head;
 194       int i;
 195
 196       ffewhere_head = ggc_alloc (sizeof (*ffewhere_head));
 197       ffewhere_head->next = old_head;
 198       ffewhere_head->files[0] = wf;
 199       for (i = 1; i < NUM_FFEWHERE_HEAD_FILES; i++)
 200         ffewhere_head->files[i] = NULL;
 201     }
 202
 203   return wf;
 204 }
 205
 206 /* Set file and first line number.
 207
 208    Pass FALSE if no line number is specified.  */
 209
 210 void
 211 ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
 212 {
 213   ffewhereLL_ ll;
 214
 215   ll = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", sizeof (*ll));
 216   ll->next = (ffewhereLL_) &ffewhere_root_ll_.first;
 217   ll->previous = ffewhere_root_ll_.last;
 218   ll->next->previous = ll;
 219   ll->previous->next = ll;
 220   if (wf == NULL)
 221     {
 222       if (ll->previous == ll->next)
 223         ll->wf = NULL;
 224       else
 225         ll->wf = ll->previous->wf;
 226     }
 227   else
 228     ll->wf = wf;
 229   ll->line_no = ffelex_line_number ();
 230   if (have_num)
 231     ll->offset = ln;
 232   else
 233     {
 234       if (ll->previous == ll->next)
 235         ll->offset = 1;
 236       else
 237         ll->offset
 238           = ll->line_no - ll->previous->line_no + ll->previous->offset;
 239     }
 240 }
 241
 242 /* Do initializations.  */
 243
 244 void
 245 ffewhere_init_1 ()
 246 {
 247   ffewhere_root_line_.first = ffewhere_root_line_.last
 248   = (ffewhereLine) &ffewhere_root_line_.first;
 249   ffewhere_root_line_.none = 0;
 250
 251   ffewhere_root_ll_.first = ffewhere_root_ll_.last
 252     = (ffewhereLL_) &ffewhere_root_ll_.first;
 253 }
 254
 255 /* Return the textual content of the line.  */
 256
 257 char *
 258 ffewhere_line_content (ffewhereLine wl)
 259 {
 260   assert (wl != NULL);
 261   return wl->content;
 262 }
 263
 264 /* Look up file object from line object.  */
 265
 266 ffewhereFile
 267 ffewhere_line_file (ffewhereLine wl)
 268 {
 269   ffewhereLL_ ll;
 270
 271   assert (wl != NULL);
 272   ll = ffewhere_ll_lookup_ (wl->line_num);
 273   return ll->wf;
 274 }
 275
 276 /* Lookup file object from line object, calc line#.  */
 277
 278 ffewhereLineNumber
 279 ffewhere_line_filelinenum (ffewhereLine wl)
 280 {
 281   ffewhereLL_ ll;
 282
 283   assert (wl != NULL);
 284   ll = ffewhere_ll_lookup_ (wl->line_num);
 285   return wl->line_num + ll->offset - ll->line_no;
 286 }
 287
 288 /* Decrement use count for line, deallocate if no uses left.  */
 289
 290 void
 291 ffewhere_line_kill (ffewhereLine wl)
 292 {
 293 #if 0
 294   if (!ffewhere_line_is_unknown (wl))
 295     fprintf (dmpout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
 296              ffewhereUses_f_ "u\n",
 297              wl->line_num, wl->uses);
 298 #endif
 299   assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
 300   if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
 301     {
 302       wl->previous->next = wl->next;
 303       wl->next->previous = wl->previous;
 304       malloc_kill_ks (ffe_pool_file (), wl,
 305                       offsetof (struct _ffewhere_line_, content)
 306                       + wl->length + 1);
 307     }
 308 }
 309
 310 /* Make a new line or increment use count of existing one.
 311
 312    Find out where line object is, if anywhere.  If in lexer, it might also
 313    be at the end of the list of lines, else put it on the end of the list.
 314    Then, if in the list of lines, increment the use count and return the
 315    line object.  Else, make an empty line object (no line) and return
 316    that.  */
 317
 318 ffewhereLine
 319 ffewhere_line_new (ffewhereLineNumber ln)
 320 {
 321   ffewhereLine wl = ffewhere_root_line_.last;
 322
 323   /* If this is the lexer's current line, see if it is already at the end of
 324      the list, and if not, make it and return it. */
 325
 326   if (((ln == 0)                /* Presumably asking for EOF pointer. */
 327        || (wl->line_num != ln))
 328       && (ffelex_line_number () == ln))
 329     {
 330 #if 0
 331       fprintf (dmpout,
 332                "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
 333                ln);
 334 #endif
 335       wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
 336                           offsetof (struct _ffewhere_line_, content)
 337                           + (size_t) ffelex_line_length () + 1);
 338       wl->next = (ffewhereLine) &ffewhere_root_line_;
 339       wl->previous = ffewhere_root_line_.last;
 340       wl->previous->next = wl;
 341       wl->next->previous = wl;
 342       wl->line_num = ln;
 343       wl->uses = 1;
 344       wl->length = ffelex_line_length ();
 345       strcpy (wl->content, ffelex_line ());
 346       return wl;
 347     }
 348
 349   /* See if line is on list already. */
 350
 351   while (wl->line_num > ln)
 352     wl = wl->previous;
 353
 354   /* If line is there, increment its use count and return. */
 355
 356   if (wl->line_num == ln)
 357     {
 358 #if 0
 359       fprintf (dmpout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
 360                ffewhereUses_f_ "u\n", ln,
 361                wl->uses);
 362 #endif
 363       wl->uses++;
 364       return wl;
 365     }
 366
 367   /* Else, make a new one with a blank line (since we've obviously lost it,
 368      which should never happen) and return it. */
 369
 370   fprintf (stderr,
 371            "(Cannot resurrect line %lu for error reporting purposes.)\n",
 372            ln);
 373
 374   wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
 375                       offsetof (struct _ffewhere_line_, content)
 376                       + 1);
 377   wl->next = (ffewhereLine) &ffewhere_root_line_;
 378   wl->previous = ffewhere_root_line_.last;
 379   wl->previous->next = wl;
 380   wl->next->previous = wl;
 381   wl->line_num = ln;
 382   wl->uses = 1;
 383   wl->length = 0;
 384   *(wl->content) = '\0';
 385   return wl;
 386 }
 387
 388 /* Increment use count of line, as in a copy.  */
 389
 390 ffewhereLine
 391 ffewhere_line_use (ffewhereLine wl)
 392 {
 393 #if 0
 394   fprintf (dmpout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
 395            "u\n", wl->line_num, wl->uses);
 396 #endif
 397   assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
 398   if (!ffewhere_line_is_unknown (wl))
 399     ++wl->uses;
 400   return wl;
 401 }
 402
 403 /* Set an ffewhere object based on a track index.
 404
 405    Determines the absolute line and column number of a character at a given
 406    index into an ffewhereTrack array.  wr* is the reference position, wt is
 407    the tracking information, and i is the index desired.  wo* is set to wr*
 408    plus the continual offsets described by wt[0...i-1], or unknown if any of
 409    the continual offsets are not known.  */
 410
 411 void
 412 ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
 413                          ffewhereLine wrl, ffewhereColumn wrc,
 414                          ffewhereTrack wt, ffewhereIndex i)
 415 {
 416   ffewhereLineNumber ln;
 417   ffewhereColumnNumber cn;
 418   ffewhereIndex j;
 419   ffewhereIndex k;
 420
 421   if ((i == 0) || (i >= FFEWHERE_indexMAX))
 422     {
 423       *wol = ffewhere_line_use (wrl);
 424       *woc = ffewhere_column_use (wrc);
 425     }
 426   else
 427     {
 428       ln = ffewhere_line_number (wrl);
 429       cn = ffewhere_column_number (wrc);
 430       for (j = 0, k = 0; j < i; ++j, k += 2)
 431         {
 432           if ((wt[k] == FFEWHERE_indexUNKNOWN)
 433               || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
 434             {
 435               *wol = ffewhere_line_unknown ();
 436               *woc = ffewhere_column_unknown ();
 437               return;
 438             }
 439           if (wt[k] == 0)
 440             cn += wt[k + 1] + 1;
 441           else
 442             {
 443               ln += wt[k];
 444               cn = wt[k + 1] + 1;
 445             }
 446         }
 447       if (ln == ffewhere_line_number (wrl))
 448         {                       /* Already have the line object, just use it
 449                                    directly. */
 450           *wol = ffewhere_line_use (wrl);
 451         }
 452       else                      /* Must search for the line object. */
 453         *wol = ffewhere_line_new (ln);
 454       *woc = ffewhere_column_new (cn);
 455     }
 456 }
 457
 458 /* Build next tracking index.
 459
 460    Set wt[i-1] continual offset so that it offsets from w* to (ln,cn).  Update
 461    w* to contain (ln,cn).  DO NOT call this routine if i >= FFEWHERE_indexMAX
 462    or i == 0.  */
 463
 464 void
 465 ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
 466                 ffewhereIndex i, ffewhereLineNumber ln,
 467                 ffewhereColumnNumber cn)
 468 {
 469   unsigned int lo;
 470   unsigned int co;
 471
 472   if ((ffewhere_line_is_unknown (*wl))
 473       || (ffewhere_column_is_unknown (*wc))
 474       || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
 475     {
 476       wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
 477       ffewhere_line_kill (*wl);
 478       ffewhere_column_kill (*wc);
 479       *wl = FFEWHERE_lineUNKNOWN;
 480       *wc = FFEWHERE_columnUNKNOWN;
 481     }
 482   else if (lo == 0)
 483     {
 484       wt[i * 2 - 2] = 0;
 485       if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
 486         {
 487           wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
 488           ffewhere_line_kill (*wl);
 489           ffewhere_column_kill (*wc);
 490           *wl = FFEWHERE_lineUNKNOWN;
 491           *wc = FFEWHERE_columnUNKNOWN;
 492         }
 493       else
 494         {
 495           wt[i * 2 - 1] = co - 1;
 496           ffewhere_column_kill (*wc);
 497           *wc = ffewhere_column_use (ffewhere_column_new (cn));
 498         }
 499     }
 500   else
 501     {
 502       wt[i * 2 - 2] = lo;
 503       if (cn > FFEWHERE_indexUNKNOWN)
 504         {
 505           wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
 506           ffewhere_line_kill (*wl);
 507           ffewhere_column_kill (*wc);
 508           *wl = ffewhere_line_unknown ();
 509           *wc = ffewhere_column_unknown ();
 510         }
 511       else
 512         {
 513           wt[i * 2 - 1] = cn - 1;
 514           ffewhere_line_kill (*wl);
 515           ffewhere_column_kill (*wc);
 516           *wl = ffewhere_line_use (ffewhere_line_new (ln));
 517           *wc = ffewhere_column_use (ffewhere_column_new (cn));
 518         }
 519     }
 520 }
 521
 522 /* Clear tracking index for internally created track.
 523
 524    Set the tracking information to indicate that the tracking is at its
 525    simplest (no spaces or newlines within the tracking).  This means set
 526    everything to zero in the current implementation.  Length is the total
 527    length of the token; length must be 2 or greater, since length-1 tracking
 528    characters are set.  */
 529
 530 void
 531 ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
 532 {
 533   ffewhereIndex i;
 534
 535   if (length > FFEWHERE_indexMAX)
 536     length = FFEWHERE_indexMAX;
 537
 538   for (i = 1; i < length; ++i)
 539     wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
 540 }
 541
 542 /* Copy tracking index from one place to another.
 543
 544    Copy tracking information from swt[start] to dwt[0] and so on, presumably
 545    after an ffewhere_set_from_track call.  Length is the total
 546    length of the token; length must be 2 or greater, since length-1 tracking
 547    characters are set.  */
 548
 549 void
 550 ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
 551                      ffewhereIndex length)
 552 {
 553   ffewhereIndex i;
 554   ffewhereIndex copy;
 555
 556   if (length > FFEWHERE_indexMAX)
 557     length = FFEWHERE_indexMAX;
 558
 559   if (length + start > FFEWHERE_indexMAX)
 560     copy = FFEWHERE_indexMAX - start;
 561   else
 562     copy = length;
 563
 564   for (i = 1; i < copy; ++i)
 565     {
 566       dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
 567       dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
 568     }
 569
 570   for (; i < length; ++i)
 571     {
 572       dwt[i * 2 - 2] = 0;
 573       dwt[i * 2 - 1] = 0;
 574     }
 575 }
 576
 577 /* Kill tracking data.
 578
 579    Kill all the tracking information by killing incremented lines from the
 580    first line number.  */
 581
 582 void
 583 ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED,
 584                      ffewhereTrack wt, ffewhereIndex length)
 585 {
 586   ffewhereLineNumber ln;
 587   unsigned int lo;
 588   ffewhereIndex i;
 589
 590   ln = ffewhere_line_number (wrl);
 591
 592   if (length > FFEWHERE_indexMAX)
 593     length = FFEWHERE_indexMAX;
 594
 595   for (i = 0; i < length - 1; ++i)
 596     {
 597       if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
 598         break;
 599       else if (lo != 0)
 600         {
 601           ln += lo;
 602           wrl = ffewhere_line_new (ln);
 603           ffewhere_line_kill (wrl);
 604         }
 605     }
 606 }