]>
Commit | Line | Data |
---|---|---|
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 | |
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 | = | |
0816ebdd | 41 | {NULL, NULL, 0, 0, 0, {0}}; |
5ff904cd JL |
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 | { | |
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 | ||
127 | ffewhereFile | |
3b304f5b | 128 | ffewhere_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 | ||
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 | } |