]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* M2Code.mod coordinate the activity of the front end. |
2 | ||
a945c346 | 3 | Copyright (C) 2001-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE M2Code ; | |
23 | ||
24 | ||
25 | FROM SYSTEM IMPORT WORD ; | |
26 | FROM M2Options IMPORT Statistics, DisplayQuadruples, OptimizeUncalledProcedures, | |
27 | (* OptimizeDynamic, *) OptimizeCommonSubExpressions, | |
28 | StyleChecking, Optimizing, WholeProgram ; | |
29 | ||
30 | FROM M2Error IMPORT InternalError ; | |
31 | FROM M2Students IMPORT StudentVariableCheck ; | |
32 | ||
33 | FROM SymbolTable IMPORT GetMainModule, IsProcedure, | |
34 | IsModuleWithinProcedure, | |
35 | CheckHiddenTypeAreAddress, IsModule, IsDefImp, | |
36 | DebugLineNumbers, | |
37 | ForeachProcedureDo, | |
38 | ForeachInnerModuleDo, GetSymName ; | |
39 | ||
40 | FROM M2Printf IMPORT printf2, printf1, printf0 ; | |
41 | FROM NameKey IMPORT Name ; | |
42 | FROM M2Batch IMPORT ForeachSourceModuleDo ; | |
43 | ||
44 | FROM M2Quads IMPORT CountQuads, GetFirstQuad, DisplayQuadList, DisplayQuadRange, | |
b0762d4c | 45 | BackPatchSubrangesAndOptParam, |
1eee94d3 GM |
46 | LoopAnalysis, ForLoopAnalysis, GetQuad, QuadOperator ; |
47 | ||
40b91158 | 48 | FROM M2SymInit IMPORT ScopeBlockVariableAnalysis ; |
b0762d4c | 49 | |
1eee94d3 GM |
50 | FROM M2Pass IMPORT SetPassToNoPass, SetPassToCodeGeneration ; |
51 | ||
52 | FROM M2BasicBlock IMPORT BasicBlock, | |
53 | InitBasicBlocks, InitBasicBlocksFromRange, | |
54 | KillBasicBlocks, FreeBasicBlocks, | |
55 | ForeachBasicBlockDo ; | |
56 | ||
57 | FROM M2Optimize IMPORT FoldBranches, RemoveProcedures ; | |
58 | FROM M2GenGCC IMPORT ConvertQuadsToTree ; | |
59 | ||
60 | FROM M2GCCDeclare IMPORT FoldConstants, StartDeclareScope, | |
61 | DeclareProcedure, InitDeclarations, | |
62 | DeclareModuleVariables, MarkExported ; | |
63 | ||
64 | FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ; | |
65 | FROM m2top IMPORT StartGlobalContext, EndGlobalContext, SetFlagUnitAtATime ; | |
66 | FROM M2Error IMPORT FlushErrors, FlushWarnings ; | |
67 | FROM M2Swig IMPORT GenerateSwigFile ; | |
68 | FROM m2flex IMPORT GetTotalLines ; | |
69 | FROM FIO IMPORT FlushBuffer, StdOut ; | |
70 | FROM M2Quiet IMPORT qprintf0 ; | |
71 | FROM M2SSA IMPORT DiscoverSSA ; | |
72 | ||
73 | ||
74 | CONST | |
75 | MaxOptimTimes = 10 ; (* upper limit of no of times we run through all optimization *) | |
76 | Debugging = TRUE ; | |
77 | ||
78 | ||
79 | VAR | |
80 | Total, | |
81 | Count, | |
82 | OptimTimes, | |
83 | DeltaProc, | |
84 | Proc, | |
85 | DeltaConst, | |
86 | Const, | |
87 | DeltaJump, | |
88 | Jump, | |
89 | DeltaBasicB, | |
90 | BasicB : CARDINAL ; | |
91 | ||
92 | ||
93 | (* | |
94 | Percent - calculates the percentage from numerator and divisor | |
95 | *) | |
96 | ||
97 | PROCEDURE Percent (numerator, divisor: CARDINAL) ; | |
98 | VAR | |
99 | value: CARDINAL ; | |
100 | BEGIN | |
101 | printf0 (' (') ; | |
102 | IF divisor=0 | |
103 | THEN | |
104 | printf0 ('overflow error') | |
105 | ELSE | |
106 | value := numerator*100 DIV divisor ; | |
107 | printf1 ('%3d', value) | |
108 | END ; | |
109 | printf0 ('\%)') | |
110 | END Percent ; | |
111 | ||
112 | ||
113 | (* | |
114 | OptimizationAnalysis - displays some simple front end optimization statistics. | |
115 | *) | |
116 | ||
117 | PROCEDURE OptimizationAnalysis ; | |
118 | VAR | |
119 | value: CARDINAL ; | |
120 | BEGIN | |
121 | IF Statistics | |
122 | THEN | |
123 | Count := CountQuads() ; | |
124 | ||
125 | printf1 ('M2 initial number of quadruples: %6d', Total) ; | |
126 | Percent (Total, Total) ; printf0 ('\n'); | |
127 | printf1 ('M2 constant folding achieved : %6d', Const) ; | |
128 | Percent (Const, Total) ; printf0 ('\n'); | |
129 | printf1 ('M2 branch folding achieved : %6d', Jump) ; | |
130 | Percent (Jump, Total) ; printf0 ('\n'); | |
131 | value := Const+Jump+Proc ; | |
132 | printf1 ('Front end optimization removed : %6d', value) ; | |
133 | Percent (value, Total) ; printf0 ('\n') ; | |
134 | printf1 ('Front end final : %6d', Count) ; | |
135 | Percent (Count, Total) ; printf0 ('\n') ; | |
136 | Count := GetTotalLines () ; | |
137 | printf1 ('Total source lines compiled : %6d\n', Count) ; | |
138 | FlushBuffer (StdOut) | |
139 | END ; | |
140 | IF DisplayQuadruples | |
141 | THEN | |
142 | printf0 ('after all front end optimization\n') ; | |
143 | DisplayQuadList | |
144 | END | |
145 | END OptimizationAnalysis ; | |
146 | ||
147 | ||
148 | (* | |
149 | RemoveUnreachableCode - | |
150 | *) | |
151 | ||
152 | PROCEDURE RemoveUnreachableCode ; | |
153 | BEGIN | |
154 | IF WholeProgram | |
155 | THEN | |
156 | ForeachSourceModuleDo(RemoveProcedures) | |
157 | ELSE | |
158 | RemoveProcedures(GetMainModule()) | |
159 | END | |
160 | END RemoveUnreachableCode ; | |
161 | ||
162 | ||
163 | (* | |
164 | DoModuleDeclare - declare all constants, types, variables, procedures for the | |
165 | main module or all modules. | |
166 | *) | |
167 | ||
168 | PROCEDURE DoModuleDeclare ; | |
169 | BEGIN | |
170 | IF WholeProgram | |
171 | THEN | |
172 | ForeachSourceModuleDo (StartDeclareScope) | |
173 | ELSE | |
174 | StartDeclareScope (GetMainModule ()) | |
175 | END | |
176 | END DoModuleDeclare ; | |
177 | ||
178 | ||
179 | (* | |
180 | PrintModule - | |
181 | *) | |
182 | ||
183 | (* | |
184 | PROCEDURE PrintModule (sym: CARDINAL) ; | |
185 | VAR | |
186 | n: Name ; | |
187 | BEGIN | |
188 | n := GetSymName (sym) ; | |
189 | printf1 ('module %a\n', n) | |
190 | END PrintModule ; | |
191 | *) | |
192 | ||
193 | ||
194 | (* | |
195 | DoCodeBlock - generate code for the main module or all modules. | |
196 | *) | |
197 | ||
198 | PROCEDURE DoCodeBlock ; | |
199 | BEGIN | |
200 | IF WholeProgram | |
201 | THEN | |
202 | (* ForeachSourceModuleDo(PrintModule) ; *) | |
203 | CodeBlock (GetMainModule ()) | |
204 | ELSE | |
205 | CodeBlock (GetMainModule ()) | |
206 | END | |
207 | END DoCodeBlock ; | |
208 | ||
209 | ||
210 | (* | |
211 | DetermineSubExpTemporaries - | |
212 | *) | |
213 | ||
214 | PROCEDURE DetermineSubExpTemporaries ; | |
215 | BEGIN | |
216 | IF WholeProgram | |
217 | THEN | |
218 | ForeachSourceModuleDo (DiscoverSSA) | |
219 | ELSE | |
220 | DiscoverSSA (GetMainModule ()) | |
221 | END | |
222 | END DetermineSubExpTemporaries ; | |
223 | ||
224 | ||
225 | (* | |
226 | Code - calls procedures to generates trees from the quadruples. | |
227 | All front end quadruple optimization is performed via this call. | |
228 | *) | |
229 | ||
230 | PROCEDURE Code ; | |
231 | BEGIN | |
232 | CheckHiddenTypeAreAddress ; | |
233 | SetPassToNoPass ; | |
234 | BackPatchSubrangesAndOptParam ; | |
235 | Total := CountQuads () ; | |
236 | ||
237 | ForLoopAnalysis ; (* must be done before any optimization as the index variable increment quad might change *) | |
238 | ||
239 | IF DisplayQuadruples | |
240 | THEN | |
241 | printf0 ('before any optimization\n') ; | |
242 | DisplayQuadList | |
243 | END ; | |
244 | ||
245 | (* now is a suitable time to check for student errors as *) | |
246 | (* we know all the front end symbols must be resolved. *) | |
247 | ||
248 | IF StyleChecking | |
249 | THEN | |
250 | StudentVariableCheck | |
251 | END ; | |
252 | ||
253 | SetPassToCodeGeneration ; | |
254 | SetFlagUnitAtATime (Optimizing) ; | |
255 | StartGlobalContext ; | |
256 | InitDeclarations ; (* default and fixed sized types are all declared from now on. *) | |
257 | ||
258 | RemoveUnreachableCode ; | |
259 | ||
260 | IF DisplayQuadruples | |
261 | THEN | |
262 | printf0 ('after dead procedure elimination\n') ; | |
263 | DisplayQuadList | |
264 | END ; | |
265 | ||
266 | DetermineSubExpTemporaries ; | |
267 | ||
268 | IF DisplayQuadruples | |
269 | THEN | |
270 | printf0 ('after identifying simple subexpression temporaries\n') ; | |
271 | DisplayQuadList | |
272 | END ; | |
273 | ||
274 | qprintf0 (' symbols to gcc trees\n') ; | |
275 | DoModuleDeclare ; | |
276 | ||
277 | FlushWarnings ; | |
278 | FlushErrors ; | |
279 | qprintf0 (' statements to gcc trees\n') ; | |
280 | DoCodeBlock ; | |
281 | ||
282 | MarkExported (GetMainModule ()) ; | |
283 | GenerateSwigFile (GetMainModule ()) ; | |
284 | DebugLineNumbers (GetMainModule ()) ; | |
285 | qprintf0 (' gcc trees given to the gcc backend\n') ; | |
286 | EndGlobalContext ; | |
287 | ||
288 | OptimizationAnalysis | |
289 | END Code ; | |
290 | ||
291 | ||
292 | (* | |
293 | InitialDeclareAndCodeBlock - declares all objects within scope, | |
294 | *) | |
295 | ||
40b91158 | 296 | PROCEDURE InitialDeclareAndOptimize (scope: CARDINAL; start, end: CARDINAL) ; |
1eee94d3 | 297 | BEGIN |
40b91158 GM |
298 | Count := CountQuads () ; |
299 | FreeBasicBlocks (InitBasicBlocksFromRange (scope, start, end)) ; | |
300 | BasicB := Count - CountQuads () ; | |
301 | Count := CountQuads () ; | |
302 | ||
303 | FoldBranches (start, end) ; | |
304 | Jump := Count - CountQuads () ; | |
305 | Count := CountQuads () | |
1eee94d3 GM |
306 | END InitialDeclareAndOptimize ; |
307 | ||
308 | ||
309 | (* | |
310 | DeclareAndCodeBlock - declares all objects within scope, | |
311 | *) | |
312 | ||
40b91158 GM |
313 | PROCEDURE SecondDeclareAndOptimize (scope: CARDINAL; |
314 | start, end: CARDINAL) ; | |
1eee94d3 GM |
315 | BEGIN |
316 | REPEAT | |
317 | FoldConstants(start, end) ; | |
318 | DeltaConst := Count - CountQuads () ; | |
319 | Count := CountQuads () ; | |
320 | ||
40b91158 | 321 | FreeBasicBlocks(InitBasicBlocksFromRange (scope, start, end)) ; |
1eee94d3 GM |
322 | |
323 | DeltaBasicB := Count - CountQuads () ; | |
324 | Count := CountQuads () ; | |
325 | ||
40b91158 | 326 | FreeBasicBlocks (InitBasicBlocksFromRange (scope, start, end)) ; |
1eee94d3 GM |
327 | FoldBranches(start, end) ; |
328 | DeltaJump := Count - CountQuads () ; | |
329 | Count := CountQuads () ; | |
330 | ||
40b91158 | 331 | FreeBasicBlocks(InitBasicBlocksFromRange (scope, start, end)) ; |
1eee94d3 GM |
332 | INC (DeltaBasicB, Count - CountQuads ()) ; |
333 | Count := CountQuads () ; | |
334 | ||
335 | (* now total the optimization components *) | |
336 | INC (Proc, DeltaProc) ; | |
337 | INC (Const, DeltaConst) ; | |
338 | INC (Jump, DeltaJump) ; | |
339 | INC (BasicB, DeltaBasicB) | |
340 | UNTIL (OptimTimes>=MaxOptimTimes) OR | |
341 | ((DeltaProc=0) AND (DeltaConst=0) AND (DeltaJump=0) AND (DeltaBasicB=0)) ; | |
342 | ||
343 | IF (DeltaProc#0) OR (DeltaConst#0) OR (DeltaJump#0) OR (DeltaBasicB#0) | |
344 | THEN | |
345 | printf0 ('optimization finished although more reduction may be possible (increase MaxOptimTimes)\n') | |
346 | END | |
347 | END SecondDeclareAndOptimize ; | |
348 | ||
349 | ||
350 | (* | |
351 | InitOptimizeVariables - | |
352 | *) | |
353 | ||
354 | PROCEDURE InitOptimizeVariables ; | |
355 | BEGIN | |
356 | Count := CountQuads () ; | |
357 | OptimTimes := 0 ; | |
358 | DeltaProc := 0 ; | |
359 | DeltaConst := 0 ; | |
360 | DeltaJump := 0 ; | |
361 | DeltaBasicB := 0 | |
362 | END InitOptimizeVariables ; | |
363 | ||
364 | ||
365 | (* | |
366 | Init - | |
367 | *) | |
368 | ||
369 | PROCEDURE Init ; | |
370 | BEGIN | |
371 | Proc := 0 ; | |
372 | Const := 0 ; | |
373 | Jump := 0 ; | |
374 | BasicB := 0 | |
375 | END Init ; | |
376 | ||
377 | ||
1eee94d3 GM |
378 | (* |
379 | DisplayQuadsInScope - | |
380 | *) | |
381 | ||
382 | (* | |
383 | PROCEDURE DisplayQuadsInScope (sb: ScopeBlock) ; | |
384 | BEGIN | |
385 | printf0 ('Quads in scope\n') ; | |
386 | ForeachScopeBlockDo (sb, DisplayQuadRange) ; | |
387 | printf0 ('===============\n') | |
388 | END DisplayQuadsInScope ; | |
389 | *) | |
390 | ||
391 | ||
392 | (* | |
393 | OptimizeScopeBlock - | |
394 | *) | |
395 | ||
396 | PROCEDURE OptimizeScopeBlock (sb: ScopeBlock) ; | |
397 | VAR | |
398 | OptimTimes, | |
399 | Previous, | |
400 | Current : CARDINAL ; | |
401 | BEGIN | |
402 | InitOptimizeVariables ; | |
403 | OptimTimes := 1 ; | |
404 | Current := CountQuads () ; | |
405 | ForeachScopeBlockDo (sb, InitialDeclareAndOptimize) ; | |
40b91158 | 406 | ForeachScopeBlockDo (sb, ScopeBlockVariableAnalysis) ; |
1eee94d3 GM |
407 | REPEAT |
408 | ForeachScopeBlockDo (sb, SecondDeclareAndOptimize) ; | |
409 | Previous := Current ; | |
410 | Current := CountQuads () ; | |
411 | INC (OptimTimes) | |
412 | UNTIL (OptimTimes=MaxOptimTimes) OR (Current=Previous) ; | |
413 | ForeachScopeBlockDo (sb, LoopAnalysis) | |
414 | END OptimizeScopeBlock ; | |
415 | ||
416 | ||
417 | (* | |
418 | DisplayQuadNumbers - the range, start..end. | |
419 | *) | |
420 | ||
421 | (* | |
422 | PROCEDURE DisplayQuadNumbers (start, end: CARDINAL) ; | |
423 | BEGIN | |
424 | IF DisplayQuadruples | |
425 | THEN | |
426 | printf2 ('Coding [%d..%d]\n', start, end) | |
427 | END | |
428 | END DisplayQuadNumbers ; | |
429 | *) | |
430 | ||
431 | ||
432 | (* | |
433 | CodeProceduresWithinBlock - codes the procedures within the module scope. | |
434 | *) | |
435 | ||
436 | PROCEDURE CodeProceduresWithinBlock (scope: CARDINAL) ; | |
437 | BEGIN | |
438 | ForeachProcedureDo (scope, CodeBlock) | |
439 | END CodeProceduresWithinBlock ; | |
440 | ||
441 | ||
442 | (* | |
443 | CodeProcedures - | |
444 | *) | |
445 | ||
446 | PROCEDURE CodeProcedures (scope: CARDINAL) ; | |
447 | BEGIN | |
448 | IF IsDefImp (scope) OR IsModule (scope) | |
449 | THEN | |
450 | ForeachProcedureDo (scope, CodeBlock) | |
451 | END | |
452 | END CodeProcedures ; | |
453 | ||
454 | ||
455 | (* | |
456 | CodeBlock - generates all code for this block and also declares | |
457 | all types and procedures for this block. It will | |
458 | also optimize quadruples within this scope. | |
459 | *) | |
460 | ||
461 | PROCEDURE CodeBlock (scope: WORD) ; | |
462 | VAR | |
463 | sb: ScopeBlock ; | |
464 | n : Name ; | |
465 | BEGIN | |
466 | IF DisplayQuadruples | |
467 | THEN | |
468 | n := GetSymName (scope) ; | |
469 | printf1 ('before coding block %a\n', n) | |
470 | END ; | |
471 | sb := InitScopeBlock (scope) ; | |
472 | OptimizeScopeBlock (sb) ; | |
473 | IF IsProcedure (scope) | |
474 | THEN | |
475 | IF DisplayQuadruples | |
476 | THEN | |
477 | n := GetSymName(scope) ; | |
478 | printf1('before coding procedure %a\n', n) ; | |
479 | ForeachScopeBlockDo(sb, DisplayQuadRange) ; | |
480 | printf0('===============\n') | |
481 | END ; | |
482 | ForeachScopeBlockDo(sb, ConvertQuadsToTree) | |
483 | ELSIF IsModuleWithinProcedure(scope) | |
484 | THEN | |
485 | IF DisplayQuadruples | |
486 | THEN | |
487 | n := GetSymName(scope) ; | |
488 | printf1('before coding module %a within procedure\n', n) ; | |
489 | ForeachScopeBlockDo(sb, DisplayQuadRange) ; | |
490 | printf0('===============\n') | |
491 | END ; | |
492 | ForeachScopeBlockDo(sb, ConvertQuadsToTree) ; | |
493 | ForeachProcedureDo(scope, CodeBlock) | |
494 | ELSE | |
495 | IF DisplayQuadruples | |
496 | THEN | |
497 | n := GetSymName(scope) ; | |
498 | printf1('before coding module %a\n', n) ; | |
499 | ForeachScopeBlockDo(sb, DisplayQuadRange) ; | |
500 | printf0('===============\n') | |
501 | END ; | |
502 | ForeachScopeBlockDo(sb, ConvertQuadsToTree) ; | |
503 | IF WholeProgram | |
504 | THEN | |
505 | ForeachSourceModuleDo(CodeProcedures) | |
506 | ELSE | |
507 | ForeachProcedureDo(scope, CodeBlock) | |
508 | END ; | |
509 | ForeachInnerModuleDo(scope, CodeProceduresWithinBlock) | |
510 | END ; | |
511 | KillScopeBlock(sb) | |
512 | END CodeBlock ; | |
513 | ||
514 | ||
515 | BEGIN | |
516 | Init | |
517 | END M2Code. |