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 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 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 42 ffelab ffelab_list_; 43 ffelabNumber 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 76 ffelab 77 ffelab_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 96 void 97 ffelab_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 117 void 118 ffelab_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 138 ffelab 139 ffelab_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