OSDN Git Service

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