1/* lab.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 Complex data abstraction for Fortran labels. Maintains a single master 26 list for all labels; it is expected initialization and termination of 27 this list will occur on program-unit boundaries. 28 29 Modifications: 30 22-Aug-89 JCB 1.1 31 Change ffelab_new for new ffewhere interface. 32*/ 33 34/* Include files. */ 35 36#include "proj.h" 37#include "lab.h" 38#include "malloc.h" 39 40/* Externals defined here. */ 41 42ffelab ffelab_list_; 43ffelabNumber ffelab_num_news_; 44 45/* Simple definitions and enumerations. */ 46 47 48/* Internal typedefs. */ 49 50 51/* Private include files. */ 52 53 54/* Internal structure definitions. */ 55 56 57/* Static objects accessed by functions in this module. */ 58 59 60/* Static functions (internal). */ 61 62 63/* Internal macros. */ 64 65 66/* ffelab_find -- Find the ffelab object having the desired label value 67 68 ffelab l; 69 ffelabValue v; 70 l = ffelab_find(v); 71 72 If the desired ffelab object doesn't exist, returns NULL. 73 74 Straightforward search of list of ffelabs. */ 75 76ffelab 77ffelab_find (ffelabValue v) 78{ 79 ffelab l; 80 81 for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next) 82 ; 83 84 return l; 85} 86 87/* ffelab_finish -- Shut down label management 88 89 ffelab_finish(); 90 91 At the end of processing a program unit, call this routine to shut down 92 label management. 93 94 Kill all the labels on the list. */ 95 96void 97ffelab_finish () 98{ 99 ffelab l; 100 ffelab pl; 101 102 for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next) 103 if (pl != NULL) 104 malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl)); 105 106 if (pl != NULL) 107 malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl)); 108} 109 110/* ffelab_init_3 -- Initialize label management system 111 112 ffelab_init_3(); 113 114 Initialize the label management system. Do this before a new program 115 unit is going to be processed. */ 116 117void 118ffelab_init_3 () 119{ 120 ffelab_list_ = NULL; 121 ffelab_num_news_ = 0; 122} 123 124/* ffelab_new -- Create an ffelab object. 125 126 ffelab l; 127 ffelabValue v; 128 l = ffelab_new(v); 129 130 Create a label having a given value. If the value isn't known, pass 131 FFELAB_valueNONE, and set it later with ffelab_set_value. 132 133 Allocate, initialize, and stick at top of label list. 134 135 22-Aug-89 JCB 1.1 136 Change for new ffewhere interface. */ 137 138ffelab 139ffelab_new (ffelabValue v) 140{ 141 ffelab l; 142 143 ++ffelab_num_news_; 144 l = (ffelab) malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l)); 145 l->next = ffelab_list_; 146#ifdef FFECOM_labelHOOK 147 l->hook = FFECOM_labelNULL; 148#endif 149 l->value = v; 150 l->firstref_line = ffewhere_line_unknown (); 151 l->firstref_col = ffewhere_column_unknown (); 152 l->doref_line = ffewhere_line_unknown (); 153 l->doref_col = ffewhere_column_unknown (); 154 l->definition_line = ffewhere_line_unknown (); 155 l->definition_col = ffewhere_column_unknown (); 156 l->type = FFELAB_typeUNKNOWN; 157 ffelab_list_ = l; 158 return l; 159} 160