1 /* where.c -- Implementation File (module.c template V1.0) 2 Copyright (C) 1995, 2002 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 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 () 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" 521