]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/f/where.c
Merge from pch-branch up to tag pch-commit-20020603.
[thirdparty/gcc.git] / gcc / f / where.c
CommitLineData
5ff904cd
JL
1/* where.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995 Free Software Foundation, Inc.
25d7717e 3 Contributed by James Craig Burley.
5ff904cd
JL
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=
0816ebdd 41{NULL, NULL, 0, 0, 0, {0}};
5ff904cd
JL
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\f
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{
e2500fed
GK
120 malloc_kill_ks (ffe_pool_file (), wf,
121 offsetof (struct _ffewhere_file_, text)
122 + wf->length + 1);
5ff904cd
JL
123}
124
125/* Create file object. */
126
127ffewhereFile
3b304f5b 128ffewhere_file_new (const char *name, size_t length)
5ff904cd
JL
129{
130 ffewhereFile wf;
e2500fed
GK
131
132 wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
133 offsetof (struct _ffewhere_file_, text)
134 + length + 1);
5ff904cd
JL
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}