1 {
2 Copyright (c) 1998-2002 by Florian Klaempfl
3
4 This unit handles the codegeneration pass
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ****************************************************************************
21 }
22 unit pass_2;
23
24 {$i fpcdefs.inc}
25
26 interface
27
28 uses
29 node;
30
31 type
32 tenumflowcontrol = (
33 fc_exit,
34 fc_break,
35 fc_continue,
36 fc_inflowcontrol,
37 fc_gotolabel,
38 { in block that has an exception handler associated with it
39 (try..except, try..finally, exception block of try..except, ... }
40 fc_catching_exceptions,
41 { in try block of try..finally and target uses specific unwinding }
42 fc_unwind_exit,
43 fc_unwind_loop,
44 { the left side of an expression is already handled, so we are
45 not allowed to do ssl }
46 fc_lefthandled,
47 { in block where the exit statement jumps to an extra code instead of
48 immediately finishing execution of the current routine. }
49 fc_no_direct_exit);
50
51 tflowcontrol = set of tenumflowcontrol;
52
53 var
54 flowcontrol : tflowcontrol;
55
56 { produces the actual code }
do_secondpassnull57 function do_secondpass(var p : tnode) : boolean;
58 procedure secondpass(p : tnode);
59
60
61 implementation
62
63 uses
64 cutils,
65 globtype,verbose,
66 globals,
67 aasmdata,
68 cgobj
69 {$ifdef EXTDEBUG}
70 ,cgbase
71 ,aasmtai
72 {$endif}
73 ;
74
75 {*****************************************************************************
76 SecondPass
77 *****************************************************************************}
78
79 {$ifdef EXTDEBUG}
80 var
81 secondprefix : string;
82
83 procedure logsecond(ht:tnodetype; entry: boolean);
84 const
85 secondnames: array[tnodetype] of string[13] =
86 ('<emptynode>',
87 'add-addn', {addn}
88 'add-muln', {muln}
89 'add-subn', {subn}
90 'moddiv-divn', {divn}
91 'add-symdifn', {symdifn}
92 'moddiv-modn', {modn}
93 'assignment', {assignn}
94 'load', {loadn}
95 'nothing-range', {range}
96 'add-ltn', {ltn}
97 'add-lten', {lten}
98 'add-gtn', {gtn}
99 'add-gten', {gten}
100 'add-equaln', {equaln}
101 'add-unequaln', {unequaln}
102 'in', {inn}
103 'add-orn', {orn}
104 'add-xorn', {xorn}
105 'shlshr-shrn', {shrn}
106 'shlshr-shln', {shln}
107 'add-slashn', {slashn}
108 'add-andn', {andn}
109 'subscriptn', {subscriptn}
110 'deref', {derefn}
111 'addr', {addrn}
112 'ordconst', {ordconstn}
113 'typeconv', {typeconvn}
114 'calln', {calln}
115 'noth-callpar',{callparan}
116 'realconst', {realconstn}
117 'unaryminus', {unaryminusn}
118 'unaryplus', {unaryplusn}
119 'asm', {asmn}
120 'vecn', {vecn}
121 'pointerconst',{pointerconstn}
122 'stringconst', {stringconstn}
123 'not', {notn}
124 'inline', {inlinen}
125 'niln', {niln}
126 'error', {errorn}
127 'nothing-typen', {typen}
128 'setelement', {setelementn}
129 'setconst', {setconstn}
130 'blockn', {blockn}
131 'statement', {statementn}
132 'ifn', {ifn}
133 'breakn', {breakn}
134 'continuen', {continuen}
135 'while_repeat', {whilerepeatn}
136 'for', {forn}
137 'exitn', {exitn}
138 'case', {casen}
139 'label', {labeln}
140 'goto', {goton}
141 'tryexcept', {tryexceptn}
142 'raise', {raisen}
143 'tryfinally', {tryfinallyn}
144 'on', {onn}
145 'is', {isn}
146 'as', {asn}
147 'add-starstar', {starstarn}
148 'arrayconstruc', {arrayconstructn}
149 'noth-arrcnstr', {arrayconstructrangen}
150 'tempcreaten',
151 'temprefn',
152 'tempdeleten',
153 'addoptn',
154 'nothing-nothg', {nothingn}
155 'loadvmt', {loadvmtn}
156 'guidconstn',
157 'rttin',
158 'loadparentfpn',
159 'objselectorn',
160 'objcprotocoln',
161 'specializen'
162 );
163 var
164 p: pchar;
165 begin
166 if entry then
167 begin
168 secondprefix:=secondprefix+' ';
169 p := strpnew(secondprefix+'second '+secondnames[ht]+' (entry)')
170 end
171 else
172 begin
173 p := strpnew(secondprefix+'second '+secondnames[ht]+' (exit)');
174 delete(secondprefix,length(secondprefix),1);
175 end;
176 current_asmdata.CurrAsmList.concat(tai_comment.create(p));
177 end;
178 {$endif EXTDEBUG}
179
180 procedure secondpass(p : tnode);
181 var
182 oldcodegenerror : boolean;
183 oldlocalswitches : tlocalswitches;
184 oldpos : tfileposinfo;
185 begin
186 if not assigned(p) then
187 internalerror(200208221);
188 if not(nf_error in p.flags) then
189 begin
190 oldcodegenerror:=codegenerror;
191 oldlocalswitches:=current_settings.localswitches;
192 oldpos:=current_filepos;
193 current_filepos:=p.fileinfo;
194 current_settings.localswitches:=p.localswitches;
195 codegenerror:=false;
196 if assigned(p.optinfo) then
197 cg.executionweight:=min(p.optinfo^.executionweight,high(cg.executionweight))
198 else
199 cg.executionweight:=100;
200 {$ifdef EXTDEBUG}
201 if (p.expectloc=LOC_INVALID) then
202 Comment(V_Warning,'ExpectLoc is not set before secondpass: '+nodetype2str[p.nodetype]);
203 if (p.location.loc<>LOC_INVALID) then
204 Comment(V_Warning,'Location.Loc is already set before secondpass: '+nodetype2str[p.nodetype]);
205 if (cs_asm_nodes in current_settings.globalswitches) then
206 logsecond(p.nodetype,true);
207 {$endif EXTDEBUG}
208 p.pass_generate_code;
209 {$ifdef EXTDEBUG}
210 if (cs_asm_nodes in current_settings.globalswitches) then
211 logsecond(p.nodetype,false);
212 if (not codegenerror) then
213 begin
214 if (p.location.loc<>p.expectloc) then
215 begin
216 if ((p.location.loc=loc_register) and (p.expectloc=loc_cregister))
217 or ((p.location.loc=loc_fpuregister) and (p.expectloc=loc_cfpuregister))
218 or ((p.location.loc=loc_reference) and (p.expectloc=loc_creference)) then
219 Comment(V_Note,'Location ('+tcgloc2str[p.location.loc]+') not equal to expectloc ('+tcgloc2str[p.expectloc]+'): '+nodetype2str[p.nodetype])
220 else
221 Comment(V_Warning,'Location ('+tcgloc2str[p.location.loc]+') not equal to expectloc ('+tcgloc2str[p.expectloc]+'): '+nodetype2str[p.nodetype]);
222 end;
223 if (p.location.loc=LOC_INVALID) then
224 Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype]);
225 end;
226 {$endif EXTDEBUG}
227 if codegenerror then
228 include(p.flags,nf_error);
229 codegenerror:=codegenerror or oldcodegenerror;
230 current_settings.localswitches:=oldlocalswitches;
231 current_filepos:=oldpos;
232 end
233 else
234 codegenerror:=true;
235 end;
236
237
do_secondpassnull238 function do_secondpass(var p : tnode) : boolean;
239 begin
240 { current_asmdata.CurrAsmList must be empty }
241 if not current_asmdata.CurrAsmList.empty then
242 internalerror(200405201);
243
244 { clear errors before starting }
245 codegenerror:=false;
246 if not(nf_error in p.flags) then
247 secondpass(p);
248 do_secondpass:=codegenerror;
249 end;
250
251
252 end.
253