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