Line data Source code
1 : /* do not edit automatically generated by mc from M2Quads. */
2 : /* M2Quads.mod generates quadruples.
3 :
4 : Copyright (C) 2001-2026 Free Software Foundation, Inc.
5 : Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 :
7 : This file is part of GNU Modula-2.
8 :
9 : GNU Modula-2 is free software; you can redistribute it and/or modify
10 : it under the terms of the GNU General Public License as published by
11 : the Free Software Foundation; either version 3, or (at your option)
12 : any later version.
13 :
14 : GNU Modula-2 is distributed in the hope that it will be useful, but
15 : WITHOUT ANY WARRANTY; without even the implied warranty of
16 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 : General Public License for more details.
18 :
19 : You should have received a copy of the GNU General Public License
20 : along with GNU Modula-2; see the file COPYING3. If not see
21 : <http://www.gnu.org/licenses/>. */
22 :
23 : #include "config.h"
24 : #include "system.h"
25 : #include "gcc-consolidation.h"
26 :
27 : #include <stdbool.h>
28 : # if !defined (PROC_D)
29 : # define PROC_D
30 : typedef void (*PROC_t) (void);
31 : typedef struct { PROC_t proc; } PROC;
32 : # endif
33 :
34 : # if !defined (TRUE)
35 : # define TRUE (1==1)
36 : # endif
37 :
38 : # if !defined (FALSE)
39 : # define FALSE (1==0)
40 : # endif
41 :
42 : # include "GStorage.h"
43 : # include "Gmcrts.h"
44 : #if defined(__cplusplus)
45 : # undef NULL
46 : # define NULL 0
47 : #endif
48 : #define _M2Quads_C
49 :
50 : #include "GM2Quads.h"
51 : # include "GStorage.h"
52 : # include "GM2Debug.h"
53 : # include "GNameKey.h"
54 : # include "GFormatStrings.h"
55 : # include "GM2DebugStack.h"
56 : # include "GStrLib.h"
57 : # include "GM2Scaffold.h"
58 : # include "GM2MetaError.h"
59 : # include "GDynamicStrings.h"
60 : # include "GSymbolTable.h"
61 : # include "GM2Batch.h"
62 : # include "GM2GCCDeclare.h"
63 : # include "GFifoQueue.h"
64 : # include "GM2Comp.h"
65 : # include "GM2LexBuf.h"
66 : # include "GM2Error.h"
67 : # include "GM2Printf.h"
68 : # include "GM2Reserved.h"
69 : # include "GM2Base.h"
70 : # include "GM2System.h"
71 : # include "GM2Size.h"
72 : # include "GM2Bitset.h"
73 : # include "GM2ALU.h"
74 : # include "GLists.h"
75 : # include "GM2Options.h"
76 : # include "GM2LangDump.h"
77 : # include "GM2Pass.h"
78 : # include "GM2StackAddress.h"
79 : # include "GM2StackWord.h"
80 : # include "GIndexing.h"
81 : # include "GM2Range.h"
82 : # include "GM2CaseList.h"
83 : # include "GPCSymBuild.h"
84 : # include "Gm2builtins.h"
85 : # include "GSymbolConversion.h"
86 : # include "GM2Diagnostic.h"
87 : # include "GFIO.h"
88 : # include "GSFIO.h"
89 : # include "GStdIO.h"
90 : # include "GM2StackSpell.h"
91 :
92 : # define DebugStackOn true
93 : # define DebugVarients false
94 : # define DebugTokPos false
95 : typedef struct M2Quads__T1_r M2Quads__T1;
96 :
97 : typedef M2Quads__T1 *M2Quads_ConstructorFrame;
98 :
99 : typedef struct M2Quads__T2_r M2Quads__T2;
100 :
101 : typedef M2Quads__T2 *M2Quads_BoolFrame;
102 :
103 : typedef struct M2Quads__T3_r M2Quads__T3;
104 :
105 : typedef M2Quads__T3 *M2Quads_QuadFrame;
106 :
107 : typedef struct M2Quads__T4_r M2Quads__T4;
108 :
109 : typedef M2Quads__T4 *M2Quads_WithFrame;
110 :
111 : typedef struct M2Quads__T5_r M2Quads__T5;
112 :
113 : typedef M2Quads__T5 *M2Quads_ForLoopInfo;
114 :
115 : typedef struct M2Quads__T6_r M2Quads__T6;
116 :
117 : typedef M2Quads__T6 *M2Quads_LineNote;
118 :
119 : # define DebugAsmTokPos false
120 : struct M2Quads__T1_r {
121 : unsigned int type;
122 : unsigned int index;
123 : };
124 :
125 : struct M2Quads__T2_r {
126 : unsigned int TrueExit;
127 : unsigned int FalseExit;
128 : unsigned int Unbounded;
129 : bool BooleanOp;
130 : unsigned int Dimension;
131 : unsigned int ReadWrite;
132 : unsigned int name;
133 : unsigned int RangeDep;
134 : DynamicStrings_String Annotation;
135 : unsigned int tokenno;
136 : };
137 :
138 : struct M2Quads__T3_r {
139 : M2Quads_QuadOperator Operator;
140 : unsigned int Operand1;
141 : unsigned int Operand2;
142 : unsigned int Operand3;
143 : unsigned int Trash;
144 : unsigned int Next;
145 : unsigned int LineNo;
146 : unsigned int TokenNo;
147 : unsigned int NoOfTimesReferenced;
148 : bool ConstExpr;
149 : bool CheckType;
150 : bool CheckOverflow;
151 : unsigned int op1pos;
152 : unsigned int op2pos;
153 : unsigned int op3pos;
154 : };
155 :
156 : struct M2Quads__T4_r {
157 : unsigned int RecordSym;
158 : unsigned int RecordType;
159 : unsigned int RecordRef;
160 : unsigned int rw;
161 : unsigned int RecordTokPos;
162 : };
163 :
164 : struct M2Quads__T5_r {
165 : unsigned int IncrementQuad;
166 : unsigned int StartOfForLoop;
167 : unsigned int EndOfForLoop;
168 : unsigned int ForLoopIndex;
169 : unsigned int IndexTok;
170 : };
171 :
172 : struct M2Quads__T6_r {
173 : unsigned int Line;
174 : NameKey_Name File;
175 : M2Quads_LineNote Next;
176 : };
177 :
178 : static M2StackAddress_StackOfAddress ConstructorStack;
179 : static M2StackAddress_StackOfAddress LineStack;
180 : static M2StackAddress_StackOfAddress BoolStack;
181 : static M2StackAddress_StackOfAddress WithStack;
182 : static M2StackWord_StackOfWord TryStack;
183 : static M2StackWord_StackOfWord CatchStack;
184 : static M2StackWord_StackOfWord ExceptStack;
185 : static M2StackWord_StackOfWord ConstExprStack;
186 : static M2StackWord_StackOfWord ConstParamStack;
187 : static M2StackWord_StackOfWord AutoStack;
188 : static M2StackWord_StackOfWord RepeatStack;
189 : static M2StackWord_StackOfWord WhileStack;
190 : static M2StackWord_StackOfWord ForStack;
191 : static M2StackWord_StackOfWord ExitStack;
192 : static M2StackWord_StackOfWord ReturnStack;
193 : static M2StackWord_StackOfWord PriorityStack;
194 : static bool SuppressWith;
195 : static Indexing_Index QuadArray;
196 : static unsigned int NextQuad;
197 : static unsigned int FreeList;
198 : static unsigned int CurrentProc;
199 : static unsigned int InitQuad;
200 : static unsigned int LastQuadNo;
201 : static NameKey_Name ArithPlusTok;
202 : static NameKey_Name LogicalOrTok;
203 : static NameKey_Name LogicalAndTok;
204 : static NameKey_Name LogicalXorTok;
205 : static NameKey_Name LogicalDifferenceTok;
206 : static bool InConstExpression;
207 : static bool InConstParameters;
208 : static bool IsAutoOn;
209 : static bool MustNotCheckBounds;
210 : static Indexing_Index ForInfo;
211 : static unsigned int GrowInitialization;
212 : static bool BuildingHigh;
213 : static bool BuildingSize;
214 : static bool QuadrupleGeneration;
215 : static M2Quads_LineNote FreeLineList;
216 : static Lists_List VarientFields;
217 : static unsigned int VarientFieldNo;
218 : static unsigned int NoOfQuads;
219 : static unsigned int Head;
220 : static M2Diagnostic_Diagnostic QuadMemDiag;
221 : static unsigned int BreakQuad;
222 :
223 : /*
224 : SetOptionCoding - builds a code quadruple if the profiling
225 : option was given to the compiler.
226 : */
227 :
228 : extern "C" void M2Quads_SetOptionCoding (bool b);
229 :
230 : /*
231 : SetOptionProfiling - builds a profile quadruple if the profiling
232 : option was given to the compiler.
233 : */
234 :
235 : extern "C" void M2Quads_SetOptionProfiling (bool b);
236 :
237 : /*
238 : SetOptionOptimizing - builds a quadruple to say that the optimization option
239 : has been found in a comment.
240 : */
241 :
242 : extern "C" void M2Quads_SetOptionOptimizing (bool b);
243 :
244 : /*
245 : Opposite - returns the opposite comparison operator.
246 : */
247 :
248 : extern "C" M2Quads_QuadOperator M2Quads_Opposite (M2Quads_QuadOperator Operator);
249 :
250 : /*
251 : IsReferenced - returns true if QuadNo is referenced by another quadruple.
252 : */
253 :
254 : extern "C" bool M2Quads_IsReferenced (unsigned int QuadNo);
255 :
256 : /*
257 : IsBackReference - returns TRUE if quadruple, q, is referenced from a quad further on.
258 : */
259 :
260 : extern "C" bool M2Quads_IsBackReference (unsigned int q);
261 :
262 : /*
263 : IsUnConditional - returns true if QuadNo is an unconditional jump.
264 : */
265 :
266 : extern "C" bool M2Quads_IsUnConditional (unsigned int QuadNo);
267 :
268 : /*
269 : IsConditional - returns true if QuadNo is a conditional jump.
270 : */
271 :
272 : extern "C" bool M2Quads_IsConditional (unsigned int QuadNo);
273 :
274 : /*
275 : IsBackReferenceConditional - returns TRUE if quadruple, q, is referenced from
276 : a conditional quad further on.
277 : */
278 :
279 : extern "C" bool M2Quads_IsBackReferenceConditional (unsigned int q);
280 :
281 : /*
282 : IsGoto - returns true if QuadNo is a goto operation.
283 : */
284 :
285 : extern "C" bool M2Quads_IsGoto (unsigned int QuadNo);
286 :
287 : /*
288 : IsCall - returns true if QuadNo is a call operation.
289 : */
290 :
291 : extern "C" bool M2Quads_IsCall (unsigned int QuadNo);
292 :
293 : /*
294 : IsReturn - returns true if QuadNo is a return operation.
295 : */
296 :
297 : extern "C" bool M2Quads_IsReturn (unsigned int QuadNo);
298 :
299 : /*
300 : IsProcedureScope - returns true if QuadNo is a ProcedureScope operation.
301 : */
302 :
303 : extern "C" bool M2Quads_IsProcedureScope (unsigned int QuadNo);
304 :
305 : /*
306 : IsNewLocalVar - returns true if QuadNo is a NewLocalVar operation.
307 : */
308 :
309 : extern "C" bool M2Quads_IsNewLocalVar (unsigned int QuadNo);
310 :
311 : /*
312 : IsKillLocalVar - returns true if QuadNo is a KillLocalVar operation.
313 : */
314 :
315 : extern "C" bool M2Quads_IsKillLocalVar (unsigned int QuadNo);
316 :
317 : /*
318 : IsCatchBegin - returns true if QuadNo is a catch begin quad.
319 : */
320 :
321 : extern "C" bool M2Quads_IsCatchBegin (unsigned int QuadNo);
322 :
323 : /*
324 : IsCatchEnd - returns true if QuadNo is a catch end quad.
325 : */
326 :
327 : extern "C" bool M2Quads_IsCatchEnd (unsigned int QuadNo);
328 :
329 : /*
330 : IsInitStart - returns true if QuadNo is a init start quad.
331 : */
332 :
333 : extern "C" bool M2Quads_IsInitStart (unsigned int QuadNo);
334 :
335 : /*
336 : IsInitEnd - returns true if QuadNo is a init end quad.
337 : */
338 :
339 : extern "C" bool M2Quads_IsInitEnd (unsigned int QuadNo);
340 :
341 : /*
342 : IsFinallyStart - returns true if QuadNo is a finally start quad.
343 : */
344 :
345 : extern "C" bool M2Quads_IsFinallyStart (unsigned int QuadNo);
346 :
347 : /*
348 : IsFinallyEnd - returns true if QuadNo is a finally end quad.
349 : */
350 :
351 : extern "C" bool M2Quads_IsFinallyEnd (unsigned int QuadNo);
352 :
353 : /*
354 : IsBecomes - return TRUE if QuadNo is a BecomesOp.
355 : */
356 :
357 : extern "C" bool M2Quads_IsBecomes (unsigned int QuadNo);
358 :
359 : /*
360 : IsDummy - return TRUE if QuadNo is a DummyOp.
361 : */
362 :
363 : extern "C" bool M2Quads_IsDummy (unsigned int QuadNo);
364 :
365 : /*
366 : IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
367 : */
368 :
369 : extern "C" bool M2Quads_IsQuadConstExpr (unsigned int QuadNo);
370 :
371 : /*
372 : SetQuadConstExpr - sets the constexpr field to value.
373 : */
374 :
375 : extern "C" void M2Quads_SetQuadConstExpr (unsigned int QuadNo, bool value);
376 :
377 : /*
378 : GetQuadDest - returns the jump destination associated with quad.
379 : */
380 :
381 : extern "C" unsigned int M2Quads_GetQuadDest (unsigned int QuadNo);
382 :
383 : /*
384 : GetQuadOp1 - returns the 1st operand associated with quad.
385 : */
386 :
387 : extern "C" unsigned int M2Quads_GetQuadOp1 (unsigned int QuadNo);
388 :
389 : /*
390 : GetQuadOp2 - returns the 2nd operand associated with quad.
391 : */
392 :
393 : extern "C" unsigned int M2Quads_GetQuadOp2 (unsigned int QuadNo);
394 :
395 : /*
396 : GetQuadOp3 - returns the 3rd operand associated with quad.
397 : */
398 :
399 : extern "C" unsigned int M2Quads_GetQuadOp3 (unsigned int QuadNo);
400 :
401 : /*
402 : IsInitialisingConst - returns TRUE if the quadruple is setting
403 : a const (op1) with a value.
404 : */
405 :
406 : extern "C" bool M2Quads_IsInitialisingConst (unsigned int QuadNo);
407 :
408 : /*
409 : IsConstQuad - return TRUE if the quadruple is marked as a constexpr.
410 : */
411 :
412 : extern "C" bool M2Quads_IsConstQuad (unsigned int quad);
413 :
414 : /*
415 : IsConditionalBooleanQuad - return TRUE if operand 1 is a boolean result.
416 : */
417 :
418 : extern "C" bool M2Quads_IsConditionalBooleanQuad (unsigned int quad);
419 :
420 : /*
421 : IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
422 : */
423 :
424 : extern "C" bool M2Quads_IsOptimizeOn (unsigned int QuadNo);
425 :
426 : /*
427 : IsProfileOn - returns true if the Profile flag was true at QuadNo.
428 : */
429 :
430 : extern "C" bool M2Quads_IsProfileOn (unsigned int QuadNo);
431 :
432 : /*
433 : IsCodeOn - returns true if the Code flag was true at QuadNo.
434 : */
435 :
436 : extern "C" bool M2Quads_IsCodeOn (unsigned int QuadNo);
437 :
438 : /*
439 : IsPseudoQuad - returns true if QuadNo is a compiler directive.
440 : ie code, profile and optimize.
441 : StartFile, EndFile,
442 : */
443 :
444 : extern "C" bool M2Quads_IsPseudoQuad (unsigned int QuadNo);
445 :
446 : /*
447 : IsDefOrModFile - returns TRUE if QuadNo is a start of Module or Def file
448 : directive.
449 : */
450 :
451 : extern "C" bool M2Quads_IsDefOrModFile (unsigned int QuadNo);
452 :
453 : /*
454 : DumpQuadruples - dump all quadruples providing the -fq, -fdump-lang-quad,
455 : -fdump-lang-quad= or -fdump-lang-all were issued to the
456 : command line.
457 : */
458 :
459 : extern "C" void M2Quads_DumpQuadruples (const char *title_, unsigned int _title_high);
460 :
461 : /*
462 : DisplayQuadRange - displays all quads in list range, start..end.
463 : */
464 :
465 : extern "C" void M2Quads_DisplayQuadRange (unsigned int scope, unsigned int start, unsigned int end);
466 :
467 : /*
468 : DisplayQuad - displays a quadruple, QuadNo.
469 : */
470 :
471 : extern "C" void M2Quads_DisplayQuad (unsigned int QuadNo);
472 :
473 : /*
474 : GetLastFileQuad - returns the Quadruple number of the last StartDefFile or
475 : StartModFile quadruple.
476 : */
477 :
478 : extern "C" unsigned int M2Quads_GetLastFileQuad (unsigned int QuadNo);
479 :
480 : /*
481 : GetLastQuadNo - returns the last quadruple number referenced
482 : by a GetQuad.
483 : */
484 :
485 : extern "C" unsigned int M2Quads_GetLastQuadNo (void);
486 :
487 : /*
488 : QuadToTokenNo - Converts a QuadNo into the approprate token number of the
489 : source file, the line number is returned.
490 :
491 : This may be used to yield an idea where abouts in the
492 : source file the code generetion is
493 : processing.
494 : */
495 :
496 : extern "C" unsigned int M2Quads_QuadToTokenNo (unsigned int QuadNo);
497 :
498 : /*
499 : QuadToLineNo - Converts a QuadNo into the approprate line number of the
500 : source file, the line number is returned.
501 :
502 : This may be used to yield an idea where abouts in the
503 : source file the code generetion is
504 : processing.
505 : */
506 :
507 : extern "C" unsigned int M2Quads_QuadToLineNo (unsigned int QuadNo);
508 :
509 : /*
510 : GetQuad - returns the Quadruple QuadNo.
511 : */
512 :
513 : extern "C" void M2Quads_GetQuad (unsigned int QuadNo, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3);
514 :
515 : /*
516 : GetQuadOp - returns the operator for quad.
517 : */
518 :
519 : extern "C" M2Quads_QuadOperator M2Quads_GetQuadOp (unsigned int quad);
520 :
521 : /*
522 : GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
523 : (if possible). It returns NIL if no there is not an obvious match
524 : in Modula-2. It is assummed that the string will be used during
525 : construction of error messages and therefore keywords are
526 : wrapped with a format specifier.
527 : */
528 :
529 : extern "C" DynamicStrings_String M2Quads_GetM2OperatorDesc (M2Quads_QuadOperator op);
530 :
531 : /*
532 : GetQuadtok - returns the Quadruple QuadNo.
533 : */
534 :
535 : extern "C" void M2Quads_GetQuadtok (unsigned int QuadNo, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos);
536 :
537 : /*
538 : GetQuadOtok - returns the Quadruple QuadNo.
539 : */
540 :
541 : extern "C" void M2Quads_GetQuadOtok (unsigned int QuadNo, unsigned int *tok, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, bool *overflowChecking, bool *constExpr, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos);
542 :
543 : /*
544 : GetQuadOTypetok - returns the fields associated with quadruple QuadNo.
545 : */
546 :
547 : extern "C" void M2Quads_GetQuadOTypetok (unsigned int QuadNo, unsigned int *tok, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, bool *overflowChecking, bool *typeChecking, bool *constExpr, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos);
548 :
549 : /*
550 : PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
551 : sets a boolean to determinine whether overflow should be checked.
552 : */
553 :
554 : extern "C" void M2Quads_PutQuadOtok (unsigned int QuadNo, unsigned int tok, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflowChecking, bool constExpr, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos);
555 :
556 : /*
557 : PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
558 : */
559 :
560 : extern "C" void M2Quads_PutQuad (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3);
561 :
562 : /*
563 : GetFirstQuad - returns the first quadruple.
564 : */
565 :
566 : extern "C" unsigned int M2Quads_GetFirstQuad (void);
567 :
568 : /*
569 : GetNextQuad - returns the Quadruple number following QuadNo.
570 : */
571 :
572 : extern "C" unsigned int M2Quads_GetNextQuad (unsigned int QuadNo);
573 :
574 : /*
575 : GetRealQuad - returns the Quadruple number of the real quadruple
576 : at QuadNo or beyond.
577 : */
578 :
579 : extern "C" unsigned int M2Quads_GetRealQuad (unsigned int QuadNo);
580 :
581 : /*
582 : SubQuad - subtracts a quadruple QuadNo from a list Head.
583 : */
584 :
585 : extern "C" void M2Quads_SubQuad (unsigned int QuadNo);
586 :
587 : /*
588 : EraseQuad - erases a quadruple QuadNo, the quadruple is still in the list
589 : but wiped clean.
590 : */
591 :
592 : extern "C" void M2Quads_EraseQuad (unsigned int QuadNo);
593 :
594 : /*
595 : CountQuads - returns the number of quadruples.
596 : */
597 :
598 : extern "C" unsigned int M2Quads_CountQuads (void);
599 :
600 : /*
601 : BuildScaffold - generate the main, init, finish functions if
602 : no -c and this is the application module.
603 : */
604 :
605 : extern "C" void M2Quads_BuildScaffold (unsigned int tok, unsigned int moduleSym);
606 :
607 : /*
608 : StartBuildDefFile - generates a StartFileDefOp quadruple indicating the file
609 : that has produced the subsequent quadruples.
610 : The code generator uses the StartDefFileOp quadruples
611 : to relate any error to the appropriate file.
612 :
613 :
614 : Entry Exit
615 : ===== ====
616 :
617 :
618 : Ptr -> <- Ptr
619 : +------------+ +------------+
620 : | ModuleName | | ModuleName |
621 : |------------| |------------|
622 :
623 :
624 : Quadruples Produced
625 :
626 : q StartDefFileOp _ _ ModuleSym
627 : */
628 :
629 : extern "C" void M2Quads_StartBuildDefFile (unsigned int tok);
630 :
631 : /*
632 : StartBuildModFile - generates a StartModFileOp quadruple indicating the file
633 : that has produced the subsequent quadruples.
634 : The code generator uses the StartModFileOp quadruples
635 : to relate any error to the appropriate file.
636 :
637 :
638 : Entry Exit
639 : ===== ====
640 :
641 :
642 : Ptr -> <- Ptr
643 : +------------+ +------------+
644 : | ModuleName | | ModuleName |
645 : |------------| |------------|
646 :
647 :
648 : Quadruples Produced
649 :
650 : q StartModFileOp lineno filename ModuleSym
651 : */
652 :
653 : extern "C" void M2Quads_StartBuildModFile (unsigned int tok);
654 :
655 : /*
656 : EndBuildFile - generates an EndFileOp quadruple indicating the file
657 : that has produced the previous quadruples has ended.
658 :
659 : Entry Exit
660 : ===== ====
661 :
662 :
663 : Ptr -> <- Ptr
664 : +------------+ +------------+
665 : | ModuleName | | ModuleName |
666 : |------------| |------------|
667 :
668 :
669 : Quadruples Produced
670 :
671 : q EndFileOp _ _ ModuleSym
672 : */
673 :
674 : extern "C" void M2Quads_EndBuildFile (unsigned int tok);
675 :
676 : /*
677 : StartBuildInit - Sets the start of initialization code of the
678 : current module to the next quadruple.
679 : */
680 :
681 : extern "C" void M2Quads_StartBuildInit (unsigned int tok);
682 :
683 : /*
684 : EndBuildInit - Sets the end initialization code of a module.
685 : */
686 :
687 : extern "C" void M2Quads_EndBuildInit (unsigned int tok);
688 :
689 : /*
690 : StartBuildFinally - Sets the start of finalization code of the
691 : current module to the next quadruple.
692 : */
693 :
694 : extern "C" void M2Quads_StartBuildFinally (unsigned int tok);
695 :
696 : /*
697 : EndBuildFinally - Sets the end finalization code of a module.
698 : */
699 :
700 : extern "C" void M2Quads_EndBuildFinally (unsigned int tok);
701 :
702 : /*
703 : BuildExceptInitial - adds an CatchBeginOp, CatchEndOp quadruple
704 : in the current block.
705 : */
706 :
707 : extern "C" void M2Quads_BuildExceptInitial (unsigned int tok);
708 :
709 : /*
710 : BuildExceptFinally - adds an ExceptOp quadruple in a modules
711 : finally block.
712 : */
713 :
714 : extern "C" void M2Quads_BuildExceptFinally (unsigned int tok);
715 :
716 : /*
717 : BuildExceptProcedure - adds an ExceptOp quadruple in a procedure
718 : block.
719 : */
720 :
721 : extern "C" void M2Quads_BuildExceptProcedure (unsigned int tok);
722 :
723 : /*
724 : BuildRetry - adds an RetryOp quadruple.
725 : */
726 :
727 : extern "C" void M2Quads_BuildRetry (unsigned int tok);
728 :
729 : /*
730 : BuildReThrow - creates a ThrowOp _ _ NulSym, indicating that
731 : the exception needs to be rethrown. The stack
732 : is unaltered.
733 : */
734 :
735 : extern "C" void M2Quads_BuildReThrow (unsigned int tokenno);
736 :
737 : /*
738 : StartBuildInnerInit - Sets the start of initialization code of the
739 : inner module to the next quadruple.
740 : */
741 :
742 : extern "C" void M2Quads_StartBuildInnerInit (unsigned int tok);
743 :
744 : /*
745 : EndBuildInnerInit - Sets the end initialization code of a module.
746 : */
747 :
748 : extern "C" void M2Quads_EndBuildInnerInit (unsigned int tok);
749 :
750 : /*
751 : BuildBuiltinConst - makes reference to a builtin constant within gm2.
752 :
753 : Entry Exit
754 :
755 : Ptr ->
756 : +------------+ +------------+
757 : | Ident | | Sym |
758 : |------------| |------------|
759 :
760 : Quadruple produced:
761 :
762 : q Sym BuiltinConstOp Ident
763 : */
764 :
765 : extern "C" void M2Quads_BuildBuiltinConst (void);
766 :
767 : /*
768 : BuildBuiltinTypeInfo - make reference to a builtin typeinfo function
769 : within gm2.
770 :
771 : Entry Exit
772 :
773 : Ptr ->
774 : +-------------+
775 : | Type |
776 : |-------------| +------------+
777 : | Ident | | Sym |
778 : |-------------| |------------|
779 :
780 : Quadruple produced:
781 :
782 : q Sym BuiltinTypeInfoOp Type Ident
783 : */
784 :
785 : extern "C" void M2Quads_BuildBuiltinTypeInfo (void);
786 :
787 : /*
788 : BuildAssignment - Builds an assignment from the values given on the
789 : quad stack. Either an assignment to an
790 : arithmetic expression or an assignment to a
791 : boolean expression. This procedure should not
792 : be called in CONST declarations.
793 : The Stack is expected to contain:
794 :
795 :
796 : Either
797 :
798 : Entry Exit
799 : ===== ====
800 :
801 : Ptr ->
802 : +------------+
803 : | Expression |
804 : |------------|
805 : | Designator |
806 : |------------| +------------+
807 : | | | | <- Ptr
808 : |------------| |------------|
809 :
810 :
811 : Quadruples Produced
812 :
813 : q BecomesOp Designator _ Expression
814 :
815 : OR
816 :
817 : Entry Exit
818 : ===== ====
819 :
820 : Ptr ->
821 : +------------+
822 : | True |False|
823 : |------------|
824 : | Designator |
825 : |------------| +------------+
826 : | | | | <- Ptr
827 : |------------| |------------|
828 :
829 :
830 : Quadruples Produced
831 :
832 : q BecomesOp Designator _ TRUE
833 : q+1 GotoOp q+3
834 : q+2 BecomesOp Designator _ FALSE
835 :
836 : */
837 :
838 : extern "C" void M2Quads_BuildAssignment (unsigned int becomesTokNo);
839 :
840 : /*
841 : BuildAssignConstant - used to create constant in the CONST declaration.
842 : The stack is expected to contain:
843 :
844 : Either
845 :
846 : Entry Exit
847 : ===== ====
848 :
849 : Ptr ->
850 : +------------+
851 : | Expression |
852 : |------------|
853 : | Designator |
854 : |------------| +------------+
855 : | | | | <- Ptr
856 : |------------| |------------|
857 :
858 :
859 : Quadruples Produced
860 :
861 : q BecomesOp Designator _ Expression
862 :
863 : OR
864 :
865 : Entry Exit
866 : ===== ====
867 :
868 : Ptr ->
869 : +------------+
870 : | True |False|
871 : |------------|
872 : | Designator |
873 : |------------| +------------+
874 : | | | | <- Ptr
875 : |------------| |------------|
876 :
877 :
878 : Quadruples Produced
879 :
880 : q BecomesOp Designator _ TRUE
881 : q+1 GotoOp q+3
882 : q+2 BecomesOp Designator _ FALSE
883 : */
884 :
885 : extern "C" void M2Quads_BuildAssignConstant (unsigned int equalsTokNo);
886 :
887 : /*
888 : BuildAlignment - builds an assignment to an alignment constant.
889 :
890 : The Stack is expected to contain:
891 :
892 :
893 : Entry Exit
894 : ===== ====
895 :
896 : Ptr ->
897 : +---------------+
898 : | Expression |
899 : |---------------|
900 : | bytealignment |
901 : |---------------| empty
902 : */
903 :
904 : extern "C" void M2Quads_BuildAlignment (unsigned int tokno);
905 :
906 : /*
907 : BuildBitLength - builds an assignment to a bit length constant.
908 :
909 : The Stack is expected to contain:
910 :
911 :
912 : Entry Exit
913 : ===== ====
914 :
915 : Ptr ->
916 : +------------+
917 : | Expression |
918 : |------------| empty
919 : */
920 :
921 : extern "C" void M2Quads_BuildBitLength (unsigned int tokno);
922 :
923 : /*
924 : BuildPragmaField - builds an assignment to an alignment constant.
925 :
926 : The Stack is expected to contain:
927 :
928 :
929 : Entry Exit
930 : ===== ====
931 :
932 : Ptr ->
933 : +------------+
934 : | Expression |
935 : |------------| empty
936 : */
937 :
938 : extern "C" void M2Quads_BuildPragmaField (void);
939 :
940 : /*
941 : BuildDefaultFieldAlignment - builds an assignment to an alignment constant.
942 :
943 : The Stack is expected to contain:
944 :
945 :
946 : Entry Exit
947 : ===== ====
948 :
949 : Ptr ->
950 : +------------+
951 : | Expression |
952 : |------------| empty
953 : */
954 :
955 : extern "C" void M2Quads_BuildDefaultFieldAlignment (void);
956 :
957 : /*
958 : BuildRepeat - Builds the repeat statement from the quad stack.
959 : The Stack is expected to contain:
960 :
961 :
962 : Entry Exit
963 : ===== ====
964 :
965 :
966 : Empty
967 : <- Ptr
968 : +------------+
969 : | RepeatQuad |
970 : |------------|
971 :
972 : */
973 :
974 : extern "C" void M2Quads_BuildRepeat (void);
975 :
976 : /*
977 : BuildUntil - Builds the until part of the repeat statement
978 : from the quad stack.
979 : The Stack is expected to contain:
980 :
981 :
982 : Entry Exit
983 : ===== ====
984 :
985 : Ptr ->
986 : +------------+
987 : | t | f |
988 : |------------|
989 : | RepeatQuad | Empty
990 : |------------|
991 : */
992 :
993 : extern "C" void M2Quads_BuildUntil (void);
994 :
995 : /*
996 : BuildWhile - Builds the While part of the While statement
997 : from the quad stack.
998 : The Stack is expected to contain:
999 :
1000 :
1001 : Entry Exit
1002 : ===== ====
1003 :
1004 : <- Ptr
1005 : |------------|
1006 : Empty | WhileQuad |
1007 : |------------|
1008 : */
1009 :
1010 : extern "C" void M2Quads_BuildWhile (void);
1011 :
1012 : /*
1013 : BuildDoWhile - Builds the Do part of the while statement
1014 : from the quad stack.
1015 : The Stack is expected to contain:
1016 :
1017 :
1018 : Entry Exit
1019 : ===== ====
1020 :
1021 : Ptr ->
1022 : +------------+ +------------+
1023 : | t | f | | 0 | f |
1024 : |------------| |------------|
1025 : | WhileQuad | | WhileQuad |
1026 : |------------| |------------|
1027 :
1028 : Quadruples
1029 :
1030 : BackPatch t exit to the NextQuad
1031 : */
1032 :
1033 : extern "C" void M2Quads_BuildDoWhile (void);
1034 :
1035 : /*
1036 : BuildEndWhile - Builds the end part of the while statement
1037 : from the quad stack.
1038 : The Stack is expected to contain:
1039 :
1040 :
1041 : Entry Exit
1042 : ===== ====
1043 :
1044 : Ptr ->
1045 : +------------+
1046 : | t | f |
1047 : |------------|
1048 : | WhileQuad | Empty
1049 : |------------|
1050 :
1051 : Quadruples
1052 :
1053 : q GotoOp WhileQuad
1054 : False exit is backpatched with q+1
1055 : */
1056 :
1057 : extern "C" void M2Quads_BuildEndWhile (int reltokpos);
1058 :
1059 : /*
1060 : BuildLoop - Builds the Loop part of the Loop statement
1061 : from the quad stack.
1062 : The Stack is expected to contain:
1063 :
1064 :
1065 : Entry Exit
1066 : ===== ====
1067 :
1068 : <- Ptr
1069 : Empty +------------+
1070 : | LoopQuad |
1071 : |------------|
1072 : */
1073 :
1074 : extern "C" void M2Quads_BuildLoop (void);
1075 :
1076 : /*
1077 : BuildExit - Builds the Exit part of the Loop statement.
1078 : */
1079 :
1080 : extern "C" void M2Quads_BuildExit (void);
1081 :
1082 : /*
1083 : BuildEndLoop - Builds the End part of the Loop statement
1084 : from the quad stack.
1085 : The Stack is expected to contain:
1086 :
1087 :
1088 : Entry Exit
1089 : ===== ====
1090 :
1091 : Ptr ->
1092 : +------------+
1093 : | LoopQuad | Empty
1094 : |------------|
1095 :
1096 : Quadruples
1097 :
1098 : Goto _ _ LoopQuad
1099 : */
1100 :
1101 : extern "C" void M2Quads_BuildEndLoop (void);
1102 :
1103 : /*
1104 : BuildThenIf - Builds the Then part of the If statement
1105 : from the quad stack.
1106 : The Stack is expected to contain:
1107 :
1108 :
1109 : Entry Exit
1110 : ===== ====
1111 :
1112 : Ptr -> <- Ptr
1113 : +------------+ +------------+
1114 : | t | f | | 0 | f |
1115 : |------------| |------------|
1116 :
1117 : Quadruples
1118 :
1119 : The true exit is BackPatched to point to
1120 : the NextQuad.
1121 : */
1122 :
1123 : extern "C" void M2Quads_BuildThenIf (void);
1124 :
1125 : /*
1126 : BuildElse - Builds the Else part of the If statement
1127 : from the quad stack.
1128 : The Stack is expected to contain:
1129 :
1130 :
1131 : Entry Exit
1132 : ===== ====
1133 :
1134 : Ptr ->
1135 : +------------+ +------------+
1136 : | t | f | | t+q | 0 |
1137 : |------------| |------------|
1138 :
1139 : Quadruples
1140 :
1141 : q GotoOp _ _ 0
1142 : q+1 <- BackPatched from f
1143 : */
1144 :
1145 : extern "C" void M2Quads_BuildElse (void);
1146 :
1147 : /*
1148 : BuildEndIf - Builds the End part of the If statement
1149 : from the quad stack.
1150 : The Stack is expected to contain:
1151 :
1152 :
1153 : Entry Exit
1154 : ===== ====
1155 :
1156 : Ptr ->
1157 : +------------+
1158 : | t | f | Empty
1159 : |------------|
1160 :
1161 : Quadruples
1162 :
1163 : Both t and f are backpatched to point to the NextQuad
1164 : */
1165 :
1166 : extern "C" void M2Quads_BuildEndIf (void);
1167 :
1168 : /*
1169 : BuildElsif1 - Builds the Elsif part of the If statement
1170 : from the quad stack.
1171 : The Stack is expected to contain:
1172 :
1173 :
1174 : Entry Exit
1175 : ===== ====
1176 :
1177 : Ptr ->
1178 : +------------+ +------------+
1179 : | t | f | | t+q | 0 |
1180 : |------------| |------------|
1181 :
1182 : Quadruples
1183 :
1184 : q GotoOp _ _ 0
1185 : q+1 <- BackPatched from f
1186 : */
1187 :
1188 : extern "C" void M2Quads_BuildElsif1 (void);
1189 :
1190 : /*
1191 : BuildElsif2 - Builds the Elsif until part of the If statement
1192 : from the quad stack.
1193 : The Stack is expected to contain:
1194 :
1195 :
1196 : Entry Exit
1197 : ===== ====
1198 :
1199 : Ptr ->
1200 : +--------------+
1201 : | 0 | f1 | <- Ptr
1202 : |--------------| +---------------+
1203 : | t2 | f2 | | t2 | f1+f2 |
1204 : |--------------| |---------------|
1205 : */
1206 :
1207 : extern "C" void M2Quads_BuildElsif2 (void);
1208 :
1209 : /*
1210 : BuildForToByDo - Builds the For To By Do part of the For statement
1211 : from the quad stack.
1212 : The Stack is expected to contain:
1213 :
1214 :
1215 : Entry Exit
1216 : ===== ====
1217 :
1218 : <- Ptr
1219 : +----------------+
1220 : Ptr -> | RangeId |
1221 : +----------------+ |----------------|
1222 : | BySym | ByType | | ForQuad |
1223 : |----------------| |----------------|
1224 : | e2 | | LastValue |
1225 : |----------------| |----------------|
1226 : | e1 | | BySym | ByType |
1227 : |----------------| |----------------|
1228 : | Ident | | IdentSym |
1229 : |----------------| |----------------|
1230 :
1231 :
1232 : x := e1 ;
1233 : Note that LASTVALUE is calculated during M2GenGCC
1234 : after all the types have been resolved.
1235 : LASTVALUE := ((e2-e1) DIV BySym) * BySym + e1
1236 : IF BySym<0
1237 : THEN
1238 : IF e1<e2
1239 : THEN
1240 : goto exit
1241 : END
1242 : ELSE
1243 : IF e1>e2
1244 : THEN
1245 : goto exit
1246 : END
1247 : END ;
1248 : LOOP
1249 : body
1250 : IF x=LASTVALUE
1251 : THEN
1252 : goto exit
1253 : END ;
1254 : INC(x, BySym)
1255 : END
1256 :
1257 : Quadruples:
1258 :
1259 : q BecomesOp IdentSym _ e1
1260 : q+ LastForIteratorOp LastValue := ((e1-e2) DIV by) * by + e1
1261 : q+1 if >= by 0 q+..2
1262 : q+2 GotoOp q+3
1263 : q+3 If >= e1 e2 q+5
1264 : q+4 GotoOp exit
1265 : q+5 ..
1266 : q+..1 Goto q+..5
1267 : q+..2 If >= e2 e1 q+..4
1268 : q+..3 GotoOp exit
1269 : q+..4 ..
1270 :
1271 : The For Loop is regarded:
1272 :
1273 : For ident := e1 To e2 By by Do
1274 :
1275 : End
1276 : */
1277 :
1278 : extern "C" void M2Quads_BuildForToByDo (void);
1279 :
1280 : /*
1281 : BuildPseudoBy - Builds the Non existant part of the By
1282 : clause of the For statement
1283 : from the quad stack.
1284 : The Stack is expected to contain:
1285 :
1286 :
1287 : Entry Exit
1288 : ===== ====
1289 :
1290 : <- Ptr
1291 : +------------+
1292 : Ptr -> | BySym | t |
1293 : +------------+ |------------|
1294 : | e | t | | e | t |
1295 : |------------| |------------|
1296 : */
1297 :
1298 : extern "C" void M2Quads_BuildPseudoBy (void);
1299 :
1300 : /*
1301 : BuildEndFor - Builds the End part of the For statement
1302 : from the quad stack.
1303 : The Stack is expected to contain:
1304 :
1305 :
1306 : Entry Exit
1307 : ===== ====
1308 :
1309 : Ptr ->
1310 : +----------------+
1311 : | RangeId |
1312 : |----------------|
1313 : | ForQuad |
1314 : |----------------|
1315 : | LastValue |
1316 : |----------------|
1317 : | BySym | ByType |
1318 : |----------------|
1319 : | IdSym | Empty
1320 : |----------------|
1321 : */
1322 :
1323 : extern "C" void M2Quads_BuildEndFor (unsigned int endpostok);
1324 :
1325 : /*
1326 : BuildCaseStart - starts the case statement.
1327 : It initializes a backpatch list on the compile
1328 : time stack, the list is used to contain all
1329 : case break points. The list is later backpatched
1330 : and contains all positions of the case statement
1331 : which jump to the end of the case statement.
1332 : The stack also contains room for a boolean
1333 : expression, this is needed to allow , operator
1334 : in the CaseField alternatives.
1335 :
1336 : The Stack is expected to contain:
1337 :
1338 :
1339 : Entry Exit
1340 : ===== ====
1341 :
1342 : <- Ptr
1343 : +------------+
1344 : | 0 | 0 |
1345 : |------------|
1346 : | 0 | 0 |
1347 : +-------------+ |------------|
1348 : | Expr | | | Expr | |
1349 : |-------------| |------------|
1350 : */
1351 :
1352 : extern "C" void M2Quads_BuildCaseStart (void);
1353 :
1354 : /*
1355 : BuildCaseStartStatementSequence - starts the statement sequence
1356 : inside a case clause.
1357 : BackPatches the true exit to the
1358 : NextQuad.
1359 : The Stack:
1360 :
1361 : Entry Exit
1362 :
1363 : Ptr -> <- Ptr
1364 : +-----------+ +------------+
1365 : | t | f | | 0 | f |
1366 : |-----------| |------------|
1367 : */
1368 :
1369 : extern "C" void M2Quads_BuildCaseStartStatementSequence (void);
1370 :
1371 : /*
1372 : BuildCaseEndStatementSequence - ends the statement sequence
1373 : inside a case clause.
1374 : BackPatches the false exit f1 to the
1375 : NextQuad.
1376 : Asserts that t1 and f2 is 0
1377 : Pushes t2+q and 0
1378 :
1379 : Quadruples:
1380 :
1381 : q GotoOp _ _ 0
1382 :
1383 : The Stack:
1384 :
1385 : Entry Exit
1386 :
1387 : Ptr -> <- Ptr
1388 : +-----------+ +------------+
1389 : | t1 | f1 | | 0 | 0 |
1390 : |-----------| |------------|
1391 : | t2 | f2 | | t2+q | 0 |
1392 : |-----------| |------------|
1393 : */
1394 :
1395 : extern "C" void M2Quads_BuildCaseEndStatementSequence (void);
1396 :
1397 : /*
1398 : BuildCaseRange - builds the range testing quaruples for
1399 : a case clause.
1400 :
1401 : IF (e1>=ce1) AND (e1<=ce2)
1402 : THEN
1403 :
1404 : ELS..
1405 :
1406 : The Stack:
1407 :
1408 : Entry Exit
1409 :
1410 : Ptr ->
1411 : +-----------+
1412 : | ce2 | <- Ptr
1413 : |-----------| +-----------+
1414 : | ce1 | | t | f |
1415 : |-----------| |-----------|
1416 : | t1 | f1 | | t1 | f1 |
1417 : |-----------| |-----------|
1418 : | t2 | f2 | | t2 | f2 |
1419 : |-----------| |-----------|
1420 : | e1 | | e1 |
1421 : |-----------| |-----------|
1422 : */
1423 :
1424 : extern "C" void M2Quads_BuildCaseRange (void);
1425 :
1426 : /*
1427 : BuildCaseEquality - builds the range testing quadruples for
1428 : a case clause.
1429 :
1430 : IF e1=ce1
1431 : THEN
1432 :
1433 : ELS..
1434 :
1435 : The Stack:
1436 :
1437 : Entry Exit
1438 :
1439 : Ptr ->
1440 : +-----------+ +-----------+
1441 : | ce1 | | t | f |
1442 : |-----------| |-----------|
1443 : | t1 | f1 | | t1 | f1 |
1444 : |-----------| |-----------|
1445 : | t2 | f2 | | t2 | f2 |
1446 : |-----------| |-----------|
1447 : | e1 | | e1 |
1448 : |-----------| |-----------|
1449 : */
1450 :
1451 : extern "C" void M2Quads_BuildCaseEquality (void);
1452 :
1453 : /*
1454 : BuildCaseList - merges two case tests into one
1455 :
1456 : The Stack:
1457 :
1458 : Entry Exit
1459 :
1460 : Ptr ->
1461 : +-----------+
1462 : | t2 | f2 |
1463 : |-----------| +-------------+
1464 : | t1 | f1 | | t1+t2| f1+f2|
1465 : |-----------| |-------------|
1466 : */
1467 :
1468 : extern "C" void M2Quads_BuildCaseList (void);
1469 :
1470 : /*
1471 : BuildCaseOr - builds the , in the case clause.
1472 :
1473 : The Stack:
1474 :
1475 : Entry Exit
1476 :
1477 : Ptr -> <- Ptr
1478 : +-----------+ +------------+
1479 : | t | f | | t | 0 |
1480 : |-----------| |------------|
1481 : */
1482 :
1483 : extern "C" void M2Quads_BuildCaseOr (void);
1484 :
1485 : /*
1486 : BuildCaseElse - builds the else of case clause.
1487 :
1488 : The Stack:
1489 :
1490 : Entry Exit
1491 :
1492 : Ptr -> <- Ptr
1493 : +-----------+ +------------+
1494 : | t | f | | t | 0 |
1495 : |-----------| |------------|
1496 : */
1497 :
1498 : extern "C" void M2Quads_BuildCaseElse (void);
1499 :
1500 : /*
1501 : BuildCaseEnd - builds the end of case clause.
1502 :
1503 : The Stack:
1504 :
1505 : Entry Exit
1506 :
1507 : Ptr ->
1508 : +-----------+
1509 : | t1 | f1 |
1510 : |-----------|
1511 : | t2 | f2 |
1512 : |-----------|
1513 : | e1 |
1514 : |-----------| Empty
1515 : */
1516 :
1517 : extern "C" void M2Quads_BuildCaseEnd (void);
1518 :
1519 : /*
1520 : BuildCaseCheck - builds the case checking code to ensure that
1521 : the program does not need an else clause at runtime.
1522 : The stack is unaltered.
1523 : */
1524 :
1525 : extern "C" void M2Quads_BuildCaseCheck (void);
1526 :
1527 : /*
1528 : BuildNulParam - Builds a nul parameter on the stack.
1529 : The Stack:
1530 :
1531 : Entry Exit
1532 :
1533 : <- Ptr
1534 : Empty +------------+
1535 : | 0 |
1536 : |------------|
1537 : */
1538 :
1539 : extern "C" void M2Quads_BuildNulParam (void);
1540 :
1541 : /*
1542 : BuildProcedureCall - builds a procedure call.
1543 : Although this procedure does not directly
1544 : destroy the procedure parameters, it calls
1545 : routine which will manipulate the stack and
1546 : so the entry and exit states of the stack are shown.
1547 :
1548 : The Stack:
1549 :
1550 :
1551 : Entry Exit
1552 :
1553 : Ptr ->
1554 : +----------------+
1555 : | NoOfParam |
1556 : |----------------|
1557 : | Param 1 |
1558 : |----------------|
1559 : | Param 2 |
1560 : |----------------|
1561 : . .
1562 : . .
1563 : . .
1564 : |----------------|
1565 : | Param # |
1566 : |----------------|
1567 : | ProcSym | Type | Empty
1568 : |----------------|
1569 : */
1570 :
1571 : extern "C" void M2Quads_BuildProcedureCall (unsigned int tokno);
1572 :
1573 : /*
1574 : CheckBuildFunction - checks to see whether ProcSym is a function
1575 : and if so it adds a TempSym value which will
1576 : hold the return value once the function finishes.
1577 : This procedure also generates an error message
1578 : if the user is calling a function and ignoring
1579 : the return result. The additional TempSym
1580 : is not created if ProcSym is a procedure
1581 : and the stack is unaltered.
1582 :
1583 : The Stack:
1584 :
1585 :
1586 : Entry Exit
1587 :
1588 : Ptr ->
1589 :
1590 : +----------------+
1591 : | ProcSym | Type |
1592 : +----------------+ |----------------|
1593 : | ProcSym | Type | | TempSym | Type |
1594 : |----------------| |----------------|
1595 : */
1596 :
1597 : extern "C" bool M2Quads_CheckBuildFunction (void);
1598 :
1599 : /*
1600 : BuildFunctionCall - builds a function call.
1601 : The Stack:
1602 :
1603 :
1604 : Entry Exit
1605 :
1606 : Ptr ->
1607 : +----------------+
1608 : | NoOfParam |
1609 : |----------------|
1610 : | Param 1 |
1611 : |----------------|
1612 : | Param 2 |
1613 : |----------------|
1614 : . .
1615 : . .
1616 : . .
1617 : |----------------|
1618 : | Param # | <- Ptr
1619 : |----------------| +------------+
1620 : | ProcSym | Type | | ReturnVar |
1621 : |----------------| |------------|
1622 : */
1623 :
1624 : extern "C" void M2Quads_BuildFunctionCall (bool ConstExpr);
1625 :
1626 : /*
1627 : BuildConstFunctionCall - builds a function call and checks that this function can be
1628 : called inside a ConstExpression.
1629 :
1630 : The Stack:
1631 :
1632 :
1633 : Entry Exit
1634 :
1635 : Ptr ->
1636 : +----------------+
1637 : | NoOfParam |
1638 : |----------------|
1639 : | Param 1 |
1640 : |----------------|
1641 : | Param 2 |
1642 : |----------------|
1643 : . .
1644 : . .
1645 : . .
1646 : |----------------|
1647 : | Param # | <- Ptr
1648 : |----------------| +------------+
1649 : | ProcSym | Type | | ReturnVar |
1650 : |----------------| |------------|
1651 :
1652 : */
1653 :
1654 : extern "C" void M2Quads_BuildConstFunctionCall (void);
1655 :
1656 : /*
1657 : BuildBooleanVariable - tests to see whether top of stack is a boolean
1658 : conditional and if so it converts it into a boolean
1659 : variable.
1660 : */
1661 :
1662 : extern "C" void M2Quads_BuildBooleanVariable (void);
1663 :
1664 : /*
1665 : BuildModuleStart - starts current module scope.
1666 : */
1667 :
1668 : extern "C" void M2Quads_BuildModuleStart (unsigned int tok);
1669 :
1670 : /*
1671 : BuildProcedureStart - Builds start of the procedure. Generates a
1672 : quadruple which indicated the start of
1673 : this procedure declarations scope.
1674 : The Stack is expected to contain:
1675 :
1676 :
1677 : Entry Exit
1678 : ===== ====
1679 :
1680 : Ptr -> <- Ptr
1681 : +------------+ +-----------+
1682 : | ProcSym | | ProcSym |
1683 : |------------| |-----------|
1684 : | Name | | Name |
1685 : |------------| |-----------|
1686 :
1687 :
1688 : Quadruples:
1689 :
1690 : q ProcedureScopeOp Line# Scope ProcSym
1691 : */
1692 :
1693 : extern "C" void M2Quads_BuildProcedureStart (void);
1694 :
1695 : /*
1696 : BuildProcedureBegin - determines the start of the BEGIN END block of
1697 : the procedure.
1698 : The Stack is expected to contain:
1699 :
1700 :
1701 : Entry Exit
1702 : ===== ====
1703 :
1704 : Ptr -> <- Ptr
1705 : +------------+ +-----------+
1706 : | ProcSym | | ProcSym |
1707 : |------------| |-----------|
1708 : | Name | | Name |
1709 : |------------| |-----------|
1710 :
1711 :
1712 : Quadruples:
1713 :
1714 : q NewLocalVarOp TokenNo(BEGIN) _ ProcSym
1715 : */
1716 :
1717 : extern "C" void M2Quads_BuildProcedureBegin (void);
1718 :
1719 : /*
1720 : BuildProcedureEnd - Builds end of the procedure. Destroys space for
1721 : the local variables.
1722 : The Stack is expected to contain:
1723 :
1724 :
1725 : Entry Exit
1726 : ===== ====
1727 :
1728 : Ptr -> <- Ptr
1729 : +------------+ +-----------+
1730 : | ProcSym | | ProcSym |
1731 : |------------| |-----------|
1732 : | Name | | Name |
1733 : |------------| |-----------|
1734 :
1735 :
1736 : Quadruples:
1737 :
1738 : q KillLocalVarOp TokenNo(END) _ ProcSym
1739 : */
1740 :
1741 : extern "C" void M2Quads_BuildProcedureEnd (void);
1742 :
1743 : /*
1744 : BuildReturn - Builds the Return part of the procedure.
1745 : tokreturn is the location of the RETURN keyword.
1746 : The Stack is expected to contain:
1747 :
1748 :
1749 : Entry Exit
1750 : ===== ====
1751 :
1752 : Ptr ->
1753 : +------------+
1754 : | e1 | Empty
1755 : |------------|
1756 : */
1757 :
1758 : extern "C" void M2Quads_BuildReturn (unsigned int tokreturn);
1759 :
1760 : /*
1761 : BuildModulePriority - assigns the current module with a priority
1762 : from the top of stack.
1763 :
1764 : Entry Exit
1765 : ===== ====
1766 :
1767 :
1768 : Ptr -> Empty
1769 : +------------+
1770 : | Priority |
1771 : |------------|
1772 : */
1773 :
1774 : extern "C" void M2Quads_BuildModulePriority (void);
1775 :
1776 : /*
1777 : StartBuildWith - performs the with statement.
1778 : The Stack:
1779 :
1780 : Entry Exit
1781 :
1782 : +------------+
1783 : | Sym | Type | Empty
1784 : |------------|
1785 : */
1786 :
1787 : extern "C" void M2Quads_StartBuildWith (unsigned int withTok);
1788 :
1789 : /*
1790 : EndBuildWith - terminates the innermost with scope.
1791 : */
1792 :
1793 : extern "C" void M2Quads_EndBuildWith (void);
1794 :
1795 : /*
1796 : CheckWithReference - performs the with statement.
1797 : The Stack:
1798 :
1799 : Entry Exit
1800 :
1801 : +------------+ +------------+
1802 : | Sym | Type | | Sym | Type |
1803 : |------------| |------------|
1804 : */
1805 :
1806 : extern "C" void M2Quads_CheckWithReference (void);
1807 :
1808 : /*
1809 : BuildDesignatorRecord - Builds the record referencing.
1810 : The Stack is expected to contain:
1811 :
1812 :
1813 : Entry Exit
1814 : ===== ====
1815 :
1816 : Ptr ->
1817 : +--------------+
1818 : | n |
1819 : |--------------|
1820 : | fld1 | type1 |
1821 : |--------------|
1822 : . .
1823 : . .
1824 : . .
1825 : |--------------|
1826 : | fldn | typen | <- Ptr
1827 : |--------------| +-------------+
1828 : | Sym | Type | | S | type1|
1829 : |--------------| |-------------|
1830 : */
1831 :
1832 : extern "C" void M2Quads_BuildDesignatorRecord (unsigned int dottok);
1833 :
1834 : /*
1835 : BuildDesignatorArray - Builds the array referencing.
1836 : The purpose of this procedure is to work out
1837 : whether the DesignatorArray is a constant string or
1838 : dynamic array/static array and to call the appropriate
1839 : BuildRoutine.
1840 :
1841 : The Stack is expected to contain:
1842 :
1843 : Entry Exit
1844 : ===== ====
1845 :
1846 : Ptr ->
1847 : +--------------+
1848 : | e | <- Ptr
1849 : |--------------| +------------+
1850 : | Sym | Type | | S | T |
1851 : |--------------| |------------|
1852 : */
1853 :
1854 : extern "C" void M2Quads_BuildDesignatorArray (void);
1855 :
1856 : /*
1857 : BuildDesignatorPointer - Builds a pointer reference.
1858 : The Stack is expected to contain:
1859 :
1860 :
1861 : Entry Exit
1862 : ===== ====
1863 :
1864 : Ptr -> <- Ptr
1865 : +--------------+ +--------------+
1866 : | Sym1 | Type1| | Sym2 | Type2|
1867 : |--------------| |--------------|
1868 : */
1869 :
1870 : extern "C" void M2Quads_BuildDesignatorPointer (unsigned int ptrtok);
1871 :
1872 : /*
1873 : BuildNulExpression - Builds a nul expression on the stack.
1874 : The Stack:
1875 :
1876 : Entry Exit
1877 :
1878 : <- Ptr
1879 : Empty +------------+
1880 : | NulSym |
1881 : |------------|
1882 : tokpos is the position of the RETURN token.
1883 : */
1884 :
1885 : extern "C" void M2Quads_BuildNulExpression (unsigned int tokpos);
1886 :
1887 : /*
1888 : BuildSetStart - Pushes a Bitset type on the stack.
1889 :
1890 : The Stack:
1891 :
1892 : Entry Exit
1893 :
1894 : Ptr -> <- Ptr
1895 :
1896 : Empty +--------------+
1897 : | Bitset |
1898 : |--------------|
1899 : */
1900 :
1901 : extern "C" void M2Quads_BuildSetStart (unsigned int tokpos);
1902 :
1903 : /*
1904 : BuildSetEnd - pops the set value and type from the stack
1905 : and pushes the value,type pair.
1906 :
1907 : Entry Exit
1908 :
1909 : Ptr ->
1910 : +--------------+
1911 : | Set Value | <- Ptr
1912 : |--------------| +--------------+
1913 : | Set Type | | Value | Type |
1914 : |--------------| |--------------|
1915 : */
1916 :
1917 : extern "C" void M2Quads_BuildSetEnd (void);
1918 :
1919 : /*
1920 : BuildEmptySet - Builds an empty set on the stack.
1921 : The Stack:
1922 :
1923 : Entry Exit
1924 :
1925 : <- Ptr
1926 : +-------------+
1927 : Ptr -> | Value |
1928 : +-----------+ |-------------|
1929 : | SetType | | SetType |
1930 : |-----------| |-------------|
1931 :
1932 : tokpos points to the opening '{'.
1933 : */
1934 :
1935 : extern "C" void M2Quads_BuildEmptySet (unsigned int tokpos);
1936 :
1937 : /*
1938 : BuildInclRange - includes a set range with a set.
1939 :
1940 :
1941 : Entry Exit
1942 : ===== ====
1943 :
1944 :
1945 : Ptr ->
1946 : +------------+
1947 : | El2 |
1948 : |------------|
1949 : | El1 | <- Ptr
1950 : |------------| +-------------------+
1951 : | Set Value | | Value + {El1..El2}|
1952 : |------------| |-------------------|
1953 :
1954 : No quadruples produced as the range info is contained within
1955 : the set value.
1956 : */
1957 :
1958 : extern "C" void M2Quads_BuildInclRange (void);
1959 :
1960 : /*
1961 : BuildInclBit - includes a bit into the set.
1962 :
1963 : Entry Exit
1964 : ===== ====
1965 :
1966 :
1967 : Ptr ->
1968 : +------------+
1969 : | Element | <- Ptr
1970 : |------------| +------------+
1971 : | Value | | Value |
1972 : |------------| |------------|
1973 :
1974 : */
1975 :
1976 : extern "C" void M2Quads_BuildInclBit (void);
1977 :
1978 : /*
1979 : SilentBuildConstructor - places NulSym into the constructor fifo queue.
1980 : */
1981 :
1982 : extern "C" void M2Quads_SilentBuildConstructor (void);
1983 :
1984 : /*
1985 : SilentBuildConstructorStart - removes an entry from the constructor fifo queue.
1986 : */
1987 :
1988 : extern "C" void M2Quads_SilentBuildConstructorStart (void);
1989 :
1990 : /*
1991 : BuildConstructor - builds a constructor.
1992 : Stack
1993 :
1994 : Entry Exit
1995 :
1996 : Ptr ->
1997 : +------------+
1998 : | Type | <- Ptr
1999 : |------------+
2000 : */
2001 :
2002 : extern "C" void M2Quads_BuildConstructor (unsigned int tokcbrpos);
2003 :
2004 : /*
2005 : BuildConstructorStart - builds a constructor.
2006 : Stack
2007 :
2008 : Entry Exit
2009 :
2010 : Ptr -> <- Ptr
2011 : +------------+ +----------------+
2012 : | Type | | ConstructorSym |
2013 : |------------+ |----------------|
2014 : */
2015 :
2016 : extern "C" void M2Quads_BuildConstructorStart (unsigned int cbratokpos);
2017 :
2018 : /*
2019 : BuildConstructorEnd - removes the current constructor frame from the
2020 : constructor stack (it does not effect the quad
2021 : stack)
2022 :
2023 : Entry Exit
2024 :
2025 : Ptr -> <- Ptr
2026 : +------------+ +------------+
2027 : | const | | const |
2028 : |------------| |------------|
2029 :
2030 : startpos is the start of the constructor, either the typename or '{'
2031 : cbratokpos is the '}'.
2032 : */
2033 :
2034 : extern "C" void M2Quads_BuildConstructorEnd (unsigned int startpos, unsigned int cbratokpos);
2035 :
2036 : /*
2037 : NextConstructorField - increments the top of constructor stacks index by one.
2038 : */
2039 :
2040 : extern "C" void M2Quads_NextConstructorField (void);
2041 :
2042 : /*
2043 : BuildTypeForConstructor - pushes the type implied by the current constructor.
2044 : If no constructor is currently being built then
2045 : it Pushes a Bitset type.
2046 : */
2047 :
2048 : extern "C" void M2Quads_BuildTypeForConstructor (unsigned int tokpos);
2049 :
2050 : /*
2051 : BuildComponentValue - builds a component value.
2052 :
2053 : Entry Exit
2054 :
2055 : Ptr -> <- Ptr
2056 :
2057 :
2058 : +------------+ +------------+
2059 : | const | | const |
2060 : |------------| |------------|
2061 : */
2062 :
2063 : extern "C" void M2Quads_BuildComponentValue (void);
2064 :
2065 : /*
2066 : PopConstructor - removes the top constructor from the top of stack.
2067 : */
2068 :
2069 : extern "C" void M2Quads_PopConstructor (void);
2070 :
2071 : /*
2072 : BuildNot - Builds a NOT operation from the quad stack.
2073 : The Stack is expected to contain:
2074 :
2075 :
2076 : Entry Exit
2077 : ===== ====
2078 :
2079 : Ptr -> <- Ptr
2080 : +------------+ +------------+
2081 : | t | f | | f | t |
2082 : |------------| |------------|
2083 : */
2084 :
2085 : extern "C" void M2Quads_BuildNot (unsigned int notTokPos);
2086 :
2087 : /*
2088 : RecordOp - Records the operator passed on the stack.
2089 : This is called when a boolean operator is found in an
2090 : expression. It is called just after the lhs has been built
2091 : and pushed to the quad stack and prior to the rhs build.
2092 : It checks to see if AND OR or equality tests are required.
2093 : It will short circuit AND and OR expressions. It also
2094 : converts a lhs to a boolean variable if an xor comparison
2095 : is about to be performed.
2096 :
2097 : Checks for AND operator or OR operator
2098 : if either of these operators are found then BackPatching
2099 : takes place.
2100 : The Expected Stack:
2101 :
2102 : Entry Exit
2103 :
2104 : Ptr -> <- Ptr
2105 : +-------------+ +-------------+
2106 : | OperatorTok | | OperatorTok |
2107 : |-------------| |-------------|
2108 : | t | f | | t | f |
2109 : |-------------| |-------------|
2110 :
2111 :
2112 : If OperatorTok=AndTok
2113 : Then
2114 : BackPatch(f, NextQuad)
2115 : Elsif OperatorTok=OrTok
2116 : Then
2117 : BackPatch(t, NextQuad)
2118 : End
2119 : */
2120 :
2121 : extern "C" void M2Quads_RecordOp (void);
2122 :
2123 : /*
2124 : BuildRelOp - Builds a relative operation from the quad stack.
2125 : The Stack is expected to contain:
2126 :
2127 :
2128 : Entry Exit
2129 : ===== ====
2130 :
2131 : Ptr ->
2132 : +------------+
2133 : | e1 |
2134 : |------------| <- Ptr
2135 : | Operator |
2136 : |------------| +------------+
2137 : | e2 | | t | f |
2138 : |------------| |------------|
2139 :
2140 :
2141 : Quadruples Produced
2142 :
2143 : q IFOperator e2 e1 TrueExit ; e2 e1 since
2144 : q+1 GotoOp FalseExit ; relation > etc
2145 : ; requires order.
2146 : */
2147 :
2148 : extern "C" void M2Quads_BuildRelOp (unsigned int optokpos);
2149 :
2150 : /*
2151 : BuildBinaryOp - Builds a binary operation from the quad stack.
2152 : Be aware that this procedure will check for
2153 : the overloading of the bitset operators + - \ *.
2154 : So do NOT call this procedure if you are building
2155 : a reference to an array which has a bitset type or
2156 : the address arithmetic will be wrongly coersed into
2157 : logical ORs.
2158 :
2159 : The Stack is expected to contain:
2160 :
2161 :
2162 : Entry Exit
2163 : ===== ====
2164 :
2165 : Ptr ->
2166 : +------------+
2167 : | Sym1 |
2168 : |------------|
2169 : | Operator | <- Ptr
2170 : |------------| +------------+
2171 : | Sym2 | | Temporary |
2172 : |------------| |------------|
2173 :
2174 :
2175 : Quadruples Produced
2176 :
2177 : q Operator Temporary Sym1 Sym2
2178 :
2179 :
2180 : OR
2181 :
2182 :
2183 : Entry Exit
2184 : ===== ====
2185 :
2186 : Ptr ->
2187 : +------------+
2188 : | T1 | F1 |
2189 : |------------|
2190 : | OrTok | <- Ptr
2191 : |------------| +------------+
2192 : | T2 | F2 | | T1+T2| F1 |
2193 : |------------| |------------|
2194 :
2195 :
2196 : Quadruples Produced
2197 :
2198 : */
2199 :
2200 : extern "C" void M2Quads_BuildBinaryOp (void);
2201 :
2202 : /*
2203 : BuildUnaryOp - Builds a unary operation from the quad stack.
2204 : The Stack is expected to contain:
2205 :
2206 :
2207 : Entry Exit
2208 : ===== ====
2209 :
2210 : Ptr ->
2211 : +------------+
2212 : | Sym |
2213 : |------------| +------------+
2214 : | Operator | | Temporary | <- Ptr
2215 : |------------| |------------|
2216 :
2217 :
2218 : Quadruples Produced
2219 :
2220 : q Operator Temporary _ Sym
2221 :
2222 : */
2223 :
2224 : extern "C" void M2Quads_BuildUnaryOp (void);
2225 :
2226 : /*
2227 : OperandT - returns the ident operand stored in the true position on the boolean stack.
2228 : */
2229 :
2230 : extern "C" unsigned int M2Quads_OperandT (unsigned int pos);
2231 :
2232 : /*
2233 : OperandF - returns the ident operand stored in the false position on the boolean stack.
2234 : */
2235 :
2236 : extern "C" unsigned int M2Quads_OperandF (unsigned int pos);
2237 :
2238 : /*
2239 : PushTF - Push a True and False numbers onto the True/False stack.
2240 : True and False are assumed to contain Symbols or Ident etc.
2241 : */
2242 :
2243 : extern "C" void M2Quads_PushTF (unsigned int True, unsigned int False);
2244 :
2245 : /*
2246 : PopTF - Pop a True and False number from the True/False stack.
2247 : True and False are assumed to contain Symbols or Ident etc.
2248 : */
2249 :
2250 : extern "C" void M2Quads_PopTF (unsigned int *True, unsigned int *False);
2251 :
2252 : /*
2253 : PushT - Push an item onto the stack in the T (true) position.
2254 : */
2255 :
2256 : extern "C" void M2Quads_PushT (unsigned int True);
2257 :
2258 : /*
2259 : PopT - Pops the T value from the stack.
2260 : */
2261 :
2262 : extern "C" void M2Quads_PopT (unsigned int *True);
2263 :
2264 : /*
2265 : PushTtok - Push an item onto the stack in the T (true) position,
2266 : it is assummed to be a token and its token location is recorded.
2267 : */
2268 :
2269 : extern "C" void M2Quads_PushTtok (unsigned int True, unsigned int tokno);
2270 :
2271 : /*
2272 : PushTFtok - Push an item onto the stack in the T (true) position,
2273 : it is assummed to be a token and its token location is recorded.
2274 : */
2275 :
2276 : extern "C" void M2Quads_PushTFtok (unsigned int True, unsigned int False, unsigned int tokno);
2277 :
2278 : /*
2279 : PopTFtok - Pop T/F/tok from the stack.
2280 : */
2281 :
2282 : extern "C" void M2Quads_PopTFtok (unsigned int *True, unsigned int *False, unsigned int *tokno);
2283 :
2284 : /*
2285 : PushTFAtok - Push T/F/A/tok to the stack.
2286 : */
2287 :
2288 : extern "C" void M2Quads_PushTFAtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int tokno);
2289 :
2290 : /*
2291 : PopTtok - Pops the T value from the stack and token position.
2292 : */
2293 :
2294 : extern "C" void M2Quads_PopTtok (unsigned int *True, unsigned int *tok);
2295 :
2296 : /*
2297 : PushTFn - Push a True and False numbers onto the True/False stack.
2298 : True and False are assumed to contain Symbols or Ident etc.
2299 : */
2300 :
2301 : extern "C" void M2Quads_PushTFn (unsigned int True, unsigned int False, unsigned int n);
2302 :
2303 : /*
2304 : PushTFntok - Push a True and False numbers onto the True/False stack.
2305 : True and False are assumed to contain Symbols or Ident etc.
2306 : */
2307 :
2308 : extern "C" void M2Quads_PushTFntok (unsigned int True, unsigned int False, unsigned int n, unsigned int tokno);
2309 :
2310 : /*
2311 : PopTFn - Pop a True and False number from the True/False stack.
2312 : True and False are assumed to contain Symbols or Ident etc.
2313 : */
2314 :
2315 : extern "C" void M2Quads_PopTFn (unsigned int *True, unsigned int *False, unsigned int *n);
2316 :
2317 : /*
2318 : PopNothing - pops the top element on the boolean stack.
2319 : */
2320 :
2321 : extern "C" void M2Quads_PopNothing (void);
2322 :
2323 : /*
2324 : PopN - pops multiple elements from the BoolStack.
2325 : */
2326 :
2327 : extern "C" void M2Quads_PopN (unsigned int n);
2328 :
2329 : /*
2330 : PushTFA - Push True, False, Array, numbers onto the
2331 : True/False stack. True and False are assumed to
2332 : contain Symbols or Ident etc.
2333 : */
2334 :
2335 : extern "C" void M2Quads_PushTFA (unsigned int True, unsigned int False, unsigned int Array);
2336 :
2337 : /*
2338 : OperandTok - returns the token associated with pos, on the stack.
2339 : */
2340 :
2341 : extern "C" unsigned int M2Quads_OperandTok (unsigned int pos);
2342 :
2343 : /*
2344 : OperandA - returns possible array symbol associated with the ident
2345 : operand stored on the boolean stack.
2346 : */
2347 :
2348 : extern "C" unsigned int M2Quads_OperandA (unsigned int pos);
2349 :
2350 : /*
2351 : OperandAnno - returns the annotation string associated with the
2352 : position, n, on the stack.
2353 : */
2354 :
2355 : extern "C" DynamicStrings_String M2Quads_OperandAnno (unsigned int n);
2356 :
2357 : /*
2358 : Annotate - annotate the top of stack.
2359 : */
2360 :
2361 : extern "C" void M2Quads_Annotate (const char *a_, unsigned int _a_high);
2362 :
2363 : /*
2364 : DisplayStack - displays the compile time symbol stack.
2365 : */
2366 :
2367 : extern "C" void M2Quads_DisplayStack (void);
2368 :
2369 : /*
2370 : Top - returns the no of items held in the stack.
2371 : */
2372 :
2373 : extern "C" unsigned int M2Quads_Top (void);
2374 :
2375 : /*
2376 : DupFrame - duplicate the top of stack and push the new frame.
2377 : */
2378 :
2379 : extern "C" void M2Quads_DupFrame (void);
2380 :
2381 : /*
2382 : WriteOperand - displays the operands name, symbol id and mode of addressing.
2383 : */
2384 :
2385 : extern "C" void M2Quads_WriteOperand (unsigned int Sym);
2386 :
2387 : /*
2388 : BeginVarient - begin a varient record.
2389 : */
2390 :
2391 : extern "C" void M2Quads_BeginVarient (void);
2392 :
2393 : /*
2394 : EndVarient - end a varient record.
2395 : */
2396 :
2397 : extern "C" void M2Quads_EndVarient (void);
2398 :
2399 : /*
2400 : ElseVarient - associate an ELSE clause with a varient record.
2401 : */
2402 :
2403 : extern "C" void M2Quads_ElseVarient (void);
2404 :
2405 : /*
2406 : BeginVarientList - begin an ident list containing ranges belonging to a
2407 : varient list.
2408 : */
2409 :
2410 : extern "C" void M2Quads_BeginVarientList (void);
2411 :
2412 : /*
2413 : EndVarientList - end a range list for a varient field.
2414 : */
2415 :
2416 : extern "C" void M2Quads_EndVarientList (void);
2417 :
2418 : /*
2419 : AddRecordToList - adds the record held on the top of stack to the
2420 : list of records and varient fields.
2421 : */
2422 :
2423 : extern "C" void M2Quads_AddRecordToList (void);
2424 :
2425 : /*
2426 : AddVarientToList - adds varient held on the top of stack to the list.
2427 : */
2428 :
2429 : extern "C" void M2Quads_AddVarientToList (void);
2430 :
2431 : /*
2432 : AddVarientFieldToList - adds varient field, f, to the list of all varient
2433 : fields created.
2434 : */
2435 :
2436 : extern "C" void M2Quads_AddVarientFieldToList (unsigned int f);
2437 :
2438 : /*
2439 : AddVarientRange - creates a range from the top two contant expressions
2440 : on the stack which are recorded with the current
2441 : varient field. The stack is unaltered.
2442 : */
2443 :
2444 : extern "C" void M2Quads_AddVarientRange (void);
2445 :
2446 : /*
2447 : AddVarientEquality - adds the contant expression on the top of the stack
2448 : to the current varient field being recorded.
2449 : The stack is unaltered.
2450 : */
2451 :
2452 : extern "C" void M2Quads_AddVarientEquality (void);
2453 :
2454 : /*
2455 : BuildCodeOn - generates a quadruple declaring that code should be
2456 : emmitted from henceforth.
2457 :
2458 : The Stack is unnaffected.
2459 : */
2460 :
2461 : extern "C" void M2Quads_BuildCodeOn (void);
2462 :
2463 : /*
2464 : BuildCodeOff - generates a quadruple declaring that code should not be
2465 : emmitted from henceforth.
2466 :
2467 : The Stack is unnaffected.
2468 : */
2469 :
2470 : extern "C" void M2Quads_BuildCodeOff (void);
2471 :
2472 : /*
2473 : BuildProfileOn - generates a quadruple declaring that profile timings
2474 : should be emmitted from henceforth.
2475 :
2476 : The Stack is unnaffected.
2477 : */
2478 :
2479 : extern "C" void M2Quads_BuildProfileOn (void);
2480 : extern "C" void M2Quads_BuildProfileOff (void);
2481 :
2482 : /*
2483 : BuildOptimizeOn - generates a quadruple declaring that optimization
2484 : should occur from henceforth.
2485 :
2486 : The Stack is unnaffected.
2487 : */
2488 :
2489 : extern "C" void M2Quads_BuildOptimizeOn (void);
2490 :
2491 : /*
2492 : BuildOptimizeOff - generates a quadruple declaring that optimization
2493 : should not occur from henceforth.
2494 :
2495 : The Stack is unnaffected.
2496 : */
2497 :
2498 : extern "C" void M2Quads_BuildOptimizeOff (void);
2499 :
2500 : /*
2501 : BuildAsm - builds an Inline pseudo quadruple operator.
2502 : The inline interface, Sym, is stored as the operand
2503 : to the operator InlineOp.
2504 :
2505 : The stack is expected to contain:
2506 :
2507 :
2508 : Entry Exit
2509 : ===== ====
2510 :
2511 : Ptr ->
2512 : +--------------+
2513 : | Sym | Empty
2514 : |--------------|
2515 : */
2516 :
2517 : extern "C" void M2Quads_BuildAsm (unsigned int tok);
2518 :
2519 : /*
2520 : BuildLineNo - builds a LineNumberOp pseudo quadruple operator.
2521 : This quadruple indicates which source line has been
2522 : processed, these quadruples are only generated if we
2523 : are producing runtime debugging information.
2524 :
2525 : The stack is not affected, read or altered in any way.
2526 :
2527 :
2528 : Entry Exit
2529 : ===== ====
2530 :
2531 : Ptr -> <- Ptr
2532 : */
2533 :
2534 : extern "C" void M2Quads_BuildLineNo (void);
2535 :
2536 : /*
2537 : PushLineNo - pushes the current file and line number to the stack.
2538 : */
2539 :
2540 : extern "C" void M2Quads_PushLineNo (void);
2541 :
2542 : /*
2543 : BuildStmtNote - builds a StatementNoteOp pseudo quadruple operator.
2544 : This quadruple indicates which source line has been
2545 : processed and it represents the start of a statement
2546 : sequence.
2547 : It differs from LineNumberOp in that multiple successive
2548 : LineNumberOps will be removed and the final one is attached to
2549 : the next real GCC tree. Whereas a StatementNoteOp is always left
2550 : alone. Depending upon the debugging level it will issue a nop
2551 : instruction to ensure that the gdb single step will step into
2552 : this line. Practically it allows pedalogical debugging to
2553 : occur when there is syntax sugar such as:
2554 :
2555 :
2556 : END step
2557 : END step
2558 : END ; step
2559 : a := 1 ; step
2560 :
2561 : REPEAT step
2562 : i := 1 step
2563 :
2564 : The stack is not affected, read or altered in any way.
2565 :
2566 :
2567 : Entry Exit
2568 : ===== ====
2569 :
2570 : Ptr -> <- Ptr
2571 : */
2572 :
2573 : extern "C" void M2Quads_BuildStmtNote (int offset);
2574 :
2575 : /*
2576 : LoopAnalysis - checks whether an infinite loop exists.
2577 : */
2578 :
2579 : extern "C" void M2Quads_LoopAnalysis (unsigned int Scope, unsigned int Current, unsigned int End);
2580 :
2581 : /*
2582 : ForLoopAnalysis - checks all the FOR loops for index variable manipulation
2583 : and dangerous usage outside the loop.
2584 : */
2585 :
2586 : extern "C" void M2Quads_ForLoopAnalysis (void);
2587 :
2588 : /*
2589 : BuildSizeCheckStart - switches off all quadruple generation if the function SIZE or HIGH
2590 : is being "called". This should be done as SIZE only requires the
2591 : actual type of the expression, not its value. Consider the problem of
2592 : SIZE(UninitializedPointer^) which is quite legal and it must
2593 : also be safe!
2594 : ISO Modula-2 also allows HIGH(a[0]) for a two dimensional array
2595 : and there is no need to compute a[0], we just need to follow the
2596 : type and count dimensions. However if SIZE(a) or HIGH(a) occurs
2597 : and, a, is an unbounded array then we turn on quadruple generation.
2598 :
2599 : The Stack is expected to contain:
2600 :
2601 :
2602 : Entry Exit
2603 : ===== ====
2604 :
2605 : Ptr -> <- Ptr
2606 : +----------------------+ +----------------------+
2607 : | ProcSym | Type | tok | | ProcSym | Type | tok |
2608 : |----------------------| |----------------------|
2609 : */
2610 :
2611 : extern "C" void M2Quads_BuildSizeCheckStart (void);
2612 :
2613 : /*
2614 : BackPatchSubrangesAndOptParam - runs through all the quadruples and finds SubrangeLow or SubrangeHigh
2615 : quadruples and replaces it by an assignment to the Low or High component
2616 : of the subrange type.
2617 :
2618 : Input:
2619 : SubrangeLow op1 op3 op3 is a subrange
2620 :
2621 : Output:
2622 : Becomes op1 low
2623 :
2624 : Input:
2625 : SubrangeHigh op1 op3 op3 is a subrange
2626 :
2627 : Output:
2628 : Becomes op1 high
2629 :
2630 : Input:
2631 : OptParam op1 op2 op3
2632 :
2633 : Output:
2634 : Param op1 op2 GetOptArgInit(op3)
2635 : */
2636 :
2637 : extern "C" void M2Quads_BackPatchSubrangesAndOptParam (void);
2638 :
2639 : /*
2640 : WriteOperator - writes the name of the quadruple operator.
2641 : */
2642 :
2643 : extern "C" void M2Quads_WriteOperator (M2Quads_QuadOperator Operator);
2644 :
2645 : /*
2646 : PushAutoOn - push the auto flag and then set it to TRUE.
2647 : Any call to ident in the parser will result in the token being pushed.
2648 : */
2649 :
2650 : extern "C" void M2Quads_PushAutoOn (void);
2651 :
2652 : /*
2653 : PushAutoOff - push the auto flag and then set it to FALSE.
2654 : */
2655 :
2656 : extern "C" void M2Quads_PushAutoOff (void);
2657 :
2658 : /*
2659 : IsAutoPushOn - returns the value of the current Auto ident push flag.
2660 : */
2661 :
2662 : extern "C" bool M2Quads_IsAutoPushOn (void);
2663 :
2664 : /*
2665 : PopAuto - restores the previous value of the Auto flag.
2666 : */
2667 :
2668 : extern "C" void M2Quads_PopAuto (void);
2669 :
2670 : /*
2671 : MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
2672 : */
2673 :
2674 : extern "C" bool M2Quads_MustCheckOverflow (unsigned int q);
2675 :
2676 : /*
2677 : PushInConstExpression - push the InConstExpression flag and then set it to TRUE.
2678 : */
2679 :
2680 : extern "C" void M2Quads_PushInConstExpression (void);
2681 :
2682 : /*
2683 : PopInConstExpression - restores the previous value of the InConstExpression.
2684 : */
2685 :
2686 : extern "C" void M2Quads_PopInConstExpression (void);
2687 :
2688 : /*
2689 : IsInConstExpression - returns the value of the InConstExpression.
2690 : */
2691 :
2692 : extern "C" bool M2Quads_IsInConstExpression (void);
2693 :
2694 : /*
2695 : PushInConstParameters - push the InConstParameters flag and then set it to TRUE.
2696 : */
2697 :
2698 : extern "C" void M2Quads_PushInConstParameters (void);
2699 :
2700 : /*
2701 : PopInConstParameters - restores the previous value of the InConstParameters.
2702 : */
2703 :
2704 : extern "C" void M2Quads_PopInConstParameters (void);
2705 :
2706 : /*
2707 : IsInConstParameters - returns the value of the InConstParameters.
2708 : */
2709 :
2710 : extern "C" bool M2Quads_IsInConstParameters (void);
2711 :
2712 : /*
2713 : BuildAsmElement - the stack is expected to contain:
2714 :
2715 :
2716 : Entry Exit
2717 : ===== ====
2718 :
2719 : Ptr ->
2720 : +------------------+
2721 : | expr | tokpos |
2722 : |------------------|
2723 : | str |
2724 : |------------------|
2725 : | name |
2726 : |------------------| +------------------+
2727 : | CurrentInterface | | CurrentInterface |
2728 : |------------------| |------------------|
2729 : | CurrentAsm | | CurrentAsm |
2730 : |------------------| |------------------|
2731 : | n | | n |
2732 : |------------------| |------------------|
2733 : */
2734 :
2735 : extern "C" void M2Quads_BuildAsmElement (bool input, bool output);
2736 :
2737 : /*
2738 : BuildAsmTrash - the stack is expected to contain:
2739 :
2740 :
2741 : Entry Exit
2742 : ===== ====
2743 :
2744 : Ptr ->
2745 : +------------------+
2746 : | expr | tokpos |
2747 : |------------------| +------------------+
2748 : | CurrentInterface | | CurrentInterface |
2749 : |------------------| |------------------|
2750 : | CurrentAsm | | CurrentAsm |
2751 : |------------------| |------------------|
2752 : | n | | n |
2753 : |------------------| |------------------|
2754 : */
2755 :
2756 : extern "C" void M2Quads_BuildAsmTrash (void);
2757 :
2758 : /*
2759 : GetQuadTrash - return the symbol associated with the trashed operand.
2760 : */
2761 :
2762 : extern "C" unsigned int M2Quads_GetQuadTrash (unsigned int quad);
2763 :
2764 : /*
2765 : DSdbEnter -
2766 : */
2767 :
2768 : static void DSdbEnter (void);
2769 :
2770 : /*
2771 : DSdbExit -
2772 : */
2773 :
2774 : static void DSdbExit (void);
2775 :
2776 : /*
2777 : GetQF - returns the QuadFrame associated with, q.
2778 : */
2779 :
2780 : static M2Quads_QuadFrame GetQF (unsigned int q);
2781 :
2782 : /*
2783 : IsQuadA - returns true if QuadNo is a op.
2784 : */
2785 :
2786 : static bool IsQuadA (unsigned int QuadNo, M2Quads_QuadOperator op);
2787 :
2788 : /*
2789 : OpUsesOp1 - return TRUE if op allows op1.
2790 : */
2791 :
2792 : static bool OpUsesOp1 (M2Quads_QuadOperator op);
2793 :
2794 : /*
2795 : AddQuadInformation - adds variable analysis and jump analysis to the new quadruple.
2796 : */
2797 :
2798 : static void AddQuadInformation (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3);
2799 :
2800 : /*
2801 : PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
2802 : sets a boolean to determinine whether overflow should be checked.
2803 : */
2804 :
2805 : static void PutQuadO (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow);
2806 :
2807 : /*
2808 : PutQuadOType -
2809 : */
2810 :
2811 : static void PutQuadOType (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow, bool checktype);
2812 :
2813 : /*
2814 : UndoReadWriteInfo -
2815 : */
2816 :
2817 : static void UndoReadWriteInfo (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3);
2818 :
2819 : /*
2820 : CheckAddTuple2Read - checks to see whether symbol tuple contains variables or
2821 : parameters and if so it then adds them to the quadruple
2822 : variable list.
2823 : */
2824 :
2825 : static void CheckAddTuple2Read (unsigned int tuple, bool canDereference, unsigned int Quad);
2826 :
2827 : /*
2828 : CheckAddVariableRead - checks to see whether symbol, Sym, is a variable or
2829 : a parameter and if so it then adds this quadruple
2830 : to the variable list.
2831 : */
2832 :
2833 : static void CheckAddVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad);
2834 :
2835 : /*
2836 : CheckRemoveVariableRead - checks to see whether, Sym, is a variable or
2837 : a parameter and if so then it removes the
2838 : quadruple from the variable list.
2839 : */
2840 :
2841 : static void CheckRemoveVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad);
2842 :
2843 : /*
2844 : CheckAddVariableWrite - checks to see whether symbol, Sym, is a variable and
2845 : if so it then adds this quadruple to the variable list.
2846 : */
2847 :
2848 : static void CheckAddVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad);
2849 :
2850 : /*
2851 : CheckRemoveVariableWrite - checks to see whether, Sym, is a variable and
2852 : if so then it removes the quadruple from the
2853 : variable list.
2854 : */
2855 :
2856 : static void CheckRemoveVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad);
2857 :
2858 : /*
2859 : CheckConst -
2860 : */
2861 :
2862 : static void CheckConst (unsigned int sym);
2863 :
2864 : /*
2865 : AlterReference - alters all references from OldQuad, to NewQuad in a
2866 : quadruple list Head.
2867 : */
2868 :
2869 : static void AlterReference (unsigned int Head, unsigned int OldQuad, unsigned int NewQuad);
2870 :
2871 : /*
2872 : GrowQuads - grows the list of quadruples to the quadruple, to.
2873 : */
2874 :
2875 : static void GrowQuads (unsigned int to);
2876 :
2877 : /*
2878 : ManipulateReference - manipulates the quadruple, q, so that it now points to quad, to.
2879 : */
2880 :
2881 : static void ManipulateReference (unsigned int q, unsigned int to);
2882 :
2883 : /*
2884 : RemoveReference - remove the reference by quadruple q to wherever
2885 : it was pointing.
2886 : */
2887 :
2888 : static void RemoveReference (unsigned int q);
2889 :
2890 : /*
2891 : NewQuad - sets QuadNo to a new quadruple.
2892 : */
2893 :
2894 : static void NewQuad (unsigned int *QuadNo);
2895 :
2896 : /*
2897 : CheckVariableAt - checks to see whether, sym, was declared at a particular address.
2898 : */
2899 :
2900 : static void CheckVariableAt (unsigned int sym);
2901 :
2902 : /*
2903 : CheckVariablesAt - checks to see whether we need to initialize any pointers
2904 : which point to variable declared at addresses.
2905 : */
2906 :
2907 : static void CheckVariablesAt (unsigned int scope);
2908 :
2909 : /*
2910 : GetTurnInterrupts - returns the TurnInterrupts procedure function.
2911 : */
2912 :
2913 : static unsigned int GetTurnInterrupts (unsigned int tok);
2914 :
2915 : /*
2916 : GetProtection - returns the PROTECTION data type.
2917 : */
2918 :
2919 : static unsigned int GetProtection (unsigned int tok);
2920 :
2921 : /*
2922 : CheckNeedPriorityBegin - checks to see whether we need to save the old
2923 : module priority and change to another module
2924 : priority.
2925 : The current module initialization or procedure
2926 : being built is defined by, scope. The module whose
2927 : priority will be used is defined by, module.
2928 : */
2929 :
2930 : static void CheckNeedPriorityBegin (unsigned int tok, unsigned int scope, unsigned int module);
2931 :
2932 : /*
2933 : CheckNeedPriorityEnd - checks to see whether we need to restore the old
2934 : module priority.
2935 : The current module initialization or procedure
2936 : being built is defined by, scope.
2937 : */
2938 :
2939 : static void CheckNeedPriorityEnd (unsigned int tok, unsigned int scope, unsigned int module);
2940 :
2941 : /*
2942 : BuildRTExceptEnter - informs RTExceptions that we are about to enter the except state.
2943 : */
2944 :
2945 : static void BuildRTExceptEnter (unsigned int tok);
2946 :
2947 : /*
2948 : BuildRTExceptLeave - informs RTExceptions that we are about to leave the except state.
2949 : If, destroy, is TRUE then pop the ExceptStack.
2950 : */
2951 :
2952 : static void BuildRTExceptLeave (unsigned int tok, bool destroy);
2953 :
2954 : /*
2955 : SafeRequestSym - only used during scaffold to get argc, argv, envp.
2956 : It attempts to get symbol name from the current scope(s) and if
2957 : it fails then it falls back onto default constants.
2958 : */
2959 :
2960 : static unsigned int SafeRequestSym (unsigned int tok, NameKey_Name name);
2961 :
2962 : /*
2963 : callRequestDependant - create a call:
2964 : RequestDependant (GetSymName (modulesym), GetLibName (modulesym),
2965 : GetSymName (depModuleSym), GetLibName (depModuleSym));
2966 : */
2967 :
2968 : static void callRequestDependant (unsigned int tokno, unsigned int moduleSym, unsigned int depModuleSym, unsigned int requestDep);
2969 :
2970 : /*
2971 : ForeachImportInDepDo -
2972 : */
2973 :
2974 : static void ForeachImportInDepDo (Lists_List importStatements, unsigned int moduleSym, unsigned int requestDep);
2975 :
2976 : /*
2977 : ForeachImportedModuleDo -
2978 : */
2979 :
2980 : static void ForeachImportedModuleDo (unsigned int moduleSym, unsigned int requestDep);
2981 :
2982 : /*
2983 : BuildM2DepFunction - creates the dependency graph procedure using IR:
2984 : static void
2985 : dependencies (void)
2986 : {
2987 : M2RTS_RequestDependant (module_name, libname, "b", "b libname");
2988 : M2RTS_RequestDependant (module_name, libname, NULL, NULL);
2989 : }
2990 : */
2991 :
2992 : static void BuildM2DepFunction (unsigned int tokno, unsigned int moduleSym);
2993 :
2994 : /*
2995 : BuildM2LinkFunction - creates the _M2_link procedure which will
2996 : cause the linker to pull in all the module ctors.
2997 : */
2998 :
2999 : static void BuildM2LinkFunction (unsigned int tokno);
3000 :
3001 : /*
3002 : BuildTry - build the try statement for main.
3003 : */
3004 :
3005 : static void BuildTry (unsigned int tokno);
3006 :
3007 : /*
3008 : BuildExcept - build the except block for main.
3009 : */
3010 :
3011 : static void BuildExcept (unsigned int tokno);
3012 :
3013 : /*
3014 : BuildM2MainFunction - creates the main function with appropriate calls to the scaffold.
3015 : */
3016 :
3017 : static void BuildM2MainFunction (unsigned int tokno);
3018 :
3019 : /*
3020 : DeferMakeConstStringCnul - return a C const string which will be nul terminated.
3021 : */
3022 :
3023 : static unsigned int DeferMakeConstStringCnul (unsigned int tok, unsigned int sym);
3024 :
3025 : /*
3026 : DeferMakeConstStringM2nul - return a const string which will be nul terminated.
3027 : */
3028 :
3029 : static unsigned int DeferMakeConstStringM2nul (unsigned int tok, unsigned int sym);
3030 :
3031 : /*
3032 : BuildStringAdrParam - push the address of a nul terminated string onto the quad stack.
3033 : */
3034 :
3035 : static void BuildStringAdrParam (unsigned int tok, NameKey_Name name);
3036 :
3037 : /*
3038 : BuildM2InitFunction -
3039 : */
3040 :
3041 : static void BuildM2InitFunction (unsigned int tok, unsigned int moduleSym);
3042 :
3043 : /*
3044 : BuildM2FiniFunction -
3045 : */
3046 :
3047 : static void BuildM2FiniFunction (unsigned int tok, unsigned int moduleSym);
3048 :
3049 : /*
3050 : BuildM2CtorFunction - create a constructor function associated with moduleSym.
3051 :
3052 : void
3053 : ctorFunction ()
3054 : {
3055 : M2RTS_RegisterModule (GetSymName (moduleSym), GetLibName (moduleSym),
3056 : init, fini, dependencies);
3057 : }
3058 : */
3059 :
3060 : static void BuildM2CtorFunction (unsigned int tok, unsigned int moduleSym);
3061 :
3062 : /*
3063 : AddForInfo - adds the description of the FOR loop into the record list.
3064 : This is used if -pedantic is turned on to check index variable
3065 : usage.
3066 : */
3067 :
3068 : static void AddForInfo (unsigned int Start, unsigned int End, unsigned int IncQuad, unsigned int Sym, unsigned int idtok);
3069 :
3070 : /*
3071 : CheckForIndex - checks the quadruples: Start..End to see whether a
3072 : for loop index is manipulated by the programmer.
3073 : It generates a warning if this is the case.
3074 : It also checks to see whether the IndexSym is read
3075 : immediately outside the loop in which case a warning
3076 : is issued.
3077 : */
3078 :
3079 : static void CheckForIndex (M2Quads_ForLoopInfo forDesc);
3080 :
3081 : /*
3082 : BuildRange - generates a RangeCheckOp quad with, r, as its operand.
3083 : */
3084 :
3085 : static void BuildRange (unsigned int r);
3086 :
3087 : /*
3088 : BuildError - generates a ErrorOp quad, indicating that if this
3089 : quadruple is reachable, then a runtime error would
3090 : occur.
3091 : */
3092 :
3093 : static void BuildError (unsigned int r);
3094 :
3095 : /*
3096 : CheckPointerThroughNil - builds a range quadruple, providing, sym, is
3097 : a candidate for checking against NIL.
3098 : This range quadruple is only expanded into
3099 : code during the code generation phase
3100 : thus allowing limited compile time checking.
3101 : */
3102 :
3103 : static void CheckPointerThroughNil (unsigned int tokpos, unsigned int sym);
3104 :
3105 : /*
3106 : CollectLow - returns the low of the subrange value.
3107 : */
3108 :
3109 : static unsigned int CollectLow (unsigned int sym);
3110 :
3111 : /*
3112 : CollectHigh - returns the high of the subrange value, sym.
3113 : */
3114 :
3115 : static unsigned int CollectHigh (unsigned int sym);
3116 :
3117 : /*
3118 : CheckCompatibleWithBecomes - checks to see that symbol, sym, is
3119 : compatible with the := operator.
3120 : */
3121 :
3122 : static void CheckCompatibleWithBecomes (unsigned int des, unsigned int expr, unsigned int destok, unsigned int exprtok);
3123 :
3124 : /*
3125 : BuildAssignmentWithoutBounds - calls BuildAssignment but makes sure we do not
3126 : check bounds.
3127 : */
3128 :
3129 : static void BuildAssignmentWithoutBounds (unsigned int tok, bool checkTypes, bool checkOverflow);
3130 :
3131 : /*
3132 : MarkArrayWritten - marks, Array, as being written.
3133 : */
3134 :
3135 : static void MarkArrayWritten (unsigned int Array);
3136 :
3137 : /*
3138 : MarkAsReadWrite - marks the variable or parameter as being
3139 : read/write.
3140 : */
3141 :
3142 : static void MarkAsReadWrite (unsigned int sym);
3143 :
3144 : /*
3145 : MarkAsRead - marks the variable or parameter as being read.
3146 : */
3147 :
3148 : static void MarkAsRead (unsigned int sym);
3149 :
3150 : /*
3151 : MarkAsWrite - marks the variable or parameter as being written.
3152 : */
3153 :
3154 : static void MarkAsWrite (unsigned int sym);
3155 :
3156 : /*
3157 : doVal - return an expression which is VAL(type, expr). If
3158 : expr is a constant then return expr.
3159 : */
3160 :
3161 : static unsigned int doVal (unsigned int type, unsigned int expr);
3162 :
3163 : /*
3164 : MoveWithMode -
3165 : */
3166 :
3167 : static void MoveWithMode (unsigned int tokno, unsigned int Des, unsigned int Exp, unsigned int Array, unsigned int destok, unsigned int exptok, bool checkOverflow);
3168 :
3169 : /*
3170 : CheckBecomesMeta - checks to make sure that we are not
3171 : assigning a variable to a constant.
3172 : Also check we are not assigning to an
3173 : unbounded array.
3174 : */
3175 :
3176 : static void CheckBecomesMeta (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok);
3177 :
3178 : /*
3179 : BuildAssignmentBoolean - build the quadruples for a boolean variable or constant
3180 : which will be assigned to the result of a boolean expression.
3181 : For example:
3182 :
3183 : foo := a = b ;
3184 : foo := a IN b ;
3185 :
3186 : The boolean result is contained in the control flow
3187 : the true value will emerge from the quad path t.
3188 : The false value will emerge from the quad path f.
3189 : This procedure terminates both paths by backpatching
3190 : and assigns TRUE or FALSE to the variable/constant.
3191 : A variable maybe an L value so it will require dereferencing.
3192 : */
3193 :
3194 : static void BuildAssignmentBoolean (unsigned int becomesTokNo, bool checkOverflow, unsigned int t, unsigned int f, unsigned int Des, unsigned int destok);
3195 :
3196 : /*
3197 : doBuildAssignment - subsiduary procedure of BuildAssignment.
3198 : It builds the assignment and optionally
3199 : checks the types are compatible.
3200 : */
3201 :
3202 : static void doBuildAssignment (unsigned int becomesTokNo, bool checkTypes, bool checkOverflow);
3203 :
3204 : /*
3205 : CheckAssignCompatible - checks to see that an assignment is compatible.
3206 : It performs limited checking - thorough checking
3207 : is done in pass 3. But we do what we can here
3208 : given knowledge so far.
3209 : */
3210 :
3211 : static void CheckAssignCompatible (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok);
3212 :
3213 : /*
3214 : CheckBooleanId - Checks to see if the top operand is a boolean.
3215 : If the operand is not a boolean then it is tested
3216 : with true and a boolean is generated.
3217 : The Stack:
3218 :
3219 :
3220 : Entry Exit
3221 : Ptr -> <- Ptr
3222 : +------------+ +------------+
3223 : | Sym | | t | f |
3224 : |------------| |------------|
3225 :
3226 : Quadruples
3227 :
3228 : q If= Sym True _
3229 : q+1 GotoOp _ _ _
3230 : */
3231 :
3232 : static void CheckBooleanId (void);
3233 :
3234 : /*
3235 : PushOne - pushes the value one to the stack.
3236 : The Stack is changed:
3237 :
3238 :
3239 : Entry Exit
3240 : ===== ====
3241 :
3242 : <- Ptr
3243 : +------------+
3244 : Ptr -> | 1 | type |
3245 : |------------|
3246 : */
3247 :
3248 : static void PushOne (unsigned int tok, unsigned int type, const char *message_, unsigned int _message_high);
3249 :
3250 : /*
3251 : PushZero - pushes the value zero to the stack.
3252 : The Stack is changed:
3253 :
3254 :
3255 : Entry Exit
3256 : ===== ====
3257 :
3258 : <- Ptr
3259 : +------------+
3260 : Ptr -> | 0 | type |
3261 : |------------|
3262 : */
3263 :
3264 : static void PushZero (unsigned int tok, unsigned int type);
3265 :
3266 : /*
3267 : ForLoopLastIterator - calculate the last iterator value but avoid setting
3268 : LastIterator twice if it is a constant (in the quads).
3269 : In the ForLoopLastIteratorVariable case only one
3270 : path will be chosen but at the time of quadruple
3271 : generation we do not know the value of BySym.
3272 : */
3273 :
3274 : static void ForLoopLastIterator (unsigned int LastIterator, unsigned int e1, unsigned int e2, unsigned int BySym, unsigned int e1tok, unsigned int e2tok, unsigned int bytok);
3275 :
3276 : /*
3277 : BuildSizeCheckEnd - checks to see whether the function "called" was in fact SIZE.
3278 : If so then we restore quadruple generation.
3279 : */
3280 :
3281 : static void BuildSizeCheckEnd (unsigned int ProcSym);
3282 :
3283 : /*
3284 : BuildRealProcedureCall - builds a real procedure call.
3285 : The Stack:
3286 :
3287 :
3288 : Entry Exit
3289 :
3290 : Ptr ->
3291 : +----------------+
3292 : | NoOfParam |
3293 : |----------------|
3294 : | Param 1 |
3295 : |----------------|
3296 : | Param 2 |
3297 : |----------------|
3298 : . .
3299 : . .
3300 : . .
3301 : |----------------|
3302 : | Param # |
3303 : |----------------|
3304 : | ProcSym | Type | Empty
3305 : |----------------|
3306 : */
3307 :
3308 : static void BuildRealProcedureCall (unsigned int tokno);
3309 :
3310 : /*
3311 : BuildRealFuncProcCall - builds a real procedure or function call.
3312 : The Stack:
3313 :
3314 :
3315 : Entry Exit
3316 :
3317 : Ptr ->
3318 : +----------------+
3319 : | NoOfParam |
3320 : |----------------|
3321 : | Param 1 |
3322 : |----------------|
3323 : | Param 2 |
3324 : |----------------|
3325 : . .
3326 : . .
3327 : . .
3328 : |----------------|
3329 : | Param # |
3330 : |----------------|
3331 : | ProcSym | Type | Empty
3332 : |----------------|
3333 : */
3334 :
3335 : static void BuildRealFuncProcCall (unsigned int tokno, bool IsFunc, bool IsForC, bool ConstExpr);
3336 :
3337 : /*
3338 : CheckProcedureParameters - Checks the parameters which are being passed to
3339 : procedure ProcSym.
3340 :
3341 : The Stack:
3342 :
3343 :
3344 : Entry Exit
3345 :
3346 : Ptr -> <- Ptr
3347 : +----------------+ +----------------+
3348 : | NoOfParam | | NoOfParam |
3349 : |----------------| |----------------|
3350 : | Param 1 | | Param 1 |
3351 : |----------------| |----------------|
3352 : | Param 2 | | Param 2 |
3353 : |----------------| |----------------|
3354 : . . . .
3355 : . . . .
3356 : . . . .
3357 : |----------------| |----------------|
3358 : | Param # | | Param # |
3359 : |----------------| |----------------|
3360 : | ProcSym | Type | | ProcSym | Type |
3361 : |----------------| |----------------|
3362 :
3363 : */
3364 :
3365 : static void CheckProcedureParameters (bool IsForC);
3366 :
3367 : /*
3368 : CheckProcTypeAndProcedure - checks the ProcType with the call.
3369 : */
3370 :
3371 : static void CheckProcTypeAndProcedure (unsigned int tokno, unsigned int ProcType, unsigned int call, unsigned int ParamCheckId);
3372 :
3373 : /*
3374 : IsReallyPointer - returns TRUE is sym is a pointer, address or a type declared
3375 : as a pointer or address.
3376 : */
3377 :
3378 : static bool IsReallyPointer (unsigned int Sym);
3379 :
3380 : /*
3381 : LegalUnboundedParam - returns TRUE if the parameter, Actual, can legitimately be
3382 : passed to ProcSym, i, the, Formal, parameter.
3383 : */
3384 :
3385 : static bool LegalUnboundedParam (unsigned int tokpos, unsigned int ProcSym, unsigned int i, unsigned int ActualType, unsigned int Actual, unsigned int Dimension, unsigned int Formal);
3386 :
3387 : /*
3388 : CheckParameter - checks that types ActualType and FormalType are compatible for parameter
3389 : passing. ProcSym is the procedure and i is the parameter number.
3390 :
3391 : We obey the following rules:
3392 :
3393 : (1) we allow WORD, BYTE, LOC to be compitable with any like sized
3394 : type.
3395 : (2) we allow ADDRESS to be compatible with any pointer type.
3396 : (3) we relax INTEGER and CARDINAL checking for Temporary variables.
3397 :
3398 : Note that type sizes are checked during the code generation pass.
3399 : */
3400 :
3401 : static void CheckParameter (unsigned int tokpos, unsigned int Actual, unsigned int Dimension, unsigned int Formal, unsigned int ProcSym, unsigned int i, Lists_List TypeList, unsigned int ParamCheckId);
3402 :
3403 : /*
3404 : DescribeType - returns a String describing a symbol, Sym, name and its type.
3405 : */
3406 :
3407 : static DynamicStrings_String DescribeType (unsigned int Sym);
3408 :
3409 : /*
3410 : FailParameter - generates an error message indicating that a parameter
3411 : declaration has failed.
3412 :
3413 : The parameters are:
3414 :
3415 : CurrentState - string describing the current failing state.
3416 : Actual - actual parameter.
3417 : ParameterNo - parameter number that has failed.
3418 : ProcedureSym - procedure symbol where parameter has failed.
3419 :
3420 : If any parameter is Nul then it is ignored.
3421 : */
3422 :
3423 : static void FailParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo);
3424 :
3425 : /*
3426 : WarnParameter - generates a warning message indicating that a parameter
3427 : use might cause problems on another target.
3428 :
3429 : CurrentState - string describing the current failing state.
3430 : Actual - actual parameter.
3431 : ParameterNo - parameter number that has failed.
3432 : ProcedureSym - procedure symbol where parameter has failed.
3433 :
3434 : If any parameter is Nul then it is ignored.
3435 : */
3436 :
3437 : static void WarnParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo);
3438 :
3439 : /*
3440 : doIndrX - perform des = *exp with a conversion if necessary.
3441 : */
3442 :
3443 : static void doIndrX (unsigned int tok, unsigned int des, unsigned int exp);
3444 :
3445 : /*
3446 : MakeRightValue - returns a temporary which will have the RightValue of symbol, Sym.
3447 : If Sym is a right value and has type, type, then no quadruples are
3448 : generated and Sym is returned. Otherwise a new temporary is created
3449 : and an IndrX quadruple is generated.
3450 : */
3451 :
3452 : static unsigned int MakeRightValue (unsigned int tok, unsigned int Sym, unsigned int type);
3453 :
3454 : /*
3455 : MakeLeftValue - returns a temporary coresponding to the LeftValue of
3456 : symbol, Sym. No quadruple is generated if Sym is already
3457 : a LeftValue and has the same type.
3458 : */
3459 :
3460 : static unsigned int MakeLeftValue (unsigned int tok, unsigned int Sym, SymbolTable_ModeOfAddr with, unsigned int type);
3461 :
3462 : /*
3463 : ManipulatePseudoCallParameters - manipulates the parameters to a pseudo function or
3464 : procedure. It dereferences all LeftValue parameters
3465 : and Boolean parameters.
3466 : The Stack:
3467 :
3468 :
3469 : Entry Exit
3470 :
3471 : Ptr -> exactly the same
3472 : +----------------+
3473 : | NoOfParameters |
3474 : |----------------|
3475 : | Param 1 |
3476 : |----------------|
3477 : | Param 2 |
3478 : |----------------|
3479 : . .
3480 : . .
3481 : . .
3482 : |----------------|
3483 : | Param # |
3484 : |----------------|
3485 : | ProcSym | Type |
3486 : |----------------|
3487 :
3488 : */
3489 :
3490 : static void ManipulatePseudoCallParameters (void);
3491 :
3492 : /*
3493 : ManipulateParameters - manipulates the procedure parameters in
3494 : preparation for a procedure call.
3495 : Prepares Boolean, Unbounded and VAR parameters.
3496 : The Stack:
3497 :
3498 :
3499 : Entry Exit
3500 :
3501 : Ptr -> exactly the same
3502 : +----------------+
3503 : | NoOfParameters |
3504 : |----------------|
3505 : | Param 1 |
3506 : |----------------|
3507 : | Param 2 |
3508 : |----------------|
3509 : . .
3510 : . .
3511 : . .
3512 : |----------------|
3513 : | Param # |
3514 : |----------------|
3515 : | ProcSym | Type |
3516 : |----------------|
3517 : */
3518 :
3519 : static void ManipulateParameters (bool IsForC);
3520 :
3521 : /*
3522 : CheckParameterOrdinals - check that ordinal values are within type range.
3523 : */
3524 :
3525 : static void CheckParameterOrdinals (void);
3526 :
3527 : /*
3528 : IsSameUnbounded - returns TRUE if unbounded types, t1, and, t2,
3529 : are compatible.
3530 : */
3531 :
3532 : static bool IsSameUnbounded (unsigned int t1, unsigned int t2);
3533 :
3534 : /*
3535 : AssignUnboundedVar - assigns an Unbounded symbol fields,
3536 : ArrayAddress and ArrayHigh, from an array symbol.
3537 : UnboundedSym is not a VAR parameter and therefore
3538 : this procedure can complete both of the fields.
3539 : Sym can be a Variable with type Unbounded.
3540 : Sym can be a Variable with type Array.
3541 : Sym can be a String Constant.
3542 :
3543 : ParamType is the TYPE of the parameter
3544 : */
3545 :
3546 : static void AssignUnboundedVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim);
3547 :
3548 : /*
3549 : AssignUnboundedNonVar - assigns an Unbounded symbol fields,
3550 : The difference between this procedure and
3551 : AssignUnboundedVar is that this procedure cannot
3552 : set the Unbounded.Address since the data from
3553 : Sym will be copied because parameter is NOT a VAR
3554 : parameter.
3555 : UnboundedSym is not a VAR parameter and therefore
3556 : this procedure can only complete the HIGH field
3557 : and not the ADDRESS field.
3558 : Sym can be a Variable with type Unbounded.
3559 : Sym can be a Variable with type Array.
3560 : Sym can be a String Constant.
3561 :
3562 : ParamType is the TYPE of the paramater
3563 : */
3564 :
3565 : static void AssignUnboundedNonVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim);
3566 :
3567 : /*
3568 : GenHigh - generates a HighOp but it checks if op3 is a
3569 : L value and if so it dereferences it. This
3570 : is inefficient, however it is clean and we let the gcc
3571 : backend detect these as common subexpressions.
3572 : It will also detect that a R value -> L value -> R value
3573 : via indirection and eleminate these.
3574 : */
3575 :
3576 : static void GenHigh (unsigned int tok, unsigned int op1, unsigned int op2, unsigned int op3);
3577 :
3578 : /*
3579 : AssignHighField -
3580 : */
3581 :
3582 : static void AssignHighField (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int actuali, unsigned int formali);
3583 :
3584 : /*
3585 : AssignHighFields -
3586 : */
3587 :
3588 : static void AssignHighFields (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim);
3589 :
3590 : /*
3591 : UnboundedNonVarLinkToArray - links an array, ArraySym, to an unbounded
3592 : array, UnboundedSym. The parameter is a
3593 : NON VAR variety.
3594 : */
3595 :
3596 : static void UnboundedNonVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim);
3597 :
3598 : /*
3599 : UnboundedVarLinkToArray - links an array, ArraySym, to an unbounded array,
3600 : UnboundedSym. The parameter is a VAR variety.
3601 : */
3602 :
3603 : static void UnboundedVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim);
3604 :
3605 : /*
3606 : BuildPseudoProcedureCall - builds a pseudo procedure call.
3607 : This procedure does not directly alter the
3608 : stack, but by calling routines the stack
3609 : will change in the following way when this
3610 : procedure returns.
3611 :
3612 : The Stack:
3613 :
3614 :
3615 : Entry Exit
3616 :
3617 : Ptr ->
3618 : +----------------+
3619 : | NoOfParam |
3620 : |----------------|
3621 : | Param 1 |
3622 : |----------------|
3623 : | Param 2 |
3624 : |----------------|
3625 : . .
3626 : . .
3627 : . .
3628 : |----------------|
3629 : | Param # |
3630 : |----------------|
3631 : | ProcSym | Type | Empty
3632 : |----------------|
3633 : */
3634 :
3635 : static void BuildPseudoProcedureCall (unsigned int tokno);
3636 :
3637 : /*
3638 : GetItemPointedTo - returns the symbol type that is being pointed to
3639 : by Sym.
3640 : */
3641 :
3642 : static unsigned int GetItemPointedTo (unsigned int Sym);
3643 :
3644 : /*
3645 : BuildThrowProcedure - builds the pseudo procedure call M2RTS.Throw.
3646 : The Stack:
3647 :
3648 :
3649 : Entry Exit
3650 :
3651 : Ptr ->
3652 : +----------------+
3653 : | NoOfParam |
3654 : |----------------|
3655 : | Param 1 |
3656 : |----------------|
3657 : | Param 2 |
3658 : |----------------|
3659 : . .
3660 : . .
3661 : . .
3662 : |----------------|
3663 : | Param # |
3664 : |----------------|
3665 : | ProcSym | Type | Empty
3666 : |----------------|
3667 : */
3668 :
3669 : static void BuildThrowProcedure (unsigned int functok);
3670 :
3671 : /*
3672 : BuildNewProcedure - builds the pseudo procedure call NEW.
3673 : This procedure is traditionally a "macro" for
3674 : NEW(x, ...) --> ALLOCATE(x, TSIZE(x^, ...))
3675 : One method of implementation is to emulate a "macro"
3676 : processor by pushing the relevant input tokens
3677 : back onto the input stack.
3678 : However this causes two problems:
3679 :
3680 : (i) Unnecessary code is produced for x^
3681 : (ii) SIZE must be imported from SYSTEM
3682 : Therefore we chose an alternative method of
3683 : implementation;
3684 : generate quadruples for ALLOCATE(x, TSIZE(x^, ...))
3685 : this, although slightly more efficient,
3686 : is more complex and circumvents problems (i) and (ii).
3687 :
3688 : The Stack:
3689 :
3690 :
3691 : Entry Exit
3692 :
3693 : Ptr ->
3694 : +----------------+
3695 : | NoOfParam |
3696 : |----------------|
3697 : | Param 1 |
3698 : |----------------|
3699 : | Param 2 |
3700 : |----------------|
3701 : . .
3702 : . .
3703 : . .
3704 : |----------------|
3705 : | Param # |
3706 : |----------------|
3707 : | ProcSym | Type | Empty
3708 : |----------------|
3709 : */
3710 :
3711 : static void BuildNewProcedure (unsigned int functok);
3712 :
3713 : /*
3714 : BuildDisposeProcedure - builds the pseudo procedure call DISPOSE.
3715 : This procedure is traditionally a "macro" for
3716 : DISPOSE(x) --> DEALLOCATE(x, TSIZE(x^))
3717 : One method of implementation is to emulate a "macro"
3718 : processor by pushing the relevant input tokens
3719 : back onto the input stack.
3720 : However this causes two problems:
3721 :
3722 : (i) Unnecessary code is produced for x^
3723 : (ii) TSIZE must be imported from SYSTEM
3724 : Therefore we chose an alternative method of
3725 : implementation;
3726 : generate quadruples for DEALLOCATE(x, TSIZE(x^))
3727 : this, although slightly more efficient,
3728 : is more complex and circumvents problems (i)
3729 : and (ii).
3730 :
3731 : The Stack:
3732 :
3733 :
3734 : Entry Exit
3735 :
3736 : Ptr ->
3737 : +----------------+
3738 : | NoOfParam |
3739 : |----------------|
3740 : | Param 1 |
3741 : |----------------|
3742 : | Param 2 |
3743 : |----------------|
3744 : . .
3745 : . .
3746 : . .
3747 : |----------------|
3748 : | Param # |
3749 : |----------------|
3750 : | ProcSym | Type | Empty
3751 : |----------------|
3752 : */
3753 :
3754 : static void BuildDisposeProcedure (unsigned int functok);
3755 :
3756 : /*
3757 : CheckRangeIncDec - performs des := des <tok> expr
3758 : with range checking (if enabled).
3759 :
3760 : Stack
3761 : Entry Exit
3762 :
3763 : +------------+
3764 : empty | des + expr |
3765 : |------------|
3766 : */
3767 :
3768 : static void CheckRangeIncDec (unsigned int tokenpos, unsigned int des, unsigned int expr, NameKey_Name tok);
3769 :
3770 : /*
3771 : BuildIncProcedure - builds the pseudo procedure call INC.
3772 : INC is a procedure which increments a variable.
3773 : It takes one or two parameters:
3774 : INC(a, b) or INC(a)
3775 : a := a+b or a := a+1
3776 :
3777 : The Stack:
3778 :
3779 :
3780 : Entry Exit
3781 :
3782 : Ptr ->
3783 : +----------------+
3784 : | NoOfParam |
3785 : |----------------|
3786 : | Param 1 |
3787 : |----------------|
3788 : | Param 2 |
3789 : |----------------|
3790 : . .
3791 : . .
3792 : . .
3793 : |----------------|
3794 : | Param # |
3795 : |----------------|
3796 : | ProcSym | Type | Empty
3797 : |----------------|
3798 : */
3799 :
3800 : static void BuildIncProcedure (unsigned int proctok);
3801 :
3802 : /*
3803 : BuildDecProcedure - builds the pseudo procedure call DEC.
3804 : DEC is a procedure which decrements a variable.
3805 : It takes one or two parameters:
3806 : DEC(a, b) or DEC(a)
3807 : a := a-b or a := a-1
3808 :
3809 : The Stack:
3810 :
3811 :
3812 : Entry Exit
3813 :
3814 : Ptr ->
3815 : +----------------+
3816 : | NoOfParam |
3817 : |----------------|
3818 : | Param 1 |
3819 : |----------------|
3820 : | Param 2 |
3821 : |----------------|
3822 : . .
3823 : . .
3824 : . .
3825 : |----------------|
3826 : | Param # |
3827 : |----------------|
3828 : | ProcSym | Type | Empty
3829 : |----------------|
3830 : */
3831 :
3832 : static void BuildDecProcedure (unsigned int proctok);
3833 :
3834 : /*
3835 : DereferenceLValue - checks to see whether, operand, is declare as an LValue
3836 : and if so it dereferences it.
3837 : */
3838 :
3839 : static unsigned int DereferenceLValue (unsigned int tok, unsigned int operand);
3840 :
3841 : /*
3842 : BuildInclProcedure - builds the pseudo procedure call INCL.
3843 : INCL is a procedure which adds bit b into a BITSET a.
3844 : It takes two parameters:
3845 : INCL(a, b)
3846 :
3847 : a := a + {b}
3848 :
3849 : The Stack:
3850 :
3851 :
3852 : Entry Exit
3853 :
3854 : Ptr ->
3855 : +----------------+
3856 : | NoOfParam |
3857 : |----------------|
3858 : | Param 1 |
3859 : |----------------|
3860 : | Param 2 |
3861 : |----------------|
3862 : | ProcSym | Type | Empty
3863 : |----------------|
3864 : */
3865 :
3866 : static void BuildInclProcedure (unsigned int proctok);
3867 :
3868 : /*
3869 : BuildExclProcedure - builds the pseudo procedure call EXCL.
3870 : INCL is a procedure which removes bit b from SET a.
3871 : It takes two parameters:
3872 : EXCL(a, b)
3873 :
3874 : a := a - {b}
3875 :
3876 : The Stack:
3877 :
3878 :
3879 : Entry Exit
3880 :
3881 : Ptr ->
3882 : +----------------+
3883 : | NoOfParam |
3884 : |----------------|
3885 : | Param 1 |
3886 : |----------------|
3887 : | Param 2 |
3888 : |----------------|
3889 : | ProcSym | Type | Empty
3890 : |----------------|
3891 : */
3892 :
3893 : static void BuildExclProcedure (unsigned int proctok);
3894 :
3895 : /*
3896 : BuildTypeCoercion - builds the type coersion.
3897 : Modula-2 allows types to be coersed with no runtime
3898 : penility.
3899 : It insists that the TSIZE(t1)=TSIZE(t2) where
3900 : t2 variable := t2(variable of type t1).
3901 : The ReturnVar on the stack is of type t2.
3902 :
3903 : The Stack:
3904 :
3905 :
3906 : Entry Exit
3907 :
3908 : Ptr ->
3909 : +----------------+
3910 : | NoOfParam |
3911 : |----------------|
3912 : | Param 1 |
3913 : |----------------|
3914 : | Param 2 |
3915 : |----------------|
3916 : . .
3917 : . .
3918 : . .
3919 : |----------------|
3920 : | Param # | <- Ptr
3921 : |----------------| +------------+
3922 : | ProcSym | Type | | ReturnVar |
3923 : |----------------| |------------|
3924 :
3925 : Quadruples:
3926 :
3927 : CoerceOp ReturnVar Type Param1
3928 :
3929 : A type coercion will only be legal if the different
3930 : types have exactly the same size.
3931 : Since we can only decide this after M2Eval has processed
3932 : the symbol table then we create a quadruple explaining
3933 : the coercion taking place, the code generator can test
3934 : this assertion and report an error if the type sizes
3935 : differ.
3936 : */
3937 :
3938 : static void BuildTypeCoercion (bool ConstExpr);
3939 :
3940 : /*
3941 : BuildRealFunctionCall - builds a function call.
3942 : The Stack:
3943 :
3944 :
3945 : Entry Exit
3946 :
3947 : Ptr ->
3948 : +----------------+
3949 : | NoOfParam |
3950 : |----------------|
3951 : | Param 1 |
3952 : |----------------|
3953 : | Param 2 |
3954 : |----------------|
3955 : . .
3956 : . .
3957 : . .
3958 : |----------------|
3959 : | Param # | <- Ptr
3960 : |----------------| +------------+
3961 : | ProcSym | Type | | ReturnVar |
3962 : |----------------| |------------|
3963 : */
3964 :
3965 : static void BuildRealFunctionCall (unsigned int tokno, bool ConstExpr);
3966 :
3967 : /*
3968 : BuildPseudoFunctionCall - builds the pseudo function
3969 : The Stack:
3970 :
3971 :
3972 : Entry Exit
3973 :
3974 : Ptr ->
3975 : +----------------+
3976 : | NoOfParam |
3977 : |----------------|
3978 : | Param 1 |
3979 : |----------------|
3980 : | Param 2 |
3981 : |----------------|
3982 : . .
3983 : . .
3984 : . .
3985 : |----------------|
3986 : | Param # | <- Ptr
3987 : |----------------| +------------+
3988 : | ProcSym | Type | | ReturnVar |
3989 : |----------------| |------------|
3990 :
3991 : */
3992 :
3993 : static void BuildPseudoFunctionCall (bool ConstExpr);
3994 :
3995 : /*
3996 : BuildAddAdrFunction - builds the pseudo procedure call ADDADR.
3997 :
3998 : PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
3999 :
4000 : Which returns address given by (addr + offset),
4001 : [ the standard says that it _may_
4002 : "raise an exception if this address is not valid."
4003 : currently we do not generate any exception code ]
4004 :
4005 : The Stack:
4006 :
4007 : Entry Exit
4008 :
4009 : Ptr ->
4010 : +----------------+
4011 : | NoOfParam |
4012 : |----------------|
4013 : | Param 1 |
4014 : |----------------|
4015 : | Param 2 | <- Ptr
4016 : |----------------| +------------+
4017 : | ProcSym | Type | | ReturnVar |
4018 : |----------------| |------------|
4019 : */
4020 :
4021 : static void BuildAddAdrFunction (unsigned int ProcSym, bool ConstExpr);
4022 :
4023 : /*
4024 : BuildSubAdrFunction - builds the pseudo procedure call ADDADR.
4025 :
4026 : PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
4027 :
4028 : Which returns address given by (addr - offset),
4029 : [ the standard says that it _may_
4030 : "raise an exception if this address is not valid."
4031 : currently we do not generate any exception code ]
4032 :
4033 : The Stack:
4034 :
4035 : Entry Exit
4036 :
4037 : Ptr ->
4038 : +----------------+
4039 : | NoOfParam |
4040 : |----------------|
4041 : | Param 1 |
4042 : |----------------|
4043 : | Param 2 | <- Ptr
4044 : |----------------| +------------+
4045 : | ProcSym | Type | | ReturnVar |
4046 : |----------------| |------------|
4047 : */
4048 :
4049 : static void BuildSubAdrFunction (unsigned int ProcSym, bool ConstExpr);
4050 :
4051 : /*
4052 : BuildDifAdrFunction - builds the pseudo procedure call DIFADR.
4053 :
4054 : PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER ;
4055 :
4056 : Which returns address given by (addr1 - addr2),
4057 : [ the standard says that it _may_
4058 : "raise an exception if this address is invalid or
4059 : address space is non-contiguous."
4060 : currently we do not generate any exception code ]
4061 :
4062 : The Stack:
4063 :
4064 : Entry Exit
4065 :
4066 : Ptr ->
4067 : +----------------+
4068 : | NoOfParam |
4069 : |----------------|
4070 : | Param 1 |
4071 : |----------------|
4072 : | Param 2 | <- Ptr
4073 : |----------------| +------------+
4074 : | ProcSym | Type | | ReturnVar |
4075 : |----------------| |------------|
4076 : */
4077 :
4078 : static void BuildDifAdrFunction (unsigned int ProcSym, bool ConstExpr);
4079 :
4080 : /*
4081 : BuildHighFunction - checks the stack in preparation for generating
4082 : quadruples which perform HIGH.
4083 : This procedure does not alter the stack but
4084 : determines whether, a, in HIGH(a) is an ArraySym
4085 : or UnboundedSym.
4086 : Both cases are different and appropriate quadruple
4087 : generating routines are called.
4088 :
4089 : The Stack:
4090 :
4091 :
4092 : Entry Exit
4093 :
4094 : Ptr ->
4095 : +----------------+
4096 : | NoOfParam |
4097 : |----------------|
4098 : | Param 1 |
4099 : |----------------|
4100 : | Param 2 |
4101 : |----------------|
4102 : . .
4103 : . .
4104 : . .
4105 : |----------------|
4106 : | Param # | <- Ptr
4107 : |----------------| +------------+
4108 : | ProcSym | Type | | ReturnVar |
4109 : |----------------| |------------|
4110 :
4111 : */
4112 :
4113 : static void BuildHighFunction (void);
4114 :
4115 : /*
4116 : BuildConstHighFromSym - builds the pseudo function HIGH from an Sym.
4117 : Sym is a constant or an array which has constant bounds
4118 : and therefore it can be calculated at compile time.
4119 :
4120 : The Stack:
4121 :
4122 :
4123 : Entry Exit
4124 :
4125 : Ptr ->
4126 : +----------------+
4127 : | NoOfParam |
4128 : |----------------|
4129 : | Param 1 |
4130 : |----------------|
4131 : | Param 2 |
4132 : |----------------|
4133 : . .
4134 : . .
4135 : . .
4136 : |----------------|
4137 : | Param # | <- Ptr
4138 : |----------------| +------------+
4139 : | ProcSym | Type | | ReturnVar |
4140 : |----------------| |------------|
4141 : */
4142 :
4143 : static void BuildConstHighFromSym (unsigned int tok);
4144 :
4145 : /*
4146 : BuildHighFromUnbounded - builds the pseudo function HIGH from an
4147 : UnboundedSym.
4148 :
4149 : The Stack:
4150 :
4151 :
4152 : Entry Exit
4153 :
4154 : Ptr ->
4155 : +----------------+
4156 : | NoOfParam |
4157 : |----------------|
4158 : | Param # | <- Ptr
4159 : |----------------| +------------+
4160 : | ProcSym | Type | | ReturnVar |
4161 : |----------------| |------------|
4162 :
4163 : */
4164 :
4165 : static void BuildHighFromUnbounded (unsigned int tok);
4166 :
4167 : /*
4168 : GetQualidentImport - returns the symbol as if it were qualified from, module.n.
4169 : This is used to reference runtime support procedures and an
4170 : error is generated if the symbol cannot be obtained.
4171 : */
4172 :
4173 : static unsigned int GetQualidentImport (unsigned int tokno, NameKey_Name n, NameKey_Name module);
4174 :
4175 : /*
4176 : ConstExprError - return TRUE if a constant expression is being built and Var is a variable.
4177 : */
4178 :
4179 : static bool ConstExprError (unsigned int Func, unsigned int Var, unsigned int optok, bool ConstExpr);
4180 :
4181 : /*
4182 : DeferMakeLengthConst - creates a constant which contains the length of string, sym.
4183 : */
4184 :
4185 : static unsigned int DeferMakeLengthConst (unsigned int tok, unsigned int sym);
4186 :
4187 : /*
4188 : BuildLengthFunction - builds the inline standard function LENGTH.
4189 :
4190 : The Stack:
4191 :
4192 :
4193 : Entry Exit
4194 :
4195 : Ptr ->
4196 : +----------------+
4197 : | NoOfParam |
4198 : |----------------|
4199 : | Param 1 | <- Ptr
4200 : |----------------| +------------+
4201 : | ProcSym | Type | | ReturnVar |
4202 : |----------------| |------------|
4203 :
4204 : */
4205 :
4206 : static void BuildLengthFunction (unsigned int Function, bool ConstExpr);
4207 :
4208 : /*
4209 : BuildOddFunction - builds the pseudo procedure call ODD.
4210 : This procedure is actually a "macro" for
4211 : ORD(x) --> VAL(BOOLEAN, x MOD 2)
4212 : However we cannot push tokens back onto the input stack
4213 : because the compiler is currently building a function
4214 : call and expecting a ReturnVar on the stack.
4215 : Hence we manipulate the stack and call
4216 : BuildConvertFunction.
4217 :
4218 : The Stack:
4219 :
4220 :
4221 : Entry Exit
4222 :
4223 : Ptr ->
4224 : +----------------+
4225 : | NoOfParam |
4226 : |----------------|
4227 : | Param 1 |
4228 : |----------------|
4229 : | Param 2 |
4230 : |----------------|
4231 : . .
4232 : . .
4233 : . .
4234 : |----------------|
4235 : | Param # |
4236 : |----------------|
4237 : | ProcSym | Type | Empty
4238 : |----------------|
4239 : */
4240 :
4241 : static void BuildOddFunction (unsigned int ProcSym, bool ConstExpr);
4242 :
4243 : /*
4244 : BuildAbsFunction - builds a call to the standard function ABS.
4245 :
4246 : We cannot implement it as a macro or inline an
4247 : IF THEN statement as the IF THEN ELSE requires
4248 : we write the value to the same variable (or constant)
4249 : twice. The macro implementation will fail as
4250 : the compiler maybe building a function
4251 : call and expecting a ReturnVar on the stack.
4252 : The only method to implement this is to pass it to the
4253 : gcc backend.
4254 :
4255 : The Stack:
4256 :
4257 :
4258 : Entry Exit
4259 :
4260 : Ptr ->
4261 : +----------------+
4262 : | NoOfParam |
4263 : |----------------|
4264 : | Param 1 |
4265 : |----------------|
4266 : | Param 2 |
4267 : |----------------|
4268 : . .
4269 : . .
4270 : . .
4271 : |----------------|
4272 : | Param # |
4273 : |----------------|
4274 : | ProcSym | Type | Empty
4275 : |----------------|
4276 : */
4277 :
4278 : static void BuildAbsFunction (unsigned int ProcSym, bool ConstExpr);
4279 :
4280 : /*
4281 : BuildCapFunction - builds the pseudo procedure call CAP.
4282 : We generate a the following quad:
4283 :
4284 :
4285 : StandardFunctionOp ReturnVal Cap Param1
4286 :
4287 : The Stack:
4288 :
4289 :
4290 : Entry Exit
4291 :
4292 : Ptr ->
4293 : +----------------+
4294 : | NoOfParam = 1 |
4295 : |----------------|
4296 : | Param 1 |
4297 : |----------------| +-------------+
4298 : | ProcSym | Type | | ReturnVal |
4299 : |----------------| |-------------|
4300 : */
4301 :
4302 : static void BuildCapFunction (unsigned int ProcSym, bool ConstExpr);
4303 :
4304 : /*
4305 : BuildChrFunction - builds the pseudo procedure call CHR.
4306 : This procedure is actually a "macro" for
4307 : CHR(x) --> CONVERT(CHAR, x)
4308 : However we cannot push tokens back onto the input stack
4309 : because the compiler is currently building a function
4310 : call and expecting a ReturnVar on the stack.
4311 : Hence we manipulate the stack and call
4312 : BuildConvertFunction.
4313 :
4314 : The Stack:
4315 :
4316 :
4317 : Entry Exit
4318 :
4319 : Ptr ->
4320 : +----------------+
4321 : | NoOfParam |
4322 : |----------------|
4323 : | Param 1 |
4324 : |----------------|
4325 : | Param 2 |
4326 : |----------------|
4327 : . .
4328 : . .
4329 : . .
4330 : |----------------|
4331 : | Param # |
4332 : |----------------|
4333 : | ProcSym | Type | Empty
4334 : |----------------|
4335 : */
4336 :
4337 : static void BuildChrFunction (unsigned int ProcSym, bool ConstExpr);
4338 :
4339 : /*
4340 : BuildOrdFunction - builds the pseudo procedure call ORD.
4341 : This procedure is actually a "macro" for
4342 : ORD(x) --> CONVERT(GetSType(sym), x)
4343 : However we cannot push tokens back onto the input stack
4344 : because the compiler is currently building a function
4345 : call and expecting a ReturnVar on the stack.
4346 : Hence we manipulate the stack and call
4347 : BuildConvertFunction.
4348 :
4349 : The Stack:
4350 :
4351 :
4352 : Entry Exit
4353 :
4354 : Ptr ->
4355 : +----------------+
4356 : | NoOfParam |
4357 : |----------------|
4358 : | Param 1 |
4359 : |----------------|
4360 : | Param 2 |
4361 : |----------------|
4362 : . .
4363 : . .
4364 : . .
4365 : |----------------|
4366 : | Param # |
4367 : |----------------|
4368 : | ProcSym | Type | Empty
4369 : |----------------|
4370 : */
4371 :
4372 : static void BuildOrdFunction (unsigned int Sym, bool ConstExpr);
4373 :
4374 : /*
4375 : BuildIntFunction - builds the pseudo procedure call INT.
4376 : This procedure is actually a "macro" for
4377 : INT(x) --> CONVERT(INTEGER, x)
4378 : However we cannot push tokens back onto the input stack
4379 : because the compiler is currently building a function
4380 : call and expecting a ReturnVar on the stack.
4381 : Hence we manipulate the stack and call
4382 : BuildConvertFunction.
4383 :
4384 : The Stack:
4385 :
4386 :
4387 : Entry Exit
4388 :
4389 : Ptr ->
4390 : +----------------+
4391 : | NoOfParam |
4392 : |----------------|
4393 : | Param 1 |
4394 : |----------------|
4395 : | Param 2 |
4396 : |----------------|
4397 : . .
4398 : . .
4399 : . .
4400 : |----------------|
4401 : | Param # |
4402 : |----------------|
4403 : | ProcSym | Type | Empty
4404 : |----------------|
4405 : */
4406 :
4407 : static void BuildIntFunction (unsigned int Sym, bool ConstExpr);
4408 :
4409 : /*
4410 : BuildMakeAdrFunction - builds the pseudo procedure call MAKEADR.
4411 :
4412 : The Stack:
4413 :
4414 :
4415 : Entry Exit
4416 :
4417 : Ptr ->
4418 : +----------------+
4419 : | NoOfParam |
4420 : |----------------|
4421 : | Param 1 |
4422 : |----------------|
4423 : | Param 2 |
4424 : |----------------|
4425 : . .
4426 : . .
4427 : . .
4428 : |----------------|
4429 : | Param # |
4430 : |----------------|
4431 : | ProcSym | Type | Empty
4432 : |----------------|
4433 : */
4434 :
4435 : static void BuildMakeAdrFunction (void);
4436 :
4437 : /*
4438 : BuildShiftFunction - builds the pseudo procedure call SHIFT.
4439 :
4440 : PROCEDURE SHIFT (val: <any type>;
4441 : num: INTEGER): <any type> ;
4442 :
4443 : "Returns a bit sequence obtained from val by
4444 : shifting up or down (left or right) by the
4445 : absolute value of num, introducing
4446 : zeros as necessary. The direction is down if
4447 : the sign of num is negative, otherwise the
4448 : direction is up."
4449 :
4450 : The Stack:
4451 :
4452 : Entry Exit
4453 :
4454 : Ptr ->
4455 : +----------------+
4456 : | NoOfParam |
4457 : |----------------|
4458 : | Param 1 |
4459 : |----------------|
4460 : | Param 2 | <- Ptr
4461 : |----------------| +------------+
4462 : | ProcSym | Type | | ReturnVar |
4463 : |----------------| |------------|
4464 : */
4465 :
4466 : static void BuildShiftFunction (void);
4467 :
4468 : /*
4469 : BuildRotateFunction - builds the pseudo procedure call ROTATE.
4470 :
4471 : PROCEDURE ROTATE (val: <any type>;
4472 : num: INTEGER): <any type> ;
4473 :
4474 : "Returns a bit sequence obtained from val
4475 : by rotating up or down (left or right) by
4476 : the absolute value of num. The direction is
4477 : down if the sign of num is negative, otherwise
4478 : the direction is up."
4479 :
4480 : The Stack:
4481 :
4482 : Entry Exit
4483 :
4484 : Ptr ->
4485 : +----------------+
4486 : | NoOfParam |
4487 : |----------------|
4488 : | Param 1 |
4489 : |----------------|
4490 : | Param 2 | <- Ptr
4491 : |----------------| +------------+
4492 : | ProcSym | Type | | ReturnVar |
4493 : |----------------| |------------|
4494 : */
4495 :
4496 : static void BuildRotateFunction (void);
4497 :
4498 : /*
4499 : BuildValFunction - builds the pseudo procedure call VAL.
4500 : This procedure is actually a "macro" for
4501 : VAL(Type, x) --> CONVERT(Type, x)
4502 : However we cannot push tokens back onto the input stack
4503 : because the compiler is currently building a function
4504 : call and expecting a ReturnVar on the stack.
4505 : Hence we manipulate the stack and call
4506 : BuildConvertFunction.
4507 :
4508 : The Stack:
4509 :
4510 :
4511 : Entry Exit
4512 :
4513 : Ptr ->
4514 : +----------------+
4515 : | NoOfParam |
4516 : |----------------|
4517 : | Param 1 |
4518 : |----------------|
4519 : | Param 2 |
4520 : |----------------|
4521 : . .
4522 : . .
4523 : . .
4524 : |----------------|
4525 : | Param # |
4526 : |----------------|
4527 : | ProcSym | Type | Empty
4528 : |----------------|
4529 : */
4530 :
4531 : static void BuildValFunction (unsigned int ProcSym, bool ConstExpr);
4532 :
4533 : /*
4534 : BuildCastFunction - builds the pseudo procedure call CAST.
4535 : This procedure is actually a "macro" for
4536 : CAST(Type, x) --> Type(x)
4537 : However we cannot push tokens back onto the input stack
4538 : because the compiler is currently building a function
4539 : call and expecting a ReturnVar on the stack.
4540 : Hence we manipulate the stack and call
4541 : BuildConvertFunction.
4542 :
4543 : The Stack:
4544 :
4545 :
4546 : Entry Exit
4547 :
4548 : Ptr ->
4549 : +----------------+
4550 : | NoOfParam |
4551 : |----------------|
4552 : | Param 1 |
4553 : |----------------|
4554 : | Param 2 |
4555 : |----------------|
4556 : . .
4557 : . .
4558 : . .
4559 : |----------------|
4560 : | Param # |
4561 : |----------------|
4562 : | ProcSym | Type | Empty
4563 : |----------------|
4564 : */
4565 :
4566 : static void BuildCastFunction (unsigned int ProcSym, bool ConstExpr);
4567 :
4568 : /*
4569 : BuildConvertFunction - builds the pseudo function CONVERT.
4570 : CONVERT( Type, Variable ) ;
4571 :
4572 : The Stack:
4573 :
4574 :
4575 : Entry Exit
4576 :
4577 : Ptr ->
4578 : +----------------+
4579 : | NoOfParam |
4580 : |----------------|
4581 : | Param 1 |
4582 : |----------------|
4583 : | Param 2 |
4584 : |----------------|
4585 : . .
4586 : . .
4587 : . .
4588 : |----------------|
4589 : | Param # | <- Ptr
4590 : |----------------| +---------------------+
4591 : | ProcSym | Type | | ReturnVar | Param1 |
4592 : |----------------| |---------------------|
4593 :
4594 : Quadruples:
4595 :
4596 : ConvertOp ReturnVar Param1 Param2
4597 :
4598 : Converts variable Param2 into a variable Param1
4599 : with a type Param1.
4600 : */
4601 :
4602 : static void BuildConvertFunction (unsigned int ProcSym, bool ConstExpr);
4603 :
4604 : /*
4605 : CheckBaseTypeValue - checks to see whether the value, min, really exists.
4606 : */
4607 :
4608 : static unsigned int CheckBaseTypeValue (unsigned int tok, unsigned int type, unsigned int min, unsigned int func);
4609 :
4610 : /*
4611 : GetTypeMin - returns the minimium value of type and generate an error
4612 : if this is unavailable.
4613 : */
4614 :
4615 : static unsigned int GetTypeMin (unsigned int tok, unsigned int func, unsigned int type);
4616 :
4617 : /*
4618 : GetTypeMinLower - obtain the maximum value for type.
4619 : */
4620 :
4621 : static unsigned int GetTypeMinLower (unsigned int tok, unsigned int func, unsigned int type);
4622 :
4623 : /*
4624 : GetTypeMax - returns the maximum value of type and generate an error
4625 : if this is unavailable.
4626 : */
4627 :
4628 : static unsigned int GetTypeMax (unsigned int tok, unsigned int func, unsigned int type);
4629 :
4630 : /*
4631 : GetTypeMaxLower - obtain the maximum value for type.
4632 : */
4633 :
4634 : static unsigned int GetTypeMaxLower (unsigned int tok, unsigned int func, unsigned int type);
4635 :
4636 : /*
4637 : BuildMinFunction - builds the pseudo function call Min.
4638 :
4639 : The Stack:
4640 :
4641 : Entry Exit
4642 :
4643 : Ptr ->
4644 : +----------------+
4645 : | NoOfParam=1 |
4646 : |----------------|
4647 : | Param 1 |
4648 : |----------------|
4649 : | ProcSym | Type | Empty
4650 : |----------------|
4651 : */
4652 :
4653 : static void BuildMinFunction (void);
4654 :
4655 : /*
4656 : BuildMaxFunction - builds the pseudo function call Max.
4657 :
4658 : The Stack:
4659 :
4660 : Entry Exit
4661 :
4662 : Ptr ->
4663 : +----------------+
4664 : | NoOfParam=1 |
4665 : |----------------|
4666 : | Param 1 |
4667 : |----------------|
4668 : | ProcSym | Type | Empty
4669 : |----------------|
4670 : */
4671 :
4672 : static void BuildMaxFunction (void);
4673 :
4674 : /*
4675 : BuildTruncFunction - builds the pseudo procedure call TRUNC.
4676 : This procedure is actually a "macro" for
4677 : TRUNC(x) --> CONVERT(INTEGER, x)
4678 : However we cannot push tokens back onto the input stack
4679 : because the compiler is currently building a function
4680 : call and expecting a ReturnVar on the stack.
4681 : Hence we manipulate the stack and call
4682 : BuildConvertFunction.
4683 :
4684 : The Stack:
4685 :
4686 :
4687 : Entry Exit
4688 :
4689 : Ptr ->
4690 : +----------------+
4691 : | NoOfParam |
4692 : |----------------|
4693 : | Param 1 |
4694 : |----------------|
4695 : | Param 2 |
4696 : |----------------|
4697 : . .
4698 : . .
4699 : . .
4700 : |----------------|
4701 : | Param # |
4702 : |----------------|
4703 : | ProcSym | Type | Empty
4704 : |----------------|
4705 : */
4706 :
4707 : static void BuildTruncFunction (unsigned int Sym, bool ConstExpr);
4708 :
4709 : /*
4710 : BuildFloatFunction - builds the pseudo procedure call FLOAT.
4711 : This procedure is actually a "macro" for
4712 : FLOAT(x) --> CONVERT(REAL, x)
4713 : However we cannot push tokens back onto the input stack
4714 : because the compiler is currently building a function
4715 : call and expecting a ReturnVar on the stack.
4716 : Hence we manipulate the stack and call
4717 : BuildConvertFunction.
4718 :
4719 : The Stack:
4720 :
4721 :
4722 : Entry Exit
4723 :
4724 : Ptr ->
4725 : +----------------+
4726 : | NoOfParam |
4727 : |----------------|
4728 : | Param 1 |
4729 : |----------------|
4730 : | Param 2 |
4731 : |----------------|
4732 : . .
4733 : . .
4734 : . .
4735 : |----------------|
4736 : | Param # |
4737 : |----------------|
4738 : | ProcSym | Type | Empty
4739 : |----------------|
4740 : */
4741 :
4742 : static void BuildFloatFunction (unsigned int Sym, bool ConstExpr);
4743 :
4744 : /*
4745 : BuildReFunction - builds the pseudo procedure call RE.
4746 :
4747 : The Stack:
4748 :
4749 :
4750 : Entry Exit
4751 :
4752 : Ptr ->
4753 : +----------------+
4754 : | NoOfParam |
4755 : |----------------|
4756 : | Param 1 |
4757 : |----------------|
4758 : | Param 2 |
4759 : |----------------|
4760 : . .
4761 : . .
4762 : . .
4763 : |----------------|
4764 : | Param # |
4765 : |----------------|
4766 : | ProcSym | Type | Empty
4767 : |----------------|
4768 : */
4769 :
4770 : static void BuildReFunction (unsigned int Sym, bool ConstExpr);
4771 :
4772 : /*
4773 : BuildImFunction - builds the pseudo procedure call IM.
4774 :
4775 : The Stack:
4776 :
4777 :
4778 : Entry Exit
4779 :
4780 : Ptr ->
4781 : +----------------+
4782 : | NoOfParam |
4783 : |----------------|
4784 : | Param 1 |
4785 : |----------------|
4786 : | Param 2 |
4787 : |----------------|
4788 : . .
4789 : . .
4790 : . .
4791 : |----------------|
4792 : | Param # |
4793 : |----------------|
4794 : | ProcSym | Type | Empty
4795 : |----------------|
4796 : */
4797 :
4798 : static void BuildImFunction (unsigned int Sym, bool ConstExpr);
4799 :
4800 : /*
4801 : BuildCmplxFunction - builds the pseudo procedure call CMPLX.
4802 :
4803 : The Stack:
4804 :
4805 :
4806 : Entry Exit
4807 :
4808 : Ptr ->
4809 : +----------------+
4810 : | NoOfParam |
4811 : |----------------|
4812 : | Param 1 |
4813 : |----------------|
4814 : | Param 2 |
4815 : |----------------|
4816 : . .
4817 : . .
4818 : . .
4819 : |----------------|
4820 : | Param # |
4821 : |----------------|
4822 : | ProcSym | Type | Empty
4823 : |----------------|
4824 : */
4825 :
4826 : static void BuildCmplxFunction (unsigned int func, bool ConstExpr);
4827 :
4828 : /*
4829 : BuildAdrFunction - builds the pseudo function ADR
4830 : The Stack:
4831 :
4832 :
4833 : Entry Exit
4834 :
4835 : Ptr ->
4836 : +----------------+
4837 : | NoOfParam |
4838 : |----------------|
4839 : | Param 1 |
4840 : |----------------|
4841 : | Param 2 |
4842 : |----------------|
4843 : . .
4844 : . .
4845 : . .
4846 : |----------------|
4847 : | Param # | <- Ptr
4848 : |----------------| +------------+
4849 : | ProcSym | Type | | ReturnVar |
4850 : |----------------| |------------|
4851 :
4852 : */
4853 :
4854 : static void BuildAdrFunction (void);
4855 :
4856 : /*
4857 : BuildSizeFunction - builds the pseudo function SIZE
4858 : The Stack:
4859 :
4860 :
4861 : Entry Exit
4862 :
4863 : Ptr ->
4864 : +----------------+
4865 : | NoOfParam |
4866 : |----------------|
4867 : | Param 1 |
4868 : |----------------|
4869 : | Param 2 |
4870 : |----------------|
4871 : . .
4872 : . .
4873 : . .
4874 : |----------------|
4875 : | Param # | <- Ptr
4876 : |----------------| +------------+
4877 : | ProcSym | Type | | ReturnVar |
4878 : |----------------| |------------|
4879 : */
4880 :
4881 : static void BuildSizeFunction (void);
4882 :
4883 : /*
4884 : BuildTSizeFunction - builds the pseudo function TSIZE
4885 : The Stack:
4886 :
4887 :
4888 : Entry Exit
4889 :
4890 : Ptr ->
4891 : +----------------+
4892 : | NoOfParam |
4893 : |----------------|
4894 : | Param 1 |
4895 : |----------------|
4896 : | Param 2 |
4897 : |----------------|
4898 : . .
4899 : . .
4900 : . .
4901 : |----------------|
4902 : | Param # | <- Ptr
4903 : |----------------| +------------+
4904 : | ProcSym | Type | | ReturnVar |
4905 : |----------------| |------------|
4906 :
4907 : */
4908 :
4909 : static void BuildTSizeFunction (void);
4910 :
4911 : /*
4912 : BuildTBitSizeFunction - builds the pseudo function TBITSIZE
4913 : The Stack:
4914 :
4915 :
4916 : Entry Exit
4917 :
4918 : Ptr ->
4919 : +----------------+
4920 : | NoOfParam |
4921 : |----------------|
4922 : | Param 1 |
4923 : |----------------|
4924 : | Param 2 |
4925 : |----------------|
4926 : . .
4927 : . .
4928 : . .
4929 : |----------------|
4930 : | Param # | <- Ptr
4931 : |----------------| +------------+
4932 : | ProcSym | Type | | ReturnVar |
4933 : |----------------| |------------|
4934 :
4935 : */
4936 :
4937 : static void BuildTBitSizeFunction (void);
4938 :
4939 : /*
4940 : ExpectingParameterType -
4941 : */
4942 :
4943 : static void ExpectingParameterType (unsigned int BlockSym, unsigned int Type);
4944 :
4945 : /*
4946 : ExpectingVariableType -
4947 : */
4948 :
4949 : static void ExpectingVariableType (unsigned int BlockSym, unsigned int Type);
4950 :
4951 : /*
4952 : CheckVariablesAndParameterTypesInBlock - checks to make sure that block, BlockSym, has
4953 : parameters types and variable types which are legal.
4954 : */
4955 :
4956 : static void CheckVariablesAndParameterTypesInBlock (unsigned int BlockSym);
4957 :
4958 : /*
4959 : IsNeverAltered - returns TRUE if variable, sym, is never altered
4960 : between quadruples: Start..End
4961 : */
4962 :
4963 : static bool IsNeverAltered (unsigned int sym, unsigned int Start, unsigned int End);
4964 :
4965 : /*
4966 : IsConditionVariable - returns TRUE if the condition at quadruple, q, is variable.
4967 : */
4968 :
4969 : static bool IsConditionVariable (unsigned int q, unsigned int Start, unsigned int End);
4970 :
4971 : /*
4972 : IsInfiniteLoop - returns TRUE if an infinite loop is found.
4973 : Given a backwards jump at, End, it returns a BOOLEAN which depends on
4974 : whether a jump is found to jump beyond, End. If a conditonal jump is found
4975 : to pass over, End, the condition is tested for global variables, procedure variables and
4976 : constants.
4977 :
4978 : constant - ignored
4979 : variables - tested to see whether they are altered inside the loop
4980 : global variable - the procedure tests to see whether it is altered as above
4981 : but will also test to see whether this loop calls a procedure
4982 : in which case it believes the loop NOT to be infinite
4983 : (as this procedure call might alter the global variable)
4984 :
4985 : Note that this procedure can easily be fooled by the user altering variables
4986 : with pointers.
4987 : */
4988 :
4989 : static bool IsInfiniteLoop (unsigned int End);
4990 :
4991 : /*
4992 : CheckVariablesInBlock - given a block, BlockSym, check whether all variables are used.
4993 : */
4994 :
4995 : static void CheckVariablesInBlock (unsigned int BlockSym);
4996 :
4997 : /*
4998 : CheckFunctionReturn - checks to see that a RETURN statement was present in a function.
4999 : */
5000 :
5001 : static void CheckFunctionReturn (unsigned int ProcSym);
5002 :
5003 : /*
5004 : CheckReturnType - checks to see that the return type from currentProc is
5005 : assignment compatible with actualType.
5006 : */
5007 :
5008 : static void CheckReturnType (unsigned int tokno, unsigned int currentProc, unsigned int actualVal, unsigned int actualType);
5009 :
5010 : /*
5011 : BuildReturnLower - check the return type and value to ensure type
5012 : compatibility and no range overflow will occur.
5013 : */
5014 :
5015 : static void BuildReturnLower (unsigned int tokcombined, unsigned int tokexpr, unsigned int e1, unsigned int t1);
5016 :
5017 : /*
5018 : IsReadOnly - a helper procedure function to detect constants.
5019 : */
5020 :
5021 : static bool IsReadOnly (unsigned int sym);
5022 :
5023 : /*
5024 : BuildDesignatorError - removes the designator from the stack and replaces
5025 : it with an error symbol.
5026 : */
5027 :
5028 : static void BuildDesignatorError (const char *message_, unsigned int _message_high);
5029 :
5030 : /*
5031 : BuildDesignatorPointerError - removes the designator from the stack and replaces
5032 : it with an error symbol.
5033 : */
5034 :
5035 : static void BuildDesignatorPointerError (unsigned int type, unsigned int rw, unsigned int tokpos, const char *message_, unsigned int _message_high);
5036 :
5037 : /*
5038 : BuildDesignatorArrayStaticDynamic - Builds the array referencing.
5039 : The purpose of this procedure is to work out
5040 : whether the DesignatorArray is a static or
5041 : dynamic array and to call the appropriate
5042 : BuildRoutine.
5043 :
5044 : The Stack is expected to contain:
5045 :
5046 :
5047 : Entry Exit
5048 : ===== ====
5049 :
5050 : Ptr ->
5051 : +--------------+
5052 : | e | <- Ptr
5053 : |--------------| +------------+
5054 : | Sym | Type | | S | T |
5055 : |--------------| |------------|
5056 : */
5057 :
5058 : static void BuildDesignatorArrayStaticDynamic (void);
5059 :
5060 : /*
5061 : BuildStaticArray - Builds the array referencing for static arrays.
5062 : The Stack is expected to contain:
5063 :
5064 :
5065 : Entry Exit
5066 : ===== ====
5067 :
5068 : Ptr ->
5069 : +--------------+
5070 : | e | <- Ptr
5071 : |--------------| +------------+
5072 : | Sym | Type | | S | T |
5073 : |--------------| |------------|
5074 : */
5075 :
5076 : static void BuildStaticArray (void);
5077 :
5078 : /*
5079 : calculateMultipicand - generates quadruples which calculate the
5080 : multiplicand for the array at dimension, dim.
5081 : */
5082 :
5083 : static unsigned int calculateMultipicand (unsigned int tok, unsigned int arraySym, unsigned int arrayType, unsigned int dim);
5084 :
5085 : /*
5086 : ConvertToAddress - convert sym to an address.
5087 : */
5088 :
5089 : static unsigned int ConvertToAddress (unsigned int tokpos, unsigned int sym);
5090 :
5091 : /*
5092 : BuildDynamicArray - Builds the array referencing for dynamic arrays.
5093 : The Stack is expected to contain:
5094 :
5095 :
5096 : Entry Exit
5097 : ===== ====
5098 :
5099 : Ptr ->
5100 : +-----------------------+
5101 : | Index | <- Ptr
5102 : |-----------------------| +---------------------------+
5103 : | ArraySym | Type | Dim | | S | T | ArraySym | Dim+1 |
5104 : |-----------------------| |---------------------------|
5105 :
5106 :
5107 : if Dim=1
5108 : then
5109 : S := base of ArraySym + TSIZE(Type)*Index
5110 : else
5111 : S := S + TSIZE(Type)*Index
5112 : fi
5113 : */
5114 :
5115 : static void BuildDynamicArray (void);
5116 :
5117 : /*
5118 : DebugLocation -
5119 : */
5120 :
5121 : static void DebugLocation (unsigned int tok, const char *message_, unsigned int _message_high);
5122 :
5123 : /*
5124 : PushWith - pushes sym and type onto the with stack. It checks for
5125 : previous declaration of this record type.
5126 : */
5127 :
5128 : static void PushWith (unsigned int Sym, unsigned int Type, unsigned int Ref, unsigned int Tok);
5129 : static void PopWith (void);
5130 :
5131 : /*
5132 : BuildAccessWithField - similar to BuildDesignatorRecord except it
5133 : does not perform the address operation.
5134 : The address will have been computed at the
5135 : beginning of the WITH statement.
5136 : It also stops the GenQuad procedure from examining the
5137 : with stack.
5138 :
5139 : The Stack
5140 :
5141 : Entry
5142 :
5143 : Ptr ->
5144 : +--------------+
5145 : | Field | Type1| <- Ptr
5146 : |-------|------| +-------------+
5147 : | Adr | Type2| | Sym | Type1|
5148 : |--------------| |-------------|
5149 : */
5150 :
5151 : static void BuildAccessWithField (void);
5152 :
5153 : /*
5154 : PushConstructor -
5155 : */
5156 :
5157 : static void PushConstructor (unsigned int sym);
5158 :
5159 : /*
5160 : AddFieldTo - adds field, e, to, value.
5161 : */
5162 :
5163 : static unsigned int AddFieldTo (unsigned int value, unsigned int e);
5164 :
5165 : /*
5166 : CheckLogicalOperator - returns a logical operator if the operands imply
5167 : a logical operation should be performed.
5168 : */
5169 :
5170 : static NameKey_Name CheckLogicalOperator (NameKey_Name Tok, unsigned int left, unsigned int lefttype);
5171 :
5172 : /*
5173 : CheckDivModRem - initiates calls to check the divisor for DIV, MOD, REM
5174 : expressions.
5175 : */
5176 :
5177 : static void CheckDivModRem (unsigned int TokPos, NameKey_Name tok, unsigned int d, unsigned int e);
5178 :
5179 : /*
5180 : doConvert - convert, sym, to a new symbol with, type.
5181 : Return the new symbol.
5182 : */
5183 :
5184 : static unsigned int doConvert (unsigned int type, unsigned int sym);
5185 :
5186 : /*
5187 : doBuildBinaryOp - build the binary op, with or without type
5188 : checking.
5189 : */
5190 :
5191 : static void doBuildBinaryOp (bool checkTypes, bool checkOverflow);
5192 :
5193 : /*
5194 : AreConstant - returns immediate addressing mode if b is true else
5195 : offset mode is returned. b determines whether the
5196 : operands are all constant - in which case we can use
5197 : a constant temporary variable.
5198 : */
5199 :
5200 : static SymbolTable_ModeOfAddr AreConstant (bool b);
5201 :
5202 : /*
5203 : ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
5204 : exit pair into a variable containing the value TRUE or
5205 : FALSE. The parameter i is relative to the top
5206 : of the stack.
5207 : */
5208 :
5209 : static void ConvertBooleanToVariable (unsigned int tok, unsigned int i);
5210 :
5211 : /*
5212 : DumpQuadSummary -
5213 : */
5214 :
5215 : static void DumpQuadSummary (unsigned int quad);
5216 :
5217 : /*
5218 : BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
5219 : instead of using a temporary boolean variable.
5220 : This function can only be used when we perform
5221 : the following translation:
5222 :
5223 : (a=b) # (c=d) alternatively (a=b) = (c=d)
5224 : ^ ^
5225 :
5226 : it only allows # = to be used as >= <= > < all
5227 : assume a particular value for TRUE and FALSE.
5228 : (In which case the user should specify ORD)
5229 :
5230 :
5231 : before
5232 :
5233 : q if r1 op1 op2 t2
5234 : q+1 Goto f2
5235 : ...
5236 : q+n if r2 op3 op4 t1
5237 : q+n+1 Goto f1
5238 :
5239 : after (in case of =)
5240 :
5241 : q if r1 op1 op2 q+2
5242 : q+1 Goto q+4
5243 : q+2 if r2 op3 op4 t
5244 : q+3 Goto f
5245 : q+4 if r2 op3 op4 f
5246 : q+5 Goto t
5247 :
5248 : after (in case of #)
5249 :
5250 : q if r1 op1 op2 q+2
5251 : q+1 Goto q+n+2
5252 : q+2 ...
5253 : ... ...
5254 : q+n if r2 op3 op4 f
5255 : q+n+1 Goto t
5256 : q+n+2 if r2 op3 op4 t
5257 : q+n+3 Goto f
5258 :
5259 : The Stack is expected to contain:
5260 :
5261 :
5262 : Entry Exit
5263 : ===== ====
5264 :
5265 : Ptr ->
5266 : +------------+
5267 : | t1 | f1 |
5268 : |------------|
5269 : | Operator | <- Ptr
5270 : |------------| +------------+
5271 : | t2 | f2 | | t | f |
5272 : |------------| |------------|
5273 :
5274 :
5275 : */
5276 :
5277 : static void BuildRelOpFromBoolean (unsigned int tokpos);
5278 :
5279 : /*
5280 : CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
5281 : */
5282 :
5283 : static void CheckVariableOrConstantOrProcedure (unsigned int tokpos, unsigned int sym);
5284 :
5285 : /*
5286 : MakeOp - returns the equalent quadruple operator to a token, t.
5287 : */
5288 :
5289 : static M2Quads_QuadOperator MakeOp (NameKey_Name t);
5290 :
5291 : /*
5292 : GenQuadO - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5293 : */
5294 :
5295 : static void GenQuadO (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow);
5296 :
5297 : /*
5298 : GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5299 : */
5300 :
5301 : static void GenQuadOTrash (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int trash);
5302 :
5303 : /*
5304 : GenQuad - Generate a quadruple with Operation, Op1, Op2, Op3.
5305 : */
5306 :
5307 : static void GenQuad (M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3);
5308 :
5309 : /*
5310 : GenQuadOtok - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5311 : */
5312 :
5313 : static void GenQuadOtok (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos);
5314 :
5315 : /*
5316 : GenQuadOTypetok - assigns the fields of the quadruple with
5317 : the parameters.
5318 : */
5319 :
5320 : static void GenQuadOTypetok (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, bool typecheck, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos);
5321 :
5322 : /*
5323 : DumpUntil - dump all quadruples until we seen the ending quadruple
5324 : with procsym in the third operand.
5325 : Return the quad number containing the match.
5326 : */
5327 :
5328 : static unsigned int DumpUntil (M2Quads_QuadOperator ending, unsigned int procsym, unsigned int quad);
5329 :
5330 : /*
5331 : GetCtorInit - return the init procedure for the module.
5332 : */
5333 :
5334 : static unsigned int GetCtorInit (unsigned int sym);
5335 :
5336 : /*
5337 : GetCtorFini - return the fini procedure for the module.
5338 : */
5339 :
5340 : static unsigned int GetCtorFini (unsigned int sym);
5341 :
5342 : /*
5343 : DumpQuadrupleFilter -
5344 : */
5345 :
5346 : static void DumpQuadrupleFilter (void);
5347 :
5348 : /*
5349 : DumpQuadrupleAll - dump all quadruples.
5350 : */
5351 :
5352 : static void DumpQuadrupleAll (void);
5353 :
5354 : /*
5355 : BackPatch - Makes each of the quadruples on the list pointed to by
5356 : QuadNo take quadruple Value as a target.
5357 : */
5358 :
5359 : static void BackPatch (unsigned int QuadNo, unsigned int Value);
5360 :
5361 : /*
5362 : Merge - joins two quad lists, QuadList2 to the end of QuadList1.
5363 : A QuadList of value zero is a nul list.
5364 : */
5365 :
5366 : static unsigned int Merge (unsigned int QuadList1, unsigned int QuadList2);
5367 :
5368 : /*
5369 : DisplayProcedureAttributes -
5370 : */
5371 :
5372 : static void DisplayProcedureAttributes (unsigned int proc);
5373 :
5374 : /*
5375 : WriteQuad - Writes out the Quad BufferQuad.
5376 : */
5377 :
5378 : static void WriteQuad (unsigned int BufferQuad);
5379 :
5380 : /*
5381 : WriteOperand - displays the operands name, symbol id and mode of addressing.
5382 : */
5383 :
5384 : static void WriteMode (SymbolTable_ModeOfAddr Mode);
5385 :
5386 : /*
5387 : PushExit - pushes the exit value onto the EXIT stack.
5388 : */
5389 :
5390 : static void PushExit (unsigned int Exit);
5391 :
5392 : /*
5393 : PopExit - pops the exit value from the EXIT stack.
5394 : */
5395 :
5396 : static unsigned int PopExit (void);
5397 :
5398 : /*
5399 : PushFor - pushes the exit value onto the FOR stack.
5400 : */
5401 :
5402 : static void PushFor (unsigned int Exit);
5403 :
5404 : /*
5405 : PopFor - pops the exit value from the FOR stack.
5406 : */
5407 :
5408 : static unsigned int PopFor (void);
5409 :
5410 : /*
5411 : OperandTno - returns the ident operand stored in the true position
5412 : on the boolean stack. This is exactly the same as
5413 : OperandT but it has no IsBoolean checking.
5414 : */
5415 :
5416 : static unsigned int OperandTno (unsigned int pos);
5417 :
5418 : /*
5419 : OperandFno - returns the ident operand stored in the false position
5420 : on the boolean stack. This is exactly the same as
5421 : OperandF but it has no IsBoolean checking.
5422 : */
5423 :
5424 : static unsigned int OperandFno (unsigned int pos);
5425 :
5426 : /*
5427 : OperandTtok - returns the token associated with the position, pos
5428 : on the boolean stack.
5429 : */
5430 :
5431 : static unsigned int OperandTtok (unsigned int pos);
5432 :
5433 : /*
5434 : PopBooltok - Pops a True and a False exit quad number from the True/False
5435 : stack.
5436 : */
5437 :
5438 : static void PopBooltok (unsigned int *True, unsigned int *False, unsigned int *tokno);
5439 :
5440 : /*
5441 : PushBooltok - Push a True and a False exit quad numbers onto the
5442 : True/False stack.
5443 : */
5444 :
5445 : static void PushBooltok (unsigned int True, unsigned int False, unsigned int tokno);
5446 :
5447 : /*
5448 : PopBool - Pops a True and a False exit quad number from the True/False
5449 : stack.
5450 : */
5451 :
5452 : static void PopBool (unsigned int *True, unsigned int *False);
5453 :
5454 : /*
5455 : PushBool - Push a True and a False exit quad numbers onto the
5456 : True/False stack.
5457 : */
5458 :
5459 : static void PushBool (unsigned int True, unsigned int False);
5460 :
5461 : /*
5462 : IsBoolean - returns true is the Stack position pos contains a Boolean
5463 : Exit. False is returned if an Ident is stored.
5464 : */
5465 :
5466 : static bool IsBoolean (unsigned int pos);
5467 :
5468 : /*
5469 : OperandD - returns possible array dimension associated with the ident
5470 : operand stored on the boolean stack.
5471 : */
5472 :
5473 : static unsigned int OperandD (unsigned int pos);
5474 :
5475 : /*
5476 : OperandRW - returns the rw operand stored on the boolean stack.
5477 : */
5478 :
5479 : static unsigned int OperandRW (unsigned int pos);
5480 :
5481 : /*
5482 : OperandMergeRW - returns the rw operand if not NulSym else it
5483 : returns True.
5484 : */
5485 :
5486 : static unsigned int OperandMergeRW (unsigned int pos);
5487 :
5488 : /*
5489 : OperandRangeDep - return the range dependant associated with the quad stack.
5490 : */
5491 :
5492 : static unsigned int OperandRangeDep (unsigned int pos);
5493 :
5494 : /*
5495 : PutRangeDep - assigns the quad stack pos RangeDep to dep.
5496 : */
5497 :
5498 : static void PutRangeDep (unsigned int pos, unsigned int dep);
5499 :
5500 : /*
5501 : UseLineNote - uses the line note and returns it to the free list.
5502 : */
5503 :
5504 : static void UseLineNote (M2Quads_LineNote l);
5505 :
5506 : /*
5507 : PopLineNo - pops a line note from the line stack.
5508 : */
5509 :
5510 : static M2Quads_LineNote PopLineNo (void);
5511 :
5512 : /*
5513 : InitLineNote - creates a line note and initializes it to
5514 : contain, file, line.
5515 : */
5516 :
5517 : static M2Quads_LineNote InitLineNote (NameKey_Name file, unsigned int line);
5518 :
5519 : /*
5520 : PushLineNote -
5521 : */
5522 :
5523 : static void PushLineNote (M2Quads_LineNote l);
5524 :
5525 : /*
5526 : BuildStmtNoteTok - adds a nop (with an assigned tokenno location) to the code.
5527 : */
5528 :
5529 : static void BuildStmtNoteTok (unsigned int tokenno);
5530 :
5531 : /*
5532 : GetRecordOrField -
5533 : */
5534 :
5535 : static unsigned int GetRecordOrField (void);
5536 :
5537 : /*
5538 : PushTFAD - Push True, False, Array, Dim, numbers onto the
5539 : True/False stack. True and False are assumed to
5540 : contain Symbols or Ident etc.
5541 : */
5542 :
5543 : static void PushTFAD (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim);
5544 :
5545 : /*
5546 : PushTFADtok - Push True, False, Array, Dim, numbers onto the
5547 : True/False stack. True and False are assumed to
5548 : contain Symbols or Ident etc.
5549 : */
5550 :
5551 : static void PushTFADtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int tokno);
5552 :
5553 : /*
5554 : PushTFADrwtok - Push True, False, Array, Dim, rw, numbers onto the
5555 : True/False stack. True and False are assumed to
5556 : contain Symbols or Ident etc.
5557 : */
5558 :
5559 : static void PushTFADrwtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int rw, unsigned int Tok);
5560 :
5561 : /*
5562 : PopTFrwtok - Pop a True and False number from the True/False stack.
5563 : True and False are assumed to contain Symbols or Ident etc.
5564 : */
5565 :
5566 : static void PopTFrwtok (unsigned int *True, unsigned int *False, unsigned int *rw, unsigned int *tokno);
5567 :
5568 : /*
5569 : PushTFrwtok - Push an item onto the stack in the T (true) position,
5570 : it is assummed to be a token and its token location is recorded.
5571 : */
5572 :
5573 : static void PushTFrwtok (unsigned int True, unsigned int False, unsigned int rw, unsigned int tokno);
5574 :
5575 : /*
5576 : PushTFDtok - Push True, False, Dim, numbers onto the
5577 : True/False stack. True and False are assumed to
5578 : contain Symbols or Ident etc.
5579 : */
5580 :
5581 : static void PushTFDtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int Tok);
5582 :
5583 : /*
5584 : PopTFDtok - Pop a True, False, Dim number from the True/False stack.
5585 : True and False are assumed to contain Symbols or Ident etc.
5586 : */
5587 :
5588 : static void PopTFDtok (unsigned int *True, unsigned int *False, unsigned int *Dim, unsigned int *Tok);
5589 :
5590 : /*
5591 : PushTFDrwtok - Push True, False, Dim, numbers onto the
5592 : True/False stack. True and False are assumed to
5593 : contain Symbols or Ident etc.
5594 : */
5595 :
5596 : static void PushTFDrwtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int rw, unsigned int Tok);
5597 :
5598 : /*
5599 : PushTFrw - Push a True and False numbers onto the True/False stack.
5600 : True and False are assumed to contain Symbols or Ident etc.
5601 : It also pushes the higher level symbol which is associated
5602 : with the True symbol. Eg record variable or array variable.
5603 : */
5604 :
5605 : static void PushTFrw (unsigned int True, unsigned int False, unsigned int rw);
5606 :
5607 : /*
5608 : PopTFrw - Pop a True and False number from the True/False stack.
5609 : True and False are assumed to contain Symbols or Ident etc.
5610 : */
5611 :
5612 : static void PopTFrw (unsigned int *True, unsigned int *False, unsigned int *rw);
5613 :
5614 : /*
5615 : newBoolFrame - creates a new BoolFrame with all fields initialised to their defaults.
5616 : */
5617 :
5618 : static M2Quads_BoolFrame newBoolFrame (void);
5619 :
5620 : /*
5621 : PushTrwtok - Push an item onto the True/False stack. The False value will be zero.
5622 : */
5623 :
5624 : static void PushTrwtok (unsigned int True, unsigned int rw, unsigned int tok);
5625 :
5626 : /*
5627 : PopTrw - Pop a True field and rw symbol from the stack.
5628 : */
5629 :
5630 : static void PopTrw (unsigned int *True, unsigned int *rw);
5631 :
5632 : /*
5633 : PopTrwtok - Pop a True field and rw symbol from the stack.
5634 : */
5635 :
5636 : static void PopTrwtok (unsigned int *True, unsigned int *rw, unsigned int *tok);
5637 :
5638 : /*
5639 : gdbhook - a debugger convenience hook.
5640 : */
5641 :
5642 : static void gdbhook (void);
5643 :
5644 : /*
5645 : BreakWhenQuadCreated - to be called interactively by gdb.
5646 : */
5647 :
5648 : static void BreakWhenQuadCreated (unsigned int quad);
5649 :
5650 : /*
5651 : CheckBreak - if quad = BreakQuad then call gdbhook.
5652 : */
5653 :
5654 : static void CheckBreak (unsigned int quad);
5655 :
5656 : /*
5657 : Init - initialize the M2Quads module, all the stacks, all the lists
5658 : and the quads list.
5659 : */
5660 :
5661 : static void Init (void);
5662 :
5663 :
5664 : /*
5665 : DSdbEnter -
5666 : */
5667 :
5668 0 : static void DSdbEnter (void)
5669 : {
5670 0 : }
5671 :
5672 :
5673 : /*
5674 : DSdbExit -
5675 : */
5676 :
5677 0 : static void DSdbExit (void)
5678 : {
5679 0 : }
5680 :
5681 :
5682 : /*
5683 : GetQF - returns the QuadFrame associated with, q.
5684 : */
5685 :
5686 14160828830 : static M2Quads_QuadFrame GetQF (unsigned int q)
5687 : {
5688 0 : return (M2Quads_QuadFrame) (Indexing_GetIndice (QuadArray, q));
5689 : /* static analysis guarentees a RETURN statement will be used before here. */
5690 : __builtin_unreachable ();
5691 : }
5692 :
5693 :
5694 : /*
5695 : IsQuadA - returns true if QuadNo is a op.
5696 : */
5697 :
5698 1038772912 : static bool IsQuadA (unsigned int QuadNo, M2Quads_QuadOperator op)
5699 : {
5700 1038772912 : M2Quads_QuadFrame f;
5701 :
5702 0 : f = GetQF (QuadNo);
5703 1038772912 : return f->Operator == op;
5704 : /* static analysis guarentees a RETURN statement will be used before here. */
5705 : __builtin_unreachable ();
5706 : }
5707 :
5708 :
5709 : /*
5710 : OpUsesOp1 - return TRUE if op allows op1.
5711 : */
5712 :
5713 415714 : static bool OpUsesOp1 (M2Quads_QuadOperator op)
5714 : {
5715 415714 : switch (op)
5716 : {
5717 : case M2Quads_StringConvertCnulOp:
5718 : case M2Quads_StringConvertM2nulOp:
5719 : case M2Quads_StringLengthOp:
5720 : case M2Quads_InclOp:
5721 : case M2Quads_ExclOp:
5722 : case M2Quads_UnboundedOp:
5723 : case M2Quads_FunctValueOp:
5724 : case M2Quads_NegateOp:
5725 : case M2Quads_BecomesOp:
5726 : case M2Quads_HighOp:
5727 : case M2Quads_SizeOp:
5728 : case M2Quads_AddrOp:
5729 : case M2Quads_RecordFieldOp:
5730 : case M2Quads_ArrayOp:
5731 : case M2Quads_LogicalShiftOp:
5732 : case M2Quads_LogicalRotateOp:
5733 : case M2Quads_LogicalOrOp:
5734 : case M2Quads_LogicalAndOp:
5735 : case M2Quads_LogicalXorOp:
5736 : case M2Quads_CoerceOp:
5737 : case M2Quads_ConvertOp:
5738 : case M2Quads_CastOp:
5739 : case M2Quads_AddOp:
5740 : case M2Quads_SubOp:
5741 : case M2Quads_MultOp:
5742 : case M2Quads_ModFloorOp:
5743 : case M2Quads_DivCeilOp:
5744 : case M2Quads_ModCeilOp:
5745 : case M2Quads_DivFloorOp:
5746 : case M2Quads_ModTruncOp:
5747 : case M2Quads_DivTruncOp:
5748 : case M2Quads_DivM2Op:
5749 : case M2Quads_ModM2Op:
5750 : case M2Quads_XIndrOp:
5751 : case M2Quads_IndrXOp:
5752 : case M2Quads_SaveExceptionOp:
5753 : case M2Quads_RestoreExceptionOp:
5754 : return true;
5755 99396 : break;
5756 :
5757 :
5758 99396 : default:
5759 99396 : return false;
5760 : break;
5761 : }
5762 : /* static analysis guarentees a RETURN statement will be used before here. */
5763 : __builtin_unreachable ();
5764 : }
5765 :
5766 :
5767 : /*
5768 : AddQuadInformation - adds variable analysis and jump analysis to the new quadruple.
5769 : */
5770 :
5771 6212138 : static void AddQuadInformation (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
5772 : {
5773 6212138 : switch (Op)
5774 : {
5775 171559 : case M2Quads_IfInOp:
5776 171559 : case M2Quads_IfNotInOp:
5777 171559 : case M2Quads_IfEquOp:
5778 171559 : case M2Quads_IfNotEquOp:
5779 171559 : case M2Quads_IfLessOp:
5780 171559 : case M2Quads_IfLessEquOp:
5781 171559 : case M2Quads_IfGreOp:
5782 171559 : case M2Quads_IfGreEquOp:
5783 171559 : ManipulateReference (QuadNo, Oper3);
5784 171559 : CheckAddVariableRead (Oper1, false, QuadNo);
5785 171559 : CheckAddVariableRead (Oper2, false, QuadNo);
5786 171559 : break;
5787 :
5788 2518 : case M2Quads_LastForIteratorOp:
5789 2518 : CheckAddVariableWrite (Oper1, false, QuadNo);
5790 2518 : CheckAddTuple2Read (Oper2, false, QuadNo);
5791 2518 : CheckAddVariableRead (Oper3, false, QuadNo);
5792 2518 : break;
5793 :
5794 181416 : case M2Quads_TryOp:
5795 181416 : case M2Quads_RetryOp:
5796 181416 : case M2Quads_GotoOp:
5797 181416 : ManipulateReference (QuadNo, Oper3);
5798 181416 : break;
5799 :
5800 1926 : case M2Quads_InclOp:
5801 1926 : case M2Quads_ExclOp:
5802 : /* variable references */
5803 1926 : CheckConst (Oper1);
5804 1926 : CheckAddVariableRead (Oper3, false, QuadNo);
5805 1926 : CheckAddVariableWrite (Oper1, true, QuadNo);
5806 1926 : break;
5807 :
5808 659930 : case M2Quads_UnboundedOp:
5809 659930 : case M2Quads_FunctValueOp:
5810 659930 : case M2Quads_NegateOp:
5811 659930 : case M2Quads_BecomesOp:
5812 659930 : case M2Quads_HighOp:
5813 659930 : case M2Quads_SizeOp:
5814 659930 : CheckConst (Oper1);
5815 659930 : CheckAddVariableWrite (Oper1, false, QuadNo);
5816 659930 : CheckAddVariableRead (Oper3, false, QuadNo);
5817 659930 : break;
5818 :
5819 191554 : case M2Quads_AddrOp:
5820 191554 : CheckConst (Oper1);
5821 191554 : CheckAddVariableWrite (Oper1, false, QuadNo);
5822 : /* the next line is a kludge and assumes we _will_
5823 : write to the variable as we have taken its address */
5824 191554 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
5825 191554 : break;
5826 :
5827 27701 : case M2Quads_ReturnValueOp:
5828 27701 : CheckAddVariableRead (Oper1, false, QuadNo);
5829 27701 : break;
5830 :
5831 : case M2Quads_ReturnOp:
5832 : case M2Quads_NewLocalVarOp:
5833 : case M2Quads_KillLocalVarOp:
5834 : break;
5835 :
5836 212988 : case M2Quads_CallOp:
5837 212988 : CheckAddVariableRead (Oper3, true, QuadNo);
5838 212988 : break;
5839 :
5840 598938 : case M2Quads_ParamOp:
5841 598938 : CheckAddVariableRead (Oper2, false, QuadNo);
5842 598938 : CheckAddVariableRead (Oper3, false, QuadNo);
5843 598938 : if (((Oper1 > 0) && (Oper1 <= (SymbolTable_NoOfParamAny (Oper2)))) && (SymbolTable_IsVarParamAny (Oper2, Oper1)))
5844 : {
5845 : /* _may_ also write to a var parameter, although we dont know */
5846 19806 : CheckAddVariableWrite (Oper3, true, QuadNo);
5847 : }
5848 : break;
5849 :
5850 352317 : case M2Quads_RecordFieldOp:
5851 352317 : case M2Quads_ArrayOp:
5852 352317 : case M2Quads_LogicalShiftOp:
5853 352317 : case M2Quads_LogicalRotateOp:
5854 352317 : case M2Quads_LogicalOrOp:
5855 352317 : case M2Quads_LogicalAndOp:
5856 352317 : case M2Quads_LogicalXorOp:
5857 352317 : case M2Quads_CoerceOp:
5858 352317 : case M2Quads_ConvertOp:
5859 352317 : case M2Quads_CastOp:
5860 352317 : case M2Quads_AddOp:
5861 352317 : case M2Quads_SubOp:
5862 352317 : case M2Quads_MultOp:
5863 352317 : case M2Quads_DivM2Op:
5864 352317 : case M2Quads_ModM2Op:
5865 352317 : case M2Quads_ModFloorOp:
5866 352317 : case M2Quads_DivCeilOp:
5867 352317 : case M2Quads_ModCeilOp:
5868 352317 : case M2Quads_DivFloorOp:
5869 352317 : case M2Quads_ModTruncOp:
5870 352317 : case M2Quads_DivTruncOp:
5871 352317 : CheckConst (Oper1);
5872 352317 : CheckAddVariableWrite (Oper1, false, QuadNo);
5873 352317 : CheckAddVariableRead (Oper2, false, QuadNo);
5874 352317 : CheckAddVariableRead (Oper3, false, QuadNo);
5875 352317 : break;
5876 :
5877 43274 : case M2Quads_XIndrOp:
5878 43274 : CheckConst (Oper1);
5879 43274 : CheckAddVariableWrite (Oper1, true, QuadNo);
5880 43274 : CheckAddVariableRead (Oper3, false, QuadNo);
5881 43274 : break;
5882 :
5883 16897 : case M2Quads_IndrXOp:
5884 16897 : CheckConst (Oper1);
5885 16897 : CheckAddVariableWrite (Oper1, false, QuadNo);
5886 16897 : CheckAddVariableRead (Oper3, true, QuadNo);
5887 16897 : break;
5888 :
5889 2909 : case M2Quads_SaveExceptionOp:
5890 : /* RangeCheckOp : CheckRangeAddVariableRead(Oper3, QuadNo) | */
5891 2909 : CheckConst (Oper1);
5892 2909 : CheckAddVariableWrite (Oper1, false, QuadNo);
5893 2909 : break;
5894 :
5895 3071 : case M2Quads_RestoreExceptionOp:
5896 3071 : CheckAddVariableRead (Oper1, false, QuadNo);
5897 3071 : break;
5898 :
5899 :
5900 : default:
5901 : break;
5902 : }
5903 6212138 : }
5904 :
5905 :
5906 : /*
5907 : PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
5908 : sets a boolean to determinine whether overflow should be checked.
5909 : */
5910 :
5911 5278551 : static void PutQuadO (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow)
5912 : {
5913 0 : PutQuadOType (QuadNo, Op, Oper1, Oper2, Oper3, overflow, true);
5914 0 : }
5915 :
5916 :
5917 : /*
5918 : PutQuadOType -
5919 : */
5920 :
5921 6132875 : static void PutQuadOType (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow, bool checktype)
5922 : {
5923 6132875 : M2Quads_QuadFrame f;
5924 :
5925 6132875 : if (QuadrupleGeneration)
5926 : {
5927 6132875 : M2Quads_EraseQuad (QuadNo);
5928 6132875 : AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3);
5929 6132875 : f = GetQF (QuadNo);
5930 6132875 : f->Operator = Op;
5931 6132875 : f->Operand1 = Oper1;
5932 6132875 : f->Operand2 = Oper2;
5933 6132875 : f->Operand3 = Oper3;
5934 6132875 : f->CheckOverflow = overflow;
5935 6132875 : f->CheckType = checktype;
5936 6132875 : f->ConstExpr = false; /* IsInConstExpression () */
5937 : }
5938 : /* IsInConstExpression () */
5939 6132875 : }
5940 :
5941 :
5942 : /*
5943 : UndoReadWriteInfo -
5944 : */
5945 :
5946 8088177 : static void UndoReadWriteInfo (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
5947 : {
5948 8088177 : switch (Op)
5949 : {
5950 94854 : case M2Quads_IfInOp:
5951 94854 : case M2Quads_IfNotInOp:
5952 94854 : case M2Quads_IfEquOp:
5953 94854 : case M2Quads_IfNotEquOp:
5954 94854 : case M2Quads_IfLessOp:
5955 94854 : case M2Quads_IfLessEquOp:
5956 94854 : case M2Quads_IfGreOp:
5957 94854 : case M2Quads_IfGreEquOp:
5958 : /* jumps, calls and branches */
5959 94854 : RemoveReference (QuadNo);
5960 94854 : CheckRemoveVariableRead (Oper1, false, QuadNo);
5961 94854 : CheckRemoveVariableRead (Oper2, false, QuadNo);
5962 94854 : break;
5963 :
5964 133089 : case M2Quads_TryOp:
5965 133089 : case M2Quads_RetryOp:
5966 133089 : case M2Quads_GotoOp:
5967 133089 : RemoveReference (QuadNo);
5968 133089 : break;
5969 :
5970 0 : case M2Quads_InclOp:
5971 0 : case M2Quads_ExclOp:
5972 : /* variable references */
5973 0 : CheckRemoveVariableRead (Oper1, false, QuadNo);
5974 0 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
5975 0 : break;
5976 :
5977 327363 : case M2Quads_UnboundedOp:
5978 327363 : case M2Quads_FunctValueOp:
5979 327363 : case M2Quads_NegateOp:
5980 327363 : case M2Quads_BecomesOp:
5981 327363 : case M2Quads_HighOp:
5982 327363 : case M2Quads_SizeOp:
5983 327363 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
5984 327363 : CheckRemoveVariableRead (Oper3, false, QuadNo);
5985 327363 : break;
5986 :
5987 1630 : case M2Quads_AddrOp:
5988 1630 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
5989 : /* the next line is a kludge and assumes we _will_
5990 : write to the variable as we have taken its address */
5991 1630 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
5992 1630 : break;
5993 :
5994 184 : case M2Quads_ReturnValueOp:
5995 184 : CheckRemoveVariableRead (Oper1, false, QuadNo);
5996 184 : break;
5997 :
5998 : case M2Quads_ReturnOp:
5999 : case M2Quads_CallOp:
6000 : case M2Quads_NewLocalVarOp:
6001 : case M2Quads_KillLocalVarOp:
6002 : break;
6003 :
6004 11254 : case M2Quads_ParamOp:
6005 11254 : CheckRemoveVariableRead (Oper2, false, QuadNo);
6006 11254 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6007 11254 : if (((Oper1 > 0) && (Oper1 <= (SymbolTable_NoOfParamAny (Oper2)))) && (SymbolTable_IsVarParamAny (Oper2, Oper1)))
6008 : {
6009 : /* _may_ also write to a var parameter, although we dont know */
6010 112 : CheckRemoveVariableWrite (Oper3, true, QuadNo);
6011 : }
6012 : break;
6013 :
6014 49872 : case M2Quads_RecordFieldOp:
6015 49872 : case M2Quads_ArrayOp:
6016 49872 : case M2Quads_LogicalShiftOp:
6017 49872 : case M2Quads_LogicalRotateOp:
6018 49872 : case M2Quads_LogicalOrOp:
6019 49872 : case M2Quads_LogicalAndOp:
6020 49872 : case M2Quads_LogicalXorOp:
6021 49872 : case M2Quads_CoerceOp:
6022 49872 : case M2Quads_ConvertOp:
6023 49872 : case M2Quads_CastOp:
6024 49872 : case M2Quads_AddOp:
6025 49872 : case M2Quads_SubOp:
6026 49872 : case M2Quads_MultOp:
6027 49872 : case M2Quads_DivM2Op:
6028 49872 : case M2Quads_ModM2Op:
6029 49872 : case M2Quads_ModFloorOp:
6030 49872 : case M2Quads_DivCeilOp:
6031 49872 : case M2Quads_ModCeilOp:
6032 49872 : case M2Quads_DivFloorOp:
6033 49872 : case M2Quads_ModTruncOp:
6034 49872 : case M2Quads_DivTruncOp:
6035 49872 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6036 49872 : CheckRemoveVariableRead (Oper2, false, QuadNo);
6037 49872 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6038 49872 : break;
6039 :
6040 4 : case M2Quads_XIndrOp:
6041 4 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
6042 4 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6043 4 : break;
6044 :
6045 450 : case M2Quads_IndrXOp:
6046 450 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6047 450 : CheckRemoveVariableRead (Oper3, true, QuadNo);
6048 450 : break;
6049 :
6050 0 : case M2Quads_SaveExceptionOp:
6051 : /* RangeCheckOp : CheckRangeRemoveVariableRead(Oper3, QuadNo) | */
6052 0 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6053 0 : break;
6054 :
6055 216 : case M2Quads_RestoreExceptionOp:
6056 216 : CheckRemoveVariableRead (Oper1, false, QuadNo);
6057 216 : break;
6058 :
6059 :
6060 : default:
6061 : break;
6062 : }
6063 8088177 : }
6064 :
6065 :
6066 : /*
6067 : CheckAddTuple2Read - checks to see whether symbol tuple contains variables or
6068 : parameters and if so it then adds them to the quadruple
6069 : variable list.
6070 : */
6071 :
6072 2518 : static void CheckAddTuple2Read (unsigned int tuple, bool canDereference, unsigned int Quad)
6073 : {
6074 2518 : if (SymbolTable_IsTuple (tuple))
6075 : {
6076 2518 : CheckAddVariableRead (SymbolTable_GetNth (tuple, 1), canDereference, Quad);
6077 2518 : CheckAddVariableRead (SymbolTable_GetNth (tuple, 2), canDereference, Quad);
6078 : }
6079 2518 : }
6080 :
6081 :
6082 : /*
6083 : CheckAddVariableRead - checks to see whether symbol, Sym, is a variable or
6084 : a parameter and if so it then adds this quadruple
6085 : to the variable list.
6086 : */
6087 :
6088 3218969 : static void CheckAddVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad)
6089 : {
6090 3218969 : if (SymbolTable_IsVar (Sym))
6091 : {
6092 1144413 : SymbolTable_PutReadQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6093 1144413 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6094 : {
6095 16965 : SymbolTable_PutReadQuad (Sym, SymbolTable_RightValue, Quad);
6096 : }
6097 : }
6098 3218969 : }
6099 :
6100 :
6101 : /*
6102 : CheckRemoveVariableRead - checks to see whether, Sym, is a variable or
6103 : a parameter and if so then it removes the
6104 : quadruple from the variable list.
6105 : */
6106 :
6107 640177 : static void CheckRemoveVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad)
6108 : {
6109 640177 : if (SymbolTable_IsVar (Sym))
6110 : {
6111 120276 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6112 120276 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6113 : {
6114 450 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_RightValue, Quad);
6115 : }
6116 : }
6117 640177 : }
6118 :
6119 :
6120 : /*
6121 : CheckAddVariableWrite - checks to see whether symbol, Sym, is a variable and
6122 : if so it then adds this quadruple to the variable list.
6123 : */
6124 :
6125 1291131 : static void CheckAddVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad)
6126 : {
6127 1291131 : if (SymbolTable_IsVar (Sym))
6128 : {
6129 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6130 927285 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6131 : {
6132 59108 : SymbolTable_PutReadQuad (Sym, SymbolTable_LeftValue, Quad);
6133 59108 : SymbolTable_PutWriteQuad (Sym, SymbolTable_RightValue, Quad);
6134 : }
6135 : else
6136 : {
6137 868177 : SymbolTable_PutWriteQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6138 : }
6139 : }
6140 1291131 : }
6141 :
6142 :
6143 : /*
6144 : CheckRemoveVariableWrite - checks to see whether, Sym, is a variable and
6145 : if so then it removes the quadruple from the
6146 : variable list.
6147 : */
6148 :
6149 572615 : static void CheckRemoveVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad)
6150 : {
6151 572615 : if (SymbolTable_IsVar (Sym))
6152 : {
6153 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6154 212930 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6155 : {
6156 10832 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_LeftValue, Quad);
6157 10832 : SymbolTable_RemoveWriteQuad (Sym, SymbolTable_RightValue, Quad);
6158 : }
6159 : else
6160 : {
6161 202098 : SymbolTable_RemoveWriteQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6162 : }
6163 : }
6164 572615 : }
6165 :
6166 :
6167 : /*
6168 : CheckConst -
6169 : */
6170 :
6171 1268807 : static void CheckConst (unsigned int sym)
6172 : {
6173 1268807 : if (SymbolTable_IsConst (sym))
6174 : {
6175 362084 : M2GCCDeclare_PutToBeSolvedByQuads (sym);
6176 : }
6177 1268807 : }
6178 :
6179 :
6180 : /*
6181 : AlterReference - alters all references from OldQuad, to NewQuad in a
6182 : quadruple list Head.
6183 : */
6184 :
6185 1876039 : static void AlterReference (unsigned int Head, unsigned int OldQuad, unsigned int NewQuad)
6186 : {
6187 1876039 : M2Quads_QuadFrame f;
6188 1876039 : M2Quads_QuadFrame g;
6189 1876039 : unsigned int i;
6190 :
6191 1876039 : f = GetQF (OldQuad);
6192 12706480 : while ((f->NoOfTimesReferenced > 0) && (Head != 0))
6193 : {
6194 8954402 : g = GetQF (Head);
6195 8954402 : switch (g->Operator)
6196 : {
6197 395880 : case M2Quads_IfInOp:
6198 395880 : case M2Quads_IfNotInOp:
6199 395880 : case M2Quads_IfEquOp:
6200 395880 : case M2Quads_IfNotEquOp:
6201 395880 : case M2Quads_IfLessOp:
6202 395880 : case M2Quads_IfLessEquOp:
6203 395880 : case M2Quads_IfGreOp:
6204 395880 : case M2Quads_IfGreEquOp:
6205 395880 : case M2Quads_TryOp:
6206 395880 : case M2Quads_RetryOp:
6207 395880 : case M2Quads_GotoOp:
6208 395880 : if (g->Operand3 == OldQuad)
6209 : {
6210 8924 : ManipulateReference (Head, NewQuad);
6211 : }
6212 : break;
6213 :
6214 :
6215 : default:
6216 : break;
6217 : }
6218 8954402 : i = g->Next;
6219 8954402 : Head = i;
6220 : }
6221 1876039 : }
6222 :
6223 :
6224 : /*
6225 : GrowQuads - grows the list of quadruples to the quadruple, to.
6226 : */
6227 :
6228 623588 : static void GrowQuads (unsigned int to)
6229 : {
6230 623588 : unsigned int i;
6231 623588 : M2Quads_QuadFrame f;
6232 :
6233 623588 : if ((to != 0) && (to > GrowInitialization))
6234 : {
6235 9842 : i = GrowInitialization+1;
6236 19684 : while (i <= to)
6237 : {
6238 9842 : if (Indexing_InBounds (QuadArray, i))
6239 : {
6240 0 : M2Debug_Assert ((Indexing_GetIndice (QuadArray, i)) != NULL);
6241 : }
6242 : else
6243 : {
6244 9842 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T3));
6245 9842 : if (f == NULL)
6246 : {
6247 0 : M2Error_InternalError ((const char *) "out of memory error when trying to allocate a quadruple", 55);
6248 : }
6249 9842 : Indexing_PutIndice (QuadArray, i, reinterpret_cast <void *> (f));
6250 9842 : f->NoOfTimesReferenced = 0;
6251 : }
6252 9842 : i += 1;
6253 : }
6254 9842 : GrowInitialization = to;
6255 : }
6256 623588 : }
6257 :
6258 :
6259 : /*
6260 : ManipulateReference - manipulates the quadruple, q, so that it now points to quad, to.
6261 : */
6262 :
6263 623588 : static void ManipulateReference (unsigned int q, unsigned int to)
6264 : {
6265 623588 : M2Quads_QuadFrame f;
6266 :
6267 1247176 : M2Debug_Assert ((GrowInitialization >= q) || (to == 0));
6268 623588 : GrowQuads (to);
6269 623588 : RemoveReference (q);
6270 623588 : f = GetQF (q);
6271 623588 : f->Operand3 = to;
6272 623588 : if (to != 0)
6273 : {
6274 396389 : f = GetQF (to);
6275 396389 : f->NoOfTimesReferenced += 1;
6276 : }
6277 623588 : }
6278 :
6279 :
6280 : /*
6281 : RemoveReference - remove the reference by quadruple q to wherever
6282 : it was pointing.
6283 : */
6284 :
6285 851531 : static void RemoveReference (unsigned int q)
6286 : {
6287 851531 : M2Quads_QuadFrame f;
6288 851531 : M2Quads_QuadFrame g;
6289 :
6290 851531 : f = GetQF (q);
6291 851531 : if ((f->Operand3 != 0) && (f->Operand3 < NextQuad))
6292 : {
6293 271357 : CheckBreak (f->Operand3);
6294 271357 : g = GetQF (f->Operand3);
6295 271357 : M2Debug_Assert (g->NoOfTimesReferenced != 0);
6296 271357 : g->NoOfTimesReferenced -= 1;
6297 : }
6298 851531 : }
6299 :
6300 :
6301 : /*
6302 : NewQuad - sets QuadNo to a new quadruple.
6303 : */
6304 :
6305 6133422 : static void NewQuad (unsigned int *QuadNo)
6306 : {
6307 6133422 : M2Quads_QuadFrame f;
6308 :
6309 6133422 : (*QuadNo) = FreeList;
6310 6133422 : if ((Indexing_InBounds (QuadArray, (*QuadNo))) && ((Indexing_GetIndice (QuadArray, (*QuadNo))) != NULL))
6311 : {
6312 9842 : f = static_cast<M2Quads_QuadFrame> (Indexing_GetIndice (QuadArray, (*QuadNo)));
6313 : }
6314 : else
6315 : {
6316 6123580 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T3));
6317 6123580 : if (f == NULL)
6318 : {
6319 0 : M2Error_InternalError ((const char *) "out of memory error trying to allocate a quadruple", 50);
6320 : }
6321 : else
6322 : {
6323 6123580 : NoOfQuads += 1;
6324 6123580 : Indexing_PutIndice (QuadArray, (*QuadNo), reinterpret_cast <void *> (f));
6325 6123580 : f->NoOfTimesReferenced = 0;
6326 6123580 : M2Diagnostic_MemSet (QuadMemDiag, 1, NoOfQuads);
6327 6123580 : M2Diagnostic_MemIncr (QuadMemDiag, 2, sizeof ((*f)));
6328 : }
6329 : }
6330 6133422 : f->Operator = M2Quads_DummyOp;
6331 6133422 : f->Operand3 = 0;
6332 6133422 : f->Next = 0;
6333 6133422 : FreeList += 1;
6334 6133422 : if (GrowInitialization < FreeList)
6335 : {
6336 6123580 : GrowInitialization = FreeList;
6337 : }
6338 6133422 : }
6339 :
6340 :
6341 : /*
6342 : CheckVariableAt - checks to see whether, sym, was declared at a particular address.
6343 : */
6344 :
6345 4047731 : static void CheckVariableAt (unsigned int sym)
6346 : {
6347 4047731 : if ((SymbolTable_IsVar (sym)) && (SymbolTable_IsVariableAtAddress (sym)))
6348 : {
6349 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6350 54 : if ((SymbolTable_GetMode (sym)) == SymbolTable_LeftValue)
6351 : {
6352 54 : GenQuad (M2Quads_InitAddressOp, sym, SymbolTable_NulSym, SymbolTable_GetVariableAtAddress (sym));
6353 : }
6354 : else
6355 : {
6356 0 : M2Error_InternalError ((const char *) "expecting lvalue for this variable which is declared at an explicit address", 75);
6357 : }
6358 : }
6359 4047731 : }
6360 :
6361 :
6362 : /*
6363 : CheckVariablesAt - checks to see whether we need to initialize any pointers
6364 : which point to variable declared at addresses.
6365 : */
6366 :
6367 161627 : static void CheckVariablesAt (unsigned int scope)
6368 : {
6369 0 : SymbolTable_ForeachLocalSymDo (scope, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) CheckVariableAt});
6370 0 : }
6371 :
6372 :
6373 : /*
6374 : GetTurnInterrupts - returns the TurnInterrupts procedure function.
6375 : */
6376 :
6377 840 : static unsigned int GetTurnInterrupts (unsigned int tok)
6378 : {
6379 840 : if (M2Options_Iso)
6380 : {
6381 0 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "TurnInterrupts", 14), NameKey_MakeKey ((const char *) "COROUTINES", 10));
6382 : }
6383 : else
6384 : {
6385 840 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "TurnInterrupts", 14), NameKey_MakeKey ((const char *) "SYSTEM", 6));
6386 : }
6387 : /* static analysis guarentees a RETURN statement will be used before here. */
6388 : __builtin_unreachable ();
6389 : }
6390 :
6391 :
6392 : /*
6393 : GetProtection - returns the PROTECTION data type.
6394 : */
6395 :
6396 420 : static unsigned int GetProtection (unsigned int tok)
6397 : {
6398 420 : if (M2Options_Iso)
6399 : {
6400 0 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "PROTECTION", 10), NameKey_MakeKey ((const char *) "COROUTINES", 10));
6401 : }
6402 : else
6403 : {
6404 420 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "PROTECTION", 10), NameKey_MakeKey ((const char *) "SYSTEM", 6));
6405 : }
6406 : /* static analysis guarentees a RETURN statement will be used before here. */
6407 : __builtin_unreachable ();
6408 : }
6409 :
6410 :
6411 : /*
6412 : CheckNeedPriorityBegin - checks to see whether we need to save the old
6413 : module priority and change to another module
6414 : priority.
6415 : The current module initialization or procedure
6416 : being built is defined by, scope. The module whose
6417 : priority will be used is defined by, module.
6418 : */
6419 :
6420 176938 : static void CheckNeedPriorityBegin (unsigned int tok, unsigned int scope, unsigned int module)
6421 : {
6422 176938 : unsigned int ProcSym;
6423 176938 : unsigned int old;
6424 :
6425 176938 : if ((SymbolTable_GetPriority (module)) != SymbolTable_NulSym)
6426 : {
6427 : /* module has been given a priority */
6428 420 : ProcSym = GetTurnInterrupts (tok);
6429 420 : if (ProcSym != SymbolTable_NulSym)
6430 : {
6431 420 : old = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
6432 420 : SymbolTable_PutVar (old, GetProtection (tok));
6433 840 : GenQuadO (tok, M2Quads_SavePriorityOp, old, scope, ProcSym, false);
6434 420 : M2StackWord_PushWord (PriorityStack, old);
6435 : }
6436 : }
6437 176938 : }
6438 :
6439 :
6440 : /*
6441 : CheckNeedPriorityEnd - checks to see whether we need to restore the old
6442 : module priority.
6443 : The current module initialization or procedure
6444 : being built is defined by, scope.
6445 : */
6446 :
6447 176760 : static void CheckNeedPriorityEnd (unsigned int tok, unsigned int scope, unsigned int module)
6448 : {
6449 176760 : unsigned int ProcSym;
6450 176760 : unsigned int old;
6451 :
6452 176760 : if ((SymbolTable_GetPriority (module)) != SymbolTable_NulSym)
6453 : {
6454 : /* module has been given a priority */
6455 420 : ProcSym = GetTurnInterrupts (tok);
6456 420 : if (ProcSym != SymbolTable_NulSym)
6457 : {
6458 420 : old = static_cast<unsigned int> (M2StackWord_PopWord (PriorityStack));
6459 420 : GenQuad (M2Quads_RestorePriorityOp, old, scope, ProcSym);
6460 : }
6461 : }
6462 176760 : }
6463 :
6464 :
6465 : /*
6466 : BuildRTExceptEnter - informs RTExceptions that we are about to enter the except state.
6467 : */
6468 :
6469 2909 : static void BuildRTExceptEnter (unsigned int tok)
6470 : {
6471 2909 : unsigned int old;
6472 2909 : unsigned int ProcSym;
6473 :
6474 2909 : if (M2Options_Exceptions)
6475 : {
6476 : /* now inform the Modula-2 runtime we are in the exception state */
6477 2909 : ProcSym = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "SetExceptionState", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6478 2909 : if (ProcSym == SymbolTable_NulSym)
6479 : {
6480 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%W}no procedure SetExceptionState found in RTExceptions which is needed to implement exception handling", 104);
6481 : }
6482 : else
6483 : {
6484 2909 : old = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
6485 2909 : SymbolTable_PutVar (old, M2Base_Boolean);
6486 5818 : GenQuadO (tok, M2Quads_SaveExceptionOp, old, SymbolTable_NulSym, ProcSym, false);
6487 2909 : M2StackWord_PushWord (ExceptStack, old);
6488 : }
6489 : }
6490 : else
6491 : {
6492 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}cannot use {%kEXCEPT} blocks with the -fno-exceptions flag", 62);
6493 : }
6494 2909 : }
6495 :
6496 :
6497 : /*
6498 : BuildRTExceptLeave - informs RTExceptions that we are about to leave the except state.
6499 : If, destroy, is TRUE then pop the ExceptStack.
6500 : */
6501 :
6502 3071 : static void BuildRTExceptLeave (unsigned int tok, bool destroy)
6503 : {
6504 3071 : unsigned int old;
6505 3071 : unsigned int ProcSym;
6506 :
6507 3071 : if (M2Options_Exceptions)
6508 : {
6509 : /* avoid dangling else. */
6510 : /* now inform the Modula-2 runtime we are in the exception state */
6511 3071 : ProcSym = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "SetExceptionState", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6512 3071 : if (ProcSym != SymbolTable_NulSym)
6513 : {
6514 3071 : if (destroy)
6515 : {
6516 2909 : old = static_cast<unsigned int> (M2StackWord_PopWord (ExceptStack));
6517 : }
6518 : else
6519 : {
6520 162 : old = static_cast<unsigned int> (M2StackWord_PeepWord (ExceptStack, 1));
6521 : }
6522 3071 : GenQuadO (tok, M2Quads_RestoreExceptionOp, old, SymbolTable_NulSym, ProcSym, false);
6523 : }
6524 : }
6525 : /* no need for an error message here as it will be generated in the Enter procedure above */
6526 3071 : }
6527 :
6528 :
6529 : /*
6530 : SafeRequestSym - only used during scaffold to get argc, argv, envp.
6531 : It attempts to get symbol name from the current scope(s) and if
6532 : it fails then it falls back onto default constants.
6533 : */
6534 :
6535 16122 : static unsigned int SafeRequestSym (unsigned int tok, NameKey_Name name)
6536 : {
6537 16122 : unsigned int sym;
6538 :
6539 16122 : sym = SymbolTable_GetSym (name);
6540 16122 : if (sym == SymbolTable_NulSym)
6541 : {
6542 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6543 0 : if (name == (NameKey_MakeKey ((const char *) "argc", 4)))
6544 : {
6545 0 : return SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType);
6546 : }
6547 0 : else if ((name == (NameKey_MakeKey ((const char *) "argv", 4))) || (name == (NameKey_MakeKey ((const char *) "envp", 4))))
6548 : {
6549 : /* avoid dangling else. */
6550 0 : return M2Base_Nil;
6551 : }
6552 : else
6553 : {
6554 : /* avoid dangling else. */
6555 0 : M2Error_InternalError ((const char *) "not expecting this parameter name", 33);
6556 : return M2Base_Nil;
6557 : }
6558 : }
6559 : return sym;
6560 : /* static analysis guarentees a RETURN statement will be used before here. */
6561 : __builtin_unreachable ();
6562 : }
6563 :
6564 :
6565 : /*
6566 : callRequestDependant - create a call:
6567 : RequestDependant (GetSymName (modulesym), GetLibName (modulesym),
6568 : GetSymName (depModuleSym), GetLibName (depModuleSym));
6569 : */
6570 :
6571 37636 : static void callRequestDependant (unsigned int tokno, unsigned int moduleSym, unsigned int depModuleSym, unsigned int requestDep)
6572 : {
6573 37636 : M2Debug_Assert (requestDep != SymbolTable_NulSym);
6574 37636 : M2Quads_PushTtok (requestDep, tokno);
6575 37636 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6576 37636 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetSymName (moduleSym)), tokno);
6577 37636 : M2Quads_PushT (static_cast<unsigned int> (1));
6578 37636 : BuildAdrFunction ();
6579 37636 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6580 37636 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetLibName (moduleSym)), tokno);
6581 37636 : M2Quads_PushT (static_cast<unsigned int> (1));
6582 37636 : BuildAdrFunction ();
6583 37636 : if (depModuleSym == SymbolTable_NulSym)
6584 : {
6585 15061 : M2Quads_PushTF (M2Base_Nil, M2System_Address);
6586 15061 : M2Quads_PushTF (M2Base_Nil, M2System_Address);
6587 : }
6588 : else
6589 : {
6590 22575 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6591 22575 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetSymName (depModuleSym)), tokno);
6592 22575 : M2Quads_PushT (static_cast<unsigned int> (1));
6593 22575 : BuildAdrFunction ();
6594 22575 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6595 22575 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetLibName (depModuleSym)), tokno);
6596 22575 : M2Quads_PushT (static_cast<unsigned int> (1));
6597 22575 : BuildAdrFunction ();
6598 : }
6599 37636 : M2Quads_PushT (static_cast<unsigned int> (4));
6600 37636 : M2Quads_BuildProcedureCall (tokno);
6601 37636 : }
6602 :
6603 :
6604 : /*
6605 : ForeachImportInDepDo -
6606 : */
6607 :
6608 30122 : static void ForeachImportInDepDo (Lists_List importStatements, unsigned int moduleSym, unsigned int requestDep)
6609 : {
6610 30122 : unsigned int i;
6611 30122 : unsigned int j;
6612 30122 : unsigned int m;
6613 30122 : unsigned int n;
6614 30122 : unsigned int imported;
6615 30122 : unsigned int stmt;
6616 30122 : Lists_List l;
6617 :
6618 30122 : if (importStatements != NULL)
6619 : {
6620 18544 : i = 1;
6621 18544 : n = Lists_NoOfItemsInList (importStatements);
6622 58913 : while (i <= n)
6623 : {
6624 21825 : stmt = static_cast<unsigned int> (Lists_GetItemFromList (importStatements, i));
6625 21825 : M2Debug_Assert (SymbolTable_IsImportStatement (stmt));
6626 21825 : l = SymbolTable_GetImportStatementList (stmt);
6627 21825 : j = 1;
6628 21825 : m = Lists_NoOfItemsInList (l);
6629 66225 : while (j <= m)
6630 : {
6631 22575 : imported = static_cast<unsigned int> (Lists_GetItemFromList (l, j));
6632 22575 : M2Debug_Assert (SymbolTable_IsImport (imported));
6633 22575 : callRequestDependant (SymbolTable_GetImportDeclared (imported), moduleSym, SymbolTable_GetImportModule (imported), requestDep);
6634 22575 : j += 1;
6635 : }
6636 21825 : i += 1;
6637 : }
6638 : }
6639 30122 : }
6640 :
6641 :
6642 : /*
6643 : ForeachImportedModuleDo -
6644 : */
6645 :
6646 15061 : static void ForeachImportedModuleDo (unsigned int moduleSym, unsigned int requestDep)
6647 : {
6648 15061 : Lists_List importStatements;
6649 :
6650 15061 : importStatements = SymbolTable_GetModuleModImportStatementList (moduleSym);
6651 15061 : ForeachImportInDepDo (importStatements, moduleSym, requestDep);
6652 15061 : importStatements = SymbolTable_GetModuleDefImportStatementList (moduleSym);
6653 15061 : ForeachImportInDepDo (importStatements, moduleSym, requestDep);
6654 15061 : }
6655 :
6656 :
6657 : /*
6658 : BuildM2DepFunction - creates the dependency graph procedure using IR:
6659 : static void
6660 : dependencies (void)
6661 : {
6662 : M2RTS_RequestDependant (module_name, libname, "b", "b libname");
6663 : M2RTS_RequestDependant (module_name, libname, NULL, NULL);
6664 : }
6665 : */
6666 :
6667 15105 : static void BuildM2DepFunction (unsigned int tokno, unsigned int moduleSym)
6668 : {
6669 15105 : unsigned int requestDep;
6670 15105 : unsigned int ctor;
6671 15105 : unsigned int init;
6672 15105 : unsigned int fini;
6673 15105 : unsigned int dep;
6674 :
6675 15105 : if (M2Options_ScaffoldDynamic)
6676 : {
6677 : /* Scaffold required and dynamic dependency graph should be produced. */
6678 15061 : SymbolTable_GetModuleCtors (moduleSym, &ctor, &init, &fini, &dep);
6679 15061 : M2Quads_PushT (dep);
6680 15061 : M2Quads_BuildProcedureStart ();
6681 15061 : M2Quads_BuildProcedureBegin ();
6682 15061 : SymbolTable_StartScope (dep);
6683 15061 : requestDep = GetQualidentImport (tokno, NameKey_MakeKey ((const char *) "RequestDependant", 16), NameKey_MakeKey ((const char *) "M2RTS", 5));
6684 15061 : if (requestDep != SymbolTable_NulSym)
6685 : {
6686 15061 : ForeachImportedModuleDo (moduleSym, requestDep);
6687 15061 : callRequestDependant (tokno, moduleSym, SymbolTable_NulSym, requestDep);
6688 : }
6689 15061 : SymbolTable_EndScope ();
6690 15061 : M2Quads_BuildProcedureEnd ();
6691 15061 : M2Quads_PopN (1);
6692 : }
6693 15105 : }
6694 :
6695 :
6696 : /*
6697 : BuildM2LinkFunction - creates the _M2_link procedure which will
6698 : cause the linker to pull in all the module ctors.
6699 : */
6700 :
6701 2723 : static void BuildM2LinkFunction (unsigned int tokno)
6702 : {
6703 2723 : if (M2Options_ScaffoldDynamic)
6704 : {
6705 2687 : if (M2Scaffold_linkFunction != SymbolTable_NulSym)
6706 : {
6707 : /* void
6708 : _M2_link (void)
6709 : {
6710 : for each module in uselist do
6711 : PROC foo_%d = _M2_module_ctor
6712 : done
6713 : }. */
6714 2672 : M2Quads_PushT (M2Scaffold_linkFunction);
6715 2672 : M2Quads_BuildProcedureStart ();
6716 2672 : M2Quads_BuildProcedureBegin ();
6717 2672 : SymbolTable_StartScope (M2Scaffold_linkFunction);
6718 2672 : M2Scaffold_PopulateCtorArray (tokno);
6719 2672 : SymbolTable_EndScope ();
6720 2672 : M2Quads_BuildProcedureEnd ();
6721 2672 : M2Quads_PopN (1);
6722 : }
6723 : }
6724 2723 : }
6725 :
6726 :
6727 : /*
6728 : BuildTry - build the try statement for main.
6729 : */
6730 :
6731 2687 : static void BuildTry (unsigned int tokno)
6732 : {
6733 2687 : if (M2Options_Exceptions)
6734 : {
6735 2687 : M2StackWord_PushWord (TryStack, NextQuad);
6736 2687 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
6737 2687 : GenQuadO (tokno, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
6738 : }
6739 2687 : }
6740 :
6741 :
6742 : /*
6743 : BuildExcept - build the except block for main.
6744 : */
6745 :
6746 2687 : static void BuildExcept (unsigned int tokno)
6747 : {
6748 2687 : unsigned int catchProcedure;
6749 :
6750 2687 : if (M2Options_Exceptions)
6751 : {
6752 2687 : M2Quads_BuildExceptInitial (tokno);
6753 2687 : catchProcedure = GetQualidentImport (tokno, NameKey_MakeKey ((const char *) "DefaultErrorCatch", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6754 2687 : if (catchProcedure != SymbolTable_NulSym)
6755 : {
6756 2687 : M2Quads_PushTtok (catchProcedure, tokno);
6757 2687 : M2Quads_PushT (static_cast<unsigned int> (0));
6758 2687 : M2Quads_BuildProcedureCall (tokno);
6759 : }
6760 2687 : BuildRTExceptLeave (tokno, true);
6761 2687 : GenQuadO (tokno, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
6762 : }
6763 2687 : }
6764 :
6765 :
6766 : /*
6767 : BuildM2MainFunction - creates the main function with appropriate calls to the scaffold.
6768 : */
6769 :
6770 2723 : static void BuildM2MainFunction (unsigned int tokno)
6771 : {
6772 2723 : if ((M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic) && ! M2Options_SharedFlag)
6773 : {
6774 : /*
6775 : int
6776 : main (int argc, char *argv[], char *envp[])
6777 : {
6778 : try {
6779 : _M2_init (argc, argv, envp);
6780 : _M2_fini (argc, argv, envp);
6781 : return 0;
6782 : }
6783 : catch (...) {
6784 : RTExceptions_DefaultErrorCatch ();
6785 : return 0;
6786 : }
6787 : }
6788 : */
6789 2687 : M2Quads_PushT (M2Scaffold_mainFunction);
6790 2687 : M2Quads_BuildProcedureStart ();
6791 2687 : M2Quads_BuildProcedureBegin ();
6792 2687 : SymbolTable_StartScope (M2Scaffold_mainFunction);
6793 2687 : BuildTry (tokno);
6794 : /* _M2_init (argc, argv, envp); */
6795 2687 : M2Quads_PushTtok (M2Scaffold_initFunction, tokno);
6796 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argc", 4)), tokno);
6797 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argv", 4)), tokno);
6798 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "envp", 4)), tokno);
6799 2687 : M2Quads_PushT (static_cast<unsigned int> (3));
6800 2687 : M2Quads_BuildProcedureCall (tokno);
6801 : /* _M2_fini (argc, argv, envp); */
6802 2687 : M2Quads_PushTtok (M2Scaffold_finiFunction, tokno);
6803 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argc", 4)), tokno);
6804 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argv", 4)), tokno);
6805 2687 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "envp", 4)), tokno);
6806 2687 : M2Quads_PushT (static_cast<unsigned int> (3));
6807 2687 : M2Quads_BuildProcedureCall (tokno);
6808 2687 : PushZero (tokno, M2Base_Integer);
6809 2687 : M2Quads_BuildReturn (tokno);
6810 2687 : BuildExcept (tokno);
6811 2687 : PushZero (tokno, M2Base_Integer);
6812 2687 : M2Quads_BuildReturn (tokno);
6813 2687 : SymbolTable_EndScope ();
6814 2687 : M2Quads_BuildProcedureEnd ();
6815 2687 : M2Quads_PopN (1);
6816 : }
6817 2723 : }
6818 :
6819 :
6820 : /*
6821 : DeferMakeConstStringCnul - return a C const string which will be nul terminated.
6822 : */
6823 :
6824 9583 : static unsigned int DeferMakeConstStringCnul (unsigned int tok, unsigned int sym)
6825 : {
6826 9583 : unsigned int const_;
6827 :
6828 9583 : const_ = SymbolTable_MakeConstStringCnul (tok, NameKey_NulName, false);
6829 19166 : GenQuadO (tok, M2Quads_StringConvertCnulOp, const_, 0, sym, false);
6830 9583 : return const_;
6831 : /* static analysis guarentees a RETURN statement will be used before here. */
6832 : __builtin_unreachable ();
6833 : }
6834 :
6835 :
6836 : /*
6837 : DeferMakeConstStringM2nul - return a const string which will be nul terminated.
6838 : */
6839 :
6840 34000 : static unsigned int DeferMakeConstStringM2nul (unsigned int tok, unsigned int sym)
6841 : {
6842 34000 : unsigned int const_;
6843 :
6844 34000 : const_ = SymbolTable_MakeConstStringM2nul (tok, NameKey_NulName, false);
6845 68000 : GenQuadO (tok, M2Quads_StringConvertM2nulOp, const_, 0, sym, false);
6846 34000 : return const_;
6847 : /* static analysis guarentees a RETURN statement will be used before here. */
6848 : __builtin_unreachable ();
6849 : }
6850 :
6851 :
6852 : /*
6853 : BuildStringAdrParam - push the address of a nul terminated string onto the quad stack.
6854 : */
6855 :
6856 8061 : static void BuildStringAdrParam (unsigned int tok, NameKey_Name name)
6857 : {
6858 8061 : unsigned int str;
6859 8061 : unsigned int m2strnul;
6860 :
6861 8061 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6862 8061 : str = SymbolTable_MakeConstString (tok, name);
6863 8061 : SymbolTable_PutConstStringKnown (tok, str, name, false, true);
6864 8061 : m2strnul = DeferMakeConstStringM2nul (tok, str);
6865 8061 : M2Quads_PushTtok (m2strnul, tok);
6866 8061 : M2Quads_PushT (static_cast<unsigned int> (1));
6867 8061 : BuildAdrFunction ();
6868 8061 : }
6869 :
6870 :
6871 : /*
6872 : BuildM2InitFunction -
6873 : */
6874 :
6875 2723 : static void BuildM2InitFunction (unsigned int tok, unsigned int moduleSym)
6876 : {
6877 2723 : unsigned int constructModules;
6878 :
6879 2723 : if (M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic)
6880 : {
6881 : /* int
6882 : _M2_init (int argc, char *argv[], char *envp[])
6883 : {
6884 : M2RTS_ConstructModules (module_name, libname,
6885 : overrideliborder, argc, argv, envp);
6886 : } */
6887 2687 : M2Quads_PushT (M2Scaffold_initFunction);
6888 2687 : M2Quads_BuildProcedureStart ();
6889 2687 : M2Quads_BuildProcedureBegin ();
6890 2687 : SymbolTable_StartScope (M2Scaffold_initFunction);
6891 2687 : if (M2Options_ScaffoldDynamic)
6892 : {
6893 : /* avoid dangling else. */
6894 2687 : if (M2Scaffold_linkFunction != SymbolTable_NulSym)
6895 : {
6896 : /* _M2_link (); */
6897 2672 : M2Quads_PushTtok (M2Scaffold_linkFunction, tok);
6898 2672 : M2Quads_PushT (static_cast<unsigned int> (0));
6899 2672 : M2Quads_BuildProcedureCall (tok);
6900 : }
6901 : /* Lookup ConstructModules and call it. */
6902 2687 : constructModules = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "ConstructModules", 16), NameKey_MakeKey ((const char *) "M2RTS", 5));
6903 2687 : if (constructModules != SymbolTable_NulSym)
6904 : {
6905 : /* ConstructModules (module_name, argc, argv, envp); */
6906 2687 : M2Quads_PushTtok (constructModules, tok);
6907 2687 : BuildStringAdrParam (tok, SymbolTable_GetSymName (moduleSym));
6908 2687 : BuildStringAdrParam (tok, SymbolTable_GetLibName (moduleSym));
6909 2687 : BuildStringAdrParam (tok, NameKey_makekey (M2Options_GetRuntimeModuleOverride ()));
6910 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), tok);
6911 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), tok);
6912 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)), tok);
6913 2687 : M2Quads_PushT (static_cast<unsigned int> (6));
6914 2687 : M2Quads_BuildProcedureCall (tok);
6915 : }
6916 : }
6917 0 : else if (M2Options_ScaffoldStatic)
6918 : {
6919 : /* avoid dangling else. */
6920 0 : M2Scaffold_ForeachModuleCallInit (tok, SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)));
6921 : }
6922 2687 : SymbolTable_EndScope ();
6923 2687 : M2Quads_BuildProcedureEnd ();
6924 2687 : M2Quads_PopN (1);
6925 : }
6926 2723 : }
6927 :
6928 :
6929 : /*
6930 : BuildM2FiniFunction -
6931 : */
6932 :
6933 2723 : static void BuildM2FiniFunction (unsigned int tok, unsigned int moduleSym)
6934 : {
6935 2723 : unsigned int deconstructModules;
6936 :
6937 2723 : if (M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic)
6938 : {
6939 : /* Scaffold required and main should be produced. */
6940 2687 : M2Quads_PushT (M2Scaffold_finiFunction);
6941 2687 : M2Quads_BuildProcedureStart ();
6942 2687 : M2Quads_BuildProcedureBegin ();
6943 2687 : SymbolTable_StartScope (M2Scaffold_finiFunction);
6944 2687 : if (M2Options_ScaffoldDynamic)
6945 : {
6946 : /* avoid dangling else. */
6947 : /* static void
6948 : _M2_finish (int argc, char *argv[], char *envp[])
6949 : {
6950 : M2RTS_DeconstructModules (module_name, argc, argv, envp);
6951 : } */
6952 2687 : deconstructModules = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "DeconstructModules", 18), NameKey_MakeKey ((const char *) "M2RTS", 5));
6953 2687 : if (deconstructModules != SymbolTable_NulSym)
6954 : {
6955 : /* DeconstructModules (module_name, argc, argv, envp); */
6956 2687 : M2Quads_PushTtok (deconstructModules, tok);
6957 2687 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6958 2687 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetSymName (moduleSym)), tok);
6959 2687 : M2Quads_PushT (static_cast<unsigned int> (1));
6960 2687 : BuildAdrFunction ();
6961 2687 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6962 2687 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetLibName (moduleSym)), tok);
6963 2687 : M2Quads_PushT (static_cast<unsigned int> (1));
6964 2687 : BuildAdrFunction ();
6965 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), tok);
6966 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), tok);
6967 2687 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)), tok);
6968 2687 : M2Quads_PushT (static_cast<unsigned int> (5));
6969 2687 : M2Quads_BuildProcedureCall (tok);
6970 : }
6971 : }
6972 0 : else if (M2Options_ScaffoldStatic)
6973 : {
6974 : /* avoid dangling else. */
6975 0 : M2Scaffold_ForeachModuleCallFinish (tok, SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)));
6976 : }
6977 2687 : SymbolTable_EndScope ();
6978 2687 : M2Quads_BuildProcedureEnd ();
6979 2687 : M2Quads_PopN (1);
6980 : }
6981 2723 : }
6982 :
6983 :
6984 : /*
6985 : BuildM2CtorFunction - create a constructor function associated with moduleSym.
6986 :
6987 : void
6988 : ctorFunction ()
6989 : {
6990 : M2RTS_RegisterModule (GetSymName (moduleSym), GetLibName (moduleSym),
6991 : init, fini, dependencies);
6992 : }
6993 : */
6994 :
6995 15105 : static void BuildM2CtorFunction (unsigned int tok, unsigned int moduleSym)
6996 : {
6997 15105 : unsigned int RegisterModule;
6998 15105 : unsigned int ctor;
6999 15105 : unsigned int init;
7000 15105 : unsigned int fini;
7001 15105 : unsigned int dep;
7002 :
7003 15105 : if (M2Options_ScaffoldDynamic)
7004 : {
7005 15061 : SymbolTable_GetModuleCtors (moduleSym, &ctor, &init, &fini, &dep);
7006 15061 : if (ctor != SymbolTable_NulSym)
7007 : {
7008 15061 : M2Debug_Assert (SymbolTable_IsProcedure (ctor));
7009 15061 : M2Quads_PushT (ctor);
7010 15061 : M2Quads_BuildProcedureStart ();
7011 15061 : M2Quads_BuildProcedureBegin ();
7012 15061 : SymbolTable_StartScope (ctor);
7013 15061 : RegisterModule = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "RegisterModule", 14), NameKey_MakeKey ((const char *) "M2RTS", 5));
7014 15061 : if (RegisterModule != SymbolTable_NulSym)
7015 : {
7016 : /* RegisterModule (module_name, init, fini, dependencies); */
7017 15061 : M2Quads_PushTtok (RegisterModule, tok);
7018 15061 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
7019 15061 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetSymName (moduleSym)), tok);
7020 15061 : M2Quads_PushT (static_cast<unsigned int> (1));
7021 15061 : BuildAdrFunction ();
7022 15061 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
7023 15061 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetLibName (moduleSym)), tok);
7024 15061 : M2Quads_PushT (static_cast<unsigned int> (1));
7025 15061 : BuildAdrFunction ();
7026 15061 : M2Quads_PushTtok (init, tok);
7027 15061 : M2Quads_PushTtok (fini, tok);
7028 15061 : M2Quads_PushTtok (dep, tok);
7029 15061 : M2Quads_PushT (static_cast<unsigned int> (5));
7030 15061 : M2Quads_BuildProcedureCall (tok);
7031 : }
7032 15061 : SymbolTable_EndScope ();
7033 15061 : M2Quads_BuildProcedureEnd ();
7034 15061 : M2Quads_PopN (1);
7035 : }
7036 : }
7037 15105 : }
7038 :
7039 :
7040 : /*
7041 : AddForInfo - adds the description of the FOR loop into the record list.
7042 : This is used if -pedantic is turned on to check index variable
7043 : usage.
7044 : */
7045 :
7046 2536 : static void AddForInfo (unsigned int Start, unsigned int End, unsigned int IncQuad, unsigned int Sym, unsigned int idtok)
7047 : {
7048 2536 : M2Quads_ForLoopInfo forDesc;
7049 :
7050 2536 : if (M2Options_Pedantic)
7051 : {
7052 0 : Storage_ALLOCATE ((void **) &forDesc, sizeof (M2Quads__T5));
7053 0 : forDesc->IncrementQuad = IncQuad;
7054 0 : forDesc->StartOfForLoop = Start;
7055 0 : forDesc->EndOfForLoop = End;
7056 0 : forDesc->ForLoopIndex = Sym;
7057 0 : forDesc->IndexTok = idtok;
7058 0 : Indexing_IncludeIndiceIntoIndex (ForInfo, reinterpret_cast <void *> (forDesc));
7059 : }
7060 2536 : }
7061 :
7062 :
7063 : /*
7064 : CheckForIndex - checks the quadruples: Start..End to see whether a
7065 : for loop index is manipulated by the programmer.
7066 : It generates a warning if this is the case.
7067 : It also checks to see whether the IndexSym is read
7068 : immediately outside the loop in which case a warning
7069 : is issued.
7070 : */
7071 :
7072 0 : static void CheckForIndex (M2Quads_ForLoopInfo forDesc)
7073 : {
7074 0 : unsigned int ReadStart;
7075 0 : unsigned int ReadEnd;
7076 0 : unsigned int WriteStart;
7077 0 : unsigned int WriteEnd;
7078 :
7079 0 : SymbolTable_GetWriteLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->StartOfForLoop, forDesc->EndOfForLoop, &WriteStart, &WriteEnd);
7080 0 : if ((WriteStart < forDesc->IncrementQuad) && (WriteStart > forDesc->StartOfForLoop))
7081 : {
7082 0 : M2MetaError_MetaErrorT1 (forDesc->IndexTok, (const char *) "{%kFOR} loop index variable {%1Wad} is being manipulated inside the loop", 72, forDesc->ForLoopIndex);
7083 0 : M2MetaError_MetaErrorT1 (M2Quads_QuadToTokenNo (WriteStart), (const char *) "{%kFOR} loop index variable {%1Wad} is being manipulated, this is considered bad practice and may cause unknown program behaviour", 129, forDesc->ForLoopIndex);
7084 : }
7085 0 : SymbolTable_GetWriteLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->EndOfForLoop, 0, &WriteStart, &WriteEnd);
7086 0 : SymbolTable_GetReadLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->EndOfForLoop, 0, &ReadStart, &ReadEnd);
7087 0 : if ((ReadStart != 0) && ((ReadStart < WriteStart) || (WriteStart == 0)))
7088 : {
7089 0 : M2MetaError_MetaErrorT1 (forDesc->IndexTok, (const char *) "{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset)", 92, forDesc->ForLoopIndex);
7090 0 : M2MetaError_MetaErrorT1 (M2Quads_QuadToTokenNo (ReadStart), (const char *) "{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset), this is considered extremely bad practice and may cause unknown program behaviour", 175, forDesc->ForLoopIndex);
7091 : }
7092 0 : }
7093 :
7094 :
7095 : /*
7096 : BuildRange - generates a RangeCheckOp quad with, r, as its operand.
7097 : */
7098 :
7099 2021875 : static void BuildRange (unsigned int r)
7100 : {
7101 2021875 : GenQuad (M2Quads_RangeCheckOp, (unsigned int ) (M2LexBuf_GetLineNo ()), SymbolTable_NulSym, r);
7102 2021875 : }
7103 :
7104 :
7105 : /*
7106 : BuildError - generates a ErrorOp quad, indicating that if this
7107 : quadruple is reachable, then a runtime error would
7108 : occur.
7109 : */
7110 :
7111 19362 : static void BuildError (unsigned int r)
7112 : {
7113 19362 : GenQuad (M2Quads_ErrorOp, (unsigned int ) (M2LexBuf_GetLineNo ()), SymbolTable_NulSym, r);
7114 19362 : }
7115 :
7116 :
7117 : /*
7118 : CheckPointerThroughNil - builds a range quadruple, providing, sym, is
7119 : a candidate for checking against NIL.
7120 : This range quadruple is only expanded into
7121 : code during the code generation phase
7122 : thus allowing limited compile time checking.
7123 : */
7124 :
7125 79423 : static void CheckPointerThroughNil (unsigned int tokpos, unsigned int sym)
7126 : {
7127 79423 : if ((SymbolTable_IsVar (sym)) && (SymbolTable_GetVarPointerCheck (sym)))
7128 : {
7129 : /* PutVarPointerCheck(sym, FALSE) ; so we do not detect this again */
7130 23090 : BuildRange (M2Range_InitPointerRangeCheck (tokpos, sym, (SymbolTable_GetMode (sym)) == SymbolTable_LeftValue));
7131 : }
7132 79423 : }
7133 :
7134 :
7135 : /*
7136 : CollectLow - returns the low of the subrange value.
7137 : */
7138 :
7139 282 : static unsigned int CollectLow (unsigned int sym)
7140 : {
7141 282 : unsigned int low;
7142 282 : unsigned int high;
7143 :
7144 282 : if (SymbolTable_IsSubrange (sym))
7145 : {
7146 282 : SymbolTable_GetSubrange (sym, &high, &low);
7147 282 : return low;
7148 : }
7149 : else
7150 : {
7151 0 : M2Error_InternalError ((const char *) "expecting Subrange symbol", 25);
7152 : }
7153 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
7154 : __builtin_unreachable ();
7155 : }
7156 :
7157 :
7158 : /*
7159 : CollectHigh - returns the high of the subrange value, sym.
7160 : */
7161 :
7162 554 : static unsigned int CollectHigh (unsigned int sym)
7163 : {
7164 554 : unsigned int low;
7165 554 : unsigned int high;
7166 :
7167 554 : if (SymbolTable_IsSubrange (sym))
7168 : {
7169 554 : SymbolTable_GetSubrange (sym, &high, &low);
7170 554 : return high;
7171 : }
7172 : else
7173 : {
7174 0 : M2Error_InternalError ((const char *) "expecting Subrange symbol", 25);
7175 : }
7176 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
7177 : __builtin_unreachable ();
7178 : }
7179 :
7180 :
7181 : /*
7182 : CheckCompatibleWithBecomes - checks to see that symbol, sym, is
7183 : compatible with the := operator.
7184 : */
7185 :
7186 488051 : static void CheckCompatibleWithBecomes (unsigned int des, unsigned int expr, unsigned int destok, unsigned int exprtok)
7187 : {
7188 488051 : if (SymbolTable_IsType (des))
7189 : {
7190 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to a type {%1a}", 51, des);
7191 : }
7192 488051 : else if (SymbolTable_IsProcedure (des))
7193 : {
7194 : /* avoid dangling else. */
7195 6 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to a procedure {%1a}", 56, des);
7196 : }
7197 488045 : else if (SymbolTable_IsFieldEnumeration (des))
7198 : {
7199 : /* avoid dangling else. */
7200 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to an enumeration field {%1a}", 65, des);
7201 : }
7202 488051 : if ((M2Base_IsPseudoBaseProcedure (expr)) || (M2Base_IsPseudoBaseFunction (expr)))
7203 : {
7204 6 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "an assignment cannot assign a {%1dv} {%1a}", 42, expr);
7205 : }
7206 488051 : }
7207 :
7208 :
7209 : /*
7210 : BuildAssignmentWithoutBounds - calls BuildAssignment but makes sure we do not
7211 : check bounds.
7212 : */
7213 :
7214 81381 : static void BuildAssignmentWithoutBounds (unsigned int tok, bool checkTypes, bool checkOverflow)
7215 : {
7216 81381 : bool old;
7217 :
7218 81381 : old = MustNotCheckBounds;
7219 81381 : MustNotCheckBounds = true;
7220 0 : doBuildAssignment (tok, checkTypes, checkOverflow);
7221 81381 : MustNotCheckBounds = old;
7222 18778 : }
7223 :
7224 :
7225 : /*
7226 : MarkArrayWritten - marks, Array, as being written.
7227 : */
7228 :
7229 99900 : static void MarkArrayWritten (unsigned int Array)
7230 : {
7231 99900 : if ((Array != SymbolTable_NulSym) && (SymbolTable_IsVarAParam (Array)))
7232 : {
7233 12536 : SymbolTable_PutVarWritten (Array, true);
7234 : }
7235 99900 : }
7236 :
7237 :
7238 : /*
7239 : MarkAsReadWrite - marks the variable or parameter as being
7240 : read/write.
7241 : */
7242 :
7243 30413 : static void MarkAsReadWrite (unsigned int sym)
7244 : {
7245 30413 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7246 : {
7247 20830 : SymbolTable_PutReadQuad (sym, SymbolTable_RightValue, NextQuad);
7248 20830 : SymbolTable_PutWriteQuad (sym, SymbolTable_RightValue, NextQuad);
7249 : }
7250 30413 : }
7251 :
7252 :
7253 : /*
7254 : MarkAsRead - marks the variable or parameter as being read.
7255 : */
7256 :
7257 1238686 : static void MarkAsRead (unsigned int sym)
7258 : {
7259 1238686 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7260 : {
7261 348847 : SymbolTable_PutReadQuad (sym, SymbolTable_RightValue, NextQuad);
7262 : }
7263 1238686 : }
7264 :
7265 :
7266 : /*
7267 : MarkAsWrite - marks the variable or parameter as being written.
7268 : */
7269 :
7270 488051 : static void MarkAsWrite (unsigned int sym)
7271 : {
7272 488051 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7273 : {
7274 84607 : SymbolTable_PutWriteQuad (sym, SymbolTable_RightValue, NextQuad);
7275 : }
7276 488051 : }
7277 :
7278 :
7279 : /*
7280 : doVal - return an expression which is VAL(type, expr). If
7281 : expr is a constant then return expr.
7282 : */
7283 :
7284 43676 : static unsigned int doVal (unsigned int type, unsigned int expr)
7285 : {
7286 43676 : if ((! (SymbolTable_IsConst (expr))) && ((SymbolTable_SkipType (type)) != (SymbolTable_GetDType (expr))))
7287 : {
7288 33190 : M2Quads_PushTF (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym));
7289 33190 : M2Quads_PushT (SymbolTable_SkipType (type));
7290 33190 : M2Quads_PushT (expr);
7291 33190 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7292 33190 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
7293 33190 : M2Quads_PopT (&expr);
7294 : }
7295 43676 : return expr;
7296 : /* static analysis guarentees a RETURN statement will be used before here. */
7297 : __builtin_unreachable ();
7298 : }
7299 :
7300 :
7301 : /*
7302 : MoveWithMode -
7303 : */
7304 :
7305 488045 : static void MoveWithMode (unsigned int tokno, unsigned int Des, unsigned int Exp, unsigned int Array, unsigned int destok, unsigned int exptok, bool checkOverflow)
7306 : {
7307 488045 : unsigned int t;
7308 :
7309 488045 : if ((SymbolTable_IsConstString (Exp)) && (SymbolTable_IsConst (Des)))
7310 : {
7311 1164 : GenQuadOtok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7312 : }
7313 : else
7314 : {
7315 486881 : if ((SymbolTable_GetMode (Des)) == SymbolTable_RightValue)
7316 : {
7317 152922 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
7318 : {
7319 2608 : CheckPointerThroughNil (tokno, Exp); /* Des = *Exp */
7320 2608 : doIndrX (tokno, Des, Exp); /* Des = *Exp */
7321 : }
7322 : else
7323 : {
7324 150314 : GenQuadOtok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7325 : }
7326 : }
7327 333959 : else if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7328 : {
7329 : /* avoid dangling else. */
7330 43158 : MarkArrayWritten (Array);
7331 43158 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
7332 : {
7333 1100 : t = SymbolTable_MakeTemporary (tokno, SymbolTable_RightValue);
7334 1100 : SymbolTable_PutVar (t, SymbolTable_GetSType (Exp));
7335 1100 : CheckPointerThroughNil (tokno, Exp);
7336 1100 : doIndrX (tokno, t, Exp);
7337 1100 : CheckPointerThroughNil (tokno, Des); /* *Des = Exp */
7338 1100 : GenQuadO (tokno, M2Quads_XIndrOp, Des, SymbolTable_GetSType (Des), doVal (SymbolTable_GetSType (Des), t), checkOverflow); /* *Des = Exp */
7339 : }
7340 : else
7341 : {
7342 42058 : CheckPointerThroughNil (tokno, Des); /* *Des = Exp */
7343 42058 : GenQuadO (tokno, M2Quads_XIndrOp, Des, SymbolTable_GetSType (Des), doVal (SymbolTable_GetSType (Des), Exp), checkOverflow); /* *Des = Exp */
7344 : }
7345 : }
7346 : else
7347 : {
7348 : /* avoid dangling else. */
7349 : /* This might be inside a const expression. */
7350 290801 : GenQuadOTypetok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7351 : }
7352 : }
7353 488045 : }
7354 :
7355 :
7356 : /*
7357 : CheckBecomesMeta - checks to make sure that we are not
7358 : assigning a variable to a constant.
7359 : Also check we are not assigning to an
7360 : unbounded array.
7361 : */
7362 :
7363 418256 : static void CheckBecomesMeta (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok)
7364 : {
7365 418256 : if ((SymbolTable_IsConst (Des)) && (SymbolTable_IsVar (Exp)))
7366 : {
7367 84 : M2MetaError_MetaErrorsT2 (combinedtok, (const char *) "in assignment, cannot assign a variable {%2a} to a constant {%1a}", 65, (const char *) "designator {%1Da} is declared as a {%kCONST}", 44, Des, Exp);
7368 : }
7369 418256 : if ((((SymbolTable_GetDType (Des)) != SymbolTable_NulSym) && (SymbolTable_IsVar (Des))) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (Des))))
7370 : {
7371 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "in assignment, cannot assign to an unbounded array {%1ad}", 57, Des);
7372 : }
7373 418256 : if ((((SymbolTable_GetDType (Exp)) != SymbolTable_NulSym) && (SymbolTable_IsVar (Exp))) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (Exp))))
7374 : {
7375 0 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "in assignment, cannot assign from an unbounded array {%1ad}", 59, Exp);
7376 : }
7377 418256 : }
7378 :
7379 :
7380 : /*
7381 : BuildAssignmentBoolean - build the quadruples for a boolean variable or constant
7382 : which will be assigned to the result of a boolean expression.
7383 : For example:
7384 :
7385 : foo := a = b ;
7386 : foo := a IN b ;
7387 :
7388 : The boolean result is contained in the control flow
7389 : the true value will emerge from the quad path t.
7390 : The false value will emerge from the quad path f.
7391 : This procedure terminates both paths by backpatching
7392 : and assigns TRUE or FALSE to the variable/constant.
7393 : A variable maybe an L value so it will require dereferencing.
7394 : */
7395 :
7396 9842 : static void BuildAssignmentBoolean (unsigned int becomesTokNo, bool checkOverflow, unsigned int t, unsigned int f, unsigned int Des, unsigned int destok)
7397 : {
7398 9842 : SymbolTable_PutVarConditional (Des, true); /* Des will contain the result of a boolean relop. */
7399 : /* Conditional Boolean Assignment. */
7400 9842 : BackPatch (t, NextQuad);
7401 9842 : if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7402 : {
7403 58 : CheckPointerThroughNil (destok, Des);
7404 116 : GenQuadO (destok, M2Quads_XIndrOp, Des, M2Base_Boolean, M2Base_True, checkOverflow);
7405 58 : GenQuadO (destok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, NextQuad+2, false);
7406 : }
7407 : else
7408 : {
7409 : /* This might be inside a const expression. */
7410 19568 : GenQuadO (becomesTokNo, M2Quads_BecomesOp, Des, SymbolTable_NulSym, M2Base_True, checkOverflow);
7411 9784 : GenQuadO (destok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, NextQuad+2, false);
7412 : }
7413 9842 : BackPatch (f, NextQuad);
7414 9842 : if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7415 : {
7416 58 : CheckPointerThroughNil (destok, Des);
7417 58 : GenQuadO (destok, M2Quads_XIndrOp, Des, M2Base_Boolean, M2Base_False, checkOverflow);
7418 : }
7419 : else
7420 : {
7421 9784 : GenQuadO (becomesTokNo, M2Quads_BecomesOp, Des, SymbolTable_NulSym, M2Base_False, checkOverflow);
7422 : }
7423 9842 : }
7424 :
7425 :
7426 : /*
7427 : doBuildAssignment - subsiduary procedure of BuildAssignment.
7428 : It builds the assignment and optionally
7429 : checks the types are compatible.
7430 : */
7431 :
7432 497893 : static void doBuildAssignment (unsigned int becomesTokNo, bool checkTypes, bool checkOverflow)
7433 : {
7434 497893 : unsigned int r;
7435 497893 : unsigned int w;
7436 497893 : unsigned int t;
7437 497893 : unsigned int f;
7438 497893 : unsigned int Array;
7439 497893 : unsigned int Des;
7440 497893 : unsigned int Exp;
7441 497893 : unsigned int combinedtok;
7442 497893 : unsigned int destok;
7443 497893 : unsigned int exptok;
7444 :
7445 497893 : M2Quads_DisplayStack ();
7446 497893 : if (IsBoolean (1))
7447 : {
7448 19684 : PopBool (&t, &f);
7449 9842 : M2Quads_PopTtok (&Des, &destok);
7450 9842 : if ((SymbolTable_IsVar (Des)) || (SymbolTable_IsConstVar (Des)))
7451 : {
7452 9842 : BuildAssignmentBoolean (becomesTokNo, checkOverflow, t, f, Des, destok);
7453 : }
7454 : else
7455 : {
7456 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "expecting the designator {%1Ead} to be a constant or a variable and not a {%1dv}", 80, Des);
7457 : }
7458 : }
7459 : else
7460 : {
7461 488051 : PopTrwtok (&Exp, &r, &exptok);
7462 488051 : MarkAsRead (r);
7463 488051 : if (Exp == SymbolTable_NulSym)
7464 : {
7465 0 : M2MetaError_MetaError0 ((const char *) "{%E}unknown expression found during assignment", 46);
7466 0 : M2Error_FlushErrors ();
7467 : }
7468 488051 : Array = static_cast<unsigned int> (M2Quads_OperandA (1));
7469 488051 : PopTrwtok (&Des, &w, &destok);
7470 488051 : MarkAsWrite (w);
7471 488051 : CheckCompatibleWithBecomes (Des, Exp, destok, exptok);
7472 488051 : if (DebugTokPos)
7473 : {
7474 : M2MetaError_MetaErrorT1 (becomesTokNo, (const char *) "becomestok {%1Oad}", 18, Des);
7475 : M2MetaError_MetaErrorT1 (destok, (const char *) "destok {%1Oad}", 14, Des);
7476 : M2MetaError_MetaErrorT1 (exptok, (const char *) "exptok {%1Oad}", 14, Exp);
7477 : }
7478 488051 : combinedtok = M2LexBuf_MakeVirtualTok (becomesTokNo, destok, exptok);
7479 488051 : if (DebugTokPos)
7480 : {
7481 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "combined {%1Oad}", 16, Des);
7482 : }
7483 488051 : if (M2Options_StrictTypeAssignment)
7484 : {
7485 488051 : BuildRange (M2Range_InitTypesAssignmentCheck (combinedtok, Des, Exp));
7486 : }
7487 488051 : if (((SymbolTable_GetSType (Des)) != SymbolTable_NulSym) && (! (SymbolTable_IsSet (SymbolTable_GetDType (Des)))))
7488 : {
7489 : /* Tell code generator to test runtime values of assignment so ensure we
7490 : catch overflow and underflow. */
7491 478735 : BuildRange (M2Range_InitAssignmentRangeCheck (combinedtok, Des, Exp, destok, exptok));
7492 : }
7493 488045 : if (checkTypes)
7494 : {
7495 418256 : CheckBecomesMeta (Des, Exp, combinedtok, destok, exptok);
7496 : }
7497 : /* Simple assignment. */
7498 488045 : MoveWithMode (combinedtok, Des, Exp, Array, destok, exptok, checkOverflow);
7499 488045 : if (checkTypes)
7500 : {
7501 418256 : CheckAssignCompatible (Des, Exp, combinedtok, destok, exptok);
7502 : }
7503 : }
7504 497887 : M2Quads_DisplayStack ();
7505 497887 : }
7506 :
7507 :
7508 : /*
7509 : CheckAssignCompatible - checks to see that an assignment is compatible.
7510 : It performs limited checking - thorough checking
7511 : is done in pass 3. But we do what we can here
7512 : given knowledge so far.
7513 : */
7514 :
7515 418256 : static void CheckAssignCompatible (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok)
7516 : {
7517 418256 : unsigned int DesT;
7518 418256 : unsigned int ExpT;
7519 418256 : unsigned int DesL;
7520 :
7521 418256 : DesT = SymbolTable_GetSType (Des);
7522 418256 : ExpT = SymbolTable_GetSType (Exp);
7523 418256 : DesL = SymbolTable_GetLType (Des);
7524 418256 : if (((SymbolTable_IsProcedure (Exp)) && ((DesT != SymbolTable_NulSym) && (! (SymbolTable_IsProcType (DesT))))) && ((DesL != SymbolTable_NulSym) && (! (SymbolTable_IsProcType (DesL)))))
7525 : {
7526 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "incorrectly assigning a procedure to a designator {%1Ead} (designator is not a procedure type, {%1ast})", 103, Des);
7527 : }
7528 : /* We ignore checking of these types in pass 3 - but we do check them thoroughly post pass 3 */
7529 418256 : else if ((SymbolTable_IsProcedure (Exp)) && (SymbolTable_IsProcedureNested (Exp)))
7530 : {
7531 : /* avoid dangling else. */
7532 6 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "cannot call nested procedure {%1Ead} indirectly as the outer scope will not be known", 84, Exp);
7533 : }
7534 418250 : else if (SymbolTable_IsConstString (Exp))
7535 : {
7536 : /* avoid dangling else. */
7537 : }
7538 415442 : else if ((DesT != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (DesT)))
7539 : {
7540 : /* avoid dangling else. */
7541 : }
7542 415442 : else if ((ExpT != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (ExpT)))
7543 : {
7544 : /* avoid dangling else. */
7545 : }
7546 415442 : else if ((DesL != SymbolTable_NulSym) && (SymbolTable_IsArray (DesL)))
7547 : {
7548 : /* avoid dangling else. */
7549 : }
7550 414594 : else if (SymbolTable_IsConstructor (Exp))
7551 : {
7552 : /* avoid dangling else. */
7553 6408 : if (ExpT == SymbolTable_NulSym)
7554 : {} /* empty. */
7555 6368 : else if (((DesT == SymbolTable_NulSym) && (SymbolTable_IsConst (Des))) && ((SymbolTable_IsConstructor (Des)) || (SymbolTable_IsConstSet (Des))))
7556 : {
7557 : /* avoid dangling else. */
7558 0 : SymbolTable_PutConst (Des, ExpT);
7559 : }
7560 6368 : else if (! (M2Base_IsAssignmentCompatible (DesT, ExpT)))
7561 : {
7562 : /* avoid dangling else. */
7563 0 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "constructor expression is not compatible during assignment to {%1Ead}", 69, Des);
7564 : }
7565 : }
7566 408186 : else if (((DesT != SymbolTable_NulSym) && (SymbolTable_IsSet (DesT))) && (SymbolTable_IsConst (Exp)))
7567 : {
7568 : /* avoid dangling else. */
7569 : }
7570 408056 : else if ((((((SymbolTable_IsConst (Exp)) && (ExpT != M2System_Address)) && (! (SymbolTable_IsConst (Des)))) && (DesL != SymbolTable_NulSym)) && ((DesL == M2Base_Cardinal) || (! (SymbolTable_IsSubrange (DesL))))) && (! (SymbolTable_IsEnumeration (DesL))))
7571 : {
7572 : /* avoid dangling else. */
7573 24197 : if ((M2Base_IsBaseType (DesL)) || (M2System_IsSystemType (DesL)))
7574 : {
7575 24197 : M2Base_CheckAssignmentCompatible (combinedtok, ExpT, DesT);
7576 : }
7577 : else
7578 : {
7579 0 : M2MetaError_MetaErrorT2 (combinedtok, (const char *) "assignment of a constant {%1Ead} can only be made to a variable whose type is equivalent to a Modula-2 base type {%2tsa}", 120, Exp, Des);
7580 : }
7581 : }
7582 : else
7583 : {
7584 : /* avoid dangling else. */
7585 383859 : if (((DesT != SymbolTable_NulSym) && (SymbolTable_IsProcType (DesT))) && (SymbolTable_IsProcedure (Exp)))
7586 : {
7587 32472 : DesT = SymbolTable_GetSType (DesT); /* we can at least check RETURN values of procedure variables */
7588 : /* remember that thorough assignment checking is done post pass 3 */
7589 32472 : M2Base_CheckAssignmentCompatible (combinedtok, ExpT, DesT);
7590 : }
7591 : }
7592 418256 : }
7593 :
7594 :
7595 : /*
7596 : CheckBooleanId - Checks to see if the top operand is a boolean.
7597 : If the operand is not a boolean then it is tested
7598 : with true and a boolean is generated.
7599 : The Stack:
7600 :
7601 :
7602 : Entry Exit
7603 : Ptr -> <- Ptr
7604 : +------------+ +------------+
7605 : | Sym | | t | f |
7606 : |------------| |------------|
7607 :
7608 : Quadruples
7609 :
7610 : q If= Sym True _
7611 : q+1 GotoOp _ _ _
7612 : */
7613 :
7614 82700 : static void CheckBooleanId (void)
7615 : {
7616 82700 : unsigned int tok;
7617 :
7618 82700 : if (! (IsBoolean (1)))
7619 : {
7620 17139 : tok = static_cast<unsigned int> (M2Quads_OperandTok (1));
7621 17139 : if (SymbolTable_IsVar (M2Quads_OperandT (1)))
7622 : {
7623 13521 : if ((SymbolTable_GetSType (M2Quads_OperandT (1))) != M2Base_Boolean)
7624 : {
7625 0 : M2MetaError_MetaError1 ((const char *) "{%1Ua:is not a boolean expression}{!%1Ua:boolean expression expected}", 69, M2Quads_OperandT (1));
7626 : }
7627 : }
7628 17139 : M2Quads_PushT (M2Reserved_EqualTok);
7629 17139 : M2Quads_PushT (M2Base_True);
7630 17139 : M2Quads_BuildRelOp (tok);
7631 : }
7632 82700 : }
7633 :
7634 :
7635 : /*
7636 : PushOne - pushes the value one to the stack.
7637 : The Stack is changed:
7638 :
7639 :
7640 : Entry Exit
7641 : ===== ====
7642 :
7643 : <- Ptr
7644 : +------------+
7645 : Ptr -> | 1 | type |
7646 : |------------|
7647 : */
7648 :
7649 15478 : static void PushOne (unsigned int tok, unsigned int type, const char *message_, unsigned int _message_high)
7650 : {
7651 15478 : unsigned int const_;
7652 15478 : char message[_message_high+1];
7653 :
7654 : /* make a local copy of each unbounded array. */
7655 15478 : memcpy (message, message_, _message_high+1);
7656 :
7657 15478 : if (type == SymbolTable_NulSym)
7658 : {
7659 220 : const_ = SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), SymbolTable_NulSym);
7660 220 : SymbolTable_PutConstLitInternal (const_, true);
7661 220 : M2Quads_PushTFtok (const_, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7662 : }
7663 15258 : else if (SymbolTable_IsEnumeration (type))
7664 : {
7665 : /* avoid dangling else. */
7666 238 : if ((SymbolTable_NoOfElements (type)) == 0)
7667 : {
7668 0 : M2MetaError_MetaErrorString1 (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "enumeration type only has one element {%1Dad} and therefore ", 60), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) message, _message_high))), type);
7669 0 : PushZero (tok, type);
7670 : }
7671 : else
7672 : {
7673 238 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7674 238 : M2Quads_PushT (type);
7675 238 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_ZType), M2Base_ZType, tok);
7676 238 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7677 238 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters */
7678 : }
7679 : }
7680 : else
7681 : {
7682 : /* avoid dangling else. */
7683 15020 : const_ = SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), type);
7684 15020 : SymbolTable_PutConstLitInternal (const_, true);
7685 15020 : M2Quads_PushTFtok (const_, type, tok);
7686 : }
7687 15478 : }
7688 :
7689 :
7690 : /*
7691 : PushZero - pushes the value zero to the stack.
7692 : The Stack is changed:
7693 :
7694 :
7695 : Entry Exit
7696 : ===== ====
7697 :
7698 : <- Ptr
7699 : +------------+
7700 : Ptr -> | 0 | type |
7701 : |------------|
7702 : */
7703 :
7704 7910 : static void PushZero (unsigned int tok, unsigned int type)
7705 : {
7706 7910 : if (type == SymbolTable_NulSym)
7707 : {
7708 424 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym), static_cast<unsigned int> (SymbolTable_NulSym), tok);
7709 : }
7710 7486 : else if (SymbolTable_IsEnumeration (type))
7711 : {
7712 : /* avoid dangling else. */
7713 196 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7714 196 : M2Quads_PushTtok (type, tok);
7715 196 : M2Quads_PushTtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType), tok);
7716 196 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7717 196 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters */
7718 : }
7719 : else
7720 : {
7721 : /* avoid dangling else. */
7722 7290 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), type), type, tok);
7723 : }
7724 7910 : }
7725 :
7726 :
7727 : /*
7728 : ForLoopLastIterator - calculate the last iterator value but avoid setting
7729 : LastIterator twice if it is a constant (in the quads).
7730 : In the ForLoopLastIteratorVariable case only one
7731 : path will be chosen but at the time of quadruple
7732 : generation we do not know the value of BySym.
7733 : */
7734 :
7735 2536 : static void ForLoopLastIterator (unsigned int LastIterator, unsigned int e1, unsigned int e2, unsigned int BySym, unsigned int e1tok, unsigned int e2tok, unsigned int bytok)
7736 : {
7737 2536 : if (! (SymbolTable_IsConst (BySym)))
7738 : {
7739 18 : M2MetaError_MetaErrorT1 (bytok, (const char *) "{%E}the {%kFOR} loop {%kBY} expression must be constant, the expression {%1a} is variable", 89, BySym);
7740 18 : M2MetaError_MetaErrorDecl (BySym, true);
7741 : }
7742 : else
7743 : {
7744 2518 : e1 = DereferenceLValue (e1tok, e1);
7745 2518 : e2 = DereferenceLValue (e2tok, e2);
7746 2518 : GenQuadOTypetok (bytok, M2Quads_LastForIteratorOp, LastIterator, SymbolTable_Make2Tuple (e1, e2), BySym, false, false, bytok, M2LexBuf_MakeVirtual2Tok (e1tok, e2tok), bytok);
7747 : }
7748 2536 : }
7749 :
7750 :
7751 : /*
7752 : BuildSizeCheckEnd - checks to see whether the function "called" was in fact SIZE.
7753 : If so then we restore quadruple generation.
7754 : */
7755 :
7756 16148 : static void BuildSizeCheckEnd (unsigned int ProcSym)
7757 : {
7758 16148 : if (((ProcSym == M2Size_Size) || (ProcSym == M2System_TSize)) || (ProcSym == M2System_TBitSize))
7759 : {
7760 13174 : QuadrupleGeneration = true;
7761 13174 : BuildingSize = false;
7762 : }
7763 2974 : else if (ProcSym == M2Base_High)
7764 : {
7765 : /* avoid dangling else. */
7766 2974 : QuadrupleGeneration = true;
7767 2974 : BuildingHigh = false;
7768 : }
7769 16148 : }
7770 :
7771 :
7772 : /*
7773 : BuildRealProcedureCall - builds a real procedure call.
7774 : The Stack:
7775 :
7776 :
7777 : Entry Exit
7778 :
7779 : Ptr ->
7780 : +----------------+
7781 : | NoOfParam |
7782 : |----------------|
7783 : | Param 1 |
7784 : |----------------|
7785 : | Param 2 |
7786 : |----------------|
7787 : . .
7788 : . .
7789 : . .
7790 : |----------------|
7791 : | Param # |
7792 : |----------------|
7793 : | ProcSym | Type | Empty
7794 : |----------------|
7795 : */
7796 :
7797 152486 : static void BuildRealProcedureCall (unsigned int tokno)
7798 : {
7799 152486 : unsigned int NoOfParam;
7800 152486 : unsigned int ProcSym;
7801 :
7802 152486 : M2Quads_PopT (&NoOfParam);
7803 152486 : M2Quads_PushT (NoOfParam);
7804 152486 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+2));
7805 152486 : ProcSym = PCSymBuild_SkipConst (ProcSym);
7806 : /* --checkme-- */
7807 152486 : if (SymbolTable_IsVar (ProcSym))
7808 : {
7809 : /* Procedure Variable ? */
7810 684 : ProcSym = SymbolTable_SkipType (M2Quads_OperandF (NoOfParam+2));
7811 : }
7812 152486 : if ((SymbolTable_IsDefImp (SymbolTable_GetScope (ProcSym))) && (SymbolTable_IsDefinitionForC (SymbolTable_GetScope (ProcSym))))
7813 : {
7814 14572 : BuildRealFuncProcCall (tokno, false, true, false);
7815 : }
7816 : else
7817 : {
7818 137914 : BuildRealFuncProcCall (tokno, false, false, false);
7819 : }
7820 152480 : }
7821 :
7822 :
7823 : /*
7824 : BuildRealFuncProcCall - builds a real procedure or function call.
7825 : The Stack:
7826 :
7827 :
7828 : Entry Exit
7829 :
7830 : Ptr ->
7831 : +----------------+
7832 : | NoOfParam |
7833 : |----------------|
7834 : | Param 1 |
7835 : |----------------|
7836 : | Param 2 |
7837 : |----------------|
7838 : . .
7839 : . .
7840 : . .
7841 : |----------------|
7842 : | Param # |
7843 : |----------------|
7844 : | ProcSym | Type | Empty
7845 : |----------------|
7846 : */
7847 :
7848 213006 : static void BuildRealFuncProcCall (unsigned int tokno, bool IsFunc, bool IsForC, bool ConstExpr)
7849 : {
7850 213006 : bool AllocateProc;
7851 213006 : bool DeallocateProc;
7852 213006 : bool ForcedFunc;
7853 213006 : bool ParamConstant;
7854 213006 : unsigned int trash;
7855 213006 : unsigned int resulttok;
7856 213006 : unsigned int paramtok;
7857 213006 : unsigned int proctok;
7858 213006 : unsigned int NoOfParameters;
7859 213006 : unsigned int i;
7860 213006 : unsigned int pi;
7861 213006 : unsigned int ParamType;
7862 213006 : unsigned int Param1;
7863 213006 : unsigned int ReturnVar;
7864 213006 : unsigned int ProcSym;
7865 213006 : unsigned int Proc;
7866 :
7867 213006 : Param1 = SymbolTable_NulSym; /* Used to remember first param for allocate/deallocate. */
7868 213006 : ParamType = SymbolTable_NulSym;
7869 213006 : CheckProcedureParameters (IsForC);
7870 212988 : M2Quads_PopT (&NoOfParameters);
7871 212988 : M2Quads_PushT (NoOfParameters); /* Restore stack to original state. */
7872 212988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+2)); /* Restore stack to original state. */
7873 212988 : proctok = tokno; /* OperandTtok (NoOfParameters+2) ; */
7874 212988 : if (proctok == M2LexBuf_UnknownTokenNo) /* OperandTtok (NoOfParameters+2) ; */
7875 : {
7876 0 : proctok = M2LexBuf_GetTokenNo ();
7877 : }
7878 212988 : paramtok = proctok;
7879 212988 : ProcSym = PCSymBuild_SkipConst (ProcSym);
7880 212988 : ForcedFunc = false;
7881 212988 : AllocateProc = false;
7882 212988 : DeallocateProc = false;
7883 212988 : if (SymbolTable_IsVar (ProcSym))
7884 : {
7885 : /* Procedure Variable ? */
7886 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF (NoOfParameters+2));
7887 772 : ParamConstant = false;
7888 : }
7889 : else
7890 : {
7891 212216 : Proc = ProcSym;
7892 212216 : ParamConstant = true;
7893 212216 : AllocateProc = (SymbolTable_GetSymName (Proc)) == (NameKey_MakeKey ((const char *) "ALLOCATE", 8));
7894 212216 : DeallocateProc = (SymbolTable_GetSymName (Proc)) == (NameKey_MakeKey ((const char *) "DEALLOCATE", 10));
7895 : }
7896 212988 : if (IsFunc)
7897 : {
7898 : /* avoid dangling else. */
7899 60508 : if ((SymbolTable_GetSType (Proc)) == SymbolTable_NulSym)
7900 : {
7901 0 : M2MetaError_MetaErrors1 ((const char *) "procedure {%1a} cannot be used as a function", 44, (const char *) "procedure {%1Da} does not have a return type", 44, Proc);
7902 : }
7903 : }
7904 : else
7905 : {
7906 : /* is being called as a procedure */
7907 152480 : if ((SymbolTable_GetSType (Proc)) != SymbolTable_NulSym)
7908 : {
7909 : /* however it was declared as a procedure function */
7910 8941 : if (! (SymbolTable_IsReturnOptionalAny (Proc)))
7911 : {
7912 6 : M2MetaError_MetaErrors1 ((const char *) "function {%1a} is being called but its return value is ignored", 62, (const char *) "function {%1Da} return a type {%1ta:of {%1ta}}", 46, Proc);
7913 : }
7914 : IsFunc = true;
7915 : ForcedFunc = true;
7916 : }
7917 : }
7918 212988 : if (AllocateProc || DeallocateProc)
7919 : {
7920 1814 : Param1 = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+1)); /* Remember this before manipulating. */
7921 : }
7922 212988 : ManipulateParameters (IsForC);
7923 212988 : CheckParameterOrdinals ();
7924 212988 : M2Quads_PopT (&NoOfParameters);
7925 212988 : if (IsFunc)
7926 : {
7927 69449 : GenQuad (M2Quads_ParamOp, 0, Proc, ProcSym); /* Space for return value */
7928 : }
7929 212988 : if (((NoOfParameters+1) == (SymbolTable_NoOfParamAny (Proc))) && (SymbolTable_UsesOptArgAny (Proc)))
7930 : {
7931 3336 : GenQuad (M2Quads_OptParamOp, SymbolTable_NoOfParamAny (Proc), Proc, Proc);
7932 : }
7933 212988 : i = NoOfParameters;
7934 212988 : pi = 1; /* stack index referencing stacked parameter, i */
7935 742453 : while (i > 0) /* stack index referencing stacked parameter, i */
7936 : {
7937 529465 : paramtok = OperandTtok (pi);
7938 529465 : if (((AllocateProc || DeallocateProc) && (i == 1)) && (Param1 != SymbolTable_NulSym))
7939 : {
7940 1814 : ParamType = GetItemPointedTo (Param1);
7941 1814 : if (ParamType == SymbolTable_NulSym)
7942 : {
7943 0 : GenQuadO (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true);
7944 : }
7945 : else
7946 : {
7947 1814 : if (AllocateProc)
7948 : {
7949 1270 : trash = SymbolTable_MakeTemporary (paramtok, SymbolTable_RightValue);
7950 1270 : SymbolTable_PutVar (trash, ParamType);
7951 1270 : SymbolTable_PutVarHeap (trash, true);
7952 : }
7953 : else
7954 : {
7955 544 : M2Debug_Assert (DeallocateProc);
7956 544 : trash = M2Base_Nil;
7957 : }
7958 1814 : GenQuadOTrash (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true, trash);
7959 : }
7960 : }
7961 : else
7962 : {
7963 527651 : GenQuadO (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true);
7964 : }
7965 529465 : if (! (SymbolTable_IsConst (M2Quads_OperandT (pi))))
7966 : {
7967 446138 : ParamConstant = false;
7968 : }
7969 529465 : i -= 1;
7970 529465 : pi += 1;
7971 : }
7972 425976 : GenQuadO (proctok, M2Quads_CallOp, SymbolTable_NulSym, SymbolTable_NulSym, ProcSym, true);
7973 212988 : M2Quads_PopN (NoOfParameters+1); /* Destroy arguments and procedure call */
7974 212988 : if (IsFunc)
7975 : {
7976 : /* ReturnVar has the type of the procedure. */
7977 69449 : resulttok = M2LexBuf_MakeVirtualTok (proctok, proctok, paramtok);
7978 69449 : if (ConstExpr && (! (SymbolTable_IsProcedureBuiltinAvailable (Proc))))
7979 : {
7980 0 : M2MetaError_MetaError1 ((const char *) "{%1d} {%1ad} cannot be used in a constant expression", 52, Proc);
7981 0 : ParamConstant = false;
7982 : }
7983 69449 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (ParamConstant && ConstExpr));
7984 69449 : SymbolTable_PutVar (ReturnVar, SymbolTable_GetSType (Proc));
7985 138898 : GenQuadO (resulttok, M2Quads_FunctValueOp, ReturnVar, SymbolTable_NulSym, Proc, true);
7986 69449 : if (! ForcedFunc)
7987 : {
7988 60508 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (Proc), resulttok);
7989 : }
7990 : }
7991 212988 : }
7992 :
7993 :
7994 : /*
7995 : CheckProcedureParameters - Checks the parameters which are being passed to
7996 : procedure ProcSym.
7997 :
7998 : The Stack:
7999 :
8000 :
8001 : Entry Exit
8002 :
8003 : Ptr -> <- Ptr
8004 : +----------------+ +----------------+
8005 : | NoOfParam | | NoOfParam |
8006 : |----------------| |----------------|
8007 : | Param 1 | | Param 1 |
8008 : |----------------| |----------------|
8009 : | Param 2 | | Param 2 |
8010 : |----------------| |----------------|
8011 : . . . .
8012 : . . . .
8013 : . . . .
8014 : |----------------| |----------------|
8015 : | Param # | | Param # |
8016 : |----------------| |----------------|
8017 : | ProcSym | Type | | ProcSym | Type |
8018 : |----------------| |----------------|
8019 :
8020 : */
8021 :
8022 213006 : static void CheckProcedureParameters (bool IsForC)
8023 : {
8024 213006 : unsigned int proctok;
8025 213006 : unsigned int paramtok;
8026 213006 : NameKey_Name n1;
8027 213006 : NameKey_Name n2;
8028 213006 : unsigned int ParamCheckId;
8029 213006 : unsigned int Dim;
8030 213006 : unsigned int Actual;
8031 213006 : unsigned int FormalI;
8032 213006 : unsigned int ParamTotal;
8033 213006 : unsigned int pi;
8034 213006 : unsigned int Proc;
8035 213006 : unsigned int ProcSym;
8036 213006 : unsigned int i;
8037 213006 : DynamicStrings_String s;
8038 :
8039 213006 : M2Quads_PopT (&ParamTotal);
8040 213006 : M2Quads_PushT (ParamTotal); /* Restore stack to origional state */
8041 213006 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((ParamTotal+1)+1)); /* Restore stack to origional state */
8042 213006 : proctok = OperandTtok ((ParamTotal+1)+1);
8043 213006 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (SymbolTable_GetDType (ProcSym))))
8044 : {
8045 : /* Procedure Variable ? */
8046 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF ((ParamTotal+1)+1));
8047 : }
8048 : else
8049 : {
8050 212234 : Proc = PCSymBuild_SkipConst (ProcSym);
8051 : }
8052 213006 : if (! ((SymbolTable_IsProcedure (Proc)) || (SymbolTable_IsProcType (Proc))))
8053 : {
8054 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8055 12 : if (SymbolTable_IsUnknown (Proc))
8056 : {
8057 : /* Spellcheck. */
8058 0 : M2MetaError_MetaError1 ((const char *) "{%1Ua} is not recognised as a procedure, check declaration or import {%1&s}", 75, Proc);
8059 0 : SymbolTable_UnknownReported (Proc);
8060 : }
8061 : else
8062 : {
8063 : /* --fixme-- filter on Var, Const, Procedure. */
8064 12 : M2MetaError_MetaErrors1 ((const char *) "{%1a} is not recognised as a procedure, check declaration or import {%1&s}", 74, (const char *) "{%1Ua} is not recognised as a procedure, check declaration or import", 68, Proc);
8065 : }
8066 : }
8067 213006 : if (M2Options_CompilerDebugging)
8068 : {
8069 0 : n1 = SymbolTable_GetSymName (Proc);
8070 0 : M2Printf_printf1 ((const char *) " %a ( ", 7, (const unsigned char *) &n1, (sizeof (n1)-1));
8071 : }
8072 213006 : if (DebugTokPos)
8073 : {
8074 : s = DynamicStrings_InitString ((const char *) "procedure", 9);
8075 : M2Error_WarnStringAt (s, proctok);
8076 : }
8077 213006 : i = 1;
8078 213006 : pi = ParamTotal+1; /* stack index referencing stacked parameter, i */
8079 739353 : while (i <= ParamTotal) /* stack index referencing stacked parameter, i */
8080 : {
8081 526365 : if (i <= (SymbolTable_NoOfParamAny (Proc)))
8082 : {
8083 : /* FormalI := GetParam(Proc, i) ; */
8084 521213 : FormalI = SymbolTable_GetNthParamAnyClosest (Proc, i, SymbolTable_GetCurrentModule ());
8085 521213 : if (M2Options_CompilerDebugging)
8086 : {
8087 0 : n1 = SymbolTable_GetSymName (FormalI);
8088 0 : n2 = SymbolTable_GetSymName (SymbolTable_GetSType (FormalI));
8089 0 : M2Printf_printf2 ((const char *) "%a: %a", 6, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
8090 : }
8091 521213 : Actual = static_cast<unsigned int> (M2Quads_OperandT (pi));
8092 521213 : Dim = static_cast<unsigned int> (OperandD (pi));
8093 521213 : paramtok = OperandTtok (pi);
8094 521213 : if (DebugTokPos)
8095 : {
8096 : s = DynamicStrings_InitString ((const char *) "actual", 6);
8097 : M2Error_WarnStringAt (s, paramtok);
8098 : }
8099 521213 : ParamCheckId = M2Range_InitTypesParameterCheck (paramtok, Proc, i, FormalI, Actual, 0);
8100 521213 : BuildRange (ParamCheckId);
8101 : /* Store the ParamCheckId on the quad stack so that any dependant checks
8102 : can be cancelled if the type check above detects an error. */
8103 521213 : PutRangeDep (pi, ParamCheckId);
8104 521213 : if (SymbolTable_IsConst (Actual))
8105 : {
8106 : /* avoid dangling else. */
8107 117917 : if (SymbolTable_IsVarParamAny (Proc, i))
8108 : {
8109 0 : FailParameter (paramtok, (const char *) "trying to pass a constant to a VAR parameter", 44, Actual, Proc, i);
8110 : }
8111 117917 : else if (SymbolTable_IsConstString (Actual))
8112 : {
8113 : /* avoid dangling else. */
8114 38564 : if (! (SymbolTable_IsConstStringKnown (Actual)))
8115 : {} /* empty. */
8116 38330 : else if ((SymbolTable_IsArray (SymbolTable_GetDType (FormalI))) && ((SymbolTable_GetSType (SymbolTable_GetDType (FormalI))) == M2Base_Char))
8117 : {
8118 : /* avoid dangling else. */
8119 : }
8120 38306 : else if ((SymbolTable_GetStringLength (paramtok, Actual)) == 1)
8121 : {
8122 : /* avoid dangling else. */
8123 5348 : CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, static_cast<Lists_List> (NULL), ParamCheckId);
8124 : }
8125 32958 : else if (! (SymbolTable_IsUnboundedParamAny (Proc, i)))
8126 : {
8127 : /* avoid dangling else. */
8128 0 : if (IsForC && ((SymbolTable_GetSType (FormalI)) == M2System_Address))
8129 : {
8130 0 : FailParameter (paramtok, (const char *) "a string constant can either be passed to an ADDRESS parameter or an ARRAY OF CHAR", 82, Actual, Proc, i);
8131 : }
8132 : else
8133 : {
8134 0 : FailParameter (paramtok, (const char *) "cannot pass a string constant to a non unbounded array parameter", 64, Actual, Proc, i);
8135 : }
8136 : }
8137 : }
8138 : }
8139 : else
8140 : {
8141 403296 : CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, static_cast<Lists_List> (NULL), ParamCheckId);
8142 : }
8143 : }
8144 : else
8145 : {
8146 5140 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8147 : {
8148 : /* these are varargs, therefore we don't check them */
8149 5140 : i = ParamTotal;
8150 : }
8151 : else
8152 : {
8153 0 : M2MetaError_MetaErrorT2 (proctok, (const char *) "too many parameters, {%2n} passed to {%1a} ", 43, Proc, i);
8154 : }
8155 : }
8156 526347 : i += 1;
8157 526347 : pi -= 1;
8158 526347 : if (M2Options_CompilerDebugging)
8159 : {
8160 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8161 0 : if (i <= ParamTotal)
8162 : {
8163 0 : M2Printf_printf0 ((const char *) "; ", 2);
8164 : }
8165 : else
8166 : {
8167 0 : M2Printf_printf0 ((const char *) " ) ; \\n", 7);
8168 : }
8169 : }
8170 : }
8171 212988 : }
8172 :
8173 :
8174 : /*
8175 : CheckProcTypeAndProcedure - checks the ProcType with the call.
8176 : */
8177 :
8178 47081 : static void CheckProcTypeAndProcedure (unsigned int tokno, unsigned int ProcType, unsigned int call, unsigned int ParamCheckId)
8179 : {
8180 47081 : NameKey_Name n1;
8181 47081 : NameKey_Name n2;
8182 47081 : unsigned int i;
8183 47081 : unsigned int n;
8184 47081 : unsigned int t;
8185 47081 : unsigned int CheckedProcedure;
8186 47081 : M2Error_Error e;
8187 :
8188 47081 : if (((SymbolTable_IsVar (call)) || (SymbolTable_IsTemporary (call))) || (SymbolTable_IsParameter (call)))
8189 : {
8190 592 : CheckedProcedure = SymbolTable_GetDType (call);
8191 : }
8192 : else
8193 : {
8194 : CheckedProcedure = call;
8195 : }
8196 47081 : if (ProcType != CheckedProcedure)
8197 : {
8198 46559 : n = SymbolTable_NoOfParamAny (ProcType);
8199 : /* We need to check the formal parameters between the procedure and proc type. */
8200 46559 : if (n != (SymbolTable_NoOfParamAny (CheckedProcedure)))
8201 : {
8202 0 : e = M2Error_NewError (SymbolTable_GetDeclaredMod (ProcType));
8203 0 : n1 = SymbolTable_GetSymName (call);
8204 0 : n2 = SymbolTable_GetSymName (ProcType);
8205 0 : M2Error_ErrorFormat2 (e, (const char *) "procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters", 117, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
8206 0 : e = M2Error_ChainError (SymbolTable_GetDeclaredMod (call), e);
8207 0 : t = SymbolTable_NoOfParamAny (CheckedProcedure);
8208 0 : if (n < 2)
8209 : {
8210 0 : M2Error_ErrorFormat3 (e, (const char *) "procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)", 82, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &t, (sizeof (t)-1));
8211 : }
8212 : else
8213 : {
8214 0 : M2Error_ErrorFormat3 (e, (const char *) "procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)", 83, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &t, (sizeof (t)-1));
8215 : }
8216 : }
8217 : else
8218 : {
8219 : i = 1;
8220 138731 : while (i <= n)
8221 : {
8222 92172 : if ((SymbolTable_IsVarParamAny (ProcType, i)) != (SymbolTable_IsVarParamAny (CheckedProcedure, i)))
8223 : {
8224 0 : M2MetaError_MetaError3 ((const char *) "parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2dv}", 71, ProcType, SymbolTable_GetNth (ProcType, i), i);
8225 0 : M2MetaError_MetaError3 ((const char *) "parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2dv}", 71, call, SymbolTable_GetNth (call, i), i);
8226 : }
8227 92172 : BuildRange (M2Range_InitTypesParameterCheck (tokno, CheckedProcedure, i, SymbolTable_GetNthParamAnyClosest (CheckedProcedure, i, SymbolTable_GetCurrentModule ()), SymbolTable_GetParam (ProcType, i), ParamCheckId));
8228 92172 : i += 1;
8229 : }
8230 : }
8231 : }
8232 47081 : }
8233 :
8234 :
8235 : /*
8236 : IsReallyPointer - returns TRUE is sym is a pointer, address or a type declared
8237 : as a pointer or address.
8238 : */
8239 :
8240 1261 : static bool IsReallyPointer (unsigned int Sym)
8241 : {
8242 1261 : if (SymbolTable_IsVar (Sym))
8243 : {
8244 1260 : Sym = SymbolTable_GetSType (Sym);
8245 : }
8246 1261 : Sym = SymbolTable_SkipType (Sym);
8247 1261 : return (SymbolTable_IsPointer (Sym)) || (Sym == M2System_Address);
8248 : /* static analysis guarentees a RETURN statement will be used before here. */
8249 : __builtin_unreachable ();
8250 : }
8251 :
8252 :
8253 : /*
8254 : LegalUnboundedParam - returns TRUE if the parameter, Actual, can legitimately be
8255 : passed to ProcSym, i, the, Formal, parameter.
8256 : */
8257 :
8258 9664 : static bool LegalUnboundedParam (unsigned int tokpos, unsigned int ProcSym, unsigned int i, unsigned int ActualType, unsigned int Actual, unsigned int Dimension, unsigned int Formal)
8259 : {
8260 9664 : unsigned int FormalType;
8261 9664 : unsigned int n;
8262 9664 : unsigned int m;
8263 :
8264 9664 : ActualType = SymbolTable_SkipType (ActualType);
8265 9664 : FormalType = SymbolTable_GetDType (Formal);
8266 9664 : FormalType = SymbolTable_GetSType (FormalType); /* type of the unbounded ARRAY */
8267 9664 : if (SymbolTable_IsArray (ActualType)) /* type of the unbounded ARRAY */
8268 : {
8269 6642 : m = SymbolTable_GetDimension (Formal);
8270 6642 : n = 0;
8271 13530 : while (SymbolTable_IsArray (ActualType))
8272 : {
8273 6810 : n += 1;
8274 6810 : ActualType = SymbolTable_GetDType (ActualType);
8275 6810 : if ((m == n) && (ActualType == FormalType))
8276 : {
8277 : return true;
8278 : }
8279 : }
8280 78 : if (n == m)
8281 : {} /* empty. */
8282 : else
8283 : {
8284 : /* now we fall though and test ActualType against FormalType */
8285 24 : if (M2System_IsGenericSystemType (FormalType))
8286 : {
8287 : return true;
8288 : }
8289 : else
8290 : {
8291 12 : FailParameter (tokpos, (const char *) "attempting to pass an array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions", 121, Actual, ProcSym, i);
8292 12 : return false;
8293 : }
8294 : }
8295 : }
8296 3022 : else if (SymbolTable_IsUnbounded (ActualType))
8297 : {
8298 : /* avoid dangling else. */
8299 36 : if ((Dimension == 0) && ((SymbolTable_GetDimension (Formal)) == (SymbolTable_GetDimension (Actual))))
8300 : {
8301 : /* now we fall though and test ActualType against FormalType */
8302 0 : ActualType = SymbolTable_GetSType (ActualType);
8303 : }
8304 : else
8305 : {
8306 36 : if (M2System_IsGenericSystemType (FormalType))
8307 : {
8308 : return true;
8309 : }
8310 : else
8311 : {
8312 12 : if (((SymbolTable_GetDimension (Actual))-Dimension) == (SymbolTable_GetDimension (Formal)))
8313 : {
8314 12 : ActualType = SymbolTable_GetSType (ActualType);
8315 : }
8316 : else
8317 : {
8318 0 : FailParameter (tokpos, (const char *) "attempting to pass an unbounded array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions", 131, Actual, ProcSym, i);
8319 0 : return false;
8320 : }
8321 : }
8322 : }
8323 : }
8324 3052 : if (((M2System_IsGenericSystemType (FormalType)) || (M2System_IsGenericSystemType (ActualType))) || (M2Base_IsAssignmentCompatible (FormalType, ActualType)))
8325 : {
8326 : /* we think it is legal, but we ask post pass 3 to check as
8327 : not all types are known at this point */
8328 3046 : return true;
8329 : }
8330 : else
8331 : {
8332 6 : FailParameter (tokpos, (const char *) "identifier with an incompatible type is being passed to this procedure", 70, Actual, ProcSym, i);
8333 6 : return false;
8334 : }
8335 : /* static analysis guarentees a RETURN statement will be used before here. */
8336 : __builtin_unreachable ();
8337 : }
8338 :
8339 :
8340 : /*
8341 : CheckParameter - checks that types ActualType and FormalType are compatible for parameter
8342 : passing. ProcSym is the procedure and i is the parameter number.
8343 :
8344 : We obey the following rules:
8345 :
8346 : (1) we allow WORD, BYTE, LOC to be compitable with any like sized
8347 : type.
8348 : (2) we allow ADDRESS to be compatible with any pointer type.
8349 : (3) we relax INTEGER and CARDINAL checking for Temporary variables.
8350 :
8351 : Note that type sizes are checked during the code generation pass.
8352 : */
8353 :
8354 408644 : static void CheckParameter (unsigned int tokpos, unsigned int Actual, unsigned int Dimension, unsigned int Formal, unsigned int ProcSym, unsigned int i, Lists_List TypeList, unsigned int ParamCheckId)
8355 : {
8356 408644 : bool NewList;
8357 408644 : unsigned int ActualType;
8358 408644 : unsigned int FormalType;
8359 :
8360 408644 : if ((SymbolTable_IsConstString (Actual)) && (! (SymbolTable_IsConstStringKnown (Actual))))
8361 : {
8362 : /* Cannot check if the string content is not yet known. */
8363 : return;
8364 : }
8365 408644 : FormalType = SymbolTable_GetDType (Formal);
8366 408644 : if ((SymbolTable_IsConstString (Actual)) && ((SymbolTable_GetStringLength (tokpos, Actual)) == 1)) /* if = 1 then it maybe treated as a char */
8367 : {
8368 5348 : ActualType = M2Base_Char;
8369 : }
8370 403296 : else if (Actual == M2Base_Boolean)
8371 : {
8372 : /* avoid dangling else. */
8373 : ActualType = Actual;
8374 : }
8375 : else
8376 : {
8377 : /* avoid dangling else. */
8378 403296 : ActualType = SymbolTable_GetDType (Actual);
8379 : }
8380 408638 : if (TypeList == NULL)
8381 : {
8382 408638 : NewList = true;
8383 408638 : Lists_InitList (&TypeList);
8384 : }
8385 : else
8386 : {
8387 : NewList = false;
8388 : }
8389 408638 : if (Lists_IsItemInList (TypeList, ActualType))
8390 : {
8391 : /* no need to check */
8392 : return;
8393 : }
8394 408638 : Lists_IncludeItemIntoList (TypeList, ActualType);
8395 408638 : if (SymbolTable_IsProcType (FormalType))
8396 : {
8397 47081 : if ((! (SymbolTable_IsProcedure (Actual))) && ((ActualType == SymbolTable_NulSym) || (! (SymbolTable_IsProcType (SymbolTable_SkipType (ActualType))))))
8398 : {
8399 0 : FailParameter (tokpos, (const char *) "expecting a procedure or procedure variable as a parameter", 58, Actual, ProcSym, i);
8400 0 : return;
8401 : }
8402 47081 : if ((SymbolTable_IsProcedure (Actual)) && (SymbolTable_IsProcedureNested (Actual)))
8403 : {
8404 6 : M2MetaError_MetaError2 ((const char *) "cannot pass a nested procedure {%1Ea} seen in the {%2N} parameter as the outer scope will be unknown at runtime", 111, Actual, i);
8405 : }
8406 : /* we can check the return type of both proc types */
8407 47081 : if ((ActualType != SymbolTable_NulSym) && (SymbolTable_IsProcType (ActualType)))
8408 : {
8409 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8410 592 : if (((SymbolTable_GetSType (ActualType)) != SymbolTable_NulSym) && ((SymbolTable_GetSType (FormalType)) == SymbolTable_NulSym))
8411 : {
8412 0 : FailParameter (tokpos, (const char *) "the item being passed is a function whereas the formal procedure parameter is a procedure", 89, Actual, ProcSym, i);
8413 0 : return;
8414 : }
8415 592 : else if (((SymbolTable_GetSType (ActualType)) == SymbolTable_NulSym) && ((SymbolTable_GetSType (FormalType)) != SymbolTable_NulSym))
8416 : {
8417 : /* avoid dangling else. */
8418 0 : FailParameter (tokpos, (const char *) "the item being passed is a procedure whereas the formal procedure parameter is a function", 89, Actual, ProcSym, i);
8419 0 : return;
8420 : }
8421 592 : else if (M2Base_AssignmentRequiresWarning (SymbolTable_GetSType (ActualType), SymbolTable_GetSType (FormalType)))
8422 : {
8423 : /* avoid dangling else. */
8424 0 : WarnParameter (tokpos, (const char *) "the return result of the procedure variable parameter may not be compatible on other targets with the return result of the item being passed", 140, Actual, ProcSym, i);
8425 0 : return;
8426 : }
8427 592 : else if (((M2System_IsGenericSystemType (SymbolTable_GetSType (FormalType))) || (M2System_IsGenericSystemType (SymbolTable_GetSType (ActualType)))) || (M2Base_IsAssignmentCompatible (SymbolTable_GetSType (ActualType), SymbolTable_GetSType (FormalType))))
8428 : {
8429 : /* avoid dangling else. */
8430 : }
8431 : else
8432 : {
8433 : /* avoid dangling else. */
8434 : /* pass */
8435 0 : FailParameter (tokpos, (const char *) "the return result of the procedure variable parameter is not compatible with the return result of the item being passed", 119, Actual, ProcSym, i);
8436 0 : return;
8437 : }
8438 : }
8439 : /* now to check each parameter of the proc type */
8440 47081 : CheckProcTypeAndProcedure (tokpos, FormalType, Actual, ParamCheckId);
8441 : }
8442 361557 : else if ((ActualType != FormalType) && (ActualType != SymbolTable_NulSym))
8443 : {
8444 : /* avoid dangling else. */
8445 17564 : if (SymbolTable_IsUnknown (FormalType))
8446 : {
8447 : /* Spellcheck. */
8448 0 : FailParameter (tokpos, (const char *) "procedure parameter type is undeclared {%1&s}", 45, Actual, ProcSym, i);
8449 0 : return;
8450 : }
8451 17564 : if ((SymbolTable_IsUnbounded (ActualType)) && (! (SymbolTable_IsUnboundedParamAny (ProcSym, i))))
8452 : {
8453 0 : FailParameter (tokpos, (const char *) "attempting to pass an unbounded array to a NON unbounded parameter", 66, Actual, ProcSym, i);
8454 0 : return;
8455 : }
8456 17564 : else if (SymbolTable_IsUnboundedParamAny (ProcSym, i))
8457 : {
8458 : /* avoid dangling else. */
8459 9664 : if (! (LegalUnboundedParam (tokpos, ProcSym, i, ActualType, Actual, Dimension, Formal)))
8460 : {
8461 : return;
8462 : }
8463 : }
8464 7900 : else if (ActualType != FormalType)
8465 : {
8466 : /* avoid dangling else. */
8467 7900 : if (M2Base_AssignmentRequiresWarning (FormalType, ActualType))
8468 : {
8469 0 : WarnParameter (tokpos, (const char *) "identifier being passed to this procedure may contain a possibly incompatible type when compiling for a different target", 120, Actual, ProcSym, i);
8470 : }
8471 7900 : else if (((M2System_IsGenericSystemType (FormalType)) || (M2System_IsGenericSystemType (ActualType))) || (M2Base_IsAssignmentCompatible (ActualType, FormalType)))
8472 : {
8473 : /* avoid dangling else. */
8474 : }
8475 : else
8476 : {
8477 : /* avoid dangling else. */
8478 : /* so far we know it is legal, but not all types have been resolved
8479 : and so this is checked later on in another pass. */
8480 24 : FailParameter (tokpos, (const char *) "identifier with an incompatible type is being passed to this procedure", 70, Actual, ProcSym, i);
8481 : }
8482 : }
8483 : }
8484 408620 : if (NewList)
8485 : {
8486 408620 : Lists_KillList (&TypeList);
8487 : }
8488 : }
8489 :
8490 :
8491 : /*
8492 : DescribeType - returns a String describing a symbol, Sym, name and its type.
8493 : */
8494 :
8495 0 : static DynamicStrings_String DescribeType (unsigned int Sym)
8496 : {
8497 0 : DynamicStrings_String s;
8498 0 : DynamicStrings_String s1;
8499 0 : DynamicStrings_String s2;
8500 0 : unsigned int Low;
8501 0 : unsigned int High;
8502 0 : unsigned int Subrange;
8503 0 : unsigned int Subscript;
8504 0 : unsigned int Type;
8505 :
8506 0 : s = static_cast<DynamicStrings_String> (NULL);
8507 0 : if (SymbolTable_IsConstString (Sym))
8508 : {
8509 : /* If = 1 then it maybe treated as a char. */
8510 0 : if ((SymbolTable_IsConstStringKnown (Sym)) && ((SymbolTable_GetStringLength (SymbolTable_GetDeclaredMod (Sym), Sym)) == 1))
8511 : {
8512 0 : s = DynamicStrings_InitString ((const char *) "(constant string) or {%kCHAR}", 29);
8513 : }
8514 : else
8515 : {
8516 0 : s = DynamicStrings_InitString ((const char *) "(constant string)", 17);
8517 : }
8518 : }
8519 0 : else if (SymbolTable_IsConst (Sym))
8520 : {
8521 : /* avoid dangling else. */
8522 0 : s = DynamicStrings_InitString ((const char *) "(constant)", 10);
8523 : }
8524 0 : else if (SymbolTable_IsUnknown (Sym))
8525 : {
8526 : /* avoid dangling else. */
8527 0 : s = DynamicStrings_InitString ((const char *) "(unknown)", 9);
8528 : }
8529 : else
8530 : {
8531 : /* avoid dangling else. */
8532 0 : Type = SymbolTable_GetSType (Sym);
8533 0 : if (Type == SymbolTable_NulSym)
8534 : {
8535 0 : s = DynamicStrings_InitString ((const char *) "(unknown)", 9);
8536 : }
8537 0 : else if (SymbolTable_IsUnbounded (Type))
8538 : {
8539 : /* avoid dangling else. */
8540 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (SymbolTable_GetSType (Type)))));
8541 0 : s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{%%kARRAY} {%%kOF} %s", 21)), (const unsigned char *) &s1, (sizeof (s1)-1));
8542 : }
8543 0 : else if (SymbolTable_IsArray (Type))
8544 : {
8545 : /* avoid dangling else. */
8546 0 : s = DynamicStrings_InitString ((const char *) "{%kARRAY} [", 11);
8547 0 : Subscript = SymbolTable_GetArraySubscript (Type);
8548 0 : if (Subscript != SymbolTable_NulSym)
8549 : {
8550 0 : M2Debug_Assert (SymbolTable_IsSubscript (Subscript));
8551 0 : Subrange = SymbolTable_GetSType (Subscript);
8552 0 : if (! (SymbolTable_IsSubrange (Subrange)))
8553 : {
8554 0 : M2MetaError_MetaError3 ((const char *) "error in definition of array {%1Ead} in the {%2N} subscript which has no subrange, instead type given is {%3a}", 110, Sym, Subscript, Subrange);
8555 : }
8556 0 : M2Debug_Assert (SymbolTable_IsSubrange (Subrange));
8557 0 : SymbolTable_GetSubrange (Subrange, &High, &Low);
8558 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Low))));
8559 0 : s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (High))));
8560 0 : s = DynamicStrings_ConCat (s, DynamicStrings_Mark (FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s..%s", 6)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1))));
8561 : }
8562 0 : s1 = DynamicStrings_Mark (DescribeType (Type));
8563 0 : s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "] OF ", 5))), s1);
8564 : }
8565 : else
8566 : {
8567 : /* avoid dangling else. */
8568 0 : if (SymbolTable_IsUnknown (Type))
8569 : {
8570 : /* Spellcheck. */
8571 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Type))));
8572 0 : s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s (currently unknown, check declaration or import) {%1&s}", 58)), (const unsigned char *) &s1, (sizeof (s1)-1));
8573 : }
8574 : else
8575 : {
8576 0 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Type)));
8577 : }
8578 : }
8579 : }
8580 0 : return s;
8581 : /* static analysis guarentees a RETURN statement will be used before here. */
8582 : __builtin_unreachable ();
8583 : }
8584 :
8585 :
8586 : /*
8587 : FailParameter - generates an error message indicating that a parameter
8588 : declaration has failed.
8589 :
8590 : The parameters are:
8591 :
8592 : CurrentState - string describing the current failing state.
8593 : Actual - actual parameter.
8594 : ParameterNo - parameter number that has failed.
8595 : ProcedureSym - procedure symbol where parameter has failed.
8596 :
8597 : If any parameter is Nul then it is ignored.
8598 : */
8599 :
8600 42 : static void FailParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo)
8601 : {
8602 42 : unsigned int FormalParam;
8603 42 : DynamicStrings_String Msg;
8604 42 : char CurrentState[_CurrentState_high+1];
8605 :
8606 : /* make a local copy of each unbounded array. */
8607 42 : memcpy (CurrentState, CurrentState_, _CurrentState_high+1);
8608 :
8609 84 : Msg = DynamicStrings_InitString ((const char *) "parameter mismatch between the {%2N} parameter of procedure {%1Ead}, ", 69);
8610 42 : Msg = DynamicStrings_ConCat (Msg, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) CurrentState, _CurrentState_high)));
8611 42 : M2MetaError_MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo);
8612 42 : if ((SymbolTable_NoOfParamAny (ProcedureSym)) >= ParameterNo)
8613 : {
8614 42 : FormalParam = SymbolTable_GetNthParamAnyClosest (ProcedureSym, ParameterNo, SymbolTable_GetCurrentModule ());
8615 42 : if (SymbolTable_IsUnboundedParamAny (ProcedureSym, ParameterNo))
8616 : {
8617 18 : M2MetaError_MetaErrorT2 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "formal parameter {%1ad} has an open array type {%2tad}", 54, FormalParam, SymbolTable_GetSType (SymbolTable_GetSType (FormalParam)));
8618 : }
8619 : else
8620 : {
8621 24 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "formal parameter {%1ad} has type {%1tad}", 40, FormalParam);
8622 : }
8623 : }
8624 : else
8625 : {
8626 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetDeclaredMod (ProcedureSym), (const char *) "procedure declaration", 21, ProcedureSym);
8627 : }
8628 42 : if ((SymbolTable_GetLType (Actual)) == SymbolTable_NulSym)
8629 : {
8630 0 : M2MetaError_MetaError1 ((const char *) "actual parameter being passed is {%1Eda} {%1ad}", 47, Actual);
8631 : }
8632 : else
8633 : {
8634 42 : if (SymbolTable_IsVar (Actual))
8635 : {
8636 36 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (Actual), (const char *) "actual parameter variable being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}", 87, Actual);
8637 : }
8638 : else
8639 : {
8640 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "actual parameter being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}", 78, Actual);
8641 : }
8642 : }
8643 42 : }
8644 :
8645 :
8646 : /*
8647 : WarnParameter - generates a warning message indicating that a parameter
8648 : use might cause problems on another target.
8649 :
8650 : CurrentState - string describing the current failing state.
8651 : Actual - actual parameter.
8652 : ParameterNo - parameter number that has failed.
8653 : ProcedureSym - procedure symbol where parameter has failed.
8654 :
8655 : If any parameter is Nul then it is ignored.
8656 : */
8657 :
8658 0 : static void WarnParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo)
8659 : {
8660 0 : unsigned int FormalParam;
8661 0 : DynamicStrings_String Msg;
8662 0 : char CurrentState[_CurrentState_high+1];
8663 :
8664 : /* make a local copy of each unbounded array. */
8665 0 : memcpy (CurrentState, CurrentState_, _CurrentState_high+1);
8666 :
8667 0 : Msg = DynamicStrings_InitString ((const char *) "{%W}parameter mismatch between the {%2N} parameter of procedure {%1ad}, ", 72);
8668 0 : Msg = DynamicStrings_ConCat (Msg, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) CurrentState, _CurrentState_high)));
8669 0 : M2MetaError_MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo);
8670 0 : if ((SymbolTable_NoOfParamAny (ProcedureSym)) >= ParameterNo)
8671 : {
8672 0 : FormalParam = SymbolTable_GetNthParamAnyClosest (ProcedureSym, ParameterNo, SymbolTable_GetCurrentModule ());
8673 0 : if (SymbolTable_IsUnboundedParamAny (ProcedureSym, ParameterNo))
8674 : {
8675 0 : M2MetaError_MetaErrorT2 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "{%W}formal parameter {%1ad} has an open array type {%2tad}", 58, FormalParam, SymbolTable_GetSType (SymbolTable_GetSType (FormalParam)));
8676 : }
8677 : else
8678 : {
8679 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "{%W}formal parameter {%1ad} has type {%1tad}", 44, FormalParam);
8680 : }
8681 : }
8682 : else
8683 : {
8684 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetDeclaredMod (ProcedureSym), (const char *) "{%W}procedure declaration", 25, ProcedureSym);
8685 : }
8686 0 : if ((SymbolTable_GetLType (Actual)) == SymbolTable_NulSym)
8687 : {
8688 0 : M2MetaError_MetaError1 ((const char *) "actual parameter being passed is {%1Wda} {%1ad}", 47, Actual);
8689 : }
8690 : else
8691 : {
8692 0 : if (SymbolTable_IsVar (Actual))
8693 : {
8694 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (Actual), (const char *) "actual parameter variable being passed is {%1Wda} {%1ad} of type {%1ts}", 71, Actual);
8695 : }
8696 : else
8697 : {
8698 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "actual parameter being passed is {%1Wda} {%1ad} of type {%1ts}", 62, Actual);
8699 : }
8700 : }
8701 0 : }
8702 :
8703 :
8704 : /*
8705 : doIndrX - perform des = *exp with a conversion if necessary.
8706 : */
8707 :
8708 16447 : static void doIndrX (unsigned int tok, unsigned int des, unsigned int exp)
8709 : {
8710 16447 : unsigned int t;
8711 :
8712 16447 : if ((SymbolTable_GetDType (des)) == (SymbolTable_GetDType (exp)))
8713 : {
8714 15929 : GenQuadOtok (tok, M2Quads_IndrXOp, des, SymbolTable_GetSType (des), exp, true, tok, tok, tok);
8715 : }
8716 : else
8717 : {
8718 518 : if (M2Options_StrictTypeAssignment)
8719 : {
8720 518 : BuildRange (M2Range_InitTypesIndrXCheck (tok, des, exp));
8721 : }
8722 518 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8723 518 : SymbolTable_PutVar (t, SymbolTable_GetSType (exp));
8724 518 : GenQuadOtok (tok, M2Quads_IndrXOp, t, SymbolTable_GetSType (exp), exp, true, tok, tok, tok);
8725 518 : GenQuadOtok (tok, M2Quads_BecomesOp, des, SymbolTable_NulSym, doVal (SymbolTable_GetSType (des), t), true, tok, M2LexBuf_UnknownTokenNo, tok);
8726 : }
8727 16447 : }
8728 :
8729 :
8730 : /*
8731 : MakeRightValue - returns a temporary which will have the RightValue of symbol, Sym.
8732 : If Sym is a right value and has type, type, then no quadruples are
8733 : generated and Sym is returned. Otherwise a new temporary is created
8734 : and an IndrX quadruple is generated.
8735 : */
8736 :
8737 1510 : static unsigned int MakeRightValue (unsigned int tok, unsigned int Sym, unsigned int type)
8738 : {
8739 1510 : unsigned int t;
8740 :
8741 1510 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_RightValue)
8742 : {
8743 0 : if ((SymbolTable_GetSType (Sym)) == type)
8744 : {
8745 : return Sym;
8746 : }
8747 : else
8748 : {
8749 : /*
8750 : type change or mode change, type changes are a pain, but I've
8751 : left them here as it is perhaps easier to remove them later.
8752 : */
8753 0 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8754 0 : SymbolTable_PutVar (t, type);
8755 0 : GenQuadOtok (tok, M2Quads_BecomesOp, t, SymbolTable_NulSym, doVal (type, Sym), true, tok, tok, tok);
8756 0 : return t;
8757 : }
8758 : }
8759 : else
8760 : {
8761 1510 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8762 1510 : SymbolTable_PutVar (t, type);
8763 1510 : CheckPointerThroughNil (tok, Sym);
8764 1510 : doIndrX (tok, t, Sym);
8765 1510 : return t;
8766 : }
8767 : /* static analysis guarentees a RETURN statement will be used before here. */
8768 : __builtin_unreachable ();
8769 : }
8770 :
8771 :
8772 : /*
8773 : MakeLeftValue - returns a temporary coresponding to the LeftValue of
8774 : symbol, Sym. No quadruple is generated if Sym is already
8775 : a LeftValue and has the same type.
8776 : */
8777 :
8778 191540 : static unsigned int MakeLeftValue (unsigned int tok, unsigned int Sym, SymbolTable_ModeOfAddr with, unsigned int type)
8779 : {
8780 191540 : unsigned int t;
8781 :
8782 191540 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
8783 : {
8784 5100 : if ((SymbolTable_GetSType (Sym)) == type)
8785 : {
8786 : return Sym;
8787 : }
8788 : else
8789 : {
8790 : /*
8791 : type change or mode change, type changes are a pain, but I've
8792 : left them here as it is perhaps easier to remove them later
8793 : */
8794 172 : t = SymbolTable_MakeTemporary (tok, with);
8795 172 : SymbolTable_PutVar (t, type);
8796 172 : GenQuadOtok (tok, M2Quads_BecomesOp, t, SymbolTable_NulSym, Sym, true, tok, M2LexBuf_UnknownTokenNo, tok);
8797 172 : return t;
8798 : }
8799 : }
8800 : else
8801 : {
8802 186440 : t = SymbolTable_MakeTemporary (tok, with);
8803 186440 : SymbolTable_PutVar (t, type);
8804 186440 : GenQuadOtok (tok, M2Quads_AddrOp, t, SymbolTable_NulSym, Sym, true, tok, M2LexBuf_UnknownTokenNo, tok);
8805 186440 : return t;
8806 : }
8807 : /* static analysis guarentees a RETURN statement will be used before here. */
8808 : __builtin_unreachable ();
8809 : }
8810 :
8811 :
8812 : /*
8813 : ManipulatePseudoCallParameters - manipulates the parameters to a pseudo function or
8814 : procedure. It dereferences all LeftValue parameters
8815 : and Boolean parameters.
8816 : The Stack:
8817 :
8818 :
8819 : Entry Exit
8820 :
8821 : Ptr -> exactly the same
8822 : +----------------+
8823 : | NoOfParameters |
8824 : |----------------|
8825 : | Param 1 |
8826 : |----------------|
8827 : | Param 2 |
8828 : |----------------|
8829 : . .
8830 : . .
8831 : . .
8832 : |----------------|
8833 : | Param # |
8834 : |----------------|
8835 : | ProcSym | Type |
8836 : |----------------|
8837 :
8838 : */
8839 :
8840 65407 : static void ManipulatePseudoCallParameters (void)
8841 : {
8842 65407 : unsigned int NoOfParameters;
8843 65407 : unsigned int ProcSym;
8844 65407 : unsigned int Proc;
8845 65407 : unsigned int i;
8846 65407 : unsigned int pi;
8847 65407 : M2Quads_BoolFrame f;
8848 :
8849 65407 : M2Quads_PopT (&NoOfParameters);
8850 65407 : M2Quads_PushT (NoOfParameters); /* restored to original state */
8851 : /* Ptr points to the ProcSym */
8852 65407 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((NoOfParameters+1)+1));
8853 65407 : if (SymbolTable_IsVar (ProcSym))
8854 : {
8855 0 : M2Error_InternalError ((const char *) "expecting a pseudo procedure or a type", 38);
8856 : }
8857 : else
8858 : {
8859 65407 : Proc = ProcSym;
8860 : }
8861 65407 : i = 1;
8862 65407 : pi = NoOfParameters+1;
8863 143452 : while (i <= NoOfParameters)
8864 : {
8865 78045 : if (((((((SymbolTable_GetMode (M2Quads_OperandT (pi))) == SymbolTable_LeftValue) && (Proc != M2System_Adr)) && (Proc != M2Size_Size)) && (Proc != M2System_TSize)) && (Proc != M2Base_High)) && (((((((Proc != M2Base_Inc) && (Proc != M2Base_Incl)) && (Proc != M2Base_Dec)) && (Proc != M2Base_Excl)) && (Proc != M2Base_New)) && (Proc != M2Base_Dispose)) || (i > 1)))
8866 : {
8867 : /* must dereference LeftValue */
8868 1344 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pi));
8869 1344 : f->TrueExit = MakeRightValue (M2LexBuf_GetTokenNo (), M2Quads_OperandT (pi), SymbolTable_GetSType (M2Quads_OperandT (pi)));
8870 : }
8871 78045 : i += 1;
8872 78045 : pi -= 1;
8873 : }
8874 65407 : }
8875 :
8876 :
8877 : /*
8878 : ManipulateParameters - manipulates the procedure parameters in
8879 : preparation for a procedure call.
8880 : Prepares Boolean, Unbounded and VAR parameters.
8881 : The Stack:
8882 :
8883 :
8884 : Entry Exit
8885 :
8886 : Ptr -> exactly the same
8887 : +----------------+
8888 : | NoOfParameters |
8889 : |----------------|
8890 : | Param 1 |
8891 : |----------------|
8892 : | Param 2 |
8893 : |----------------|
8894 : . .
8895 : . .
8896 : . .
8897 : |----------------|
8898 : | Param # |
8899 : |----------------|
8900 : | ProcSym | Type |
8901 : |----------------|
8902 : */
8903 :
8904 212988 : static void ManipulateParameters (bool IsForC)
8905 : {
8906 212988 : unsigned int tokpos;
8907 212988 : unsigned int np;
8908 212988 : DynamicStrings_String s;
8909 212988 : unsigned int ArraySym;
8910 212988 : unsigned int UnboundedType;
8911 212988 : unsigned int ParamType;
8912 212988 : unsigned int NoOfParameters;
8913 212988 : unsigned int i;
8914 212988 : unsigned int pi;
8915 212988 : unsigned int ProcSym;
8916 212988 : unsigned int rw;
8917 212988 : unsigned int Proc;
8918 212988 : unsigned int t;
8919 212988 : M2Quads_BoolFrame f;
8920 :
8921 212988 : M2Quads_PopT (&NoOfParameters);
8922 212988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+1));
8923 212988 : tokpos = OperandTtok (NoOfParameters+1);
8924 212988 : if (SymbolTable_IsVar (ProcSym))
8925 : {
8926 : /* Procedure Variable ? */
8927 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF (NoOfParameters+1));
8928 : }
8929 : else
8930 : {
8931 212216 : Proc = PCSymBuild_SkipConst (ProcSym);
8932 : }
8933 212988 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8934 : {
8935 : /* avoid dangling else. */
8936 9613 : if (NoOfParameters < (SymbolTable_NoOfParamAny (Proc)))
8937 : {
8938 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8939 0 : np = SymbolTable_NoOfParamAny (Proc);
8940 0 : M2Error_ErrorStringAt2 (FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "attempting to pass (%d) parameters to procedure (%s) which was declared with varargs but contains at least (%d) parameters", 122)), (const unsigned char *) &NoOfParameters, (sizeof (NoOfParameters)-1), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &np, (sizeof (np)-1)), tokpos, SymbolTable_GetDeclaredMod (ProcSym));
8941 : }
8942 : }
8943 203375 : else if (SymbolTable_UsesOptArgAny (Proc))
8944 : {
8945 : /* avoid dangling else. */
8946 3516 : if (! ((NoOfParameters == (SymbolTable_NoOfParamAny (Proc))) || ((NoOfParameters+1) == (SymbolTable_NoOfParamAny (Proc)))))
8947 : {
8948 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8949 0 : np = SymbolTable_NoOfParamAny (Proc);
8950 0 : M2Error_ErrorStringAt2 (FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "attempting to pass (%d) parameters to procedure (%s) which was declared with an optarg with a maximum of (%d) parameters", 120)), (const unsigned char *) &NoOfParameters, (sizeof (NoOfParameters)-1), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &np, (sizeof (np)-1)), tokpos, SymbolTable_GetDeclaredMod (ProcSym));
8951 : }
8952 : }
8953 199859 : else if (NoOfParameters != (SymbolTable_NoOfParamAny (Proc)))
8954 : {
8955 : /* avoid dangling else. */
8956 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8957 0 : np = SymbolTable_NoOfParamAny (Proc);
8958 0 : M2Error_ErrorStringAt2 (FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "attempting to pass (%d) parameters to procedure (%s) which was declared with (%d) parameters", 92)), (const unsigned char *) &NoOfParameters, (sizeof (NoOfParameters)-1), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &np, (sizeof (np)-1)), tokpos, SymbolTable_GetDeclaredMod (ProcSym));
8959 : }
8960 212988 : i = 1;
8961 212988 : pi = NoOfParameters;
8962 742453 : while (i <= NoOfParameters)
8963 : {
8964 529465 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pi));
8965 529465 : rw = static_cast<unsigned int> (OperandMergeRW (pi));
8966 529465 : M2Debug_Assert (SymbolTable_IsLegal (rw));
8967 529465 : if (i > (SymbolTable_NoOfParamAny (Proc)))
8968 : {
8969 8258 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8970 : {
8971 : /* avoid dangling else. */
8972 8258 : if (((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym) && (SymbolTable_IsArray (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
8973 : {
8974 156 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_RightValue, M2System_Address);
8975 156 : MarkAsReadWrite (rw);
8976 : }
8977 8102 : else if (SymbolTable_IsConstString (M2Quads_OperandT (pi)))
8978 : {
8979 : /* avoid dangling else. */
8980 282 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), DeferMakeConstStringCnul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi)), SymbolTable_RightValue, M2System_Address);
8981 282 : MarkAsReadWrite (rw);
8982 : }
8983 7820 : else if (((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (M2Quads_OperandT (pi)))))
8984 : {
8985 : /* avoid dangling else. */
8986 200 : MarkAsReadWrite (rw);
8987 : /* pass the address field of an unbounded variable */
8988 200 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, M2Quads_OperandTok (pi));
8989 200 : PushTFAD (f->TrueExit, f->FalseExit, f->Unbounded, f->Dimension);
8990 200 : M2Quads_PushT (static_cast<unsigned int> (1));
8991 200 : BuildAdrFunction ();
8992 200 : M2Quads_PopT (&f->TrueExit);
8993 : }
8994 7620 : else if ((SymbolTable_GetMode (M2Quads_OperandT (pi))) == SymbolTable_LeftValue)
8995 : {
8996 : /* avoid dangling else. */
8997 460 : MarkAsReadWrite (rw);
8998 : /* must dereference LeftValue (even if we are passing variable as a vararg) */
8999 460 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9000 460 : SymbolTable_PutVar (t, SymbolTable_GetSType (M2Quads_OperandT (pi)));
9001 460 : CheckPointerThroughNil (tokpos, M2Quads_OperandT (pi));
9002 460 : doIndrX (M2Quads_OperandTok (pi), t, M2Quads_OperandT (pi));
9003 460 : f->TrueExit = t;
9004 : }
9005 : }
9006 : else
9007 : {
9008 0 : M2MetaError_MetaErrorT2 (tokpos, (const char *) "attempting to pass too many parameters to procedure {%1a}, the {%2N} parameter does not exist", 93, Proc, i);
9009 : }
9010 : }
9011 521207 : else if (((IsForC && (SymbolTable_IsUnboundedParamAny (Proc, i))) && ((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym)) && (SymbolTable_IsArray (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
9012 : {
9013 : /* avoid dangling else. */
9014 24 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_RightValue, M2System_Address);
9015 24 : MarkAsReadWrite (rw);
9016 : }
9017 521183 : else if (((IsForC && (SymbolTable_IsUnboundedParamAny (Proc, i))) && ((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym)) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
9018 : {
9019 : /* avoid dangling else. */
9020 184 : MarkAsReadWrite (rw);
9021 : /* pass the address field of an unbounded variable */
9022 184 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, M2Quads_OperandTok (pi));
9023 184 : PushTFAD (f->TrueExit, f->FalseExit, f->Unbounded, f->Dimension);
9024 184 : M2Quads_PushT (static_cast<unsigned int> (1));
9025 184 : BuildAdrFunction ();
9026 184 : M2Quads_PopT (&f->TrueExit);
9027 : }
9028 520999 : else if ((IsForC && (SymbolTable_IsConstString (M2Quads_OperandT (pi)))) && ((SymbolTable_IsUnboundedParamAny (Proc, i)) || ((SymbolTable_GetDType (SymbolTable_GetParam (Proc, i))) == M2System_Address)))
9029 : {
9030 : /* avoid dangling else. */
9031 9301 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), DeferMakeConstStringCnul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi)), SymbolTable_RightValue, M2System_Address);
9032 9301 : MarkAsReadWrite (rw);
9033 : }
9034 511698 : else if (SymbolTable_IsUnboundedParamAny (Proc, i))
9035 : {
9036 : /* avoid dangling else. */
9037 : /* always pass constant strings with a nul terminator, but leave the HIGH as before. */
9038 39741 : if (SymbolTable_IsConstString (M2Quads_OperandT (pi)))
9039 : {
9040 : /* this is a Modula-2 string which must be nul terminated. */
9041 25939 : f->TrueExit = DeferMakeConstStringM2nul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi));
9042 : }
9043 39741 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9044 39741 : UnboundedType = SymbolTable_GetSType (SymbolTable_GetParam (Proc, i));
9045 39741 : SymbolTable_PutVar (t, UnboundedType);
9046 39741 : ParamType = SymbolTable_GetSType (UnboundedType);
9047 39741 : if ((OperandD (pi)) == 0)
9048 : {
9049 39693 : ArraySym = static_cast<unsigned int> (M2Quads_OperandT (pi));
9050 : }
9051 : else
9052 : {
9053 48 : ArraySym = static_cast<unsigned int> (M2Quads_OperandA (pi));
9054 : }
9055 39741 : if (SymbolTable_IsVarParamAny (Proc, i))
9056 : {
9057 4316 : MarkArrayWritten (M2Quads_OperandT (pi));
9058 4316 : MarkArrayWritten (M2Quads_OperandA (pi));
9059 4316 : MarkAsReadWrite (rw);
9060 4316 : AssignUnboundedVar (OperandTtok (pi), M2Quads_OperandT (pi), ArraySym, t, ParamType, OperandD (pi));
9061 : }
9062 : else
9063 : {
9064 35425 : MarkAsRead (rw);
9065 35425 : AssignUnboundedNonVar (OperandTtok (pi), M2Quads_OperandT (pi), ArraySym, t, ParamType, OperandD (pi));
9066 : }
9067 39741 : f->TrueExit = t;
9068 : }
9069 471957 : else if (SymbolTable_IsVarParamAny (Proc, i))
9070 : {
9071 : /* avoid dangling else. */
9072 : /* must reference by address, but we contain the type of the referenced entity */
9073 15490 : MarkArrayWritten (M2Quads_OperandT (pi));
9074 15490 : MarkArrayWritten (M2Quads_OperandA (pi));
9075 15490 : MarkAsReadWrite (rw);
9076 15490 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_LeftValue, SymbolTable_GetSType (SymbolTable_GetParam (Proc, i)));
9077 : }
9078 456467 : else if ((! (SymbolTable_IsVarParamAny (Proc, i))) && ((SymbolTable_GetMode (M2Quads_OperandT (pi))) == SymbolTable_LeftValue))
9079 : {
9080 : /* avoid dangling else. */
9081 : /* must dereference LeftValue */
9082 1470 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9083 1470 : SymbolTable_PutVar (t, SymbolTable_GetSType (M2Quads_OperandT (pi)));
9084 1470 : CheckPointerThroughNil (tokpos, M2Quads_OperandT (pi));
9085 1470 : doIndrX (M2Quads_OperandTok (pi), t, M2Quads_OperandT (pi));
9086 1470 : f->TrueExit = t;
9087 1470 : MarkAsRead (rw);
9088 : }
9089 : else
9090 : {
9091 : /* avoid dangling else. */
9092 454997 : MarkAsRead (rw);
9093 : }
9094 529465 : i += 1;
9095 529465 : pi -= 1;
9096 : }
9097 212988 : M2Quads_PushT (NoOfParameters);
9098 212988 : }
9099 :
9100 :
9101 : /*
9102 : CheckParameterOrdinals - check that ordinal values are within type range.
9103 : */
9104 :
9105 212988 : static void CheckParameterOrdinals (void)
9106 : {
9107 212988 : unsigned int tokno;
9108 212988 : unsigned int Proc;
9109 212988 : unsigned int ProcSym;
9110 212988 : unsigned int Actual;
9111 212988 : unsigned int FormalI;
9112 212988 : unsigned int ParamTotal;
9113 212988 : unsigned int pi;
9114 212988 : unsigned int i;
9115 :
9116 212988 : M2Quads_PopT (&ParamTotal);
9117 212988 : M2Quads_PushT (ParamTotal); /* Restore stack to origional state */
9118 212988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((ParamTotal+1)+1)); /* Restore stack to origional state */
9119 212988 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (SymbolTable_GetDType (ProcSym))))
9120 : {
9121 : /* Indirect procedure call. */
9122 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF ((ParamTotal+1)+1));
9123 : }
9124 : else
9125 : {
9126 212216 : Proc = PCSymBuild_SkipConst (ProcSym);
9127 : }
9128 212988 : i = 1;
9129 212988 : pi = ParamTotal+1; /* stack index referencing stacked parameter, i */
9130 742453 : while (i <= ParamTotal) /* stack index referencing stacked parameter, i */
9131 : {
9132 529465 : if (i <= (SymbolTable_NoOfParamAny (Proc)))
9133 : {
9134 521207 : FormalI = SymbolTable_GetParam (Proc, i);
9135 521207 : Actual = static_cast<unsigned int> (M2Quads_OperandT (pi));
9136 521207 : tokno = static_cast<unsigned int> (M2Quads_OperandTok (pi));
9137 521207 : if (M2Base_IsOrdinalType (SymbolTable_GetLType (FormalI)))
9138 : {
9139 136555 : if (! (SymbolTable_IsSet (SymbolTable_GetDType (FormalI))))
9140 : {
9141 : /* Tell the code generator to test the runtime values of the assignment
9142 : so ensure we catch overflow and underflow. */
9143 136555 : BuildRange (M2Range_InitParameterRangeCheck (tokno, Proc, i, FormalI, Actual, OperandRangeDep (pi)));
9144 : }
9145 : }
9146 : }
9147 529465 : i += 1;
9148 529465 : pi -= 1;
9149 : }
9150 212988 : }
9151 :
9152 :
9153 : /*
9154 : IsSameUnbounded - returns TRUE if unbounded types, t1, and, t2,
9155 : are compatible.
9156 : */
9157 :
9158 36 : static bool IsSameUnbounded (unsigned int t1, unsigned int t2)
9159 : {
9160 36 : M2Debug_Assert (SymbolTable_IsUnbounded (t1));
9161 36 : M2Debug_Assert (SymbolTable_IsUnbounded (t2));
9162 36 : return (SymbolTable_GetDType (t1)) == (SymbolTable_GetDType (t2));
9163 : /* static analysis guarentees a RETURN statement will be used before here. */
9164 : __builtin_unreachable ();
9165 : }
9166 :
9167 :
9168 : /*
9169 : AssignUnboundedVar - assigns an Unbounded symbol fields,
9170 : ArrayAddress and ArrayHigh, from an array symbol.
9171 : UnboundedSym is not a VAR parameter and therefore
9172 : this procedure can complete both of the fields.
9173 : Sym can be a Variable with type Unbounded.
9174 : Sym can be a Variable with type Array.
9175 : Sym can be a String Constant.
9176 :
9177 : ParamType is the TYPE of the parameter
9178 : */
9179 :
9180 4316 : static void AssignUnboundedVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9181 : {
9182 4316 : unsigned int Type;
9183 :
9184 4316 : if (SymbolTable_IsConst (Sym))
9185 : {
9186 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9187 : }
9188 4316 : else if (SymbolTable_IsVar (Sym))
9189 : {
9190 : /* avoid dangling else. */
9191 4316 : Type = SymbolTable_GetDType (Sym);
9192 4316 : if (Type == SymbolTable_NulSym)
9193 : {
9194 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} has no type and cannot be passed to a VAR formal parameter", 65, Sym);
9195 : }
9196 4316 : else if (SymbolTable_IsUnbounded (Type))
9197 : {
9198 : /* avoid dangling else. */
9199 1462 : if (Type == (SymbolTable_GetSType (UnboundedSym)))
9200 : {
9201 : /* Copy Unbounded Symbol ie. UnboundedSym := Sym */
9202 1426 : M2Quads_PushT (UnboundedSym);
9203 1426 : M2Quads_PushT (Sym);
9204 1426 : BuildAssignmentWithoutBounds (tok, false, true);
9205 : }
9206 36 : else if ((IsSameUnbounded (Type, SymbolTable_GetSType (UnboundedSym))) || (M2System_IsGenericSystemType (ParamType)))
9207 : {
9208 : /* avoid dangling else. */
9209 36 : UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9210 : }
9211 : else
9212 : {
9213 : /* avoid dangling else. */
9214 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9215 : }
9216 : }
9217 2854 : else if ((SymbolTable_IsArray (Type)) || (M2System_IsGenericSystemType (ParamType)))
9218 : {
9219 : /* avoid dangling else. */
9220 2854 : UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9221 : }
9222 : else
9223 : {
9224 : /* avoid dangling else. */
9225 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9226 : }
9227 : }
9228 : else
9229 : {
9230 : /* avoid dangling else. */
9231 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9232 : }
9233 4316 : }
9234 :
9235 :
9236 : /*
9237 : AssignUnboundedNonVar - assigns an Unbounded symbol fields,
9238 : The difference between this procedure and
9239 : AssignUnboundedVar is that this procedure cannot
9240 : set the Unbounded.Address since the data from
9241 : Sym will be copied because parameter is NOT a VAR
9242 : parameter.
9243 : UnboundedSym is not a VAR parameter and therefore
9244 : this procedure can only complete the HIGH field
9245 : and not the ADDRESS field.
9246 : Sym can be a Variable with type Unbounded.
9247 : Sym can be a Variable with type Array.
9248 : Sym can be a String Constant.
9249 :
9250 : ParamType is the TYPE of the paramater
9251 : */
9252 :
9253 35425 : static void AssignUnboundedNonVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9254 : {
9255 35425 : unsigned int Type;
9256 :
9257 35425 : if (SymbolTable_IsConst (Sym)) /* was IsConstString(Sym) */
9258 : {
9259 25993 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9260 : }
9261 9432 : else if (SymbolTable_IsVar (Sym))
9262 : {
9263 : /* avoid dangling else. */
9264 9432 : Type = SymbolTable_GetDType (Sym);
9265 9432 : if (Type == SymbolTable_NulSym)
9266 : {
9267 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} has no type and cannot be passed to a non VAR formal parameter", 69, Sym);
9268 : }
9269 9432 : else if (SymbolTable_IsUnbounded (Type))
9270 : {
9271 : /* avoid dangling else. */
9272 4762 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9273 : }
9274 4670 : else if ((SymbolTable_IsArray (Type)) || (M2System_IsGenericSystemType (ParamType)))
9275 : {
9276 : /* avoid dangling else. */
9277 4658 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9278 : }
9279 : else
9280 : {
9281 : /* avoid dangling else. */
9282 12 : M2MetaError_MetaErrorT1 (tok, (const char *) "illegal type parameter {%1Ead} expecting array or dynamic array", 63, Sym);
9283 : }
9284 : }
9285 : else
9286 : {
9287 : /* avoid dangling else. */
9288 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "illegal parameter {%1Ead} which cannot be passed as {%kVAR} {%kARRAY} {%kOF} {%1tsad}", 85, Sym);
9289 : }
9290 35425 : }
9291 :
9292 :
9293 : /*
9294 : GenHigh - generates a HighOp but it checks if op3 is a
9295 : L value and if so it dereferences it. This
9296 : is inefficient, however it is clean and we let the gcc
9297 : backend detect these as common subexpressions.
9298 : It will also detect that a R value -> L value -> R value
9299 : via indirection and eleminate these.
9300 : */
9301 :
9302 41181 : static void GenHigh (unsigned int tok, unsigned int op1, unsigned int op2, unsigned int op3)
9303 : {
9304 41181 : unsigned int sym;
9305 :
9306 41181 : if (((SymbolTable_GetMode (op3)) == SymbolTable_LeftValue) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (op3))))
9307 : {
9308 48 : sym = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
9309 48 : SymbolTable_PutVar (sym, SymbolTable_GetSType (op3));
9310 48 : doIndrX (tok, sym, op3);
9311 48 : GenQuadO (tok, M2Quads_HighOp, op1, op2, sym, true);
9312 : }
9313 : else
9314 : {
9315 41133 : GenQuadO (tok, M2Quads_HighOp, op1, op2, op3, true);
9316 : }
9317 41181 : }
9318 :
9319 :
9320 : /*
9321 : AssignHighField -
9322 : */
9323 :
9324 38459 : static void AssignHighField (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int actuali, unsigned int formali)
9325 : {
9326 38459 : unsigned int ReturnVar;
9327 38459 : unsigned int ArrayType;
9328 38459 : unsigned int Field;
9329 :
9330 : /* Unbounded.ArrayHigh := HIGH(ArraySym) */
9331 38459 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9332 38459 : Field = SymbolTable_GetUnboundedHighOffset (SymbolTable_GetSType (UnboundedSym), formali);
9333 38459 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9334 38459 : M2Quads_PushT (static_cast<unsigned int> (1));
9335 38459 : M2Quads_BuildDesignatorRecord (tok);
9336 38459 : if (M2System_IsGenericSystemType (ParamType))
9337 : {
9338 2036 : if (SymbolTable_IsConstString (Sym))
9339 : {
9340 18 : M2Quads_PushTtok (DeferMakeLengthConst (tok, Sym), tok);
9341 : }
9342 : else
9343 : {
9344 2018 : ArrayType = SymbolTable_GetSType (Sym);
9345 2018 : if (SymbolTable_IsUnbounded (ArrayType))
9346 : {
9347 : /*
9348 : * SIZE(parameter) DIV TSIZE(ParamType)
9349 : * however in this case parameter
9350 : * is an unbounded symbol and therefore we must use
9351 : * (HIGH(parameter)+1)*SIZE(unbounded type) DIV TSIZE(ParamType)
9352 : *
9353 : * we call upon the function SIZE(ArraySym)
9354 : * remember SIZE doubles as
9355 : * (HIGH(a)+1) * SIZE(ArrayType) for unbounded symbols
9356 : */
9357 1106 : M2Quads_PushTFtok (calculateMultipicand (tok, ArraySym, ArrayType, actuali-1), M2Base_Cardinal, tok);
9358 1106 : M2Quads_PushT (M2Reserved_DivideTok); /* Divide by */
9359 1106 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ParamType) */
9360 1106 : M2Quads_PushTtok (ParamType, tok); /* TSIZE(ParamType) */
9361 1106 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9362 1106 : M2Quads_BuildFunctionCall (false); /* 1 parameter for TSIZE() */
9363 1106 : M2Quads_BuildBinaryOp ();
9364 : }
9365 : else
9366 : {
9367 : /* SIZE(parameter) DIV TSIZE(ParamType) */
9368 912 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ArrayType) */
9369 912 : M2Quads_PushTtok (ArrayType, tok); /* TSIZE(ArrayType) */
9370 912 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9371 912 : M2Quads_BuildFunctionCall (true); /* 1 parameter for TSIZE() */
9372 912 : M2Quads_PushT (M2Reserved_DivideTok); /* Divide by */
9373 912 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ParamType) */
9374 912 : M2Quads_PushTtok (ParamType, tok); /* TSIZE(ParamType) */
9375 912 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9376 912 : M2Quads_BuildFunctionCall (true); /* 1 parameter for TSIZE() */
9377 912 : M2Quads_BuildBinaryOp ();
9378 : }
9379 : /* now convert from no of elements into HIGH by subtracting 1 */
9380 2018 : M2Quads_PushT (M2Reserved_MinusTok); /* -1 */
9381 2018 : M2Quads_PushTtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal), tok); /* -1 */
9382 2018 : M2Quads_BuildBinaryOp ();
9383 : }
9384 : }
9385 : else
9386 : {
9387 36423 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
9388 36423 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
9389 36423 : if (((actuali != formali) && (ArraySym != SymbolTable_NulSym)) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (ArraySym))))
9390 : {
9391 12 : GenHigh (tok, ReturnVar, actuali, ArraySym);
9392 : }
9393 : else
9394 : {
9395 36411 : GenHigh (tok, ReturnVar, formali, Sym);
9396 : }
9397 36423 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), tok);
9398 : }
9399 38459 : BuildAssignmentWithoutBounds (tok, false, true);
9400 38459 : }
9401 :
9402 :
9403 : /*
9404 : AssignHighFields -
9405 : */
9406 :
9407 38303 : static void AssignHighFields (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9408 : {
9409 38303 : unsigned int type;
9410 38303 : unsigned int actuali;
9411 38303 : unsigned int formali;
9412 38303 : unsigned int actualn;
9413 38303 : unsigned int formaln;
9414 :
9415 38303 : type = SymbolTable_GetDType (Sym);
9416 38303 : actualn = 1;
9417 38303 : if ((type != SymbolTable_NulSym) && ((SymbolTable_IsUnbounded (type)) || (SymbolTable_IsArray (type))))
9418 : {
9419 11428 : actualn = SymbolTable_GetDimension (type);
9420 : }
9421 38303 : actuali = dim+1;
9422 38303 : formali = 1;
9423 38303 : formaln = SymbolTable_GetDimension (SymbolTable_GetDType (UnboundedSym));
9424 76762 : while ((actuali < actualn) && (formali < formaln))
9425 : {
9426 156 : AssignHighField (tok, Sym, ArraySym, UnboundedSym, SymbolTable_NulSym, actuali, formali);
9427 156 : actuali += 1;
9428 156 : formali += 1;
9429 : }
9430 38303 : AssignHighField (tok, Sym, ArraySym, UnboundedSym, ParamType, actuali, formali);
9431 38303 : }
9432 :
9433 :
9434 : /*
9435 : UnboundedNonVarLinkToArray - links an array, ArraySym, to an unbounded
9436 : array, UnboundedSym. The parameter is a
9437 : NON VAR variety.
9438 : */
9439 :
9440 35413 : static void UnboundedNonVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9441 : {
9442 35413 : unsigned int Field;
9443 35413 : unsigned int AddressField;
9444 :
9445 : /* Unbounded.ArrayAddress := to be assigned at runtime. */
9446 35413 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9447 35413 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
9448 35413 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9449 35413 : M2Quads_PushT (static_cast<unsigned int> (1));
9450 35413 : M2Quads_BuildDesignatorRecord (tok);
9451 35413 : M2Quads_PopT (&AddressField);
9452 : /* caller saves non var unbounded array contents. */
9453 70826 : GenQuadO (tok, M2Quads_UnboundedOp, AddressField, SymbolTable_NulSym, Sym, false);
9454 35413 : AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9455 35413 : }
9456 :
9457 :
9458 : /*
9459 : UnboundedVarLinkToArray - links an array, ArraySym, to an unbounded array,
9460 : UnboundedSym. The parameter is a VAR variety.
9461 : */
9462 :
9463 2890 : static void UnboundedVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9464 : {
9465 2890 : unsigned int SymType;
9466 2890 : unsigned int Field;
9467 :
9468 2890 : SymType = SymbolTable_GetSType (Sym);
9469 : /* Unbounded.ArrayAddress := ADR(Sym) */
9470 2890 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9471 2890 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
9472 2890 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9473 2890 : M2Quads_PushT (static_cast<unsigned int> (1));
9474 2890 : M2Quads_BuildDesignatorRecord (tok);
9475 2890 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok); /* ADR (Sym). */
9476 2890 : if ((SymbolTable_IsUnbounded (SymType)) && (dim == 0)) /* ADR (Sym). */
9477 : {
9478 12 : PushTFADtok (Sym, SymType, UnboundedSym, dim, tok);
9479 : }
9480 : else
9481 : {
9482 2878 : PushTFADtok (Sym, SymType, ArraySym, dim, tok);
9483 : }
9484 2890 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for ADR(). */
9485 2890 : M2Quads_BuildFunctionCall (false); /* 1 parameter for ADR(). */
9486 2890 : BuildAssignmentWithoutBounds (tok, false, true);
9487 2890 : AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9488 2890 : }
9489 :
9490 :
9491 : /*
9492 : BuildPseudoProcedureCall - builds a pseudo procedure call.
9493 : This procedure does not directly alter the
9494 : stack, but by calling routines the stack
9495 : will change in the following way when this
9496 : procedure returns.
9497 :
9498 : The Stack:
9499 :
9500 :
9501 : Entry Exit
9502 :
9503 : Ptr ->
9504 : +----------------+
9505 : | NoOfParam |
9506 : |----------------|
9507 : | Param 1 |
9508 : |----------------|
9509 : | Param 2 |
9510 : |----------------|
9511 : . .
9512 : . .
9513 : . .
9514 : |----------------|
9515 : | Param # |
9516 : |----------------|
9517 : | ProcSym | Type | Empty
9518 : |----------------|
9519 : */
9520 :
9521 20515 : static void BuildPseudoProcedureCall (unsigned int tokno)
9522 : {
9523 20515 : unsigned int NoOfParam;
9524 20515 : unsigned int ProcSym;
9525 :
9526 20515 : M2Quads_PopT (&NoOfParam);
9527 20515 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
9528 20515 : M2Quads_PushT (NoOfParam);
9529 : /* Compile time stack restored to entry state */
9530 20515 : if (ProcSym == M2Base_New)
9531 : {
9532 861 : BuildNewProcedure (tokno);
9533 : }
9534 19654 : else if (ProcSym == M2Base_Dispose)
9535 : {
9536 : /* avoid dangling else. */
9537 328 : BuildDisposeProcedure (tokno);
9538 : }
9539 19326 : else if (ProcSym == M2Base_Inc)
9540 : {
9541 : /* avoid dangling else. */
9542 13557 : BuildIncProcedure (tokno);
9543 : }
9544 5769 : else if (ProcSym == M2Base_Dec)
9545 : {
9546 : /* avoid dangling else. */
9547 3797 : BuildDecProcedure (tokno);
9548 : }
9549 1972 : else if (ProcSym == M2Base_Incl)
9550 : {
9551 : /* avoid dangling else. */
9552 1101 : BuildInclProcedure (tokno);
9553 : }
9554 871 : else if (ProcSym == M2Base_Excl)
9555 : {
9556 : /* avoid dangling else. */
9557 761 : BuildExclProcedure (tokno);
9558 : }
9559 110 : else if (ProcSym == M2System_Throw)
9560 : {
9561 : /* avoid dangling else. */
9562 110 : BuildThrowProcedure (tokno);
9563 : }
9564 : else
9565 : {
9566 : /* avoid dangling else. */
9567 0 : M2Error_InternalError ((const char *) "pseudo procedure not implemented yet", 36);
9568 : }
9569 20515 : }
9570 :
9571 :
9572 : /*
9573 : GetItemPointedTo - returns the symbol type that is being pointed to
9574 : by Sym.
9575 : */
9576 :
9577 3002 : static unsigned int GetItemPointedTo (unsigned int Sym)
9578 : {
9579 6012 : if (SymbolTable_IsPointer (Sym))
9580 : {
9581 3002 : return SymbolTable_GetSType (Sym);
9582 : }
9583 3010 : else if ((SymbolTable_IsVar (Sym)) || (SymbolTable_IsType (Sym)))
9584 : {
9585 : /* avoid dangling else. */
9586 3010 : return GetItemPointedTo (SymbolTable_GetSType (Sym));
9587 : }
9588 : else
9589 : {
9590 : /* avoid dangling else. */
9591 : return SymbolTable_NulSym;
9592 : }
9593 : /* static analysis guarentees a RETURN statement will be used before here. */
9594 : __builtin_unreachable ();
9595 : }
9596 :
9597 :
9598 : /*
9599 : BuildThrowProcedure - builds the pseudo procedure call M2RTS.Throw.
9600 : The Stack:
9601 :
9602 :
9603 : Entry Exit
9604 :
9605 : Ptr ->
9606 : +----------------+
9607 : | NoOfParam |
9608 : |----------------|
9609 : | Param 1 |
9610 : |----------------|
9611 : | Param 2 |
9612 : |----------------|
9613 : . .
9614 : . .
9615 : . .
9616 : |----------------|
9617 : | Param # |
9618 : |----------------|
9619 : | ProcSym | Type | Empty
9620 : |----------------|
9621 : */
9622 :
9623 110 : static void BuildThrowProcedure (unsigned int functok)
9624 : {
9625 110 : unsigned int op;
9626 110 : unsigned int NoOfParam;
9627 :
9628 110 : M2Quads_PopT (&NoOfParam);
9629 110 : if (NoOfParam == 1)
9630 : {
9631 110 : op = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9632 110 : GenQuadO (functok, M2Quads_ThrowOp, SymbolTable_NulSym, SymbolTable_NulSym, op, false);
9633 : }
9634 : else
9635 : {
9636 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure %{1Ea} takes one INTEGER parameter", 55, M2System_Throw);
9637 : }
9638 110 : M2Quads_PopN (NoOfParam+1);
9639 110 : }
9640 :
9641 :
9642 : /*
9643 : BuildNewProcedure - builds the pseudo procedure call NEW.
9644 : This procedure is traditionally a "macro" for
9645 : NEW(x, ...) --> ALLOCATE(x, TSIZE(x^, ...))
9646 : One method of implementation is to emulate a "macro"
9647 : processor by pushing the relevant input tokens
9648 : back onto the input stack.
9649 : However this causes two problems:
9650 :
9651 : (i) Unnecessary code is produced for x^
9652 : (ii) SIZE must be imported from SYSTEM
9653 : Therefore we chose an alternative method of
9654 : implementation;
9655 : generate quadruples for ALLOCATE(x, TSIZE(x^, ...))
9656 : this, although slightly more efficient,
9657 : is more complex and circumvents problems (i) and (ii).
9658 :
9659 : The Stack:
9660 :
9661 :
9662 : Entry Exit
9663 :
9664 : Ptr ->
9665 : +----------------+
9666 : | NoOfParam |
9667 : |----------------|
9668 : | Param 1 |
9669 : |----------------|
9670 : | Param 2 |
9671 : |----------------|
9672 : . .
9673 : . .
9674 : . .
9675 : |----------------|
9676 : | Param # |
9677 : |----------------|
9678 : | ProcSym | Type | Empty
9679 : |----------------|
9680 : */
9681 :
9682 861 : static void BuildNewProcedure (unsigned int functok)
9683 : {
9684 861 : unsigned int NoOfParam;
9685 861 : unsigned int SizeSym;
9686 861 : unsigned int PtrSym;
9687 861 : unsigned int ProcSym;
9688 861 : unsigned int paramtok;
9689 861 : unsigned int combinedtok;
9690 :
9691 861 : M2Quads_PopT (&NoOfParam);
9692 861 : if (NoOfParam >= 1)
9693 : {
9694 861 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "ALLOCATE", 8));
9695 861 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
9696 : {
9697 861 : PtrSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9698 861 : paramtok = OperandTtok (1);
9699 861 : if (IsReallyPointer (PtrSym))
9700 : {
9701 860 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
9702 : /*
9703 : Build macro: ALLOCATE( PtrSym, SIZE(PtrSym^) )
9704 : */
9705 860 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, paramtok); /* Procedure */
9706 : /* x^ */
9707 860 : M2Quads_PushTtok (GetItemPointedTo (PtrSym), paramtok);
9708 860 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One parameter */
9709 860 : M2Quads_BuildFunctionCall (false); /* One parameter */
9710 860 : M2Quads_PopT (&SizeSym);
9711 860 : M2Quads_PushTtok (ProcSym, combinedtok); /* ALLOCATE */
9712 860 : M2Quads_PushTtok (PtrSym, paramtok); /* x */
9713 860 : M2Quads_PushTtok (SizeSym, paramtok); /* TSIZE(x^) */
9714 860 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9715 860 : M2Quads_BuildProcedureCall (combinedtok); /* Two parameters */
9716 : }
9717 : else
9718 : {
9719 1 : M2MetaError_MetaErrorT1 (paramtok, (const char *) "parameter to {%EkNEW} must be a pointer, seen {%1Ed} {%1&s}", 59, PtrSym);
9720 : }
9721 : }
9722 : else
9723 : {
9724 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}ALLOCATE procedure not found for NEW substitution", 53);
9725 : }
9726 : }
9727 : else
9728 : {
9729 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the pseudo procedure {%EkNEW} has one or more parameters", 56);
9730 : }
9731 861 : M2Quads_PopN (NoOfParam+1);
9732 861 : }
9733 :
9734 :
9735 : /*
9736 : BuildDisposeProcedure - builds the pseudo procedure call DISPOSE.
9737 : This procedure is traditionally a "macro" for
9738 : DISPOSE(x) --> DEALLOCATE(x, TSIZE(x^))
9739 : One method of implementation is to emulate a "macro"
9740 : processor by pushing the relevant input tokens
9741 : back onto the input stack.
9742 : However this causes two problems:
9743 :
9744 : (i) Unnecessary code is produced for x^
9745 : (ii) TSIZE must be imported from SYSTEM
9746 : Therefore we chose an alternative method of
9747 : implementation;
9748 : generate quadruples for DEALLOCATE(x, TSIZE(x^))
9749 : this, although slightly more efficient,
9750 : is more complex and circumvents problems (i)
9751 : and (ii).
9752 :
9753 : The Stack:
9754 :
9755 :
9756 : Entry Exit
9757 :
9758 : Ptr ->
9759 : +----------------+
9760 : | NoOfParam |
9761 : |----------------|
9762 : | Param 1 |
9763 : |----------------|
9764 : | Param 2 |
9765 : |----------------|
9766 : . .
9767 : . .
9768 : . .
9769 : |----------------|
9770 : | Param # |
9771 : |----------------|
9772 : | ProcSym | Type | Empty
9773 : |----------------|
9774 : */
9775 :
9776 328 : static void BuildDisposeProcedure (unsigned int functok)
9777 : {
9778 328 : unsigned int NoOfParam;
9779 328 : unsigned int SizeSym;
9780 328 : unsigned int PtrSym;
9781 328 : unsigned int ProcSym;
9782 328 : unsigned int combinedtok;
9783 328 : unsigned int paramtok;
9784 :
9785 328 : M2Quads_PopT (&NoOfParam);
9786 328 : if (NoOfParam >= 1)
9787 : {
9788 328 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "DEALLOCATE", 10));
9789 328 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
9790 : {
9791 328 : PtrSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9792 328 : paramtok = OperandTtok (1);
9793 328 : if (IsReallyPointer (PtrSym))
9794 : {
9795 328 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
9796 : /*
9797 : Build macro: DEALLOCATE( PtrSym, TSIZE(PtrSym^) )
9798 : */
9799 328 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, paramtok); /* Procedure */
9800 : /* x^ */
9801 328 : M2Quads_PushTtok (GetItemPointedTo (PtrSym), paramtok);
9802 328 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One parameter */
9803 328 : M2Quads_BuildFunctionCall (false); /* One parameter */
9804 328 : M2Quads_PopT (&SizeSym);
9805 328 : M2Quads_PushTtok (ProcSym, combinedtok); /* DEALLOCATE */
9806 328 : M2Quads_PushTtok (PtrSym, paramtok); /* x */
9807 328 : M2Quads_PushTtok (SizeSym, paramtok); /* TSIZE(x^) */
9808 328 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9809 328 : M2Quads_BuildProcedureCall (combinedtok); /* Two parameters */
9810 : }
9811 : else
9812 : {
9813 0 : M2MetaError_MetaErrorT1 (paramtok, (const char *) "argument to {%EkDISPOSE} must be a pointer, seen {%1Ed} {%1&s}", 62, PtrSym);
9814 : }
9815 : }
9816 : else
9817 : {
9818 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}DEALLOCATE procedure not found for DISPOSE substitution", 59);
9819 : }
9820 : }
9821 : else
9822 : {
9823 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the pseudo procedure {%EkDISPOSE} has one or more parameters", 60);
9824 : }
9825 328 : M2Quads_PopN (NoOfParam+1);
9826 328 : }
9827 :
9828 :
9829 : /*
9830 : CheckRangeIncDec - performs des := des <tok> expr
9831 : with range checking (if enabled).
9832 :
9833 : Stack
9834 : Entry Exit
9835 :
9836 : +------------+
9837 : empty | des + expr |
9838 : |------------|
9839 : */
9840 :
9841 17352 : static void CheckRangeIncDec (unsigned int tokenpos, unsigned int des, unsigned int expr, NameKey_Name tok)
9842 : {
9843 17352 : unsigned int dtype;
9844 17352 : unsigned int etype;
9845 :
9846 17352 : dtype = SymbolTable_GetDType (des);
9847 17352 : etype = SymbolTable_GetDType (expr);
9848 17352 : if ((etype == SymbolTable_NulSym) && (SymbolTable_IsPointer (SymbolTable_GetTypeMode (des))))
9849 : {
9850 24 : expr = ConvertToAddress (tokenpos, expr);
9851 24 : etype = M2System_Address;
9852 : }
9853 17352 : if (M2Options_WholeValueChecking && ! MustNotCheckBounds)
9854 : {
9855 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
9856 1476 : if (tok == M2Reserved_PlusTok)
9857 : {
9858 792 : BuildRange (M2Range_InitIncRangeCheck (des, expr));
9859 : }
9860 : else
9861 : {
9862 684 : BuildRange (M2Range_InitDecRangeCheck (des, expr));
9863 : }
9864 : }
9865 17352 : if (M2Base_IsExpressionCompatible (dtype, etype))
9866 : {
9867 : /* the easy case simulate a straightforward macro */
9868 15882 : M2Quads_PushTFtok (des, dtype, tokenpos);
9869 15882 : M2Quads_PushT (tok);
9870 15882 : M2Quads_PushTFtok (expr, etype, tokenpos);
9871 15882 : doBuildBinaryOp (false, true);
9872 : }
9873 : else
9874 : {
9875 1470 : if ((((M2Base_IsOrdinalType (dtype)) || (dtype == M2System_Address)) || (SymbolTable_IsPointer (dtype))) && (((M2Base_IsOrdinalType (etype)) || (etype == M2System_Address)) || (SymbolTable_IsPointer (etype))))
9876 : {
9877 1470 : M2Quads_PushTFtok (des, dtype, tokenpos);
9878 1470 : M2Quads_PushT (tok);
9879 1470 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tokenpos);
9880 1470 : M2Quads_PushTtok (dtype, tokenpos);
9881 1470 : M2Quads_PushTtok (expr, tokenpos);
9882 1470 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9883 1470 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
9884 1470 : doBuildBinaryOp (false, true);
9885 : }
9886 : else
9887 : {
9888 0 : if (tok == M2Reserved_PlusTok)
9889 : {
9890 0 : M2MetaError_MetaError0 ((const char *) "cannot perform {%EkINC} using non ordinal types", 47);
9891 : }
9892 : else
9893 : {
9894 0 : M2MetaError_MetaError0 ((const char *) "cannot perform {%EkDEC} using non ordinal types", 47);
9895 : }
9896 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tokenpos, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym), static_cast<unsigned int> (SymbolTable_NulSym), tokenpos);
9897 : }
9898 : }
9899 17352 : }
9900 :
9901 :
9902 : /*
9903 : BuildIncProcedure - builds the pseudo procedure call INC.
9904 : INC is a procedure which increments a variable.
9905 : It takes one or two parameters:
9906 : INC(a, b) or INC(a)
9907 : a := a+b or a := a+1
9908 :
9909 : The Stack:
9910 :
9911 :
9912 : Entry Exit
9913 :
9914 : Ptr ->
9915 : +----------------+
9916 : | NoOfParam |
9917 : |----------------|
9918 : | Param 1 |
9919 : |----------------|
9920 : | Param 2 |
9921 : |----------------|
9922 : . .
9923 : . .
9924 : . .
9925 : |----------------|
9926 : | Param # |
9927 : |----------------|
9928 : | ProcSym | Type | Empty
9929 : |----------------|
9930 : */
9931 :
9932 13557 : static void BuildIncProcedure (unsigned int proctok)
9933 : {
9934 13557 : unsigned int vartok;
9935 13557 : unsigned int NoOfParam;
9936 13557 : unsigned int dtype;
9937 13557 : unsigned int OperandSym;
9938 13557 : unsigned int VarSym;
9939 13557 : unsigned int TempSym;
9940 :
9941 13557 : M2Quads_PopT (&NoOfParam);
9942 13557 : if ((NoOfParam == 1) || (NoOfParam == 2))
9943 : {
9944 13557 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam)); /* Bottom/first parameter. */
9945 13557 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam)); /* Bottom/first parameter. */
9946 13557 : if (SymbolTable_IsVar (VarSym))
9947 : {
9948 13556 : dtype = SymbolTable_GetDType (VarSym);
9949 13556 : if (NoOfParam == 2)
9950 : {
9951 2720 : OperandSym = DereferenceLValue (proctok, M2Quads_OperandT (1));
9952 : }
9953 : else
9954 : {
9955 10836 : PushOne (proctok, dtype, (const char *) "the {%EkINC} will cause an overflow {%1ad}", 42);
9956 10836 : M2Quads_PopT (&OperandSym);
9957 : }
9958 13556 : M2Quads_PushTtok (VarSym, vartok);
9959 13556 : TempSym = DereferenceLValue (vartok, VarSym);
9960 13556 : CheckRangeIncDec (proctok, TempSym, OperandSym, M2Reserved_PlusTok); /* TempSym + OperandSym. */
9961 13556 : BuildAssignmentWithoutBounds (proctok, false, true); /* VarSym := TempSym + OperandSym. */
9962 : }
9963 : else
9964 : {
9965 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed} {%1&s}", 85, VarSym);
9966 : }
9967 : }
9968 : else
9969 : {
9970 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkINC} expects 1 or 2 parameters", 53);
9971 : }
9972 13557 : M2Quads_PopN (NoOfParam+1);
9973 13557 : }
9974 :
9975 :
9976 : /*
9977 : BuildDecProcedure - builds the pseudo procedure call DEC.
9978 : DEC is a procedure which decrements a variable.
9979 : It takes one or two parameters:
9980 : DEC(a, b) or DEC(a)
9981 : a := a-b or a := a-1
9982 :
9983 : The Stack:
9984 :
9985 :
9986 : Entry Exit
9987 :
9988 : Ptr ->
9989 : +----------------+
9990 : | NoOfParam |
9991 : |----------------|
9992 : | Param 1 |
9993 : |----------------|
9994 : | Param 2 |
9995 : |----------------|
9996 : . .
9997 : . .
9998 : . .
9999 : |----------------|
10000 : | Param # |
10001 : |----------------|
10002 : | ProcSym | Type | Empty
10003 : |----------------|
10004 : */
10005 :
10006 3797 : static void BuildDecProcedure (unsigned int proctok)
10007 : {
10008 3797 : unsigned int vartok;
10009 3797 : unsigned int NoOfParam;
10010 3797 : unsigned int dtype;
10011 3797 : unsigned int OperandSym;
10012 3797 : unsigned int VarSym;
10013 3797 : unsigned int TempSym;
10014 :
10015 3797 : M2Quads_PopT (&NoOfParam);
10016 3797 : if ((NoOfParam == 1) || (NoOfParam == 2))
10017 : {
10018 3797 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam)); /* Bottom/first parameter. */
10019 3797 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam)); /* Bottom/first parameter. */
10020 3797 : if (SymbolTable_IsVar (VarSym))
10021 : {
10022 3796 : dtype = SymbolTable_GetDType (VarSym);
10023 3796 : if (NoOfParam == 2)
10024 : {
10025 1330 : OperandSym = DereferenceLValue (proctok, M2Quads_OperandT (1));
10026 : }
10027 : else
10028 : {
10029 2466 : PushOne (proctok, dtype, (const char *) "the {%EkDEC} will cause an overflow {%1ad}", 42);
10030 2466 : M2Quads_PopT (&OperandSym);
10031 : }
10032 3796 : M2Quads_PushTtok (VarSym, vartok);
10033 3796 : TempSym = DereferenceLValue (vartok, VarSym);
10034 3796 : CheckRangeIncDec (proctok, TempSym, OperandSym, M2Reserved_MinusTok); /* TempSym - OperandSym. */
10035 3796 : BuildAssignmentWithoutBounds (proctok, false, true); /* VarSym := TempSym - OperandSym. */
10036 : }
10037 : else
10038 : {
10039 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed} {%1&s}", 85, VarSym);
10040 : }
10041 : }
10042 : else
10043 : {
10044 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkDEC} expects 1 or 2 parameters", 53);
10045 : }
10046 3797 : M2Quads_PopN (NoOfParam+1);
10047 3797 : }
10048 :
10049 :
10050 : /*
10051 : DereferenceLValue - checks to see whether, operand, is declare as an LValue
10052 : and if so it dereferences it.
10053 : */
10054 :
10055 29440 : static unsigned int DereferenceLValue (unsigned int tok, unsigned int operand)
10056 : {
10057 29440 : unsigned int sym;
10058 :
10059 29440 : if ((SymbolTable_GetMode (operand)) == SymbolTable_LeftValue)
10060 : {
10061 : /* dereference the pointer */
10062 1392 : sym = SymbolTable_MakeTemporary (tok, AreConstant (SymbolTable_IsConst (operand)));
10063 696 : SymbolTable_PutVar (sym, SymbolTable_GetSType (operand));
10064 696 : M2Quads_PushTtok (sym, tok);
10065 696 : M2Quads_PushTtok (operand, tok);
10066 696 : BuildAssignmentWithoutBounds (tok, false, true);
10067 696 : return sym;
10068 : }
10069 : else
10070 : {
10071 : return operand;
10072 : }
10073 : /* static analysis guarentees a RETURN statement will be used before here. */
10074 : __builtin_unreachable ();
10075 : }
10076 :
10077 :
10078 : /*
10079 : BuildInclProcedure - builds the pseudo procedure call INCL.
10080 : INCL is a procedure which adds bit b into a BITSET a.
10081 : It takes two parameters:
10082 : INCL(a, b)
10083 :
10084 : a := a + {b}
10085 :
10086 : The Stack:
10087 :
10088 :
10089 : Entry Exit
10090 :
10091 : Ptr ->
10092 : +----------------+
10093 : | NoOfParam |
10094 : |----------------|
10095 : | Param 1 |
10096 : |----------------|
10097 : | Param 2 |
10098 : |----------------|
10099 : | ProcSym | Type | Empty
10100 : |----------------|
10101 : */
10102 :
10103 1101 : static void BuildInclProcedure (unsigned int proctok)
10104 : {
10105 1101 : unsigned int vartok;
10106 1101 : unsigned int optok;
10107 1101 : unsigned int NoOfParam;
10108 1101 : unsigned int DerefSym;
10109 1101 : unsigned int OperandSym;
10110 1101 : unsigned int VarSym;
10111 :
10112 1101 : M2Quads_PopT (&NoOfParam);
10113 1101 : if (NoOfParam == 2)
10114 : {
10115 1101 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10116 1101 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10117 1101 : MarkArrayWritten (M2Quads_OperandA (2));
10118 1101 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10119 1101 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10120 1101 : if (SymbolTable_IsVar (VarSym))
10121 : {
10122 1094 : if (SymbolTable_IsSet (SymbolTable_GetDType (VarSym)))
10123 : {
10124 1094 : DerefSym = DereferenceLValue (optok, OperandSym);
10125 1094 : BuildRange (M2Range_InitInclCheck (VarSym, DerefSym));
10126 1094 : GenQuadO (proctok, M2Quads_InclOp, VarSym, SymbolTable_NulSym, DerefSym, false);
10127 : }
10128 : else
10129 : {
10130 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the first parameter to {%EkINCL} must be a set variable, seen {%1Ed} {%1&s}", 75, VarSym);
10131 : }
10132 : }
10133 : else
10134 : {
10135 7 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkINCL} expects a variable as a parameter, seen {%1Ed} {%1&s}", 78, VarSym);
10136 : }
10137 : }
10138 : else
10139 : {
10140 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkINCL} expects 1 or 2 parameters", 54);
10141 : }
10142 1101 : M2Quads_PopN (NoOfParam+1);
10143 1101 : }
10144 :
10145 :
10146 : /*
10147 : BuildExclProcedure - builds the pseudo procedure call EXCL.
10148 : INCL is a procedure which removes bit b from SET a.
10149 : It takes two parameters:
10150 : EXCL(a, b)
10151 :
10152 : a := a - {b}
10153 :
10154 : The Stack:
10155 :
10156 :
10157 : Entry Exit
10158 :
10159 : Ptr ->
10160 : +----------------+
10161 : | NoOfParam |
10162 : |----------------|
10163 : | Param 1 |
10164 : |----------------|
10165 : | Param 2 |
10166 : |----------------|
10167 : | ProcSym | Type | Empty
10168 : |----------------|
10169 : */
10170 :
10171 761 : static void BuildExclProcedure (unsigned int proctok)
10172 : {
10173 761 : unsigned int vartok;
10174 761 : unsigned int optok;
10175 761 : unsigned int NoOfParam;
10176 761 : unsigned int DerefSym;
10177 761 : unsigned int OperandSym;
10178 761 : unsigned int VarSym;
10179 :
10180 761 : M2Quads_PopT (&NoOfParam);
10181 761 : if (NoOfParam == 2)
10182 : {
10183 761 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10184 761 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10185 761 : MarkArrayWritten (M2Quads_OperandA (2));
10186 761 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10187 761 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10188 761 : if (SymbolTable_IsVar (VarSym))
10189 : {
10190 760 : if (SymbolTable_IsSet (SymbolTable_GetDType (VarSym)))
10191 : {
10192 760 : DerefSym = DereferenceLValue (optok, OperandSym);
10193 760 : BuildRange (M2Range_InitExclCheck (VarSym, DerefSym));
10194 760 : GenQuadO (proctok, M2Quads_ExclOp, VarSym, SymbolTable_NulSym, DerefSym, false);
10195 : }
10196 : else
10197 : {
10198 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the first parameter to {%EkEXCL} must be a set variable, seen {%1Ed} {%1&s}", 75, VarSym);
10199 : }
10200 : }
10201 : else
10202 : {
10203 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkEXCL} expects a variable as a parameter, seen {%1Ed} {%1&s}", 78, VarSym);
10204 : }
10205 : }
10206 : else
10207 : {
10208 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkEXCL} expects 1 or 2 parameters", 54);
10209 : }
10210 761 : M2Quads_PopN (NoOfParam+1);
10211 761 : }
10212 :
10213 :
10214 : /*
10215 : BuildTypeCoercion - builds the type coersion.
10216 : Modula-2 allows types to be coersed with no runtime
10217 : penility.
10218 : It insists that the TSIZE(t1)=TSIZE(t2) where
10219 : t2 variable := t2(variable of type t1).
10220 : The ReturnVar on the stack is of type t2.
10221 :
10222 : The Stack:
10223 :
10224 :
10225 : Entry Exit
10226 :
10227 : Ptr ->
10228 : +----------------+
10229 : | NoOfParam |
10230 : |----------------|
10231 : | Param 1 |
10232 : |----------------|
10233 : | Param 2 |
10234 : |----------------|
10235 : . .
10236 : . .
10237 : . .
10238 : |----------------|
10239 : | Param # | <- Ptr
10240 : |----------------| +------------+
10241 : | ProcSym | Type | | ReturnVar |
10242 : |----------------| |------------|
10243 :
10244 : Quadruples:
10245 :
10246 : CoerceOp ReturnVar Type Param1
10247 :
10248 : A type coercion will only be legal if the different
10249 : types have exactly the same size.
10250 : Since we can only decide this after M2Eval has processed
10251 : the symbol table then we create a quadruple explaining
10252 : the coercion taking place, the code generator can test
10253 : this assertion and report an error if the type sizes
10254 : differ.
10255 : */
10256 :
10257 2562 : static void BuildTypeCoercion (bool ConstExpr)
10258 : {
10259 2562 : unsigned int resulttok;
10260 2562 : unsigned int proctok;
10261 2562 : unsigned int exptok;
10262 2562 : unsigned int r;
10263 2562 : unsigned int exp;
10264 2562 : unsigned int NoOfParam;
10265 2562 : unsigned int ReturnVar;
10266 2562 : unsigned int ProcSym;
10267 :
10268 2562 : M2Quads_PopT (&NoOfParam);
10269 2562 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10270 2562 : proctok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
10271 2562 : if (! (SymbolTable_IsAModula2Type (ProcSym)))
10272 : {
10273 0 : M2MetaError_MetaError1 ((const char *) "coersion expecting a type, seen {%1Ea} which is {%1Ed} {%1&s}", 61, ProcSym);
10274 : }
10275 2562 : if (NoOfParam == 1)
10276 : {
10277 2562 : PopTrwtok (&exp, &r, &exptok);
10278 2562 : MarkAsRead (r);
10279 2562 : resulttok = M2LexBuf_MakeVirtual2Tok (proctok, exptok);
10280 2562 : M2Quads_PopN (1); /* Pop procedure. */
10281 2562 : if (ConstExprError (ProcSym, exp, exptok, ConstExpr)) /* Pop procedure. */
10282 : {
10283 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
10284 0 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10285 : }
10286 : /* Set ReturnVar's TYPE. */
10287 2562 : else if ((SymbolTable_IsConst (exp)) || (SymbolTable_IsVar (exp)))
10288 : {
10289 : /* avoid dangling else. */
10290 5124 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (SymbolTable_IsConst (exp)));
10291 2562 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10292 2562 : GenQuad (M2Quads_CoerceOp, ReturnVar, ProcSym, exp); /* Set ReturnVar's TYPE. */
10293 : }
10294 : else
10295 : {
10296 : /* avoid dangling else. */
10297 0 : M2MetaError_MetaError2 ((const char *) "trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}", 74, exp, ProcSym);
10298 0 : M2MetaError_MetaError2 ((const char *) "trying to coerse {%1ECad} which is not a variable or constant into {%2ad}", 73, exp, ProcSym);
10299 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_RightValue);
10300 0 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10301 : }
10302 2562 : M2Quads_PushTFtok (ReturnVar, ProcSym, resulttok);
10303 : }
10304 : else
10305 : {
10306 0 : M2MetaError_MetaError0 ((const char *) "{%E}only one parameter expected in a TYPE coersion", 50);
10307 : }
10308 2562 : }
10309 :
10310 :
10311 : /*
10312 : BuildRealFunctionCall - builds a function call.
10313 : The Stack:
10314 :
10315 :
10316 : Entry Exit
10317 :
10318 : Ptr ->
10319 : +----------------+
10320 : | NoOfParam |
10321 : |----------------|
10322 : | Param 1 |
10323 : |----------------|
10324 : | Param 2 |
10325 : |----------------|
10326 : . .
10327 : . .
10328 : . .
10329 : |----------------|
10330 : | Param # | <- Ptr
10331 : |----------------| +------------+
10332 : | ProcSym | Type | | ReturnVar |
10333 : |----------------| |------------|
10334 : */
10335 :
10336 60520 : static void BuildRealFunctionCall (unsigned int tokno, bool ConstExpr)
10337 : {
10338 60520 : unsigned int NoOfParam;
10339 60520 : unsigned int ProcSym;
10340 :
10341 60520 : M2Quads_PopT (&NoOfParam);
10342 60520 : M2Quads_PushT (NoOfParam);
10343 60520 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+2));
10344 60520 : ProcSym = PCSymBuild_SkipConst (ProcSym);
10345 60520 : if (SymbolTable_IsVar (ProcSym))
10346 : {
10347 : /* Procedure Variable therefore get its type to see if it is a FOR "C" call. */
10348 94 : ProcSym = SymbolTable_SkipType (M2Quads_OperandF (NoOfParam+2));
10349 : }
10350 60520 : if ((SymbolTable_IsDefImp (SymbolTable_GetScope (ProcSym))) && (SymbolTable_IsDefinitionForC (SymbolTable_GetScope (ProcSym))))
10351 : {
10352 7314 : BuildRealFuncProcCall (tokno, true, true, ConstExpr);
10353 : }
10354 : else
10355 : {
10356 53206 : BuildRealFuncProcCall (tokno, true, false, ConstExpr);
10357 : }
10358 60508 : }
10359 :
10360 :
10361 : /*
10362 : BuildPseudoFunctionCall - builds the pseudo function
10363 : The Stack:
10364 :
10365 :
10366 : Entry Exit
10367 :
10368 : Ptr ->
10369 : +----------------+
10370 : | NoOfParam |
10371 : |----------------|
10372 : | Param 1 |
10373 : |----------------|
10374 : | Param 2 |
10375 : |----------------|
10376 : . .
10377 : . .
10378 : . .
10379 : |----------------|
10380 : | Param # | <- Ptr
10381 : |----------------| +------------+
10382 : | ProcSym | Type | | ReturnVar |
10383 : |----------------| |------------|
10384 :
10385 : */
10386 :
10387 42360 : static void BuildPseudoFunctionCall (bool ConstExpr)
10388 : {
10389 42360 : unsigned int NoOfParam;
10390 42360 : unsigned int ProcSym;
10391 :
10392 42360 : M2Quads_PopT (&NoOfParam);
10393 42360 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10394 42360 : ProcSym = PCSymBuild_SkipConst (ProcSym);
10395 42360 : M2Quads_PushT (NoOfParam);
10396 : /* Compile time stack restored to entry state. */
10397 42360 : if (ProcSym == M2Base_High)
10398 : {
10399 2974 : BuildHighFunction ();
10400 : }
10401 39386 : else if (ProcSym == M2Base_LengthS)
10402 : {
10403 : /* avoid dangling else. */
10404 346 : BuildLengthFunction (ProcSym, ConstExpr);
10405 : }
10406 39040 : else if (ProcSym == M2System_Adr)
10407 : {
10408 : /* avoid dangling else. */
10409 9559 : BuildAdrFunction ();
10410 : }
10411 29481 : else if (ProcSym == M2Size_Size)
10412 : {
10413 : /* avoid dangling else. */
10414 2047 : BuildSizeFunction ();
10415 : }
10416 27434 : else if (ProcSym == M2System_TSize)
10417 : {
10418 : /* avoid dangling else. */
10419 4758 : BuildTSizeFunction ();
10420 : }
10421 22676 : else if (ProcSym == M2System_TBitSize)
10422 : {
10423 : /* avoid dangling else. */
10424 6376 : BuildTBitSizeFunction ();
10425 : }
10426 16300 : else if (ProcSym == M2Base_Convert)
10427 : {
10428 : /* avoid dangling else. */
10429 12 : BuildConvertFunction (ProcSym, ConstExpr);
10430 : }
10431 16288 : else if (ProcSym == M2Base_Odd)
10432 : {
10433 : /* avoid dangling else. */
10434 42 : BuildOddFunction (ProcSym, ConstExpr);
10435 : }
10436 16246 : else if (ProcSym == M2Base_Abs)
10437 : {
10438 : /* avoid dangling else. */
10439 177 : BuildAbsFunction (ProcSym, ConstExpr);
10440 : }
10441 16069 : else if (ProcSym == M2Base_Cap)
10442 : {
10443 : /* avoid dangling else. */
10444 125 : BuildCapFunction (ProcSym, ConstExpr);
10445 : }
10446 15944 : else if (ProcSym == M2Base_Val)
10447 : {
10448 : /* avoid dangling else. */
10449 4918 : BuildValFunction (ProcSym, ConstExpr);
10450 : }
10451 11026 : else if (ProcSym == M2Base_Chr)
10452 : {
10453 : /* avoid dangling else. */
10454 1016 : BuildChrFunction (ProcSym, ConstExpr);
10455 : }
10456 10010 : else if (M2Base_IsOrd (ProcSym))
10457 : {
10458 : /* avoid dangling else. */
10459 4692 : BuildOrdFunction (ProcSym, ConstExpr);
10460 : }
10461 5318 : else if (M2Base_IsInt (ProcSym))
10462 : {
10463 : /* avoid dangling else. */
10464 6 : BuildIntFunction (ProcSym, ConstExpr);
10465 : }
10466 5312 : else if (M2Base_IsTrunc (ProcSym))
10467 : {
10468 : /* avoid dangling else. */
10469 60 : BuildTruncFunction (ProcSym, ConstExpr);
10470 : }
10471 5252 : else if (M2Base_IsFloat (ProcSym))
10472 : {
10473 : /* avoid dangling else. */
10474 88 : BuildFloatFunction (ProcSym, ConstExpr);
10475 : }
10476 5164 : else if (ProcSym == M2Base_Min)
10477 : {
10478 : /* avoid dangling else. */
10479 1222 : BuildMinFunction ();
10480 : }
10481 3942 : else if (ProcSym == M2Base_Max)
10482 : {
10483 : /* avoid dangling else. */
10484 2014 : BuildMaxFunction ();
10485 : }
10486 1928 : else if (ProcSym == M2System_AddAdr)
10487 : {
10488 : /* avoid dangling else. */
10489 36 : BuildAddAdrFunction (ProcSym, ConstExpr);
10490 : }
10491 1892 : else if (ProcSym == M2System_SubAdr)
10492 : {
10493 : /* avoid dangling else. */
10494 12 : BuildSubAdrFunction (ProcSym, ConstExpr);
10495 : }
10496 1880 : else if (ProcSym == M2System_DifAdr)
10497 : {
10498 : /* avoid dangling else. */
10499 12 : BuildDifAdrFunction (ProcSym, ConstExpr);
10500 : }
10501 1868 : else if (ProcSym == M2System_Cast)
10502 : {
10503 : /* avoid dangling else. */
10504 156 : BuildCastFunction (ProcSym, ConstExpr);
10505 : }
10506 1712 : else if (ProcSym == M2System_Shift)
10507 : {
10508 : /* avoid dangling else. */
10509 682 : BuildShiftFunction ();
10510 : }
10511 1030 : else if (ProcSym == M2System_Rotate)
10512 : {
10513 : /* avoid dangling else. */
10514 406 : BuildRotateFunction ();
10515 : }
10516 624 : else if (ProcSym == M2System_MakeAdr)
10517 : {
10518 : /* avoid dangling else. */
10519 12 : BuildMakeAdrFunction ();
10520 : }
10521 612 : else if (ProcSym == M2Base_Re)
10522 : {
10523 : /* avoid dangling else. */
10524 60 : BuildReFunction (ProcSym, ConstExpr);
10525 : }
10526 552 : else if (ProcSym == M2Base_Im)
10527 : {
10528 : /* avoid dangling else. */
10529 60 : BuildImFunction (ProcSym, ConstExpr);
10530 : }
10531 492 : else if (ProcSym == M2Base_Cmplx)
10532 : {
10533 : /* avoid dangling else. */
10534 492 : BuildCmplxFunction (ProcSym, ConstExpr);
10535 : }
10536 : else
10537 : {
10538 : /* avoid dangling else. */
10539 0 : M2Error_InternalError ((const char *) "pseudo function not implemented yet", 35);
10540 : }
10541 42345 : }
10542 :
10543 :
10544 : /*
10545 : BuildAddAdrFunction - builds the pseudo procedure call ADDADR.
10546 :
10547 : PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
10548 :
10549 : Which returns address given by (addr + offset),
10550 : [ the standard says that it _may_
10551 : "raise an exception if this address is not valid."
10552 : currently we do not generate any exception code ]
10553 :
10554 : The Stack:
10555 :
10556 : Entry Exit
10557 :
10558 : Ptr ->
10559 : +----------------+
10560 : | NoOfParam |
10561 : |----------------|
10562 : | Param 1 |
10563 : |----------------|
10564 : | Param 2 | <- Ptr
10565 : |----------------| +------------+
10566 : | ProcSym | Type | | ReturnVar |
10567 : |----------------| |------------|
10568 : */
10569 :
10570 36 : static void BuildAddAdrFunction (unsigned int ProcSym, bool ConstExpr)
10571 : {
10572 36 : unsigned int combinedtok;
10573 36 : unsigned int functok;
10574 36 : unsigned int vartok;
10575 36 : unsigned int optok;
10576 36 : unsigned int opa;
10577 36 : unsigned int ReturnVar;
10578 36 : unsigned int NoOfParam;
10579 36 : unsigned int OperandSym;
10580 36 : unsigned int VarSym;
10581 :
10582 36 : M2Quads_PopT (&NoOfParam);
10583 36 : functok = OperandTtok (NoOfParam+1);
10584 36 : if (NoOfParam == 2)
10585 : {
10586 36 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10587 36 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10588 36 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10589 36 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10590 36 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
10591 36 : M2Quads_PopN (NoOfParam+1);
10592 36 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10593 : {
10594 : /* Fake return result. */
10595 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10596 : }
10597 36 : else if (SymbolTable_IsVar (VarSym))
10598 : {
10599 : /* avoid dangling else. */
10600 36 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10601 : {
10602 36 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
10603 36 : SymbolTable_PutVar (ReturnVar, M2System_Address);
10604 36 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10605 72 : GenQuadOtok (combinedtok, M2Quads_AddOp, ReturnVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10606 36 : M2Quads_PushTFtok (ReturnVar, M2System_Address, combinedtok);
10607 : }
10608 : else
10609 : {
10610 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the first parameter to ADDADR {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}", 114, VarSym);
10611 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10612 : }
10613 : }
10614 : else
10615 : {
10616 : /* avoid dangling else. */
10617 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure ADDADR expects a variable of type ADDRESS or POINTER as its first parameter", 96);
10618 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10619 : }
10620 : }
10621 : else
10622 : {
10623 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure {%EkADDADR} expects 2 parameters", 53);
10624 0 : M2Quads_PopN (NoOfParam+1);
10625 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, functok);
10626 : }
10627 36 : }
10628 :
10629 :
10630 : /*
10631 : BuildSubAdrFunction - builds the pseudo procedure call ADDADR.
10632 :
10633 : PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
10634 :
10635 : Which returns address given by (addr - offset),
10636 : [ the standard says that it _may_
10637 : "raise an exception if this address is not valid."
10638 : currently we do not generate any exception code ]
10639 :
10640 : The Stack:
10641 :
10642 : Entry Exit
10643 :
10644 : Ptr ->
10645 : +----------------+
10646 : | NoOfParam |
10647 : |----------------|
10648 : | Param 1 |
10649 : |----------------|
10650 : | Param 2 | <- Ptr
10651 : |----------------| +------------+
10652 : | ProcSym | Type | | ReturnVar |
10653 : |----------------| |------------|
10654 : */
10655 :
10656 12 : static void BuildSubAdrFunction (unsigned int ProcSym, bool ConstExpr)
10657 : {
10658 12 : unsigned int functok;
10659 12 : unsigned int combinedtok;
10660 12 : unsigned int optok;
10661 12 : unsigned int vartok;
10662 12 : unsigned int ReturnVar;
10663 12 : unsigned int NoOfParam;
10664 12 : unsigned int OperandSym;
10665 12 : unsigned int opa;
10666 12 : unsigned int VarSym;
10667 :
10668 12 : M2Quads_PopT (&NoOfParam);
10669 12 : functok = OperandTtok (NoOfParam+1);
10670 12 : if (NoOfParam == 2)
10671 : {
10672 12 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10673 12 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10674 12 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10675 12 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10676 12 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10677 12 : M2Quads_PopN (NoOfParam+1);
10678 12 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10679 : {
10680 : /* Fake return result. */
10681 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10682 : }
10683 12 : else if (SymbolTable_IsVar (VarSym))
10684 : {
10685 : /* avoid dangling else. */
10686 12 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10687 : {
10688 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
10689 12 : SymbolTable_PutVar (ReturnVar, M2System_Address);
10690 12 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10691 24 : GenQuadOtok (combinedtok, M2Quads_SubOp, ReturnVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10692 12 : M2Quads_PushTFtok (ReturnVar, M2System_Address, combinedtok);
10693 : }
10694 : else
10695 : {
10696 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the first parameter to {%EkSUBADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}", 119, VarSym);
10697 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (vartok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, vartok);
10698 : }
10699 : }
10700 : else
10701 : {
10702 : /* avoid dangling else. */
10703 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10704 0 : M2MetaError_MetaErrorT0 (combinedtok, (const char *) "{%E}SYSTEM procedure {%EkSUBADR} expects a variable of type ADDRESS or POINTER as its first parameter", 101);
10705 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10706 : }
10707 : }
10708 : else
10709 : {
10710 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure {%EkSUBADR} expects 2 parameters", 53);
10711 0 : M2Quads_PopN (NoOfParam+1);
10712 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, functok);
10713 : }
10714 12 : }
10715 :
10716 :
10717 : /*
10718 : BuildDifAdrFunction - builds the pseudo procedure call DIFADR.
10719 :
10720 : PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER ;
10721 :
10722 : Which returns address given by (addr1 - addr2),
10723 : [ the standard says that it _may_
10724 : "raise an exception if this address is invalid or
10725 : address space is non-contiguous."
10726 : currently we do not generate any exception code ]
10727 :
10728 : The Stack:
10729 :
10730 : Entry Exit
10731 :
10732 : Ptr ->
10733 : +----------------+
10734 : | NoOfParam |
10735 : |----------------|
10736 : | Param 1 |
10737 : |----------------|
10738 : | Param 2 | <- Ptr
10739 : |----------------| +------------+
10740 : | ProcSym | Type | | ReturnVar |
10741 : |----------------| |------------|
10742 : */
10743 :
10744 12 : static void BuildDifAdrFunction (unsigned int ProcSym, bool ConstExpr)
10745 : {
10746 12 : unsigned int functok;
10747 12 : unsigned int optok;
10748 12 : unsigned int vartok;
10749 12 : unsigned int combinedtok;
10750 12 : unsigned int TempVar;
10751 12 : unsigned int NoOfParam;
10752 12 : unsigned int OperandSym;
10753 12 : unsigned int opa;
10754 12 : unsigned int VarSym;
10755 :
10756 12 : M2Quads_PopT (&NoOfParam);
10757 12 : functok = OperandTtok (NoOfParam+1);
10758 12 : if (NoOfParam >= 1)
10759 : {
10760 12 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10761 12 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10762 : }
10763 : else
10764 : {
10765 : optok = functok;
10766 : }
10767 12 : if (NoOfParam == 2)
10768 : {
10769 12 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10770 12 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10771 12 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10772 12 : M2Quads_PopN (NoOfParam+1);
10773 12 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10774 : {
10775 : /* Fake return result. */
10776 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10777 : }
10778 12 : else if (SymbolTable_IsVar (VarSym))
10779 : {
10780 : /* avoid dangling else. */
10781 12 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10782 : {
10783 12 : if ((IsReallyPointer (OperandSym)) || ((SymbolTable_GetSType (OperandSym)) == M2System_Address))
10784 : {
10785 12 : TempVar = SymbolTable_MakeTemporary (vartok, SymbolTable_RightValue);
10786 12 : SymbolTable_PutVar (TempVar, M2System_Address);
10787 12 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10788 24 : GenQuadOtok (combinedtok, M2Quads_SubOp, TempVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10789 : /*
10790 : Build macro: CONVERT( INTEGER, TempVar )
10791 : */
10792 12 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
10793 12 : M2Quads_PushTtok (M2Base_Integer, functok);
10794 12 : M2Quads_PushTtok (TempVar, vartok);
10795 12 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
10796 12 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
10797 : }
10798 : else
10799 : {
10800 0 : M2MetaError_MetaError1 ((const char *) "the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}", 120, OperandSym);
10801 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10802 : }
10803 : }
10804 : else
10805 : {
10806 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the first parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}", 119, VarSym);
10807 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10808 : }
10809 : }
10810 : else
10811 : {
10812 : /* avoid dangling else. */
10813 0 : M2MetaError_MetaError0 ((const char *) "{%E}SYSTEM procedure {%EkDIFADR} expects a variable of type ADDRESS or POINTER as its first parameter", 101);
10814 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10815 : }
10816 : }
10817 : else
10818 : {
10819 0 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
10820 0 : M2MetaError_MetaErrorT0 (combinedtok, (const char *) "{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters", 53);
10821 0 : M2Quads_PopN (NoOfParam+1);
10822 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10823 : }
10824 12 : }
10825 :
10826 :
10827 : /*
10828 : BuildHighFunction - checks the stack in preparation for generating
10829 : quadruples which perform HIGH.
10830 : This procedure does not alter the stack but
10831 : determines whether, a, in HIGH(a) is an ArraySym
10832 : or UnboundedSym.
10833 : Both cases are different and appropriate quadruple
10834 : generating routines are called.
10835 :
10836 : The Stack:
10837 :
10838 :
10839 : Entry Exit
10840 :
10841 : Ptr ->
10842 : +----------------+
10843 : | NoOfParam |
10844 : |----------------|
10845 : | Param 1 |
10846 : |----------------|
10847 : | Param 2 |
10848 : |----------------|
10849 : . .
10850 : . .
10851 : . .
10852 : |----------------|
10853 : | Param # | <- Ptr
10854 : |----------------| +------------+
10855 : | ProcSym | Type | | ReturnVar |
10856 : |----------------| |------------|
10857 :
10858 : */
10859 :
10860 2974 : static void BuildHighFunction (void)
10861 : {
10862 2974 : unsigned int functok;
10863 2974 : unsigned int combinedtok;
10864 2974 : unsigned int paramtok;
10865 2974 : unsigned int ProcSym;
10866 2974 : unsigned int Type;
10867 2974 : unsigned int NoOfParam;
10868 2974 : unsigned int Param;
10869 :
10870 2974 : M2Quads_PopT (&NoOfParam);
10871 2974 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10872 2974 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
10873 2974 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
10874 2974 : if (NoOfParam == 1) /* quadruple generation now on */
10875 : {
10876 2974 : Param = static_cast<unsigned int> (M2Quads_OperandT (1));
10877 2974 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10878 2974 : combinedtok = M2LexBuf_MakeVirtualTok (paramtok, functok, paramtok);
10879 2974 : Type = SymbolTable_GetDType (Param);
10880 : /* Restore stack to original form */
10881 2974 : M2Quads_PushT (NoOfParam);
10882 2974 : if (((! (SymbolTable_IsVar (Param))) && (! (SymbolTable_IsConstString (Param)))) && (! (SymbolTable_IsConst (Param))))
10883 : {
10884 : /* we cannot test for IsConst(Param) AND (GetSType(Param)=Char) as the type might not be assigned yet */
10885 0 : M2MetaError_MetaError1 ((const char *) "base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}", 111, Param);
10886 : }
10887 2974 : else if ((Type != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (Type)))
10888 : {
10889 : /* avoid dangling else. */
10890 2742 : BuildHighFromUnbounded (combinedtok);
10891 : }
10892 : else
10893 : {
10894 : /* avoid dangling else. */
10895 232 : BuildConstHighFromSym (combinedtok);
10896 : }
10897 : }
10898 : else
10899 : {
10900 0 : M2MetaError_MetaError0 ((const char *) "base procedure {%EkHIGH} requires one parameter", 47);
10901 0 : M2Quads_PopN (2);
10902 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
10903 : }
10904 2974 : }
10905 :
10906 :
10907 : /*
10908 : BuildConstHighFromSym - builds the pseudo function HIGH from an Sym.
10909 : Sym is a constant or an array which has constant bounds
10910 : and therefore it can be calculated at compile time.
10911 :
10912 : The Stack:
10913 :
10914 :
10915 : Entry Exit
10916 :
10917 : Ptr ->
10918 : +----------------+
10919 : | NoOfParam |
10920 : |----------------|
10921 : | Param 1 |
10922 : |----------------|
10923 : | Param 2 |
10924 : |----------------|
10925 : . .
10926 : . .
10927 : . .
10928 : |----------------|
10929 : | Param # | <- Ptr
10930 : |----------------| +------------+
10931 : | ProcSym | Type | | ReturnVar |
10932 : |----------------| |------------|
10933 : */
10934 :
10935 232 : static void BuildConstHighFromSym (unsigned int tok)
10936 : {
10937 232 : unsigned int NoOfParam;
10938 232 : unsigned int ReturnVar;
10939 :
10940 232 : M2Quads_PopT (&NoOfParam);
10941 232 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
10942 232 : SymbolTable_PutConst (ReturnVar, M2Base_Cardinal);
10943 232 : GenHigh (tok, ReturnVar, 1, M2Quads_OperandT (1));
10944 232 : M2Quads_PopN (NoOfParam+1);
10945 232 : M2Quads_PushTtok (ReturnVar, tok);
10946 232 : }
10947 :
10948 :
10949 : /*
10950 : BuildHighFromUnbounded - builds the pseudo function HIGH from an
10951 : UnboundedSym.
10952 :
10953 : The Stack:
10954 :
10955 :
10956 : Entry Exit
10957 :
10958 : Ptr ->
10959 : +----------------+
10960 : | NoOfParam |
10961 : |----------------|
10962 : | Param # | <- Ptr
10963 : |----------------| +------------+
10964 : | ProcSym | Type | | ReturnVar |
10965 : |----------------| |------------|
10966 :
10967 : */
10968 :
10969 2742 : static void BuildHighFromUnbounded (unsigned int tok)
10970 : {
10971 2742 : unsigned int Dim;
10972 2742 : unsigned int NoOfParam;
10973 2742 : unsigned int ReturnVar;
10974 :
10975 2742 : M2Quads_PopT (&NoOfParam);
10976 2742 : M2Debug_Assert (NoOfParam == 1);
10977 2742 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
10978 2742 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
10979 2742 : Dim = static_cast<unsigned int> (OperandD (1));
10980 2742 : Dim += 1;
10981 2742 : if (Dim > 1)
10982 : {
10983 36 : GenHigh (tok, ReturnVar, Dim, M2Quads_OperandA (1));
10984 : }
10985 : else
10986 : {
10987 2706 : GenHigh (tok, ReturnVar, Dim, M2Quads_OperandT (1));
10988 : }
10989 2742 : M2Quads_PopN (2);
10990 2742 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), tok);
10991 2742 : }
10992 :
10993 :
10994 : /*
10995 : GetQualidentImport - returns the symbol as if it were qualified from, module.n.
10996 : This is used to reference runtime support procedures and an
10997 : error is generated if the symbol cannot be obtained.
10998 : */
10999 :
11000 45715 : static unsigned int GetQualidentImport (unsigned int tokno, NameKey_Name n, NameKey_Name module)
11001 : {
11002 45715 : unsigned int sym;
11003 45715 : unsigned int ModSym;
11004 :
11005 45715 : ModSym = M2Batch_MakeDefinitionSource (tokno, module);
11006 45715 : if (ModSym == SymbolTable_NulSym)
11007 : {
11008 0 : M2MetaError_MetaErrorNT2 (tokno, (const char *) "module %a cannot be found and is needed to import %a", 52, module, n);
11009 0 : M2Error_FlushErrors ();
11010 0 : return SymbolTable_NulSym;
11011 : }
11012 45715 : M2Debug_Assert (SymbolTable_IsDefImp (ModSym));
11013 45715 : if (((SymbolTable_GetExported (tokno, ModSym, n)) == SymbolTable_NulSym) || (SymbolTable_IsUnknown (SymbolTable_GetExported (tokno, ModSym, n))))
11014 : {
11015 0 : sym = SymbolTable_GetExported (tokno, ModSym, n);
11016 0 : if (SymbolTable_IsUnknown (sym))
11017 : {
11018 : /* Spellcheck. */
11019 0 : M2MetaError_MetaErrorN2 ((const char *) "module %a does not export procedure %a which is a necessary component of the runtime system, hint check the path and library/language variant", 141, module, n);
11020 0 : M2MetaError_MetaErrorT1 (tokno, (const char *) "unknown symbol {%1&s}", 21, sym);
11021 0 : SymbolTable_UnknownReported (sym);
11022 : }
11023 : else
11024 : {
11025 0 : M2MetaError_MetaErrorN2 ((const char *) "module %a does not export procedure %a which is a necessary component of the runtime system, hint check the path and library/language variant", 141, module, n);
11026 : }
11027 0 : M2Error_FlushErrors ();
11028 0 : return SymbolTable_NulSym;
11029 : }
11030 45715 : return SymbolTable_GetExported (tokno, M2Batch_MakeDefinitionSource (tokno, module), n);
11031 : /* static analysis guarentees a RETURN statement will be used before here. */
11032 : __builtin_unreachable ();
11033 : }
11034 :
11035 :
11036 : /*
11037 : ConstExprError - return TRUE if a constant expression is being built and Var is a variable.
11038 : */
11039 :
11040 71677 : static bool ConstExprError (unsigned int Func, unsigned int Var, unsigned int optok, bool ConstExpr)
11041 : {
11042 71677 : if (ConstExpr && (SymbolTable_IsVar (Var)))
11043 : {
11044 108 : M2MetaError_MetaErrorT2 (optok, (const char *) "the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav} {%2&s}", 155, Func, Var);
11045 108 : return true;
11046 : }
11047 : else
11048 : {
11049 71569 : return false;
11050 : }
11051 : /* static analysis guarentees a RETURN statement will be used before here. */
11052 : __builtin_unreachable ();
11053 : }
11054 :
11055 :
11056 : /*
11057 : DeferMakeLengthConst - creates a constant which contains the length of string, sym.
11058 : */
11059 :
11060 66 : static unsigned int DeferMakeLengthConst (unsigned int tok, unsigned int sym)
11061 : {
11062 66 : unsigned int const_;
11063 :
11064 66 : const_ = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
11065 66 : SymbolTable_PutVar (const_, M2Base_ZType);
11066 132 : GenQuadO (tok, M2Quads_StringLengthOp, const_, 0, sym, false);
11067 66 : return const_;
11068 : /* static analysis guarentees a RETURN statement will be used before here. */
11069 : __builtin_unreachable ();
11070 : }
11071 :
11072 :
11073 : /*
11074 : BuildLengthFunction - builds the inline standard function LENGTH.
11075 :
11076 : The Stack:
11077 :
11078 :
11079 : Entry Exit
11080 :
11081 : Ptr ->
11082 : +----------------+
11083 : | NoOfParam |
11084 : |----------------|
11085 : | Param 1 | <- Ptr
11086 : |----------------| +------------+
11087 : | ProcSym | Type | | ReturnVar |
11088 : |----------------| |------------|
11089 :
11090 : */
11091 :
11092 346 : static void BuildLengthFunction (unsigned int Function, bool ConstExpr)
11093 : {
11094 346 : unsigned int combinedtok;
11095 346 : unsigned int paramtok;
11096 346 : unsigned int functok;
11097 346 : unsigned int ProcSym;
11098 346 : unsigned int Type;
11099 346 : unsigned int NoOfParam;
11100 346 : unsigned int Param;
11101 346 : unsigned int ReturnVar;
11102 :
11103 346 : M2Quads_PopT (&NoOfParam);
11104 346 : Param = static_cast<unsigned int> (M2Quads_OperandT (1));
11105 346 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11106 346 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11107 : /* Restore stack to origional form. */
11108 346 : M2Quads_PushT (NoOfParam);
11109 346 : Type = SymbolTable_GetSType (Param); /* Get the type from the symbol, not the stack. */
11110 346 : if (NoOfParam != 1) /* Get the type from the symbol, not the stack. */
11111 : {
11112 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "base procedure {%1EkLENGTH} expects 1 parameter, seen {%1n} parameters", 70, NoOfParam);
11113 : }
11114 346 : if (NoOfParam >= 1)
11115 : {
11116 346 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, paramtok);
11117 346 : if ((SymbolTable_IsConst (Param)) && ((SymbolTable_GetSType (Param)) == M2Base_Char))
11118 : {
11119 6 : M2Quads_PopT (&NoOfParam);
11120 6 : M2Quads_PopN (NoOfParam+1);
11121 6 : ReturnVar = SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal);
11122 6 : M2Quads_PushTtok (ReturnVar, combinedtok);
11123 : }
11124 340 : else if (SymbolTable_IsConstString (Param))
11125 : {
11126 : /* avoid dangling else. */
11127 48 : M2Quads_PopT (&NoOfParam);
11128 48 : ReturnVar = DeferMakeLengthConst (combinedtok, M2Quads_OperandT (1));
11129 48 : M2Quads_PopN (NoOfParam+1);
11130 48 : M2Quads_PushTtok (ReturnVar, combinedtok);
11131 : }
11132 : else
11133 : {
11134 : /* avoid dangling else. */
11135 292 : ProcSym = GetQualidentImport (functok, NameKey_MakeKey ((const char *) "Length", 6), NameKey_MakeKey ((const char *) "M2RTS", 5));
11136 292 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
11137 : {
11138 292 : M2Quads_PopT (&NoOfParam);
11139 292 : if (SymbolTable_IsConst (Param))
11140 : {
11141 : /* This can be folded in M2GenGCC. */
11142 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_ImmediateValue);
11143 0 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
11144 0 : GenQuad (M2Quads_StandardFunctionOp, ReturnVar, ProcSym, Param);
11145 0 : M2Quads_PopN (NoOfParam+1);
11146 0 : M2Quads_PushTtok (ReturnVar, combinedtok);
11147 : }
11148 292 : else if (ConstExprError (Function, Param, paramtok, ConstExpr))
11149 : {
11150 : /* avoid dangling else. */
11151 : /* Fake a result as we have detected and reported an error. */
11152 6 : M2Quads_PopN (NoOfParam+1);
11153 6 : ReturnVar = SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal);
11154 6 : M2Quads_PushTtok (ReturnVar, combinedtok);
11155 : }
11156 : else
11157 : {
11158 : /* avoid dangling else. */
11159 : /* We must resolve this at runtime or in the GCC optimizer. */
11160 286 : M2Quads_PopTF (&Param, &Type);
11161 286 : M2Quads_PopN (NoOfParam);
11162 286 : M2Quads_PushTtok (ProcSym, functok);
11163 286 : M2Quads_PushTFtok (Param, Type, paramtok);
11164 286 : M2Quads_PushT (NoOfParam);
11165 286 : BuildRealFunctionCall (functok, false);
11166 : }
11167 : }
11168 : else
11169 : {
11170 0 : M2Quads_PopT (&NoOfParam);
11171 0 : M2Quads_PopN (NoOfParam+1);
11172 0 : M2Quads_PushTtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), combinedtok);
11173 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "no procedure Length found for substitution to the standard function {%1EkLENGTH} which is required to calculate non constant string lengths", 139);
11174 : }
11175 : }
11176 : }
11177 : else
11178 : {
11179 : /* NoOfParam is _very_ wrong, we flush all outstanding errors */
11180 0 : M2Error_FlushErrors ();
11181 : }
11182 346 : }
11183 :
11184 :
11185 : /*
11186 : BuildOddFunction - builds the pseudo procedure call ODD.
11187 : This procedure is actually a "macro" for
11188 : ORD(x) --> VAL(BOOLEAN, x MOD 2)
11189 : However we cannot push tokens back onto the input stack
11190 : because the compiler is currently building a function
11191 : call and expecting a ReturnVar on the stack.
11192 : Hence we manipulate the stack and call
11193 : BuildConvertFunction.
11194 :
11195 : The Stack:
11196 :
11197 :
11198 : Entry Exit
11199 :
11200 : Ptr ->
11201 : +----------------+
11202 : | NoOfParam |
11203 : |----------------|
11204 : | Param 1 |
11205 : |----------------|
11206 : | Param 2 |
11207 : |----------------|
11208 : . .
11209 : . .
11210 : . .
11211 : |----------------|
11212 : | Param # |
11213 : |----------------|
11214 : | ProcSym | Type | Empty
11215 : |----------------|
11216 : */
11217 :
11218 42 : static void BuildOddFunction (unsigned int ProcSym, bool ConstExpr)
11219 : {
11220 42 : unsigned int combinedtok;
11221 42 : unsigned int optok;
11222 42 : unsigned int functok;
11223 42 : unsigned int NoOfParam;
11224 42 : unsigned int Res;
11225 42 : unsigned int Var;
11226 :
11227 42 : M2Quads_PopT (&NoOfParam);
11228 42 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11229 42 : if (NoOfParam == 1)
11230 : {
11231 42 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11232 42 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11233 42 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
11234 42 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11235 : {
11236 : /* Nothing to do. */
11237 6 : M2Quads_PushTtok (M2Base_False, combinedtok);
11238 : }
11239 36 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11240 : {
11241 : /* avoid dangling else. */
11242 36 : M2Quads_PopN (NoOfParam+1);
11243 : /* compute (x MOD 2) */
11244 36 : M2Quads_PushTFtok (Var, SymbolTable_GetSType (Var), optok);
11245 36 : M2Quads_PushT (M2Reserved_ModTok);
11246 36 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (optok, NameKey_MakeKey ((const char *) "2", 1), M2Base_ZType), M2Base_ZType, optok);
11247 36 : M2Quads_BuildBinaryOp ();
11248 36 : M2Quads_PopT (&Res);
11249 : /* compute IF ...=0 */
11250 36 : M2Quads_PushTtok (Res, optok);
11251 36 : M2Quads_PushT (M2Reserved_EqualTok);
11252 36 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (optok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType), M2Base_ZType, optok);
11253 36 : M2Quads_BuildRelOp (combinedtok);
11254 36 : M2Quads_BuildThenIf ();
11255 36 : Res = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11256 36 : SymbolTable_PutVar (Res, M2Base_Boolean);
11257 36 : M2Quads_PushTtok (Res, combinedtok);
11258 36 : M2Quads_PushTtok (M2Base_False, combinedtok);
11259 36 : M2Quads_BuildAssignment (combinedtok);
11260 36 : M2Quads_BuildElse ();
11261 36 : M2Quads_PushTtok (Res, combinedtok);
11262 36 : M2Quads_PushTtok (M2Base_True, combinedtok);
11263 36 : M2Quads_BuildAssignment (combinedtok);
11264 36 : M2Quads_BuildEndIf ();
11265 36 : M2Quads_PushTtok (Res, combinedtok);
11266 : }
11267 : else
11268 : {
11269 : /* avoid dangling else. */
11270 0 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%1EkODD} must be a variable or constant, seen {%1ad} {%1&s}", 77, Var);
11271 0 : M2Quads_PushTtok (M2Base_False, combinedtok);
11272 : }
11273 : }
11274 : else
11275 : {
11276 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%E1kODD} only has one parameter, seen {%1n} parameters", 76, NoOfParam);
11277 0 : M2Quads_PushTtok (M2Base_False, functok);
11278 : }
11279 42 : }
11280 :
11281 :
11282 : /*
11283 : BuildAbsFunction - builds a call to the standard function ABS.
11284 :
11285 : We cannot implement it as a macro or inline an
11286 : IF THEN statement as the IF THEN ELSE requires
11287 : we write the value to the same variable (or constant)
11288 : twice. The macro implementation will fail as
11289 : the compiler maybe building a function
11290 : call and expecting a ReturnVar on the stack.
11291 : The only method to implement this is to pass it to the
11292 : gcc backend.
11293 :
11294 : The Stack:
11295 :
11296 :
11297 : Entry Exit
11298 :
11299 : Ptr ->
11300 : +----------------+
11301 : | NoOfParam |
11302 : |----------------|
11303 : | Param 1 |
11304 : |----------------|
11305 : | Param 2 |
11306 : |----------------|
11307 : . .
11308 : . .
11309 : . .
11310 : |----------------|
11311 : | Param # |
11312 : |----------------|
11313 : | ProcSym | Type | Empty
11314 : |----------------|
11315 : */
11316 :
11317 177 : static void BuildAbsFunction (unsigned int ProcSym, bool ConstExpr)
11318 : {
11319 177 : unsigned int vartok;
11320 177 : unsigned int functok;
11321 177 : unsigned int combinedtok;
11322 177 : unsigned int NoOfParam;
11323 177 : unsigned int Res;
11324 177 : unsigned int Var;
11325 :
11326 177 : M2Quads_PopT (&NoOfParam);
11327 177 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11328 177 : if (NoOfParam == 1)
11329 : {
11330 177 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11331 177 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11332 177 : M2Quads_PopN (NoOfParam+1);
11333 177 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
11334 177 : if (ConstExprError (ProcSym, Var, vartok, ConstExpr))
11335 : {
11336 : /* Create fake result. */
11337 24 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11338 12 : SymbolTable_PutVar (Res, SymbolTable_GetSType (Var));
11339 12 : M2Quads_PushTFtok (Res, SymbolTable_GetSType (Var), combinedtok);
11340 : }
11341 165 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11342 : {
11343 : /* avoid dangling else. */
11344 316 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11345 158 : SymbolTable_PutVar (Res, SymbolTable_GetSType (Var));
11346 316 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, Res, ProcSym, Var, false);
11347 158 : M2Quads_PushTFtok (Res, SymbolTable_GetSType (Var), combinedtok);
11348 : }
11349 : else
11350 : {
11351 : /* avoid dangling else. */
11352 7 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the parameter to {%AkABS} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11353 : }
11354 : }
11355 : else
11356 : {
11357 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkABS} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11358 : }
11359 170 : }
11360 :
11361 :
11362 : /*
11363 : BuildCapFunction - builds the pseudo procedure call CAP.
11364 : We generate a the following quad:
11365 :
11366 :
11367 : StandardFunctionOp ReturnVal Cap Param1
11368 :
11369 : The Stack:
11370 :
11371 :
11372 : Entry Exit
11373 :
11374 : Ptr ->
11375 : +----------------+
11376 : | NoOfParam = 1 |
11377 : |----------------|
11378 : | Param 1 |
11379 : |----------------| +-------------+
11380 : | ProcSym | Type | | ReturnVal |
11381 : |----------------| |-------------|
11382 : */
11383 :
11384 125 : static void BuildCapFunction (unsigned int ProcSym, bool ConstExpr)
11385 : {
11386 125 : unsigned int optok;
11387 125 : unsigned int functok;
11388 125 : unsigned int combinedtok;
11389 125 : unsigned int NoOfParam;
11390 125 : unsigned int Res;
11391 125 : unsigned int Var;
11392 :
11393 125 : M2Quads_PopT (&NoOfParam);
11394 125 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11395 125 : if (NoOfParam == 1)
11396 : {
11397 125 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11398 125 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11399 125 : M2Quads_PopN (NoOfParam+1);
11400 125 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11401 : {
11402 : /* Create fake result. */
11403 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11404 24 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11405 12 : SymbolTable_PutVar (Res, M2Base_Char);
11406 12 : M2Quads_PushTFtok (Res, M2Base_Char, combinedtok);
11407 : }
11408 113 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11409 : {
11410 : /* avoid dangling else. */
11411 112 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11412 224 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11413 112 : SymbolTable_PutVar (Res, M2Base_Char);
11414 224 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, Res, ProcSym, Var, false);
11415 112 : M2Quads_PushTFtok (Res, M2Base_Char, combinedtok);
11416 : }
11417 : else
11418 : {
11419 : /* avoid dangling else. */
11420 1 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%AkCAP} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11421 : }
11422 : }
11423 : else
11424 : {
11425 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkCAP} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11426 : }
11427 124 : }
11428 :
11429 :
11430 : /*
11431 : BuildChrFunction - builds the pseudo procedure call CHR.
11432 : This procedure is actually a "macro" for
11433 : CHR(x) --> CONVERT(CHAR, x)
11434 : However we cannot push tokens back onto the input stack
11435 : because the compiler is currently building a function
11436 : call and expecting a ReturnVar on the stack.
11437 : Hence we manipulate the stack and call
11438 : BuildConvertFunction.
11439 :
11440 : The Stack:
11441 :
11442 :
11443 : Entry Exit
11444 :
11445 : Ptr ->
11446 : +----------------+
11447 : | NoOfParam |
11448 : |----------------|
11449 : | Param 1 |
11450 : |----------------|
11451 : | Param 2 |
11452 : |----------------|
11453 : . .
11454 : . .
11455 : . .
11456 : |----------------|
11457 : | Param # |
11458 : |----------------|
11459 : | ProcSym | Type | Empty
11460 : |----------------|
11461 : */
11462 :
11463 1016 : static void BuildChrFunction (unsigned int ProcSym, bool ConstExpr)
11464 : {
11465 1016 : unsigned int functok;
11466 1016 : unsigned int combinedtok;
11467 1016 : unsigned int optok;
11468 1016 : unsigned int ReturnVar;
11469 1016 : unsigned int NoOfParam;
11470 1016 : unsigned int Var;
11471 :
11472 1016 : M2Quads_PopT (&NoOfParam);
11473 1016 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11474 1016 : if (NoOfParam == 1)
11475 : {
11476 1016 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11477 1016 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11478 1016 : M2Quads_PopN (NoOfParam+1);
11479 1016 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11480 : {
11481 : /* Generate fake result. */
11482 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11483 24 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11484 12 : SymbolTable_PutVar (ReturnVar, M2Base_Char);
11485 12 : M2Quads_PushTFtok (ReturnVar, M2Base_Char, combinedtok);
11486 : }
11487 1004 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11488 : {
11489 : /* avoid dangling else. */
11490 : /*
11491 : Build macro: CONVERT( CHAR, Var )
11492 : */
11493 1003 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11494 1003 : M2Quads_PushTtok (M2Base_Char, functok);
11495 1003 : M2Quads_PushTtok (Var, optok);
11496 1003 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11497 1003 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11498 : }
11499 : else
11500 : {
11501 : /* avoid dangling else. */
11502 1 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%AkCHR} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11503 : }
11504 : }
11505 : else
11506 : {
11507 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkCHR} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11508 : }
11509 1015 : }
11510 :
11511 :
11512 : /*
11513 : BuildOrdFunction - builds the pseudo procedure call ORD.
11514 : This procedure is actually a "macro" for
11515 : ORD(x) --> CONVERT(GetSType(sym), x)
11516 : However we cannot push tokens back onto the input stack
11517 : because the compiler is currently building a function
11518 : call and expecting a ReturnVar on the stack.
11519 : Hence we manipulate the stack and call
11520 : BuildConvertFunction.
11521 :
11522 : The Stack:
11523 :
11524 :
11525 : Entry Exit
11526 :
11527 : Ptr ->
11528 : +----------------+
11529 : | NoOfParam |
11530 : |----------------|
11531 : | Param 1 |
11532 : |----------------|
11533 : | Param 2 |
11534 : |----------------|
11535 : . .
11536 : . .
11537 : . .
11538 : |----------------|
11539 : | Param # |
11540 : |----------------|
11541 : | ProcSym | Type | Empty
11542 : |----------------|
11543 : */
11544 :
11545 4692 : static void BuildOrdFunction (unsigned int Sym, bool ConstExpr)
11546 : {
11547 4692 : unsigned int combinedtok;
11548 4692 : unsigned int functok;
11549 4692 : unsigned int optok;
11550 4692 : unsigned int ReturnVar;
11551 4692 : unsigned int NoOfParam;
11552 4692 : unsigned int Type;
11553 4692 : unsigned int Var;
11554 :
11555 4692 : M2Quads_PopT (&NoOfParam);
11556 4692 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11557 4692 : if (NoOfParam == 1)
11558 : {
11559 4692 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11560 4692 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11561 4692 : M2Quads_PopN (NoOfParam+1);
11562 4692 : if (ConstExprError (Sym, Var, optok, ConstExpr))
11563 : {
11564 : /* Generate fake result. */
11565 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11566 24 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11567 12 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
11568 12 : M2Quads_PushTFtok (ReturnVar, M2Base_Cardinal, combinedtok);
11569 : }
11570 4680 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11571 : {
11572 : /* avoid dangling else. */
11573 4680 : Type = SymbolTable_GetSType (Sym);
11574 : /*
11575 : Build macro: CONVERT( CARDINAL, Var )
11576 : */
11577 4680 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11578 4680 : M2Quads_PushTtok (Type, optok);
11579 4680 : M2Quads_PushTtok (Var, optok);
11580 4680 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11581 4680 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11582 : }
11583 : else
11584 : {
11585 : /* avoid dangling else. */
11586 0 : M2MetaError_MetaErrorT2 (optok, (const char *) "the parameter to {%1Aa} must be a variable or constant, seen {%2ad} {%2&s}", 74, Sym, Var);
11587 : }
11588 : }
11589 : else
11590 : {
11591 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the pseudo procedure {%1Aa} only has one parameter, seen {%2n} parameters", 73, Sym, NoOfParam);
11592 : }
11593 4692 : }
11594 :
11595 :
11596 : /*
11597 : BuildIntFunction - builds the pseudo procedure call INT.
11598 : This procedure is actually a "macro" for
11599 : INT(x) --> CONVERT(INTEGER, x)
11600 : However we cannot push tokens back onto the input stack
11601 : because the compiler is currently building a function
11602 : call and expecting a ReturnVar on the stack.
11603 : Hence we manipulate the stack and call
11604 : BuildConvertFunction.
11605 :
11606 : The Stack:
11607 :
11608 :
11609 : Entry Exit
11610 :
11611 : Ptr ->
11612 : +----------------+
11613 : | NoOfParam |
11614 : |----------------|
11615 : | Param 1 |
11616 : |----------------|
11617 : | Param 2 |
11618 : |----------------|
11619 : . .
11620 : . .
11621 : . .
11622 : |----------------|
11623 : | Param # |
11624 : |----------------|
11625 : | ProcSym | Type | Empty
11626 : |----------------|
11627 : */
11628 :
11629 6 : static void BuildIntFunction (unsigned int Sym, bool ConstExpr)
11630 : {
11631 6 : unsigned int combinedtok;
11632 6 : unsigned int functok;
11633 6 : unsigned int optok;
11634 6 : unsigned int ReturnVar;
11635 6 : unsigned int NoOfParam;
11636 6 : unsigned int Type;
11637 6 : unsigned int Var;
11638 :
11639 6 : M2Quads_PopT (&NoOfParam);
11640 6 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11641 6 : if (NoOfParam == 1)
11642 : {
11643 6 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11644 6 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11645 6 : M2Quads_PopN (NoOfParam+1);
11646 6 : if (ConstExprError (Sym, Var, optok, ConstExpr))
11647 : {
11648 : /* Generate fake result. */
11649 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11650 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11651 6 : SymbolTable_PutVar (ReturnVar, M2Base_Integer);
11652 6 : M2Quads_PushTFtok (ReturnVar, M2Base_Integer, combinedtok);
11653 : }
11654 0 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11655 : {
11656 : /* avoid dangling else. */
11657 0 : Type = SymbolTable_GetSType (Sym); /* return type of function */
11658 : /* Build macro: CONVERT( CARDINAL, Var ). */
11659 0 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11660 0 : M2Quads_PushTtok (Type, functok);
11661 0 : M2Quads_PushTtok (Var, optok);
11662 0 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11663 0 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11664 : }
11665 : else
11666 : {
11667 : /* avoid dangling else. */
11668 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, optok, optok);
11669 0 : M2MetaError_MetaErrorT2 (optok, (const char *) "the parameter to {%1Ea} must be a variable or constant, seen {%2ad} {%2&s}", 74, Sym, Var);
11670 0 : M2Quads_PushTtok (combinedtok, SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType));
11671 : }
11672 : }
11673 : else
11674 : {
11675 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the pseudo procedure {%1Ea} only has one parameter, seen {%2n} parameters", 73, Sym, NoOfParam);
11676 0 : M2Quads_PushTtok (functok, SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType));
11677 : }
11678 6 : }
11679 :
11680 :
11681 : /*
11682 : BuildMakeAdrFunction - builds the pseudo procedure call MAKEADR.
11683 :
11684 : The Stack:
11685 :
11686 :
11687 : Entry Exit
11688 :
11689 : Ptr ->
11690 : +----------------+
11691 : | NoOfParam |
11692 : |----------------|
11693 : | Param 1 |
11694 : |----------------|
11695 : | Param 2 |
11696 : |----------------|
11697 : . .
11698 : . .
11699 : . .
11700 : |----------------|
11701 : | Param # |
11702 : |----------------|
11703 : | ProcSym | Type | Empty
11704 : |----------------|
11705 : */
11706 :
11707 12 : static void BuildMakeAdrFunction (void)
11708 : {
11709 12 : unsigned int functok;
11710 12 : unsigned int starttok;
11711 12 : unsigned int endtok;
11712 12 : unsigned int resulttok;
11713 12 : bool AreConst;
11714 12 : unsigned int i;
11715 12 : unsigned int pi;
11716 12 : unsigned int NoOfParameters;
11717 12 : unsigned int ReturnVar;
11718 :
11719 12 : M2Quads_PopT (&NoOfParameters);
11720 12 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParameters+1));
11721 12 : if (NoOfParameters > 0)
11722 : {
11723 12 : starttok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParameters+1)); /* ADR token. */
11724 12 : endtok = static_cast<unsigned int> (M2Quads_OperandTok (1)); /* last parameter. */
11725 24 : GenQuad (M2Quads_ParamOp, 0, M2System_MakeAdr, M2System_MakeAdr); /* last parameter. */
11726 12 : i = NoOfParameters;
11727 : /* stack index referencing stacked parameter, i */
11728 12 : pi = 1;
11729 24 : while (i > 0)
11730 : {
11731 12 : GenQuadO (M2Quads_OperandTok (pi), M2Quads_ParamOp, i, M2System_MakeAdr, M2Quads_OperandT (pi), true);
11732 12 : i -= 1;
11733 12 : pi += 1;
11734 : }
11735 : AreConst = true;
11736 : i = 1;
11737 24 : while (i <= NoOfParameters)
11738 : {
11739 12 : if (SymbolTable_IsVar (M2Quads_OperandT (i)))
11740 : {
11741 : AreConst = false;
11742 : }
11743 12 : else if (! (SymbolTable_IsConst (M2Quads_OperandT (i))))
11744 : {
11745 : /* avoid dangling else. */
11746 0 : M2MetaError_MetaError1 ((const char *) "problem in the {%1EN} argument for {%kMAKEADR}, all arguments to {%kMAKEADR} must be either variables or constants", 114, i);
11747 : }
11748 12 : i += 1;
11749 : }
11750 : /* ReturnVar - will have the type of the procedure */
11751 12 : resulttok = M2LexBuf_MakeVirtualTok (starttok, starttok, endtok);
11752 12 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (AreConst));
11753 12 : SymbolTable_PutVar (ReturnVar, SymbolTable_GetSType (M2System_MakeAdr));
11754 24 : GenQuadO (resulttok, M2Quads_FunctValueOp, ReturnVar, SymbolTable_NulSym, M2System_MakeAdr, true);
11755 12 : M2Quads_PopN (NoOfParameters+1);
11756 12 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (M2System_MakeAdr), resulttok);
11757 : }
11758 : else
11759 : {
11760 0 : M2MetaError_MetaError1 ((const char *) "the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%1n}", 77, NoOfParameters);
11761 0 : M2Quads_PopN (1);
11762 0 : M2Quads_PushTFtok (M2Base_Nil, SymbolTable_GetSType (M2System_MakeAdr), functok);
11763 : }
11764 12 : }
11765 :
11766 :
11767 : /*
11768 : BuildShiftFunction - builds the pseudo procedure call SHIFT.
11769 :
11770 : PROCEDURE SHIFT (val: <any type>;
11771 : num: INTEGER): <any type> ;
11772 :
11773 : "Returns a bit sequence obtained from val by
11774 : shifting up or down (left or right) by the
11775 : absolute value of num, introducing
11776 : zeros as necessary. The direction is down if
11777 : the sign of num is negative, otherwise the
11778 : direction is up."
11779 :
11780 : The Stack:
11781 :
11782 : Entry Exit
11783 :
11784 : Ptr ->
11785 : +----------------+
11786 : | NoOfParam |
11787 : |----------------|
11788 : | Param 1 |
11789 : |----------------|
11790 : | Param 2 | <- Ptr
11791 : |----------------| +------------+
11792 : | ProcSym | Type | | ReturnVar |
11793 : |----------------| |------------|
11794 : */
11795 :
11796 682 : static void BuildShiftFunction (void)
11797 : {
11798 682 : unsigned int combinedtok;
11799 682 : unsigned int paramtok;
11800 682 : unsigned int functok;
11801 682 : unsigned int vartok;
11802 682 : unsigned int exptok;
11803 682 : unsigned int r;
11804 682 : unsigned int procSym;
11805 682 : unsigned int returnVar;
11806 682 : unsigned int NoOfParam;
11807 682 : unsigned int derefExp;
11808 682 : unsigned int Exp;
11809 682 : unsigned int varSet;
11810 :
11811 682 : M2Quads_PopT (&NoOfParam);
11812 682 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11813 682 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11814 682 : if (NoOfParam == 2)
11815 : {
11816 682 : PopTrwtok (&Exp, &r, &exptok);
11817 682 : MarkAsRead (r);
11818 682 : M2Quads_PopTtok (&varSet, &vartok);
11819 682 : M2Quads_PopT (&procSym);
11820 682 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
11821 682 : if (((SymbolTable_GetSType (varSet)) != SymbolTable_NulSym) && ((SymbolTable_IsSet (SymbolTable_GetDType (varSet))) || (M2System_IsGenericSystemType (SymbolTable_GetDType (varSet)))))
11822 : {
11823 682 : derefExp = DereferenceLValue (exptok, Exp);
11824 682 : BuildRange (M2Range_InitShiftCheck (varSet, derefExp));
11825 682 : returnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11826 682 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (varSet));
11827 1364 : GenQuadO (combinedtok, M2Quads_LogicalShiftOp, returnVar, varSet, derefExp, true);
11828 682 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (varSet), combinedtok);
11829 : }
11830 : else
11831 : {
11832 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad} {%1&s}", 126, varSet);
11833 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, combinedtok);
11834 : }
11835 : }
11836 : else
11837 : {
11838 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
11839 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%kSHIFT} requires at least two parameters, seen {%1En}", 76, NoOfParam);
11840 0 : M2Quads_PopN (NoOfParam+1);
11841 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, combinedtok);
11842 : }
11843 682 : }
11844 :
11845 :
11846 : /*
11847 : BuildRotateFunction - builds the pseudo procedure call ROTATE.
11848 :
11849 : PROCEDURE ROTATE (val: <any type>;
11850 : num: INTEGER): <any type> ;
11851 :
11852 : "Returns a bit sequence obtained from val
11853 : by rotating up or down (left or right) by
11854 : the absolute value of num. The direction is
11855 : down if the sign of num is negative, otherwise
11856 : the direction is up."
11857 :
11858 : The Stack:
11859 :
11860 : Entry Exit
11861 :
11862 : Ptr ->
11863 : +----------------+
11864 : | NoOfParam |
11865 : |----------------|
11866 : | Param 1 |
11867 : |----------------|
11868 : | Param 2 | <- Ptr
11869 : |----------------| +------------+
11870 : | ProcSym | Type | | ReturnVar |
11871 : |----------------| |------------|
11872 : */
11873 :
11874 406 : static void BuildRotateFunction (void)
11875 : {
11876 406 : unsigned int combinedtok;
11877 406 : unsigned int functok;
11878 406 : unsigned int vartok;
11879 406 : unsigned int exptok;
11880 406 : unsigned int r;
11881 406 : unsigned int procSym;
11882 406 : unsigned int returnVar;
11883 406 : unsigned int NoOfParam;
11884 406 : unsigned int derefExp;
11885 406 : unsigned int Exp;
11886 406 : unsigned int varSet;
11887 :
11888 406 : M2Quads_PopT (&NoOfParam);
11889 406 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11890 406 : if (NoOfParam == 2)
11891 : {
11892 406 : PopTrwtok (&Exp, &r, &exptok);
11893 406 : MarkAsRead (r);
11894 406 : M2Quads_PopTtok (&varSet, &vartok);
11895 406 : M2Quads_PopT (&procSym);
11896 406 : if (((SymbolTable_GetSType (varSet)) != SymbolTable_NulSym) && ((SymbolTable_IsSet (SymbolTable_GetDType (varSet))) || (M2System_IsGenericSystemType (SymbolTable_GetDType (varSet)))))
11897 : {
11898 406 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
11899 406 : derefExp = DereferenceLValue (exptok, Exp);
11900 406 : BuildRange (M2Range_InitRotateCheck (varSet, derefExp));
11901 406 : returnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11902 406 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (varSet));
11903 812 : GenQuadO (combinedtok, M2Quads_LogicalRotateOp, returnVar, varSet, derefExp, true);
11904 406 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (varSet), combinedtok);
11905 : }
11906 : else
11907 : {
11908 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad} {%1&s}", 126, varSet);
11909 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
11910 : }
11911 : }
11912 : else
11913 : {
11914 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "SYSTEM procedure {%EkROTATE} expects 2 parameters and was given {%1n} parameters", 80, NoOfParam);
11915 0 : M2Quads_PopN (NoOfParam+1);
11916 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
11917 : }
11918 406 : }
11919 :
11920 :
11921 : /*
11922 : BuildValFunction - builds the pseudo procedure call VAL.
11923 : This procedure is actually a "macro" for
11924 : VAL(Type, x) --> CONVERT(Type, x)
11925 : However we cannot push tokens back onto the input stack
11926 : because the compiler is currently building a function
11927 : call and expecting a ReturnVar on the stack.
11928 : Hence we manipulate the stack and call
11929 : BuildConvertFunction.
11930 :
11931 : The Stack:
11932 :
11933 :
11934 : Entry Exit
11935 :
11936 : Ptr ->
11937 : +----------------+
11938 : | NoOfParam |
11939 : |----------------|
11940 : | Param 1 |
11941 : |----------------|
11942 : | Param 2 |
11943 : |----------------|
11944 : . .
11945 : . .
11946 : . .
11947 : |----------------|
11948 : | Param # |
11949 : |----------------|
11950 : | ProcSym | Type | Empty
11951 : |----------------|
11952 : */
11953 :
11954 4918 : static void BuildValFunction (unsigned int ProcSym, bool ConstExpr)
11955 : {
11956 4918 : unsigned int combinedtok;
11957 4918 : unsigned int functok;
11958 4918 : unsigned int ReturnVar;
11959 4918 : unsigned int NoOfParam;
11960 4918 : unsigned int Exp;
11961 4918 : unsigned int Type;
11962 4918 : unsigned int tok;
11963 4918 : unsigned int r;
11964 4918 : unsigned int typetok;
11965 4918 : unsigned int exptok;
11966 :
11967 4918 : M2Quads_PopT (&NoOfParam);
11968 4918 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11969 4918 : if (NoOfParam == 2)
11970 : {
11971 4918 : PopTrwtok (&Exp, &r, &exptok);
11972 4918 : MarkAsRead (r);
11973 4918 : M2Quads_PopTtok (&Type, &typetok);
11974 4918 : M2Quads_PopTtok (&ProcSym, &tok);
11975 4918 : if (SymbolTable_IsUnknown (Type))
11976 : {
11977 : /* It is sensible not to try and recover when we dont know the return type. */
11978 6 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type found in builtin procedure function {%AkVAL} {%1ad} {%1&s}", 74, Type);
11979 : /* Non recoverable error. */
11980 0 : SymbolTable_UnknownReported (Type);
11981 : }
11982 4912 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
11983 : {
11984 : /* avoid dangling else. */
11985 : /* Generate fake result. */
11986 6 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
11987 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
11988 6 : SymbolTable_PutVar (ReturnVar, Type);
11989 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
11990 : }
11991 4906 : else if (((((((SymbolTable_IsSet (Type)) || (SymbolTable_IsEnumeration (Type))) || (SymbolTable_IsSubrange (Type))) || (SymbolTable_IsType (Type))) || (SymbolTable_IsPointer (Type))) || (SymbolTable_IsProcType (Type))) && (((SymbolTable_IsVar (Exp)) || (SymbolTable_IsConst (Exp))) || (SymbolTable_IsProcedure (Exp))))
11992 : {
11993 : /* avoid dangling else. */
11994 : /*
11995 : Build macro: CONVERT( Type, Var )
11996 : */
11997 4906 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
11998 4906 : M2Quads_PushTtok (Type, typetok);
11999 4906 : M2Quads_PushTtok (Exp, exptok);
12000 4906 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
12001 4906 : BuildConvertFunction (M2Base_Convert, ConstExpr);
12002 : }
12003 : else
12004 : {
12005 : /* avoid dangling else. */
12006 : /* non recoverable error. */
12007 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkVAL} has the following formal parameter declaration {%kVAL} (type, expression)", 104);
12008 : }
12009 : }
12010 : else
12011 : {
12012 : /* non recoverable error. */
12013 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the builtin procedure {%AkVAL} expects 2 parameters, a type and an expression, but was given {%1n} parameters", 109, NoOfParam);
12014 : }
12015 4912 : }
12016 :
12017 :
12018 : /*
12019 : BuildCastFunction - builds the pseudo procedure call CAST.
12020 : This procedure is actually a "macro" for
12021 : CAST(Type, x) --> Type(x)
12022 : However we cannot push tokens back onto the input stack
12023 : because the compiler is currently building a function
12024 : call and expecting a ReturnVar on the stack.
12025 : Hence we manipulate the stack and call
12026 : BuildConvertFunction.
12027 :
12028 : The Stack:
12029 :
12030 :
12031 : Entry Exit
12032 :
12033 : Ptr ->
12034 : +----------------+
12035 : | NoOfParam |
12036 : |----------------|
12037 : | Param 1 |
12038 : |----------------|
12039 : | Param 2 |
12040 : |----------------|
12041 : . .
12042 : . .
12043 : . .
12044 : |----------------|
12045 : | Param # |
12046 : |----------------|
12047 : | ProcSym | Type | Empty
12048 : |----------------|
12049 : */
12050 :
12051 156 : static void BuildCastFunction (unsigned int ProcSym, bool ConstExpr)
12052 : {
12053 156 : unsigned int combinedtok;
12054 156 : unsigned int exptok;
12055 156 : unsigned int typetok;
12056 156 : unsigned int functok;
12057 156 : unsigned int ReturnVar;
12058 156 : unsigned int NoOfParam;
12059 156 : unsigned int Exp;
12060 156 : unsigned int Type;
12061 :
12062 156 : M2Quads_PopT (&NoOfParam);
12063 156 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
12064 156 : if (NoOfParam == 2)
12065 : {
12066 156 : Type = static_cast<unsigned int> (M2Quads_OperandT (2));
12067 156 : typetok = static_cast<unsigned int> (M2Quads_OperandTok (2));
12068 156 : Exp = static_cast<unsigned int> (M2Quads_OperandT (1));
12069 156 : exptok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12070 156 : if (SymbolTable_IsUnknown (Type))
12071 : {
12072 : /* We cannot recover if we dont have a type. */
12073 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type {%1Aad} found in {%kCAST} {%1&s}", 48, Type);
12074 : /* Non recoverable error. */
12075 0 : SymbolTable_UnknownReported (Type);
12076 : }
12077 156 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
12078 : {
12079 : /* avoid dangling else. */
12080 : /* Generate fake result. */
12081 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12082 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12083 0 : SymbolTable_PutVar (ReturnVar, Type);
12084 0 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12085 : }
12086 156 : else if (((((((SymbolTable_IsSet (Type)) || (SymbolTable_IsEnumeration (Type))) || (SymbolTable_IsSubrange (Type))) || (SymbolTable_IsType (Type))) || (SymbolTable_IsPointer (Type))) || (SymbolTable_IsArray (Type))) || (SymbolTable_IsProcType (Type)))
12087 : {
12088 : /* avoid dangling else. */
12089 156 : if (SymbolTable_IsConst (Exp))
12090 : {
12091 30 : M2Quads_PopN (NoOfParam+1);
12092 : /*
12093 : Build macro: Type( Var )
12094 : */
12095 30 : M2Quads_PushTFtok (Type, static_cast<unsigned int> (SymbolTable_NulSym), typetok);
12096 30 : M2Quads_PushTtok (Exp, exptok);
12097 30 : M2Quads_PushT (static_cast<unsigned int> (1)); /* one parameter */
12098 30 : BuildTypeCoercion (ConstExpr); /* one parameter */
12099 : }
12100 126 : else if ((SymbolTable_IsVar (Exp)) || (SymbolTable_IsProcedure (Exp)))
12101 : {
12102 : /* avoid dangling else. */
12103 126 : M2Quads_PopN (NoOfParam+1);
12104 126 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, exptok);
12105 126 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
12106 126 : SymbolTable_PutVar (ReturnVar, Type);
12107 252 : GenQuadO (combinedtok, M2Quads_CastOp, ReturnVar, Type, Exp, false);
12108 126 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12109 : }
12110 : else
12111 : {
12112 : /* avoid dangling else. */
12113 : /* non recoverable error. */
12114 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the second parameter to the builtin procedure {%AkCAST} must either be a variable, constant or a procedure. The formal parameters to cast are {%kCAST} (type, variable or constant or procedure)", 193);
12115 : }
12116 : }
12117 : else
12118 : {
12119 : /* avoid dangling else. */
12120 : /* non recoverable error. */
12121 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkCAST} has the following formal parameter declaration {%kCAST} (type, expression)", 106);
12122 : }
12123 : }
12124 : else
12125 : {
12126 : /* non recoverable error. */
12127 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the builtin procedure {%AkCAST} `expects 2 parameters, a type and an expression, but was given {%1n} parameters", 111, NoOfParam);
12128 : }
12129 156 : }
12130 :
12131 :
12132 : /*
12133 : BuildConvertFunction - builds the pseudo function CONVERT.
12134 : CONVERT( Type, Variable ) ;
12135 :
12136 : The Stack:
12137 :
12138 :
12139 : Entry Exit
12140 :
12141 : Ptr ->
12142 : +----------------+
12143 : | NoOfParam |
12144 : |----------------|
12145 : | Param 1 |
12146 : |----------------|
12147 : | Param 2 |
12148 : |----------------|
12149 : . .
12150 : . .
12151 : . .
12152 : |----------------|
12153 : | Param # | <- Ptr
12154 : |----------------| +---------------------+
12155 : | ProcSym | Type | | ReturnVar | Param1 |
12156 : |----------------| |---------------------|
12157 :
12158 : Quadruples:
12159 :
12160 : ConvertOp ReturnVar Param1 Param2
12161 :
12162 : Converts variable Param2 into a variable Param1
12163 : with a type Param1.
12164 : */
12165 :
12166 56325 : static void BuildConvertFunction (unsigned int ProcSym, bool ConstExpr)
12167 : {
12168 56325 : unsigned int combinedtok;
12169 56325 : unsigned int functok;
12170 56325 : unsigned int typetok;
12171 56325 : unsigned int exptok;
12172 56325 : unsigned int t;
12173 56325 : unsigned int r;
12174 56325 : unsigned int Exp;
12175 56325 : unsigned int Type;
12176 56325 : unsigned int NoOfParam;
12177 56325 : unsigned int ReturnVar;
12178 :
12179 56325 : M2Quads_PopT (&NoOfParam);
12180 56325 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
12181 56325 : if (NoOfParam == 2)
12182 : {
12183 56325 : PopTrwtok (&Exp, &r, &exptok);
12184 56325 : MarkAsRead (r);
12185 56325 : M2Quads_PopTtok (&Type, &typetok);
12186 56325 : M2Quads_PopT (&ProcSym);
12187 56325 : if (SymbolTable_IsUnknown (Type))
12188 : {
12189 : /* We cannot recover if we dont have a type. */
12190 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type {%1Aad} found in {%kCONVERT} {%1&s}", 51, Type);
12191 : /* Non recoverable error. */
12192 0 : SymbolTable_UnknownReported (Type);
12193 : }
12194 56325 : else if (SymbolTable_IsUnknown (Exp))
12195 : {
12196 : /* avoid dangling else. */
12197 : /* We cannot recover if we dont have an expression. */
12198 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "unknown {%1Ad} {%1ad} found in {%kCONVERT} {%1&s}", 49, Exp);
12199 : /* Non recoverable error. */
12200 0 : SymbolTable_UnknownReported (Exp);
12201 : }
12202 56325 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
12203 : {
12204 : /* avoid dangling else. */
12205 : /* Generate fake result. */
12206 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12207 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12208 0 : SymbolTable_PutVar (ReturnVar, Type);
12209 0 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12210 : }
12211 56325 : else if ((((((((SymbolTable_IsSet (Type)) || (SymbolTable_IsEnumeration (Type))) || (SymbolTable_IsSubrange (Type))) || (SymbolTable_IsType (Type))) || (SymbolTable_IsPointer (Type))) || (SymbolTable_IsProcType (Type))) || (SymbolTable_IsRecord (Type))) && (((SymbolTable_IsVar (Exp)) || (SymbolTable_IsConst (Exp))) || (SymbolTable_IsProcedure (Exp))))
12212 : {
12213 : /* avoid dangling else. */
12214 : /* firstly dereference Var */
12215 56319 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
12216 : {
12217 0 : t = SymbolTable_MakeTemporary (exptok, SymbolTable_RightValue);
12218 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (Exp));
12219 0 : CheckPointerThroughNil (exptok, Exp);
12220 0 : doIndrX (exptok, t, Exp);
12221 0 : Exp = t;
12222 : }
12223 56319 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12224 112638 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12225 56319 : SymbolTable_PutVar (ReturnVar, Type);
12226 112638 : GenQuadO (combinedtok, M2Quads_ConvertOp, ReturnVar, Type, Exp, true);
12227 56319 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12228 : }
12229 : else
12230 : {
12231 : /* avoid dangling else. */
12232 : /* non recoverable error. */
12233 6 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkCONVERT} has the following formal parameter declaration {%kCONVERT} (type, expression)", 112);
12234 : }
12235 : }
12236 : else
12237 : {
12238 : /* non recoverable error. */
12239 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the builtin procedure {%AkCONVERT} expects 2 parameters, a type and an expression, but was given {%1n} parameters", 113, NoOfParam);
12240 : }
12241 56319 : }
12242 :
12243 :
12244 : /*
12245 : CheckBaseTypeValue - checks to see whether the value, min, really exists.
12246 : */
12247 :
12248 2012 : static unsigned int CheckBaseTypeValue (unsigned int tok, unsigned int type, unsigned int min, unsigned int func)
12249 : {
12250 2012 : if (((type == M2Base_Real) || (type == M2Base_LongReal)) || (type == M2Base_ShortReal))
12251 : {
12252 102 : SymbolTable_PushValue (min);
12253 102 : if (! (M2ALU_IsValueAndTreeKnown ()))
12254 : {
12255 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1Ead} ({%2ad}) cannot be calculated at compile time for the target architecture", 81, func, type);
12256 0 : return SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType);
12257 : }
12258 : }
12259 : return min;
12260 : /* static analysis guarentees a RETURN statement will be used before here. */
12261 : __builtin_unreachable ();
12262 : }
12263 :
12264 :
12265 : /*
12266 : GetTypeMin - returns the minimium value of type and generate an error
12267 : if this is unavailable.
12268 : */
12269 :
12270 1298 : static unsigned int GetTypeMin (unsigned int tok, unsigned int func, unsigned int type)
12271 : {
12272 1298 : unsigned int min;
12273 :
12274 1298 : min = GetTypeMinLower (tok, func, type);
12275 1298 : if (min == SymbolTable_NulSym)
12276 : {
12277 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "unable to obtain the {%AkMIN} value for type {%1ad}", 51, type);
12278 : }
12279 1298 : return min;
12280 : /* static analysis guarentees a RETURN statement will be used before here. */
12281 : __builtin_unreachable ();
12282 : }
12283 :
12284 :
12285 : /*
12286 : GetTypeMinLower - obtain the maximum value for type.
12287 : */
12288 :
12289 1298 : static unsigned int GetTypeMinLower (unsigned int tok, unsigned int func, unsigned int type)
12290 : {
12291 1298 : unsigned int min;
12292 1298 : unsigned int max;
12293 :
12294 1298 : if (SymbolTable_IsSubrange (type))
12295 : {
12296 282 : min = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
12297 282 : SymbolTable_PutVar (min, type);
12298 564 : GenQuad (M2Quads_SubrangeLowOp, min, SymbolTable_NulSym, type);
12299 282 : return min;
12300 : }
12301 1016 : else if (SymbolTable_IsSet (SymbolTable_SkipType (type)))
12302 : {
12303 : /* avoid dangling else. */
12304 60 : return GetTypeMin (tok, func, SymbolTable_GetSType (SymbolTable_SkipType (type)));
12305 : }
12306 956 : else if ((M2Base_IsBaseType (type)) || (SymbolTable_IsEnumeration (type)))
12307 : {
12308 : /* avoid dangling else. */
12309 754 : M2Base_GetBaseTypeMinMax (type, &min, &max);
12310 754 : min = CheckBaseTypeValue (tok, type, min, func);
12311 754 : return min;
12312 : }
12313 202 : else if (M2System_IsSystemType (type))
12314 : {
12315 : /* avoid dangling else. */
12316 186 : M2System_GetSystemTypeMinMax (type, &min, &max);
12317 186 : return min;
12318 : }
12319 16 : else if ((SymbolTable_GetSType (type)) == SymbolTable_NulSym)
12320 : {
12321 : /* avoid dangling else. */
12322 : return SymbolTable_NulSym;
12323 : }
12324 : else
12325 : {
12326 : /* avoid dangling else. */
12327 16 : return GetTypeMin (tok, func, SymbolTable_GetSType (type));
12328 : }
12329 : /* static analysis guarentees a RETURN statement will be used before here. */
12330 : __builtin_unreachable ();
12331 : }
12332 :
12333 :
12334 : /*
12335 : GetTypeMax - returns the maximum value of type and generate an error
12336 : if this is unavailable.
12337 : */
12338 :
12339 2240 : static unsigned int GetTypeMax (unsigned int tok, unsigned int func, unsigned int type)
12340 : {
12341 2240 : unsigned int max;
12342 :
12343 2240 : max = GetTypeMaxLower (tok, func, type);
12344 2240 : if (max == SymbolTable_NulSym)
12345 : {
12346 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "unable to obtain the {%AkMAX} value for type {%1ad}", 51, type);
12347 : }
12348 2240 : return max;
12349 : /* static analysis guarentees a RETURN statement will be used before here. */
12350 : __builtin_unreachable ();
12351 : }
12352 :
12353 :
12354 : /*
12355 : GetTypeMaxLower - obtain the maximum value for type.
12356 : */
12357 :
12358 2240 : static unsigned int GetTypeMaxLower (unsigned int tok, unsigned int func, unsigned int type)
12359 : {
12360 2240 : unsigned int min;
12361 2240 : unsigned int max;
12362 :
12363 2240 : if (SymbolTable_IsSubrange (type))
12364 : {
12365 554 : max = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
12366 554 : SymbolTable_PutVar (max, type);
12367 1108 : GenQuad (M2Quads_SubrangeHighOp, max, SymbolTable_NulSym, type);
12368 554 : return max;
12369 : }
12370 1686 : else if (SymbolTable_IsSet (SymbolTable_SkipType (type)))
12371 : {
12372 : /* avoid dangling else. */
12373 210 : return GetTypeMax (tok, func, SymbolTable_GetSType (SymbolTable_SkipType (type)));
12374 : }
12375 1476 : else if ((M2Base_IsBaseType (type)) || (SymbolTable_IsEnumeration (type)))
12376 : {
12377 : /* avoid dangling else. */
12378 1258 : M2Base_GetBaseTypeMinMax (type, &min, &max);
12379 1258 : min = CheckBaseTypeValue (tok, type, min, func);
12380 1258 : return max;
12381 : }
12382 218 : else if (M2System_IsSystemType (type))
12383 : {
12384 : /* avoid dangling else. */
12385 202 : M2System_GetSystemTypeMinMax (type, &min, &max);
12386 202 : return max;
12387 : }
12388 16 : else if ((SymbolTable_GetSType (type)) == SymbolTable_NulSym)
12389 : {
12390 : /* avoid dangling else. */
12391 : return SymbolTable_NulSym;
12392 : }
12393 : else
12394 : {
12395 : /* avoid dangling else. */
12396 16 : return GetTypeMax (tok, func, SymbolTable_GetSType (type));
12397 : }
12398 : /* static analysis guarentees a RETURN statement will be used before here. */
12399 : __builtin_unreachable ();
12400 : }
12401 :
12402 :
12403 : /*
12404 : BuildMinFunction - builds the pseudo function call Min.
12405 :
12406 : The Stack:
12407 :
12408 : Entry Exit
12409 :
12410 : Ptr ->
12411 : +----------------+
12412 : | NoOfParam=1 |
12413 : |----------------|
12414 : | Param 1 |
12415 : |----------------|
12416 : | ProcSym | Type | Empty
12417 : |----------------|
12418 : */
12419 :
12420 1222 : static void BuildMinFunction (void)
12421 : {
12422 1222 : unsigned int combinedtok;
12423 1222 : unsigned int functok;
12424 1222 : unsigned int vartok;
12425 1222 : unsigned int func;
12426 1222 : unsigned int min;
12427 1222 : unsigned int NoOfParam;
12428 1222 : unsigned int Var;
12429 :
12430 1222 : M2Quads_PopT (&NoOfParam);
12431 1222 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12432 1222 : functok = OperandTtok (NoOfParam+1);
12433 1222 : if (NoOfParam == 1)
12434 : {
12435 1222 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12436 1222 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12437 1222 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12438 1222 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok); /* destroy arguments to this function */
12439 1222 : if (SymbolTable_IsAModula2Type (Var))
12440 : {
12441 1222 : min = GetTypeMin (vartok, func, Var);
12442 1222 : M2Quads_PushTFtok (min, SymbolTable_GetSType (min), combinedtok);
12443 : }
12444 0 : else if (SymbolTable_IsVar (Var))
12445 : {
12446 : /* avoid dangling else. */
12447 0 : min = GetTypeMin (vartok, func, SymbolTable_GetSType (Var));
12448 0 : M2Quads_PushTFtok (min, SymbolTable_GetSType (Var), combinedtok);
12449 : }
12450 : else
12451 : {
12452 : /* avoid dangling else. */
12453 : /* non recoverable error. */
12454 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "parameter to {%AkMIN} must be a type or a variable, seen {%1ad} {%1&s}", 70, Var);
12455 : }
12456 : }
12457 : else
12458 : {
12459 : /* non recoverable error. */
12460 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkMIN} only has one parameter, seen {%1n}", 82, NoOfParam);
12461 : }
12462 1222 : }
12463 :
12464 :
12465 : /*
12466 : BuildMaxFunction - builds the pseudo function call Max.
12467 :
12468 : The Stack:
12469 :
12470 : Entry Exit
12471 :
12472 : Ptr ->
12473 : +----------------+
12474 : | NoOfParam=1 |
12475 : |----------------|
12476 : | Param 1 |
12477 : |----------------|
12478 : | ProcSym | Type | Empty
12479 : |----------------|
12480 : */
12481 :
12482 2014 : static void BuildMaxFunction (void)
12483 : {
12484 2014 : unsigned int combinedtok;
12485 2014 : unsigned int functok;
12486 2014 : unsigned int vartok;
12487 2014 : unsigned int func;
12488 2014 : unsigned int max;
12489 2014 : unsigned int NoOfParam;
12490 2014 : unsigned int Var;
12491 :
12492 2014 : M2Quads_PopT (&NoOfParam);
12493 2014 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12494 2014 : functok = OperandTtok (NoOfParam+1);
12495 2014 : if (NoOfParam == 1)
12496 : {
12497 2014 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12498 2014 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12499 2014 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12500 2014 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok); /* destroy arguments to this function */
12501 2014 : if (SymbolTable_IsAModula2Type (Var))
12502 : {
12503 2014 : max = GetTypeMax (vartok, func, Var);
12504 2014 : M2Quads_PushTFtok (max, SymbolTable_GetSType (max), combinedtok);
12505 : }
12506 0 : else if (SymbolTable_IsVar (Var))
12507 : {
12508 : /* avoid dangling else. */
12509 0 : max = GetTypeMax (vartok, func, SymbolTable_GetSType (Var));
12510 0 : M2Quads_PushTFtok (max, SymbolTable_GetSType (Var), combinedtok);
12511 : }
12512 : else
12513 : {
12514 : /* avoid dangling else. */
12515 : /* non recoverable error. */
12516 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "parameter to {%AkMAX} must be a type or a variable, seen {%1ad} {%1&s}", 70, Var);
12517 : }
12518 : }
12519 : else
12520 : {
12521 : /* non recoverable error. */
12522 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkMAX} only has one parameter, seen {%1n}", 81, NoOfParam);
12523 : }
12524 2014 : }
12525 :
12526 :
12527 : /*
12528 : BuildTruncFunction - builds the pseudo procedure call TRUNC.
12529 : This procedure is actually a "macro" for
12530 : TRUNC(x) --> CONVERT(INTEGER, x)
12531 : However we cannot push tokens back onto the input stack
12532 : because the compiler is currently building a function
12533 : call and expecting a ReturnVar on the stack.
12534 : Hence we manipulate the stack and call
12535 : BuildConvertFunction.
12536 :
12537 : The Stack:
12538 :
12539 :
12540 : Entry Exit
12541 :
12542 : Ptr ->
12543 : +----------------+
12544 : | NoOfParam |
12545 : |----------------|
12546 : | Param 1 |
12547 : |----------------|
12548 : | Param 2 |
12549 : |----------------|
12550 : . .
12551 : . .
12552 : . .
12553 : |----------------|
12554 : | Param # |
12555 : |----------------|
12556 : | ProcSym | Type | Empty
12557 : |----------------|
12558 : */
12559 :
12560 60 : static void BuildTruncFunction (unsigned int Sym, bool ConstExpr)
12561 : {
12562 60 : unsigned int combinedtok;
12563 60 : unsigned int vartok;
12564 60 : unsigned int functok;
12565 60 : unsigned int NoOfParam;
12566 60 : unsigned int ReturnVar;
12567 60 : unsigned int ProcSym;
12568 60 : unsigned int Type;
12569 60 : unsigned int Var;
12570 :
12571 60 : M2Quads_PopT (&NoOfParam);
12572 60 : M2Debug_Assert (M2Base_IsTrunc (M2Quads_OperandT (NoOfParam+1)));
12573 60 : functok = OperandTtok (NoOfParam+1);
12574 60 : if (NoOfParam == 1)
12575 : {
12576 60 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "CONVERT", 7));
12577 60 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
12578 : {
12579 60 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12580 60 : vartok = OperandTtok (1);
12581 60 : Type = SymbolTable_GetSType (Sym);
12582 60 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12583 60 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12584 : {
12585 : /* Generate fake result. */
12586 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12587 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12588 6 : SymbolTable_PutVar (ReturnVar, Type);
12589 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12590 : }
12591 54 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12592 : {
12593 : /* avoid dangling else. */
12594 54 : if (M2Base_IsRealType (SymbolTable_GetSType (Var)))
12595 : {
12596 : /* build macro: CONVERT( INTEGER, Var ). */
12597 54 : M2Quads_PushTFtok (ProcSym, static_cast<unsigned int> (SymbolTable_NulSym), functok);
12598 54 : M2Quads_PushTtok (Type, functok);
12599 54 : M2Quads_PushTtok (Var, vartok);
12600 54 : M2Quads_PushT (static_cast<unsigned int> (2)); /* two parameters */
12601 54 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* two parameters */
12602 : }
12603 : else
12604 : {
12605 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "argument to {%1Ead} must be a float point type", 46, Sym);
12606 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), Type), Type, functok);
12607 : }
12608 : }
12609 : else
12610 : {
12611 : /* avoid dangling else. */
12612 0 : M2MetaError_MetaErrorT2 (vartok, (const char *) "argument to {%1Ead} must be a variable or constant, seen {%2ad} {%2&s}", 70, Sym, Var);
12613 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), Type), Type, functok);
12614 : }
12615 : }
12616 : else
12617 : {
12618 0 : M2Error_InternalError ((const char *) "CONVERT procedure not found for TRUNC substitution", 50);
12619 : }
12620 : }
12621 : else
12622 : {
12623 : /* non recoverable error. */
12624 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkTRUNC} only has one parameter, seen {%1n}", 84, NoOfParam);
12625 : }
12626 60 : }
12627 :
12628 :
12629 : /*
12630 : BuildFloatFunction - builds the pseudo procedure call FLOAT.
12631 : This procedure is actually a "macro" for
12632 : FLOAT(x) --> CONVERT(REAL, x)
12633 : However we cannot push tokens back onto the input stack
12634 : because the compiler is currently building a function
12635 : call and expecting a ReturnVar on the stack.
12636 : Hence we manipulate the stack and call
12637 : BuildConvertFunction.
12638 :
12639 : The Stack:
12640 :
12641 :
12642 : Entry Exit
12643 :
12644 : Ptr ->
12645 : +----------------+
12646 : | NoOfParam |
12647 : |----------------|
12648 : | Param 1 |
12649 : |----------------|
12650 : | Param 2 |
12651 : |----------------|
12652 : . .
12653 : . .
12654 : . .
12655 : |----------------|
12656 : | Param # |
12657 : |----------------|
12658 : | ProcSym | Type | Empty
12659 : |----------------|
12660 : */
12661 :
12662 88 : static void BuildFloatFunction (unsigned int Sym, bool ConstExpr)
12663 : {
12664 88 : unsigned int combinedtok;
12665 88 : unsigned int vartok;
12666 88 : unsigned int functok;
12667 88 : unsigned int NoOfParam;
12668 88 : unsigned int ReturnVar;
12669 88 : unsigned int Type;
12670 88 : unsigned int Var;
12671 88 : unsigned int ProcSym;
12672 :
12673 88 : M2Quads_PopT (&NoOfParam);
12674 88 : functok = OperandTtok (NoOfParam+1);
12675 88 : Type = SymbolTable_GetSType (Sym);
12676 88 : if (NoOfParam == 1)
12677 : {
12678 88 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "CONVERT", 7));
12679 88 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
12680 : {
12681 88 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12682 88 : vartok = OperandTtok (1);
12683 88 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function. */
12684 88 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12685 : {
12686 : /* Generate fake result. */
12687 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12688 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12689 6 : SymbolTable_PutVar (ReturnVar, Type);
12690 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12691 : }
12692 82 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12693 : {
12694 : /* avoid dangling else. */
12695 : /* build macro: CONVERT (REAL, Var). */
12696 82 : M2Quads_PushTFtok (ProcSym, static_cast<unsigned int> (SymbolTable_NulSym), functok);
12697 82 : M2Quads_PushTtok (Type, functok);
12698 82 : M2Quads_PushTtok (Var, vartok);
12699 82 : M2Quads_PushT (static_cast<unsigned int> (2)); /* two parameters. */
12700 82 : BuildConvertFunction (ProcSym, ConstExpr); /* two parameters. */
12701 : }
12702 : else
12703 : {
12704 : /* avoid dangling else. */
12705 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "argument to {%1Ead} must be a variable or constant", 50, ProcSym);
12706 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0.0", 3), Type), Type, functok);
12707 : }
12708 : }
12709 : else
12710 : {
12711 0 : M2Error_InternalError ((const char *) "CONVERT procedure not found for FLOAT substitution", 50);
12712 : }
12713 : }
12714 : else
12715 : {
12716 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function. */
12717 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter", 61, Sym); /* destroy arguments to this function. */
12718 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0.0", 3), Type), Type, functok);
12719 : }
12720 88 : }
12721 :
12722 :
12723 : /*
12724 : BuildReFunction - builds the pseudo procedure call RE.
12725 :
12726 : The Stack:
12727 :
12728 :
12729 : Entry Exit
12730 :
12731 : Ptr ->
12732 : +----------------+
12733 : | NoOfParam |
12734 : |----------------|
12735 : | Param 1 |
12736 : |----------------|
12737 : | Param 2 |
12738 : |----------------|
12739 : . .
12740 : . .
12741 : . .
12742 : |----------------|
12743 : | Param # |
12744 : |----------------|
12745 : | ProcSym | Type | Empty
12746 : |----------------|
12747 : */
12748 :
12749 60 : static void BuildReFunction (unsigned int Sym, bool ConstExpr)
12750 : {
12751 60 : unsigned int func;
12752 60 : unsigned int combinedtok;
12753 60 : unsigned int vartok;
12754 60 : unsigned int functok;
12755 60 : unsigned int NoOfParam;
12756 60 : unsigned int ReturnVar;
12757 60 : unsigned int Type;
12758 60 : unsigned int Var;
12759 :
12760 60 : M2Quads_PopT (&NoOfParam);
12761 60 : functok = OperandTtok (NoOfParam+1);
12762 60 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12763 60 : if (NoOfParam == 1)
12764 : {
12765 60 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12766 60 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12767 60 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
12768 60 : Type = M2Base_ComplexToScalar (SymbolTable_GetDType (Var));
12769 60 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12770 60 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12771 : {
12772 : /* Generate fake result. */
12773 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12774 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12775 6 : SymbolTable_PutVar (ReturnVar, Type);
12776 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12777 : }
12778 54 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12779 : {
12780 : /* avoid dangling else. */
12781 108 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12782 54 : SymbolTable_PutVar (ReturnVar, Type);
12783 108 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Re, Var, false);
12784 54 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12785 : }
12786 : else
12787 : {
12788 : /* avoid dangling else. */
12789 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, combinedtok);
12790 0 : M2MetaError_MetaErrorT2 (vartok, (const char *) "the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad} {%2&s}", 108, func, Var);
12791 : }
12792 : }
12793 : else
12794 : {
12795 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12796 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, functok); /* destroy arguments to this function */
12797 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter, seen {%2n}", 73, func, NoOfParam);
12798 : }
12799 60 : }
12800 :
12801 :
12802 : /*
12803 : BuildImFunction - builds the pseudo procedure call IM.
12804 :
12805 : The Stack:
12806 :
12807 :
12808 : Entry Exit
12809 :
12810 : Ptr ->
12811 : +----------------+
12812 : | NoOfParam |
12813 : |----------------|
12814 : | Param 1 |
12815 : |----------------|
12816 : | Param 2 |
12817 : |----------------|
12818 : . .
12819 : . .
12820 : . .
12821 : |----------------|
12822 : | Param # |
12823 : |----------------|
12824 : | ProcSym | Type | Empty
12825 : |----------------|
12826 : */
12827 :
12828 60 : static void BuildImFunction (unsigned int Sym, bool ConstExpr)
12829 : {
12830 60 : unsigned int func;
12831 60 : unsigned int combinedtok;
12832 60 : unsigned int vartok;
12833 60 : unsigned int functok;
12834 60 : unsigned int NoOfParam;
12835 60 : unsigned int ReturnVar;
12836 60 : unsigned int Type;
12837 60 : unsigned int Var;
12838 :
12839 60 : M2Quads_PopT (&NoOfParam);
12840 60 : functok = OperandTtok (NoOfParam+1);
12841 60 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12842 60 : if (NoOfParam == 1)
12843 : {
12844 60 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12845 60 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12846 60 : Type = M2Base_ComplexToScalar (SymbolTable_GetDType (Var));
12847 60 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
12848 60 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12849 60 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12850 : {
12851 : /* Generate fake result. */
12852 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12853 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12854 6 : SymbolTable_PutVar (ReturnVar, Type);
12855 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12856 : }
12857 54 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12858 : {
12859 : /* avoid dangling else. */
12860 108 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12861 54 : SymbolTable_PutVar (ReturnVar, M2Base_ComplexToScalar (SymbolTable_GetDType (Var)));
12862 108 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Im, Var, false);
12863 54 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), combinedtok);
12864 : }
12865 : else
12866 : {
12867 : /* avoid dangling else. */
12868 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, combinedtok);
12869 0 : M2MetaError_MetaErrorT2 (vartok, (const char *) "the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad} {%2&s}", 108, func, Var);
12870 : }
12871 : }
12872 : else
12873 : {
12874 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12875 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, functok); /* destroy arguments to this function */
12876 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter, seen {%2n}", 73, func, NoOfParam);
12877 : }
12878 60 : }
12879 :
12880 :
12881 : /*
12882 : BuildCmplxFunction - builds the pseudo procedure call CMPLX.
12883 :
12884 : The Stack:
12885 :
12886 :
12887 : Entry Exit
12888 :
12889 : Ptr ->
12890 : +----------------+
12891 : | NoOfParam |
12892 : |----------------|
12893 : | Param 1 |
12894 : |----------------|
12895 : | Param 2 |
12896 : |----------------|
12897 : . .
12898 : . .
12899 : . .
12900 : |----------------|
12901 : | Param # |
12902 : |----------------|
12903 : | ProcSym | Type | Empty
12904 : |----------------|
12905 : */
12906 :
12907 492 : static void BuildCmplxFunction (unsigned int func, bool ConstExpr)
12908 : {
12909 492 : bool failure;
12910 492 : unsigned int functok;
12911 492 : unsigned int rtok;
12912 492 : unsigned int ltok;
12913 492 : unsigned int combinedtok;
12914 492 : unsigned int NoOfParam;
12915 492 : unsigned int type;
12916 492 : unsigned int ReturnVar;
12917 492 : unsigned int l;
12918 492 : unsigned int r;
12919 :
12920 492 : M2Quads_PopT (&NoOfParam);
12921 492 : functok = OperandTtok (NoOfParam+1);
12922 492 : if (NoOfParam == 2)
12923 : {
12924 492 : l = static_cast<unsigned int> (M2Quads_OperandT (2));
12925 492 : ltok = OperandTtok (2);
12926 492 : r = static_cast<unsigned int> (M2Quads_OperandT (1));
12927 492 : rtok = OperandTtok (1);
12928 492 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, rtok);
12929 492 : M2Quads_PopN (NoOfParam+1); /* Destroy arguments to this function. */
12930 492 : type = M2Base_GetCmplxReturnType (SymbolTable_GetDType (l), SymbolTable_GetDType (r)); /* Destroy arguments to this function. */
12931 570 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant ((SymbolTable_IsConst (l)) && (SymbolTable_IsConst (r))));
12932 492 : SymbolTable_PutVar (ReturnVar, type);
12933 492 : failure = false;
12934 492 : if (ConstExprError (func, l, ltok, ConstExpr))
12935 : {
12936 : /* ConstExprError has generated an error message we will fall through
12937 : and check the right operand. */
12938 : failure = true;
12939 : }
12940 492 : if (ConstExprError (func, r, rtok, ConstExpr))
12941 : {
12942 : /* Right operand is in error as a variable. */
12943 : failure = true;
12944 : }
12945 486 : if (failure)
12946 : {
12947 : /* Generate a fake result if either operand was a variable (and we
12948 : are in a const expression). */
12949 6 : M2Quads_PushTFtok (ReturnVar, type, combinedtok);
12950 : }
12951 486 : else if (((SymbolTable_IsVar (l)) || (SymbolTable_IsConst (l))) && ((SymbolTable_IsVar (r)) || (SymbolTable_IsConst (r))))
12952 : {
12953 : /* avoid dangling else. */
12954 486 : M2Base_CheckExpressionCompatible (combinedtok, SymbolTable_GetSType (l), SymbolTable_GetSType (r));
12955 486 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Cmplx, SymbolTable_Make2Tuple (l, r), true);
12956 486 : M2Quads_PushTFtok (ReturnVar, type, combinedtok);
12957 : }
12958 : else
12959 : {
12960 : /* avoid dangling else. */
12961 0 : if ((SymbolTable_IsVar (l)) || (SymbolTable_IsConst (l)))
12962 : {
12963 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the second parameter is {%2d}", 124, func, r);
12964 : }
12965 : else
12966 : {
12967 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}", 123, func, l);
12968 : }
12969 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_CType), M2Base_CType, combinedtok);
12970 : }
12971 : }
12972 : else
12973 : {
12974 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure {%1Ead} requires two parameters, seen {%2n}", 65, func, NoOfParam);
12975 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12976 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_CType), M2Base_CType, functok); /* destroy arguments to this function */
12977 : }
12978 492 : }
12979 :
12980 :
12981 : /*
12982 : BuildAdrFunction - builds the pseudo function ADR
12983 : The Stack:
12984 :
12985 :
12986 : Entry Exit
12987 :
12988 : Ptr ->
12989 : +----------------+
12990 : | NoOfParam |
12991 : |----------------|
12992 : | Param 1 |
12993 : |----------------|
12994 : | Param 2 |
12995 : |----------------|
12996 : . .
12997 : . .
12998 : . .
12999 : |----------------|
13000 : | Param # | <- Ptr
13001 : |----------------| +------------+
13002 : | ProcSym | Type | | ReturnVar |
13003 : |----------------| |------------|
13004 :
13005 : */
13006 :
13007 173922 : static void BuildAdrFunction (void)
13008 : {
13009 173922 : unsigned int param;
13010 173922 : unsigned int paramTok;
13011 173922 : unsigned int combinedTok;
13012 173922 : unsigned int procTok;
13013 173922 : unsigned int t;
13014 173922 : unsigned int UnboundedSym;
13015 173922 : unsigned int Dim;
13016 173922 : unsigned int Field;
13017 173922 : unsigned int noOfParameters;
13018 173922 : unsigned int procSym;
13019 173922 : unsigned int returnVar;
13020 173922 : unsigned int Type;
13021 173922 : unsigned int rw;
13022 :
13023 173922 : M2Quads_DisplayStack ();
13024 173922 : M2Quads_PopT (&noOfParameters);
13025 173922 : procSym = static_cast<unsigned int> (M2Quads_OperandT (noOfParameters+1));
13026 173922 : procTok = static_cast<unsigned int> (M2Quads_OperandTok (noOfParameters+1)); /* token of procedure ADR. */
13027 173922 : paramTok = static_cast<unsigned int> (M2Quads_OperandTok (1)); /* last parameter. */
13028 173922 : param = static_cast<unsigned int> (M2Quads_OperandT (1)); /* last parameter. */
13029 173922 : combinedTok = M2LexBuf_MakeVirtualTok (procTok, procTok, static_cast<unsigned int> (M2Reserved_endtok));
13030 173922 : if (noOfParameters != 1)
13031 : {
13032 0 : M2MetaError_MetaErrorNT0 (combinedTok, (const char *) "SYSTEM procedure ADR expects 1 parameter", 40);
13033 0 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13034 0 : M2Quads_PushTF (M2Base_Nil, M2System_Address); /* destroy the arguments and function */
13035 : }
13036 173922 : else if (SymbolTable_IsConstString (param))
13037 : {
13038 : /* avoid dangling else. */
13039 166263 : returnVar = MakeLeftValue (combinedTok, param, SymbolTable_RightValue, SymbolTable_GetSType (procSym));
13040 166263 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13041 166263 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (returnVar), combinedTok); /* destroy the arguments and function */
13042 : }
13043 7659 : else if ((! (SymbolTable_IsVar (param))) && (! (SymbolTable_IsProcedure (param))))
13044 : {
13045 : /* avoid dangling else. */
13046 1 : M2MetaError_MetaErrorT1 (paramTok, (const char *) "SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter, seen {%1Ed} {%1&s}", 108, param);
13047 1 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13048 1 : M2Quads_PushTFtok (M2Base_Nil, M2System_Address, combinedTok); /* destroy the arguments and function */
13049 : }
13050 7658 : else if (SymbolTable_IsProcedure (param))
13051 : {
13052 : /* avoid dangling else. */
13053 24 : returnVar = MakeLeftValue (combinedTok, param, SymbolTable_RightValue, SymbolTable_GetSType (procSym));
13054 24 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13055 24 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (returnVar), combinedTok); /* destroy the arguments and function */
13056 : }
13057 : else
13058 : {
13059 : /* avoid dangling else. */
13060 7634 : Type = SymbolTable_GetSType (param);
13061 7634 : Dim = static_cast<unsigned int> (OperandD (1));
13062 7634 : MarkArrayWritten (param);
13063 7634 : MarkArrayWritten (M2Quads_OperandA (1));
13064 : /* if the operand is an unbounded which has not been indexed
13065 : then we will lookup its address from the unbounded record.
13066 : Otherwise we obtain the address of the operand.
13067 : */
13068 7634 : if ((SymbolTable_IsUnbounded (Type)) && (Dim == 0))
13069 : {
13070 : /* we will reference the address field of the unbounded structure */
13071 2356 : UnboundedSym = param;
13072 2356 : rw = static_cast<unsigned int> (OperandRW (1));
13073 2356 : PushTFrw (UnboundedSym, SymbolTable_GetSType (UnboundedSym), rw);
13074 2356 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
13075 2356 : M2Quads_PushTF (Field, SymbolTable_GetSType (Field));
13076 2356 : M2Quads_PushT (static_cast<unsigned int> (1));
13077 2356 : M2Quads_BuildDesignatorRecord (combinedTok);
13078 2356 : PopTrw (&returnVar, &rw);
13079 2356 : if ((SymbolTable_GetMode (returnVar)) == SymbolTable_LeftValue)
13080 : {
13081 0 : t = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13082 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (procSym));
13083 0 : doIndrX (combinedTok, t, returnVar);
13084 0 : returnVar = t;
13085 : }
13086 : else
13087 : {
13088 : /* we need to cast returnVar into ADDRESS */
13089 2356 : t = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13090 2356 : SymbolTable_PutVar (t, SymbolTable_GetSType (procSym));
13091 2356 : GenQuadO (combinedTok, M2Quads_ConvertOp, t, SymbolTable_GetSType (procSym), returnVar, false);
13092 2356 : returnVar = t;
13093 : }
13094 : }
13095 : else
13096 : {
13097 5278 : returnVar = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13098 5278 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (procSym));
13099 5278 : if ((SymbolTable_GetMode (param)) == SymbolTable_LeftValue)
13100 : {
13101 438 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (procSym));
13102 438 : GenQuadO (combinedTok, M2Quads_ConvertOp, returnVar, SymbolTable_GetSType (procSym), param, false);
13103 : }
13104 : else
13105 : {
13106 4840 : GenQuadO (combinedTok, M2Quads_AddrOp, returnVar, SymbolTable_NulSym, param, false);
13107 : }
13108 5278 : SymbolTable_PutWriteQuad (param, SymbolTable_GetMode (param), NextQuad-1);
13109 5278 : rw = static_cast<unsigned int> (OperandMergeRW (1));
13110 5278 : M2Debug_Assert (SymbolTable_IsLegal (rw));
13111 : }
13112 7634 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13113 7634 : PushTFrwtok (returnVar, SymbolTable_GetSType (returnVar), rw, combinedTok); /* destroy the arguments and function */
13114 : }
13115 173922 : }
13116 :
13117 :
13118 : /*
13119 : BuildSizeFunction - builds the pseudo function SIZE
13120 : The Stack:
13121 :
13122 :
13123 : Entry Exit
13124 :
13125 : Ptr ->
13126 : +----------------+
13127 : | NoOfParam |
13128 : |----------------|
13129 : | Param 1 |
13130 : |----------------|
13131 : | Param 2 |
13132 : |----------------|
13133 : . .
13134 : . .
13135 : . .
13136 : |----------------|
13137 : | Param # | <- Ptr
13138 : |----------------| +------------+
13139 : | ProcSym | Type | | ReturnVar |
13140 : |----------------| |------------|
13141 : */
13142 :
13143 2047 : static void BuildSizeFunction (void)
13144 : {
13145 2047 : unsigned int resulttok;
13146 2047 : unsigned int paramtok;
13147 2047 : unsigned int functok;
13148 2047 : unsigned int dim;
13149 2047 : unsigned int Type;
13150 2047 : unsigned int NoOfParam;
13151 2047 : unsigned int ProcSym;
13152 2047 : unsigned int ReturnVar;
13153 :
13154 2047 : M2Quads_PopT (&NoOfParam);
13155 2047 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13156 2047 : functok = OperandTtok (NoOfParam+1);
13157 2047 : if (NoOfParam != 1)
13158 : {
13159 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "{%E} SYSTEM procedure function {%kSIZE} requires one parameter, seen {%1n}", 74, NoOfParam);
13160 0 : resulttok = functok;
13161 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13162 : }
13163 : else
13164 : {
13165 2047 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
13166 2047 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13167 2047 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13168 : {
13169 968 : BuildSizeCheckEnd (ProcSym); /* Quadruple generation now on. */
13170 968 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue); /* Quadruple generation now on. */
13171 968 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, M2Quads_OperandT (1), true);
13172 : }
13173 1079 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13174 : {
13175 : /* avoid dangling else. */
13176 1072 : BuildSizeCheckEnd (ProcSym); /* Quadruple generation now on. */
13177 1072 : Type = SymbolTable_GetSType (M2Quads_OperandT (1)); /* Quadruple generation now on. */
13178 1072 : if (SymbolTable_IsUnbounded (Type))
13179 : {
13180 : /* Eg. SIZE(a) ; where a is unbounded dereference HIGH and multiply by the TYPE. */
13181 168 : dim = static_cast<unsigned int> (OperandD (1));
13182 168 : if (dim == 0)
13183 : {
13184 72 : ReturnVar = calculateMultipicand (resulttok, M2Quads_OperandT (1), Type, dim);
13185 : }
13186 : else
13187 : {
13188 96 : ReturnVar = calculateMultipicand (resulttok, M2Quads_OperandA (1), Type, dim);
13189 : }
13190 : }
13191 : else
13192 : {
13193 904 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13194 904 : if (Type == SymbolTable_NulSym)
13195 : {
13196 0 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "cannot get the type and size of {%1Ead}", 39, M2Quads_OperandT (1));
13197 : }
13198 904 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, Type, true);
13199 : }
13200 : }
13201 : else
13202 : {
13203 : /* avoid dangling else. */
13204 7 : M2MetaError_MetaErrorT1 (paramtok, (const char *) "{%E}SYSTEM procedure {%kSIZE} expects a variable or type as its parameter, seen {%1Ed} {%1&s}", 93, M2Quads_OperandT (1));
13205 7 : ReturnVar = SymbolTable_MakeConstLit (paramtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13206 : }
13207 : }
13208 2047 : M2Quads_PopN (NoOfParam+1); /* Destroy the arguments and function. */
13209 2047 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* Destroy the arguments and function. */
13210 2047 : }
13211 :
13212 :
13213 : /*
13214 : BuildTSizeFunction - builds the pseudo function TSIZE
13215 : The Stack:
13216 :
13217 :
13218 : Entry Exit
13219 :
13220 : Ptr ->
13221 : +----------------+
13222 : | NoOfParam |
13223 : |----------------|
13224 : | Param 1 |
13225 : |----------------|
13226 : | Param 2 |
13227 : |----------------|
13228 : . .
13229 : . .
13230 : . .
13231 : |----------------|
13232 : | Param # | <- Ptr
13233 : |----------------| +------------+
13234 : | ProcSym | Type | | ReturnVar |
13235 : |----------------| |------------|
13236 :
13237 : */
13238 :
13239 4758 : static void BuildTSizeFunction (void)
13240 : {
13241 4758 : unsigned int resulttok;
13242 4758 : unsigned int paramtok;
13243 4758 : unsigned int functok;
13244 4758 : unsigned int NoOfParam;
13245 4758 : unsigned int ProcSym;
13246 4758 : unsigned int Record;
13247 4758 : unsigned int ReturnVar;
13248 :
13249 4758 : M2Quads_PopT (&NoOfParam);
13250 4758 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13251 4758 : functok = OperandTtok (NoOfParam);
13252 4758 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
13253 4758 : if (NoOfParam == 1) /* quadruple generation now on */
13254 : {
13255 4758 : paramtok = OperandTtok (1);
13256 4758 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13257 4758 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13258 : {
13259 4724 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13260 4724 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13261 4724 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, M2Quads_OperandT (1), false);
13262 : }
13263 34 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13264 : {
13265 : /* avoid dangling else. */
13266 28 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13267 28 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13268 28 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, SymbolTable_GetSType (M2Quads_OperandT (1)), false);
13269 : }
13270 : else
13271 : {
13272 : /* avoid dangling else. */
13273 : /* Spellcheck. */
13274 6 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTSIZE} expects a variable or type as its first parameter, seen {%1Ed} {%1&s}", 109, M2Quads_OperandT (1));
13275 6 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13276 : }
13277 : }
13278 0 : else if (NoOfParam == 0)
13279 : {
13280 : /* avoid dangling else. */
13281 0 : resulttok = functok;
13282 0 : M2MetaError_MetaErrorT0 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTSIZE} expects either one or two parameters, seen none", 87);
13283 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13284 : }
13285 : else
13286 : {
13287 : /* avoid dangling else. */
13288 0 : Record = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
13289 0 : paramtok = OperandTtok (1);
13290 0 : resulttok = OperandTtok (NoOfParam);
13291 0 : if (SymbolTable_IsRecord (Record))
13292 : {
13293 0 : paramtok = OperandTtok (1);
13294 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13295 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13296 0 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13297 0 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, Record, false);
13298 : }
13299 : else
13300 : {
13301 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13302 0 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}", 106, Record);
13303 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13304 : }
13305 : }
13306 4758 : M2Quads_PopN (NoOfParam+1); /* destroy the arguments and function */
13307 4758 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* destroy the arguments and function */
13308 4758 : }
13309 :
13310 :
13311 : /*
13312 : BuildTBitSizeFunction - builds the pseudo function TBITSIZE
13313 : The Stack:
13314 :
13315 :
13316 : Entry Exit
13317 :
13318 : Ptr ->
13319 : +----------------+
13320 : | NoOfParam |
13321 : |----------------|
13322 : | Param 1 |
13323 : |----------------|
13324 : | Param 2 |
13325 : |----------------|
13326 : . .
13327 : . .
13328 : . .
13329 : |----------------|
13330 : | Param # | <- Ptr
13331 : |----------------| +------------+
13332 : | ProcSym | Type | | ReturnVar |
13333 : |----------------| |------------|
13334 :
13335 : */
13336 :
13337 6376 : static void BuildTBitSizeFunction (void)
13338 : {
13339 6376 : unsigned int resulttok;
13340 6376 : unsigned int paramtok;
13341 6376 : unsigned int functok;
13342 6376 : unsigned int NoOfParam;
13343 6376 : unsigned int ProcSym;
13344 6376 : unsigned int Record;
13345 6376 : unsigned int ReturnVar;
13346 :
13347 6376 : M2Quads_PopT (&NoOfParam);
13348 6376 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13349 6376 : functok = OperandTtok (NoOfParam);
13350 6376 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
13351 6376 : if (NoOfParam == 1) /* quadruple generation now on */
13352 : {
13353 6376 : paramtok = OperandTtok (1);
13354 6376 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13355 6376 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13356 : {
13357 6304 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13358 6304 : GenQuadO (resulttok, M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1), false);
13359 : }
13360 72 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13361 : {
13362 : /* avoid dangling else. */
13363 72 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13364 72 : GenQuadO (resulttok, M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1), false);
13365 : }
13366 : else
13367 : {
13368 : /* avoid dangling else. */
13369 0 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d} {%1&s}", 103, M2Quads_OperandT (1));
13370 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13371 : }
13372 : }
13373 0 : else if (NoOfParam == 0)
13374 : {
13375 : /* avoid dangling else. */
13376 0 : resulttok = functok;
13377 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure function {%kTBITSIZE} expects either one or two parameters, seen none", 90);
13378 0 : ReturnVar = SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13379 : }
13380 : else
13381 : {
13382 : /* avoid dangling else. */
13383 0 : Record = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
13384 0 : paramtok = OperandTtok (1);
13385 0 : resulttok = OperandTtok (NoOfParam);
13386 0 : if (SymbolTable_IsRecord (Record))
13387 : {
13388 0 : paramtok = OperandTtok (1);
13389 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13390 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13391 0 : GenQuad (M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1));
13392 : }
13393 : else
13394 : {
13395 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13396 0 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d} {%1&s}", 109, Record);
13397 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13398 : }
13399 : }
13400 6376 : M2Quads_PopN (NoOfParam+1); /* destroy the arguments and function */
13401 6376 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* destroy the arguments and function */
13402 6376 : }
13403 :
13404 :
13405 : /*
13406 : ExpectingParameterType -
13407 : */
13408 :
13409 89644 : static void ExpectingParameterType (unsigned int BlockSym, unsigned int Type)
13410 : {
13411 89644 : if (! (SymbolTable_IsAModula2Type (Type)))
13412 : {
13413 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13414 6 : if (((Type == SymbolTable_NulSym) || (SymbolTable_IsPartialUnbounded (Type))) || (SymbolTable_IsUnknown (Type)))
13415 : {
13416 0 : if (SymbolTable_IsUnknown (Type))
13417 : {
13418 : /* Spellcheck. */
13419 0 : M2MetaError_MetaError2 ((const char *) "the type used in the formal parameter declaration in {%1Md} {%1a} is unknown {%2&s}", 83, BlockSym, Type);
13420 0 : SymbolTable_UnknownReported (Type);
13421 : }
13422 : else
13423 : {
13424 0 : M2MetaError_MetaError1 ((const char *) "the type used in the formal parameter declaration in {%1Md} {%1a} is unknown", 76, BlockSym);
13425 : }
13426 : }
13427 : else
13428 : {
13429 : /* --fixme-- filter spellcheck on type. */
13430 6 : M2MetaError_MetaError2 ((const char *) "the type {%1Ead} used in the formal parameter declaration in {%2Md} {%2a} was not declared as a type", 100, Type, BlockSym);
13431 : }
13432 : }
13433 89644 : }
13434 :
13435 :
13436 : /*
13437 : ExpectingVariableType -
13438 : */
13439 :
13440 80407 : static void ExpectingVariableType (unsigned int BlockSym, unsigned int Type)
13441 : {
13442 80407 : if (! (SymbolTable_IsAModula2Type (Type)))
13443 : {
13444 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13445 0 : if (Type == SymbolTable_NulSym)
13446 : {
13447 0 : M2MetaError_MetaError1 ((const char *) "the type used during the variable declaration section in procedure {%1EMad} is unknown", 86, BlockSym);
13448 0 : M2MetaError_MetaError1 ((const char *) "the type used during the variable declaration section in procedure {%1Ead} is unknown", 85, BlockSym);
13449 : }
13450 0 : else if ((SymbolTable_IsPartialUnbounded (Type)) || (SymbolTable_IsUnknown (Type)))
13451 : {
13452 : /* avoid dangling else. */
13453 : /* Spellcheck. */
13454 0 : M2MetaError_MetaError2 ((const char *) "the type {%1EMad} used during variable declaration section in procedure {%2ad} is unknown {%1&s}", 96, Type, BlockSym);
13455 0 : M2MetaError_MetaError2 ((const char *) "the type {%1Ead} used during variable declaration section in procedure {%2Mad} is unknown", 89, Type, BlockSym);
13456 0 : SymbolTable_UnknownReported (Type);
13457 : }
13458 : else
13459 : {
13460 : /* avoid dangling else. */
13461 0 : M2MetaError_MetaError2 ((const char *) "the {%1d} {%1Ea} is not a type and therefore cannot be used to declare a variable in {%2d} {%2a}", 96, Type, BlockSym);
13462 : }
13463 : }
13464 80407 : }
13465 :
13466 :
13467 : /*
13468 : CheckVariablesAndParameterTypesInBlock - checks to make sure that block, BlockSym, has
13469 : parameters types and variable types which are legal.
13470 : */
13471 :
13472 176760 : static void CheckVariablesAndParameterTypesInBlock (unsigned int BlockSym)
13473 : {
13474 176760 : unsigned int i;
13475 176760 : unsigned int n;
13476 176760 : unsigned int ParamNo;
13477 :
13478 176760 : if (SymbolTable_IsProcedure (BlockSym))
13479 : {
13480 78926 : ParamNo = SymbolTable_NoOfParamAny (BlockSym);
13481 : }
13482 : else
13483 : {
13484 : ParamNo = 0;
13485 : }
13486 176760 : i = 1;
13487 1285360 : do {
13488 1285360 : n = SymbolTable_GetNth (BlockSym, i);
13489 1285360 : if (((n != SymbolTable_NulSym) && (! (SymbolTable_IsTemporary (n)))) && ((SymbolTable_IsProcedure (BlockSym)) || (((SymbolTable_IsDefImp (BlockSym)) && ((SymbolTable_GetMainModule ()) == BlockSym)) || (SymbolTable_IsModule (BlockSym)))))
13490 : {
13491 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13492 170051 : if (i <= ParamNo)
13493 : {
13494 : /* n is a parameter */
13495 89644 : ExpectingParameterType (BlockSym, SymbolTable_GetSType (n));
13496 : }
13497 : else
13498 : {
13499 : /* n is a local variable */
13500 80407 : ExpectingVariableType (BlockSym, SymbolTable_GetSType (n));
13501 : }
13502 : }
13503 1285360 : i += 1;
13504 1285360 : } while (! (n == SymbolTable_NulSym));
13505 176760 : }
13506 :
13507 :
13508 : /*
13509 : IsNeverAltered - returns TRUE if variable, sym, is never altered
13510 : between quadruples: Start..End
13511 : */
13512 :
13513 30 : static bool IsNeverAltered (unsigned int sym, unsigned int Start, unsigned int End)
13514 : {
13515 30 : unsigned int WriteStart;
13516 30 : unsigned int WriteEnd;
13517 :
13518 30 : SymbolTable_GetWriteLimitQuads (sym, SymbolTable_GetMode (sym), Start, End, &WriteStart, &WriteEnd);
13519 30 : return (WriteStart == 0) && (WriteEnd == 0);
13520 : /* static analysis guarentees a RETURN statement will be used before here. */
13521 : __builtin_unreachable ();
13522 : }
13523 :
13524 :
13525 : /*
13526 : IsConditionVariable - returns TRUE if the condition at quadruple, q, is variable.
13527 : */
13528 :
13529 24 : static bool IsConditionVariable (unsigned int q, unsigned int Start, unsigned int End)
13530 : {
13531 24 : M2Quads_QuadOperator op;
13532 24 : unsigned int op1;
13533 24 : unsigned int op2;
13534 24 : unsigned int op3;
13535 24 : bool LeftFixed;
13536 24 : bool RightFixed;
13537 :
13538 24 : M2Quads_GetQuad (q, &op, &op1, &op2, &op3);
13539 24 : if (op == M2Quads_GotoOp)
13540 : {
13541 : return false;
13542 : }
13543 : else
13544 : {
13545 24 : LeftFixed = SymbolTable_IsConst (op1);
13546 24 : RightFixed = SymbolTable_IsConst (op2);
13547 24 : if (! LeftFixed)
13548 : {
13549 24 : LeftFixed = IsNeverAltered (op1, Start, End);
13550 : }
13551 24 : if (! RightFixed)
13552 : {
13553 6 : RightFixed = IsNeverAltered (op2, Start, End);
13554 : }
13555 24 : return ! (LeftFixed && RightFixed);
13556 : }
13557 : /* static analysis guarentees a RETURN statement will be used before here. */
13558 : __builtin_unreachable ();
13559 : }
13560 :
13561 :
13562 : /*
13563 : IsInfiniteLoop - returns TRUE if an infinite loop is found.
13564 : Given a backwards jump at, End, it returns a BOOLEAN which depends on
13565 : whether a jump is found to jump beyond, End. If a conditonal jump is found
13566 : to pass over, End, the condition is tested for global variables, procedure variables and
13567 : constants.
13568 :
13569 : constant - ignored
13570 : variables - tested to see whether they are altered inside the loop
13571 : global variable - the procedure tests to see whether it is altered as above
13572 : but will also test to see whether this loop calls a procedure
13573 : in which case it believes the loop NOT to be infinite
13574 : (as this procedure call might alter the global variable)
13575 :
13576 : Note that this procedure can easily be fooled by the user altering variables
13577 : with pointers.
13578 : */
13579 :
13580 24 : static bool IsInfiniteLoop (unsigned int End)
13581 : {
13582 24 : bool SeenCall;
13583 24 : bool IsGlobal;
13584 24 : unsigned int Current;
13585 24 : unsigned int Start;
13586 24 : M2Quads_QuadOperator op;
13587 24 : unsigned int op1;
13588 24 : unsigned int op2;
13589 24 : unsigned int op3;
13590 :
13591 24 : SeenCall = false;
13592 24 : IsGlobal = false;
13593 24 : M2Quads_GetQuad (End, &op, &op1, &op2, &Start);
13594 24 : Current = Start;
13595 216 : while (Current != End)
13596 : {
13597 216 : M2Quads_GetQuad (Current, &op, &op1, &op2, &op3);
13598 : /* remember that this function is only called once we have optimized the redundant gotos and conditionals */
13599 216 : if ((M2Quads_IsConditional (Current)) && ! IsGlobal)
13600 : {
13601 24 : IsGlobal = ((SymbolTable_IsVar (op1)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op1))))) || ((SymbolTable_IsVar (op2)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op2)))));
13602 : }
13603 216 : if (op == M2Quads_CallOp)
13604 : {
13605 12 : SeenCall = true;
13606 : }
13607 216 : if ((op == M2Quads_GotoOp) || ((M2Quads_IsConditional (Current)) && (IsConditionVariable (Current, Start, End))))
13608 : {
13609 24 : if ((op3 > End) || (op3 < Start))
13610 : {
13611 : return false; /* may jump out of this loop, good */
13612 : }
13613 : }
13614 192 : Current = M2Quads_GetNextQuad (Current);
13615 : }
13616 0 : M2Quads_GetQuad (End, &op, &op1, &op2, &op3);
13617 0 : if (M2Quads_IsConditional (End))
13618 : {
13619 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13620 0 : if (IsConditionVariable (End, Start, End))
13621 : {
13622 : return false;
13623 : }
13624 : else
13625 : {
13626 0 : if (! IsGlobal)
13627 : {
13628 0 : IsGlobal = ((SymbolTable_IsVar (op1)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op1))))) || ((SymbolTable_IsVar (op2)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op2)))));
13629 : }
13630 : }
13631 : }
13632 : /* we have found a likely infinite loop if no conditional uses a global and no procedure call was seen */
13633 0 : return ! (IsGlobal && SeenCall);
13634 : /* static analysis guarentees a RETURN statement will be used before here. */
13635 : __builtin_unreachable ();
13636 : }
13637 :
13638 :
13639 : /*
13640 : CheckVariablesInBlock - given a block, BlockSym, check whether all variables are used.
13641 : */
13642 :
13643 176760 : static void CheckVariablesInBlock (unsigned int BlockSym)
13644 : {
13645 0 : CheckVariablesAndParameterTypesInBlock (BlockSym);
13646 0 : }
13647 :
13648 :
13649 : /*
13650 : CheckFunctionReturn - checks to see that a RETURN statement was present in a function.
13651 : */
13652 :
13653 78926 : static void CheckFunctionReturn (unsigned int ProcSym)
13654 : {
13655 78926 : M2Quads_QuadOperator Op;
13656 78926 : unsigned int Op1;
13657 78926 : unsigned int Op2;
13658 78926 : unsigned int Op3;
13659 78926 : unsigned int Scope;
13660 78926 : unsigned int Start;
13661 78926 : unsigned int End;
13662 :
13663 78926 : if ((SymbolTable_GetSType (ProcSym)) != SymbolTable_NulSym)
13664 : {
13665 : /* yes it is a function */
13666 18874 : SymbolTable_GetProcedureQuads (ProcSym, &Scope, &Start, &End);
13667 18874 : M2Quads_GetQuad (Start, &Op, &Op1, &Op2, &Op3);
13668 18874 : if (Start == 0)
13669 : {
13670 0 : M2Error_InternalError ((const char *) "incorrect start quad", 20);
13671 : }
13672 758856 : while (((Start != End) && (Op != M2Quads_ReturnValueOp)) && (Op != M2Quads_InlineOp))
13673 : {
13674 739982 : Start = M2Quads_GetNextQuad (Start);
13675 739982 : M2Quads_GetQuad (Start, &Op, &Op1, &Op2, &Op3);
13676 : }
13677 18874 : if ((Op != M2Quads_ReturnValueOp) && (Op != M2Quads_InlineOp))
13678 : {
13679 : /* an InlineOp can always be used to emulate a RETURN */
13680 6 : M2MetaError_MetaError1 ((const char *) "procedure function {%1Ea} does not RETURN a value", 49, ProcSym);
13681 : }
13682 : }
13683 78926 : }
13684 :
13685 :
13686 : /*
13687 : CheckReturnType - checks to see that the return type from currentProc is
13688 : assignment compatible with actualType.
13689 : */
13690 :
13691 27701 : static void CheckReturnType (unsigned int tokno, unsigned int currentProc, unsigned int actualVal, unsigned int actualType)
13692 : {
13693 27701 : unsigned int procType;
13694 27701 : DynamicStrings_String s1;
13695 27701 : DynamicStrings_String s2;
13696 27701 : NameKey_Name n1;
13697 27701 : NameKey_Name n2;
13698 :
13699 27701 : procType = SymbolTable_GetSType (currentProc);
13700 27701 : if (procType == SymbolTable_NulSym)
13701 : {
13702 0 : M2MetaError_MetaError1 ((const char *) "attempting to RETURN a value from procedure {%1Ea} which was not a declared as a procedure function", 99, currentProc);
13703 : }
13704 27701 : else if (M2Base_AssignmentRequiresWarning (actualType, SymbolTable_GetSType (currentProc)))
13705 : {
13706 : /* avoid dangling else. */
13707 0 : M2MetaError_MetaError2 ((const char *) "attempting to RETURN a value {%1Wa} with an incompatible type {%1Wtsa} from a procedure function {%1a} which returns {%1tsa}", 124, actualVal, currentProc);
13708 : }
13709 27701 : else if (! (M2Base_IsAssignmentCompatible (actualType, procType)))
13710 : {
13711 : /* avoid dangling else. */
13712 0 : n1 = SymbolTable_GetSymName (actualType);
13713 0 : n2 = SymbolTable_GetSymName (procType);
13714 0 : M2Error_WriteFormat2 ((const char *) "attempting to RETURN a value with an incompatible type (%a) from a function which returns (%a)", 94, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
13715 : }
13716 27701 : else if ((SymbolTable_IsProcedure (actualVal)) && (! (M2Base_IsAssignmentCompatible (actualVal, procType))))
13717 : {
13718 : /* avoid dangling else. */
13719 : /*
13720 : MetaWarnings2('attempting to RETURN a value with an incompatible type {%1ad} from function {%2a} which returns {%2ta}',
13721 : actualVal, currentProc)
13722 :
13723 : --fixme-- introduce MetaWarning, MetaWarning2, MetaWarning3 into M2MetaError
13724 : */
13725 0 : s1 = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (actualVal)));
13726 0 : s2 = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (procType)));
13727 0 : M2Error_ErrorString (M2Error_NewWarning (M2LexBuf_GetTokenNo ()), FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "attempting to RETURN a value with a (possibly on other targets) incompatible type (%s) from a function which returns (%s)", 121)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1)));
13728 : }
13729 27701 : else if ((SymbolTable_IsProcedure (actualVal)) && (! (M2Base_IsAssignmentCompatible (actualVal, SymbolTable_GetSType (CurrentProc)))))
13730 : {
13731 : /* avoid dangling else. */
13732 0 : n1 = SymbolTable_GetSymName (actualVal);
13733 0 : n2 = SymbolTable_GetSymName (SymbolTable_GetSType (currentProc));
13734 0 : M2Error_WriteFormat2 ((const char *) "attempting to RETURN a value with an incompatible type (%a) from a function which returns (%a)", 94, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
13735 : }
13736 : else
13737 : {
13738 : /* avoid dangling else. */
13739 : /* this checks the types are compatible, not the data contents. */
13740 27701 : BuildRange (M2Range_InitTypesReturnTypeCheck (tokno, currentProc, actualVal));
13741 : }
13742 27701 : }
13743 :
13744 :
13745 : /*
13746 : BuildReturnLower - check the return type and value to ensure type
13747 : compatibility and no range overflow will occur.
13748 : */
13749 :
13750 27701 : static void BuildReturnLower (unsigned int tokcombined, unsigned int tokexpr, unsigned int e1, unsigned int t1)
13751 : {
13752 27701 : unsigned int e2;
13753 27701 : unsigned int t2;
13754 :
13755 : /* This will check that the type returned is compatible with
13756 : the formal return type of the procedure. */
13757 27701 : CheckReturnType (tokcombined, CurrentProc, e1, t1);
13758 : /* Dereference LeftValue if necessary. */
13759 27701 : if ((SymbolTable_GetMode (e1)) == SymbolTable_LeftValue)
13760 : {
13761 172 : t2 = SymbolTable_GetSType (CurrentProc);
13762 172 : e2 = SymbolTable_MakeTemporary (tokexpr, SymbolTable_RightValue);
13763 172 : SymbolTable_PutVar (e2, t2);
13764 172 : CheckPointerThroughNil (tokexpr, e1);
13765 172 : doIndrX (tokexpr, e2, e1);
13766 172 : e1 = e2;
13767 : }
13768 : /* Here we check the data contents to ensure no overflow. */
13769 27701 : BuildRange (M2Range_InitReturnRangeCheck (tokcombined, CurrentProc, e1));
13770 27701 : GenQuadOtok (tokcombined, M2Quads_ReturnValueOp, e1, SymbolTable_NulSym, CurrentProc, false, tokcombined, M2LexBuf_UnknownTokenNo, SymbolTable_GetDeclaredMod (CurrentProc));
13771 27701 : }
13772 :
13773 :
13774 : /*
13775 : IsReadOnly - a helper procedure function to detect constants.
13776 : */
13777 :
13778 268200 : static bool IsReadOnly (unsigned int sym)
13779 : {
13780 268200 : return (SymbolTable_IsConst (sym)) || ((SymbolTable_IsVar (sym)) && (SymbolTable_IsVarConst (sym)));
13781 : /* static analysis guarentees a RETURN statement will be used before here. */
13782 : __builtin_unreachable ();
13783 : }
13784 :
13785 :
13786 : /*
13787 : BuildDesignatorError - removes the designator from the stack and replaces
13788 : it with an error symbol.
13789 : */
13790 :
13791 54 : static void BuildDesignatorError (const char *message_, unsigned int _message_high)
13792 : {
13793 54 : unsigned int combinedTok;
13794 54 : unsigned int arrayTok;
13795 54 : unsigned int exprTok;
13796 54 : unsigned int e;
13797 54 : unsigned int d;
13798 54 : unsigned int error;
13799 54 : unsigned int Sym;
13800 54 : unsigned int Type;
13801 54 : char message[_message_high+1];
13802 :
13803 : /* make a local copy of each unbounded array. */
13804 54 : memcpy (message, message_, _message_high+1);
13805 :
13806 54 : M2Quads_PopTtok (&e, &exprTok);
13807 54 : PopTFDtok (&Sym, &Type, &d, &arrayTok);
13808 54 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, exprTok);
13809 54 : error = SymbolTable_MakeError (combinedTok, NameKey_MakeKey ((const char *) message, _message_high));
13810 54 : PushTFDtok (error, Type, d, arrayTok);
13811 54 : }
13812 :
13813 :
13814 : /*
13815 : BuildDesignatorPointerError - removes the designator from the stack and replaces
13816 : it with an error symbol.
13817 : */
13818 :
13819 2 : static void BuildDesignatorPointerError (unsigned int type, unsigned int rw, unsigned int tokpos, const char *message_, unsigned int _message_high)
13820 : {
13821 2 : unsigned int error;
13822 2 : char message[_message_high+1];
13823 :
13824 : /* make a local copy of each unbounded array. */
13825 2 : memcpy (message, message_, _message_high+1);
13826 :
13827 2 : error = SymbolTable_MakeError (tokpos, NameKey_MakeKey ((const char *) message, _message_high));
13828 2 : if ((SymbolTable_GetSType (type)) != SymbolTable_NulSym)
13829 : {
13830 2 : type = SymbolTable_GetSType (type);
13831 : }
13832 2 : PushTFrwtok (error, type, rw, tokpos);
13833 2 : }
13834 :
13835 :
13836 : /*
13837 : BuildDesignatorArrayStaticDynamic - Builds the array referencing.
13838 : The purpose of this procedure is to work out
13839 : whether the DesignatorArray is a static or
13840 : dynamic array and to call the appropriate
13841 : BuildRoutine.
13842 :
13843 : The Stack is expected to contain:
13844 :
13845 :
13846 : Entry Exit
13847 : ===== ====
13848 :
13849 : Ptr ->
13850 : +--------------+
13851 : | e | <- Ptr
13852 : |--------------| +------------+
13853 : | Sym | Type | | S | T |
13854 : |--------------| |------------|
13855 : */
13856 :
13857 55826 : static void BuildDesignatorArrayStaticDynamic (void)
13858 : {
13859 55826 : unsigned int combinedTok;
13860 55826 : unsigned int arrayTok;
13861 55826 : unsigned int exprTok;
13862 55826 : unsigned int e;
13863 55826 : unsigned int type;
13864 55826 : unsigned int dim;
13865 55826 : unsigned int result;
13866 55826 : unsigned int Sym;
13867 55826 : unsigned int Type;
13868 :
13869 55826 : if (SymbolTable_IsConst (M2Quads_OperandT (2)))
13870 : {
13871 204 : type = SymbolTable_GetDType (M2Quads_OperandT (2));
13872 204 : if ((type != SymbolTable_NulSym) && (SymbolTable_IsArray (type)))
13873 : {
13874 204 : M2Quads_PopTtok (&e, &exprTok);
13875 204 : PopTFDtok (&Sym, &Type, &dim, &arrayTok);
13876 204 : result = SymbolTable_MakeTemporary (exprTok, SymbolTable_RightValue);
13877 204 : SymbolTable_PutVar (result, Type);
13878 204 : M2Quads_PushTFtok (result, SymbolTable_GetSType (result), exprTok);
13879 204 : M2Quads_PushTtok (Sym, arrayTok);
13880 204 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, exprTok);
13881 204 : SymbolTable_PutVarConst (result, true);
13882 204 : M2Quads_BuildAssignConstant (combinedTok);
13883 204 : PushTFDtok (result, SymbolTable_GetDType (result), dim, arrayTok);
13884 204 : M2Quads_PushTtok (e, exprTok);
13885 : }
13886 : }
13887 55826 : if ((! (SymbolTable_IsVar (M2Quads_OperandT (2)))) && (! (SymbolTable_IsTemporary (M2Quads_OperandT (2)))))
13888 : {
13889 18 : M2MetaError_MetaErrorT1 (OperandTtok (2), (const char *) "can only access arrays using constants, variables or formal parameters not {%1Ead}", 82, M2Quads_OperandT (2));
13890 18 : BuildDesignatorError ((const char *) "bad array access", 16);
13891 : }
13892 55826 : Sym = static_cast<unsigned int> (M2Quads_OperandT (2));
13893 55826 : Type = SymbolTable_GetDType (Sym);
13894 55826 : arrayTok = OperandTtok (2);
13895 55826 : if (Type == SymbolTable_NulSym)
13896 : {
13897 0 : if ((arrayTok == M2LexBuf_UnknownTokenNo) || (arrayTok == M2LexBuf_BuiltinTokenNo))
13898 : {
13899 0 : arrayTok = M2LexBuf_GetTokenNo ();
13900 : }
13901 0 : M2MetaError_MetaErrorT0 (arrayTok, (const char *) "type of array is undefined", 26);
13902 0 : BuildDesignatorError ((const char *) "bad array access", 16);
13903 : }
13904 55826 : else if (SymbolTable_IsUnbounded (Type))
13905 : {
13906 : /* avoid dangling else. */
13907 8966 : BuildDynamicArray ();
13908 : }
13909 46860 : else if (SymbolTable_IsArray (Type))
13910 : {
13911 : /* avoid dangling else. */
13912 46830 : BuildStaticArray ();
13913 : }
13914 : else
13915 : {
13916 : /* avoid dangling else. */
13917 30 : M2MetaError_MetaErrorT1 (arrayTok, (const char *) "can only index static or dynamic arrays, {%1Ead} is not an array but a {%tadv}", 78, Sym);
13918 30 : BuildDesignatorError ((const char *) "bad array access", 16);
13919 : }
13920 55820 : }
13921 :
13922 :
13923 : /*
13924 : BuildStaticArray - Builds the array referencing for static arrays.
13925 : The Stack is expected to contain:
13926 :
13927 :
13928 : Entry Exit
13929 : ===== ====
13930 :
13931 : Ptr ->
13932 : +--------------+
13933 : | e | <- Ptr
13934 : |--------------| +------------+
13935 : | Sym | Type | | S | T |
13936 : |--------------| |------------|
13937 : */
13938 :
13939 46830 : static void BuildStaticArray (void)
13940 : {
13941 46830 : unsigned int combinedTok;
13942 46830 : unsigned int indexTok;
13943 46830 : unsigned int arrayTok;
13944 46830 : unsigned int rw;
13945 46830 : unsigned int Dim;
13946 46830 : unsigned int Array;
13947 46830 : unsigned int Index;
13948 46830 : unsigned int BackEndType;
13949 46830 : unsigned int Type;
13950 46830 : unsigned int Adr;
13951 :
13952 46830 : Index = static_cast<unsigned int> (M2Quads_OperandT (1));
13953 46830 : indexTok = OperandTtok (1);
13954 46830 : Array = static_cast<unsigned int> (M2Quads_OperandT (2));
13955 46830 : arrayTok = OperandTtok (2);
13956 46830 : Type = SymbolTable_SkipType (M2Quads_OperandF (2));
13957 46830 : rw = static_cast<unsigned int> (OperandMergeRW (2));
13958 46830 : M2Debug_Assert (SymbolTable_IsLegal (rw));
13959 46830 : Dim = static_cast<unsigned int> (OperandD (2));
13960 46830 : Dim += 1;
13961 46830 : if ((SymbolTable_GetMode (Index)) == SymbolTable_LeftValue)
13962 : {
13963 166 : Index = MakeRightValue (indexTok, Index, SymbolTable_GetSType (Index));
13964 : }
13965 46824 : BuildRange (M2Range_InitStaticArraySubscriptRangeCheck (SymbolTable_GetArraySubscript (Type), Index, Dim));
13966 : /* now make Adr point to the address of the indexed element */
13967 46824 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, indexTok);
13968 46824 : Adr = SymbolTable_MakeTemporary (combinedTok, SymbolTable_LeftValue);
13969 46824 : if (SymbolTable_IsVar (Array))
13970 : {
13971 : /* BuildDesignatorArray may have detected des is a constant. */
13972 46824 : SymbolTable_PutVarConst (Adr, SymbolTable_IsVarConst (Array));
13973 : }
13974 46824 : SymbolTable_PutVarArrayRef (Adr, true);
13975 : /*
13976 : From now on it must reference the array element by its lvalue
13977 : - so we create the type of the referenced entity
13978 : */
13979 46824 : BackEndType = SymbolTable_MakePointer (combinedTok, NameKey_NulName);
13980 46824 : SymbolTable_PutPointer (BackEndType, SymbolTable_GetDType (Type));
13981 : /* PutVar(Adr, BackEndType) ; */
13982 46824 : SymbolTable_PutLeftValueFrontBackType (Adr, SymbolTable_GetDType (Type), BackEndType);
13983 93648 : GenQuadO (combinedTok, M2Quads_ArrayOp, Adr, Index, Array, true);
13984 46824 : M2Quads_PopN (2); /* remove all parameters to this procedure */
13985 46824 : PushTFDrwtok (Adr, SymbolTable_GetSType (Adr), Dim, rw, combinedTok); /* remove all parameters to this procedure */
13986 46824 : }
13987 :
13988 :
13989 : /*
13990 : calculateMultipicand - generates quadruples which calculate the
13991 : multiplicand for the array at dimension, dim.
13992 : */
13993 :
13994 12024 : static unsigned int calculateMultipicand (unsigned int tok, unsigned int arraySym, unsigned int arrayType, unsigned int dim)
13995 : {
13996 12024 : unsigned int ti;
13997 12024 : unsigned int tj;
13998 12024 : unsigned int tk;
13999 12024 : unsigned int tl;
14000 :
14001 12024 : if (dim == (SymbolTable_GetDimension (arrayType)))
14002 : {
14003 : /* ti has no type since constant */
14004 10240 : ti = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
14005 10240 : SymbolTable_PutVar (ti, M2Base_Cardinal);
14006 10240 : GenQuadO (tok, M2Quads_ElementSizeOp, ti, arrayType, 1, true);
14007 : }
14008 : else
14009 : {
14010 1784 : dim += 1;
14011 1784 : tk = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14012 1784 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14013 1784 : GenHigh (tok, tk, dim, arraySym);
14014 1784 : tl = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14015 1784 : SymbolTable_PutVar (tl, M2Base_Cardinal);
14016 1784 : GenQuadOtok (tok, M2Quads_AddOp, tl, tk, SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal), true, tok, tok, tok);
14017 1784 : tj = calculateMultipicand (tok, arraySym, arrayType, dim);
14018 1784 : ti = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14019 1784 : SymbolTable_PutVar (ti, M2Base_Cardinal);
14020 1784 : GenQuadO (tok, M2Quads_MultOp, ti, tj, tl, true);
14021 : }
14022 12024 : return ti;
14023 : /* static analysis guarentees a RETURN statement will be used before here. */
14024 : __builtin_unreachable ();
14025 : }
14026 :
14027 :
14028 : /*
14029 : ConvertToAddress - convert sym to an address.
14030 : */
14031 :
14032 9050 : static unsigned int ConvertToAddress (unsigned int tokpos, unsigned int sym)
14033 : {
14034 9050 : unsigned int adr;
14035 :
14036 9050 : if ((SymbolTable_GetSType (sym)) == M2System_Address)
14037 : {
14038 : return sym;
14039 : }
14040 : else
14041 : {
14042 9038 : M2Quads_PushTF (SymbolTable_RequestSym (tokpos, NameKey_MakeKey ((const char *) "CONVERT", 7)), static_cast<unsigned int> (SymbolTable_NulSym));
14043 9038 : M2Quads_PushT (M2System_Address);
14044 9038 : M2Quads_PushTtok (sym, tokpos);
14045 9038 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14046 9038 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14047 9038 : M2Quads_PopT (&adr);
14048 9038 : return adr;
14049 : }
14050 : /* static analysis guarentees a RETURN statement will be used before here. */
14051 : __builtin_unreachable ();
14052 : }
14053 :
14054 :
14055 : /*
14056 : BuildDynamicArray - Builds the array referencing for dynamic arrays.
14057 : The Stack is expected to contain:
14058 :
14059 :
14060 : Entry Exit
14061 : ===== ====
14062 :
14063 : Ptr ->
14064 : +-----------------------+
14065 : | Index | <- Ptr
14066 : |-----------------------| +---------------------------+
14067 : | ArraySym | Type | Dim | | S | T | ArraySym | Dim+1 |
14068 : |-----------------------| |---------------------------|
14069 :
14070 :
14071 : if Dim=1
14072 : then
14073 : S := base of ArraySym + TSIZE(Type)*Index
14074 : else
14075 : S := S + TSIZE(Type)*Index
14076 : fi
14077 : */
14078 :
14079 8966 : static void BuildDynamicArray (void)
14080 : {
14081 8966 : unsigned int combinedTok;
14082 8966 : unsigned int arrayTok;
14083 8966 : unsigned int indexTok;
14084 8966 : unsigned int Sym;
14085 8966 : unsigned int idx;
14086 8966 : unsigned int Type;
14087 8966 : unsigned int Adr;
14088 8966 : unsigned int ArraySym;
14089 8966 : unsigned int BackEndType;
14090 8966 : unsigned int UnboundedType;
14091 8966 : unsigned int PtrToBase;
14092 8966 : unsigned int Base;
14093 8966 : unsigned int Dim;
14094 8966 : unsigned int rw;
14095 8966 : unsigned int ti;
14096 8966 : unsigned int tj;
14097 8966 : unsigned int tk;
14098 8966 : unsigned int tka;
14099 :
14100 8966 : M2Quads_DisplayStack ();
14101 8966 : Sym = static_cast<unsigned int> (M2Quads_OperandT (2));
14102 8966 : Type = SymbolTable_SkipType (M2Quads_OperandF (2));
14103 8966 : arrayTok = static_cast<unsigned int> (M2Quads_OperandTok (2));
14104 8966 : indexTok = static_cast<unsigned int> (M2Quads_OperandTok (1));
14105 8966 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, indexTok);
14106 8966 : Dim = static_cast<unsigned int> (OperandD (2));
14107 8966 : rw = static_cast<unsigned int> (OperandMergeRW (2));
14108 8966 : M2Debug_Assert (SymbolTable_IsLegal (rw));
14109 8966 : Dim += 1;
14110 8966 : if (Dim == 1)
14111 : {
14112 : /*
14113 : Base has type address since
14114 : BuildDesignatorRecord references by address.
14115 :
14116 : Build a record for retrieving the address of dynamic array.
14117 : BuildDesignatorRecord will generate the required quadruples,
14118 : therefore build sets up the stack for BuildDesignatorRecord
14119 : which will generate the quads to access the record.
14120 : */
14121 8828 : ArraySym = Sym;
14122 8828 : UnboundedType = SymbolTable_GetUnboundedRecordType (SymbolTable_GetSType (Sym));
14123 8828 : PushTFrwtok (Sym, UnboundedType, rw, arrayTok);
14124 8828 : M2Quads_PushTF (SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (Sym)), SymbolTable_GetSType (SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (Sym))));
14125 8828 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One record field to dereference */
14126 8828 : M2Quads_BuildDesignatorRecord (combinedTok); /* One record field to dereference */
14127 8828 : M2Quads_PopT (&PtrToBase);
14128 8828 : M2Quads_DisplayStack ();
14129 : /* Now actually copy Unbounded.ArrayAddress into base */
14130 8828 : if ((SymbolTable_GetMode (PtrToBase)) == SymbolTable_LeftValue)
14131 : {
14132 0 : Base = SymbolTable_MakeTemporary (arrayTok, SymbolTable_RightValue);
14133 0 : SymbolTable_PutVar (Base, M2System_Address); /* has type ADDRESS */
14134 0 : CheckPointerThroughNil (arrayTok, PtrToBase); /* has type ADDRESS */
14135 0 : GenQuad (M2Quads_IndrXOp, Base, M2System_Address, PtrToBase); /* Base = *PtrToBase */
14136 : }
14137 : else
14138 : {
14139 8828 : M2Debug_Assert ((SymbolTable_GetMode (PtrToBase)) != SymbolTable_ImmediateValue);
14140 8828 : Base = PtrToBase;
14141 : }
14142 : }
14143 : else
14144 : {
14145 : /* Base already calculated previously and pushed to stack */
14146 138 : UnboundedType = SymbolTable_SkipType (M2Quads_OperandF (2));
14147 138 : Base = Sym;
14148 138 : ArraySym = static_cast<unsigned int> (M2Quads_OperandA (2));
14149 : }
14150 8966 : M2Debug_Assert ((SymbolTable_GetSType (Sym)) == Type);
14151 8966 : ti = calculateMultipicand (indexTok, Sym, Type, Dim);
14152 8966 : idx = static_cast<unsigned int> (M2Quads_OperandT (1));
14153 8966 : if ((SymbolTable_IsConst (idx)) && (SymbolTable_IsConst (ti)))
14154 : {
14155 : /* tj has no type since constant */
14156 460 : tj = SymbolTable_MakeTemporary (indexTok, SymbolTable_ImmediateValue);
14157 460 : tk = SymbolTable_MakeTemporary (indexTok, SymbolTable_ImmediateValue);
14158 460 : SymbolTable_PutVar (tj, M2Base_Cardinal);
14159 460 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14160 : }
14161 : else
14162 : {
14163 : /* tj has Cardinal type since we have multiplied array indices */
14164 8506 : tj = SymbolTable_MakeTemporary (indexTok, SymbolTable_RightValue);
14165 8506 : if ((SymbolTable_GetSType (idx)) != M2Base_Cardinal)
14166 : {
14167 270 : M2Quads_PushTF (SymbolTable_RequestSym (indexTok, NameKey_MakeKey ((const char *) "CONVERT", 7)), static_cast<unsigned int> (SymbolTable_NulSym));
14168 270 : M2Quads_PushT (M2Base_Cardinal);
14169 270 : M2Quads_PushTtok (idx, indexTok);
14170 270 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14171 270 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14172 270 : M2Quads_PopT (&idx);
14173 : }
14174 8506 : SymbolTable_PutVar (tj, M2Base_Cardinal);
14175 8506 : tk = SymbolTable_MakeTemporary (indexTok, SymbolTable_RightValue);
14176 8506 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14177 : }
14178 8966 : BuildRange (M2Range_InitDynamicArraySubscriptRangeCheck (ArraySym, idx, Dim));
14179 8966 : M2Quads_PushTtok (tj, indexTok);
14180 8966 : M2Quads_PushTtok (idx, indexTok);
14181 8966 : BuildAssignmentWithoutBounds (indexTok, false, true);
14182 17932 : GenQuad (M2Quads_MultOp, tk, ti, tj);
14183 17932 : Adr = SymbolTable_MakeTemporary (combinedTok, SymbolTable_LeftValue);
14184 8966 : SymbolTable_PutVarArrayRef (Adr, true);
14185 : /*
14186 : Ok must reference by address
14187 : - but we contain the type of the referenced entity
14188 : */
14189 8966 : BackEndType = SymbolTable_MakePointer (combinedTok, NameKey_NulName);
14190 8966 : SymbolTable_PutPointer (BackEndType, SymbolTable_GetSType (Type));
14191 : /* Create a temporary pointer for addition. */
14192 8966 : tka = ConvertToAddress (combinedTok, tk);
14193 8966 : if (Dim == (SymbolTable_GetDimension (Type)))
14194 : {
14195 8648 : SymbolTable_PutLeftValueFrontBackType (Adr, SymbolTable_GetSType (Type), BackEndType);
14196 17296 : GenQuadOtok (combinedTok, M2Quads_AddOp, Adr, Base, tka, false, combinedTok, combinedTok, combinedTok);
14197 8648 : M2Quads_PopN (2);
14198 8648 : PushTFADrwtok (Adr, SymbolTable_GetSType (Adr), ArraySym, Dim, rw, combinedTok);
14199 : }
14200 : else
14201 : {
14202 : /* more to index */
14203 318 : SymbolTable_PutLeftValueFrontBackType (Adr, Type, BackEndType);
14204 636 : GenQuadOtok (combinedTok, M2Quads_AddOp, Adr, Base, tka, false, combinedTok, combinedTok, combinedTok);
14205 318 : M2Quads_PopN (2);
14206 318 : PushTFADrwtok (Adr, SymbolTable_GetSType (Adr), ArraySym, Dim, rw, combinedTok);
14207 : }
14208 8966 : }
14209 :
14210 :
14211 : /*
14212 : DebugLocation -
14213 : */
14214 :
14215 56662 : static void DebugLocation (unsigned int tok, const char *message_, unsigned int _message_high)
14216 : {
14217 56662 : char message[_message_high+1];
14218 :
14219 : /* make a local copy of each unbounded array. */
14220 56662 : memcpy (message, message_, _message_high+1);
14221 :
14222 56662 : if (DebugTokPos)
14223 : {
14224 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) message, _message_high), tok);
14225 : }
14226 56662 : }
14227 :
14228 :
14229 : /*
14230 : PushWith - pushes sym and type onto the with stack. It checks for
14231 : previous declaration of this record type.
14232 : */
14233 :
14234 5716 : static void PushWith (unsigned int Sym, unsigned int Type, unsigned int Ref, unsigned int Tok)
14235 : {
14236 5716 : unsigned int i;
14237 5716 : unsigned int n;
14238 5716 : M2Quads_WithFrame f;
14239 :
14240 5716 : if (M2Options_Pedantic)
14241 : {
14242 0 : n = M2StackAddress_NoOfItemsInStackAddress (WithStack);
14243 0 : i = 1; /* Top of the stack. */
14244 : /* Search for other declarations of the with using Type. */
14245 0 : while (i <= n)
14246 : {
14247 0 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PeepAddress (WithStack, i));
14248 0 : if (f->RecordSym == Type)
14249 : {
14250 0 : M2MetaError_MetaErrorT1 (Tok, (const char *) "cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}", 78, Sym);
14251 0 : M2MetaError_MetaErrorT1 (f->RecordTokPos, (const char *) "cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}", 78, f->RecordSym);
14252 : }
14253 0 : i += 1;
14254 : }
14255 : }
14256 5716 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T4));
14257 5716 : f->RecordSym = Sym;
14258 5716 : f->RecordType = Type;
14259 5716 : f->RecordRef = Ref;
14260 5716 : f->rw = Sym;
14261 5716 : f->RecordTokPos = Tok;
14262 5716 : M2StackAddress_PushAddress (WithStack, reinterpret_cast <void *> (f));
14263 5716 : }
14264 :
14265 5716 : static void PopWith (void)
14266 : {
14267 5716 : M2Quads_WithFrame f;
14268 :
14269 5716 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PopAddress (WithStack));
14270 5716 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T4));
14271 5716 : }
14272 :
14273 :
14274 : /*
14275 : BuildAccessWithField - similar to BuildDesignatorRecord except it
14276 : does not perform the address operation.
14277 : The address will have been computed at the
14278 : beginning of the WITH statement.
14279 : It also stops the GenQuad procedure from examining the
14280 : with stack.
14281 :
14282 : The Stack
14283 :
14284 : Entry
14285 :
14286 : Ptr ->
14287 : +--------------+
14288 : | Field | Type1| <- Ptr
14289 : |-------|------| +-------------+
14290 : | Adr | Type2| | Sym | Type1|
14291 : |--------------| |-------------|
14292 : */
14293 :
14294 28984 : static void BuildAccessWithField (void)
14295 : {
14296 28984 : unsigned int rectok;
14297 28984 : unsigned int fieldtok;
14298 28984 : bool OldSuppressWith;
14299 28984 : unsigned int rw;
14300 28984 : unsigned int Field;
14301 28984 : unsigned int FieldType;
14302 28984 : unsigned int Record;
14303 28984 : unsigned int RecordType;
14304 28984 : unsigned int Ref;
14305 :
14306 28984 : OldSuppressWith = SuppressWith;
14307 28984 : SuppressWith = true;
14308 : /*
14309 : now the WITH cannot look at the stack of outstanding WITH records.
14310 : */
14311 28984 : M2Quads_PopTFtok (&Field, &FieldType, &fieldtok);
14312 28984 : PopTFrwtok (&Record, &RecordType, &rw, &rectok);
14313 28984 : Ref = SymbolTable_MakeComponentRef (SymbolTable_MakeComponentRecord (fieldtok, SymbolTable_RightValue, Record), Field);
14314 28984 : SymbolTable_PutVarConst (Ref, IsReadOnly (Record));
14315 57968 : GenQuadO (fieldtok, M2Quads_RecordFieldOp, Ref, Record, Field, true);
14316 28984 : PushTFrwtok (Ref, FieldType, rw, fieldtok);
14317 28984 : SuppressWith = OldSuppressWith;
14318 28984 : }
14319 :
14320 :
14321 : /*
14322 : PushConstructor -
14323 : */
14324 :
14325 47484 : static void PushConstructor (unsigned int sym)
14326 : {
14327 47484 : M2Quads_ConstructorFrame c;
14328 :
14329 47484 : Storage_ALLOCATE ((void **) &c, sizeof (M2Quads__T1));
14330 47484 : c->type = SymbolTable_SkipType (sym);
14331 47484 : c->index = 1;
14332 47484 : M2StackAddress_PushAddress (ConstructorStack, reinterpret_cast <void *> (c));
14333 47484 : }
14334 :
14335 :
14336 : /*
14337 : AddFieldTo - adds field, e, to, value.
14338 : */
14339 :
14340 25650 : static unsigned int AddFieldTo (unsigned int value, unsigned int e)
14341 : {
14342 25650 : if (SymbolTable_IsSet (SymbolTable_GetDType (value)))
14343 : {
14344 11908 : SymbolTable_PutConstSet (value);
14345 11908 : M2Quads_PushT (value);
14346 11908 : M2Quads_PushT (e);
14347 11908 : M2Quads_BuildInclBit ();
14348 11908 : M2Quads_PopT (&value);
14349 : }
14350 : else
14351 : {
14352 13742 : SymbolTable_PushValue (value);
14353 13742 : M2ALU_AddField (M2LexBuf_GetTokenNo (), e);
14354 13742 : SymbolTable_PopValue (value);
14355 : }
14356 25650 : return value;
14357 : /* static analysis guarentees a RETURN statement will be used before here. */
14358 : __builtin_unreachable ();
14359 : }
14360 :
14361 :
14362 : /*
14363 : CheckLogicalOperator - returns a logical operator if the operands imply
14364 : a logical operation should be performed.
14365 : */
14366 :
14367 76790 : static NameKey_Name CheckLogicalOperator (NameKey_Name Tok, unsigned int left, unsigned int lefttype)
14368 : {
14369 76790 : if ((((Tok == M2Reserved_PlusTok) || (Tok == M2Reserved_TimesTok)) || (Tok == M2Reserved_DivideTok)) || (Tok == M2Reserved_MinusTok))
14370 : {
14371 : /* --fixme-- when we add complex arithmetic, we must check constructor is not a complex constant. */
14372 67753 : if ((((lefttype != SymbolTable_NulSym) && (SymbolTable_IsSet (SymbolTable_SkipType (lefttype)))) || (SymbolTable_IsConstSet (left))) || (SymbolTable_IsConstructor (left)))
14373 : {
14374 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
14375 1414 : if (Tok == M2Reserved_PlusTok)
14376 : {
14377 940 : return LogicalOrTok;
14378 : }
14379 474 : else if (Tok == M2Reserved_DivideTok)
14380 : {
14381 : /* avoid dangling else. */
14382 124 : return LogicalXorTok;
14383 : }
14384 350 : else if (Tok == M2Reserved_TimesTok)
14385 : {
14386 : /* avoid dangling else. */
14387 284 : return LogicalAndTok;
14388 : }
14389 66 : else if (Tok == M2Reserved_MinusTok)
14390 : {
14391 : /* avoid dangling else. */
14392 66 : return LogicalDifferenceTok;
14393 : }
14394 : }
14395 : }
14396 : return Tok;
14397 : /* static analysis guarentees a RETURN statement will be used before here. */
14398 : __builtin_unreachable ();
14399 : }
14400 :
14401 :
14402 : /*
14403 : CheckDivModRem - initiates calls to check the divisor for DIV, MOD, REM
14404 : expressions.
14405 : */
14406 :
14407 76190 : static void CheckDivModRem (unsigned int TokPos, NameKey_Name tok, unsigned int d, unsigned int e)
14408 : {
14409 76190 : if (tok == M2Reserved_DivTok)
14410 : {
14411 6599 : BuildRange (M2Range_InitWholeZeroDivisionCheck (TokPos, d, e));
14412 : }
14413 69591 : else if (tok == M2Reserved_ModTok)
14414 : {
14415 : /* avoid dangling else. */
14416 2342 : BuildRange (M2Range_InitWholeZeroDivisionCheck (TokPos, d, e));
14417 : }
14418 67249 : else if (tok == M2Reserved_RemTok)
14419 : {
14420 : /* avoid dangling else. */
14421 96 : BuildRange (M2Range_InitWholeZeroRemainderCheck (TokPos, d, e));
14422 : }
14423 76190 : }
14424 :
14425 :
14426 : /*
14427 : doConvert - convert, sym, to a new symbol with, type.
14428 : Return the new symbol.
14429 : */
14430 :
14431 5084 : static unsigned int doConvert (unsigned int type, unsigned int sym)
14432 : {
14433 5084 : if ((SymbolTable_GetSType (sym)) != type)
14434 : {
14435 1042 : M2Quads_PushTF (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym));
14436 1042 : M2Quads_PushT (type);
14437 1042 : M2Quads_PushT (sym);
14438 1042 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14439 1042 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14440 1036 : M2Quads_PopT (&sym);
14441 : }
14442 5078 : return sym;
14443 : /* static analysis guarentees a RETURN statement will be used before here. */
14444 : __builtin_unreachable ();
14445 : }
14446 :
14447 :
14448 : /*
14449 : doBuildBinaryOp - build the binary op, with or without type
14450 : checking.
14451 : */
14452 :
14453 89608 : static void doBuildBinaryOp (bool checkTypes, bool checkOverflow)
14454 : {
14455 89608 : DynamicStrings_String s;
14456 89608 : NameKey_Name NewOp;
14457 89608 : NameKey_Name Operator;
14458 89608 : unsigned int OperatorPos;
14459 89608 : unsigned int OldPos;
14460 89608 : unsigned int leftrw;
14461 89608 : unsigned int rightrw;
14462 89608 : unsigned int t1;
14463 89608 : unsigned int f1;
14464 89608 : unsigned int t2;
14465 89608 : unsigned int f2;
14466 89608 : unsigned int lefttype;
14467 89608 : unsigned int righttype;
14468 89608 : unsigned int left;
14469 89608 : unsigned int right;
14470 89608 : unsigned int leftpos;
14471 89608 : unsigned int rightpos;
14472 89608 : unsigned int value;
14473 :
14474 89608 : Operator = static_cast<NameKey_Name> (M2Quads_OperandT (2));
14475 89608 : if (Operator == M2Reserved_OrTok)
14476 : {
14477 3442 : CheckBooleanId ();
14478 3442 : PopBooltok (&t1, &f1, &rightpos);
14479 3442 : M2Quads_PopTtok (&Operator, &OperatorPos);
14480 3442 : PopBooltok (&t2, &f2, &leftpos);
14481 3442 : M2Debug_Assert (f2 == 0);
14482 3442 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14483 3442 : PushBooltok (Merge (t1, t2), f1, OperatorPos);
14484 : }
14485 86166 : else if ((Operator == M2Reserved_AndTok) || (Operator == M2Reserved_AmbersandTok))
14486 : {
14487 : /* avoid dangling else. */
14488 9376 : CheckBooleanId ();
14489 9376 : PopBooltok (&t1, &f1, &rightpos);
14490 9376 : M2Quads_PopTtok (&Operator, &OperatorPos);
14491 9376 : PopBooltok (&t2, &f2, &leftpos);
14492 9376 : M2Debug_Assert (t2 == 0);
14493 9376 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14494 9376 : PushBooltok (t1, Merge (f1, f2), OperatorPos);
14495 : }
14496 : else
14497 : {
14498 : /* avoid dangling else. */
14499 76790 : PopTFrwtok (&right, &righttype, &rightrw, &rightpos);
14500 76790 : M2Quads_PopTtok (&Operator, &OperatorPos);
14501 76790 : PopTFrwtok (&left, &lefttype, &leftrw, &leftpos);
14502 76790 : MarkAsRead (rightrw);
14503 76790 : MarkAsRead (leftrw);
14504 76790 : NewOp = CheckLogicalOperator (Operator, left, lefttype); /* right, righttype, */
14505 76790 : if (NewOp == Operator)
14506 : {
14507 : /* avoid dangling else. */
14508 : /*
14509 : BinaryOps and UnaryOps only work with immediate and
14510 : offset addressing. This is fine for calculating
14511 : array and record offsets but we need to get the real
14512 : values to perform normal arithmetic. Not address
14513 : arithmetic.
14514 :
14515 : However the set operators will dereference LValues
14516 : (to optimize large set arithemetic)
14517 : */
14518 75376 : if ((SymbolTable_GetMode (right)) == SymbolTable_LeftValue)
14519 : {
14520 298 : value = SymbolTable_MakeTemporary (rightpos, SymbolTable_RightValue);
14521 298 : SymbolTable_PutVar (value, righttype);
14522 298 : CheckPointerThroughNil (rightpos, right);
14523 298 : doIndrX (rightpos, value, right);
14524 298 : right = value;
14525 : }
14526 75376 : if ((SymbolTable_GetMode (left)) == SymbolTable_LeftValue)
14527 : {
14528 836 : value = SymbolTable_MakeTemporary (leftpos, SymbolTable_RightValue);
14529 836 : SymbolTable_PutVar (value, lefttype);
14530 836 : CheckPointerThroughNil (leftpos, left);
14531 836 : doIndrX (leftpos, value, left);
14532 836 : left = value;
14533 : }
14534 : }
14535 : /* CheckForGenericNulSet(e1, e2, t1, t2) */
14536 76790 : OldPos = OperatorPos;
14537 76790 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14538 76790 : if (((Operator == M2Reserved_PlusTok) && (SymbolTable_IsConstString (left))) && (SymbolTable_IsConstString (right)))
14539 : {
14540 492 : value = SymbolTable_MakeConstString (OperatorPos, NameKey_NulName);
14541 492 : SymbolTable_PutConstStringKnown (OperatorPos, value, NameKey_NulName, false, false);
14542 492 : GenQuadOtok (OperatorPos, MakeOp (M2Reserved_PlusTok), value, left, right, false, OperatorPos, leftpos, rightpos);
14543 : }
14544 : else
14545 : {
14546 76298 : if (checkTypes)
14547 : {
14548 58946 : BuildRange (M2Range_InitTypesExpressionCheck (OperatorPos, left, right, false, false));
14549 : }
14550 118177 : value = SymbolTable_MakeTemporaryFromExpressions (OperatorPos, right, left, AreConstant ((SymbolTable_IsConst (left)) && (SymbolTable_IsConst (right))));
14551 76190 : CheckDivModRem (OperatorPos, NewOp, value, right);
14552 76190 : if (DebugTokPos)
14553 : {
14554 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (M2LexBuf_GetTokenName (Operator)));
14555 : M2Error_WarnStringAt (s, OldPos);
14556 : s = DynamicStrings_InitString ((const char *) "left", 4);
14557 : M2Error_WarnStringAt (s, leftpos);
14558 : s = DynamicStrings_InitString ((const char *) "right", 5);
14559 : M2Error_WarnStringAt (s, rightpos);
14560 : s = DynamicStrings_InitString ((const char *) "caret", 5);
14561 : M2Error_WarnStringAt (s, OldPos);
14562 : s = DynamicStrings_InitString ((const char *) "combined", 8);
14563 : M2Error_WarnStringAt (s, OperatorPos);
14564 : }
14565 : /* MetaErrorT1 (GetDeclaredMod (t), 'in binary with a {%1av}', t) */
14566 76190 : GenQuadOtok (OperatorPos, MakeOp (NewOp), value, left, right, checkOverflow, OperatorPos, leftpos, rightpos);
14567 : }
14568 76682 : M2Quads_PushTFtok (value, SymbolTable_GetSType (value), OperatorPos);
14569 : }
14570 89500 : }
14571 :
14572 :
14573 : /*
14574 : AreConstant - returns immediate addressing mode if b is true else
14575 : offset mode is returned. b determines whether the
14576 : operands are all constant - in which case we can use
14577 : a constant temporary variable.
14578 : */
14579 :
14580 157304 : static SymbolTable_ModeOfAddr AreConstant (bool b)
14581 : {
14582 157304 : if (b)
14583 : {
14584 : return SymbolTable_ImmediateValue;
14585 : }
14586 : else
14587 : {
14588 59783 : return SymbolTable_RightValue;
14589 : }
14590 : /* static analysis guarentees a RETURN statement will be used before here. */
14591 : __builtin_unreachable ();
14592 : }
14593 :
14594 :
14595 : /*
14596 : ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
14597 : exit pair into a variable containing the value TRUE or
14598 : FALSE. The parameter i is relative to the top
14599 : of the stack.
14600 : */
14601 :
14602 7286 : static void ConvertBooleanToVariable (unsigned int tok, unsigned int i)
14603 : {
14604 7286 : unsigned int Des;
14605 7286 : M2Quads_BoolFrame f;
14606 :
14607 7286 : M2Debug_Assert (IsBoolean (i));
14608 : /* We need to convert the boolean top of stack into a variable or
14609 : constant boolean. */
14610 14572 : Des = SymbolTable_MakeTemporary (tok, AreConstant (M2Quads_IsInConstExpression ()));
14611 7286 : SymbolTable_PutVar (Des, M2Base_Boolean);
14612 7286 : SymbolTable_PutVarConditional (Des, true);
14613 7286 : M2Quads_PushTtok (Des, tok); /* we have just increased the stack so we must use i+1 */
14614 7286 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, i+1)); /* we have just increased the stack so we must use i+1 */
14615 14572 : PushBool (f->TrueExit, f->FalseExit);
14616 7286 : BuildAssignmentWithoutBounds (tok, false, true);
14617 : /* Restored stack after the BuildAssign... above. */
14618 7286 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, i));
14619 7286 : f->TrueExit = Des; /* Alter Stack(i) to contain the variable. */
14620 7286 : f->FalseExit = M2Base_Boolean; /* Alter Stack(i) to contain the variable. */
14621 7286 : f->BooleanOp = false; /* No longer a Boolean True|False pair. */
14622 7286 : f->Unbounded = SymbolTable_NulSym; /* No longer a Boolean True|False pair. */
14623 7286 : f->Dimension = 0;
14624 7286 : f->ReadWrite = SymbolTable_NulSym;
14625 7286 : f->tokenno = tok;
14626 7286 : f->Annotation = DynamicStrings_KillString (f->Annotation);
14627 7286 : f->Annotation = DynamicStrings_InitString ((const char *) "%1s(%1d)|%2s(%2d)||boolean var|type", 35);
14628 7286 : f->RangeDep = 0;
14629 7286 : }
14630 :
14631 :
14632 : /*
14633 : DumpQuadSummary -
14634 : */
14635 :
14636 0 : static void DumpQuadSummary (unsigned int quad)
14637 : {
14638 0 : M2Quads_QuadFrame f;
14639 :
14640 0 : if (quad != 0)
14641 : {
14642 0 : f = GetQF (quad);
14643 0 : M2Printf_printf2 ((const char *) "%d op3 = %d\\n", 14, (const unsigned char *) &quad, (sizeof (quad)-1), (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
14644 : }
14645 0 : }
14646 :
14647 :
14648 : /*
14649 : BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
14650 : instead of using a temporary boolean variable.
14651 : This function can only be used when we perform
14652 : the following translation:
14653 :
14654 : (a=b) # (c=d) alternatively (a=b) = (c=d)
14655 : ^ ^
14656 :
14657 : it only allows # = to be used as >= <= > < all
14658 : assume a particular value for TRUE and FALSE.
14659 : (In which case the user should specify ORD)
14660 :
14661 :
14662 : before
14663 :
14664 : q if r1 op1 op2 t2
14665 : q+1 Goto f2
14666 : ...
14667 : q+n if r2 op3 op4 t1
14668 : q+n+1 Goto f1
14669 :
14670 : after (in case of =)
14671 :
14672 : q if r1 op1 op2 q+2
14673 : q+1 Goto q+4
14674 : q+2 if r2 op3 op4 t
14675 : q+3 Goto f
14676 : q+4 if r2 op3 op4 f
14677 : q+5 Goto t
14678 :
14679 : after (in case of #)
14680 :
14681 : q if r1 op1 op2 q+2
14682 : q+1 Goto q+n+2
14683 : q+2 ...
14684 : ... ...
14685 : q+n if r2 op3 op4 f
14686 : q+n+1 Goto t
14687 : q+n+2 if r2 op3 op4 t
14688 : q+n+3 Goto f
14689 :
14690 : The Stack is expected to contain:
14691 :
14692 :
14693 : Entry Exit
14694 : ===== ====
14695 :
14696 : Ptr ->
14697 : +------------+
14698 : | t1 | f1 |
14699 : |------------|
14700 : | Operator | <- Ptr
14701 : |------------| +------------+
14702 : | t2 | f2 | | t | f |
14703 : |------------| |------------|
14704 :
14705 :
14706 : */
14707 :
14708 0 : static void BuildRelOpFromBoolean (unsigned int tokpos)
14709 : {
14710 0 : unsigned int Tok;
14711 0 : unsigned int t1;
14712 0 : unsigned int f1;
14713 0 : unsigned int t2;
14714 0 : unsigned int f2;
14715 0 : M2Quads_QuadFrame f;
14716 :
14717 0 : M2Debug_Assert ((IsBoolean (1)) && (IsBoolean (3)));
14718 0 : if ((M2Quads_OperandT (2)) == M2Reserved_EqualTok)
14719 : {
14720 : /* Are the two boolean expressions the same? */
14721 0 : PopBool (&t1, &f1);
14722 0 : M2Quads_PopT (&Tok);
14723 0 : PopBool (&t2, &f2);
14724 : /* Give the false exit a second chance. */
14725 0 : BackPatch (t2, t1); /* q if _ _ q+2 */
14726 0 : BackPatch (f2, NextQuad); /* q+1 if _ _ q+4 */
14727 0 : M2Debug_Assert (NextQuad == (f1+1)); /* q+1 if _ _ q+4 */
14728 0 : f = GetQF (t1);
14729 0 : GenQuadO (tokpos, f->Operator, f->Operand1, f->Operand2, 0, false);
14730 0 : GenQuadO (tokpos, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
14731 0 : PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos);
14732 : }
14733 0 : else if (((M2Quads_OperandT (2)) == M2Reserved_HashTok) || ((M2Quads_OperandT (2)) == M2Reserved_LessGreaterTok))
14734 : {
14735 : /* avoid dangling else. */
14736 0 : if (M2Options_CompilerDebugging)
14737 : {
14738 0 : M2Printf_printf0 ((const char *) "BuildRelOpFromBoolean (NotEqualTok)\\n", 37);
14739 0 : M2Quads_DisplayStack ();
14740 : }
14741 : /* Are the two boolean expressions different? */
14742 0 : PopBool (&t1, &f1);
14743 0 : M2Quads_PopT (&Tok);
14744 0 : PopBool (&t2, &f2);
14745 0 : if (M2Options_CompilerDebugging)
14746 : {
14747 0 : M2Printf_printf2 ((const char *) "t1 = %d, f1 = %d\\n", 18, (const unsigned char *) &t1, (sizeof (t1)-1), (const unsigned char *) &f1, (sizeof (f1)-1));
14748 0 : M2Printf_printf2 ((const char *) "t2 = %d, f2 = %d\\n", 18, (const unsigned char *) &t2, (sizeof (t2)-1), (const unsigned char *) &f2, (sizeof (f2)-1));
14749 0 : DumpQuadSummary (t1);
14750 0 : DumpQuadSummary (f1);
14751 0 : DumpQuadSummary (t2);
14752 0 : DumpQuadSummary (f2);
14753 : }
14754 : /* Give the false exit a second chance. */
14755 0 : BackPatch (t2, t1); /* q if _ _ q+2 */
14756 0 : BackPatch (f2, NextQuad); /* q+1 if _ _ q+4 */
14757 0 : M2Debug_Assert (NextQuad == (f1+1)); /* q+1 if _ _ q+4 */
14758 0 : f = GetQF (t1);
14759 0 : GenQuadO (tokpos, f->Operator, f->Operand1, f->Operand2, 0, false);
14760 0 : GenQuadO (tokpos, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
14761 0 : PushBooltok (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1), tokpos);
14762 : }
14763 : else
14764 : {
14765 : /* avoid dangling else. */
14766 0 : M2MetaError_MetaError0 ((const char *) "only allowed to use the relation operators {%Ek=} {%Ek#} rather than {%Ek<} or {%Ek>} on {%EkBOOLEAN} expressions as these do not imply an ordinal value for {%kTRUE} or {%kFALSE}", 178);
14767 : }
14768 0 : }
14769 :
14770 :
14771 : /*
14772 : CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
14773 : */
14774 :
14775 177824 : static void CheckVariableOrConstantOrProcedure (unsigned int tokpos, unsigned int sym)
14776 : {
14777 177824 : unsigned int type;
14778 :
14779 177824 : type = SymbolTable_GetSType (sym);
14780 177824 : if (SymbolTable_IsUnknown (sym))
14781 : {
14782 : /* Spellcheck. */
14783 12 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1EUad} has not been declared {%1&s}", 37, sym);
14784 12 : SymbolTable_UnknownReported (sym);
14785 : }
14786 177812 : else if ((M2System_IsPseudoSystemFunction (sym)) || (M2Base_IsPseudoBaseFunction (sym)))
14787 : {
14788 : /* avoid dangling else. */
14789 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1Ead} expected a variable, procedure, constant or expression, not an intrinsic procedure function", 99, sym);
14790 : }
14791 177806 : else if (((((! (SymbolTable_IsConst (sym))) && (! (SymbolTable_IsVar (sym)))) && (! (SymbolTable_IsProcedure (sym)))) && (! (SymbolTable_IsTemporary (sym)))) && ! MustNotCheckBounds)
14792 : {
14793 : /* avoid dangling else. */
14794 0 : M2MetaError_MetaErrorsT1 (tokpos, (const char *) "{%1Ead} expected a variable, procedure, constant or expression", 62, (const char *) "and it was declared as a {%1Ddv}", 32, sym);
14795 : }
14796 177806 : else if ((type != SymbolTable_NulSym) && (SymbolTable_IsArray (type)))
14797 : {
14798 : /* avoid dangling else. */
14799 0 : M2MetaError_MetaErrorsT1 (tokpos, (const char *) "{%1EU} not expecting an array variable as an operand for either comparison or binary operation", 94, (const char *) "it was declared as a {%1Ddv}", 28, sym);
14800 : }
14801 177806 : else if (((SymbolTable_IsConstString (sym)) && (SymbolTable_IsConstStringKnown (sym))) && ((SymbolTable_GetStringLength (tokpos, sym)) > 1))
14802 : {
14803 : /* avoid dangling else. */
14804 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1EU} not expecting a string constant as an operand for either comparison or binary operation", 94, sym);
14805 : }
14806 177824 : }
14807 :
14808 :
14809 : /*
14810 : MakeOp - returns the equalent quadruple operator to a token, t.
14811 : */
14812 :
14813 165594 : static M2Quads_QuadOperator MakeOp (NameKey_Name t)
14814 : {
14815 165594 : if (t == ArithPlusTok)
14816 : {
14817 : return M2Quads_ArithAddOp;
14818 : }
14819 165594 : else if (t == M2Reserved_PlusTok)
14820 : {
14821 : /* avoid dangling else. */
14822 : return M2Quads_AddOp;
14823 : }
14824 141631 : else if (t == M2Reserved_MinusTok)
14825 : {
14826 : /* avoid dangling else. */
14827 : return M2Quads_SubOp;
14828 : }
14829 119283 : else if (t == M2Reserved_DivTok)
14830 : {
14831 : /* avoid dangling else. */
14832 : return M2Quads_DivM2Op;
14833 : }
14834 112684 : else if (t == M2Reserved_DivideTok)
14835 : {
14836 : /* avoid dangling else. */
14837 : return M2Quads_DivTruncOp;
14838 : }
14839 110226 : else if (t == M2Reserved_RemTok)
14840 : {
14841 : /* avoid dangling else. */
14842 : return M2Quads_ModTruncOp;
14843 : }
14844 110130 : else if (t == M2Reserved_ModTok)
14845 : {
14846 : /* avoid dangling else. */
14847 : return M2Quads_ModM2Op;
14848 : }
14849 107788 : else if (t == M2Reserved_TimesTok)
14850 : {
14851 : /* avoid dangling else. */
14852 : return M2Quads_MultOp;
14853 : }
14854 90308 : else if (t == M2Reserved_HashTok)
14855 : {
14856 : /* avoid dangling else. */
14857 : return M2Quads_IfNotEquOp;
14858 : }
14859 78206 : else if (t == M2Reserved_LessGreaterTok)
14860 : {
14861 : /* avoid dangling else. */
14862 : return M2Quads_IfNotEquOp;
14863 : }
14864 78122 : else if (t == M2Reserved_GreaterEqualTok)
14865 : {
14866 : /* avoid dangling else. */
14867 : return M2Quads_IfGreEquOp;
14868 : }
14869 67796 : else if (t == M2Reserved_LessEqualTok)
14870 : {
14871 : /* avoid dangling else. */
14872 : return M2Quads_IfLessEquOp;
14873 : }
14874 63156 : else if (t == M2Reserved_EqualTok)
14875 : {
14876 : /* avoid dangling else. */
14877 : return M2Quads_IfEquOp;
14878 : }
14879 17230 : else if (t == M2Reserved_LessTok)
14880 : {
14881 : /* avoid dangling else. */
14882 : return M2Quads_IfLessOp;
14883 : }
14884 9724 : else if (t == M2Reserved_GreaterTok)
14885 : {
14886 : /* avoid dangling else. */
14887 : return M2Quads_IfGreOp;
14888 : }
14889 3800 : else if (t == M2Reserved_InTok)
14890 : {
14891 : /* avoid dangling else. */
14892 : return M2Quads_IfInOp;
14893 : }
14894 1396 : else if (t == LogicalOrTok)
14895 : {
14896 : /* avoid dangling else. */
14897 : return M2Quads_LogicalOrOp;
14898 : }
14899 474 : else if (t == LogicalAndTok)
14900 : {
14901 : /* avoid dangling else. */
14902 : return M2Quads_LogicalAndOp;
14903 : }
14904 190 : else if (t == LogicalXorTok)
14905 : {
14906 : /* avoid dangling else. */
14907 : return M2Quads_LogicalXorOp;
14908 : }
14909 66 : else if (t == LogicalDifferenceTok)
14910 : {
14911 : /* avoid dangling else. */
14912 : return M2Quads_LogicalDiffOp;
14913 : }
14914 : else
14915 : {
14916 : /* avoid dangling else. */
14917 0 : M2Error_InternalError ((const char *) "binary operation not implemented yet", 36);
14918 : }
14919 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
14920 : __builtin_unreachable ();
14921 : }
14922 :
14923 :
14924 : /*
14925 : GenQuadO - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
14926 : */
14927 :
14928 5264577 : static void GenQuadO (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow)
14929 : {
14930 1173798 : GenQuadOTrash (TokPos, Operation, Op1, Op2, Op3, overflow, SymbolTable_NulSym);
14931 698067 : }
14932 :
14933 :
14934 : /*
14935 : GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
14936 : */
14937 :
14938 5266391 : static void GenQuadOTrash (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int trash)
14939 : {
14940 5266391 : M2Quads_QuadFrame f;
14941 :
14942 : /* WriteString('Potential Quad: ') ; */
14943 5266391 : if (QuadrupleGeneration)
14944 : {
14945 5264146 : if (NextQuad != Head)
14946 : {
14947 5249569 : f = GetQF (NextQuad-1);
14948 5249569 : f->Next = NextQuad;
14949 : }
14950 5264146 : PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow);
14951 5264146 : f = GetQF (NextQuad);
14952 5264146 : f->Trash = trash;
14953 5264146 : f->Next = 0;
14954 5264146 : f->LineNo = M2LexBuf_GetLineNo ();
14955 5264146 : if (TokPos == M2LexBuf_UnknownTokenNo)
14956 : {
14957 3146163 : f->TokenNo = M2LexBuf_GetTokenNo ();
14958 : }
14959 : else
14960 : {
14961 2117983 : f->TokenNo = TokPos;
14962 : }
14963 5264146 : if (M2Options_GetDebugTraceQuad ())
14964 : {
14965 0 : M2Printf_printf0 ((const char *) "generating: ", 12);
14966 0 : M2Quads_DisplayQuad (NextQuad);
14967 : }
14968 : /* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) */
14969 5264146 : CheckBreak (NextQuad);
14970 5264146 : NewQuad (&NextQuad);
14971 : }
14972 5266391 : }
14973 :
14974 :
14975 : /*
14976 : GenQuad - Generate a quadruple with Operation, Op1, Op2, Op3.
14977 : */
14978 :
14979 3077147 : static void GenQuad (M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3)
14980 : {
14981 2126872 : GenQuadO (M2LexBuf_UnknownTokenNo, Operation, Op1, Op2, Op3, true);
14982 600245 : }
14983 :
14984 :
14985 : /*
14986 : GenQuadOtok - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
14987 : */
14988 :
14989 559160 : static void GenQuadOtok (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos)
14990 : {
14991 470248 : GenQuadOTypetok (TokPos, Operation, Op1, Op2, Op3, overflow, true, Op1Pos, Op2Pos, Op3Pos);
14992 244607 : }
14993 :
14994 :
14995 : /*
14996 : GenQuadOTypetok - assigns the fields of the quadruple with
14997 : the parameters.
14998 : */
14999 :
15000 855015 : static void GenQuadOTypetok (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, bool typecheck, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos)
15001 : {
15002 855015 : M2Quads_QuadFrame f;
15003 :
15004 : /* WriteString('Potential Quad: ') ; */
15005 855015 : if (QuadrupleGeneration)
15006 : {
15007 854324 : if (NextQuad != Head)
15008 : {
15009 854324 : f = GetQF (NextQuad-1);
15010 854324 : f->Next = NextQuad;
15011 : }
15012 854324 : PutQuadOType (NextQuad, Operation, Op1, Op2, Op3, overflow, typecheck);
15013 854324 : f = GetQF (NextQuad);
15014 854324 : f->Next = 0;
15015 854324 : f->LineNo = M2LexBuf_GetLineNo ();
15016 854324 : if (TokPos == M2LexBuf_UnknownTokenNo)
15017 : {
15018 0 : f->TokenNo = M2LexBuf_GetTokenNo ();
15019 : }
15020 : else
15021 : {
15022 854324 : f->TokenNo = TokPos;
15023 : }
15024 854324 : f->op1pos = Op1Pos;
15025 854324 : f->op2pos = Op2Pos;
15026 854324 : f->op3pos = Op3Pos;
15027 854324 : if (M2Options_GetDebugTraceQuad ())
15028 : {
15029 0 : M2Printf_printf0 ((const char *) "generating: ", 12);
15030 0 : M2Quads_DisplayQuad (NextQuad);
15031 : }
15032 : /* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) */
15033 854324 : CheckBreak (NextQuad);
15034 854324 : NewQuad (&NextQuad);
15035 : }
15036 855015 : }
15037 :
15038 :
15039 : /*
15040 : DumpUntil - dump all quadruples until we seen the ending quadruple
15041 : with procsym in the third operand.
15042 : Return the quad number containing the match.
15043 : */
15044 :
15045 0 : static unsigned int DumpUntil (M2Quads_QuadOperator ending, unsigned int procsym, unsigned int quad)
15046 : {
15047 0 : M2Quads_QuadOperator op;
15048 0 : unsigned int op1;
15049 0 : unsigned int op2;
15050 0 : unsigned int op3;
15051 0 : M2Quads_QuadFrame f;
15052 :
15053 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "\\n...\\n\\n", 9);
15054 0 : do {
15055 0 : M2Quads_GetQuad (quad, &op, &op1, &op2, &op3);
15056 0 : M2Quads_DisplayQuad (quad);
15057 0 : f = GetQF (quad);
15058 0 : quad = f->Next;
15059 0 : } while (! ((op == ending) && (op3 == procsym)));
15060 0 : return quad;
15061 : /* static analysis guarentees a RETURN statement will be used before here. */
15062 : __builtin_unreachable ();
15063 : }
15064 :
15065 :
15066 : /*
15067 : GetCtorInit - return the init procedure for the module.
15068 : */
15069 :
15070 0 : static unsigned int GetCtorInit (unsigned int sym)
15071 : {
15072 0 : unsigned int ctor;
15073 0 : unsigned int init;
15074 0 : unsigned int fini;
15075 0 : unsigned int dep;
15076 :
15077 0 : SymbolTable_GetModuleCtors (sym, &ctor, &init, &fini, &dep);
15078 0 : return init;
15079 : /* static analysis guarentees a RETURN statement will be used before here. */
15080 : __builtin_unreachable ();
15081 : }
15082 :
15083 :
15084 : /*
15085 : GetCtorFini - return the fini procedure for the module.
15086 : */
15087 :
15088 0 : static unsigned int GetCtorFini (unsigned int sym)
15089 : {
15090 0 : unsigned int ctor;
15091 0 : unsigned int init;
15092 0 : unsigned int fini;
15093 0 : unsigned int dep;
15094 :
15095 0 : SymbolTable_GetModuleCtors (sym, &ctor, &init, &fini, &dep);
15096 0 : return fini;
15097 : /* static analysis guarentees a RETURN statement will be used before here. */
15098 : __builtin_unreachable ();
15099 : }
15100 :
15101 :
15102 : /*
15103 : DumpQuadrupleFilter -
15104 : */
15105 :
15106 0 : static void DumpQuadrupleFilter (void)
15107 : {
15108 0 : M2Quads_QuadFrame f;
15109 0 : unsigned int i;
15110 0 : M2Quads_QuadOperator op;
15111 0 : unsigned int op1;
15112 0 : unsigned int op2;
15113 0 : unsigned int op3;
15114 :
15115 0 : i = Head;
15116 0 : while (i != 0)
15117 : {
15118 0 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
15119 0 : if ((op == M2Quads_ProcedureScopeOp) && (M2LangDump_IsDumpRequired (op3, true)))
15120 : {
15121 0 : i = DumpUntil (M2Quads_KillLocalVarOp, op3, i);
15122 : }
15123 0 : else if ((op == M2Quads_InitStartOp) && (M2LangDump_IsDumpRequired (GetCtorInit (op3), true)))
15124 : {
15125 : /* avoid dangling else. */
15126 0 : i = DumpUntil (M2Quads_InitEndOp, op3, i);
15127 : }
15128 0 : else if ((op == M2Quads_FinallyStartOp) && (M2LangDump_IsDumpRequired (GetCtorFini (op3), true)))
15129 : {
15130 : /* avoid dangling else. */
15131 0 : i = DumpUntil (M2Quads_FinallyEndOp, op3, i);
15132 : }
15133 : else
15134 : {
15135 : /* avoid dangling else. */
15136 0 : f = GetQF (i);
15137 0 : i = f->Next;
15138 : }
15139 : }
15140 0 : }
15141 :
15142 :
15143 : /*
15144 : DumpQuadrupleAll - dump all quadruples.
15145 : */
15146 :
15147 0 : static void DumpQuadrupleAll (void)
15148 : {
15149 0 : M2Quads_QuadFrame f;
15150 0 : unsigned int i;
15151 :
15152 0 : i = Head;
15153 0 : while (i != 0)
15154 : {
15155 0 : M2Quads_DisplayQuad (i);
15156 0 : f = GetQF (i);
15157 0 : i = f->Next;
15158 : }
15159 0 : }
15160 :
15161 :
15162 : /*
15163 : BackPatch - Makes each of the quadruples on the list pointed to by
15164 : QuadNo take quadruple Value as a target.
15165 : */
15166 :
15167 405337 : static void BackPatch (unsigned int QuadNo, unsigned int Value)
15168 : {
15169 405337 : unsigned int i;
15170 405337 : M2Quads_QuadFrame f;
15171 :
15172 405337 : if (QuadrupleGeneration)
15173 : {
15174 644339 : while (QuadNo != 0)
15175 : {
15176 239019 : f = GetQF (QuadNo);
15177 239019 : i = f->Operand3; /* Next Link along the BackPatch */
15178 239019 : ManipulateReference (QuadNo, Value); /* Filling in the BackPatch. */
15179 239019 : QuadNo = i;
15180 : }
15181 : }
15182 405337 : }
15183 :
15184 :
15185 : /*
15186 : Merge - joins two quad lists, QuadList2 to the end of QuadList1.
15187 : A QuadList of value zero is a nul list.
15188 : */
15189 :
15190 52796 : static unsigned int Merge (unsigned int QuadList1, unsigned int QuadList2)
15191 : {
15192 52796 : unsigned int i;
15193 52796 : unsigned int j;
15194 52796 : M2Quads_QuadFrame f;
15195 :
15196 52796 : if (QuadList1 == 0)
15197 : {
15198 : return QuadList2;
15199 : }
15200 25802 : else if (QuadList2 == 0)
15201 : {
15202 : /* avoid dangling else. */
15203 : return QuadList1;
15204 : }
15205 : else
15206 : {
15207 : /* avoid dangling else. */
15208 : i = QuadList1;
15209 50682 : do {
15210 50682 : j = i;
15211 50682 : f = GetQF (i);
15212 50682 : i = f->Operand3;
15213 50682 : } while (! (i == 0));
15214 22670 : ManipulateReference (j, QuadList2);
15215 22670 : return QuadList1;
15216 : }
15217 : /* static analysis guarentees a RETURN statement will be used before here. */
15218 : __builtin_unreachable ();
15219 : }
15220 :
15221 :
15222 : /*
15223 : DisplayProcedureAttributes -
15224 : */
15225 :
15226 0 : static void DisplayProcedureAttributes (unsigned int proc)
15227 : {
15228 0 : if (SymbolTable_IsCtor (proc))
15229 : {
15230 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (ctor)", 7);
15231 : }
15232 0 : if (SymbolTable_IsPublic (proc))
15233 : {
15234 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (public)", 9);
15235 : }
15236 0 : if (SymbolTable_IsExtern (proc))
15237 : {
15238 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (extern)", 9);
15239 : }
15240 0 : if (SymbolTable_IsMonoName (proc))
15241 : {
15242 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (mononame)", 11);
15243 : }
15244 0 : }
15245 :
15246 :
15247 : /*
15248 : WriteQuad - Writes out the Quad BufferQuad.
15249 : */
15250 :
15251 0 : static void WriteQuad (unsigned int BufferQuad)
15252 : {
15253 0 : NameKey_Name n1;
15254 0 : NameKey_Name n2;
15255 0 : M2Quads_QuadFrame f;
15256 0 : NameKey_Name n;
15257 0 : unsigned int l;
15258 :
15259 0 : f = GetQF (BufferQuad);
15260 0 : M2Quads_WriteOperator (f->Operator);
15261 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " [%d]", 5, (const unsigned char *) &f->NoOfTimesReferenced, (sizeof (f->NoOfTimesReferenced)-1));
15262 0 : if (f->ConstExpr)
15263 : {
15264 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " const ", 7);
15265 : }
15266 : else
15267 : {
15268 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 7);
15269 : }
15270 0 : switch (f->Operator)
15271 : {
15272 0 : case M2Quads_LastForIteratorOp:
15273 0 : M2Quads_WriteOperand (f->Operand1);
15274 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15275 0 : M2Quads_WriteOperand (f->Operand2);
15276 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15277 0 : M2Quads_WriteOperand (f->Operand3);
15278 0 : break;
15279 :
15280 0 : case M2Quads_HighOp:
15281 0 : M2Quads_WriteOperand (f->Operand1);
15282 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %4d ", 7, (const unsigned char *) &f->Operand2, (sizeof (f->Operand2)-1));
15283 0 : M2Quads_WriteOperand (f->Operand3);
15284 0 : break;
15285 :
15286 0 : case M2Quads_InitAddressOp:
15287 0 : case M2Quads_SavePriorityOp:
15288 0 : case M2Quads_RestorePriorityOp:
15289 0 : case M2Quads_SubrangeLowOp:
15290 0 : case M2Quads_SubrangeHighOp:
15291 0 : case M2Quads_BecomesOp:
15292 0 : case M2Quads_InclOp:
15293 0 : case M2Quads_ExclOp:
15294 0 : case M2Quads_UnboundedOp:
15295 0 : case M2Quads_ReturnValueOp:
15296 0 : case M2Quads_FunctValueOp:
15297 0 : case M2Quads_NegateOp:
15298 0 : case M2Quads_AddrOp:
15299 0 : case M2Quads_StringConvertCnulOp:
15300 0 : case M2Quads_StringConvertM2nulOp:
15301 0 : case M2Quads_StringLengthOp:
15302 0 : M2Quads_WriteOperand (f->Operand1);
15303 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15304 0 : M2Quads_WriteOperand (f->Operand3);
15305 0 : break;
15306 :
15307 0 : case M2Quads_ElementSizeOp:
15308 0 : case M2Quads_IfInOp:
15309 0 : case M2Quads_IfNotInOp:
15310 0 : case M2Quads_IfNotEquOp:
15311 0 : case M2Quads_IfEquOp:
15312 0 : case M2Quads_IfLessOp:
15313 0 : case M2Quads_IfGreOp:
15314 0 : case M2Quads_IfLessEquOp:
15315 0 : case M2Quads_IfGreEquOp:
15316 0 : M2Quads_WriteOperand (f->Operand1);
15317 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15318 0 : M2Quads_WriteOperand (f->Operand2);
15319 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %4d", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15320 0 : break;
15321 :
15322 0 : case M2Quads_InlineOp:
15323 0 : case M2Quads_RetryOp:
15324 0 : case M2Quads_TryOp:
15325 0 : case M2Quads_GotoOp:
15326 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d", 3, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15327 0 : break;
15328 :
15329 0 : case M2Quads_StatementNoteOp:
15330 0 : l = M2LexBuf_TokenToLineNo (f->Operand3, 0);
15331 0 : n = M2LexBuf_GetTokenName (f->Operand3);
15332 0 : M2Printf_fprintf4 (M2LangDump_GetDumpFile (), (const char *) "%a:%d:%a (tokenno %d)", 21, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &l, (sizeof (l)-1), (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15333 0 : break;
15334 :
15335 0 : case M2Quads_LineNumberOp:
15336 0 : M2Printf_fprintf2 (M2LangDump_GetDumpFile (), (const char *) "%a:%d", 5, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15337 0 : break;
15338 :
15339 0 : case M2Quads_EndFileOp:
15340 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15341 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%a", 2, (const unsigned char *) &n1, (sizeof (n1)-1));
15342 0 : break;
15343 :
15344 0 : case M2Quads_ThrowOp:
15345 0 : case M2Quads_ReturnOp:
15346 0 : case M2Quads_CallOp:
15347 0 : case M2Quads_KillLocalVarOp:
15348 0 : M2Quads_WriteOperand (f->Operand3);
15349 0 : break;
15350 :
15351 0 : case M2Quads_ProcedureScopeOp:
15352 0 : n1 = SymbolTable_GetSymName (f->Operand2);
15353 0 : n2 = SymbolTable_GetSymName (f->Operand3);
15354 0 : M2Printf_fprintf4 (M2LangDump_GetDumpFile (), (const char *) " %4d %a %a(%d)", 17, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1), (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15355 0 : DisplayProcedureAttributes (f->Operand3);
15356 0 : break;
15357 :
15358 0 : case M2Quads_NewLocalVarOp:
15359 0 : case M2Quads_FinallyStartOp:
15360 0 : case M2Quads_FinallyEndOp:
15361 0 : case M2Quads_InitEndOp:
15362 0 : case M2Quads_InitStartOp:
15363 0 : n1 = SymbolTable_GetSymName (f->Operand2);
15364 0 : n2 = SymbolTable_GetSymName (f->Operand3);
15365 0 : M2Printf_fprintf3 (M2LangDump_GetDumpFile (), (const char *) " %4d %a %a", 13, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
15366 0 : break;
15367 :
15368 0 : case M2Quads_ModuleScopeOp:
15369 0 : case M2Quads_StartModFileOp:
15370 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15371 0 : M2Printf_fprintf4 (M2LangDump_GetDumpFile (), (const char *) "%a:%d %a(%d)", 13, (const unsigned char *) &f->Operand2, (sizeof (f->Operand2)-1), (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15372 0 : break;
15373 :
15374 0 : case M2Quads_StartDefFileOp:
15375 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15376 0 : M2Printf_fprintf2 (M2LangDump_GetDumpFile (), (const char *) " %4d %a", 9, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1), (const unsigned char *) &n1, (sizeof (n1)-1));
15377 0 : break;
15378 :
15379 0 : case M2Quads_OptParamOp:
15380 0 : case M2Quads_ParamOp:
15381 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d ", 5, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1));
15382 0 : M2Quads_WriteOperand (f->Operand2);
15383 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15384 0 : M2Quads_WriteOperand (f->Operand3);
15385 0 : break;
15386 :
15387 0 : case M2Quads_SizeOp:
15388 0 : case M2Quads_RecordFieldOp:
15389 0 : case M2Quads_IndrXOp:
15390 0 : case M2Quads_XIndrOp:
15391 0 : case M2Quads_ArrayOp:
15392 0 : case M2Quads_LogicalShiftOp:
15393 0 : case M2Quads_LogicalRotateOp:
15394 0 : case M2Quads_LogicalOrOp:
15395 0 : case M2Quads_LogicalAndOp:
15396 0 : case M2Quads_LogicalXorOp:
15397 0 : case M2Quads_LogicalDiffOp:
15398 0 : case M2Quads_ArithAddOp:
15399 0 : case M2Quads_CoerceOp:
15400 0 : case M2Quads_ConvertOp:
15401 0 : case M2Quads_CastOp:
15402 0 : case M2Quads_AddOp:
15403 0 : case M2Quads_SubOp:
15404 0 : case M2Quads_MultOp:
15405 0 : case M2Quads_DivM2Op:
15406 0 : case M2Quads_ModM2Op:
15407 0 : case M2Quads_ModFloorOp:
15408 0 : case M2Quads_DivCeilOp:
15409 0 : case M2Quads_ModCeilOp:
15410 0 : case M2Quads_DivFloorOp:
15411 0 : case M2Quads_ModTruncOp:
15412 0 : case M2Quads_DivTruncOp:
15413 0 : M2Quads_WriteOperand (f->Operand1);
15414 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15415 0 : M2Quads_WriteOperand (f->Operand2);
15416 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15417 0 : M2Quads_WriteOperand (f->Operand3);
15418 0 : break;
15419 :
15420 : case M2Quads_DummyOp:
15421 : case M2Quads_CodeOnOp:
15422 : case M2Quads_CodeOffOp:
15423 : case M2Quads_ProfileOnOp:
15424 : case M2Quads_ProfileOffOp:
15425 : case M2Quads_OptimizeOnOp:
15426 : case M2Quads_OptimizeOffOp:
15427 : break;
15428 :
15429 0 : case M2Quads_BuiltinConstOp:
15430 0 : M2Quads_WriteOperand (f->Operand1);
15431 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15432 0 : break;
15433 :
15434 0 : case M2Quads_BuiltinTypeInfoOp:
15435 0 : M2Quads_WriteOperand (f->Operand1);
15436 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand2, (sizeof (f->Operand2)-1));
15437 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15438 0 : break;
15439 :
15440 0 : case M2Quads_StandardFunctionOp:
15441 0 : M2Quads_WriteOperand (f->Operand1);
15442 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15443 0 : M2Quads_WriteOperand (f->Operand2);
15444 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15445 0 : M2Quads_WriteOperand (f->Operand3);
15446 0 : break;
15447 :
15448 : case M2Quads_CatchBeginOp:
15449 : case M2Quads_CatchEndOp:
15450 : break;
15451 :
15452 0 : case M2Quads_RangeCheckOp:
15453 0 : case M2Quads_ErrorOp:
15454 0 : M2Range_WriteRangeCheck (f->Operand3);
15455 0 : break;
15456 :
15457 0 : case M2Quads_SaveExceptionOp:
15458 0 : case M2Quads_RestoreExceptionOp:
15459 0 : M2Quads_WriteOperand (f->Operand1);
15460 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15461 0 : M2Quads_WriteOperand (f->Operand3);
15462 0 : break;
15463 :
15464 :
15465 0 : default:
15466 0 : M2Error_InternalError ((const char *) "quadruple not recognised", 24);
15467 0 : break;
15468 : }
15469 0 : }
15470 :
15471 :
15472 : /*
15473 : WriteOperand - displays the operands name, symbol id and mode of addressing.
15474 : */
15475 :
15476 0 : static void WriteMode (SymbolTable_ModeOfAddr Mode)
15477 : {
15478 0 : switch (Mode)
15479 : {
15480 0 : case SymbolTable_ImmediateValue:
15481 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "i", 1);
15482 0 : break;
15483 :
15484 0 : case SymbolTable_NoValue:
15485 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "n", 1);
15486 0 : break;
15487 :
15488 0 : case SymbolTable_RightValue:
15489 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "r", 1);
15490 0 : break;
15491 :
15492 0 : case SymbolTable_LeftValue:
15493 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "l", 1);
15494 0 : break;
15495 :
15496 :
15497 0 : default:
15498 0 : M2Error_InternalError ((const char *) "unrecognised mode", 17);
15499 0 : break;
15500 : }
15501 0 : }
15502 :
15503 :
15504 : /*
15505 : PushExit - pushes the exit value onto the EXIT stack.
15506 : */
15507 :
15508 596 : static void PushExit (unsigned int Exit)
15509 : {
15510 0 : M2StackWord_PushWord (ExitStack, Exit);
15511 94 : }
15512 :
15513 :
15514 : /*
15515 : PopExit - pops the exit value from the EXIT stack.
15516 : */
15517 :
15518 596 : static unsigned int PopExit (void)
15519 : {
15520 0 : return M2StackWord_PopWord (ExitStack);
15521 : /* static analysis guarentees a RETURN statement will be used before here. */
15522 : __builtin_unreachable ();
15523 : }
15524 :
15525 :
15526 : /*
15527 : PushFor - pushes the exit value onto the FOR stack.
15528 : */
15529 :
15530 10150 : static void PushFor (unsigned int Exit)
15531 : {
15532 0 : M2StackWord_PushWord (ForStack, Exit);
15533 0 : }
15534 :
15535 :
15536 : /*
15537 : PopFor - pops the exit value from the FOR stack.
15538 : */
15539 :
15540 10144 : static unsigned int PopFor (void)
15541 : {
15542 0 : return M2StackWord_PopWord (ForStack);
15543 : /* static analysis guarentees a RETURN statement will be used before here. */
15544 : __builtin_unreachable ();
15545 : }
15546 :
15547 :
15548 : /*
15549 : OperandTno - returns the ident operand stored in the true position
15550 : on the boolean stack. This is exactly the same as
15551 : OperandT but it has no IsBoolean checking.
15552 : */
15553 :
15554 208567198 : static unsigned int OperandTno (unsigned int pos)
15555 : {
15556 208567198 : M2Quads_BoolFrame f;
15557 :
15558 208567198 : M2Debug_Assert (pos > 0);
15559 208567198 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15560 208567198 : return static_cast<unsigned int> (f->TrueExit);
15561 : /* static analysis guarentees a RETURN statement will be used before here. */
15562 : __builtin_unreachable ();
15563 : }
15564 :
15565 :
15566 : /*
15567 : OperandFno - returns the ident operand stored in the false position
15568 : on the boolean stack. This is exactly the same as
15569 : OperandF but it has no IsBoolean checking.
15570 : */
15571 :
15572 174128 : static unsigned int OperandFno (unsigned int pos)
15573 : {
15574 174128 : M2Quads_BoolFrame f;
15575 :
15576 174128 : M2Debug_Assert (pos > 0);
15577 174128 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15578 174128 : return static_cast<unsigned int> (f->FalseExit);
15579 : /* static analysis guarentees a RETURN statement will be used before here. */
15580 : __builtin_unreachable ();
15581 : }
15582 :
15583 :
15584 : /*
15585 : OperandTtok - returns the token associated with the position, pos
15586 : on the boolean stack.
15587 : */
15588 :
15589 57247238 : static unsigned int OperandTtok (unsigned int pos)
15590 : {
15591 57247238 : M2Quads_BoolFrame f;
15592 :
15593 57247238 : M2Debug_Assert (pos > 0);
15594 57247238 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15595 57247238 : return f->tokenno;
15596 : /* static analysis guarentees a RETURN statement will be used before here. */
15597 : __builtin_unreachable ();
15598 : }
15599 :
15600 :
15601 : /*
15602 : PopBooltok - Pops a True and a False exit quad number from the True/False
15603 : stack.
15604 : */
15605 :
15606 218410 : static void PopBooltok (unsigned int *True, unsigned int *False, unsigned int *tokno)
15607 : {
15608 218410 : M2Quads_BoolFrame f;
15609 :
15610 218410 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
15611 218410 : (*True) = f->TrueExit;
15612 218410 : (*False) = f->FalseExit;
15613 218410 : (*tokno) = f->tokenno;
15614 218410 : M2Debug_Assert (f->BooleanOp);
15615 218410 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
15616 218410 : }
15617 :
15618 :
15619 : /*
15620 : PushBooltok - Push a True and a False exit quad numbers onto the
15621 : True/False stack.
15622 : */
15623 :
15624 225696 : static void PushBooltok (unsigned int True, unsigned int False, unsigned int tokno)
15625 : {
15626 225696 : M2Quads_BoolFrame f;
15627 :
15628 225696 : M2Debug_Assert (True <= NextQuad);
15629 225696 : M2Debug_Assert (False <= NextQuad);
15630 225696 : f = newBoolFrame ();
15631 225696 : f->TrueExit = True;
15632 225696 : f->FalseExit = False;
15633 225696 : f->BooleanOp = true;
15634 225696 : f->tokenno = tokno;
15635 225696 : f->Annotation = static_cast<DynamicStrings_String> (NULL);
15636 225696 : f->RangeDep = 0;
15637 225696 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15638 225696 : M2Quads_Annotate ((const char *) "<q%1d>|<q%2d>||true quad|false quad", 35);
15639 225696 : }
15640 :
15641 :
15642 : /*
15643 : PopBool - Pops a True and a False exit quad number from the True/False
15644 : stack.
15645 : */
15646 :
15647 186314 : static void PopBool (unsigned int *True, unsigned int *False)
15648 : {
15649 186314 : unsigned int tokno;
15650 :
15651 9842 : PopBooltok (True, False, &tokno);
15652 0 : }
15653 :
15654 :
15655 : /*
15656 : PushBool - Push a True and a False exit quad numbers onto the
15657 : True/False stack.
15658 : */
15659 :
15660 117506 : static void PushBool (unsigned int True, unsigned int False)
15661 : {
15662 7286 : PushBooltok (True, False, M2LexBuf_UnknownTokenNo);
15663 12818 : }
15664 :
15665 :
15666 : /*
15667 : IsBoolean - returns true is the Stack position pos contains a Boolean
15668 : Exit. False is returned if an Ident is stored.
15669 : */
15670 :
15671 269673599 : static bool IsBoolean (unsigned int pos)
15672 : {
15673 269673599 : M2Quads_BoolFrame f;
15674 :
15675 269673599 : M2Debug_Assert (pos > 0);
15676 269673599 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15677 269673599 : return f->BooleanOp;
15678 : /* static analysis guarentees a RETURN statement will be used before here. */
15679 : __builtin_unreachable ();
15680 : }
15681 :
15682 :
15683 : /*
15684 : OperandD - returns possible array dimension associated with the ident
15685 : operand stored on the boolean stack.
15686 : */
15687 :
15688 667035 : static unsigned int OperandD (unsigned int pos)
15689 : {
15690 667035 : M2Quads_BoolFrame f;
15691 :
15692 667035 : M2Debug_Assert (pos > 0);
15693 667035 : M2Debug_Assert (! (IsBoolean (pos)));
15694 667035 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15695 667035 : return static_cast<unsigned int> (f->Dimension);
15696 : /* static analysis guarentees a RETURN statement will be used before here. */
15697 : __builtin_unreachable ();
15698 : }
15699 :
15700 :
15701 : /*
15702 : OperandRW - returns the rw operand stored on the boolean stack.
15703 : */
15704 :
15705 728487 : static unsigned int OperandRW (unsigned int pos)
15706 : {
15707 728487 : M2Quads_BoolFrame f;
15708 :
15709 728487 : M2Debug_Assert (pos > 0);
15710 728487 : M2Debug_Assert (! (IsBoolean (pos)));
15711 728487 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15712 728487 : return static_cast<unsigned int> (f->ReadWrite);
15713 : /* static analysis guarentees a RETURN statement will be used before here. */
15714 : __builtin_unreachable ();
15715 : }
15716 :
15717 :
15718 : /*
15719 : OperandMergeRW - returns the rw operand if not NulSym else it
15720 : returns True.
15721 : */
15722 :
15723 704867 : static unsigned int OperandMergeRW (unsigned int pos)
15724 : {
15725 704867 : if ((OperandRW (pos)) == SymbolTable_NulSym)
15726 : {
15727 683603 : return M2Quads_OperandT (pos);
15728 : }
15729 : else
15730 : {
15731 21264 : return OperandRW (pos);
15732 : }
15733 : /* static analysis guarentees a RETURN statement will be used before here. */
15734 : __builtin_unreachable ();
15735 : }
15736 :
15737 :
15738 : /*
15739 : OperandRangeDep - return the range dependant associated with the quad stack.
15740 : */
15741 :
15742 136555 : static unsigned int OperandRangeDep (unsigned int pos)
15743 : {
15744 136555 : M2Quads_BoolFrame f;
15745 :
15746 136555 : M2Debug_Assert (! (IsBoolean (pos)));
15747 136555 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15748 136555 : return f->RangeDep;
15749 : /* static analysis guarentees a RETURN statement will be used before here. */
15750 : __builtin_unreachable ();
15751 : }
15752 :
15753 :
15754 : /*
15755 : PutRangeDep - assigns the quad stack pos RangeDep to dep.
15756 : */
15757 :
15758 521213 : static void PutRangeDep (unsigned int pos, unsigned int dep)
15759 : {
15760 521213 : M2Quads_BoolFrame f;
15761 :
15762 521213 : M2Debug_Assert (! (IsBoolean (pos)));
15763 521213 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15764 521213 : f->RangeDep = dep;
15765 521213 : }
15766 :
15767 :
15768 : /*
15769 : UseLineNote - uses the line note and returns it to the free list.
15770 : */
15771 :
15772 5084 : static void UseLineNote (M2Quads_LineNote l)
15773 : {
15774 5084 : M2Quads_QuadFrame f;
15775 :
15776 5084 : f = GetQF (NextQuad-1);
15777 5084 : if ((f->Operator == M2Quads_LineNumberOp) && (f->Operand1 == ((unsigned int ) (l->File))))
15778 : {} /* empty. */
15779 : else
15780 : {
15781 : /* do nothing */
15782 : if (false)
15783 : {
15784 : GenQuad (M2Quads_LineNumberOp, (unsigned int ) (l->File), SymbolTable_NulSym, (unsigned int ) (l->Line));
15785 : }
15786 : }
15787 5084 : l->Next = FreeLineList;
15788 5084 : FreeLineList = l;
15789 5084 : }
15790 :
15791 :
15792 : /*
15793 : PopLineNo - pops a line note from the line stack.
15794 : */
15795 :
15796 5084 : static M2Quads_LineNote PopLineNo (void)
15797 : {
15798 5084 : M2Quads_LineNote l;
15799 :
15800 5084 : l = static_cast<M2Quads_LineNote> (M2StackAddress_PopAddress (LineStack));
15801 5084 : if (l == NULL)
15802 : {
15803 0 : M2Error_InternalError ((const char *) "no line note available", 22);
15804 : }
15805 5084 : return l;
15806 : /* static analysis guarentees a RETURN statement will be used before here. */
15807 : __builtin_unreachable ();
15808 : }
15809 :
15810 :
15811 : /*
15812 : InitLineNote - creates a line note and initializes it to
15813 : contain, file, line.
15814 : */
15815 :
15816 5084 : static M2Quads_LineNote InitLineNote (NameKey_Name file, unsigned int line)
15817 : {
15818 5084 : M2Quads_LineNote l;
15819 :
15820 5084 : if (FreeLineList == NULL)
15821 : {
15822 2380 : Storage_ALLOCATE ((void **) &l, sizeof (M2Quads__T6));
15823 : }
15824 : else
15825 : {
15826 2704 : l = FreeLineList;
15827 2704 : FreeLineList = FreeLineList->Next;
15828 : }
15829 5084 : l->File = file;
15830 5084 : l->Line = line;
15831 5084 : return l;
15832 : /* static analysis guarentees a RETURN statement will be used before here. */
15833 : __builtin_unreachable ();
15834 : }
15835 :
15836 :
15837 : /*
15838 : PushLineNote -
15839 : */
15840 :
15841 5084 : static void PushLineNote (M2Quads_LineNote l)
15842 : {
15843 0 : M2StackAddress_PushAddress (LineStack, reinterpret_cast <void *> (l));
15844 0 : }
15845 :
15846 :
15847 : /*
15848 : BuildStmtNoteTok - adds a nop (with an assigned tokenno location) to the code.
15849 : */
15850 :
15851 531224 : static void BuildStmtNoteTok (unsigned int tokenno)
15852 : {
15853 531224 : NameKey_Name filename;
15854 531224 : M2Quads_QuadFrame f;
15855 :
15856 531224 : f = GetQF (NextQuad-1);
15857 : /* no need to have multiple notes at the same position. */
15858 531224 : if ((f->Operator != M2Quads_StatementNoteOp) || (f->Operand3 != tokenno))
15859 : {
15860 523962 : filename = NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()));
15861 523962 : GenQuad (M2Quads_StatementNoteOp, (unsigned int ) (filename), SymbolTable_NulSym, tokenno);
15862 : }
15863 531224 : }
15864 :
15865 :
15866 : /*
15867 : GetRecordOrField -
15868 : */
15869 :
15870 12066 : static unsigned int GetRecordOrField (void)
15871 : {
15872 12066 : unsigned int f;
15873 :
15874 12066 : VarientFieldNo += 1;
15875 12066 : f = static_cast<unsigned int> (Lists_GetItemFromList (VarientFields, VarientFieldNo));
15876 12066 : if (DebugVarients)
15877 : {
15878 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
15879 : if (SymbolTable_IsRecord (f))
15880 : {
15881 : M2Printf_printf2 ((const char *) "out list: record %d is %d\\n", 27, (const unsigned char *) &VarientFieldNo, (sizeof (VarientFieldNo)-1), (const unsigned char *) &f, (sizeof (f)-1));
15882 : }
15883 : else
15884 : {
15885 : M2Printf_printf2 ((const char *) "out list: varient field %d is %d\\n", 34, (const unsigned char *) &VarientFieldNo, (sizeof (VarientFieldNo)-1), (const unsigned char *) &f, (sizeof (f)-1));
15886 : }
15887 : }
15888 12066 : return f;
15889 : /* static analysis guarentees a RETURN statement will be used before here. */
15890 : __builtin_unreachable ();
15891 : }
15892 :
15893 :
15894 : /*
15895 : PushTFAD - Push True, False, Array, Dim, numbers onto the
15896 : True/False stack. True and False are assumed to
15897 : contain Symbols or Ident etc.
15898 : */
15899 :
15900 384 : static void PushTFAD (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim)
15901 : {
15902 384 : M2Quads_BoolFrame f;
15903 :
15904 384 : f = newBoolFrame ();
15905 384 : f->TrueExit = static_cast<unsigned int> (True);
15906 384 : f->FalseExit = static_cast<unsigned int> (False);
15907 384 : f->Unbounded = static_cast<unsigned int> (Array);
15908 384 : f->Dimension = static_cast<unsigned int> (Dim);
15909 384 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15910 384 : }
15911 :
15912 :
15913 : /*
15914 : PushTFADtok - Push True, False, Array, Dim, numbers onto the
15915 : True/False stack. True and False are assumed to
15916 : contain Symbols or Ident etc.
15917 : */
15918 :
15919 2890 : static void PushTFADtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int tokno)
15920 : {
15921 2890 : M2Quads_BoolFrame f;
15922 :
15923 2890 : f = newBoolFrame ();
15924 2890 : f->TrueExit = static_cast<unsigned int> (True);
15925 2890 : f->FalseExit = static_cast<unsigned int> (False);
15926 2890 : f->Unbounded = static_cast<unsigned int> (Array);
15927 2890 : f->Dimension = static_cast<unsigned int> (Dim);
15928 2890 : f->tokenno = tokno;
15929 2890 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15930 2890 : }
15931 :
15932 :
15933 : /*
15934 : PushTFADrwtok - Push True, False, Array, Dim, rw, numbers onto the
15935 : True/False stack. True and False are assumed to
15936 : contain Symbols or Ident etc.
15937 : */
15938 :
15939 8966 : static void PushTFADrwtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int rw, unsigned int Tok)
15940 : {
15941 8966 : M2Quads_BoolFrame f;
15942 :
15943 8966 : f = newBoolFrame ();
15944 8966 : f->TrueExit = static_cast<unsigned int> (True);
15945 8966 : f->FalseExit = static_cast<unsigned int> (False);
15946 8966 : f->Unbounded = static_cast<unsigned int> (Array);
15947 8966 : f->Dimension = static_cast<unsigned int> (Dim);
15948 8966 : f->ReadWrite = static_cast<unsigned int> (rw);
15949 8966 : f->tokenno = Tok;
15950 8966 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15951 8966 : }
15952 :
15953 :
15954 : /*
15955 : PopTFrwtok - Pop a True and False number from the True/False stack.
15956 : True and False are assumed to contain Symbols or Ident etc.
15957 : */
15958 :
15959 300352 : static void PopTFrwtok (unsigned int *True, unsigned int *False, unsigned int *rw, unsigned int *tokno)
15960 : {
15961 300352 : M2Quads_BoolFrame f;
15962 :
15963 300352 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
15964 300352 : (*True) = static_cast<unsigned int> (f->TrueExit);
15965 300352 : (*False) = static_cast<unsigned int> (f->FalseExit);
15966 300352 : M2Debug_Assert (! f->BooleanOp);
15967 300352 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
15968 300352 : (*tokno) = f->tokenno;
15969 300352 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
15970 300352 : }
15971 :
15972 :
15973 : /*
15974 : PushTFrwtok - Push an item onto the stack in the T (true) position,
15975 : it is assummed to be a token and its token location is recorded.
15976 : */
15977 :
15978 306546 : static void PushTFrwtok (unsigned int True, unsigned int False, unsigned int rw, unsigned int tokno)
15979 : {
15980 306546 : M2Quads_BoolFrame f;
15981 :
15982 306546 : f = newBoolFrame ();
15983 306546 : f->TrueExit = static_cast<unsigned int> (True);
15984 306546 : f->FalseExit = static_cast<unsigned int> (False);
15985 306546 : f->ReadWrite = static_cast<unsigned int> (rw);
15986 306546 : f->tokenno = tokno;
15987 306546 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15988 306546 : }
15989 :
15990 :
15991 : /*
15992 : PushTFDtok - Push True, False, Dim, numbers onto the
15993 : True/False stack. True and False are assumed to
15994 : contain Symbols or Ident etc.
15995 : */
15996 :
15997 258 : static void PushTFDtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int Tok)
15998 : {
15999 258 : M2Quads_BoolFrame f;
16000 :
16001 258 : f = newBoolFrame ();
16002 258 : f->TrueExit = static_cast<unsigned int> (True);
16003 258 : f->FalseExit = static_cast<unsigned int> (False);
16004 258 : f->Dimension = static_cast<unsigned int> (Dim);
16005 258 : f->tokenno = Tok;
16006 258 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16007 258 : }
16008 :
16009 :
16010 : /*
16011 : PopTFDtok - Pop a True, False, Dim number from the True/False stack.
16012 : True and False are assumed to contain Symbols or Ident etc.
16013 : */
16014 :
16015 258 : static void PopTFDtok (unsigned int *True, unsigned int *False, unsigned int *Dim, unsigned int *Tok)
16016 : {
16017 258 : M2Quads_BoolFrame f;
16018 :
16019 258 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16020 258 : (*True) = static_cast<unsigned int> (f->TrueExit);
16021 258 : (*False) = static_cast<unsigned int> (f->FalseExit);
16022 258 : (*Dim) = static_cast<unsigned int> (f->Dimension);
16023 258 : (*Tok) = f->tokenno;
16024 258 : M2Debug_Assert (! f->BooleanOp);
16025 258 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16026 258 : }
16027 :
16028 :
16029 : /*
16030 : PushTFDrwtok - Push True, False, Dim, numbers onto the
16031 : True/False stack. True and False are assumed to
16032 : contain Symbols or Ident etc.
16033 : */
16034 :
16035 46824 : static void PushTFDrwtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int rw, unsigned int Tok)
16036 : {
16037 46824 : M2Quads_BoolFrame f;
16038 :
16039 46824 : f = newBoolFrame ();
16040 46824 : f->TrueExit = static_cast<unsigned int> (True);
16041 46824 : f->FalseExit = static_cast<unsigned int> (False);
16042 46824 : f->Dimension = static_cast<unsigned int> (Dim);
16043 46824 : f->ReadWrite = static_cast<unsigned int> (rw);
16044 46824 : f->tokenno = Tok;
16045 46824 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16046 46824 : }
16047 :
16048 :
16049 : /*
16050 : PushTFrw - Push a True and False numbers onto the True/False stack.
16051 : True and False are assumed to contain Symbols or Ident etc.
16052 : It also pushes the higher level symbol which is associated
16053 : with the True symbol. Eg record variable or array variable.
16054 : */
16055 :
16056 2356 : static void PushTFrw (unsigned int True, unsigned int False, unsigned int rw)
16057 : {
16058 2356 : M2Quads_BoolFrame f;
16059 :
16060 2356 : f = newBoolFrame ();
16061 2356 : f->TrueExit = static_cast<unsigned int> (True);
16062 2356 : f->FalseExit = static_cast<unsigned int> (False);
16063 2356 : f->ReadWrite = rw;
16064 2356 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16065 2356 : }
16066 :
16067 :
16068 : /*
16069 : PopTFrw - Pop a True and False number from the True/False stack.
16070 : True and False are assumed to contain Symbols or Ident etc.
16071 : */
16072 :
16073 28984 : static void PopTFrw (unsigned int *True, unsigned int *False, unsigned int *rw)
16074 : {
16075 28984 : M2Quads_BoolFrame f;
16076 :
16077 28984 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16078 28984 : (*True) = static_cast<unsigned int> (f->TrueExit);
16079 28984 : (*False) = static_cast<unsigned int> (f->FalseExit);
16080 28984 : M2Debug_Assert (! f->BooleanOp);
16081 28984 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16082 28984 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16083 28984 : }
16084 :
16085 :
16086 : /*
16087 : newBoolFrame - creates a new BoolFrame with all fields initialised to their defaults.
16088 : */
16089 :
16090 343580764 : static M2Quads_BoolFrame newBoolFrame (void)
16091 : {
16092 343580764 : M2Quads_BoolFrame f;
16093 :
16094 343580764 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16095 343580764 : f->TrueExit = 0;
16096 343580764 : f->FalseExit = 0;
16097 343580764 : f->Unbounded = SymbolTable_NulSym;
16098 343580764 : f->BooleanOp = false;
16099 343580764 : f->Dimension = 0;
16100 343580764 : f->ReadWrite = SymbolTable_NulSym;
16101 343580764 : f->name = SymbolTable_NulSym;
16102 343580764 : f->Annotation = static_cast<DynamicStrings_String> (NULL);
16103 343580764 : f->tokenno = M2LexBuf_UnknownTokenNo;
16104 343580764 : return f;
16105 : /* static analysis guarentees a RETURN statement will be used before here. */
16106 : __builtin_unreachable ();
16107 : }
16108 :
16109 :
16110 : /*
16111 : PushTrwtok - Push an item onto the True/False stack. The False value will be zero.
16112 : */
16113 :
16114 156 : static void PushTrwtok (unsigned int True, unsigned int rw, unsigned int tok)
16115 : {
16116 156 : M2Quads_BoolFrame f;
16117 :
16118 156 : f = newBoolFrame ();
16119 156 : f->TrueExit = static_cast<unsigned int> (True);
16120 156 : f->ReadWrite = static_cast<unsigned int> (rw);
16121 156 : f->tokenno = tok;
16122 156 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16123 156 : }
16124 :
16125 :
16126 : /*
16127 : PopTrw - Pop a True field and rw symbol from the stack.
16128 : */
16129 :
16130 2356 : static void PopTrw (unsigned int *True, unsigned int *rw)
16131 : {
16132 2356 : M2Quads_BoolFrame f;
16133 :
16134 2356 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16135 2356 : (*True) = static_cast<unsigned int> (f->TrueExit);
16136 2356 : M2Debug_Assert (! f->BooleanOp);
16137 2356 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16138 2356 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16139 2356 : }
16140 :
16141 :
16142 : /*
16143 : PopTrwtok - Pop a True field and rw symbol from the stack.
16144 : */
16145 :
16146 1061669 : static void PopTrwtok (unsigned int *True, unsigned int *rw, unsigned int *tok)
16147 : {
16148 1061669 : M2Quads_BoolFrame f;
16149 :
16150 1061669 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16151 1061669 : (*True) = static_cast<unsigned int> (f->TrueExit);
16152 1061669 : M2Debug_Assert (! f->BooleanOp);
16153 1061669 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16154 1061669 : (*tok) = f->tokenno;
16155 1061669 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16156 1061669 : }
16157 :
16158 :
16159 : /*
16160 : gdbhook - a debugger convenience hook.
16161 : */
16162 :
16163 0 : static void gdbhook (void)
16164 : {
16165 0 : }
16166 :
16167 :
16168 : /*
16169 : BreakWhenQuadCreated - to be called interactively by gdb.
16170 : */
16171 :
16172 14952 : static void BreakWhenQuadCreated (unsigned int quad)
16173 : {
16174 14952 : BreakQuad = quad;
16175 0 : }
16176 :
16177 :
16178 : /*
16179 : CheckBreak - if quad = BreakQuad then call gdbhook.
16180 : */
16181 :
16182 0 : static void CheckBreak (unsigned int quad)
16183 : {
16184 0 : if (quad == BreakQuad)
16185 : {
16186 0 : gdbhook ();
16187 : }
16188 0 : }
16189 :
16190 :
16191 : /*
16192 : Init - initialize the M2Quads module, all the stacks, all the lists
16193 : and the quads list.
16194 : */
16195 :
16196 14952 : static void Init (void)
16197 : {
16198 14952 : BreakWhenQuadCreated (0); /* Disable the intereactive quad watch. */
16199 : /* To examine the quad table when a quad is created run cc1gm2 from gdb
16200 : and set a break point on gdbhook.
16201 : (gdb) break gdbhook
16202 : (gdb) run
16203 : Now below interactively call BreakWhenQuadCreated with the quad
16204 : under investigation. */
16205 14952 : gdbhook ();
16206 : /* Now is the time to interactively call gdb, for example:
16207 : (gdb) print BreakWhenQuadCreated (1234)
16208 : (gdb) cont
16209 : and you will arrive at gdbhook when this quad is created. */
16210 14952 : LogicalOrTok = NameKey_MakeKey ((const char *) "_LOR", 4);
16211 14952 : LogicalAndTok = NameKey_MakeKey ((const char *) "_LAND", 5);
16212 14952 : LogicalXorTok = NameKey_MakeKey ((const char *) "_LXOR", 5);
16213 14952 : LogicalDifferenceTok = NameKey_MakeKey ((const char *) "_LDIFF", 6);
16214 14952 : ArithPlusTok = NameKey_MakeKey ((const char *) "_ARITH_+", 8);
16215 14952 : QuadArray = Indexing_InitIndexTuned (1, (1024*1024) / 16, 16);
16216 14952 : FreeList = 1;
16217 14952 : NewQuad (&NextQuad);
16218 14952 : M2Debug_Assert (NextQuad == 1);
16219 14952 : BoolStack = M2StackAddress_InitStackAddress ();
16220 14952 : ExitStack = M2StackWord_InitStackWord ();
16221 14952 : RepeatStack = M2StackWord_InitStackWord ();
16222 14952 : WhileStack = M2StackWord_InitStackWord ();
16223 14952 : ForStack = M2StackWord_InitStackWord ();
16224 14952 : WithStack = M2StackAddress_InitStackAddress ();
16225 14952 : ReturnStack = M2StackWord_InitStackWord ();
16226 14952 : LineStack = M2StackAddress_InitStackAddress ();
16227 14952 : PriorityStack = M2StackWord_InitStackWord ();
16228 14952 : TryStack = M2StackWord_InitStackWord ();
16229 14952 : CatchStack = M2StackWord_InitStackWord ();
16230 14952 : ExceptStack = M2StackWord_InitStackWord ();
16231 14952 : ConstructorStack = M2StackAddress_InitStackAddress ();
16232 14952 : ConstParamStack = M2StackWord_InitStackWord ();
16233 14952 : ConstExprStack = M2StackWord_InitStackWord ();
16234 : /* StressStack ; */
16235 14952 : SuppressWith = false;
16236 14952 : Head = 1;
16237 14952 : LastQuadNo = 0;
16238 14952 : MustNotCheckBounds = false;
16239 14952 : InitQuad = 0;
16240 14952 : GrowInitialization = 0;
16241 14952 : ForInfo = Indexing_InitIndex (1);
16242 14952 : QuadrupleGeneration = true;
16243 14952 : BuildingHigh = false;
16244 14952 : BuildingSize = false;
16245 14952 : AutoStack = M2StackWord_InitStackWord ();
16246 14952 : IsAutoOn = true;
16247 14952 : InConstExpression = false;
16248 14952 : InConstParameters = false;
16249 14952 : FreeLineList = NULL;
16250 14952 : Lists_InitList (&VarientFields);
16251 14952 : VarientFieldNo = 0;
16252 14952 : NoOfQuads = 0;
16253 14952 : QuadMemDiag = M2Diagnostic_InitMemDiagnostic ((const char *) "M2Quad:Quadruples", 17, (const char *) "{0N} total quadruples {1d} consuming {2M} ram {0M} ({2P})", 57);
16254 14952 : }
16255 :
16256 :
16257 : /*
16258 : SetOptionCoding - builds a code quadruple if the profiling
16259 : option was given to the compiler.
16260 : */
16261 :
16262 0 : extern "C" void M2Quads_SetOptionCoding (bool b)
16263 : {
16264 0 : if (b != M2Options_Coding)
16265 : {
16266 0 : if (b)
16267 : {
16268 0 : M2Quads_BuildCodeOn ();
16269 : }
16270 : else
16271 : {
16272 0 : M2Quads_BuildCodeOff ();
16273 : }
16274 0 : M2Options_Coding = b;
16275 : }
16276 0 : }
16277 :
16278 :
16279 : /*
16280 : SetOptionProfiling - builds a profile quadruple if the profiling
16281 : option was given to the compiler.
16282 : */
16283 :
16284 0 : extern "C" void M2Quads_SetOptionProfiling (bool b)
16285 : {
16286 0 : if (b != M2Options_Profiling)
16287 : {
16288 0 : if (b)
16289 : {
16290 0 : M2Quads_BuildProfileOn ();
16291 : }
16292 : else
16293 : {
16294 0 : M2Quads_BuildProfileOff ();
16295 : }
16296 0 : M2Options_Profiling = b;
16297 : }
16298 0 : }
16299 :
16300 :
16301 : /*
16302 : SetOptionOptimizing - builds a quadruple to say that the optimization option
16303 : has been found in a comment.
16304 : */
16305 :
16306 0 : extern "C" void M2Quads_SetOptionOptimizing (bool b)
16307 : {
16308 0 : if (b)
16309 : {
16310 0 : M2Quads_BuildOptimizeOn ();
16311 : }
16312 : else
16313 : {
16314 0 : M2Quads_BuildOptimizeOff ();
16315 : }
16316 0 : }
16317 :
16318 :
16319 : /*
16320 : Opposite - returns the opposite comparison operator.
16321 : */
16322 :
16323 79270 : extern "C" M2Quads_QuadOperator M2Quads_Opposite (M2Quads_QuadOperator Operator)
16324 : {
16325 79270 : M2Quads_QuadOperator Op;
16326 :
16327 79270 : switch (Operator)
16328 : {
16329 : case M2Quads_IfNotEquOp:
16330 : Op = M2Quads_IfEquOp;
16331 : break;
16332 :
16333 : case M2Quads_IfEquOp:
16334 : Op = M2Quads_IfNotEquOp;
16335 : break;
16336 :
16337 : case M2Quads_IfLessEquOp:
16338 : Op = M2Quads_IfGreOp;
16339 : break;
16340 :
16341 : case M2Quads_IfGreOp:
16342 : Op = M2Quads_IfLessEquOp;
16343 : break;
16344 :
16345 : case M2Quads_IfGreEquOp:
16346 : Op = M2Quads_IfLessOp;
16347 : break;
16348 :
16349 : case M2Quads_IfLessOp:
16350 : Op = M2Quads_IfGreEquOp;
16351 : break;
16352 :
16353 : case M2Quads_IfInOp:
16354 : Op = M2Quads_IfNotInOp;
16355 : break;
16356 :
16357 : case M2Quads_IfNotInOp:
16358 : Op = M2Quads_IfInOp;
16359 : break;
16360 :
16361 :
16362 0 : default:
16363 0 : M2Error_InternalError ((const char *) "unexpected operator", 19);
16364 79270 : break;
16365 : }
16366 79270 : return Op;
16367 : /* static analysis guarentees a RETURN statement will be used before here. */
16368 : __builtin_unreachable ();
16369 : }
16370 :
16371 :
16372 : /*
16373 : IsReferenced - returns true if QuadNo is referenced by another quadruple.
16374 : */
16375 :
16376 255625481 : extern "C" bool M2Quads_IsReferenced (unsigned int QuadNo)
16377 : {
16378 255625481 : M2Quads_QuadFrame f;
16379 :
16380 255625481 : f = GetQF (QuadNo);
16381 255625481 : return ((f->Operator == M2Quads_ProcedureScopeOp) || (f->Operator == M2Quads_NewLocalVarOp)) || (f->NoOfTimesReferenced > 0);
16382 : /* static analysis guarentees a RETURN statement will be used before here. */
16383 : __builtin_unreachable ();
16384 : }
16385 :
16386 :
16387 : /*
16388 : IsBackReference - returns TRUE if quadruple, q, is referenced from a quad further on.
16389 : */
16390 :
16391 97025 : extern "C" bool M2Quads_IsBackReference (unsigned int q)
16392 : {
16393 97025 : unsigned int i;
16394 97025 : M2Quads_QuadOperator op;
16395 97025 : unsigned int op1;
16396 97025 : unsigned int op2;
16397 97025 : unsigned int op3;
16398 :
16399 97025 : i = q;
16400 3803984 : while (i != 0)
16401 : {
16402 3803984 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
16403 3803984 : switch (op)
16404 : {
16405 : case M2Quads_NewLocalVarOp:
16406 : case M2Quads_KillLocalVarOp:
16407 : case M2Quads_FinallyStartOp:
16408 : case M2Quads_FinallyEndOp:
16409 : case M2Quads_InitEndOp:
16410 : case M2Quads_InitStartOp:
16411 : case M2Quads_EndFileOp:
16412 : case M2Quads_StartDefFileOp:
16413 : case M2Quads_StartModFileOp:
16414 : return false; /* run into end of procedure or module */
16415 168340 : break;
16416 :
16417 168340 : case M2Quads_GotoOp:
16418 168340 : case M2Quads_IfEquOp:
16419 168340 : case M2Quads_IfLessEquOp:
16420 168340 : case M2Quads_IfGreEquOp:
16421 168340 : case M2Quads_IfGreOp:
16422 168340 : case M2Quads_IfLessOp:
16423 168340 : case M2Quads_IfNotEquOp:
16424 168340 : case M2Quads_IfInOp:
16425 168340 : case M2Quads_IfNotInOp:
16426 168340 : if (op3 == q) /* run into end of procedure or module */
16427 : {
16428 : return true;
16429 : }
16430 : break;
16431 :
16432 :
16433 : default:
16434 : break;
16435 : }
16436 3706959 : i = M2Quads_GetNextQuad (i);
16437 : }
16438 0 : M2Error_InternalError ((const char *) "fix this for the sake of efficiency..", 37);
16439 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
16440 : __builtin_unreachable ();
16441 : }
16442 :
16443 :
16444 : /*
16445 : IsUnConditional - returns true if QuadNo is an unconditional jump.
16446 : */
16447 :
16448 518626946 : extern "C" bool M2Quads_IsUnConditional (unsigned int QuadNo)
16449 : {
16450 518626946 : M2Quads_QuadFrame f;
16451 :
16452 518626946 : f = GetQF (QuadNo);
16453 518626946 : switch (f->Operator)
16454 : {
16455 : case M2Quads_ThrowOp:
16456 : case M2Quads_RetryOp:
16457 : case M2Quads_CallOp:
16458 : case M2Quads_ReturnOp:
16459 : case M2Quads_GotoOp:
16460 : return true;
16461 498299047 : break;
16462 :
16463 :
16464 498299047 : default:
16465 498299047 : return false;
16466 : break;
16467 : }
16468 : /* static analysis guarentees a RETURN statement will be used before here. */
16469 : __builtin_unreachable ();
16470 : }
16471 :
16472 :
16473 : /*
16474 : IsConditional - returns true if QuadNo is a conditional jump.
16475 : */
16476 :
16477 518734345 : extern "C" bool M2Quads_IsConditional (unsigned int QuadNo)
16478 : {
16479 518734345 : M2Quads_QuadFrame f;
16480 :
16481 518734345 : f = GetQF (QuadNo);
16482 518734345 : switch (f->Operator)
16483 : {
16484 : case M2Quads_IfInOp:
16485 : case M2Quads_IfNotInOp:
16486 : case M2Quads_IfEquOp:
16487 : case M2Quads_IfNotEquOp:
16488 : case M2Quads_IfLessOp:
16489 : case M2Quads_IfLessEquOp:
16490 : case M2Quads_IfGreOp:
16491 : case M2Quads_IfGreEquOp:
16492 : return true;
16493 514816364 : break;
16494 :
16495 :
16496 514816364 : default:
16497 514816364 : return false;
16498 : break;
16499 : }
16500 : /* static analysis guarentees a RETURN statement will be used before here. */
16501 : __builtin_unreachable ();
16502 : }
16503 :
16504 :
16505 : /*
16506 : IsBackReferenceConditional - returns TRUE if quadruple, q, is referenced from
16507 : a conditional quad further on.
16508 : */
16509 :
16510 0 : extern "C" bool M2Quads_IsBackReferenceConditional (unsigned int q)
16511 : {
16512 0 : unsigned int i;
16513 0 : M2Quads_QuadOperator op;
16514 0 : unsigned int op1;
16515 0 : unsigned int op2;
16516 0 : unsigned int op3;
16517 :
16518 0 : i = q;
16519 0 : while (i != 0)
16520 : {
16521 0 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
16522 0 : switch (op)
16523 : {
16524 : case M2Quads_NewLocalVarOp:
16525 : case M2Quads_KillLocalVarOp:
16526 : case M2Quads_FinallyStartOp:
16527 : case M2Quads_FinallyEndOp:
16528 : case M2Quads_InitEndOp:
16529 : case M2Quads_InitStartOp:
16530 : case M2Quads_EndFileOp:
16531 : case M2Quads_StartDefFileOp:
16532 : case M2Quads_StartModFileOp:
16533 : return false; /* run into end of procedure or module */
16534 0 : break;
16535 :
16536 0 : case M2Quads_TryOp:
16537 0 : case M2Quads_RetryOp:
16538 0 : case M2Quads_GotoOp:
16539 0 : case M2Quads_IfEquOp:
16540 0 : case M2Quads_IfLessEquOp:
16541 0 : case M2Quads_IfGreEquOp:
16542 0 : case M2Quads_IfGreOp:
16543 0 : case M2Quads_IfLessOp:
16544 0 : case M2Quads_IfNotEquOp:
16545 0 : case M2Quads_IfInOp:
16546 0 : case M2Quads_IfNotInOp:
16547 0 : if ((op3 == q) && (M2Quads_IsConditional (q))) /* run into end of procedure or module */
16548 : {
16549 : return true;
16550 : }
16551 0 : break;
16552 :
16553 :
16554 : default:
16555 : return false;
16556 0 : break;
16557 : }
16558 0 : i = M2Quads_GetNextQuad (i);
16559 : }
16560 0 : M2Error_InternalError ((const char *) "fix this for the sake of efficiency..", 37);
16561 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
16562 : __builtin_unreachable ();
16563 : }
16564 :
16565 :
16566 : /*
16567 : IsGoto - returns true if QuadNo is a goto operation.
16568 : */
16569 :
16570 97025 : extern "C" bool M2Quads_IsGoto (unsigned int QuadNo)
16571 : {
16572 97025 : return IsQuadA (QuadNo, M2Quads_GotoOp);
16573 : /* static analysis guarentees a RETURN statement will be used before here. */
16574 : __builtin_unreachable ();
16575 : }
16576 :
16577 :
16578 : /*
16579 : IsCall - returns true if QuadNo is a call operation.
16580 : */
16581 :
16582 518723971 : extern "C" bool M2Quads_IsCall (unsigned int QuadNo)
16583 : {
16584 518723971 : return IsQuadA (QuadNo, M2Quads_CallOp);
16585 : /* static analysis guarentees a RETURN statement will be used before here. */
16586 : __builtin_unreachable ();
16587 : }
16588 :
16589 :
16590 : /*
16591 : IsReturn - returns true if QuadNo is a return operation.
16592 : */
16593 :
16594 518884063 : extern "C" bool M2Quads_IsReturn (unsigned int QuadNo)
16595 : {
16596 518884063 : return IsQuadA (QuadNo, M2Quads_ReturnOp);
16597 : /* static analysis guarentees a RETURN statement will be used before here. */
16598 : __builtin_unreachable ();
16599 : }
16600 :
16601 :
16602 : /*
16603 : IsProcedureScope - returns true if QuadNo is a ProcedureScope operation.
16604 : */
16605 :
16606 0 : extern "C" bool M2Quads_IsProcedureScope (unsigned int QuadNo)
16607 : {
16608 0 : return IsQuadA (QuadNo, M2Quads_ProcedureScopeOp);
16609 : /* static analysis guarentees a RETURN statement will be used before here. */
16610 : __builtin_unreachable ();
16611 : }
16612 :
16613 :
16614 : /*
16615 : IsNewLocalVar - returns true if QuadNo is a NewLocalVar operation.
16616 : */
16617 :
16618 0 : extern "C" bool M2Quads_IsNewLocalVar (unsigned int QuadNo)
16619 : {
16620 0 : return IsQuadA (QuadNo, M2Quads_NewLocalVarOp);
16621 : /* static analysis guarentees a RETURN statement will be used before here. */
16622 : __builtin_unreachable ();
16623 : }
16624 :
16625 :
16626 : /*
16627 : IsKillLocalVar - returns true if QuadNo is a KillLocalVar operation.
16628 : */
16629 :
16630 253239 : extern "C" bool M2Quads_IsKillLocalVar (unsigned int QuadNo)
16631 : {
16632 253239 : return IsQuadA (QuadNo, M2Quads_KillLocalVarOp);
16633 : /* static analysis guarentees a RETURN statement will be used before here. */
16634 : __builtin_unreachable ();
16635 : }
16636 :
16637 :
16638 : /*
16639 : IsCatchBegin - returns true if QuadNo is a catch begin quad.
16640 : */
16641 :
16642 135728 : extern "C" bool M2Quads_IsCatchBegin (unsigned int QuadNo)
16643 : {
16644 135728 : return IsQuadA (QuadNo, M2Quads_CatchBeginOp);
16645 : /* static analysis guarentees a RETURN statement will be used before here. */
16646 : __builtin_unreachable ();
16647 : }
16648 :
16649 :
16650 : /*
16651 : IsCatchEnd - returns true if QuadNo is a catch end quad.
16652 : */
16653 :
16654 152336 : extern "C" bool M2Quads_IsCatchEnd (unsigned int QuadNo)
16655 : {
16656 152336 : return IsQuadA (QuadNo, M2Quads_CatchEndOp);
16657 : /* static analysis guarentees a RETURN statement will be used before here. */
16658 : __builtin_unreachable ();
16659 : }
16660 :
16661 :
16662 : /*
16663 : IsInitStart - returns true if QuadNo is a init start quad.
16664 : */
16665 :
16666 135728 : extern "C" bool M2Quads_IsInitStart (unsigned int QuadNo)
16667 : {
16668 135728 : return IsQuadA (QuadNo, M2Quads_InitStartOp);
16669 : /* static analysis guarentees a RETURN statement will be used before here. */
16670 : __builtin_unreachable ();
16671 : }
16672 :
16673 :
16674 : /*
16675 : IsInitEnd - returns true if QuadNo is a init end quad.
16676 : */
16677 :
16678 135728 : extern "C" bool M2Quads_IsInitEnd (unsigned int QuadNo)
16679 : {
16680 135728 : return IsQuadA (QuadNo, M2Quads_InitEndOp);
16681 : /* static analysis guarentees a RETURN statement will be used before here. */
16682 : __builtin_unreachable ();
16683 : }
16684 :
16685 :
16686 : /*
16687 : IsFinallyStart - returns true if QuadNo is a finally start quad.
16688 : */
16689 :
16690 130274 : extern "C" bool M2Quads_IsFinallyStart (unsigned int QuadNo)
16691 : {
16692 130274 : return IsQuadA (QuadNo, M2Quads_FinallyStartOp);
16693 : /* static analysis guarentees a RETURN statement will be used before here. */
16694 : __builtin_unreachable ();
16695 : }
16696 :
16697 :
16698 : /*
16699 : IsFinallyEnd - returns true if QuadNo is a finally end quad.
16700 : */
16701 :
16702 124820 : extern "C" bool M2Quads_IsFinallyEnd (unsigned int QuadNo)
16703 : {
16704 124820 : return IsQuadA (QuadNo, M2Quads_FinallyEndOp);
16705 : /* static analysis guarentees a RETURN statement will be used before here. */
16706 : __builtin_unreachable ();
16707 : }
16708 :
16709 :
16710 : /*
16711 : IsBecomes - return TRUE if QuadNo is a BecomesOp.
16712 : */
16713 :
16714 0 : extern "C" bool M2Quads_IsBecomes (unsigned int QuadNo)
16715 : {
16716 0 : return IsQuadA (QuadNo, M2Quads_BecomesOp);
16717 : /* static analysis guarentees a RETURN statement will be used before here. */
16718 : __builtin_unreachable ();
16719 : }
16720 :
16721 :
16722 : /*
16723 : IsDummy - return TRUE if QuadNo is a DummyOp.
16724 : */
16725 :
16726 0 : extern "C" bool M2Quads_IsDummy (unsigned int QuadNo)
16727 : {
16728 0 : return IsQuadA (QuadNo, M2Quads_DummyOp);
16729 : /* static analysis guarentees a RETURN statement will be used before here. */
16730 : __builtin_unreachable ();
16731 : }
16732 :
16733 :
16734 : /*
16735 : IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
16736 : */
16737 :
16738 0 : extern "C" bool M2Quads_IsQuadConstExpr (unsigned int QuadNo)
16739 : {
16740 0 : M2Quads_QuadFrame f;
16741 :
16742 0 : f = GetQF (QuadNo);
16743 0 : return f->ConstExpr;
16744 : /* static analysis guarentees a RETURN statement will be used before here. */
16745 : __builtin_unreachable ();
16746 : }
16747 :
16748 :
16749 : /*
16750 : SetQuadConstExpr - sets the constexpr field to value.
16751 : */
16752 :
16753 0 : extern "C" void M2Quads_SetQuadConstExpr (unsigned int QuadNo, bool value)
16754 : {
16755 0 : M2Quads_QuadFrame f;
16756 :
16757 0 : f = GetQF (QuadNo);
16758 0 : f->ConstExpr = value;
16759 0 : }
16760 :
16761 :
16762 : /*
16763 : GetQuadDest - returns the jump destination associated with quad.
16764 : */
16765 :
16766 0 : extern "C" unsigned int M2Quads_GetQuadDest (unsigned int QuadNo)
16767 : {
16768 0 : return M2Quads_GetQuadOp3 (QuadNo);
16769 : /* static analysis guarentees a RETURN statement will be used before here. */
16770 : __builtin_unreachable ();
16771 : }
16772 :
16773 :
16774 : /*
16775 : GetQuadOp1 - returns the 1st operand associated with quad.
16776 : */
16777 :
16778 0 : extern "C" unsigned int M2Quads_GetQuadOp1 (unsigned int QuadNo)
16779 : {
16780 0 : M2Quads_QuadFrame f;
16781 :
16782 0 : f = GetQF (QuadNo);
16783 0 : return f->Operand1;
16784 : /* static analysis guarentees a RETURN statement will be used before here. */
16785 : __builtin_unreachable ();
16786 : }
16787 :
16788 :
16789 : /*
16790 : GetQuadOp2 - returns the 2nd operand associated with quad.
16791 : */
16792 :
16793 0 : extern "C" unsigned int M2Quads_GetQuadOp2 (unsigned int QuadNo)
16794 : {
16795 0 : M2Quads_QuadFrame f;
16796 :
16797 0 : f = GetQF (QuadNo);
16798 0 : return f->Operand2;
16799 : /* static analysis guarentees a RETURN statement will be used before here. */
16800 : __builtin_unreachable ();
16801 : }
16802 :
16803 :
16804 : /*
16805 : GetQuadOp3 - returns the 3rd operand associated with quad.
16806 : */
16807 :
16808 0 : extern "C" unsigned int M2Quads_GetQuadOp3 (unsigned int QuadNo)
16809 : {
16810 0 : M2Quads_QuadFrame f;
16811 :
16812 0 : f = GetQF (QuadNo);
16813 0 : return f->Operand3;
16814 : /* static analysis guarentees a RETURN statement will be used before here. */
16815 : __builtin_unreachable ();
16816 : }
16817 :
16818 :
16819 : /*
16820 : IsInitialisingConst - returns TRUE if the quadruple is setting
16821 : a const (op1) with a value.
16822 : */
16823 :
16824 0 : extern "C" bool M2Quads_IsInitialisingConst (unsigned int QuadNo)
16825 : {
16826 0 : M2Quads_QuadOperator op;
16827 0 : unsigned int op1;
16828 0 : unsigned int op2;
16829 0 : unsigned int op3;
16830 :
16831 0 : M2Quads_GetQuad (QuadNo, &op, &op1, &op2, &op3);
16832 0 : return (OpUsesOp1 (op)) && (SymbolTable_IsConst (op1));
16833 : /* static analysis guarentees a RETURN statement will be used before here. */
16834 : __builtin_unreachable ();
16835 : }
16836 :
16837 :
16838 : /*
16839 : IsConstQuad - return TRUE if the quadruple is marked as a constexpr.
16840 : */
16841 :
16842 0 : extern "C" bool M2Quads_IsConstQuad (unsigned int quad)
16843 : {
16844 0 : M2Quads_QuadFrame f;
16845 :
16846 0 : f = GetQF (quad);
16847 0 : return f->ConstExpr;
16848 : /* static analysis guarentees a RETURN statement will be used before here. */
16849 : __builtin_unreachable ();
16850 : }
16851 :
16852 :
16853 : /*
16854 : IsConditionalBooleanQuad - return TRUE if operand 1 is a boolean result.
16855 : */
16856 :
16857 415714 : extern "C" bool M2Quads_IsConditionalBooleanQuad (unsigned int quad)
16858 : {
16859 415714 : M2Quads_QuadFrame f;
16860 :
16861 415714 : f = GetQF (quad);
16862 415714 : return ((OpUsesOp1 (f->Operator)) && ((SymbolTable_IsVar (f->Operand1)) || (SymbolTable_IsConst (f->Operand1)))) && (SymbolTable_IsVarConditional (f->Operand1));
16863 : /* static analysis guarentees a RETURN statement will be used before here. */
16864 : __builtin_unreachable ();
16865 : }
16866 :
16867 :
16868 : /*
16869 : IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
16870 : */
16871 :
16872 0 : extern "C" bool M2Quads_IsOptimizeOn (unsigned int QuadNo)
16873 : {
16874 0 : M2Quads_QuadFrame f;
16875 0 : unsigned int n;
16876 0 : unsigned int q;
16877 0 : bool On;
16878 :
16879 0 : On = M2Options_Optimizing;
16880 0 : q = Head;
16881 0 : while ((q != 0) && (q != QuadNo))
16882 : {
16883 0 : f = GetQF (q);
16884 0 : if (f->Operator == M2Quads_OptimizeOnOp)
16885 : {
16886 : On = true;
16887 : }
16888 0 : else if (f->Operator == M2Quads_OptimizeOffOp)
16889 : {
16890 : /* avoid dangling else. */
16891 0 : On = false;
16892 : }
16893 0 : n = f->Next;
16894 0 : q = n;
16895 : }
16896 0 : return On;
16897 : /* static analysis guarentees a RETURN statement will be used before here. */
16898 : __builtin_unreachable ();
16899 : }
16900 :
16901 :
16902 : /*
16903 : IsProfileOn - returns true if the Profile flag was true at QuadNo.
16904 : */
16905 :
16906 0 : extern "C" bool M2Quads_IsProfileOn (unsigned int QuadNo)
16907 : {
16908 0 : M2Quads_QuadFrame f;
16909 0 : unsigned int n;
16910 0 : unsigned int q;
16911 0 : bool On;
16912 :
16913 0 : On = M2Options_Profiling;
16914 0 : q = Head;
16915 0 : while ((q != 0) && (q != QuadNo))
16916 : {
16917 0 : f = GetQF (q);
16918 0 : if (f->Operator == M2Quads_ProfileOnOp)
16919 : {
16920 : On = true;
16921 : }
16922 0 : else if (f->Operator == M2Quads_ProfileOffOp)
16923 : {
16924 : /* avoid dangling else. */
16925 0 : On = false;
16926 : }
16927 0 : n = f->Next;
16928 0 : q = n;
16929 : }
16930 0 : return On;
16931 : /* static analysis guarentees a RETURN statement will be used before here. */
16932 : __builtin_unreachable ();
16933 : }
16934 :
16935 :
16936 : /*
16937 : IsCodeOn - returns true if the Code flag was true at QuadNo.
16938 : */
16939 :
16940 0 : extern "C" bool M2Quads_IsCodeOn (unsigned int QuadNo)
16941 : {
16942 0 : M2Quads_QuadFrame f;
16943 0 : unsigned int n;
16944 0 : unsigned int q;
16945 0 : bool On;
16946 :
16947 0 : On = M2Options_Coding;
16948 0 : q = Head;
16949 0 : while ((q != 0) && (q != QuadNo))
16950 : {
16951 0 : f = GetQF (q);
16952 0 : if (f->Operator == M2Quads_CodeOnOp)
16953 : {
16954 : On = true;
16955 : }
16956 0 : else if (f->Operator == M2Quads_CodeOffOp)
16957 : {
16958 : /* avoid dangling else. */
16959 0 : On = false;
16960 : }
16961 0 : n = f->Next;
16962 0 : q = n;
16963 : }
16964 0 : return On;
16965 : /* static analysis guarentees a RETURN statement will be used before here. */
16966 : __builtin_unreachable ();
16967 : }
16968 :
16969 :
16970 : /*
16971 : IsPseudoQuad - returns true if QuadNo is a compiler directive.
16972 : ie code, profile and optimize.
16973 : StartFile, EndFile,
16974 : */
16975 :
16976 22569493 : extern "C" bool M2Quads_IsPseudoQuad (unsigned int QuadNo)
16977 : {
16978 22569493 : M2Quads_QuadFrame f;
16979 :
16980 22569493 : f = GetQF (QuadNo);
16981 22569493 : return ((((((((f->Operator == M2Quads_CodeOnOp) || (f->Operator == M2Quads_CodeOffOp)) || (f->Operator == M2Quads_ProfileOnOp)) || (f->Operator == M2Quads_ProfileOffOp)) || (f->Operator == M2Quads_OptimizeOnOp)) || (f->Operator == M2Quads_OptimizeOffOp)) || (f->Operator == M2Quads_EndFileOp)) || (f->Operator == M2Quads_StartDefFileOp)) || (f->Operator == M2Quads_StartModFileOp);
16982 : /* static analysis guarentees a RETURN statement will be used before here. */
16983 : __builtin_unreachable ();
16984 : }
16985 :
16986 :
16987 : /*
16988 : IsDefOrModFile - returns TRUE if QuadNo is a start of Module or Def file
16989 : directive.
16990 : */
16991 :
16992 518626946 : extern "C" bool M2Quads_IsDefOrModFile (unsigned int QuadNo)
16993 : {
16994 518626946 : M2Quads_QuadFrame f;
16995 :
16996 518626946 : f = GetQF (QuadNo);
16997 518626946 : return (f->Operator == M2Quads_StartDefFileOp) || (f->Operator == M2Quads_StartModFileOp);
16998 : /* static analysis guarentees a RETURN statement will be used before here. */
16999 : __builtin_unreachable ();
17000 : }
17001 :
17002 :
17003 : /*
17004 : DumpQuadruples - dump all quadruples providing the -fq, -fdump-lang-quad,
17005 : -fdump-lang-quad= or -fdump-lang-all were issued to the
17006 : command line.
17007 : */
17008 :
17009 69412 : extern "C" void M2Quads_DumpQuadruples (const char *title_, unsigned int _title_high)
17010 : {
17011 69412 : char title[_title_high+1];
17012 :
17013 : /* make a local copy of each unbounded array. */
17014 69412 : memcpy (title, title_, _title_high+1);
17015 :
17016 69412 : if (M2Options_GetDumpQuad ())
17017 : {
17018 0 : M2LangDump_CreateDumpQuad ((const char *) title, _title_high);
17019 0 : if ((M2Options_GetM2DumpFilter ()) == NULL)
17020 : {
17021 0 : DumpQuadrupleAll ();
17022 : }
17023 : else
17024 : {
17025 0 : DumpQuadrupleFilter ();
17026 : }
17027 0 : M2LangDump_CloseDumpQuad ();
17028 : }
17029 69412 : }
17030 :
17031 :
17032 : /*
17033 : DisplayQuadRange - displays all quads in list range, start..end.
17034 : */
17035 :
17036 0 : extern "C" void M2Quads_DisplayQuadRange (unsigned int scope, unsigned int start, unsigned int end)
17037 : {
17038 0 : M2Quads_QuadFrame f;
17039 :
17040 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "Quadruples for scope: %d\\n", 26, (const unsigned char *) &scope, (sizeof (scope)-1));
17041 0 : while ((start <= end) && (start != 0))
17042 : {
17043 0 : M2Quads_DisplayQuad (start);
17044 0 : f = GetQF (start);
17045 0 : start = f->Next;
17046 : }
17047 0 : }
17048 :
17049 :
17050 : /*
17051 : DisplayQuad - displays a quadruple, QuadNo.
17052 : */
17053 :
17054 0 : extern "C" void M2Quads_DisplayQuad (unsigned int QuadNo)
17055 : {
17056 0 : if (QuadNo != 0)
17057 : {
17058 0 : DSdbEnter ();
17059 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d ", 5, (const unsigned char *) &QuadNo, (sizeof (QuadNo)-1));
17060 0 : WriteQuad (QuadNo);
17061 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "\\n", 2);
17062 0 : DSdbExit ();
17063 : }
17064 0 : }
17065 :
17066 :
17067 : /*
17068 : GetLastFileQuad - returns the Quadruple number of the last StartDefFile or
17069 : StartModFile quadruple.
17070 : */
17071 :
17072 0 : extern "C" unsigned int M2Quads_GetLastFileQuad (unsigned int QuadNo)
17073 : {
17074 0 : M2Quads_QuadFrame f;
17075 0 : unsigned int q;
17076 0 : unsigned int i;
17077 0 : unsigned int FileQuad;
17078 :
17079 0 : q = Head;
17080 0 : FileQuad = 0;
17081 0 : do {
17082 0 : f = GetQF (q);
17083 0 : if ((f->Operator == M2Quads_StartModFileOp) || (f->Operator == M2Quads_StartDefFileOp))
17084 : {
17085 0 : FileQuad = q;
17086 : }
17087 0 : i = f->Next;
17088 0 : q = i;
17089 0 : } while (! ((i == QuadNo) || (i == 0)));
17090 0 : M2Debug_Assert (i != 0);
17091 0 : M2Debug_Assert (FileQuad != 0);
17092 0 : return FileQuad;
17093 : /* static analysis guarentees a RETURN statement will be used before here. */
17094 : __builtin_unreachable ();
17095 : }
17096 :
17097 :
17098 : /*
17099 : GetLastQuadNo - returns the last quadruple number referenced
17100 : by a GetQuad.
17101 : */
17102 :
17103 0 : extern "C" unsigned int M2Quads_GetLastQuadNo (void)
17104 : {
17105 0 : return LastQuadNo;
17106 : /* static analysis guarentees a RETURN statement will be used before here. */
17107 : __builtin_unreachable ();
17108 : }
17109 :
17110 :
17111 : /*
17112 : QuadToTokenNo - Converts a QuadNo into the approprate token number of the
17113 : source file, the line number is returned.
17114 :
17115 : This may be used to yield an idea where abouts in the
17116 : source file the code generetion is
17117 : processing.
17118 : */
17119 :
17120 7118353 : extern "C" unsigned int M2Quads_QuadToTokenNo (unsigned int QuadNo)
17121 : {
17122 7118353 : M2Quads_QuadFrame f;
17123 :
17124 7118353 : if ((((LastQuadNo == 0) && (! (M2Pass_IsNoPass ()))) && (! (M2Pass_IsPassCodeGeneration ()))) || (! (Indexing_InBounds (QuadArray, QuadNo))))
17125 : {
17126 0 : return 0;
17127 : }
17128 : else
17129 : {
17130 7118353 : f = GetQF (QuadNo);
17131 7118353 : return f->TokenNo;
17132 : }
17133 : /* static analysis guarentees a RETURN statement will be used before here. */
17134 : __builtin_unreachable ();
17135 : }
17136 :
17137 :
17138 : /*
17139 : QuadToLineNo - Converts a QuadNo into the approprate line number of the
17140 : source file, the line number is returned.
17141 :
17142 : This may be used to yield an idea where abouts in the
17143 : source file the code generetion is
17144 : processing.
17145 : */
17146 :
17147 0 : extern "C" unsigned int M2Quads_QuadToLineNo (unsigned int QuadNo)
17148 : {
17149 0 : M2Quads_QuadFrame f;
17150 :
17151 0 : if ((((LastQuadNo == 0) && (! (M2Pass_IsNoPass ()))) && (! (M2Pass_IsPassCodeGeneration ()))) || (! (Indexing_InBounds (QuadArray, QuadNo))))
17152 : {
17153 0 : return 0;
17154 : }
17155 : else
17156 : {
17157 0 : f = GetQF (QuadNo);
17158 0 : return f->LineNo;
17159 : }
17160 : /* static analysis guarentees a RETURN statement will be used before here. */
17161 : __builtin_unreachable ();
17162 : }
17163 :
17164 :
17165 : /*
17166 : GetQuad - returns the Quadruple QuadNo.
17167 : */
17168 :
17169 2672673946 : extern "C" void M2Quads_GetQuad (unsigned int QuadNo, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3)
17170 : {
17171 2672673946 : M2Quads_QuadFrame f;
17172 :
17173 2672673946 : f = GetQF (QuadNo);
17174 2672673946 : LastQuadNo = QuadNo;
17175 2672673946 : (*Op) = f->Operator;
17176 2672673946 : (*Oper1) = f->Operand1;
17177 2672673946 : (*Oper2) = f->Operand2;
17178 2672673946 : (*Oper3) = f->Operand3;
17179 2672673946 : }
17180 :
17181 :
17182 : /*
17183 : GetQuadOp - returns the operator for quad.
17184 : */
17185 :
17186 24 : extern "C" M2Quads_QuadOperator M2Quads_GetQuadOp (unsigned int quad)
17187 : {
17188 24 : M2Quads_QuadFrame f;
17189 :
17190 24 : f = GetQF (quad);
17191 24 : return f->Operator;
17192 : /* static analysis guarentees a RETURN statement will be used before here. */
17193 : __builtin_unreachable ();
17194 : }
17195 :
17196 :
17197 : /*
17198 : GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
17199 : (if possible). It returns NIL if no there is not an obvious match
17200 : in Modula-2. It is assummed that the string will be used during
17201 : construction of error messages and therefore keywords are
17202 : wrapped with a format specifier.
17203 : */
17204 :
17205 31 : extern "C" DynamicStrings_String M2Quads_GetM2OperatorDesc (M2Quads_QuadOperator op)
17206 : {
17207 31 : switch (op)
17208 : {
17209 6 : case M2Quads_NegateOp:
17210 6 : return DynamicStrings_InitString ((const char *) "-", 1);
17211 18 : break;
17212 :
17213 18 : case M2Quads_AddOp:
17214 18 : return DynamicStrings_InitString ((const char *) "+", 1);
17215 0 : break;
17216 :
17217 0 : case M2Quads_SubOp:
17218 0 : return DynamicStrings_InitString ((const char *) "-", 1);
17219 0 : break;
17220 :
17221 0 : case M2Quads_MultOp:
17222 0 : return DynamicStrings_InitString ((const char *) "*", 1);
17223 0 : break;
17224 :
17225 0 : case M2Quads_DivM2Op:
17226 0 : case M2Quads_DivCeilOp:
17227 0 : case M2Quads_DivFloorOp:
17228 0 : case M2Quads_DivTruncOp:
17229 0 : return DynamicStrings_InitString ((const char *) "{%kDIV}", 7);
17230 0 : break;
17231 :
17232 0 : case M2Quads_ModM2Op:
17233 0 : case M2Quads_ModCeilOp:
17234 0 : case M2Quads_ModFloorOp:
17235 0 : return DynamicStrings_InitString ((const char *) "{%kMOD}", 7);
17236 0 : break;
17237 :
17238 0 : case M2Quads_ModTruncOp:
17239 0 : return DynamicStrings_InitString ((const char *) "{%kREM}", 7);
17240 0 : break;
17241 :
17242 0 : case M2Quads_LogicalOrOp:
17243 0 : return DynamicStrings_InitString ((const char *) "{%kOR}", 6);
17244 0 : break;
17245 :
17246 0 : case M2Quads_LogicalAndOp:
17247 0 : return DynamicStrings_InitString ((const char *) "{%kAND}", 7);
17248 0 : break;
17249 :
17250 0 : case M2Quads_InclOp:
17251 0 : return DynamicStrings_InitString ((const char *) "{%kINCL}", 8);
17252 0 : break;
17253 :
17254 0 : case M2Quads_ExclOp:
17255 0 : return DynamicStrings_InitString ((const char *) "{%kEXCL}", 8);
17256 7 : break;
17257 :
17258 7 : case M2Quads_IfEquOp:
17259 7 : return DynamicStrings_InitString ((const char *) "=", 1);
17260 0 : break;
17261 :
17262 0 : case M2Quads_IfLessEquOp:
17263 0 : return DynamicStrings_InitString ((const char *) "<=", 2);
17264 0 : break;
17265 :
17266 0 : case M2Quads_IfGreEquOp:
17267 0 : return DynamicStrings_InitString ((const char *) ">=", 2);
17268 0 : break;
17269 :
17270 0 : case M2Quads_IfGreOp:
17271 0 : return DynamicStrings_InitString ((const char *) ">", 1);
17272 0 : break;
17273 :
17274 0 : case M2Quads_IfLessOp:
17275 0 : return DynamicStrings_InitString ((const char *) "<", 1);
17276 0 : break;
17277 :
17278 0 : case M2Quads_IfNotEquOp:
17279 0 : return DynamicStrings_InitString ((const char *) "#", 1);
17280 0 : break;
17281 :
17282 0 : case M2Quads_IfInOp:
17283 0 : return DynamicStrings_InitString ((const char *) "IN", 2);
17284 0 : break;
17285 :
17286 0 : case M2Quads_IfNotInOp:
17287 0 : return DynamicStrings_InitString ((const char *) "NOT IN", 6);
17288 : break;
17289 :
17290 :
17291 : default:
17292 : return static_cast<DynamicStrings_String> (NULL);
17293 : break;
17294 : }
17295 : /* static analysis guarentees a RETURN statement will be used before here. */
17296 : __builtin_unreachable ();
17297 : }
17298 :
17299 :
17300 : /*
17301 : GetQuadtok - returns the Quadruple QuadNo.
17302 : */
17303 :
17304 170248831 : extern "C" void M2Quads_GetQuadtok (unsigned int QuadNo, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos)
17305 : {
17306 170248831 : M2Quads_QuadFrame f;
17307 :
17308 170248831 : f = GetQF (QuadNo);
17309 170248831 : LastQuadNo = QuadNo;
17310 170248831 : (*Op) = f->Operator;
17311 170248831 : (*Oper1) = f->Operand1;
17312 170248831 : (*Oper2) = f->Operand2;
17313 170248831 : (*Oper3) = f->Operand3;
17314 170248831 : (*Op1Pos) = f->op1pos;
17315 170248831 : (*Op2Pos) = f->op2pos;
17316 170248831 : (*Op3Pos) = f->op3pos;
17317 170248831 : }
17318 :
17319 :
17320 : /*
17321 : GetQuadOtok - returns the Quadruple QuadNo.
17322 : */
17323 :
17324 6876015 : extern "C" void M2Quads_GetQuadOtok (unsigned int QuadNo, unsigned int *tok, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, bool *overflowChecking, bool *constExpr, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos)
17325 : {
17326 6876015 : M2Quads_QuadFrame f;
17327 :
17328 6876015 : f = GetQF (QuadNo);
17329 6876015 : LastQuadNo = QuadNo;
17330 6876015 : (*Op) = f->Operator;
17331 6876015 : (*Oper1) = f->Operand1;
17332 6876015 : (*Oper2) = f->Operand2;
17333 6876015 : (*Oper3) = f->Operand3;
17334 6876015 : (*Op1Pos) = f->op1pos;
17335 6876015 : (*Op2Pos) = f->op2pos;
17336 6876015 : (*Op3Pos) = f->op3pos;
17337 6876015 : (*tok) = f->TokenNo;
17338 6876015 : (*overflowChecking) = f->CheckOverflow;
17339 6876015 : (*constExpr) = f->ConstExpr;
17340 6876015 : }
17341 :
17342 :
17343 : /*
17344 : GetQuadOTypetok - returns the fields associated with quadruple QuadNo.
17345 : */
17346 :
17347 6244 : extern "C" void M2Quads_GetQuadOTypetok (unsigned int QuadNo, unsigned int *tok, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3, bool *overflowChecking, bool *typeChecking, bool *constExpr, unsigned int *Op1Pos, unsigned int *Op2Pos, unsigned int *Op3Pos)
17348 : {
17349 6244 : M2Quads_QuadFrame f;
17350 :
17351 6244 : f = GetQF (QuadNo);
17352 6244 : LastQuadNo = QuadNo;
17353 6244 : (*Op) = f->Operator;
17354 6244 : (*Oper1) = f->Operand1;
17355 6244 : (*Oper2) = f->Operand2;
17356 6244 : (*Oper3) = f->Operand3;
17357 6244 : (*Op1Pos) = f->op1pos;
17358 6244 : (*Op2Pos) = f->op2pos;
17359 6244 : (*Op3Pos) = f->op3pos;
17360 6244 : (*tok) = f->TokenNo;
17361 6244 : (*overflowChecking) = f->CheckOverflow;
17362 6244 : (*typeChecking) = f->CheckType;
17363 6244 : (*constExpr) = f->ConstExpr;
17364 6244 : }
17365 :
17366 :
17367 : /*
17368 : PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
17369 : sets a boolean to determinine whether overflow should be checked.
17370 : */
17371 :
17372 79263 : extern "C" void M2Quads_PutQuadOtok (unsigned int QuadNo, unsigned int tok, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflowChecking, bool constExpr, unsigned int Op1Pos, unsigned int Op2Pos, unsigned int Op3Pos)
17373 : {
17374 79263 : M2Quads_QuadFrame f;
17375 :
17376 79263 : if (QuadrupleGeneration)
17377 : {
17378 79263 : M2Quads_EraseQuad (QuadNo);
17379 79263 : AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3);
17380 79263 : f = GetQF (QuadNo);
17381 79263 : f->Operator = Op;
17382 79263 : f->Operand1 = Oper1;
17383 79263 : f->Operand2 = Oper2;
17384 79263 : f->Operand3 = Oper3;
17385 79263 : f->CheckOverflow = overflowChecking;
17386 79263 : f->op1pos = Op1Pos;
17387 79263 : f->op2pos = Op2Pos;
17388 79263 : f->op3pos = Op3Pos;
17389 79263 : f->TokenNo = tok;
17390 79263 : f->ConstExpr = constExpr;
17391 : }
17392 79263 : }
17393 :
17394 :
17395 : /*
17396 : PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
17397 : */
17398 :
17399 14405 : extern "C" void M2Quads_PutQuad (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
17400 : {
17401 14405 : PutQuadO (QuadNo, Op, Oper1, Oper2, Oper3, true);
17402 14405 : }
17403 :
17404 :
17405 : /*
17406 : GetFirstQuad - returns the first quadruple.
17407 : */
17408 :
17409 777680 : extern "C" unsigned int M2Quads_GetFirstQuad (void)
17410 : {
17411 777680 : return Head;
17412 : /* static analysis guarentees a RETURN statement will be used before here. */
17413 : __builtin_unreachable ();
17414 : }
17415 :
17416 :
17417 : /*
17418 : GetNextQuad - returns the Quadruple number following QuadNo.
17419 : */
17420 :
17421 3362073795 : extern "C" unsigned int M2Quads_GetNextQuad (unsigned int QuadNo)
17422 : {
17423 3362073795 : M2Quads_QuadFrame f;
17424 :
17425 3362073795 : f = GetQF (QuadNo);
17426 3362073795 : return f->Next;
17427 : /* static analysis guarentees a RETURN statement will be used before here. */
17428 : __builtin_unreachable ();
17429 : }
17430 :
17431 :
17432 : /*
17433 : GetRealQuad - returns the Quadruple number of the real quadruple
17434 : at QuadNo or beyond.
17435 : */
17436 :
17437 14842898 : extern "C" unsigned int M2Quads_GetRealQuad (unsigned int QuadNo)
17438 : {
17439 14842898 : M2Quads_QuadFrame f;
17440 :
17441 22485826 : while (QuadNo != 0)
17442 : {
17443 22485826 : if (Indexing_InBounds (QuadArray, QuadNo))
17444 : {
17445 22403947 : f = GetQF (QuadNo);
17446 22403947 : if ((((! (M2Quads_IsPseudoQuad (QuadNo))) && (f->Operator != M2Quads_DummyOp)) && (f->Operator != M2Quads_LineNumberOp)) && (f->Operator != M2Quads_StatementNoteOp))
17447 : {
17448 : return QuadNo;
17449 : }
17450 7642928 : QuadNo += 1;
17451 : }
17452 : else
17453 : {
17454 : return 0;
17455 : }
17456 : }
17457 : return 0;
17458 : /* static analysis guarentees a RETURN statement will be used before here. */
17459 : __builtin_unreachable ();
17460 : }
17461 :
17462 :
17463 : /*
17464 : SubQuad - subtracts a quadruple QuadNo from a list Head.
17465 : */
17466 :
17467 1876039 : extern "C" void M2Quads_SubQuad (unsigned int QuadNo)
17468 : {
17469 1876039 : unsigned int i;
17470 1876039 : M2Quads_QuadFrame f;
17471 1876039 : M2Quads_QuadFrame g;
17472 :
17473 1876039 : CheckBreak (QuadNo);
17474 1876039 : f = GetQF (QuadNo);
17475 1876039 : AlterReference (Head, QuadNo, f->Next);
17476 1876039 : UndoReadWriteInfo (QuadNo, f->Operator, f->Operand1, f->Operand2, f->Operand3);
17477 1876039 : if (Head == QuadNo)
17478 : {
17479 0 : Head = f->Next;
17480 : }
17481 : else
17482 : {
17483 1876039 : i = Head;
17484 1876039 : g = GetQF (i);
17485 5001017052 : while (g->Next != QuadNo)
17486 : {
17487 4997264974 : i = g->Next;
17488 4997264974 : g = GetQF (i);
17489 : }
17490 1876039 : g->Next = f->Next;
17491 : }
17492 1876039 : f->Operator = M2Quads_DummyOp;
17493 1876039 : NoOfQuads -= 1;
17494 1876039 : }
17495 :
17496 :
17497 : /*
17498 : EraseQuad - erases a quadruple QuadNo, the quadruple is still in the list
17499 : but wiped clean.
17500 : */
17501 :
17502 6212138 : extern "C" void M2Quads_EraseQuad (unsigned int QuadNo)
17503 : {
17504 6212138 : M2Quads_QuadFrame f;
17505 :
17506 6212138 : CheckBreak (QuadNo);
17507 6212138 : f = GetQF (QuadNo);
17508 6212138 : UndoReadWriteInfo (QuadNo, f->Operator, f->Operand1, f->Operand2, f->Operand3);
17509 6212138 : f->Operator = M2Quads_DummyOp; /* finally blank it out */
17510 6212138 : f->Operand1 = 0; /* finally blank it out */
17511 6212138 : f->Operand2 = 0;
17512 6212138 : f->Operand3 = 0;
17513 6212138 : f->Trash = 0;
17514 6212138 : f->op1pos = M2LexBuf_UnknownTokenNo;
17515 6212138 : f->op2pos = M2LexBuf_UnknownTokenNo;
17516 6212138 : f->op3pos = M2LexBuf_UnknownTokenNo;
17517 6212138 : f->ConstExpr = false;
17518 6212138 : }
17519 :
17520 :
17521 : /*
17522 : CountQuads - returns the number of quadruples.
17523 : */
17524 :
17525 8959723 : extern "C" unsigned int M2Quads_CountQuads (void)
17526 : {
17527 8959723 : return NoOfQuads;
17528 : /* static analysis guarentees a RETURN statement will be used before here. */
17529 : __builtin_unreachable ();
17530 : }
17531 :
17532 :
17533 : /*
17534 : BuildScaffold - generate the main, init, finish functions if
17535 : no -c and this is the application module.
17536 : */
17537 :
17538 15105 : extern "C" void M2Quads_BuildScaffold (unsigned int tok, unsigned int moduleSym)
17539 : {
17540 15105 : if ((SymbolTable_GetMainModule ()) == moduleSym)
17541 : {
17542 14577 : M2Scaffold_DeclareScaffold (tok);
17543 14577 : if (M2Options_ScaffoldMain || ! M2Options_cflag)
17544 : {
17545 : /* There are module init/fini functions and
17546 : application init/fini functions.
17547 : Here we create the application pair. */
17548 2723 : BuildM2LinkFunction (tok);
17549 2723 : BuildM2MainFunction (tok);
17550 2723 : BuildM2InitFunction (tok, moduleSym); /* Application init. */
17551 2723 : BuildM2FiniFunction (tok, moduleSym); /* Application fini. */
17552 : }
17553 : /* Application fini. */
17554 14577 : BuildM2DepFunction (tok, moduleSym); /* Per module dependency. */
17555 : /* Each module needs a ctor to register the module
17556 : init/finish/dep with M2RTS. */
17557 14577 : BuildM2CtorFunction (tok, moduleSym);
17558 : }
17559 528 : else if (M2Options_WholeProgram)
17560 : {
17561 : /* avoid dangling else. */
17562 528 : M2Scaffold_DeclareScaffold (tok);
17563 528 : BuildM2DepFunction (tok, moduleSym); /* Per module dependency. */
17564 : /* Each module needs a ctor to register the module
17565 : init/finish/dep with M2RTS. */
17566 528 : BuildM2CtorFunction (tok, moduleSym);
17567 : }
17568 15105 : }
17569 :
17570 :
17571 : /*
17572 : StartBuildDefFile - generates a StartFileDefOp quadruple indicating the file
17573 : that has produced the subsequent quadruples.
17574 : The code generator uses the StartDefFileOp quadruples
17575 : to relate any error to the appropriate file.
17576 :
17577 :
17578 : Entry Exit
17579 : ===== ====
17580 :
17581 :
17582 : Ptr -> <- Ptr
17583 : +------------+ +------------+
17584 : | ModuleName | | ModuleName |
17585 : |------------| |------------|
17586 :
17587 :
17588 : Quadruples Produced
17589 :
17590 : q StartDefFileOp _ _ ModuleSym
17591 : */
17592 :
17593 160176 : extern "C" void M2Quads_StartBuildDefFile (unsigned int tok)
17594 : {
17595 160176 : NameKey_Name ModuleName;
17596 :
17597 160176 : M2Quads_PopT (&ModuleName);
17598 160176 : M2Quads_PushT (ModuleName);
17599 160176 : GenQuadO (tok, M2Quads_StartDefFileOp, tok, SymbolTable_NulSym, SymbolTable_GetModule (ModuleName), false);
17600 160176 : }
17601 :
17602 :
17603 : /*
17604 : StartBuildModFile - generates a StartModFileOp quadruple indicating the file
17605 : that has produced the subsequent quadruples.
17606 : The code generator uses the StartModFileOp quadruples
17607 : to relate any error to the appropriate file.
17608 :
17609 :
17610 : Entry Exit
17611 : ===== ====
17612 :
17613 :
17614 : Ptr -> <- Ptr
17615 : +------------+ +------------+
17616 : | ModuleName | | ModuleName |
17617 : |------------| |------------|
17618 :
17619 :
17620 : Quadruples Produced
17621 :
17622 : q StartModFileOp lineno filename ModuleSym
17623 : */
17624 :
17625 82311 : extern "C" void M2Quads_StartBuildModFile (unsigned int tok)
17626 : {
17627 82311 : GenQuadO (tok, M2Quads_StartModFileOp, tok, (unsigned int ) (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()))), SymbolTable_GetFileModule (), false);
17628 82311 : }
17629 :
17630 :
17631 : /*
17632 : EndBuildFile - generates an EndFileOp quadruple indicating the file
17633 : that has produced the previous quadruples has ended.
17634 :
17635 : Entry Exit
17636 : ===== ====
17637 :
17638 :
17639 : Ptr -> <- Ptr
17640 : +------------+ +------------+
17641 : | ModuleName | | ModuleName |
17642 : |------------| |------------|
17643 :
17644 :
17645 : Quadruples Produced
17646 :
17647 : q EndFileOp _ _ ModuleSym
17648 : */
17649 :
17650 242273 : extern "C" void M2Quads_EndBuildFile (unsigned int tok)
17651 : {
17652 242273 : NameKey_Name ModuleName;
17653 :
17654 242273 : ModuleName = static_cast<NameKey_Name> (M2Quads_OperandT (1));
17655 242273 : GenQuadO (tok, M2Quads_EndFileOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_GetModule (ModuleName), false);
17656 242273 : }
17657 :
17658 :
17659 : /*
17660 : StartBuildInit - Sets the start of initialization code of the
17661 : current module to the next quadruple.
17662 : */
17663 :
17664 82677 : extern "C" void M2Quads_StartBuildInit (unsigned int tok)
17665 : {
17666 82677 : NameKey_Name name;
17667 82677 : unsigned int ModuleSym;
17668 :
17669 82677 : M2Quads_PopT (&name);
17670 82677 : ModuleSym = SymbolTable_GetCurrentModule ();
17671 165354 : M2Debug_Assert ((SymbolTable_IsModule (ModuleSym)) || (SymbolTable_IsDefImp (ModuleSym)));
17672 82677 : M2Debug_Assert ((SymbolTable_GetSymName (ModuleSym)) == name);
17673 82671 : SymbolTable_PutModuleStartQuad (ModuleSym, NextQuad);
17674 82671 : GenQuad (M2Quads_InitStartOp, tok, SymbolTable_GetFileModule (), ModuleSym);
17675 82671 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17676 82671 : M2Quads_PushT (name);
17677 82671 : CheckVariablesAt (ModuleSym);
17678 82671 : CheckNeedPriorityBegin (tok, ModuleSym, ModuleSym);
17679 82671 : M2StackWord_PushWord (TryStack, NextQuad);
17680 82671 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17681 82671 : if (SymbolTable_HasExceptionBlock (ModuleSym))
17682 : {
17683 54 : GenQuad (M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
17684 : }
17685 82671 : }
17686 :
17687 :
17688 : /*
17689 : EndBuildInit - Sets the end initialization code of a module.
17690 : */
17691 :
17692 82523 : extern "C" void M2Quads_EndBuildInit (unsigned int tok)
17693 : {
17694 82523 : if (SymbolTable_HasExceptionBlock (SymbolTable_GetCurrentModule ()))
17695 : {
17696 54 : BuildRTExceptLeave (tok, true);
17697 54 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17698 : }
17699 82523 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17700 82523 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17701 82523 : SymbolTable_PutModuleEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17702 82523 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17703 82523 : GenQuadO (tok, M2Quads_InitEndOp, tok, SymbolTable_GetFileModule (), SymbolTable_GetCurrentModule (), false);
17704 82523 : }
17705 :
17706 :
17707 : /*
17708 : StartBuildFinally - Sets the start of finalization code of the
17709 : current module to the next quadruple.
17710 : */
17711 :
17712 15317 : extern "C" void M2Quads_StartBuildFinally (unsigned int tok)
17713 : {
17714 15317 : NameKey_Name name;
17715 15317 : unsigned int ModuleSym;
17716 :
17717 15317 : M2Quads_PopT (&name);
17718 15311 : ModuleSym = SymbolTable_GetCurrentModule ();
17719 30622 : M2Debug_Assert ((SymbolTable_IsModule (ModuleSym)) || (SymbolTable_IsDefImp (ModuleSym)));
17720 15311 : M2Debug_Assert ((SymbolTable_GetSymName (ModuleSym)) == name);
17721 15311 : SymbolTable_PutModuleFinallyStartQuad (ModuleSym, NextQuad);
17722 15311 : GenQuadO (tok, M2Quads_FinallyStartOp, tok, SymbolTable_GetFileModule (), ModuleSym, false);
17723 15311 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17724 15311 : M2Quads_PushT (name);
17725 : /* CheckVariablesAt(ModuleSym) ; */
17726 15311 : CheckNeedPriorityBegin (tok, ModuleSym, ModuleSym);
17727 15311 : M2StackWord_PushWord (TryStack, NextQuad);
17728 15311 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17729 15311 : if (SymbolTable_HasExceptionFinally (ModuleSym))
17730 : {
17731 0 : GenQuadO (tok, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
17732 : }
17733 15311 : }
17734 :
17735 :
17736 : /*
17737 : EndBuildFinally - Sets the end finalization code of a module.
17738 : */
17739 :
17740 15311 : extern "C" void M2Quads_EndBuildFinally (unsigned int tok)
17741 : {
17742 15311 : if (SymbolTable_HasExceptionFinally (SymbolTable_GetCurrentModule ()))
17743 : {
17744 0 : BuildRTExceptLeave (tok, true);
17745 0 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17746 : }
17747 15311 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17748 15311 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17749 15311 : SymbolTable_PutModuleFinallyEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17750 15311 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17751 15311 : GenQuadO (tok, M2Quads_FinallyEndOp, tok, SymbolTable_GetFileModule (), SymbolTable_GetCurrentModule (), false);
17752 15311 : }
17753 :
17754 :
17755 : /*
17756 : BuildExceptInitial - adds an CatchBeginOp, CatchEndOp quadruple
17757 : in the current block.
17758 : */
17759 :
17760 2909 : extern "C" void M2Quads_BuildExceptInitial (unsigned int tok)
17761 : {
17762 2909 : unsigned int previous;
17763 :
17764 : /* we have finished the 'try' block, so now goto the return
17765 : section which will tidy up (any) priorities before returning.
17766 : */
17767 2909 : GenQuadO (tok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PopWord (ReturnStack), false);
17768 2909 : M2StackWord_PushWord (ReturnStack, NextQuad-1);
17769 : /*
17770 : this is the 'catch' block.
17771 : */
17772 2909 : BackPatch (M2StackWord_PeepWord (TryStack, 1), NextQuad);
17773 2909 : GenQuadO (tok, M2Quads_CatchBeginOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17774 2909 : previous = static_cast<unsigned int> (M2StackWord_PopWord (CatchStack));
17775 2909 : if (previous != 0)
17776 : {
17777 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}only allowed one EXCEPT statement in a procedure or module", 62);
17778 : }
17779 2909 : M2StackWord_PushWord (CatchStack, NextQuad-1);
17780 2909 : BuildRTExceptEnter (tok);
17781 2909 : }
17782 :
17783 :
17784 : /*
17785 : BuildExceptFinally - adds an ExceptOp quadruple in a modules
17786 : finally block.
17787 : */
17788 :
17789 0 : extern "C" void M2Quads_BuildExceptFinally (unsigned int tok)
17790 : {
17791 0 : M2Quads_BuildExceptInitial (tok);
17792 0 : }
17793 :
17794 :
17795 : /*
17796 : BuildExceptProcedure - adds an ExceptOp quadruple in a procedure
17797 : block.
17798 : */
17799 :
17800 168 : extern "C" void M2Quads_BuildExceptProcedure (unsigned int tok)
17801 : {
17802 168 : M2Quads_BuildExceptInitial (tok);
17803 168 : }
17804 :
17805 :
17806 : /*
17807 : BuildRetry - adds an RetryOp quadruple.
17808 : */
17809 :
17810 168 : extern "C" void M2Quads_BuildRetry (unsigned int tok)
17811 : {
17812 168 : if ((M2StackWord_PeepWord (CatchStack, 1)) == 0)
17813 : {
17814 6 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}the {%kRETRY} statement must occur after an {%kEXCEPT} statement in the same module or procedure block", 106);
17815 : }
17816 : else
17817 : {
17818 162 : BuildRTExceptLeave (tok, false);
17819 162 : GenQuadO (tok, M2Quads_RetryOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PeepWord (TryStack, 1), false);
17820 : }
17821 168 : }
17822 :
17823 :
17824 : /*
17825 : BuildReThrow - creates a ThrowOp _ _ NulSym, indicating that
17826 : the exception needs to be rethrown. The stack
17827 : is unaltered.
17828 : */
17829 :
17830 222 : extern "C" void M2Quads_BuildReThrow (unsigned int tokenno)
17831 : {
17832 222 : GenQuadO (tokenno, M2Quads_ThrowOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17833 222 : }
17834 :
17835 :
17836 : /*
17837 : StartBuildInnerInit - Sets the start of initialization code of the
17838 : inner module to the next quadruple.
17839 : */
17840 :
17841 0 : extern "C" void M2Quads_StartBuildInnerInit (unsigned int tok)
17842 : {
17843 0 : SymbolTable_PutModuleStartQuad (SymbolTable_GetCurrentModule (), NextQuad);
17844 0 : GenQuadO (tok, M2Quads_InitStartOp, tok, SymbolTable_NulSym, SymbolTable_GetCurrentModule (), false);
17845 0 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17846 0 : CheckNeedPriorityBegin (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17847 0 : M2StackWord_PushWord (TryStack, NextQuad);
17848 0 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17849 0 : if (SymbolTable_HasExceptionFinally (SymbolTable_GetCurrentModule ()))
17850 : {
17851 0 : GenQuadO (tok, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
17852 : }
17853 0 : }
17854 :
17855 :
17856 : /*
17857 : EndBuildInnerInit - Sets the end initialization code of a module.
17858 : */
17859 :
17860 0 : extern "C" void M2Quads_EndBuildInnerInit (unsigned int tok)
17861 : {
17862 0 : if (SymbolTable_HasExceptionBlock (SymbolTable_GetCurrentModule ()))
17863 : {
17864 0 : BuildRTExceptLeave (tok, true);
17865 0 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17866 : }
17867 0 : SymbolTable_PutModuleEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17868 0 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17869 0 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17870 0 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17871 0 : GenQuadO (tok, M2Quads_InitEndOp, tok, SymbolTable_NulSym, SymbolTable_GetCurrentModule (), false);
17872 0 : }
17873 :
17874 :
17875 : /*
17876 : BuildBuiltinConst - makes reference to a builtin constant within gm2.
17877 :
17878 : Entry Exit
17879 :
17880 : Ptr ->
17881 : +------------+ +------------+
17882 : | Ident | | Sym |
17883 : |------------| |------------|
17884 :
17885 : Quadruple produced:
17886 :
17887 : q Sym BuiltinConstOp Ident
17888 : */
17889 :
17890 28794 : extern "C" void M2Quads_BuildBuiltinConst (void)
17891 : {
17892 28794 : unsigned int idtok;
17893 28794 : unsigned int Id;
17894 28794 : unsigned int Sym;
17895 :
17896 28794 : M2Quads_PopTtok (&Id, &idtok);
17897 28794 : Sym = SymbolTable_MakeTemporary (idtok, SymbolTable_ImmediateValue);
17898 28794 : SymbolTable_PutVar (Sym, M2Base_Integer);
17899 : /*
17900 : CASE GetBuiltinConstType(KeyToCharStar(Name(Id))) OF
17901 :
17902 : 0: ErrorFormat1(NewError(GetTokenNo()),
17903 : '%a unrecognised builtin constant', Id) |
17904 : 1: PutVar(Sym, Integer) |
17905 : 2: PutVar(Sym, Real)
17906 :
17907 : ELSE
17908 : InternalError ('unrecognised value')
17909 : END ;
17910 : */
17911 28794 : GenQuadO (idtok, M2Quads_BuiltinConstOp, Sym, SymbolTable_NulSym, Id, false);
17912 28794 : M2Quads_PushTtok (Sym, idtok);
17913 28794 : }
17914 :
17915 :
17916 : /*
17917 : BuildBuiltinTypeInfo - make reference to a builtin typeinfo function
17918 : within gm2.
17919 :
17920 : Entry Exit
17921 :
17922 : Ptr ->
17923 : +-------------+
17924 : | Type |
17925 : |-------------| +------------+
17926 : | Ident | | Sym |
17927 : |-------------| |------------|
17928 :
17929 : Quadruple produced:
17930 :
17931 : q Sym BuiltinTypeInfoOp Type Ident
17932 : */
17933 :
17934 360 : extern "C" void M2Quads_BuildBuiltinTypeInfo (void)
17935 : {
17936 360 : unsigned int idtok;
17937 360 : unsigned int Ident;
17938 360 : unsigned int Type;
17939 360 : unsigned int Sym;
17940 :
17941 360 : M2Quads_PopTtok (&Ident, &idtok);
17942 360 : M2Quads_PopT (&Type);
17943 360 : Sym = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
17944 360 : switch (m2builtins_GetBuiltinTypeInfoType (const_cast <const char * > (static_cast <char * > (NameKey_KeyToCharStar ((NameKey_Name) (Ident))))))
17945 : {
17946 0 : case 0:
17947 0 : M2Error_ErrorFormat1 (M2Error_NewError (idtok), (const char *) "%a unrecognised builtin constant", 32, (const unsigned char *) &Ident, (sizeof (Ident)-1));
17948 0 : break;
17949 :
17950 192 : case 1:
17951 192 : SymbolTable_PutVar (Sym, M2Base_Boolean);
17952 192 : break;
17953 :
17954 120 : case 2:
17955 120 : SymbolTable_PutVar (Sym, M2Base_ZType);
17956 120 : break;
17957 :
17958 48 : case 3:
17959 48 : SymbolTable_PutVar (Sym, M2Base_RType);
17960 48 : break;
17961 :
17962 :
17963 0 : default:
17964 0 : M2Error_InternalError ((const char *) "unrecognised value", 18);
17965 360 : break;
17966 : }
17967 360 : GenQuadO (idtok, M2Quads_BuiltinTypeInfoOp, Sym, Type, Ident, false);
17968 360 : M2Quads_PushTtok (Sym, idtok);
17969 360 : }
17970 :
17971 :
17972 : /*
17973 : BuildAssignment - Builds an assignment from the values given on the
17974 : quad stack. Either an assignment to an
17975 : arithmetic expression or an assignment to a
17976 : boolean expression. This procedure should not
17977 : be called in CONST declarations.
17978 : The Stack is expected to contain:
17979 :
17980 :
17981 : Either
17982 :
17983 : Entry Exit
17984 : ===== ====
17985 :
17986 : Ptr ->
17987 : +------------+
17988 : | Expression |
17989 : |------------|
17990 : | Designator |
17991 : |------------| +------------+
17992 : | | | | <- Ptr
17993 : |------------| |------------|
17994 :
17995 :
17996 : Quadruples Produced
17997 :
17998 : q BecomesOp Designator _ Expression
17999 :
18000 : OR
18001 :
18002 : Entry Exit
18003 : ===== ====
18004 :
18005 : Ptr ->
18006 : +------------+
18007 : | True |False|
18008 : |------------|
18009 : | Designator |
18010 : |------------| +------------+
18011 : | | | | <- Ptr
18012 : |------------| |------------|
18013 :
18014 :
18015 : Quadruples Produced
18016 :
18017 : q BecomesOp Designator _ TRUE
18018 : q+1 GotoOp q+3
18019 : q+2 BecomesOp Designator _ FALSE
18020 :
18021 : */
18022 :
18023 124888 : extern "C" void M2Quads_BuildAssignment (unsigned int becomesTokNo)
18024 : {
18025 124888 : unsigned int des;
18026 124888 : unsigned int exp;
18027 124888 : unsigned int destok;
18028 124888 : unsigned int exptok;
18029 124888 : unsigned int combinedtok;
18030 :
18031 124888 : des = static_cast<unsigned int> (M2Quads_OperandT (2));
18032 124888 : if (IsReadOnly (des))
18033 : {
18034 36 : destok = static_cast<unsigned int> (M2Quads_OperandTok (2));
18035 36 : exptok = static_cast<unsigned int> (M2Quads_OperandTok (1));
18036 36 : exp = static_cast<unsigned int> (M2Quads_OperandT (1));
18037 36 : if (DebugTokPos)
18038 : {
18039 : M2MetaError_MetaErrorT1 (destok, (const char *) "destok {%1Ead}", 14, des);
18040 : M2MetaError_MetaErrorT1 (exptok, (const char *) "exptok {%1Ead}", 14, exp);
18041 : }
18042 36 : combinedtok = M2LexBuf_MakeVirtualTok (becomesTokNo, destok, exptok);
18043 36 : if (DebugTokPos)
18044 : {
18045 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "combined {%1Ead}", 16, des);
18046 : }
18047 36 : if (IsBoolean (1))
18048 : {
18049 0 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "cannot assign expression to a constant designator {%1Ead}", 57, des);
18050 : }
18051 : else
18052 : {
18053 36 : exp = static_cast<unsigned int> (M2Quads_OperandT (1));
18054 36 : M2MetaError_MetaErrorT2 (combinedtok, (const char *) "cannot assign a constant designator {%1Ead} with an expression {%2Ead}", 70, des, exp);
18055 : }
18056 36 : M2Quads_PopN (2); /* Remove both parameters. */
18057 : }
18058 124852 : else if (SymbolTable_IsError (des))
18059 : {
18060 : /* avoid dangling else. */
18061 25 : M2Quads_PopN (2); /* Remove both parameters. */
18062 : }
18063 : else
18064 : {
18065 : /* avoid dangling else. */
18066 124827 : doBuildAssignment (becomesTokNo, true, true);
18067 : }
18068 124882 : }
18069 :
18070 :
18071 : /*
18072 : BuildAssignConstant - used to create constant in the CONST declaration.
18073 : The stack is expected to contain:
18074 :
18075 : Either
18076 :
18077 : Entry Exit
18078 : ===== ====
18079 :
18080 : Ptr ->
18081 : +------------+
18082 : | Expression |
18083 : |------------|
18084 : | Designator |
18085 : |------------| +------------+
18086 : | | | | <- Ptr
18087 : |------------| |------------|
18088 :
18089 :
18090 : Quadruples Produced
18091 :
18092 : q BecomesOp Designator _ Expression
18093 :
18094 : OR
18095 :
18096 : Entry Exit
18097 : ===== ====
18098 :
18099 : Ptr ->
18100 : +------------+
18101 : | True |False|
18102 : |------------|
18103 : | Designator |
18104 : |------------| +------------+
18105 : | | | | <- Ptr
18106 : |------------| |------------|
18107 :
18108 :
18109 : Quadruples Produced
18110 :
18111 : q BecomesOp Designator _ TRUE
18112 : q+1 GotoOp q+3
18113 : q+2 BecomesOp Designator _ FALSE
18114 : */
18115 :
18116 291685 : extern "C" void M2Quads_BuildAssignConstant (unsigned int equalsTokNo)
18117 : {
18118 291685 : doBuildAssignment (equalsTokNo, true, true);
18119 291685 : }
18120 :
18121 :
18122 : /*
18123 : BuildAlignment - builds an assignment to an alignment constant.
18124 :
18125 : The Stack is expected to contain:
18126 :
18127 :
18128 : Entry Exit
18129 : ===== ====
18130 :
18131 : Ptr ->
18132 : +---------------+
18133 : | Expression |
18134 : |---------------|
18135 : | bytealignment |
18136 : |---------------| empty
18137 : */
18138 :
18139 72 : extern "C" void M2Quads_BuildAlignment (unsigned int tokno)
18140 : {
18141 72 : NameKey_Name name;
18142 72 : unsigned int expr;
18143 72 : unsigned int align;
18144 :
18145 72 : M2Quads_PopT (&expr);
18146 72 : M2Quads_PopT (&name);
18147 72 : if (name != (NameKey_MakeKey ((const char *) "bytealignment", 13)))
18148 : {
18149 0 : M2MetaError_MetaError1 ((const char *) "expecting bytealignment identifier, rather than {%1Ea}", 54, SymbolTable_MakeError (tokno, name));
18150 : }
18151 72 : FifoQueue_GetConstFromFifoQueue (&align);
18152 72 : M2Quads_PushT (align);
18153 72 : M2Quads_PushT (expr);
18154 72 : M2Quads_BuildAssignConstant (tokno);
18155 72 : }
18156 :
18157 :
18158 : /*
18159 : BuildBitLength - builds an assignment to a bit length constant.
18160 :
18161 : The Stack is expected to contain:
18162 :
18163 :
18164 : Entry Exit
18165 : ===== ====
18166 :
18167 : Ptr ->
18168 : +------------+
18169 : | Expression |
18170 : |------------| empty
18171 : */
18172 :
18173 0 : extern "C" void M2Quads_BuildBitLength (unsigned int tokno)
18174 : {
18175 0 : unsigned int expr;
18176 0 : unsigned int length;
18177 :
18178 0 : M2Quads_PopT (&expr);
18179 0 : FifoQueue_GetConstFromFifoQueue (&length);
18180 0 : M2Quads_PushT (length);
18181 0 : M2Quads_PushT (expr);
18182 0 : M2Quads_BuildAssignConstant (tokno);
18183 0 : }
18184 :
18185 :
18186 : /*
18187 : BuildPragmaField - builds an assignment to an alignment constant.
18188 :
18189 : The Stack is expected to contain:
18190 :
18191 :
18192 : Entry Exit
18193 : ===== ====
18194 :
18195 : Ptr ->
18196 : +------------+
18197 : | Expression |
18198 : |------------| empty
18199 : */
18200 :
18201 12 : extern "C" void M2Quads_BuildPragmaField (void)
18202 : {
18203 12 : unsigned int expr;
18204 12 : unsigned int const_;
18205 12 : NameKey_Name name;
18206 :
18207 12 : M2Quads_PopT (&expr);
18208 12 : M2Quads_PopT (&name);
18209 12 : if ((name != (NameKey_MakeKey ((const char *) "unused", 6))) && (name != (NameKey_MakeKey ((const char *) "bytealignment", 13))))
18210 : {
18211 0 : M2MetaError_MetaError0 ((const char *) "only allowed to use the attribute {%Ekbytealignment} in the default record field alignment pragma", 97);
18212 : }
18213 12 : if (expr != SymbolTable_NulSym)
18214 : {
18215 12 : FifoQueue_GetConstFromFifoQueue (&const_);
18216 12 : M2Quads_PushT (const_);
18217 12 : M2Quads_PushT (expr);
18218 12 : M2Quads_BuildAssignConstant (M2LexBuf_GetTokenNo ());
18219 : }
18220 12 : }
18221 :
18222 :
18223 : /*
18224 : BuildDefaultFieldAlignment - builds an assignment to an alignment constant.
18225 :
18226 : The Stack is expected to contain:
18227 :
18228 :
18229 : Entry Exit
18230 : ===== ====
18231 :
18232 : Ptr ->
18233 : +------------+
18234 : | Expression |
18235 : |------------| empty
18236 : */
18237 :
18238 36 : extern "C" void M2Quads_BuildDefaultFieldAlignment (void)
18239 : {
18240 36 : unsigned int expr;
18241 36 : unsigned int align;
18242 36 : NameKey_Name name;
18243 :
18244 36 : M2Quads_PopT (&expr);
18245 36 : M2Quads_PopT (&name);
18246 36 : if (name != (NameKey_MakeKey ((const char *) "bytealignment", 13)))
18247 : {
18248 0 : M2MetaError_MetaError0 ((const char *) "{%E}only allowed to use the attribute {%kbytealignment} in the default record field alignment pragma", 100);
18249 : }
18250 36 : FifoQueue_GetConstFromFifoQueue (&align);
18251 36 : M2Quads_PushT (align);
18252 36 : M2Quads_PushT (expr);
18253 36 : M2Quads_BuildAssignConstant (M2LexBuf_GetTokenNo ());
18254 36 : }
18255 :
18256 :
18257 : /*
18258 : BuildRepeat - Builds the repeat statement from the quad stack.
18259 : The Stack is expected to contain:
18260 :
18261 :
18262 : Entry Exit
18263 : ===== ====
18264 :
18265 :
18266 : Empty
18267 : <- Ptr
18268 : +------------+
18269 : | RepeatQuad |
18270 : |------------|
18271 :
18272 : */
18273 :
18274 1340 : extern "C" void M2Quads_BuildRepeat (void)
18275 : {
18276 1340 : M2Quads_PushT (NextQuad);
18277 1340 : }
18278 :
18279 :
18280 : /*
18281 : BuildUntil - Builds the until part of the repeat statement
18282 : from the quad stack.
18283 : The Stack is expected to contain:
18284 :
18285 :
18286 : Entry Exit
18287 : ===== ====
18288 :
18289 : Ptr ->
18290 : +------------+
18291 : | t | f |
18292 : |------------|
18293 : | RepeatQuad | Empty
18294 : |------------|
18295 : */
18296 :
18297 1340 : extern "C" void M2Quads_BuildUntil (void)
18298 : {
18299 1340 : unsigned int t;
18300 1340 : unsigned int f;
18301 1340 : unsigned int Repeat;
18302 :
18303 1340 : CheckBooleanId ();
18304 1340 : PopBool (&t, &f);
18305 1340 : M2Quads_PopT (&Repeat);
18306 1340 : BackPatch (f, Repeat); /* If False then keep on repeating */
18307 1340 : BackPatch (t, NextQuad); /* If True then exit repeat */
18308 1340 : }
18309 :
18310 :
18311 : /*
18312 : BuildWhile - Builds the While part of the While statement
18313 : from the quad stack.
18314 : The Stack is expected to contain:
18315 :
18316 :
18317 : Entry Exit
18318 : ===== ====
18319 :
18320 : <- Ptr
18321 : |------------|
18322 : Empty | WhileQuad |
18323 : |------------|
18324 : */
18325 :
18326 7408 : extern "C" void M2Quads_BuildWhile (void)
18327 : {
18328 7408 : M2Quads_PushT (NextQuad);
18329 7408 : }
18330 :
18331 :
18332 : /*
18333 : BuildDoWhile - Builds the Do part of the while statement
18334 : from the quad stack.
18335 : The Stack is expected to contain:
18336 :
18337 :
18338 : Entry Exit
18339 : ===== ====
18340 :
18341 : Ptr ->
18342 : +------------+ +------------+
18343 : | t | f | | 0 | f |
18344 : |------------| |------------|
18345 : | WhileQuad | | WhileQuad |
18346 : |------------| |------------|
18347 :
18348 : Quadruples
18349 :
18350 : BackPatch t exit to the NextQuad
18351 : */
18352 :
18353 7408 : extern "C" void M2Quads_BuildDoWhile (void)
18354 : {
18355 7408 : unsigned int t;
18356 7408 : unsigned int f;
18357 :
18358 7408 : CheckBooleanId ();
18359 7408 : PopBool (&t, &f);
18360 7408 : BackPatch (t, NextQuad);
18361 7408 : PushBool (0, f);
18362 7408 : }
18363 :
18364 :
18365 : /*
18366 : BuildEndWhile - Builds the end part of the while statement
18367 : from the quad stack.
18368 : The Stack is expected to contain:
18369 :
18370 :
18371 : Entry Exit
18372 : ===== ====
18373 :
18374 : Ptr ->
18375 : +------------+
18376 : | t | f |
18377 : |------------|
18378 : | WhileQuad | Empty
18379 : |------------|
18380 :
18381 : Quadruples
18382 :
18383 : q GotoOp WhileQuad
18384 : False exit is backpatched with q+1
18385 : */
18386 :
18387 7408 : extern "C" void M2Quads_BuildEndWhile (int reltokpos)
18388 : {
18389 7408 : unsigned int tok;
18390 7408 : unsigned int While;
18391 7408 : unsigned int t;
18392 7408 : unsigned int f;
18393 :
18394 7408 : tok = M2LexBuf_GetTokenNo ();
18395 7408 : tok = ((int ) (tok))+reltokpos;
18396 7408 : PopBool (&t, &f);
18397 7408 : M2Debug_Assert (t == 0);
18398 7408 : M2Quads_PopT (&While);
18399 7408 : GenQuadO (tok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, While, false);
18400 7408 : BackPatch (f, NextQuad);
18401 7408 : }
18402 :
18403 :
18404 : /*
18405 : BuildLoop - Builds the Loop part of the Loop statement
18406 : from the quad stack.
18407 : The Stack is expected to contain:
18408 :
18409 :
18410 : Entry Exit
18411 : ===== ====
18412 :
18413 : <- Ptr
18414 : Empty +------------+
18415 : | LoopQuad |
18416 : |------------|
18417 : */
18418 :
18419 502 : extern "C" void M2Quads_BuildLoop (void)
18420 : {
18421 502 : M2Quads_PushT (NextQuad);
18422 502 : PushExit (0); /* Seperate Exit Stack for loop end */
18423 502 : }
18424 :
18425 :
18426 : /*
18427 : BuildExit - Builds the Exit part of the Loop statement.
18428 : */
18429 :
18430 94 : extern "C" void M2Quads_BuildExit (void)
18431 : {
18432 94 : if (M2StackWord_IsEmptyWord (ExitStack))
18433 : {
18434 0 : M2MetaError_MetaError0 ((const char *) "{%EkEXIT} is only allowed in a {%kLOOP} statement", 49);
18435 : }
18436 : else
18437 : {
18438 94 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18439 94 : PushExit (Merge (PopExit (), NextQuad-1));
18440 : }
18441 94 : }
18442 :
18443 :
18444 : /*
18445 : BuildEndLoop - Builds the End part of the Loop statement
18446 : from the quad stack.
18447 : The Stack is expected to contain:
18448 :
18449 :
18450 : Entry Exit
18451 : ===== ====
18452 :
18453 : Ptr ->
18454 : +------------+
18455 : | LoopQuad | Empty
18456 : |------------|
18457 :
18458 : Quadruples
18459 :
18460 : Goto _ _ LoopQuad
18461 : */
18462 :
18463 502 : extern "C" void M2Quads_BuildEndLoop (void)
18464 : {
18465 502 : unsigned int Loop;
18466 :
18467 502 : M2Quads_PopT (&Loop);
18468 502 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, Loop);
18469 502 : BackPatch (PopExit (), NextQuad);
18470 502 : }
18471 :
18472 :
18473 : /*
18474 : BuildThenIf - Builds the Then part of the If statement
18475 : from the quad stack.
18476 : The Stack is expected to contain:
18477 :
18478 :
18479 : Entry Exit
18480 : ===== ====
18481 :
18482 : Ptr -> <- Ptr
18483 : +------------+ +------------+
18484 : | t | f | | 0 | f |
18485 : |------------| |------------|
18486 :
18487 : Quadruples
18488 :
18489 : The true exit is BackPatched to point to
18490 : the NextQuad.
18491 : */
18492 :
18493 43620 : extern "C" void M2Quads_BuildThenIf (void)
18494 : {
18495 43620 : unsigned int t;
18496 43620 : unsigned int f;
18497 :
18498 43620 : CheckBooleanId ();
18499 43620 : PopBool (&t, &f);
18500 43620 : BackPatch (t, NextQuad);
18501 43620 : PushBool (0, f);
18502 43620 : }
18503 :
18504 :
18505 : /*
18506 : BuildElse - Builds the Else part of the If statement
18507 : from the quad stack.
18508 : The Stack is expected to contain:
18509 :
18510 :
18511 : Entry Exit
18512 : ===== ====
18513 :
18514 : Ptr ->
18515 : +------------+ +------------+
18516 : | t | f | | t+q | 0 |
18517 : |------------| |------------|
18518 :
18519 : Quadruples
18520 :
18521 : q GotoOp _ _ 0
18522 : q+1 <- BackPatched from f
18523 : */
18524 :
18525 14842 : extern "C" void M2Quads_BuildElse (void)
18526 : {
18527 14842 : unsigned int t;
18528 14842 : unsigned int f;
18529 :
18530 14842 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18531 14842 : PopBool (&t, &f);
18532 14842 : BackPatch (f, NextQuad);
18533 14842 : PushBool (Merge (t, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
18534 14842 : }
18535 :
18536 :
18537 : /*
18538 : BuildEndIf - Builds the End part of the If statement
18539 : from the quad stack.
18540 : The Stack is expected to contain:
18541 :
18542 :
18543 : Entry Exit
18544 : ===== ====
18545 :
18546 : Ptr ->
18547 : +------------+
18548 : | t | f | Empty
18549 : |------------|
18550 :
18551 : Quadruples
18552 :
18553 : Both t and f are backpatched to point to the NextQuad
18554 : */
18555 :
18556 40488 : extern "C" void M2Quads_BuildEndIf (void)
18557 : {
18558 40488 : unsigned int t;
18559 40488 : unsigned int f;
18560 :
18561 40488 : PopBool (&t, &f);
18562 40488 : BackPatch (t, NextQuad);
18563 40488 : BackPatch (f, NextQuad);
18564 40488 : }
18565 :
18566 :
18567 : /*
18568 : BuildElsif1 - Builds the Elsif part of the If statement
18569 : from the quad stack.
18570 : The Stack is expected to contain:
18571 :
18572 :
18573 : Entry Exit
18574 : ===== ====
18575 :
18576 : Ptr ->
18577 : +------------+ +------------+
18578 : | t | f | | t+q | 0 |
18579 : |------------| |------------|
18580 :
18581 : Quadruples
18582 :
18583 : q GotoOp _ _ 0
18584 : q+1 <- BackPatched from f
18585 : */
18586 :
18587 3132 : extern "C" void M2Quads_BuildElsif1 (void)
18588 : {
18589 3132 : unsigned int t;
18590 3132 : unsigned int f;
18591 :
18592 3132 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18593 3132 : PopBool (&t, &f);
18594 3132 : BackPatch (f, NextQuad);
18595 3132 : PushBool (Merge (t, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
18596 3132 : }
18597 :
18598 :
18599 : /*
18600 : BuildElsif2 - Builds the Elsif until part of the If statement
18601 : from the quad stack.
18602 : The Stack is expected to contain:
18603 :
18604 :
18605 : Entry Exit
18606 : ===== ====
18607 :
18608 : Ptr ->
18609 : +--------------+
18610 : | 0 | f1 | <- Ptr
18611 : |--------------| +---------------+
18612 : | t2 | f2 | | t2 | f1+f2 |
18613 : |--------------| |---------------|
18614 : */
18615 :
18616 3132 : extern "C" void M2Quads_BuildElsif2 (void)
18617 : {
18618 3132 : unsigned int t1;
18619 3132 : unsigned int f1;
18620 3132 : unsigned int t2;
18621 3132 : unsigned int f2;
18622 :
18623 3132 : PopBool (&t1, &f1);
18624 3132 : M2Debug_Assert (t1 == 0);
18625 3132 : PopBool (&t2, &f2);
18626 3132 : PushBool (t2, Merge (f1, f2));
18627 3132 : }
18628 :
18629 :
18630 : /*
18631 : BuildForToByDo - Builds the For To By Do part of the For statement
18632 : from the quad stack.
18633 : The Stack is expected to contain:
18634 :
18635 :
18636 : Entry Exit
18637 : ===== ====
18638 :
18639 : <- Ptr
18640 : +----------------+
18641 : Ptr -> | RangeId |
18642 : +----------------+ |----------------|
18643 : | BySym | ByType | | ForQuad |
18644 : |----------------| |----------------|
18645 : | e2 | | LastValue |
18646 : |----------------| |----------------|
18647 : | e1 | | BySym | ByType |
18648 : |----------------| |----------------|
18649 : | Ident | | IdentSym |
18650 : |----------------| |----------------|
18651 :
18652 :
18653 : x := e1 ;
18654 : Note that LASTVALUE is calculated during M2GenGCC
18655 : after all the types have been resolved.
18656 : LASTVALUE := ((e2-e1) DIV BySym) * BySym + e1
18657 : IF BySym<0
18658 : THEN
18659 : IF e1<e2
18660 : THEN
18661 : goto exit
18662 : END
18663 : ELSE
18664 : IF e1>e2
18665 : THEN
18666 : goto exit
18667 : END
18668 : END ;
18669 : LOOP
18670 : body
18671 : IF x=LASTVALUE
18672 : THEN
18673 : goto exit
18674 : END ;
18675 : INC(x, BySym)
18676 : END
18677 :
18678 : Quadruples:
18679 :
18680 : q BecomesOp IdentSym _ e1
18681 : q+ LastForIteratorOp LastValue := ((e1-e2) DIV by) * by + e1
18682 : q+1 if >= by 0 q+..2
18683 : q+2 GotoOp q+3
18684 : q+3 If >= e1 e2 q+5
18685 : q+4 GotoOp exit
18686 : q+5 ..
18687 : q+..1 Goto q+..5
18688 : q+..2 If >= e2 e1 q+..4
18689 : q+..3 GotoOp exit
18690 : q+..4 ..
18691 :
18692 : The For Loop is regarded:
18693 :
18694 : For ident := e1 To e2 By by Do
18695 :
18696 : End
18697 : */
18698 :
18699 2542 : extern "C" void M2Quads_BuildForToByDo (void)
18700 : {
18701 2542 : M2Quads_LineNote l1;
18702 2542 : M2Quads_LineNote l2;
18703 2542 : NameKey_Name e1;
18704 2542 : NameKey_Name e2;
18705 2542 : NameKey_Name Id;
18706 2542 : unsigned int e1tok;
18707 2542 : unsigned int e2tok;
18708 2542 : unsigned int idtok;
18709 2542 : unsigned int bytok;
18710 2542 : unsigned int LastIterator;
18711 2542 : unsigned int exit1;
18712 2542 : unsigned int IdSym;
18713 2542 : unsigned int BySym;
18714 2542 : unsigned int ByType;
18715 2542 : unsigned int ForLoop;
18716 2542 : unsigned int RangeId;
18717 2542 : unsigned int t;
18718 2542 : unsigned int f;
18719 2542 : unsigned int etype;
18720 2542 : unsigned int t1;
18721 :
18722 2542 : l2 = PopLineNo ();
18723 2542 : l1 = PopLineNo ();
18724 2542 : UseLineNote (l1);
18725 2542 : PushFor (0);
18726 2542 : M2Quads_PopTFtok (&BySym, &ByType, &bytok);
18727 2542 : M2Quads_PopTtok (&e2, &e2tok);
18728 2542 : M2Quads_PopTtok (&e1, &e1tok);
18729 2542 : M2Quads_PopTtok (&Id, &idtok);
18730 2542 : IdSym = SymbolTable_RequestSym (idtok, Id);
18731 2542 : RangeId = M2Range_InitForLoopBeginRangeCheck (IdSym, idtok, e1, e1tok, e2, e2tok, BySym, bytok);
18732 2542 : BuildRange (RangeId);
18733 2542 : M2Quads_PushTtok (IdSym, idtok);
18734 2542 : M2Quads_PushTtok (e1, e1tok);
18735 2542 : BuildAssignmentWithoutBounds (idtok, true, true);
18736 2542 : UseLineNote (l2);
18737 3376 : LastIterator = SymbolTable_MakeTemporary (e2tok, AreConstant (((SymbolTable_IsConst (e1)) && (SymbolTable_IsConst (e2))) && (SymbolTable_IsConst (BySym))));
18738 2542 : SymbolTable_PutVar (LastIterator, SymbolTable_GetSType (IdSym));
18739 2542 : etype = M2Base_MixTypes (SymbolTable_GetSType (e1), SymbolTable_GetSType (e2), e2tok);
18740 2542 : e1 = doConvert (etype, e1);
18741 2542 : e2 = doConvert (etype, e2);
18742 2536 : ForLoopLastIterator (LastIterator, e1, e2, BySym, e1tok, e2tok, bytok);
18743 : /* q+2 GotoOp q+3 */
18744 2536 : M2Quads_PushTFtok (BySym, ByType, bytok); /* BuildRelOp 1st parameter. */
18745 2536 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter. */
18746 : /* 3rd parameter. */
18747 2536 : PushZero (bytok, ByType);
18748 2536 : M2Quads_BuildRelOp (e2tok); /* Choose final expression position. */
18749 2536 : PopBool (&t, &f); /* Choose final expression position. */
18750 2536 : BackPatch (f, NextQuad);
18751 : /* q+4 GotoOp Exit */
18752 2536 : M2Quads_PushTFtok (e1, SymbolTable_GetSType (e1), e1tok); /* BuildRelOp 1st parameter */
18753 2536 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter */
18754 2536 : M2Quads_PushTFtok (e2, SymbolTable_GetSType (e2), e2tok); /* 3rd parameter */
18755 2536 : M2Quads_BuildRelOp (e2tok); /* Choose final expression position. */
18756 2536 : PopBool (&t1, &exit1); /* Choose final expression position. */
18757 2536 : BackPatch (t1, NextQuad);
18758 2536 : PushFor (Merge (PopFor (), exit1)); /* Merge exit1. */
18759 2536 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0); /* Merge exit1. */
18760 2536 : ForLoop = NextQuad-1;
18761 : /* ELSE. */
18762 2536 : BackPatch (t, NextQuad);
18763 2536 : M2Quads_PushTFtok (e2, SymbolTable_GetSType (e2), e2tok); /* BuildRelOp 1st parameter */
18764 2536 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter */
18765 2536 : M2Quads_PushTFtok (e1, SymbolTable_GetSType (e1), e1tok); /* 3rd parameter */
18766 2536 : M2Quads_BuildRelOp (e2tok); /* 3rd parameter */
18767 2536 : PopBool (&t1, &exit1);
18768 2536 : BackPatch (t1, NextQuad);
18769 2536 : PushFor (Merge (PopFor (), exit1)); /* Merge exit1. */
18770 2536 : BackPatch (ForLoop, NextQuad); /* Fixes the start of the for loop. */
18771 2536 : ForLoop = NextQuad;
18772 : /* And set up the stack. */
18773 2536 : M2Quads_PushTFtok (IdSym, SymbolTable_GetSym (IdSym), idtok);
18774 2536 : M2Quads_PushTFtok (BySym, ByType, bytok);
18775 2536 : M2Quads_PushTFtok (LastIterator, SymbolTable_GetSType (LastIterator), e2tok);
18776 2536 : M2Quads_PushT (ForLoop);
18777 2536 : M2Quads_PushT (RangeId);
18778 2536 : }
18779 :
18780 :
18781 : /*
18782 : BuildPseudoBy - Builds the Non existant part of the By
18783 : clause of the For statement
18784 : from the quad stack.
18785 : The Stack is expected to contain:
18786 :
18787 :
18788 : Entry Exit
18789 : ===== ====
18790 :
18791 : <- Ptr
18792 : +------------+
18793 : Ptr -> | BySym | t |
18794 : +------------+ |------------|
18795 : | e | t | | e | t |
18796 : |------------| |------------|
18797 : */
18798 :
18799 2176 : extern "C" void M2Quads_BuildPseudoBy (void)
18800 : {
18801 2176 : unsigned int expr;
18802 2176 : unsigned int type;
18803 2176 : unsigned int dotok;
18804 :
18805 : /* As there is no BY token this position is the DO at the end of the last expression. */
18806 2176 : M2Quads_PopTFtok (&expr, &type, &dotok);
18807 2176 : M2Quads_PushTFtok (expr, type, dotok);
18808 2176 : if (type == SymbolTable_NulSym)
18809 : {} /* empty. */
18810 : /* Use type. */
18811 1956 : else if ((SymbolTable_IsEnumeration (SymbolTable_SkipType (type))) || ((SymbolTable_SkipType (type)) == M2Base_Char))
18812 : {
18813 : /* avoid dangling else. */
18814 : }
18815 1736 : else if (M2Base_IsOrdinalType (SymbolTable_SkipType (type)))
18816 : {
18817 : /* avoid dangling else. */
18818 1736 : type = M2Base_ZType;
18819 : }
18820 2176 : PushOne (dotok, type, (const char *) "the implied {%kFOR} loop increment will cause an overflow {%1ad}", 64);
18821 2176 : }
18822 :
18823 :
18824 : /*
18825 : BuildEndFor - Builds the End part of the For statement
18826 : from the quad stack.
18827 : The Stack is expected to contain:
18828 :
18829 :
18830 : Entry Exit
18831 : ===== ====
18832 :
18833 : Ptr ->
18834 : +----------------+
18835 : | RangeId |
18836 : |----------------|
18837 : | ForQuad |
18838 : |----------------|
18839 : | LastValue |
18840 : |----------------|
18841 : | BySym | ByType |
18842 : |----------------|
18843 : | IdSym | Empty
18844 : |----------------|
18845 : */
18846 :
18847 2536 : extern "C" void M2Quads_BuildEndFor (unsigned int endpostok)
18848 : {
18849 2536 : unsigned int t;
18850 2536 : unsigned int f;
18851 2536 : unsigned int tsym;
18852 2536 : unsigned int RangeId;
18853 2536 : unsigned int IncQuad;
18854 2536 : unsigned int ForQuad;
18855 2536 : unsigned int LastSym;
18856 2536 : unsigned int ByType;
18857 2536 : unsigned int BySym;
18858 2536 : unsigned int bytok;
18859 2536 : unsigned int IdSym;
18860 2536 : unsigned int idtok;
18861 :
18862 2536 : M2Quads_PopT (&RangeId);
18863 2536 : M2Quads_PopT (&ForQuad);
18864 2536 : M2Quads_PopT (&LastSym);
18865 2536 : M2Quads_PopTFtok (&BySym, &ByType, &bytok);
18866 2536 : M2Quads_PopTtok (&IdSym, &idtok);
18867 : /* IF IdSym=LastSym THEN exit END */
18868 2536 : M2Quads_PushTF (IdSym, SymbolTable_GetSType (IdSym));
18869 2536 : M2Quads_PushT (M2Reserved_EqualTok);
18870 2536 : M2Quads_PushTF (LastSym, SymbolTable_GetSType (LastSym));
18871 2536 : M2Quads_BuildRelOp (endpostok);
18872 2536 : PopBool (&t, &f);
18873 2536 : BackPatch (t, NextQuad);
18874 2536 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18875 2536 : PushFor (Merge (PopFor (), NextQuad-1));
18876 2536 : BackPatch (f, NextQuad);
18877 2536 : if ((SymbolTable_GetMode (IdSym)) == SymbolTable_LeftValue)
18878 : {
18879 : /* index variable is a LeftValue, therefore we must dereference it */
18880 0 : tsym = SymbolTable_MakeTemporary (idtok, SymbolTable_RightValue);
18881 0 : SymbolTable_PutVar (tsym, SymbolTable_GetSType (IdSym));
18882 0 : CheckPointerThroughNil (idtok, IdSym);
18883 0 : doIndrX (endpostok, tsym, IdSym);
18884 0 : BuildRange (M2Range_InitForLoopEndRangeCheck (tsym, BySym)); /* --fixme-- pass endpostok. */
18885 0 : IncQuad = NextQuad;
18886 : /* we have explicitly checked using the above and also
18887 : this addition can legitimately overflow if a cardinal type
18888 : is counting down. The above test will generate a more
18889 : precise error message, so we suppress overflow detection
18890 : here. */
18891 0 : GenQuadOTypetok (bytok, M2Quads_AddOp, tsym, tsym, BySym, false, false, idtok, idtok, bytok);
18892 0 : CheckPointerThroughNil (idtok, IdSym);
18893 0 : GenQuadOtok (idtok, M2Quads_XIndrOp, IdSym, SymbolTable_GetSType (IdSym), tsym, false, idtok, idtok, idtok);
18894 : }
18895 : else
18896 : {
18897 2536 : BuildRange (M2Range_InitForLoopEndRangeCheck (IdSym, BySym));
18898 2536 : IncQuad = NextQuad;
18899 : /* we have explicitly checked using the above and also
18900 : this addition can legitimately overflow if a cardinal type
18901 : is counting down. The above test will generate a more
18902 : precise error message, so we suppress overflow detection
18903 : here.
18904 :
18905 : This quadruple suppresses the generic binary op type
18906 : check (performed in M2GenGCC.mod) as there
18907 : will be a more informative/exhaustive check performed by the
18908 : InitForLoopBeginRangeCheck setup in BuildForToByDo and
18909 : performed by M2Range.mod. */
18910 2536 : GenQuadOTypetok (idtok, M2Quads_AddOp, IdSym, IdSym, BySym, false, false, idtok, idtok, bytok);
18911 : }
18912 2536 : GenQuadO (endpostok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, ForQuad, false);
18913 2536 : BackPatch (PopFor (), NextQuad);
18914 2536 : AddForInfo (ForQuad, NextQuad-1, IncQuad, IdSym, idtok);
18915 2536 : M2Range_PutRangeForIncrement (RangeId, IncQuad);
18916 2536 : }
18917 :
18918 :
18919 : /*
18920 : BuildCaseStart - starts the case statement.
18921 : It initializes a backpatch list on the compile
18922 : time stack, the list is used to contain all
18923 : case break points. The list is later backpatched
18924 : and contains all positions of the case statement
18925 : which jump to the end of the case statement.
18926 : The stack also contains room for a boolean
18927 : expression, this is needed to allow , operator
18928 : in the CaseField alternatives.
18929 :
18930 : The Stack is expected to contain:
18931 :
18932 :
18933 : Entry Exit
18934 : ===== ====
18935 :
18936 : <- Ptr
18937 : +------------+
18938 : | 0 | 0 |
18939 : |------------|
18940 : | 0 | 0 |
18941 : +-------------+ |------------|
18942 : | Expr | | | Expr | |
18943 : |-------------| |------------|
18944 : */
18945 :
18946 976 : extern "C" void M2Quads_BuildCaseStart (void)
18947 : {
18948 976 : BuildRange (M2Range_InitCaseBounds (M2CaseList_PushCase (SymbolTable_NulSym, SymbolTable_NulSym, M2Quads_OperandT (1))));
18949 976 : PushBool (0, 0); /* BackPatch list initialized */
18950 976 : PushBool (0, 0); /* Room for a boolean expression */
18951 976 : }
18952 :
18953 :
18954 : /*
18955 : BuildCaseStartStatementSequence - starts the statement sequence
18956 : inside a case clause.
18957 : BackPatches the true exit to the
18958 : NextQuad.
18959 : The Stack:
18960 :
18961 : Entry Exit
18962 :
18963 : Ptr -> <- Ptr
18964 : +-----------+ +------------+
18965 : | t | f | | 0 | f |
18966 : |-----------| |------------|
18967 : */
18968 :
18969 3690 : extern "C" void M2Quads_BuildCaseStartStatementSequence (void)
18970 : {
18971 3690 : unsigned int t;
18972 3690 : unsigned int f;
18973 :
18974 3690 : PopBool (&t, &f);
18975 3690 : BackPatch (t, NextQuad);
18976 3690 : PushBool (0, f);
18977 3690 : }
18978 :
18979 :
18980 : /*
18981 : BuildCaseEndStatementSequence - ends the statement sequence
18982 : inside a case clause.
18983 : BackPatches the false exit f1 to the
18984 : NextQuad.
18985 : Asserts that t1 and f2 is 0
18986 : Pushes t2+q and 0
18987 :
18988 : Quadruples:
18989 :
18990 : q GotoOp _ _ 0
18991 :
18992 : The Stack:
18993 :
18994 : Entry Exit
18995 :
18996 : Ptr -> <- Ptr
18997 : +-----------+ +------------+
18998 : | t1 | f1 | | 0 | 0 |
18999 : |-----------| |------------|
19000 : | t2 | f2 | | t2+q | 0 |
19001 : |-----------| |------------|
19002 : */
19003 :
19004 3690 : extern "C" void M2Quads_BuildCaseEndStatementSequence (void)
19005 : {
19006 3690 : unsigned int t1;
19007 3690 : unsigned int f1;
19008 3690 : unsigned int t2;
19009 3690 : unsigned int f2;
19010 :
19011 3690 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
19012 3690 : PopBool (&t1, &f1);
19013 3690 : PopBool (&t2, &f2); /* t2 contains the break list for the case */
19014 3690 : BackPatch (f1, NextQuad); /* f1 no longer needed */
19015 3690 : M2Debug_Assert (t1 == 0); /* f1 no longer needed */
19016 3690 : M2Debug_Assert (f2 == 0);
19017 3690 : PushBool (Merge (t2, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
19018 3690 : PushBool (0, 0); /* Room for boolean expression */
19019 3690 : }
19020 :
19021 :
19022 : /*
19023 : BuildCaseRange - builds the range testing quaruples for
19024 : a case clause.
19025 :
19026 : IF (e1>=ce1) AND (e1<=ce2)
19027 : THEN
19028 :
19029 : ELS..
19030 :
19031 : The Stack:
19032 :
19033 : Entry Exit
19034 :
19035 : Ptr ->
19036 : +-----------+
19037 : | ce2 | <- Ptr
19038 : |-----------| +-----------+
19039 : | ce1 | | t | f |
19040 : |-----------| |-----------|
19041 : | t1 | f1 | | t1 | f1 |
19042 : |-----------| |-----------|
19043 : | t2 | f2 | | t2 | f2 |
19044 : |-----------| |-----------|
19045 : | e1 | | e1 |
19046 : |-----------| |-----------|
19047 : */
19048 :
19049 168 : extern "C" void M2Quads_BuildCaseRange (void)
19050 : {
19051 168 : unsigned int ce1;
19052 168 : unsigned int ce2;
19053 168 : unsigned int combinedtok;
19054 168 : unsigned int ce1tok;
19055 168 : unsigned int ce2tok;
19056 168 : unsigned int e1tok;
19057 168 : unsigned int e1;
19058 168 : unsigned int t2;
19059 168 : unsigned int f2;
19060 168 : unsigned int t1;
19061 168 : unsigned int f1;
19062 :
19063 168 : M2Quads_PopTtok (&ce2, &ce2tok);
19064 168 : M2Quads_PopTtok (&ce1, &ce1tok);
19065 168 : combinedtok = M2LexBuf_MakeVirtualTok (ce2tok, ce2tok, ce1tok);
19066 168 : M2CaseList_AddRange (ce1, ce2, combinedtok);
19067 168 : PopBool (&t1, &f1);
19068 168 : PopBool (&t2, &f2);
19069 168 : M2Quads_PopTtok (&e1, &e1tok);
19070 168 : M2Quads_PushTtok (e1, e1tok); /* leave e1 on bottom of stack when exit procedure */
19071 168 : PushBool (t2, f2); /* leave e1 on bottom of stack when exit procedure */
19072 168 : PushBool (t1, f1); /* also leave t1 and f1 on the bottom of the stack */
19073 168 : M2Quads_PushTtok (e1, e1tok); /* also leave t1 and f1 on the bottom of the stack */
19074 168 : M2Quads_PushT (M2Reserved_GreaterEqualTok);
19075 168 : M2Quads_PushTtok (ce1, ce1tok);
19076 168 : M2Quads_BuildRelOp (combinedtok);
19077 168 : M2Quads_PushT (M2Reserved_AndTok);
19078 168 : M2Quads_RecordOp ();
19079 168 : M2Quads_PushTtok (e1, e1tok);
19080 168 : M2Quads_PushT (M2Reserved_LessEqualTok);
19081 168 : M2Quads_PushTtok (ce2, ce2tok);
19082 168 : M2Quads_BuildRelOp (combinedtok);
19083 168 : M2Quads_BuildBinaryOp ();
19084 168 : }
19085 :
19086 :
19087 : /*
19088 : BuildCaseEquality - builds the range testing quadruples for
19089 : a case clause.
19090 :
19091 : IF e1=ce1
19092 : THEN
19093 :
19094 : ELS..
19095 :
19096 : The Stack:
19097 :
19098 : Entry Exit
19099 :
19100 : Ptr ->
19101 : +-----------+ +-----------+
19102 : | ce1 | | t | f |
19103 : |-----------| |-----------|
19104 : | t1 | f1 | | t1 | f1 |
19105 : |-----------| |-----------|
19106 : | t2 | f2 | | t2 | f2 |
19107 : |-----------| |-----------|
19108 : | e1 | | e1 |
19109 : |-----------| |-----------|
19110 : */
19111 :
19112 3572 : extern "C" void M2Quads_BuildCaseEquality (void)
19113 : {
19114 3572 : unsigned int ce1tok;
19115 3572 : unsigned int e1tok;
19116 3572 : unsigned int ce1;
19117 3572 : unsigned int e1;
19118 3572 : unsigned int t2;
19119 3572 : unsigned int f2;
19120 3572 : unsigned int t1;
19121 3572 : unsigned int f1;
19122 :
19123 3572 : M2Quads_PopTtok (&ce1, &ce1tok);
19124 3572 : M2CaseList_AddRange (ce1, SymbolTable_NulSym, ce1tok);
19125 3572 : PopBool (&t1, &f1);
19126 3572 : PopBool (&t2, &f2);
19127 3572 : M2Quads_PopTtok (&e1, &e1tok);
19128 3572 : M2Quads_PushTtok (e1, e1tok); /* leave e1 on bottom of stack when exit procedure */
19129 3572 : PushBool (t2, f2); /* also leave t2 and f2 on the bottom of the stack */
19130 3572 : PushBool (t1, f1); /* also leave t2 and f2 on the bottom of the stack */
19131 3572 : M2Quads_PushTtok (e1, e1tok);
19132 3572 : M2Quads_PushT (M2Reserved_EqualTok);
19133 3572 : M2Quads_PushTtok (ce1, ce1tok);
19134 3572 : M2Quads_BuildRelOp (ce1tok);
19135 3572 : }
19136 :
19137 :
19138 : /*
19139 : BuildCaseList - merges two case tests into one
19140 :
19141 : The Stack:
19142 :
19143 : Entry Exit
19144 :
19145 : Ptr ->
19146 : +-----------+
19147 : | t2 | f2 |
19148 : |-----------| +-------------+
19149 : | t1 | f1 | | t1+t2| f1+f2|
19150 : |-----------| |-------------|
19151 : */
19152 :
19153 3740 : extern "C" void M2Quads_BuildCaseList (void)
19154 : {
19155 3740 : unsigned int t2;
19156 3740 : unsigned int f2;
19157 3740 : unsigned int t1;
19158 3740 : unsigned int f1;
19159 :
19160 3740 : PopBool (&t2, &f2);
19161 3740 : PopBool (&t1, &f1);
19162 3740 : PushBool (Merge (t1, t2), Merge (f1, f2));
19163 3740 : }
19164 :
19165 :
19166 : /*
19167 : BuildCaseOr - builds the , in the case clause.
19168 :
19169 : The Stack:
19170 :
19171 : Entry Exit
19172 :
19173 : Ptr -> <- Ptr
19174 : +-----------+ +------------+
19175 : | t | f | | t | 0 |
19176 : |-----------| |------------|
19177 : */
19178 :
19179 50 : extern "C" void M2Quads_BuildCaseOr (void)
19180 : {
19181 50 : unsigned int t;
19182 50 : unsigned int f;
19183 :
19184 50 : PopBool (&t, &f);
19185 50 : BackPatch (f, NextQuad);
19186 50 : PushBool (t, 0);
19187 50 : }
19188 :
19189 :
19190 : /*
19191 : BuildCaseElse - builds the else of case clause.
19192 :
19193 : The Stack:
19194 :
19195 : Entry Exit
19196 :
19197 : Ptr -> <- Ptr
19198 : +-----------+ +------------+
19199 : | t | f | | t | 0 |
19200 : |-----------| |------------|
19201 : */
19202 :
19203 976 : extern "C" void M2Quads_BuildCaseElse (void)
19204 : {
19205 976 : unsigned int t;
19206 976 : unsigned int f;
19207 :
19208 976 : PopBool (&t, &f);
19209 976 : BackPatch (f, NextQuad);
19210 976 : PushBool (t, 0);
19211 976 : }
19212 :
19213 :
19214 : /*
19215 : BuildCaseEnd - builds the end of case clause.
19216 :
19217 : The Stack:
19218 :
19219 : Entry Exit
19220 :
19221 : Ptr ->
19222 : +-----------+
19223 : | t1 | f1 |
19224 : |-----------|
19225 : | t2 | f2 |
19226 : |-----------|
19227 : | e1 |
19228 : |-----------| Empty
19229 : */
19230 :
19231 976 : extern "C" void M2Quads_BuildCaseEnd (void)
19232 : {
19233 976 : unsigned int e1;
19234 976 : unsigned int t;
19235 976 : unsigned int f;
19236 :
19237 976 : PopBool (&t, &f);
19238 976 : BackPatch (f, NextQuad);
19239 976 : BackPatch (t, NextQuad);
19240 976 : PopBool (&t, &f);
19241 976 : BackPatch (f, NextQuad);
19242 976 : BackPatch (t, NextQuad);
19243 976 : M2Quads_PopT (&e1);
19244 976 : M2CaseList_PopCase ();
19245 976 : }
19246 :
19247 :
19248 : /*
19249 : BuildCaseCheck - builds the case checking code to ensure that
19250 : the program does not need an else clause at runtime.
19251 : The stack is unaltered.
19252 : */
19253 :
19254 488 : extern "C" void M2Quads_BuildCaseCheck (void)
19255 : {
19256 488 : BuildError (M2Range_InitNoElseRangeCheck ());
19257 488 : }
19258 :
19259 :
19260 : /*
19261 : BuildNulParam - Builds a nul parameter on the stack.
19262 : The Stack:
19263 :
19264 : Entry Exit
19265 :
19266 : <- Ptr
19267 : Empty +------------+
19268 : | 0 |
19269 : |------------|
19270 : */
19271 :
19272 17390 : extern "C" void M2Quads_BuildNulParam (void)
19273 : {
19274 17390 : M2Quads_PushT (static_cast<unsigned int> (0));
19275 17390 : }
19276 :
19277 :
19278 : /*
19279 : BuildProcedureCall - builds a procedure call.
19280 : Although this procedure does not directly
19281 : destroy the procedure parameters, it calls
19282 : routine which will manipulate the stack and
19283 : so the entry and exit states of the stack are shown.
19284 :
19285 : The Stack:
19286 :
19287 :
19288 : Entry Exit
19289 :
19290 : Ptr ->
19291 : +----------------+
19292 : | NoOfParam |
19293 : |----------------|
19294 : | Param 1 |
19295 : |----------------|
19296 : | Param 2 |
19297 : |----------------|
19298 : . .
19299 : . .
19300 : . .
19301 : |----------------|
19302 : | Param # |
19303 : |----------------|
19304 : | ProcSym | Type | Empty
19305 : |----------------|
19306 : */
19307 :
19308 173031 : extern "C" void M2Quads_BuildProcedureCall (unsigned int tokno)
19309 : {
19310 173031 : unsigned int NoOfParam;
19311 173031 : unsigned int ProcSym;
19312 :
19313 173031 : M2Quads_PopT (&NoOfParam);
19314 173031 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19315 173031 : M2Quads_PushT (NoOfParam); /* Compile time stack restored to entry state */
19316 173031 : if ((M2Base_IsPseudoBaseProcedure (ProcSym)) || (M2System_IsPseudoSystemProcedure (ProcSym))) /* Compile time stack restored to entry state */
19317 : {
19318 20515 : M2Quads_DisplayStack ();
19319 20515 : ManipulatePseudoCallParameters ();
19320 20515 : M2Quads_DisplayStack ();
19321 20515 : BuildPseudoProcedureCall (tokno);
19322 20515 : M2Quads_DisplayStack ();
19323 : }
19324 152516 : else if (SymbolTable_IsUnknown (ProcSym))
19325 : {
19326 : /* avoid dangling else. */
19327 : /* Spellcheck. */
19328 30 : M2MetaError_MetaError1 ((const char *) "{%1Ua} is not recognised as a procedure {%1&s}", 46, ProcSym);
19329 30 : M2Quads_PopN (NoOfParam+2);
19330 30 : SymbolTable_UnknownReported (ProcSym);
19331 : }
19332 : else
19333 : {
19334 : /* avoid dangling else. */
19335 152486 : M2Quads_DisplayStack ();
19336 152486 : BuildRealProcedureCall (tokno);
19337 152480 : M2Quads_DisplayStack ();
19338 : }
19339 173025 : }
19340 :
19341 :
19342 : /*
19343 : CheckBuildFunction - checks to see whether ProcSym is a function
19344 : and if so it adds a TempSym value which will
19345 : hold the return value once the function finishes.
19346 : This procedure also generates an error message
19347 : if the user is calling a function and ignoring
19348 : the return result. The additional TempSym
19349 : is not created if ProcSym is a procedure
19350 : and the stack is unaltered.
19351 :
19352 : The Stack:
19353 :
19354 :
19355 : Entry Exit
19356 :
19357 : Ptr ->
19358 :
19359 : +----------------+
19360 : | ProcSym | Type |
19361 : +----------------+ |----------------|
19362 : | ProcSym | Type | | TempSym | Type |
19363 : |----------------| |----------------|
19364 : */
19365 :
19366 103039 : extern "C" bool M2Quads_CheckBuildFunction (void)
19367 : {
19368 103039 : unsigned int tokpos;
19369 103039 : unsigned int TempSym;
19370 103039 : unsigned int ProcSym;
19371 103039 : unsigned int Type;
19372 :
19373 103039 : M2Quads_PopTFtok (&ProcSym, &Type, &tokpos);
19374 103039 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (Type)))
19375 : {
19376 : /* avoid dangling else. */
19377 684 : if ((SymbolTable_GetSType (Type)) != SymbolTable_NulSym)
19378 : {
19379 0 : TempSym = SymbolTable_MakeTemporary (tokpos, SymbolTable_RightValue);
19380 0 : SymbolTable_PutVar (TempSym, SymbolTable_GetSType (Type));
19381 0 : M2Quads_PushTFtok (TempSym, SymbolTable_GetSType (Type), tokpos);
19382 0 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19383 0 : if (! (SymbolTable_IsReturnOptionalAny (Type)))
19384 : {
19385 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "function {%1Ea} is called but its return value is ignored", 57, ProcSym);
19386 : }
19387 0 : return true;
19388 : }
19389 : }
19390 102355 : else if ((SymbolTable_IsProcedure (ProcSym)) && (Type != SymbolTable_NulSym))
19391 : {
19392 : /* avoid dangling else. */
19393 0 : TempSym = SymbolTable_MakeTemporary (tokpos, SymbolTable_RightValue);
19394 0 : SymbolTable_PutVar (TempSym, Type);
19395 0 : M2Quads_PushTFtok (TempSym, Type, tokpos);
19396 0 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19397 0 : if (! (SymbolTable_IsReturnOptionalAny (ProcSym)))
19398 : {
19399 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "function {%1Ea} is called but its return value is ignored", 57, ProcSym);
19400 : }
19401 0 : return true;
19402 : }
19403 103039 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19404 103039 : return false;
19405 : /* static analysis guarentees a RETURN statement will be used before here. */
19406 : __builtin_unreachable ();
19407 : }
19408 :
19409 :
19410 : /*
19411 : BuildFunctionCall - builds a function call.
19412 : The Stack:
19413 :
19414 :
19415 : Entry Exit
19416 :
19417 : Ptr ->
19418 : +----------------+
19419 : | NoOfParam |
19420 : |----------------|
19421 : | Param 1 |
19422 : |----------------|
19423 : | Param 2 |
19424 : |----------------|
19425 : . .
19426 : . .
19427 : . .
19428 : |----------------|
19429 : | Param # | <- Ptr
19430 : |----------------| +------------+
19431 : | ProcSym | Type | | ReturnVar |
19432 : |----------------| |------------|
19433 : */
19434 :
19435 105132 : extern "C" void M2Quads_BuildFunctionCall (bool ConstExpr)
19436 : {
19437 105132 : unsigned int paramtok;
19438 105132 : unsigned int combinedtok;
19439 105132 : unsigned int functok;
19440 105132 : unsigned int NoOfParam;
19441 105132 : unsigned int ProcSym;
19442 :
19443 105132 : M2Quads_PopT (&NoOfParam);
19444 105132 : functok = OperandTtok (NoOfParam+1);
19445 105132 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19446 105132 : ProcSym = PCSymBuild_SkipConst (ProcSym);
19447 105132 : M2Quads_PushT (NoOfParam);
19448 : /* Compile time stack restored to entry state. */
19449 105132 : if (SymbolTable_IsUnknown (ProcSym))
19450 : {
19451 : /* Spellcheck. */
19452 6 : paramtok = OperandTtok (1);
19453 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, paramtok);
19454 6 : M2MetaError_MetaErrorT1 (functok, (const char *) "procedure function {%1Ea} is undefined {%1&s}", 45, ProcSym);
19455 6 : SymbolTable_UnknownReported (ProcSym);
19456 6 : M2Quads_PopN (NoOfParam+2);
19457 : /* Fake return value to continue compiling. */
19458 6 : M2Quads_PushT (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym));
19459 : }
19460 105126 : else if (SymbolTable_IsAModula2Type (ProcSym))
19461 : {
19462 : /* avoid dangling else. */
19463 2532 : ManipulatePseudoCallParameters ();
19464 2532 : BuildTypeCoercion (ConstExpr);
19465 : }
19466 102594 : else if ((M2System_IsPseudoSystemFunction (ProcSym)) || (M2Base_IsPseudoBaseFunction (ProcSym)))
19467 : {
19468 : /* avoid dangling else. */
19469 42360 : ManipulatePseudoCallParameters ();
19470 42360 : BuildPseudoFunctionCall (ConstExpr);
19471 : }
19472 : else
19473 : {
19474 : /* avoid dangling else. */
19475 60234 : BuildRealFunctionCall (functok, ConstExpr);
19476 : }
19477 105105 : }
19478 :
19479 :
19480 : /*
19481 : BuildConstFunctionCall - builds a function call and checks that this function can be
19482 : called inside a ConstExpression.
19483 :
19484 : The Stack:
19485 :
19486 :
19487 : Entry Exit
19488 :
19489 : Ptr ->
19490 : +----------------+
19491 : | NoOfParam |
19492 : |----------------|
19493 : | Param 1 |
19494 : |----------------|
19495 : | Param 2 |
19496 : |----------------|
19497 : . .
19498 : . .
19499 : . .
19500 : |----------------|
19501 : | Param # | <- Ptr
19502 : |----------------| +------------+
19503 : | ProcSym | Type | | ReturnVar |
19504 : |----------------| |------------|
19505 :
19506 : */
19507 :
19508 7272 : extern "C" void M2Quads_BuildConstFunctionCall (void)
19509 : {
19510 7272 : unsigned int functok;
19511 7272 : unsigned int combinedtok;
19512 7272 : unsigned int paramtok;
19513 7272 : unsigned int ConstExpression;
19514 7272 : unsigned int NoOfParam;
19515 7272 : unsigned int ProcSym;
19516 :
19517 7272 : M2Quads_DisplayStack ();
19518 7272 : M2Quads_PopT (&NoOfParam);
19519 7272 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19520 7272 : functok = OperandTtok (NoOfParam+1);
19521 7272 : if (M2Options_CompilerDebugging)
19522 : {
19523 0 : M2Printf_printf2 ((const char *) "procsym = %d token = %d\\n", 26, (const unsigned char *) &ProcSym, (sizeof (ProcSym)-1), (const unsigned char *) &functok, (sizeof (functok)-1));
19524 : }
19525 : /* ErrorStringAt (InitString ('constant function'), functok). */
19526 7272 : M2Quads_PushT (NoOfParam);
19527 7272 : if ((ProcSym != M2Base_Convert) && (((M2Base_IsPseudoBaseFunction (ProcSym)) || (M2System_IsPseudoSystemFunctionConstExpression (ProcSym))) || ((SymbolTable_IsProcedure (ProcSym)) && (SymbolTable_IsProcedureBuiltin (ProcSym)))))
19528 : {
19529 7140 : M2Quads_BuildFunctionCall (true);
19530 : }
19531 : else
19532 : {
19533 132 : if (SymbolTable_IsAModula2Type (ProcSym))
19534 : {
19535 : /* Type conversion. */
19536 132 : if (NoOfParam == 1)
19537 : {
19538 132 : ConstExpression = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19539 132 : paramtok = OperandTtok (NoOfParam+1);
19540 132 : M2Quads_PopN (NoOfParam+2);
19541 : /* Build macro: CONVERT( ProcSym, ConstExpression ). */
19542 132 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
19543 132 : M2Quads_PushTtok (ProcSym, functok);
19544 132 : M2Quads_PushTtok (ConstExpression, paramtok);
19545 132 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters. */
19546 132 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters. */
19547 : }
19548 : else
19549 : {
19550 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}a constant type conversion can only have one argument", 57);
19551 : }
19552 : }
19553 : else
19554 : {
19555 : /* Error issue message and fake return stack. */
19556 0 : if (M2Options_Iso)
19557 : {
19558 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kCMPLX}, {%kFLOAT}, {%kHIGH}, {%kIM}, {%kLENGTH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kRE}, {%kSIZE}, {%kTSIZE}, {%kTBITSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins", 245);
19559 : }
19560 : else
19561 : {
19562 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kFLOAT}, {%kHIGH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kTBITSIZE}, {%kVAL} and gcc builtins", 206);
19563 : }
19564 0 : if (NoOfParam > 0)
19565 : {
19566 0 : paramtok = OperandTtok (NoOfParam+1);
19567 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
19568 : }
19569 : else
19570 : {
19571 0 : combinedtok = functok;
19572 : }
19573 0 : M2Quads_PopN (NoOfParam+2);
19574 0 : M2Quads_PushT (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym)); /* Fake return value to continue compiling. */
19575 : }
19576 : }
19577 7272 : }
19578 :
19579 :
19580 : /*
19581 : BuildBooleanVariable - tests to see whether top of stack is a boolean
19582 : conditional and if so it converts it into a boolean
19583 : variable.
19584 : */
19585 :
19586 350870 : extern "C" void M2Quads_BuildBooleanVariable (void)
19587 : {
19588 350870 : if (IsBoolean (1))
19589 : {
19590 7170 : ConvertBooleanToVariable (OperandTtok (1), 1);
19591 : }
19592 350870 : }
19593 :
19594 :
19595 : /*
19596 : BuildModuleStart - starts current module scope.
19597 : */
19598 :
19599 82731 : extern "C" void M2Quads_BuildModuleStart (unsigned int tok)
19600 : {
19601 82731 : GenQuadO (tok, M2Quads_ModuleScopeOp, tok, (unsigned int ) (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()))), SymbolTable_GetCurrentModule (), false);
19602 82731 : }
19603 :
19604 :
19605 : /*
19606 : BuildProcedureStart - Builds start of the procedure. Generates a
19607 : quadruple which indicated the start of
19608 : this procedure declarations scope.
19609 : The Stack is expected to contain:
19610 :
19611 :
19612 : Entry Exit
19613 : ===== ====
19614 :
19615 : Ptr -> <- Ptr
19616 : +------------+ +-----------+
19617 : | ProcSym | | ProcSym |
19618 : |------------| |-----------|
19619 : | Name | | Name |
19620 : |------------| |-----------|
19621 :
19622 :
19623 : Quadruples:
19624 :
19625 : q ProcedureScopeOp Line# Scope ProcSym
19626 : */
19627 :
19628 78968 : extern "C" void M2Quads_BuildProcedureStart (void)
19629 : {
19630 78968 : unsigned int ProcSym;
19631 :
19632 78968 : M2Quads_PopT (&ProcSym);
19633 78968 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
19634 78968 : SymbolTable_PutProcedureScopeQuad (ProcSym, NextQuad);
19635 78968 : GenQuad (M2Quads_ProcedureScopeOp, M2LexBuf_GetPreviousTokenLineNo (), SymbolTable_GetScope (ProcSym), ProcSym);
19636 78968 : M2Quads_PushT (ProcSym);
19637 78968 : }
19638 :
19639 :
19640 : /*
19641 : BuildProcedureBegin - determines the start of the BEGIN END block of
19642 : the procedure.
19643 : The Stack is expected to contain:
19644 :
19645 :
19646 : Entry Exit
19647 : ===== ====
19648 :
19649 : Ptr -> <- Ptr
19650 : +------------+ +-----------+
19651 : | ProcSym | | ProcSym |
19652 : |------------| |-----------|
19653 : | Name | | Name |
19654 : |------------| |-----------|
19655 :
19656 :
19657 : Quadruples:
19658 :
19659 : q NewLocalVarOp TokenNo(BEGIN) _ ProcSym
19660 : */
19661 :
19662 78956 : extern "C" void M2Quads_BuildProcedureBegin (void)
19663 : {
19664 78956 : unsigned int ProcSym;
19665 :
19666 78956 : M2Quads_PopT (&ProcSym);
19667 78956 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
19668 78956 : SymbolTable_PutProcedureStartQuad (ProcSym, NextQuad);
19669 78956 : SymbolTable_PutProcedureBegin (ProcSym, M2LexBuf_GetTokenNo ());
19670 78956 : GenQuad (M2Quads_NewLocalVarOp, M2LexBuf_GetTokenNo (), SymbolTable_GetScope (ProcSym), ProcSym);
19671 78956 : CurrentProc = ProcSym;
19672 78956 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
19673 78956 : M2Quads_PushT (ProcSym);
19674 78956 : CheckVariablesAt (ProcSym);
19675 78956 : CheckNeedPriorityBegin (M2LexBuf_GetTokenNo (), ProcSym, SymbolTable_GetCurrentModule ());
19676 78956 : M2StackWord_PushWord (TryStack, NextQuad);
19677 78956 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
19678 78956 : if (SymbolTable_HasExceptionBlock (ProcSym))
19679 : {
19680 168 : GenQuad (M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
19681 : }
19682 78956 : }
19683 :
19684 :
19685 : /*
19686 : BuildProcedureEnd - Builds end of the procedure. Destroys space for
19687 : the local variables.
19688 : The Stack is expected to contain:
19689 :
19690 :
19691 : Entry Exit
19692 : ===== ====
19693 :
19694 : Ptr -> <- Ptr
19695 : +------------+ +-----------+
19696 : | ProcSym | | ProcSym |
19697 : |------------| |-----------|
19698 : | Name | | Name |
19699 : |------------| |-----------|
19700 :
19701 :
19702 : Quadruples:
19703 :
19704 : q KillLocalVarOp TokenNo(END) _ ProcSym
19705 : */
19706 :
19707 78926 : extern "C" void M2Quads_BuildProcedureEnd (void)
19708 : {
19709 78926 : unsigned int tok;
19710 78926 : unsigned int ProcSym;
19711 :
19712 78926 : M2Quads_PopTtok (&ProcSym, &tok);
19713 78926 : if (SymbolTable_HasExceptionBlock (ProcSym))
19714 : {
19715 168 : BuildRTExceptLeave (tok, true);
19716 168 : GenQuad (M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
19717 : }
19718 78926 : if ((SymbolTable_GetSType (ProcSym)) != SymbolTable_NulSym)
19719 : {
19720 18874 : BuildError (M2Range_InitNoReturnRangeCheck ());
19721 : }
19722 78926 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
19723 78926 : CheckNeedPriorityEnd (tok, ProcSym, SymbolTable_GetCurrentModule ());
19724 78926 : CurrentProc = SymbolTable_NulSym;
19725 78926 : SymbolTable_PutProcedureEnd (ProcSym, (M2LexBuf_GetTokenNo ())-1); /* --fixme-- */
19726 78926 : GenQuad (M2Quads_KillLocalVarOp, (M2LexBuf_GetTokenNo ())-1, SymbolTable_NulSym, ProcSym); /* --fixme-- */
19727 78926 : SymbolTable_PutProcedureEndQuad (ProcSym, NextQuad);
19728 78926 : GenQuad (M2Quads_ReturnOp, SymbolTable_NulSym, SymbolTable_NulSym, ProcSym);
19729 78926 : CheckFunctionReturn (ProcSym);
19730 78926 : CheckVariablesInBlock (ProcSym);
19731 : /* Call PutProcedureEndQuad so that any runtime procedure will be
19732 : seen as defined even if it not seen during pass 2 (which will also
19733 : call PutProcedureEndQuad). */
19734 78926 : SymbolTable_PutProcedureParametersDefined (ProcSym, SymbolTable_ProperProcedure);
19735 78926 : SymbolTable_PutProcedureDefined (ProcSym, SymbolTable_ProperProcedure);
19736 78926 : M2StackWord_RemoveTop (CatchStack);
19737 78926 : M2StackWord_RemoveTop (TryStack);
19738 78926 : M2Quads_PushT (ProcSym);
19739 78926 : }
19740 :
19741 :
19742 : /*
19743 : BuildReturn - Builds the Return part of the procedure.
19744 : tokreturn is the location of the RETURN keyword.
19745 : The Stack is expected to contain:
19746 :
19747 :
19748 : Entry Exit
19749 : ===== ====
19750 :
19751 : Ptr ->
19752 : +------------+
19753 : | e1 | Empty
19754 : |------------|
19755 : */
19756 :
19757 28549 : extern "C" void M2Quads_BuildReturn (unsigned int tokreturn)
19758 : {
19759 28549 : unsigned int tokcombined;
19760 28549 : unsigned int tokexpr;
19761 28549 : unsigned int e1;
19762 28549 : unsigned int t1;
19763 28549 : unsigned int t;
19764 28549 : unsigned int f;
19765 28549 : unsigned int Des;
19766 :
19767 28549 : if (IsBoolean (1))
19768 : {
19769 1764 : PopBooltok (&t, &f, &tokexpr);
19770 : /* Des will be a boolean type */
19771 1764 : Des = SymbolTable_MakeTemporary (tokexpr, SymbolTable_RightValue);
19772 1764 : SymbolTable_PutVar (Des, M2Base_Boolean);
19773 1764 : M2Quads_PushTFtok (Des, M2Base_Boolean, tokexpr);
19774 1764 : PushBooltok (t, f, tokexpr);
19775 1764 : BuildAssignmentWithoutBounds (tokreturn, false, true);
19776 1764 : M2Quads_PushTFtok (Des, M2Base_Boolean, tokexpr);
19777 : }
19778 28549 : M2Quads_PopTFtok (&e1, &t1, &tokexpr);
19779 28549 : tokcombined = M2LexBuf_MakeVirtualTok (tokreturn, tokreturn, tokexpr);
19780 28549 : if (e1 != SymbolTable_NulSym)
19781 : {
19782 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
19783 : /* Check we are in a procedure scope and that the procedure has a return type. */
19784 27713 : if (CurrentProc == SymbolTable_NulSym)
19785 : {
19786 6 : M2MetaError_MetaErrorT0 (tokcombined, (const char *) "{%1E} attempting to return a value when not in a procedure scope", 64);
19787 : }
19788 27707 : else if ((SymbolTable_GetSType (CurrentProc)) == SymbolTable_NulSym)
19789 : {
19790 : /* avoid dangling else. */
19791 6 : M2MetaError_MetaErrorT1 (tokcombined, (const char *) "attempting to return a value from procedure {%1Ea} which does not have a return type", 84, CurrentProc);
19792 : }
19793 : else
19794 : {
19795 : /* avoid dangling else. */
19796 27701 : BuildReturnLower (tokcombined, tokexpr, e1, t1);
19797 : }
19798 : }
19799 28549 : GenQuadO (tokcombined, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PopWord (ReturnStack), false);
19800 28549 : M2StackWord_PushWord (ReturnStack, NextQuad-1);
19801 28549 : }
19802 :
19803 :
19804 : /*
19805 : BuildModulePriority - assigns the current module with a priority
19806 : from the top of stack.
19807 :
19808 : Entry Exit
19809 : ===== ====
19810 :
19811 :
19812 : Ptr -> Empty
19813 : +------------+
19814 : | Priority |
19815 : |------------|
19816 : */
19817 :
19818 38 : extern "C" void M2Quads_BuildModulePriority (void)
19819 : {
19820 38 : unsigned int Priority;
19821 :
19822 38 : M2Quads_PopT (&Priority);
19823 38 : SymbolTable_PutPriority (SymbolTable_GetCurrentModule (), Priority);
19824 38 : }
19825 :
19826 :
19827 : /*
19828 : StartBuildWith - performs the with statement.
19829 : The Stack:
19830 :
19831 : Entry Exit
19832 :
19833 : +------------+
19834 : | Sym | Type | Empty
19835 : |------------|
19836 : */
19837 :
19838 5722 : extern "C" void M2Quads_StartBuildWith (unsigned int withTok)
19839 : {
19840 5722 : unsigned int tok;
19841 5722 : unsigned int Sym;
19842 5722 : unsigned int Type;
19843 5722 : unsigned int Ref;
19844 :
19845 5722 : DebugLocation (static_cast<unsigned int> (M2Reserved_withtok), (const char *) "with", 4);
19846 5722 : BuildStmtNoteTok (withTok);
19847 5722 : M2Quads_DisplayStack ();
19848 5722 : M2Quads_PopTFtok (&Sym, &Type, &tok);
19849 5722 : DebugLocation (tok, (const char *) "expression", 10);
19850 5722 : Type = SymbolTable_SkipType (Type);
19851 5722 : if (Type == SymbolTable_NulSym)
19852 : {
19853 6 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1Aa} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type", 104, Sym);
19854 : }
19855 : else
19856 : {
19857 5716 : Ref = SymbolTable_MakeTemporary (tok, SymbolTable_LeftValue);
19858 5716 : SymbolTable_PutVar (Ref, Type);
19859 5716 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
19860 : {
19861 : /* Copy LeftValue. */
19862 5442 : GenQuadO (tok, M2Quads_BecomesOp, Ref, SymbolTable_NulSym, Sym, true);
19863 : }
19864 : else
19865 : {
19866 : /* Calculate the address of Sym. */
19867 274 : GenQuadO (tok, M2Quads_AddrOp, Ref, SymbolTable_NulSym, Sym, true);
19868 : }
19869 5716 : PushWith (Sym, Type, Ref, tok);
19870 5716 : DebugLocation (tok, (const char *) "with ref", 8);
19871 5716 : if (! (SymbolTable_IsRecord (Type)))
19872 : {
19873 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "the {%kWITH} statement requires that {%1Ea} {%1d} be of a {%kRECORD} {%1tsa:type rather than {%1tsa}}", 101, Sym);
19874 : }
19875 5716 : SymbolTable_StartScope (Type);
19876 : }
19877 5716 : M2StackSpell_Push (Type);
19878 5716 : M2Quads_DisplayStack ();
19879 5716 : }
19880 :
19881 :
19882 : /*
19883 : EndBuildWith - terminates the innermost with scope.
19884 : */
19885 :
19886 5716 : extern "C" void M2Quads_EndBuildWith (void)
19887 : {
19888 5716 : M2Quads_DisplayStack ();
19889 5716 : SymbolTable_EndScope ();
19890 5716 : PopWith ();
19891 5716 : M2StackSpell_Pop ();
19892 5716 : M2Quads_DisplayStack ();
19893 5716 : }
19894 :
19895 :
19896 : /*
19897 : CheckWithReference - performs the with statement.
19898 : The Stack:
19899 :
19900 : Entry Exit
19901 :
19902 : +------------+ +------------+
19903 : | Sym | Type | | Sym | Type |
19904 : |------------| |------------|
19905 : */
19906 :
19907 673011 : extern "C" void M2Quads_CheckWithReference (void)
19908 : {
19909 673011 : M2Quads_WithFrame f;
19910 673011 : unsigned int tokpos;
19911 673011 : unsigned int i;
19912 673011 : unsigned int n;
19913 673011 : unsigned int rw;
19914 673011 : unsigned int Sym;
19915 673011 : unsigned int Type;
19916 :
19917 673011 : n = M2StackAddress_NoOfItemsInStackAddress (WithStack);
19918 673011 : if ((n > 0) && ! SuppressWith)
19919 : {
19920 98036 : PopTFrwtok (&Sym, &Type, &rw, &tokpos);
19921 98036 : M2Debug_Assert (tokpos != M2LexBuf_UnknownTokenNo);
19922 98036 : if (SymbolTable_IsUnknown (Sym))
19923 : {
19924 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1ad} is unknown {%1&s}", 24, Sym);
19925 6 : SymbolTable_UnknownReported (Sym);
19926 : }
19927 : else
19928 : {
19929 : /* Inner WITH always has precedence. */
19930 : i = 1; /* top of stack */
19931 : /* WriteString('Checking for a with') ; */
19932 208234 : while (i <= n)
19933 : {
19934 110204 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PeepAddress (WithStack, i));
19935 110204 : if ((SymbolTable_IsRecordField (Sym)) && ((SymbolTable_GetRecord (SymbolTable_GetParent (Sym))) == f->RecordType))
19936 : {
19937 28984 : if (SymbolTable_IsUnused (Sym))
19938 : {
19939 0 : M2MetaError_MetaError1 ((const char *) "record field {%1Dad} was declared as unused by a pragma", 55, Sym);
19940 : }
19941 : /* Fake a RecordSym.op */
19942 28984 : PushTFrwtok (f->RecordRef, f->RecordType, f->rw, f->RecordTokPos);
19943 28984 : M2Quads_PushTFtok (Sym, Type, tokpos);
19944 28984 : BuildAccessWithField ();
19945 28984 : PopTFrw (&Sym, &Type, &f->rw);
19946 28984 : i = n+1; /* Finish loop. */
19947 : }
19948 : else
19949 : {
19950 81220 : i += 1;
19951 : }
19952 : }
19953 : }
19954 98036 : PushTFrwtok (Sym, Type, rw, tokpos);
19955 : }
19956 673011 : }
19957 :
19958 :
19959 : /*
19960 : BuildDesignatorRecord - Builds the record referencing.
19961 : The Stack is expected to contain:
19962 :
19963 :
19964 : Entry Exit
19965 : ===== ====
19966 :
19967 : Ptr ->
19968 : +--------------+
19969 : | n |
19970 : |--------------|
19971 : | fld1 | type1 |
19972 : |--------------|
19973 : . .
19974 : . .
19975 : . .
19976 : |--------------|
19977 : | fldn | typen | <- Ptr
19978 : |--------------| +-------------+
19979 : | Sym | Type | | S | type1|
19980 : |--------------| |-------------|
19981 : */
19982 :
19983 114328 : extern "C" void M2Quads_BuildDesignatorRecord (unsigned int dottok)
19984 : {
19985 114328 : unsigned int RecordTok;
19986 114328 : unsigned int FieldTok;
19987 114328 : unsigned int combinedtok;
19988 114328 : unsigned int n;
19989 114328 : unsigned int rw;
19990 114328 : unsigned int Field;
19991 114328 : unsigned int FieldType;
19992 114328 : unsigned int RecordSym;
19993 114328 : unsigned int Res;
19994 :
19995 114328 : M2Quads_PopT (&n);
19996 114328 : RecordSym = static_cast<unsigned int> (M2Quads_OperandT (n+1));
19997 : /* RecordType could be found by: SkipType (OperandF (n+1)). */
19998 114328 : RecordTok = static_cast<unsigned int> (M2Quads_OperandTok (n+1));
19999 114328 : rw = static_cast<unsigned int> (OperandMergeRW (n+1));
20000 114328 : M2Debug_Assert (SymbolTable_IsLegal (rw));
20001 114328 : Field = static_cast<unsigned int> (M2Quads_OperandT (n));
20002 114328 : FieldType = SymbolTable_SkipType (M2Quads_OperandF (n));
20003 114328 : FieldTok = static_cast<unsigned int> (M2Quads_OperandTok (n));
20004 114328 : combinedtok = M2LexBuf_MakeVirtualTok (dottok, RecordTok, FieldTok);
20005 114328 : if (n > 1)
20006 : {
20007 0 : M2Error_InternalError ((const char *) "not expecting to see n>1", 24);
20008 : }
20009 114328 : if (SymbolTable_IsUnused (Field))
20010 : {
20011 0 : M2MetaError_MetaErrors1 ((const char *) "record field {%1Dad} was declared as unused by a pragma", 55, (const char *) "record field {%1ad} is being used after being declared as unused by a pragma", 76, Field);
20012 : }
20013 114328 : Res = SymbolTable_MakeComponentRef (SymbolTable_MakeComponentRecord (combinedtok, SymbolTable_RightValue, RecordSym), Field);
20014 114328 : SymbolTable_PutVarConst (Res, IsReadOnly (RecordSym));
20015 114328 : GenQuadO (combinedtok, M2Quads_RecordFieldOp, Res, RecordSym, Field, false);
20016 114328 : M2Quads_PopN (n+1);
20017 114328 : PushTFrwtok (Res, FieldType, rw, combinedtok);
20018 114328 : }
20019 :
20020 :
20021 : /*
20022 : BuildDesignatorArray - Builds the array referencing.
20023 : The purpose of this procedure is to work out
20024 : whether the DesignatorArray is a constant string or
20025 : dynamic array/static array and to call the appropriate
20026 : BuildRoutine.
20027 :
20028 : The Stack is expected to contain:
20029 :
20030 : Entry Exit
20031 : ===== ====
20032 :
20033 : Ptr ->
20034 : +--------------+
20035 : | e | <- Ptr
20036 : |--------------| +------------+
20037 : | Sym | Type | | S | T |
20038 : |--------------| |------------|
20039 : */
20040 :
20041 55832 : extern "C" void M2Quads_BuildDesignatorArray (void)
20042 : {
20043 55832 : if ((SymbolTable_IsConst (M2Quads_OperandT (2))) && (SymbolTable_IsConstString (M2Quads_OperandT (2))))
20044 : {
20045 6 : M2MetaError_MetaErrorT1 (OperandTtok (2), (const char *) "{%1Ead} is not an array, but a constant string. Hint use a string constant created with an array constructor", 109, M2Quads_OperandT (2));
20046 6 : BuildDesignatorError ((const char *) "bad array access", 16);
20047 : }
20048 : else
20049 : {
20050 55826 : BuildDesignatorArrayStaticDynamic ();
20051 : }
20052 55826 : }
20053 :
20054 :
20055 : /*
20056 : BuildDesignatorPointer - Builds a pointer reference.
20057 : The Stack is expected to contain:
20058 :
20059 :
20060 : Entry Exit
20061 : ===== ====
20062 :
20063 : Ptr -> <- Ptr
20064 : +--------------+ +--------------+
20065 : | Sym1 | Type1| | Sym2 | Type2|
20066 : |--------------| |--------------|
20067 : */
20068 :
20069 19752 : extern "C" void M2Quads_BuildDesignatorPointer (unsigned int ptrtok)
20070 : {
20071 19752 : unsigned int combinedtok;
20072 19752 : unsigned int destok;
20073 19752 : unsigned int rw;
20074 19752 : unsigned int Sym1;
20075 19752 : unsigned int Type1;
20076 19752 : unsigned int Sym2;
20077 19752 : unsigned int Type2;
20078 :
20079 19752 : PopTFrwtok (&Sym1, &Type1, &rw, &destok);
20080 19752 : DebugLocation (destok, (const char *) "des ptr expression", 18);
20081 19752 : Type1 = SymbolTable_SkipType (Type1);
20082 19752 : if (Type1 == SymbolTable_NulSym)
20083 : {
20084 0 : M2MetaError_MetaErrorT1 (ptrtok, (const char *) "{%1ad} has no type and therefore cannot be dereferenced by ^", 60, Sym1);
20085 : }
20086 19752 : else if (SymbolTable_IsUnknown (Sym1))
20087 : {
20088 : /* avoid dangling else. */
20089 : /* Spellcheck. */
20090 0 : M2MetaError_MetaError1 ((const char *) "{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved {%1&s}", 69, Sym1);
20091 0 : SymbolTable_UnknownReported (Sym1);
20092 : }
20093 : else
20094 : {
20095 : /* avoid dangling else. */
20096 19752 : combinedtok = M2LexBuf_MakeVirtual2Tok (destok, ptrtok);
20097 19752 : if (SymbolTable_IsPointer (Type1))
20098 : {
20099 19750 : Type2 = SymbolTable_GetSType (Type1);
20100 19750 : Sym2 = SymbolTable_MakeTemporary (ptrtok, SymbolTable_LeftValue);
20101 : /*
20102 : Ok must reference by address
20103 : - but we contain the type of the referenced entity
20104 : */
20105 19750 : MarkAsRead (rw);
20106 19750 : SymbolTable_PutVarPointerCheck (Sym1, true);
20107 19750 : CheckPointerThroughNil (ptrtok, Sym1);
20108 19750 : if ((SymbolTable_GetMode (Sym1)) == SymbolTable_LeftValue)
20109 : {
20110 510 : rw = SymbolTable_NulSym;
20111 510 : SymbolTable_PutLeftValueFrontBackType (Sym2, Type2, Type1);
20112 510 : GenQuadO (ptrtok, M2Quads_IndrXOp, Sym2, Type1, Sym1, false); /* Sym2 := *Sym1. */
20113 : }
20114 : else
20115 : {
20116 19240 : SymbolTable_PutLeftValueFrontBackType (Sym2, Type2, SymbolTable_NulSym);
20117 19240 : GenQuadO (ptrtok, M2Quads_BecomesOp, Sym2, SymbolTable_NulSym, Sym1, false); /* Sym2 := Sym1. */
20118 : }
20119 : /* We should check this for Sym2 later on (pointer via NIL). */
20120 19750 : SymbolTable_PutVarPointerCheck (Sym2, true);
20121 19750 : PushTFrwtok (Sym2, Type2, rw, combinedtok);
20122 19750 : DebugLocation (combinedtok, (const char *) "pointer expression", 18);
20123 : }
20124 2 : else if ((SymbolTable_IsHiddenType (Type1)) && ((SymbolTable_GetModuleScope (Type1)) != (SymbolTable_GetCurrentModuleScope ())))
20125 : {
20126 : /* avoid dangling else. */
20127 2 : M2MetaError_MetaErrorT1 (ptrtok, (const char *) "{%1Ead} is declared with an opaque type from a different module and cannot be dereferenced", 90, Sym1);
20128 2 : MarkAsRead (rw);
20129 2 : BuildDesignatorPointerError (Type1, rw, combinedtok, (const char *) "bad opaque pointer dereference", 30);
20130 : }
20131 : else
20132 : {
20133 : /* avoid dangling else. */
20134 0 : M2MetaError_MetaError2 ((const char *) "{%1Ead} is not a pointer type but a {%2dv}", 42, Sym1, Type1);
20135 0 : MarkAsRead (rw);
20136 0 : BuildDesignatorPointerError (Type1, rw, combinedtok, (const char *) "bad pointer dereference", 23);
20137 : }
20138 : }
20139 19752 : }
20140 :
20141 :
20142 : /*
20143 : BuildNulExpression - Builds a nul expression on the stack.
20144 : The Stack:
20145 :
20146 : Entry Exit
20147 :
20148 : <- Ptr
20149 : Empty +------------+
20150 : | NulSym |
20151 : |------------|
20152 : tokpos is the position of the RETURN token.
20153 : */
20154 :
20155 836 : extern "C" void M2Quads_BuildNulExpression (unsigned int tokpos)
20156 : {
20157 836 : M2Quads_PushTtok (static_cast<unsigned int> (SymbolTable_NulSym), tokpos);
20158 836 : }
20159 :
20160 :
20161 : /*
20162 : BuildSetStart - Pushes a Bitset type on the stack.
20163 :
20164 : The Stack:
20165 :
20166 : Entry Exit
20167 :
20168 : Ptr -> <- Ptr
20169 :
20170 : Empty +--------------+
20171 : | Bitset |
20172 : |--------------|
20173 : */
20174 :
20175 0 : extern "C" void M2Quads_BuildSetStart (unsigned int tokpos)
20176 : {
20177 0 : M2Quads_PushTtok (M2Bitset_Bitset, tokpos);
20178 0 : }
20179 :
20180 :
20181 : /*
20182 : BuildSetEnd - pops the set value and type from the stack
20183 : and pushes the value,type pair.
20184 :
20185 : Entry Exit
20186 :
20187 : Ptr ->
20188 : +--------------+
20189 : | Set Value | <- Ptr
20190 : |--------------| +--------------+
20191 : | Set Type | | Value | Type |
20192 : |--------------| |--------------|
20193 : */
20194 :
20195 0 : extern "C" void M2Quads_BuildSetEnd (void)
20196 : {
20197 0 : unsigned int valuepos;
20198 0 : unsigned int typepos;
20199 0 : unsigned int combined;
20200 0 : unsigned int value;
20201 0 : unsigned int type;
20202 :
20203 0 : M2Quads_PopTtok (&value, &valuepos);
20204 0 : M2Quads_PopTtok (&type, &typepos);
20205 0 : combined = M2LexBuf_MakeVirtual2Tok (typepos, valuepos);
20206 0 : M2Quads_PushTFtok (value, type, combined);
20207 0 : M2Debug_Assert (SymbolTable_IsSet (type));
20208 0 : }
20209 :
20210 :
20211 : /*
20212 : BuildEmptySet - Builds an empty set on the stack.
20213 : The Stack:
20214 :
20215 : Entry Exit
20216 :
20217 : <- Ptr
20218 : +-------------+
20219 : Ptr -> | Value |
20220 : +-----------+ |-------------|
20221 : | SetType | | SetType |
20222 : |-----------| |-------------|
20223 :
20224 : tokpos points to the opening '{'.
20225 : */
20226 :
20227 0 : extern "C" void M2Quads_BuildEmptySet (unsigned int tokpos)
20228 : {
20229 0 : NameKey_Name n;
20230 0 : unsigned int typepos;
20231 0 : unsigned int Type;
20232 0 : unsigned int NulSet;
20233 :
20234 0 : M2Quads_PopTtok (&Type, &typepos); /* type of set we are building */
20235 0 : if ((Type == SymbolTable_NulSym) && M2Options_Pim)
20236 : {
20237 : /* allowed generic {} in PIM Modula-2 */
20238 0 : typepos = tokpos;
20239 : }
20240 0 : else if (SymbolTable_IsUnknown (Type))
20241 : {
20242 : /* avoid dangling else. */
20243 : /* Spellcheck. */
20244 0 : M2MetaError_MetaError1 ((const char *) "set type {%1a} is undefined {%1&s}", 34, Type);
20245 0 : SymbolTable_UnknownReported (Type);
20246 0 : Type = M2Bitset_Bitset;
20247 : }
20248 0 : else if (! (SymbolTable_IsSet (SymbolTable_SkipType (Type))))
20249 : {
20250 : /* avoid dangling else. */
20251 0 : M2MetaError_MetaError1 ((const char *) "expecting a set type {%1a} and not a {%1d}", 42, Type);
20252 0 : Type = M2Bitset_Bitset;
20253 : }
20254 : else
20255 : {
20256 : /* avoid dangling else. */
20257 0 : Type = SymbolTable_SkipType (Type);
20258 0 : M2Debug_Assert (Type != SymbolTable_NulSym);
20259 : }
20260 0 : NulSet = SymbolTable_MakeTemporary (typepos, SymbolTable_ImmediateValue);
20261 0 : SymbolTable_PutVar (NulSet, Type);
20262 0 : SymbolTable_PutConstSet (NulSet);
20263 0 : if (M2Options_CompilerDebugging)
20264 : {
20265 0 : n = SymbolTable_GetSymName (Type);
20266 0 : M2Printf_printf1 ((const char *) "set type = %a\\n", 15, (const unsigned char *) &n, (sizeof (n)-1));
20267 : }
20268 0 : M2ALU_PushNulSet (Type); /* onto the ALU stack */
20269 0 : SymbolTable_PopValue (NulSet); /* ALU -> symbol table */
20270 : /* and now construct the M2Quads stack as defined by the comments above */
20271 0 : M2Quads_PushTtok (Type, typepos);
20272 0 : M2Quads_PushTtok (NulSet, typepos);
20273 0 : if (M2Options_CompilerDebugging)
20274 : {
20275 0 : n = SymbolTable_GetSymName (Type);
20276 0 : M2Printf_printf2 ((const char *) "Type = %a (%d) built empty set\\n", 34, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &Type, (sizeof (Type)-1));
20277 0 : M2Quads_DisplayStack (); /* Debugging info */
20278 : }
20279 0 : }
20280 :
20281 :
20282 : /*
20283 : BuildInclRange - includes a set range with a set.
20284 :
20285 :
20286 : Entry Exit
20287 : ===== ====
20288 :
20289 :
20290 : Ptr ->
20291 : +------------+
20292 : | El2 |
20293 : |------------|
20294 : | El1 | <- Ptr
20295 : |------------| +-------------------+
20296 : | Set Value | | Value + {El1..El2}|
20297 : |------------| |-------------------|
20298 :
20299 : No quadruples produced as the range info is contained within
20300 : the set value.
20301 : */
20302 :
20303 0 : extern "C" void M2Quads_BuildInclRange (void)
20304 : {
20305 0 : NameKey_Name n;
20306 0 : unsigned int el1;
20307 0 : unsigned int el2;
20308 0 : unsigned int value;
20309 :
20310 0 : M2Quads_PopT (&el2);
20311 0 : M2Quads_PopT (&el1);
20312 0 : M2Quads_PopT (&value);
20313 0 : if (! (SymbolTable_IsConstSet (value)))
20314 : {
20315 0 : n = SymbolTable_GetSymName (el1);
20316 0 : M2Error_WriteFormat1 ((const char *) "can only add bit ranges to a constant set, %a is not a constant set", 67, (const unsigned char *) &n, (sizeof (n)-1));
20317 : }
20318 0 : if ((SymbolTable_IsConst (el1)) && (SymbolTable_IsConst (el2)))
20319 : {
20320 0 : SymbolTable_PushValue (value); /* onto ALU stack */
20321 0 : M2ALU_AddBitRange (M2LexBuf_GetTokenNo (), el1, el2); /* onto ALU stack */
20322 0 : SymbolTable_PopValue (value); /* ALU -> symboltable */
20323 : }
20324 : else
20325 : {
20326 0 : if (! (SymbolTable_IsConst (el1)))
20327 : {
20328 0 : n = SymbolTable_GetSymName (el1);
20329 0 : M2Error_WriteFormat1 ((const char *) "must use constants as ranges when defining a set constant, problem with the low value %a", 88, (const unsigned char *) &n, (sizeof (n)-1));
20330 : }
20331 0 : if (! (SymbolTable_IsConst (el2)))
20332 : {
20333 0 : n = SymbolTable_GetSymName (el2);
20334 0 : M2Error_WriteFormat1 ((const char *) "must use constants as ranges when defining a set constant, problem with the high value %a", 89, (const unsigned char *) &n, (sizeof (n)-1));
20335 : }
20336 : }
20337 0 : M2Quads_PushT (value);
20338 0 : }
20339 :
20340 :
20341 : /*
20342 : BuildInclBit - includes a bit into the set.
20343 :
20344 : Entry Exit
20345 : ===== ====
20346 :
20347 :
20348 : Ptr ->
20349 : +------------+
20350 : | Element | <- Ptr
20351 : |------------| +------------+
20352 : | Value | | Value |
20353 : |------------| |------------|
20354 :
20355 : */
20356 :
20357 11908 : extern "C" void M2Quads_BuildInclBit (void)
20358 : {
20359 11908 : unsigned int tok;
20360 11908 : unsigned int el;
20361 11908 : unsigned int value;
20362 11908 : unsigned int t;
20363 :
20364 11908 : M2Quads_PopT (&el);
20365 11908 : M2Quads_PopT (&value);
20366 11908 : tok = M2LexBuf_GetTokenNo ();
20367 11908 : if (SymbolTable_IsConst (el))
20368 : {
20369 11836 : SymbolTable_PushValue (value); /* onto ALU stack */
20370 11836 : M2ALU_AddBit (tok, el); /* onto ALU stack */
20371 11836 : SymbolTable_PopValue (value); /* ALU -> symboltable */
20372 : }
20373 : else
20374 : {
20375 72 : if ((SymbolTable_GetMode (el)) == SymbolTable_LeftValue)
20376 : {
20377 0 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
20378 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (el));
20379 0 : CheckPointerThroughNil (tok, el);
20380 0 : doIndrX (tok, t, el);
20381 0 : el = t;
20382 : }
20383 72 : if (SymbolTable_IsConst (value))
20384 : {
20385 : /* move constant into a variable to achieve the include */
20386 72 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
20387 72 : SymbolTable_PutVar (t, SymbolTable_GetSType (value));
20388 72 : GenQuad (M2Quads_BecomesOp, t, SymbolTable_NulSym, value);
20389 72 : value = t;
20390 : }
20391 72 : GenQuad (M2Quads_InclOp, value, SymbolTable_NulSym, el);
20392 : }
20393 11908 : M2Quads_PushT (value);
20394 11908 : }
20395 :
20396 :
20397 : /*
20398 : SilentBuildConstructor - places NulSym into the constructor fifo queue.
20399 : */
20400 :
20401 0 : extern "C" void M2Quads_SilentBuildConstructor (void)
20402 : {
20403 0 : FifoQueue_PutConstructorIntoFifoQueue (SymbolTable_NulSym);
20404 0 : }
20405 :
20406 :
20407 : /*
20408 : SilentBuildConstructorStart - removes an entry from the constructor fifo queue.
20409 : */
20410 :
20411 25444 : extern "C" void M2Quads_SilentBuildConstructorStart (void)
20412 : {
20413 25444 : unsigned int constValue;
20414 :
20415 25444 : FifoQueue_GetConstructorFromFifoQueue (&constValue);
20416 25444 : }
20417 :
20418 :
20419 : /*
20420 : BuildConstructor - builds a constructor.
20421 : Stack
20422 :
20423 : Entry Exit
20424 :
20425 : Ptr ->
20426 : +------------+
20427 : | Type | <- Ptr
20428 : |------------+
20429 : */
20430 :
20431 36470 : extern "C" void M2Quads_BuildConstructor (unsigned int tokcbrpos)
20432 : {
20433 36470 : unsigned int tok;
20434 36470 : unsigned int constValue;
20435 36470 : unsigned int type;
20436 :
20437 36470 : M2Quads_PopTtok (&type, &tok);
20438 36470 : constValue = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
20439 36470 : SymbolTable_PutVar (constValue, type);
20440 36470 : SymbolTable_PutConstructor (constValue);
20441 36470 : SymbolTable_PushValue (constValue);
20442 36470 : if (type == SymbolTable_NulSym)
20443 : {
20444 6 : M2MetaError_MetaErrorT0 (tokcbrpos, (const char *) "{%E}constructor requires a type before the opening %{", 53);
20445 : }
20446 : else
20447 : {
20448 36464 : M2ALU_ChangeToConstructor (tok, type);
20449 36464 : SymbolTable_PutConstructorFrom (constValue, type);
20450 36464 : SymbolTable_PopValue (constValue);
20451 36464 : FifoQueue_PutConstructorIntoFifoQueue (constValue);
20452 : }
20453 36470 : PushConstructor (type);
20454 36470 : }
20455 :
20456 :
20457 : /*
20458 : BuildConstructorStart - builds a constructor.
20459 : Stack
20460 :
20461 : Entry Exit
20462 :
20463 : Ptr -> <- Ptr
20464 : +------------+ +----------------+
20465 : | Type | | ConstructorSym |
20466 : |------------+ |----------------|
20467 : */
20468 :
20469 11014 : extern "C" void M2Quads_BuildConstructorStart (unsigned int cbratokpos)
20470 : {
20471 11014 : unsigned int typepos;
20472 11014 : unsigned int constValue;
20473 11014 : unsigned int type;
20474 :
20475 11014 : M2Quads_PopTtok (&type, &typepos); /* we ignore the type as we already have the constructor symbol from pass C */
20476 11014 : FifoQueue_GetConstructorFromFifoQueue (&constValue); /* we ignore the type as we already have the constructor symbol from pass C */
20477 11014 : if (type != (SymbolTable_GetSType (constValue)))
20478 : {
20479 0 : M2MetaError_MetaErrorT3 (cbratokpos, (const char *) "{%E}the constructor type is {%1ad} and this is different from the constant {%2ad} which has a type {%2tad}", 106, type, constValue, constValue);
20480 : }
20481 11014 : M2Quads_PushTtok (constValue, cbratokpos);
20482 11014 : PushConstructor (type);
20483 11014 : }
20484 :
20485 :
20486 : /*
20487 : BuildConstructorEnd - removes the current constructor frame from the
20488 : constructor stack (it does not effect the quad
20489 : stack)
20490 :
20491 : Entry Exit
20492 :
20493 : Ptr -> <- Ptr
20494 : +------------+ +------------+
20495 : | const | | const |
20496 : |------------| |------------|
20497 :
20498 : startpos is the start of the constructor, either the typename or '{'
20499 : cbratokpos is the '}'.
20500 : */
20501 :
20502 11014 : extern "C" void M2Quads_BuildConstructorEnd (unsigned int startpos, unsigned int cbratokpos)
20503 : {
20504 11014 : unsigned int value;
20505 11014 : unsigned int valtok;
20506 :
20507 11014 : if (DebugTokPos)
20508 : {
20509 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "startpos", 8), startpos);
20510 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "cbratokpos", 10), cbratokpos);
20511 : }
20512 11014 : M2Quads_PopTtok (&value, &valtok);
20513 11014 : if (DebugTokPos)
20514 : {
20515 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "value valtok", 12), valtok);
20516 : }
20517 11014 : valtok = M2LexBuf_MakeVirtual2Tok (startpos, cbratokpos);
20518 11014 : SymbolTable_PutDeclared (valtok, value);
20519 11014 : M2Quads_PushTtok (value, valtok); /* Use valtok as we now know it was a constructor. */
20520 11014 : M2Quads_PopConstructor (); /* Use valtok as we now know it was a constructor. */
20521 11014 : if (DebugTokPos)
20522 : {
20523 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "aggregate constant", 18), valtok);
20524 : }
20525 11014 : }
20526 :
20527 :
20528 : /*
20529 : NextConstructorField - increments the top of constructor stacks index by one.
20530 : */
20531 :
20532 35076 : extern "C" void M2Quads_NextConstructorField (void)
20533 : {
20534 35076 : M2Quads_ConstructorFrame c;
20535 :
20536 35076 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PeepAddress (ConstructorStack, 1));
20537 35076 : c->index += 1;
20538 35076 : }
20539 :
20540 :
20541 : /*
20542 : BuildTypeForConstructor - pushes the type implied by the current constructor.
20543 : If no constructor is currently being built then
20544 : it Pushes a Bitset type.
20545 : */
20546 :
20547 1700 : extern "C" void M2Quads_BuildTypeForConstructor (unsigned int tokpos)
20548 : {
20549 1700 : M2Quads_ConstructorFrame c;
20550 :
20551 1700 : if ((M2StackAddress_NoOfItemsInStackAddress (ConstructorStack)) == 0)
20552 : {
20553 632 : M2Quads_PushTtok (M2Bitset_Bitset, tokpos);
20554 : }
20555 : else
20556 : {
20557 1068 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PeepAddress (ConstructorStack, 1));
20558 1068 : if ((SymbolTable_IsArray (c->type)) || (SymbolTable_IsSet (c->type)))
20559 : {
20560 972 : M2Quads_PushTtok (SymbolTable_GetSType (c->type), tokpos);
20561 : }
20562 96 : else if (SymbolTable_IsRecord (c->type))
20563 : {
20564 : /* avoid dangling else. */
20565 96 : M2Quads_PushTtok (SymbolTable_GetSType (SymbolTable_GetNth (c->type, c->index)), tokpos);
20566 : }
20567 : else
20568 : {
20569 : /* avoid dangling else. */
20570 0 : M2MetaError_MetaError1 ((const char *) "{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity", 97, c->type);
20571 : }
20572 : }
20573 1700 : }
20574 :
20575 :
20576 : /*
20577 : BuildComponentValue - builds a component value.
20578 :
20579 : Entry Exit
20580 :
20581 : Ptr -> <- Ptr
20582 :
20583 :
20584 : +------------+ +------------+
20585 : | const | | const |
20586 : |------------| |------------|
20587 : */
20588 :
20589 25922 : extern "C" void M2Quads_BuildComponentValue (void)
20590 : {
20591 25922 : unsigned int const_;
20592 25922 : unsigned int e1;
20593 25922 : unsigned int e2;
20594 25922 : NameKey_Name nuldotdot;
20595 25922 : NameKey_Name nulby;
20596 :
20597 25922 : M2Quads_PopT (&nulby);
20598 25922 : if (nulby == M2Reserved_NulTok)
20599 : {
20600 25892 : M2Quads_PopT (&nuldotdot);
20601 25892 : if (nuldotdot == M2Reserved_NulTok)
20602 : {
20603 25650 : M2Quads_PopT (&e1);
20604 25650 : M2Quads_PopT (&const_);
20605 25650 : M2Quads_PushT (AddFieldTo (const_, e1));
20606 : }
20607 : else
20608 : {
20609 242 : M2Quads_PopT (&e2);
20610 242 : M2Quads_PopT (&e1);
20611 242 : M2Quads_PopT (&const_);
20612 242 : SymbolTable_PushValue (const_);
20613 242 : M2ALU_AddBitRange (M2LexBuf_GetTokenNo (), e1, e2);
20614 242 : SymbolTable_PopValue (const_);
20615 242 : M2Quads_PushT (const_);
20616 : }
20617 : }
20618 : else
20619 : {
20620 30 : M2Quads_PopT (&e1);
20621 30 : M2Quads_PopT (&nuldotdot);
20622 30 : if (nuldotdot == M2Reserved_NulTok)
20623 : {
20624 30 : M2Quads_PopT (&e2);
20625 30 : M2Quads_PopT (&const_);
20626 30 : SymbolTable_PushValue (const_);
20627 30 : M2ALU_AddElements (M2LexBuf_GetTokenNo (), e2, e1);
20628 30 : SymbolTable_PopValue (const_);
20629 30 : M2Quads_PushT (const_);
20630 : }
20631 : else
20632 : {
20633 0 : M2Quads_PopT (&e2);
20634 0 : M2Quads_PopT (&e1);
20635 0 : M2Quads_PopT (&const_);
20636 0 : M2Error_WriteFormat0 ((const char *) "the constant must be either an array constructor or a set constructor", 69);
20637 0 : M2Quads_PushT (const_);
20638 : }
20639 : }
20640 25922 : }
20641 :
20642 :
20643 : /*
20644 : PopConstructor - removes the top constructor from the top of stack.
20645 : */
20646 :
20647 47484 : extern "C" void M2Quads_PopConstructor (void)
20648 : {
20649 47484 : M2Quads_ConstructorFrame c;
20650 :
20651 47484 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PopAddress (ConstructorStack));
20652 47484 : Storage_DEALLOCATE ((void **) &c, sizeof (M2Quads__T1));
20653 47484 : }
20654 :
20655 :
20656 : /*
20657 : BuildNot - Builds a NOT operation from the quad stack.
20658 : The Stack is expected to contain:
20659 :
20660 :
20661 : Entry Exit
20662 : ===== ====
20663 :
20664 : Ptr -> <- Ptr
20665 : +------------+ +------------+
20666 : | t | f | | f | t |
20667 : |------------| |------------|
20668 : */
20669 :
20670 4696 : extern "C" void M2Quads_BuildNot (unsigned int notTokPos)
20671 : {
20672 4696 : unsigned int combinedTok;
20673 4696 : unsigned int exprTokPos;
20674 4696 : unsigned int t;
20675 4696 : unsigned int f;
20676 :
20677 4696 : CheckBooleanId ();
20678 4696 : PopBooltok (&t, &f, &exprTokPos);
20679 4696 : combinedTok = M2LexBuf_MakeVirtualTok (notTokPos, notTokPos, exprTokPos);
20680 4696 : PushBooltok (f, t, combinedTok);
20681 4696 : }
20682 :
20683 :
20684 : /*
20685 : RecordOp - Records the operator passed on the stack.
20686 : This is called when a boolean operator is found in an
20687 : expression. It is called just after the lhs has been built
20688 : and pushed to the quad stack and prior to the rhs build.
20689 : It checks to see if AND OR or equality tests are required.
20690 : It will short circuit AND and OR expressions. It also
20691 : converts a lhs to a boolean variable if an xor comparison
20692 : is about to be performed.
20693 :
20694 : Checks for AND operator or OR operator
20695 : if either of these operators are found then BackPatching
20696 : takes place.
20697 : The Expected Stack:
20698 :
20699 : Entry Exit
20700 :
20701 : Ptr -> <- Ptr
20702 : +-------------+ +-------------+
20703 : | OperatorTok | | OperatorTok |
20704 : |-------------| |-------------|
20705 : | t | f | | t | f |
20706 : |-------------| |-------------|
20707 :
20708 :
20709 : If OperatorTok=AndTok
20710 : Then
20711 : BackPatch(f, NextQuad)
20712 : Elsif OperatorTok=OrTok
20713 : Then
20714 : BackPatch(t, NextQuad)
20715 : End
20716 : */
20717 :
20718 103013 : extern "C" void M2Quads_RecordOp (void)
20719 : {
20720 103013 : NameKey_Name Op;
20721 103013 : unsigned int tokno;
20722 103013 : unsigned int t;
20723 103013 : unsigned int f;
20724 :
20725 103013 : M2Quads_PopTtok (&Op, &tokno);
20726 103013 : if ((Op == M2Reserved_AndTok) || (Op == M2Reserved_AmbersandTok))
20727 : {
20728 9376 : CheckBooleanId ();
20729 9376 : PopBool (&t, &f);
20730 9376 : BackPatch (t, NextQuad);
20731 9376 : PushBool (0, f);
20732 : }
20733 93637 : else if (Op == M2Reserved_OrTok)
20734 : {
20735 : /* avoid dangling else. */
20736 3442 : CheckBooleanId ();
20737 3442 : PopBool (&t, &f);
20738 3442 : BackPatch (f, NextQuad);
20739 3442 : PushBool (t, 0);
20740 : }
20741 90195 : else if ((IsBoolean (1)) && ((((Op == M2Reserved_EqualTok) || (Op == M2Reserved_LessGreaterTok)) || (Op == M2Reserved_HashTok)) || (Op == M2Reserved_InTok)))
20742 : {
20743 : /* avoid dangling else. */
20744 52 : ConvertBooleanToVariable (tokno, 1);
20745 : }
20746 103013 : M2Quads_PushTtok (Op, tokno);
20747 103013 : }
20748 :
20749 :
20750 : /*
20751 : BuildRelOp - Builds a relative operation from the quad stack.
20752 : The Stack is expected to contain:
20753 :
20754 :
20755 : Entry Exit
20756 : ===== ====
20757 :
20758 : Ptr ->
20759 : +------------+
20760 : | e1 |
20761 : |------------| <- Ptr
20762 : | Operator |
20763 : |------------| +------------+
20764 : | e2 | | t | f |
20765 : |------------| |------------|
20766 :
20767 :
20768 : Quadruples Produced
20769 :
20770 : q IFOperator e2 e1 TrueExit ; e2 e1 since
20771 : q+1 GotoOp FalseExit ; relation > etc
20772 : ; requires order.
20773 : */
20774 :
20775 88912 : extern "C" void M2Quads_BuildRelOp (unsigned int optokpos)
20776 : {
20777 88912 : unsigned int combinedTok;
20778 88912 : unsigned int rightpos;
20779 88912 : unsigned int leftpos;
20780 88912 : NameKey_Name Op;
20781 88912 : unsigned int t;
20782 88912 : unsigned int rightType;
20783 88912 : unsigned int leftType;
20784 88912 : unsigned int right;
20785 88912 : unsigned int left;
20786 88912 : DynamicStrings_String s;
20787 :
20788 88912 : if (M2Options_CompilerDebugging)
20789 : {
20790 0 : M2Quads_DisplayStack (); /* Debugging info */
20791 : }
20792 88912 : if (((M2Quads_IsInConstExpression ()) && (IsBoolean (1))) && (IsBoolean (3)))
20793 : {
20794 : /*
20795 : we allow # and = to be used with Boolean expressions.
20796 : we do not allow > < >= <= though. We only examine
20797 : this case if we are in a const expression as there will be
20798 : no dereferencing of operands.
20799 : */
20800 0 : BuildRelOpFromBoolean (optokpos);
20801 : }
20802 : else
20803 : {
20804 88912 : if (IsBoolean (1))
20805 : {
20806 64 : ConvertBooleanToVariable (OperandTtok (1), 1);
20807 : }
20808 88912 : if (IsBoolean (3))
20809 : {
20810 0 : ConvertBooleanToVariable (OperandTtok (3), 3);
20811 : }
20812 88912 : M2Quads_PopTFtok (&right, &rightType, &rightpos);
20813 88912 : M2Quads_PopT (&Op);
20814 88912 : M2Quads_PopTFtok (&left, &leftType, &leftpos);
20815 88912 : CheckVariableOrConstantOrProcedure (rightpos, right);
20816 88912 : CheckVariableOrConstantOrProcedure (leftpos, left);
20817 88912 : combinedTok = M2LexBuf_MakeVirtualTok (optokpos, leftpos, rightpos);
20818 88912 : if ((left != SymbolTable_NulSym) && (right != SymbolTable_NulSym))
20819 : {
20820 : /* BuildRange will check the expression later on once gcc knows about all data types. */
20821 88912 : BuildRange (M2Range_InitTypesExpressionCheck (combinedTok, left, right, true, Op == M2Reserved_InTok));
20822 : }
20823 : /* Must dereference LeftValue operands. */
20824 88912 : if ((SymbolTable_GetMode (right)) == SymbolTable_LeftValue)
20825 : {
20826 1912 : t = SymbolTable_MakeTemporary (rightpos, SymbolTable_RightValue);
20827 1912 : SymbolTable_PutVar (t, SymbolTable_GetSType (right));
20828 1912 : CheckPointerThroughNil (rightpos, right);
20829 1912 : doIndrX (rightpos, t, right);
20830 1912 : right = t;
20831 : }
20832 88912 : if ((SymbolTable_GetMode (left)) == SymbolTable_LeftValue)
20833 : {
20834 6033 : t = SymbolTable_MakeTemporary (leftpos, SymbolTable_RightValue);
20835 6033 : SymbolTable_PutVar (t, SymbolTable_GetSType (left));
20836 6033 : CheckPointerThroughNil (leftpos, left);
20837 6033 : doIndrX (leftpos, t, left);
20838 6033 : left = t;
20839 : }
20840 88912 : if (DebugTokPos)
20841 : {
20842 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (M2LexBuf_GetTokenName (Op)));
20843 : M2Error_WarnStringAt (s, optokpos);
20844 : s = DynamicStrings_InitString ((const char *) "left", 4);
20845 : M2Error_WarnStringAt (s, leftpos);
20846 : s = DynamicStrings_InitString ((const char *) "right", 5);
20847 : M2Error_WarnStringAt (s, rightpos);
20848 : s = DynamicStrings_InitString ((const char *) "caret", 5);
20849 : M2Error_WarnStringAt (s, optokpos);
20850 : s = DynamicStrings_InitString ((const char *) "combined", 8);
20851 : M2Error_WarnStringAt (s, combinedTok);
20852 : }
20853 88912 : GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, false, leftpos, rightpos, M2LexBuf_UnknownTokenNo); /* True Exit */
20854 88912 : GenQuadO (combinedTok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false); /* False Exit */
20855 88912 : PushBooltok (NextQuad-2, NextQuad-1, combinedTok); /* False Exit */
20856 : }
20857 88912 : }
20858 :
20859 :
20860 : /*
20861 : BuildBinaryOp - Builds a binary operation from the quad stack.
20862 : Be aware that this procedure will check for
20863 : the overloading of the bitset operators + - \ *.
20864 : So do NOT call this procedure if you are building
20865 : a reference to an array which has a bitset type or
20866 : the address arithmetic will be wrongly coersed into
20867 : logical ORs.
20868 :
20869 : The Stack is expected to contain:
20870 :
20871 :
20872 : Entry Exit
20873 : ===== ====
20874 :
20875 : Ptr ->
20876 : +------------+
20877 : | Sym1 |
20878 : |------------|
20879 : | Operator | <- Ptr
20880 : |------------| +------------+
20881 : | Sym2 | | Temporary |
20882 : |------------| |------------|
20883 :
20884 :
20885 : Quadruples Produced
20886 :
20887 : q Operator Temporary Sym1 Sym2
20888 :
20889 :
20890 : OR
20891 :
20892 :
20893 : Entry Exit
20894 : ===== ====
20895 :
20896 : Ptr ->
20897 : +------------+
20898 : | T1 | F1 |
20899 : |------------|
20900 : | OrTok | <- Ptr
20901 : |------------| +------------+
20902 : | T2 | F2 | | T1+T2| F1 |
20903 : |------------| |------------|
20904 :
20905 :
20906 : Quadruples Produced
20907 :
20908 : */
20909 :
20910 72256 : extern "C" void M2Quads_BuildBinaryOp (void)
20911 : {
20912 72256 : doBuildBinaryOp (true, true);
20913 72148 : }
20914 :
20915 :
20916 : /*
20917 : BuildUnaryOp - Builds a unary operation from the quad stack.
20918 : The Stack is expected to contain:
20919 :
20920 :
20921 : Entry Exit
20922 : ===== ====
20923 :
20924 : Ptr ->
20925 : +------------+
20926 : | Sym |
20927 : |------------| +------------+
20928 : | Operator | | Temporary | <- Ptr
20929 : |------------| |------------|
20930 :
20931 :
20932 : Quadruples Produced
20933 :
20934 : q Operator Temporary _ Sym
20935 :
20936 : */
20937 :
20938 20674 : extern "C" void M2Quads_BuildUnaryOp (void)
20939 : {
20940 20674 : unsigned int sympos;
20941 20674 : unsigned int tokpos;
20942 20674 : NameKey_Name Tok;
20943 20674 : unsigned int type;
20944 20674 : unsigned int Sym;
20945 20674 : unsigned int SymT;
20946 20674 : unsigned int r;
20947 20674 : unsigned int t;
20948 :
20949 20674 : PopTrwtok (&Sym, &r, &sympos);
20950 20674 : M2Quads_PopTtok (&Tok, &tokpos);
20951 20674 : if (Tok == M2Reserved_MinusTok)
20952 : {
20953 20518 : MarkAsRead (r);
20954 20518 : type = M2Base_NegateType (SymbolTable_GetSType (Sym)); /* , sympos */
20955 20518 : tokpos = M2LexBuf_MakeVirtualTok (tokpos, tokpos, sympos);
20956 41036 : t = SymbolTable_MakeTemporary (tokpos, AreConstant (SymbolTable_IsConst (Sym)));
20957 20518 : SymbolTable_PutVar (t, type);
20958 : /*
20959 : variables must have a type and REAL/LONGREAL constants must
20960 : be typed
20961 : */
20962 20518 : if (! (SymbolTable_IsConst (Sym)))
20963 : {
20964 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
20965 1002 : if ((type != SymbolTable_NulSym) && (SymbolTable_IsSet (SymbolTable_SkipType (type))))
20966 : {} /* empty. */
20967 : /* do not dereference set variables */
20968 924 : else if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
20969 : {
20970 : /* avoid dangling else. */
20971 : /* dereference symbols which are not sets and which are variables */
20972 0 : SymT = SymbolTable_MakeTemporary (sympos, SymbolTable_RightValue);
20973 0 : SymbolTable_PutVar (SymT, SymbolTable_GetSType (Sym));
20974 0 : CheckPointerThroughNil (sympos, Sym);
20975 0 : doIndrX (sympos, SymT, Sym);
20976 0 : Sym = SymT;
20977 : }
20978 : }
20979 20518 : GenQuadO (tokpos, M2Quads_NegateOp, t, SymbolTable_NulSym, Sym, true);
20980 20518 : M2Quads_PushTtok (t, tokpos);
20981 : }
20982 156 : else if (Tok == M2Reserved_PlusTok)
20983 : {
20984 : /* avoid dangling else. */
20985 156 : tokpos = M2LexBuf_MakeVirtualTok (tokpos, tokpos, sympos);
20986 156 : PushTrwtok (Sym, r, tokpos);
20987 : }
20988 : else
20989 : {
20990 : /* avoid dangling else. */
20991 0 : M2MetaError_MetaErrorNT1 (tokpos, (const char *) "expecting an unary operator, seen {%Ek%a}", 41, Tok);
20992 : }
20993 20674 : }
20994 :
20995 :
20996 : /*
20997 : OperandT - returns the ident operand stored in the true position on the boolean stack.
20998 : */
20999 :
21000 208567198 : extern "C" unsigned int M2Quads_OperandT (unsigned int pos)
21001 : {
21002 208567198 : M2Debug_Assert (! (IsBoolean (pos)));
21003 208567198 : return OperandTno (pos);
21004 : /* static analysis guarentees a RETURN statement will be used before here. */
21005 : __builtin_unreachable ();
21006 : }
21007 :
21008 :
21009 : /*
21010 : OperandF - returns the ident operand stored in the false position on the boolean stack.
21011 : */
21012 :
21013 174128 : extern "C" unsigned int M2Quads_OperandF (unsigned int pos)
21014 : {
21015 174128 : M2Debug_Assert (! (IsBoolean (pos)));
21016 174128 : return OperandFno (pos);
21017 : /* static analysis guarentees a RETURN statement will be used before here. */
21018 : __builtin_unreachable ();
21019 : }
21020 :
21021 :
21022 : /*
21023 : PushTF - Push a True and False numbers onto the True/False stack.
21024 : True and False are assumed to contain Symbols or Ident etc.
21025 : */
21026 :
21027 15581972 : extern "C" void M2Quads_PushTF (unsigned int True, unsigned int False)
21028 : {
21029 15581972 : M2Quads_BoolFrame f;
21030 :
21031 15581972 : f = newBoolFrame ();
21032 15581972 : f->TrueExit = static_cast<unsigned int> (True);
21033 15581972 : f->FalseExit = static_cast<unsigned int> (False);
21034 15581972 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21035 15581972 : }
21036 :
21037 :
21038 : /*
21039 : PopTF - Pop a True and False number from the True/False stack.
21040 : True and False are assumed to contain Symbols or Ident etc.
21041 : */
21042 :
21043 10476397 : extern "C" void M2Quads_PopTF (unsigned int *True, unsigned int *False)
21044 : {
21045 10476397 : M2Quads_BoolFrame f;
21046 :
21047 10476397 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21048 10476397 : (*True) = static_cast<unsigned int> (f->TrueExit);
21049 10476397 : (*False) = static_cast<unsigned int> (f->FalseExit);
21050 10476397 : M2Debug_Assert (! f->BooleanOp);
21051 10476397 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21052 10476397 : }
21053 :
21054 :
21055 : /*
21056 : PushT - Push an item onto the stack in the T (true) position.
21057 : */
21058 :
21059 96550405 : extern "C" void M2Quads_PushT (unsigned int True)
21060 : {
21061 96550405 : M2Quads_BoolFrame f;
21062 :
21063 96550405 : f = newBoolFrame ();
21064 96550405 : f->TrueExit = static_cast<unsigned int> (True);
21065 96550405 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21066 96550405 : }
21067 :
21068 :
21069 : /*
21070 : PopT - Pops the T value from the stack.
21071 : */
21072 :
21073 142459348 : extern "C" void M2Quads_PopT (unsigned int *True)
21074 : {
21075 142459348 : M2Quads_BoolFrame f;
21076 :
21077 142459348 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21078 142459342 : (*True) = static_cast<unsigned int> (f->TrueExit);
21079 142459342 : M2Debug_Assert (! f->BooleanOp);
21080 142459342 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21081 142459342 : }
21082 :
21083 :
21084 : /*
21085 : PushTtok - Push an item onto the stack in the T (true) position,
21086 : it is assummed to be a token and its token location is recorded.
21087 : */
21088 :
21089 76759345 : extern "C" void M2Quads_PushTtok (unsigned int True, unsigned int tokno)
21090 : {
21091 76759345 : M2Quads_BoolFrame f;
21092 :
21093 : /* PrintTokenNo (tokno) ; */
21094 76759345 : f = newBoolFrame ();
21095 76759345 : f->TrueExit = static_cast<unsigned int> (True);
21096 76759345 : f->tokenno = tokno;
21097 76759345 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21098 76759345 : }
21099 :
21100 :
21101 : /*
21102 : PushTFtok - Push an item onto the stack in the T (true) position,
21103 : it is assummed to be a token and its token location is recorded.
21104 : */
21105 :
21106 153443705 : extern "C" void M2Quads_PushTFtok (unsigned int True, unsigned int False, unsigned int tokno)
21107 : {
21108 153443705 : M2Quads_BoolFrame f;
21109 :
21110 153443705 : f = newBoolFrame ();
21111 153443705 : f->TrueExit = static_cast<unsigned int> (True);
21112 153443705 : f->FalseExit = static_cast<unsigned int> (False);
21113 153443705 : f->tokenno = tokno;
21114 153443705 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21115 153443705 : }
21116 :
21117 :
21118 : /*
21119 : PopTFtok - Pop T/F/tok from the stack.
21120 : */
21121 :
21122 9258561 : extern "C" void M2Quads_PopTFtok (unsigned int *True, unsigned int *False, unsigned int *tokno)
21123 : {
21124 9258561 : M2Quads_BoolFrame f;
21125 :
21126 9258561 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21127 9258561 : (*True) = static_cast<unsigned int> (f->TrueExit);
21128 9258561 : (*False) = static_cast<unsigned int> (f->FalseExit);
21129 9258561 : (*tokno) = f->tokenno;
21130 9258561 : }
21131 :
21132 :
21133 : /*
21134 : PushTFAtok - Push T/F/A/tok to the stack.
21135 : */
21136 :
21137 54 : extern "C" void M2Quads_PushTFAtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int tokno)
21138 : {
21139 54 : M2Quads_BoolFrame f;
21140 :
21141 54 : f = newBoolFrame ();
21142 54 : f->TrueExit = static_cast<unsigned int> (True);
21143 54 : f->FalseExit = static_cast<unsigned int> (False);
21144 54 : f->Unbounded = static_cast<unsigned int> (Array);
21145 54 : f->tokenno = tokno;
21146 54 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21147 54 : }
21148 :
21149 :
21150 : /*
21151 : PopTtok - Pops the T value from the stack and token position.
21152 : */
21153 :
21154 114863291 : extern "C" void M2Quads_PopTtok (unsigned int *True, unsigned int *tok)
21155 : {
21156 114863291 : M2Quads_BoolFrame f;
21157 :
21158 114863291 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21159 114863291 : (*True) = static_cast<unsigned int> (f->TrueExit);
21160 114863291 : (*tok) = f->tokenno;
21161 114863291 : M2Debug_Assert (! f->BooleanOp);
21162 114863291 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21163 114863291 : }
21164 :
21165 :
21166 : /*
21167 : PushTFn - Push a True and False numbers onto the True/False stack.
21168 : True and False are assumed to contain Symbols or Ident etc.
21169 : */
21170 :
21171 0 : extern "C" void M2Quads_PushTFn (unsigned int True, unsigned int False, unsigned int n)
21172 : {
21173 0 : M2Quads_BoolFrame f;
21174 :
21175 0 : f = newBoolFrame ();
21176 0 : f->TrueExit = static_cast<unsigned int> (True);
21177 0 : f->FalseExit = static_cast<unsigned int> (False);
21178 0 : f->name = static_cast<unsigned int> (n);
21179 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21180 0 : }
21181 :
21182 :
21183 : /*
21184 : PushTFntok - Push a True and False numbers onto the True/False stack.
21185 : True and False are assumed to contain Symbols or Ident etc.
21186 : */
21187 :
21188 651207 : extern "C" void M2Quads_PushTFntok (unsigned int True, unsigned int False, unsigned int n, unsigned int tokno)
21189 : {
21190 651207 : M2Quads_BoolFrame f;
21191 :
21192 651207 : f = newBoolFrame ();
21193 651207 : f->TrueExit = static_cast<unsigned int> (True);
21194 651207 : f->FalseExit = static_cast<unsigned int> (False);
21195 651207 : f->name = static_cast<unsigned int> (n);
21196 651207 : f->tokenno = tokno;
21197 651207 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21198 651207 : }
21199 :
21200 :
21201 : /*
21202 : PopTFn - Pop a True and False number from the True/False stack.
21203 : True and False are assumed to contain Symbols or Ident etc.
21204 : */
21205 :
21206 0 : extern "C" void M2Quads_PopTFn (unsigned int *True, unsigned int *False, unsigned int *n)
21207 : {
21208 0 : M2Quads_BoolFrame f;
21209 :
21210 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21211 0 : (*True) = static_cast<unsigned int> (f->TrueExit);
21212 0 : (*False) = static_cast<unsigned int> (f->FalseExit);
21213 0 : (*n) = static_cast<unsigned int> (f->name);
21214 0 : M2Debug_Assert (! f->BooleanOp);
21215 0 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21216 0 : }
21217 :
21218 :
21219 : /*
21220 : PopNothing - pops the top element on the boolean stack.
21221 : */
21222 :
21223 64871227 : extern "C" void M2Quads_PopNothing (void)
21224 : {
21225 64871227 : M2Quads_BoolFrame f;
21226 :
21227 64871227 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21228 64871227 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21229 64871227 : }
21230 :
21231 :
21232 : /*
21233 : PopN - pops multiple elements from the BoolStack.
21234 : */
21235 :
21236 12436252 : extern "C" void M2Quads_PopN (unsigned int n)
21237 : {
21238 47117302 : while (n > 0)
21239 : {
21240 34681050 : M2Quads_PopNothing ();
21241 34681050 : n -= 1;
21242 : }
21243 12436252 : }
21244 :
21245 :
21246 : /*
21247 : PushTFA - Push True, False, Array, numbers onto the
21248 : True/False stack. True and False are assumed to
21249 : contain Symbols or Ident etc.
21250 : */
21251 :
21252 0 : extern "C" void M2Quads_PushTFA (unsigned int True, unsigned int False, unsigned int Array)
21253 : {
21254 0 : M2Quads_BoolFrame f;
21255 :
21256 0 : f = newBoolFrame ();
21257 0 : f->TrueExit = static_cast<unsigned int> (True);
21258 0 : f->FalseExit = static_cast<unsigned int> (False);
21259 0 : f->Unbounded = static_cast<unsigned int> (Array);
21260 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21261 0 : }
21262 :
21263 :
21264 : /*
21265 : OperandTok - returns the token associated with pos, on the stack.
21266 : */
21267 :
21268 55430847 : extern "C" unsigned int M2Quads_OperandTok (unsigned int pos)
21269 : {
21270 55430847 : M2Debug_Assert (! (IsBoolean (pos)));
21271 55430847 : return static_cast<unsigned int> (OperandTtok (pos));
21272 : /* static analysis guarentees a RETURN statement will be used before here. */
21273 : __builtin_unreachable ();
21274 : }
21275 :
21276 :
21277 : /*
21278 : OperandA - returns possible array symbol associated with the ident
21279 : operand stored on the boolean stack.
21280 : */
21281 :
21282 2212609 : extern "C" unsigned int M2Quads_OperandA (unsigned int pos)
21283 : {
21284 2212609 : M2Quads_BoolFrame f;
21285 :
21286 2212609 : M2Debug_Assert (pos > 0);
21287 2212609 : M2Debug_Assert (! (IsBoolean (pos)));
21288 2212609 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
21289 2212609 : return static_cast<unsigned int> (f->Unbounded);
21290 : /* static analysis guarentees a RETURN statement will be used before here. */
21291 : __builtin_unreachable ();
21292 : }
21293 :
21294 :
21295 : /*
21296 : OperandAnno - returns the annotation string associated with the
21297 : position, n, on the stack.
21298 : */
21299 :
21300 0 : extern "C" DynamicStrings_String M2Quads_OperandAnno (unsigned int n)
21301 : {
21302 0 : M2Quads_BoolFrame f;
21303 :
21304 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, n));
21305 0 : return f->Annotation;
21306 : /* static analysis guarentees a RETURN statement will be used before here. */
21307 : __builtin_unreachable ();
21308 : }
21309 :
21310 :
21311 : /*
21312 : Annotate - annotate the top of stack.
21313 : */
21314 :
21315 122725484 : extern "C" void M2Quads_Annotate (const char *a_, unsigned int _a_high)
21316 : {
21317 122725484 : M2Quads_BoolFrame f;
21318 122725484 : char a[_a_high+1];
21319 :
21320 : /* make a local copy of each unbounded array. */
21321 122725484 : memcpy (a, a_, _a_high+1);
21322 :
21323 0 : if ((DebugStackOn && M2Options_CompilerDebugging) && ((M2StackAddress_NoOfItemsInStackAddress (BoolStack)) > 0))
21324 : {
21325 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, 1)); /* top of stack */
21326 0 : if (f->Annotation != NULL) /* top of stack */
21327 : {
21328 0 : f->Annotation = DynamicStrings_KillString (f->Annotation);
21329 : }
21330 0 : f->Annotation = DynamicStrings_InitString ((const char *) a, _a_high);
21331 : }
21332 122725484 : }
21333 :
21334 :
21335 : /*
21336 : DisplayStack - displays the compile time symbol stack.
21337 : */
21338 :
21339 19975555 : extern "C" void M2Quads_DisplayStack (void)
21340 : {
21341 19975555 : if (DebugStackOn && M2Options_CompilerDebugging)
21342 : {
21343 0 : M2DebugStack_DebugStack (M2StackAddress_NoOfItemsInStackAddress (BoolStack), (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) OperandTno}, (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) OperandFno}, (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) M2Quads_OperandA}, (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) OperandD}, (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) OperandRW}, (M2DebugStack_ProcedureWord) {(M2DebugStack_ProcedureWord_t) M2Quads_OperandTok}, (M2DebugStack_ProcedureString) {(M2DebugStack_ProcedureString_t) M2Quads_OperandAnno});
21344 : }
21345 19975555 : }
21346 :
21347 :
21348 : /*
21349 : Top - returns the no of items held in the stack.
21350 : */
21351 :
21352 89511131 : extern "C" unsigned int M2Quads_Top (void)
21353 : {
21354 89511131 : return M2StackAddress_NoOfItemsInStackAddress (BoolStack);
21355 : /* static analysis guarentees a RETURN statement will be used before here. */
21356 : __builtin_unreachable ();
21357 : }
21358 :
21359 :
21360 : /*
21361 : DupFrame - duplicate the top of stack and push the new frame.
21362 : */
21363 :
21364 0 : extern "C" void M2Quads_DupFrame (void)
21365 : {
21366 0 : M2Quads_BoolFrame f;
21367 0 : M2Quads_BoolFrame newf;
21368 :
21369 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21370 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21371 0 : newf = newBoolFrame ();
21372 0 : (*newf) = (*f);
21373 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (newf));
21374 0 : }
21375 :
21376 :
21377 : /*
21378 : WriteOperand - displays the operands name, symbol id and mode of addressing.
21379 : */
21380 :
21381 0 : extern "C" void M2Quads_WriteOperand (unsigned int Sym)
21382 : {
21383 0 : NameKey_Name n;
21384 :
21385 0 : if (Sym == SymbolTable_NulSym)
21386 : {
21387 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "<nulsym>", 8);
21388 : }
21389 : else
21390 : {
21391 0 : n = SymbolTable_GetSymName (Sym);
21392 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%a", 2, (const unsigned char *) &n, (sizeof (n)-1));
21393 0 : if ((SymbolTable_IsVar (Sym)) || (SymbolTable_IsConst (Sym)))
21394 : {
21395 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "[", 1);
21396 0 : WriteMode (SymbolTable_GetMode (Sym));
21397 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "]", 1);
21398 : }
21399 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "(%d)", 4, (const unsigned char *) &Sym, (sizeof (Sym)-1));
21400 0 : if (SymbolConversion_GccKnowsAbout (Sym))
21401 : {
21402 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "[gcc]", 5);
21403 : }
21404 : }
21405 0 : }
21406 :
21407 :
21408 : /*
21409 : BeginVarient - begin a varient record.
21410 : */
21411 :
21412 2988 : extern "C" void M2Quads_BeginVarient (void)
21413 : {
21414 2988 : unsigned int r;
21415 2988 : unsigned int v;
21416 :
21417 2988 : r = GetRecordOrField ();
21418 5976 : M2Debug_Assert ((SymbolTable_IsRecord (r)) || (SymbolTable_IsFieldVarient (r)));
21419 2988 : v = GetRecordOrField ();
21420 2988 : M2Debug_Assert (SymbolTable_IsVarient (v));
21421 2988 : BuildRange (M2Range_InitCaseBounds (M2CaseList_PushCase (r, v, SymbolTable_NulSym)));
21422 2988 : }
21423 :
21424 :
21425 : /*
21426 : EndVarient - end a varient record.
21427 : */
21428 :
21429 2988 : extern "C" void M2Quads_EndVarient (void)
21430 : {
21431 2988 : M2CaseList_PopCase ();
21432 2988 : }
21433 :
21434 :
21435 : /*
21436 : ElseVarient - associate an ELSE clause with a varient record.
21437 : */
21438 :
21439 114 : extern "C" void M2Quads_ElseVarient (void)
21440 : {
21441 114 : unsigned int f;
21442 :
21443 114 : f = GetRecordOrField ();
21444 114 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21445 114 : M2CaseList_ElseCase (f);
21446 114 : }
21447 :
21448 :
21449 : /*
21450 : BeginVarientList - begin an ident list containing ranges belonging to a
21451 : varient list.
21452 : */
21453 :
21454 5976 : extern "C" void M2Quads_BeginVarientList (void)
21455 : {
21456 5976 : unsigned int f;
21457 :
21458 5976 : f = GetRecordOrField ();
21459 5976 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21460 5976 : M2CaseList_BeginCaseList (f);
21461 5976 : }
21462 :
21463 :
21464 : /*
21465 : EndVarientList - end a range list for a varient field.
21466 : */
21467 :
21468 5976 : extern "C" void M2Quads_EndVarientList (void)
21469 : {
21470 5976 : M2CaseList_EndCaseList ();
21471 5976 : }
21472 :
21473 :
21474 : /*
21475 : AddRecordToList - adds the record held on the top of stack to the
21476 : list of records and varient fields.
21477 : */
21478 :
21479 2988 : extern "C" void M2Quads_AddRecordToList (void)
21480 : {
21481 2988 : unsigned int r;
21482 2988 : unsigned int n;
21483 :
21484 2988 : r = static_cast<unsigned int> (M2Quads_OperandT (1));
21485 5976 : M2Debug_Assert ((SymbolTable_IsRecord (r)) || (SymbolTable_IsFieldVarient (r)));
21486 : /*
21487 : r might be a field varient if the declaration consists of nested
21488 : varients. However ISO TSIZE can only utilise record types, we store
21489 : a varient field anyway as the next pass would not know whether to
21490 : ignore a varient field.
21491 : */
21492 2988 : Lists_PutItemIntoList (VarientFields, r);
21493 2988 : if (DebugVarients)
21494 : {
21495 : n = Lists_NoOfItemsInList (VarientFields);
21496 : if (SymbolTable_IsRecord (r))
21497 : {
21498 : M2Printf_printf2 ((const char *) "in list: record %d is %d\\n", 26, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &r, (sizeof (r)-1));
21499 : }
21500 : else
21501 : {
21502 : M2Printf_printf2 ((const char *) "in list: varient field %d is %d\\n", 33, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &r, (sizeof (r)-1));
21503 : }
21504 : }
21505 2988 : }
21506 :
21507 :
21508 : /*
21509 : AddVarientToList - adds varient held on the top of stack to the list.
21510 : */
21511 :
21512 2988 : extern "C" void M2Quads_AddVarientToList (void)
21513 : {
21514 2988 : unsigned int v;
21515 2988 : unsigned int n;
21516 :
21517 2988 : v = static_cast<unsigned int> (M2Quads_OperandT (1));
21518 2988 : M2Debug_Assert (SymbolTable_IsVarient (v));
21519 2988 : Lists_PutItemIntoList (VarientFields, v);
21520 2988 : if (DebugVarients)
21521 : {
21522 : n = Lists_NoOfItemsInList (VarientFields);
21523 : M2Printf_printf2 ((const char *) "in list: varient %d is %d\\n", 27, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &v, (sizeof (v)-1));
21524 : }
21525 2988 : }
21526 :
21527 :
21528 : /*
21529 : AddVarientFieldToList - adds varient field, f, to the list of all varient
21530 : fields created.
21531 : */
21532 :
21533 6090 : extern "C" void M2Quads_AddVarientFieldToList (unsigned int f)
21534 : {
21535 6090 : unsigned int n;
21536 :
21537 6090 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21538 6090 : Lists_PutItemIntoList (VarientFields, f);
21539 6090 : if (DebugVarients)
21540 : {
21541 : n = Lists_NoOfItemsInList (VarientFields);
21542 : M2Printf_printf2 ((const char *) "in list: varient field %d is %d\\n", 33, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &f, (sizeof (f)-1));
21543 : }
21544 6090 : }
21545 :
21546 :
21547 : /*
21548 : AddVarientRange - creates a range from the top two contant expressions
21549 : on the stack which are recorded with the current
21550 : varient field. The stack is unaltered.
21551 : */
21552 :
21553 0 : extern "C" void M2Quads_AddVarientRange (void)
21554 : {
21555 0 : unsigned int r1;
21556 0 : unsigned int r2;
21557 :
21558 0 : M2Quads_PopT (&r2);
21559 0 : M2Quads_PopT (&r1);
21560 0 : M2CaseList_AddRange (r1, r2, M2LexBuf_GetTokenNo ());
21561 0 : }
21562 :
21563 :
21564 : /*
21565 : AddVarientEquality - adds the contant expression on the top of the stack
21566 : to the current varient field being recorded.
21567 : The stack is unaltered.
21568 : */
21569 :
21570 6018 : extern "C" void M2Quads_AddVarientEquality (void)
21571 : {
21572 6018 : unsigned int r1;
21573 :
21574 6018 : M2Quads_PopT (&r1);
21575 6018 : M2CaseList_AddRange (r1, SymbolTable_NulSym, M2LexBuf_GetTokenNo ());
21576 6018 : }
21577 :
21578 :
21579 : /*
21580 : BuildCodeOn - generates a quadruple declaring that code should be
21581 : emmitted from henceforth.
21582 :
21583 : The Stack is unnaffected.
21584 : */
21585 :
21586 0 : extern "C" void M2Quads_BuildCodeOn (void)
21587 : {
21588 0 : GenQuad (M2Quads_CodeOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21589 0 : }
21590 :
21591 :
21592 : /*
21593 : BuildCodeOff - generates a quadruple declaring that code should not be
21594 : emmitted from henceforth.
21595 :
21596 : The Stack is unnaffected.
21597 : */
21598 :
21599 0 : extern "C" void M2Quads_BuildCodeOff (void)
21600 : {
21601 0 : GenQuad (M2Quads_CodeOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21602 0 : }
21603 :
21604 :
21605 : /*
21606 : BuildProfileOn - generates a quadruple declaring that profile timings
21607 : should be emmitted from henceforth.
21608 :
21609 : The Stack is unnaffected.
21610 : */
21611 :
21612 0 : extern "C" void M2Quads_BuildProfileOn (void)
21613 : {
21614 0 : GenQuad (M2Quads_ProfileOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21615 0 : }
21616 :
21617 0 : extern "C" void M2Quads_BuildProfileOff (void)
21618 : {
21619 : /*
21620 : BuildProfileOn - generates a quadruple declaring that profile timings
21621 : should be emmitted from henceforth.
21622 :
21623 : The Stack is unnaffected.
21624 : */
21625 0 : GenQuad (M2Quads_ProfileOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21626 0 : }
21627 :
21628 :
21629 : /*
21630 : BuildOptimizeOn - generates a quadruple declaring that optimization
21631 : should occur from henceforth.
21632 :
21633 : The Stack is unnaffected.
21634 : */
21635 :
21636 0 : extern "C" void M2Quads_BuildOptimizeOn (void)
21637 : {
21638 0 : GenQuad (M2Quads_OptimizeOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21639 0 : }
21640 :
21641 :
21642 : /*
21643 : BuildOptimizeOff - generates a quadruple declaring that optimization
21644 : should not occur from henceforth.
21645 :
21646 : The Stack is unnaffected.
21647 : */
21648 :
21649 0 : extern "C" void M2Quads_BuildOptimizeOff (void)
21650 : {
21651 0 : GenQuad (M2Quads_OptimizeOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21652 0 : }
21653 :
21654 :
21655 : /*
21656 : BuildAsm - builds an Inline pseudo quadruple operator.
21657 : The inline interface, Sym, is stored as the operand
21658 : to the operator InlineOp.
21659 :
21660 : The stack is expected to contain:
21661 :
21662 :
21663 : Entry Exit
21664 : ===== ====
21665 :
21666 : Ptr ->
21667 : +--------------+
21668 : | Sym | Empty
21669 : |--------------|
21670 : */
21671 :
21672 27 : extern "C" void M2Quads_BuildAsm (unsigned int tok)
21673 : {
21674 27 : unsigned int Sym;
21675 :
21676 27 : M2Quads_PopT (&Sym);
21677 27 : GenQuadO (tok, M2Quads_InlineOp, SymbolTable_NulSym, SymbolTable_NulSym, Sym, false);
21678 27 : }
21679 :
21680 :
21681 : /*
21682 : BuildLineNo - builds a LineNumberOp pseudo quadruple operator.
21683 : This quadruple indicates which source line has been
21684 : processed, these quadruples are only generated if we
21685 : are producing runtime debugging information.
21686 :
21687 : The stack is not affected, read or altered in any way.
21688 :
21689 :
21690 : Entry Exit
21691 : ===== ====
21692 :
21693 : Ptr -> <- Ptr
21694 : */
21695 :
21696 0 : extern "C" void M2Quads_BuildLineNo (void)
21697 : {
21698 0 : NameKey_Name filename;
21699 0 : M2Quads_QuadFrame f;
21700 :
21701 0 : if (((NextQuad != Head) && (M2Options_GenerateLineDebug || M2Options_GenerateDebugging)) && false)
21702 : {
21703 : filename = NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()));
21704 : f = GetQF (NextQuad-1);
21705 : if (! ((f->Operator == M2Quads_LineNumberOp) && (f->Operand1 == ((unsigned int ) (filename)))))
21706 : {
21707 : GenQuad (M2Quads_LineNumberOp, (unsigned int ) (filename), SymbolTable_NulSym, (unsigned int ) (M2LexBuf_GetLineNo ()));
21708 : }
21709 : }
21710 0 : }
21711 :
21712 :
21713 : /*
21714 : PushLineNo - pushes the current file and line number to the stack.
21715 : */
21716 :
21717 5084 : extern "C" void M2Quads_PushLineNo (void)
21718 : {
21719 5084 : PushLineNote (InitLineNote (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ())), M2LexBuf_GetLineNo ()));
21720 5084 : }
21721 :
21722 :
21723 : /*
21724 : BuildStmtNote - builds a StatementNoteOp pseudo quadruple operator.
21725 : This quadruple indicates which source line has been
21726 : processed and it represents the start of a statement
21727 : sequence.
21728 : It differs from LineNumberOp in that multiple successive
21729 : LineNumberOps will be removed and the final one is attached to
21730 : the next real GCC tree. Whereas a StatementNoteOp is always left
21731 : alone. Depending upon the debugging level it will issue a nop
21732 : instruction to ensure that the gdb single step will step into
21733 : this line. Practically it allows pedalogical debugging to
21734 : occur when there is syntax sugar such as:
21735 :
21736 :
21737 : END step
21738 : END step
21739 : END ; step
21740 : a := 1 ; step
21741 :
21742 : REPEAT step
21743 : i := 1 step
21744 :
21745 : The stack is not affected, read or altered in any way.
21746 :
21747 :
21748 : Entry Exit
21749 : ===== ====
21750 :
21751 : Ptr -> <- Ptr
21752 : */
21753 :
21754 525502 : extern "C" void M2Quads_BuildStmtNote (int offset)
21755 : {
21756 525502 : int tokenno;
21757 :
21758 525502 : if (NextQuad != Head)
21759 : {
21760 525502 : tokenno = offset;
21761 525502 : tokenno += M2LexBuf_GetTokenNo ();
21762 525502 : BuildStmtNoteTok ((unsigned int ) (tokenno));
21763 : }
21764 525502 : }
21765 :
21766 :
21767 : /*
21768 : LoopAnalysis - checks whether an infinite loop exists.
21769 : */
21770 :
21771 397657 : extern "C" void M2Quads_LoopAnalysis (unsigned int Scope, unsigned int Current, unsigned int End)
21772 : {
21773 397657 : M2Quads_QuadOperator op;
21774 397657 : unsigned int op1;
21775 397657 : unsigned int op2;
21776 397657 : unsigned int op3;
21777 :
21778 397657 : if (M2Options_Pedantic)
21779 : {
21780 11442 : while ((Current <= End) && (Current != 0))
21781 : {
21782 9990 : M2Quads_GetQuad (Current, &op, &op1, &op2, &op3);
21783 9990 : if ((op == M2Quads_GotoOp) || (M2Quads_IsConditional (Current)))
21784 : {
21785 114 : if (op3 <= Current)
21786 : {
21787 : /* found a loop - ie a branch which goes back in quadruple numbers */
21788 24 : if (IsInfiniteLoop (Current))
21789 : {
21790 0 : M2MetaError_MetaErrorT1 (M2Quads_QuadToTokenNo (op3), (const char *) "it is very likely (although not absolutely certain) that the top of an infinite loop exists here in {%1Wad}", 107, Scope);
21791 0 : M2MetaError_MetaErrorT1 (M2Quads_QuadToTokenNo (Current), (const char *) "and the bottom of the infinite loop is ends here in {%1Wad} or alternatively a component of this loop is never executed", 119, Scope);
21792 : }
21793 : /*
21794 : WarnStringAt(InitString('it is very likely (although not absolutely certain) that the top of an infinite loop is here'),
21795 : QuadToTokenNo(op3)) ;
21796 : WarnStringAt(InitString('and the bottom of the infinite loop is ends here or alternatively a component of this loop is never executed'),
21797 : QuadToTokenNo(Current))
21798 : */
21799 : }
21800 : }
21801 9990 : Current = M2Quads_GetNextQuad (Current);
21802 : }
21803 : }
21804 397657 : }
21805 :
21806 :
21807 : /*
21808 : ForLoopAnalysis - checks all the FOR loops for index variable manipulation
21809 : and dangerous usage outside the loop.
21810 : */
21811 :
21812 13940 : extern "C" void M2Quads_ForLoopAnalysis (void)
21813 : {
21814 13940 : unsigned int i;
21815 13940 : unsigned int n;
21816 13940 : M2Quads_ForLoopInfo forDesc;
21817 :
21818 13940 : if (M2Options_Pedantic)
21819 : {
21820 108 : n = Indexing_HighIndice (ForInfo);
21821 108 : i = 1;
21822 216 : while (i <= n)
21823 : {
21824 0 : forDesc = static_cast<M2Quads_ForLoopInfo> (Indexing_GetIndice (ForInfo, i));
21825 0 : CheckForIndex (forDesc);
21826 0 : i += 1;
21827 : }
21828 : }
21829 13940 : }
21830 :
21831 :
21832 : /*
21833 : BuildSizeCheckStart - switches off all quadruple generation if the function SIZE or HIGH
21834 : is being "called". This should be done as SIZE only requires the
21835 : actual type of the expression, not its value. Consider the problem of
21836 : SIZE(UninitializedPointer^) which is quite legal and it must
21837 : also be safe!
21838 : ISO Modula-2 also allows HIGH(a[0]) for a two dimensional array
21839 : and there is no need to compute a[0], we just need to follow the
21840 : type and count dimensions. However if SIZE(a) or HIGH(a) occurs
21841 : and, a, is an unbounded array then we turn on quadruple generation.
21842 :
21843 : The Stack is expected to contain:
21844 :
21845 :
21846 : Entry Exit
21847 : ===== ====
21848 :
21849 : Ptr -> <- Ptr
21850 : +----------------------+ +----------------------+
21851 : | ProcSym | Type | tok | | ProcSym | Type | tok |
21852 : |----------------------| |----------------------|
21853 : */
21854 :
21855 187310 : extern "C" void M2Quads_BuildSizeCheckStart (void)
21856 : {
21857 187310 : unsigned int ProcSym;
21858 187310 : unsigned int Type;
21859 187310 : unsigned int tok;
21860 :
21861 187310 : M2Quads_PopTFtok (&ProcSym, &Type, &tok);
21862 187310 : if (((ProcSym == M2Size_Size) || (ProcSym == M2System_TSize)) || (ProcSym == M2System_TBitSize))
21863 : {
21864 9063 : QuadrupleGeneration = false;
21865 9063 : BuildingSize = true;
21866 : }
21867 178247 : else if (ProcSym == M2Base_High)
21868 : {
21869 : /* avoid dangling else. */
21870 2974 : QuadrupleGeneration = false;
21871 2974 : BuildingHigh = true;
21872 : }
21873 187310 : M2Quads_PushTFtok (ProcSym, Type, tok);
21874 187310 : }
21875 :
21876 :
21877 : /*
21878 : BackPatchSubrangesAndOptParam - runs through all the quadruples and finds SubrangeLow or SubrangeHigh
21879 : quadruples and replaces it by an assignment to the Low or High component
21880 : of the subrange type.
21881 :
21882 : Input:
21883 : SubrangeLow op1 op3 op3 is a subrange
21884 :
21885 : Output:
21886 : Becomes op1 low
21887 :
21888 : Input:
21889 : SubrangeHigh op1 op3 op3 is a subrange
21890 :
21891 : Output:
21892 : Becomes op1 high
21893 :
21894 : Input:
21895 : OptParam op1 op2 op3
21896 :
21897 : Output:
21898 : Param op1 op2 GetOptArgInit(op3)
21899 : */
21900 :
21901 13940 : extern "C" void M2Quads_BackPatchSubrangesAndOptParam (void)
21902 : {
21903 13940 : M2Quads_QuadFrame f;
21904 13940 : unsigned int q;
21905 :
21906 13940 : q = M2Quads_GetFirstQuad ();
21907 13940 : if (q != 0)
21908 : {
21909 6063467 : do {
21910 6063467 : f = GetQF (q);
21911 6063467 : switch (f->Operator)
21912 : {
21913 282 : case M2Quads_SubrangeLowOp:
21914 282 : f->Operand3 = CollectLow (f->Operand3);
21915 282 : f->Operator = M2Quads_BecomesOp;
21916 282 : f->ConstExpr = false;
21917 282 : break;
21918 :
21919 554 : case M2Quads_SubrangeHighOp:
21920 554 : f->Operand3 = CollectHigh (f->Operand3);
21921 554 : f->Operator = M2Quads_BecomesOp;
21922 554 : f->ConstExpr = false;
21923 554 : break;
21924 :
21925 3336 : case M2Quads_OptParamOp:
21926 3336 : f->Operand3 = SymbolTable_GetOptArgInit (f->Operand3);
21927 3336 : f->Operator = M2Quads_ParamOp;
21928 3336 : break;
21929 :
21930 :
21931 : default:
21932 : break;
21933 : }
21934 6063467 : q = f->Next;
21935 6063467 : } while (! (q == 0));
21936 : }
21937 13940 : }
21938 :
21939 :
21940 : /*
21941 : WriteOperator - writes the name of the quadruple operator.
21942 : */
21943 :
21944 0 : extern "C" void M2Quads_WriteOperator (M2Quads_QuadOperator Operator)
21945 : {
21946 0 : switch (Operator)
21947 : {
21948 0 : case M2Quads_ArithAddOp:
21949 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Arith + ", 18);
21950 0 : break;
21951 :
21952 0 : case M2Quads_InitAddressOp:
21953 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitAddress ", 18);
21954 0 : break;
21955 :
21956 0 : case M2Quads_LastForIteratorOp:
21957 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "LastForIterator ", 18);
21958 0 : break;
21959 :
21960 0 : case M2Quads_LogicalOrOp:
21961 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Or ", 18);
21962 0 : break;
21963 :
21964 0 : case M2Quads_LogicalAndOp:
21965 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "And ", 18);
21966 0 : break;
21967 :
21968 0 : case M2Quads_LogicalXorOp:
21969 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Xor ", 18);
21970 0 : break;
21971 :
21972 0 : case M2Quads_LogicalDiffOp:
21973 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Ldiff ", 18);
21974 0 : break;
21975 :
21976 0 : case M2Quads_LogicalShiftOp:
21977 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Shift ", 18);
21978 0 : break;
21979 :
21980 0 : case M2Quads_LogicalRotateOp:
21981 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Rotate ", 18);
21982 0 : break;
21983 :
21984 0 : case M2Quads_BecomesOp:
21985 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Becomes ", 18);
21986 0 : break;
21987 :
21988 0 : case M2Quads_IndrXOp:
21989 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "IndrX ", 18);
21990 0 : break;
21991 :
21992 0 : case M2Quads_XIndrOp:
21993 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "XIndr ", 18);
21994 0 : break;
21995 :
21996 0 : case M2Quads_ArrayOp:
21997 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Array ", 18);
21998 0 : break;
21999 :
22000 0 : case M2Quads_ElementSizeOp:
22001 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ElementSize ", 18);
22002 0 : break;
22003 :
22004 0 : case M2Quads_RecordFieldOp:
22005 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RecordField ", 18);
22006 0 : break;
22007 :
22008 0 : case M2Quads_AddrOp:
22009 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Addr ", 18);
22010 0 : break;
22011 :
22012 0 : case M2Quads_SizeOp:
22013 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Size ", 18);
22014 0 : break;
22015 :
22016 0 : case M2Quads_IfInOp:
22017 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If IN ", 18);
22018 0 : break;
22019 :
22020 0 : case M2Quads_IfNotInOp:
22021 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If NOT IN ", 18);
22022 0 : break;
22023 :
22024 0 : case M2Quads_IfNotEquOp:
22025 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If <> ", 18);
22026 0 : break;
22027 :
22028 0 : case M2Quads_IfEquOp:
22029 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If = ", 18);
22030 0 : break;
22031 :
22032 0 : case M2Quads_IfLessEquOp:
22033 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If <= ", 18);
22034 0 : break;
22035 :
22036 0 : case M2Quads_IfGreEquOp:
22037 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If >= ", 18);
22038 0 : break;
22039 :
22040 0 : case M2Quads_IfGreOp:
22041 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If > ", 18);
22042 0 : break;
22043 :
22044 0 : case M2Quads_IfLessOp:
22045 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If < ", 18);
22046 0 : break;
22047 :
22048 0 : case M2Quads_GotoOp:
22049 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Goto ", 18);
22050 0 : break;
22051 :
22052 0 : case M2Quads_DummyOp:
22053 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Dummy ", 18);
22054 0 : break;
22055 :
22056 0 : case M2Quads_ModuleScopeOp:
22057 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ModuleScopeOp ", 18);
22058 0 : break;
22059 :
22060 0 : case M2Quads_StartDefFileOp:
22061 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StartDefFile ", 18);
22062 0 : break;
22063 :
22064 0 : case M2Quads_StartModFileOp:
22065 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StartModFile ", 18);
22066 0 : break;
22067 :
22068 0 : case M2Quads_EndFileOp:
22069 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "EndFileOp ", 18);
22070 0 : break;
22071 :
22072 0 : case M2Quads_InitStartOp:
22073 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitStart ", 18);
22074 0 : break;
22075 :
22076 0 : case M2Quads_InitEndOp:
22077 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitEnd ", 18);
22078 0 : break;
22079 :
22080 0 : case M2Quads_FinallyStartOp:
22081 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FinallyStart ", 18);
22082 0 : break;
22083 :
22084 0 : case M2Quads_FinallyEndOp:
22085 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FinallyEnd ", 18);
22086 0 : break;
22087 :
22088 0 : case M2Quads_RetryOp:
22089 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Retry ", 18);
22090 0 : break;
22091 :
22092 0 : case M2Quads_TryOp:
22093 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Try ", 18);
22094 0 : break;
22095 :
22096 0 : case M2Quads_ThrowOp:
22097 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Throw ", 18);
22098 0 : break;
22099 :
22100 0 : case M2Quads_CatchBeginOp:
22101 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CatchBegin ", 18);
22102 0 : break;
22103 :
22104 0 : case M2Quads_CatchEndOp:
22105 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CatchEnd ", 18);
22106 0 : break;
22107 :
22108 0 : case M2Quads_AddOp:
22109 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "+ ", 18);
22110 0 : break;
22111 :
22112 0 : case M2Quads_SubOp:
22113 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "- ", 18);
22114 0 : break;
22115 :
22116 0 : case M2Quads_DivM2Op:
22117 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV M2 ", 18);
22118 0 : break;
22119 :
22120 0 : case M2Quads_ModM2Op:
22121 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD M2 ", 18);
22122 0 : break;
22123 :
22124 0 : case M2Quads_DivCeilOp:
22125 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV ceil ", 18);
22126 0 : break;
22127 :
22128 0 : case M2Quads_ModCeilOp:
22129 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD ceil ", 18);
22130 0 : break;
22131 :
22132 0 : case M2Quads_DivFloorOp:
22133 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV floor ", 18);
22134 0 : break;
22135 :
22136 0 : case M2Quads_ModFloorOp:
22137 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD floor ", 18);
22138 0 : break;
22139 :
22140 0 : case M2Quads_DivTruncOp:
22141 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV trunc ", 18);
22142 0 : break;
22143 :
22144 0 : case M2Quads_ModTruncOp:
22145 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD trunc ", 18);
22146 0 : break;
22147 :
22148 0 : case M2Quads_MultOp:
22149 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "* ", 18);
22150 0 : break;
22151 :
22152 0 : case M2Quads_NegateOp:
22153 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Negate ", 18);
22154 0 : break;
22155 :
22156 0 : case M2Quads_InclOp:
22157 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Incl ", 18);
22158 0 : break;
22159 :
22160 0 : case M2Quads_ExclOp:
22161 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Excl ", 18);
22162 0 : break;
22163 :
22164 0 : case M2Quads_ReturnOp:
22165 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Return ", 18);
22166 0 : break;
22167 :
22168 0 : case M2Quads_ReturnValueOp:
22169 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ReturnValue ", 18);
22170 0 : break;
22171 :
22172 0 : case M2Quads_FunctValueOp:
22173 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FunctValue ", 18);
22174 0 : break;
22175 :
22176 0 : case M2Quads_CallOp:
22177 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Call ", 18);
22178 0 : break;
22179 :
22180 0 : case M2Quads_ParamOp:
22181 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Param ", 18);
22182 0 : break;
22183 :
22184 0 : case M2Quads_OptParamOp:
22185 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptParam ", 18);
22186 0 : break;
22187 :
22188 0 : case M2Quads_NewLocalVarOp:
22189 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "NewLocalVar ", 18);
22190 0 : break;
22191 :
22192 0 : case M2Quads_KillLocalVarOp:
22193 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "KillLocalVar ", 18);
22194 0 : break;
22195 :
22196 0 : case M2Quads_ProcedureScopeOp:
22197 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProcedureScope ", 18);
22198 0 : break;
22199 :
22200 0 : case M2Quads_UnboundedOp:
22201 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Unbounded ", 18);
22202 0 : break;
22203 :
22204 0 : case M2Quads_CoerceOp:
22205 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Coerce ", 18);
22206 0 : break;
22207 :
22208 0 : case M2Quads_ConvertOp:
22209 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Convert ", 18);
22210 0 : break;
22211 :
22212 0 : case M2Quads_CastOp:
22213 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Cast ", 18);
22214 0 : break;
22215 :
22216 0 : case M2Quads_HighOp:
22217 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "High ", 18);
22218 0 : break;
22219 :
22220 0 : case M2Quads_CodeOnOp:
22221 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CodeOn ", 18);
22222 0 : break;
22223 :
22224 0 : case M2Quads_CodeOffOp:
22225 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CodeOff ", 18);
22226 0 : break;
22227 :
22228 0 : case M2Quads_ProfileOnOp:
22229 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProfileOn ", 18);
22230 0 : break;
22231 :
22232 0 : case M2Quads_ProfileOffOp:
22233 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProfileOff ", 18);
22234 0 : break;
22235 :
22236 0 : case M2Quads_OptimizeOnOp:
22237 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptimizeOn ", 18);
22238 0 : break;
22239 :
22240 0 : case M2Quads_OptimizeOffOp:
22241 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptimizeOff ", 18);
22242 0 : break;
22243 :
22244 0 : case M2Quads_InlineOp:
22245 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Inline ", 18);
22246 0 : break;
22247 :
22248 0 : case M2Quads_StatementNoteOp:
22249 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StatementNote ", 18);
22250 0 : break;
22251 :
22252 0 : case M2Quads_LineNumberOp:
22253 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "LineNumber ", 18);
22254 0 : break;
22255 :
22256 0 : case M2Quads_BuiltinConstOp:
22257 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "BuiltinConst ", 18);
22258 0 : break;
22259 :
22260 0 : case M2Quads_BuiltinTypeInfoOp:
22261 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "BuiltinTypeInfo ", 18);
22262 0 : break;
22263 :
22264 0 : case M2Quads_StandardFunctionOp:
22265 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StandardFunction ", 18);
22266 0 : break;
22267 :
22268 0 : case M2Quads_SavePriorityOp:
22269 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SavePriority ", 18);
22270 0 : break;
22271 :
22272 0 : case M2Quads_RestorePriorityOp:
22273 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RestorePriority ", 18);
22274 0 : break;
22275 :
22276 0 : case M2Quads_RangeCheckOp:
22277 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RangeCheck ", 18);
22278 0 : break;
22279 :
22280 0 : case M2Quads_ErrorOp:
22281 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Error ", 18);
22282 0 : break;
22283 :
22284 0 : case M2Quads_SaveExceptionOp:
22285 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SaveException ", 18);
22286 0 : break;
22287 :
22288 0 : case M2Quads_RestoreExceptionOp:
22289 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RestoreException ", 18);
22290 0 : break;
22291 :
22292 0 : case M2Quads_StringConvertCnulOp:
22293 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringConvertCnul ", 18);
22294 0 : break;
22295 :
22296 0 : case M2Quads_StringConvertM2nulOp:
22297 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringConvertM2nul", 18);
22298 0 : break;
22299 :
22300 0 : case M2Quads_StringLengthOp:
22301 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringLength ", 18);
22302 0 : break;
22303 :
22304 0 : case M2Quads_SubrangeHighOp:
22305 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SubrangeHigh ", 18);
22306 0 : break;
22307 :
22308 0 : case M2Quads_SubrangeLowOp:
22309 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SubrangeLow ", 18);
22310 0 : break;
22311 :
22312 :
22313 0 : default:
22314 0 : M2Error_InternalError ((const char *) "operator not expected", 21);
22315 0 : break;
22316 : }
22317 0 : }
22318 :
22319 :
22320 : /*
22321 : PushAutoOn - push the auto flag and then set it to TRUE.
22322 : Any call to ident in the parser will result in the token being pushed.
22323 : */
22324 :
22325 62562895 : extern "C" void M2Quads_PushAutoOn (void)
22326 : {
22327 62562895 : M2StackWord_PushWord (AutoStack, static_cast<unsigned int> (IsAutoOn));
22328 62562895 : IsAutoOn = true;
22329 62562895 : }
22330 :
22331 :
22332 : /*
22333 : PushAutoOff - push the auto flag and then set it to FALSE.
22334 : */
22335 :
22336 117321655 : extern "C" void M2Quads_PushAutoOff (void)
22337 : {
22338 117321655 : M2StackWord_PushWord (AutoStack, static_cast<unsigned int> (IsAutoOn));
22339 117321655 : IsAutoOn = false;
22340 117321655 : }
22341 :
22342 :
22343 : /*
22344 : IsAutoPushOn - returns the value of the current Auto ident push flag.
22345 : */
22346 :
22347 560206000 : extern "C" bool M2Quads_IsAutoPushOn (void)
22348 : {
22349 560206000 : return IsAutoOn;
22350 : /* static analysis guarentees a RETURN statement will be used before here. */
22351 : __builtin_unreachable ();
22352 : }
22353 :
22354 :
22355 : /*
22356 : PopAuto - restores the previous value of the Auto flag.
22357 : */
22358 :
22359 179860012 : extern "C" void M2Quads_PopAuto (void)
22360 : {
22361 179860012 : IsAutoOn = static_cast<bool> (M2StackWord_PopWord (AutoStack));
22362 179860012 : }
22363 :
22364 :
22365 : /*
22366 : MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
22367 : */
22368 :
22369 529105 : extern "C" bool M2Quads_MustCheckOverflow (unsigned int q)
22370 : {
22371 529105 : M2Quads_QuadFrame f;
22372 :
22373 529105 : f = GetQF (q);
22374 529105 : return f->CheckOverflow;
22375 : /* static analysis guarentees a RETURN statement will be used before here. */
22376 : __builtin_unreachable ();
22377 : }
22378 :
22379 :
22380 : /*
22381 : PushInConstExpression - push the InConstExpression flag and then set it to TRUE.
22382 : */
22383 :
22384 1221310 : extern "C" void M2Quads_PushInConstExpression (void)
22385 : {
22386 1221310 : M2StackWord_PushWord (ConstExprStack, static_cast<unsigned int> (InConstExpression));
22387 1221310 : InConstExpression = true;
22388 1221310 : }
22389 :
22390 :
22391 : /*
22392 : PopInConstExpression - restores the previous value of the InConstExpression.
22393 : */
22394 :
22395 1221286 : extern "C" void M2Quads_PopInConstExpression (void)
22396 : {
22397 1221286 : InConstExpression = static_cast<bool> (M2StackWord_PopWord (ConstExprStack));
22398 1221286 : }
22399 :
22400 :
22401 : /*
22402 : IsInConstExpression - returns the value of the InConstExpression.
22403 : */
22404 :
22405 96198 : extern "C" bool M2Quads_IsInConstExpression (void)
22406 : {
22407 96198 : return InConstExpression;
22408 : /* static analysis guarentees a RETURN statement will be used before here. */
22409 : __builtin_unreachable ();
22410 : }
22411 :
22412 :
22413 : /*
22414 : PushInConstParameters - push the InConstParameters flag and then set it to TRUE.
22415 : */
22416 :
22417 1724 : extern "C" void M2Quads_PushInConstParameters (void)
22418 : {
22419 1724 : M2StackWord_PushWord (ConstParamStack, static_cast<unsigned int> (InConstParameters));
22420 1724 : InConstParameters = true;
22421 1724 : }
22422 :
22423 :
22424 : /*
22425 : PopInConstParameters - restores the previous value of the InConstParameters.
22426 : */
22427 :
22428 1724 : extern "C" void M2Quads_PopInConstParameters (void)
22429 : {
22430 1724 : InConstParameters = static_cast<bool> (M2StackWord_PopWord (ConstParamStack));
22431 1724 : }
22432 :
22433 :
22434 : /*
22435 : IsInConstParameters - returns the value of the InConstParameters.
22436 : */
22437 :
22438 91032 : extern "C" bool M2Quads_IsInConstParameters (void)
22439 : {
22440 91032 : return InConstParameters;
22441 : /* static analysis guarentees a RETURN statement will be used before here. */
22442 : __builtin_unreachable ();
22443 : }
22444 :
22445 :
22446 : /*
22447 : BuildAsmElement - the stack is expected to contain:
22448 :
22449 :
22450 : Entry Exit
22451 : ===== ====
22452 :
22453 : Ptr ->
22454 : +------------------+
22455 : | expr | tokpos |
22456 : |------------------|
22457 : | str |
22458 : |------------------|
22459 : | name |
22460 : |------------------| +------------------+
22461 : | CurrentInterface | | CurrentInterface |
22462 : |------------------| |------------------|
22463 : | CurrentAsm | | CurrentAsm |
22464 : |------------------| |------------------|
22465 : | n | | n |
22466 : |------------------| |------------------|
22467 : */
22468 :
22469 33 : extern "C" void M2Quads_BuildAsmElement (bool input, bool output)
22470 : {
22471 33 : DynamicStrings_String s;
22472 33 : unsigned int n;
22473 33 : unsigned int str;
22474 33 : unsigned int expr;
22475 33 : unsigned int tokpos;
22476 33 : unsigned int CurrentInterface;
22477 33 : unsigned int CurrentAsm;
22478 33 : unsigned int name;
22479 :
22480 33 : M2Quads_PopTtok (&expr, &tokpos);
22481 33 : M2Quads_PopT (&str);
22482 33 : M2Quads_PopT (&name);
22483 33 : M2Quads_PopT (&CurrentInterface);
22484 33 : M2Quads_PopT (&CurrentAsm);
22485 66 : M2Debug_Assert ((SymbolTable_IsGnuAsm (CurrentAsm)) || (SymbolTable_IsGnuAsmVolatile (CurrentAsm)));
22486 33 : M2Quads_PopT (&n);
22487 33 : n += 1;
22488 33 : if (CurrentInterface == SymbolTable_NulSym)
22489 : {
22490 30 : CurrentInterface = SymbolTable_MakeRegInterface ();
22491 : }
22492 33 : if (input)
22493 : {
22494 18 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, name, str, expr, NextQuad, 0);
22495 18 : if (DebugAsmTokPos)
22496 : {
22497 : s = DynamicStrings_InitString ((const char *) "input expression", 16);
22498 : M2Error_WarnStringAt (s, tokpos);
22499 : }
22500 : }
22501 33 : if (output)
22502 : {
22503 15 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, name, str, expr, 0, NextQuad);
22504 15 : if (DebugAsmTokPos)
22505 : {
22506 : s = DynamicStrings_InitString ((const char *) "output expression", 17);
22507 : M2Error_WarnStringAt (s, tokpos);
22508 : }
22509 : }
22510 33 : M2Quads_PushT (n);
22511 33 : M2Quads_PushT (CurrentAsm);
22512 33 : M2Quads_PushT (CurrentInterface);
22513 33 : }
22514 :
22515 :
22516 : /*
22517 : BuildAsmTrash - the stack is expected to contain:
22518 :
22519 :
22520 : Entry Exit
22521 : ===== ====
22522 :
22523 : Ptr ->
22524 : +------------------+
22525 : | expr | tokpos |
22526 : |------------------| +------------------+
22527 : | CurrentInterface | | CurrentInterface |
22528 : |------------------| |------------------|
22529 : | CurrentAsm | | CurrentAsm |
22530 : |------------------| |------------------|
22531 : | n | | n |
22532 : |------------------| |------------------|
22533 : */
22534 :
22535 3 : extern "C" void M2Quads_BuildAsmTrash (void)
22536 : {
22537 3 : unsigned int n;
22538 3 : unsigned int expr;
22539 3 : unsigned int tokpos;
22540 3 : unsigned int CurrentInterface;
22541 3 : unsigned int CurrentAsm;
22542 :
22543 3 : M2Quads_PopTtok (&expr, &tokpos);
22544 3 : M2Quads_PopT (&CurrentInterface);
22545 3 : M2Quads_PopT (&CurrentAsm);
22546 6 : M2Debug_Assert ((SymbolTable_IsGnuAsm (CurrentAsm)) || (SymbolTable_IsGnuAsmVolatile (CurrentAsm)));
22547 3 : M2Quads_PopT (&n);
22548 3 : n += 1;
22549 3 : if (CurrentInterface == SymbolTable_NulSym)
22550 : {
22551 3 : CurrentInterface = SymbolTable_MakeRegInterface ();
22552 : }
22553 3 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, NameKey_NulName, SymbolTable_NulSym, expr, 0, NextQuad);
22554 3 : M2Quads_PushT (n);
22555 3 : M2Quads_PushT (CurrentAsm);
22556 3 : M2Quads_PushT (CurrentInterface);
22557 3 : }
22558 :
22559 :
22560 : /*
22561 : GetQuadTrash - return the symbol associated with the trashed operand.
22562 : */
22563 :
22564 260 : extern "C" unsigned int M2Quads_GetQuadTrash (unsigned int quad)
22565 : {
22566 260 : M2Quads_QuadFrame f;
22567 :
22568 260 : f = GetQF (quad);
22569 260 : LastQuadNo = quad;
22570 260 : return f->Trash;
22571 : /* static analysis guarentees a RETURN statement will be used before here. */
22572 : __builtin_unreachable ();
22573 : }
22574 :
22575 14952 : extern "C" void _M2_M2Quads_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
22576 : {
22577 14952 : Init ();
22578 14952 : }
22579 :
22580 0 : extern "C" void _M2_M2Quads_fini (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
22581 : {
22582 0 : }
|