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 5This file is part of GNU Fortran. 6 7GNU Fortran is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Fortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Fortran; see the file COPYING. If not, write to 19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 2002111-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 39struct _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 48typedef struct _ffewhere_ll_ *ffewhereLL_; 49 50/* Private include files. */ 51 52 53/* Internal structure definitions. */ 54 55struct _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 64struct _ffewhere_root_ll_ 65 { 66 ffewhereLL_ first; 67 ffewhereLL_ last; 68 }; 69 70struct _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 79static struct _ffewhere_root_ll_ ffewhere_root_ll_; 80static struct _ffewhere_root_line_ ffewhere_root_line_; 81 82/* Static functions (internal). */ 83 84static ffewhereLL_ ffewhere_ll_lookup_ (ffewhereLineNumber ln); 85 86/* Internal macros. */ 87 88 89/* Look up line-to-line object from absolute line num. */ 90 91static ffewhereLL_ 92ffewhere_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 117void 118ffewhere_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 127ffewhereFile 128ffewhere_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 146void 147ffewhere_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 180void 181ffewhere_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 193char * 194ffewhere_line_content (ffewhereLine wl) 195{ 196 assert (wl != NULL); 197 return wl->content; 198} 199 200/* Look up file object from line object. */ 201 202ffewhereFile 203ffewhere_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 214ffewhereLineNumber 215ffewhere_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 226void 227ffewhere_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 254ffewhereLine 255ffewhere_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 326ffewhereLine 327ffewhere_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 347void 348ffewhere_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 400void 401ffewhere_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 466void 467ffewhere_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 485void 486ffewhere_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 518void 519ffewhere_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} 543