]> gcc.gnu.org Git - gcc.git/blob - gcc/fortran/st.c
re PR fortran/13792 (lbound/ubound generates internal compiler error)
[gcc.git] / gcc / fortran / st.c
1 /* Build executable statement trees.
2 Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5 This file is part of GCC.
6
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 2, or (at your option) any later
10 version.
11
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING. If not, write to the Free
19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
20 02111-1307, USA. */
21
22 /* Executable statements are strung together into a singly linked list
23 of code structures. These structures are later translated into GCC
24 GENERIC tree structures and from there to executable code for a
25 target. */
26
27 #include "config.h"
28 #include "gfortran.h"
29 #include <string.h>
30
31 gfc_code new_st;
32
33
34 /* Zeroes out the new_st structure. */
35
36 void
37 gfc_clear_new_st (void)
38 {
39
40 memset (&new_st, '\0', sizeof (new_st));
41 new_st.op = EXEC_NOP;
42 }
43
44
45 /* Get a gfc_code structure. */
46
47 gfc_code *
48 gfc_get_code (void)
49 {
50 gfc_code *c;
51
52 c = gfc_getmem (sizeof (gfc_code));
53 c->loc = gfc_current_locus;
54 return c;
55 }
56
57
58 /* Given some part of a gfc_code structure, append a set of code to
59 its tail, returning a pointer to the new tail. */
60
61 gfc_code *
62 gfc_append_code (gfc_code * tail, gfc_code * new)
63 {
64
65 if (tail != NULL)
66 {
67 while (tail->next != NULL)
68 tail = tail->next;
69
70 tail->next = new;
71 }
72
73 while (new->next != NULL)
74 new = new->next;
75
76 return new;
77 }
78
79
80 /* Free a single code structure, but not the actual structure itself. */
81
82 void
83 gfc_free_statement (gfc_code * p)
84 {
85
86 if (p->expr)
87 gfc_free_expr (p->expr);
88 if (p->expr2)
89 gfc_free_expr (p->expr2);
90
91 switch (p->op)
92 {
93 case EXEC_NOP:
94 case EXEC_ASSIGN:
95 case EXEC_GOTO:
96 case EXEC_CYCLE:
97 case EXEC_RETURN:
98 case EXEC_IF:
99 case EXEC_PAUSE:
100 case EXEC_STOP:
101 case EXEC_EXIT:
102 case EXEC_WHERE:
103 case EXEC_IOLENGTH:
104 case EXEC_POINTER_ASSIGN:
105 case EXEC_DO_WHILE:
106 case EXEC_CONTINUE:
107 case EXEC_TRANSFER:
108 case EXEC_LABEL_ASSIGN:
109
110 case EXEC_ARITHMETIC_IF:
111 break;
112
113 case EXEC_CALL:
114 gfc_free_actual_arglist (p->ext.actual);
115 break;
116
117 case EXEC_SELECT:
118 if (p->ext.case_list)
119 gfc_free_case_list (p->ext.case_list);
120 break;
121
122 case EXEC_DO:
123 gfc_free_iterator (p->ext.iterator, 1);
124 break;
125
126 case EXEC_ALLOCATE:
127 case EXEC_DEALLOCATE:
128 gfc_free_alloc_list (p->ext.alloc_list);
129 break;
130
131 case EXEC_OPEN:
132 gfc_free_open (p->ext.open);
133 break;
134
135 case EXEC_CLOSE:
136 gfc_free_close (p->ext.close);
137 break;
138
139 case EXEC_BACKSPACE:
140 case EXEC_ENDFILE:
141 case EXEC_REWIND:
142 gfc_free_filepos (p->ext.filepos);
143 break;
144
145 case EXEC_INQUIRE:
146 gfc_free_inquire (p->ext.inquire);
147 break;
148
149 case EXEC_READ:
150 case EXEC_WRITE:
151 gfc_free_dt (p->ext.dt);
152 break;
153
154 case EXEC_DT_END:
155 /* The ext.dt member is a duplicate pointer and doesn't need to
156 be freed. */
157 break;
158
159 case EXEC_FORALL:
160 gfc_free_forall_iterator (p->ext.forall_iterator);
161 break;
162
163 default:
164 gfc_internal_error ("gfc_free_statement(): Bad statement");
165 }
166 }
167
168
169 /* Free a code statement and all other code structures linked to it. */
170
171 void
172 gfc_free_statements (gfc_code * p)
173 {
174 gfc_code *q;
175
176 for (; p; p = q)
177 {
178 q = p->next;
179
180 if (p->block)
181 gfc_free_statements (p->block);
182 gfc_free_statement (p);
183 gfc_free (p);
184 }
185 }
186
This page took 0.046752 seconds and 5 git commands to generate.