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