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 : SafeCheckWithField - only call CheckWithReference if the top of stack
5155 : contains a record field.
5156 : */
5157 :
5158 : static void SafeCheckWithField (void);
5159 :
5160 : /*
5161 : PushConstructor -
5162 : */
5163 :
5164 : static void PushConstructor (unsigned int sym);
5165 :
5166 : /*
5167 : AddFieldTo - adds field to value.
5168 : */
5169 :
5170 : static unsigned int AddFieldTo (unsigned int value, unsigned int field, unsigned int valuetok, unsigned int fieldtok);
5171 :
5172 : /*
5173 : CheckLogicalOperator - returns a logical operator if the operands imply
5174 : a logical operation should be performed.
5175 : */
5176 :
5177 : static NameKey_Name CheckLogicalOperator (NameKey_Name Tok, unsigned int left, unsigned int lefttype);
5178 :
5179 : /*
5180 : CheckDivModRem - initiates calls to check the divisor for DIV, MOD, REM
5181 : expressions.
5182 : */
5183 :
5184 : static void CheckDivModRem (unsigned int TokPos, NameKey_Name tok, unsigned int d, unsigned int e);
5185 :
5186 : /*
5187 : doConvert - convert, sym, to a new symbol with, type.
5188 : Return the new symbol.
5189 : */
5190 :
5191 : static unsigned int doConvert (unsigned int type, unsigned int sym);
5192 :
5193 : /*
5194 : doBuildBinaryOp - build the binary op, with or without type
5195 : checking.
5196 : */
5197 :
5198 : static void doBuildBinaryOp (bool checkTypes, bool checkOverflow);
5199 :
5200 : /*
5201 : AreConstant - returns immediate addressing mode if b is true else
5202 : offset mode is returned. b determines whether the
5203 : operands are all constant - in which case we can use
5204 : a constant temporary variable.
5205 : */
5206 :
5207 : static SymbolTable_ModeOfAddr AreConstant (bool b);
5208 :
5209 : /*
5210 : ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
5211 : exit pair into a variable containing the value TRUE or
5212 : FALSE. The parameter i is relative to the top
5213 : of the stack.
5214 : */
5215 :
5216 : static void ConvertBooleanToVariable (unsigned int tok, unsigned int i);
5217 :
5218 : /*
5219 : DumpQuadSummary -
5220 : */
5221 :
5222 : static void DumpQuadSummary (unsigned int quad);
5223 :
5224 : /*
5225 : BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
5226 : instead of using a temporary boolean variable.
5227 : This function can only be used when we perform
5228 : the following translation:
5229 :
5230 : (a=b) # (c=d) alternatively (a=b) = (c=d)
5231 : ^ ^
5232 :
5233 : it only allows # = to be used as >= <= > < all
5234 : assume a particular value for TRUE and FALSE.
5235 : (In which case the user should specify ORD)
5236 :
5237 :
5238 : before
5239 :
5240 : q if r1 op1 op2 t2
5241 : q+1 Goto f2
5242 : ...
5243 : q+n if r2 op3 op4 t1
5244 : q+n+1 Goto f1
5245 :
5246 : after (in case of =)
5247 :
5248 : q if r1 op1 op2 q+2
5249 : q+1 Goto q+4
5250 : q+2 if r2 op3 op4 t
5251 : q+3 Goto f
5252 : q+4 if r2 op3 op4 f
5253 : q+5 Goto t
5254 :
5255 : after (in case of #)
5256 :
5257 : q if r1 op1 op2 q+2
5258 : q+1 Goto q+n+2
5259 : q+2 ...
5260 : ... ...
5261 : q+n if r2 op3 op4 f
5262 : q+n+1 Goto t
5263 : q+n+2 if r2 op3 op4 t
5264 : q+n+3 Goto f
5265 :
5266 : The Stack is expected to contain:
5267 :
5268 :
5269 : Entry Exit
5270 : ===== ====
5271 :
5272 : Ptr ->
5273 : +------------+
5274 : | t1 | f1 |
5275 : |------------|
5276 : | Operator | <- Ptr
5277 : |------------| +------------+
5278 : | t2 | f2 | | t | f |
5279 : |------------| |------------|
5280 :
5281 :
5282 : */
5283 :
5284 : static void BuildRelOpFromBoolean (unsigned int tokpos);
5285 :
5286 : /*
5287 : CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
5288 : */
5289 :
5290 : static void CheckVariableOrConstantOrProcedure (unsigned int tokpos, unsigned int sym);
5291 :
5292 : /*
5293 : MakeOp - returns the equalent quadruple operator to a token, t.
5294 : */
5295 :
5296 : static M2Quads_QuadOperator MakeOp (NameKey_Name t);
5297 :
5298 : /*
5299 : GenQuadO - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5300 : */
5301 :
5302 : static void GenQuadO (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow);
5303 :
5304 : /*
5305 : GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5306 : */
5307 :
5308 : static void GenQuadOTrash (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int trash);
5309 :
5310 : /*
5311 : GenQuad - Generate a quadruple with Operation, Op1, Op2, Op3.
5312 : */
5313 :
5314 : static void GenQuad (M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3);
5315 :
5316 : /*
5317 : GenQuadOtok - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
5318 : */
5319 :
5320 : 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);
5321 :
5322 : /*
5323 : GenQuadOTypetok - assigns the fields of the quadruple with
5324 : the parameters.
5325 : */
5326 :
5327 : 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);
5328 :
5329 : /*
5330 : DumpUntil - dump all quadruples until we seen the ending quadruple
5331 : with procsym in the third operand.
5332 : Return the quad number containing the match.
5333 : */
5334 :
5335 : static unsigned int DumpUntil (M2Quads_QuadOperator ending, unsigned int procsym, unsigned int quad);
5336 :
5337 : /*
5338 : GetCtorInit - return the init procedure for the module.
5339 : */
5340 :
5341 : static unsigned int GetCtorInit (unsigned int sym);
5342 :
5343 : /*
5344 : GetCtorFini - return the fini procedure for the module.
5345 : */
5346 :
5347 : static unsigned int GetCtorFini (unsigned int sym);
5348 :
5349 : /*
5350 : DumpQuadrupleFilter -
5351 : */
5352 :
5353 : static void DumpQuadrupleFilter (void);
5354 :
5355 : /*
5356 : DumpQuadrupleAll - dump all quadruples.
5357 : */
5358 :
5359 : static void DumpQuadrupleAll (void);
5360 :
5361 : /*
5362 : BackPatch - Makes each of the quadruples on the list pointed to by
5363 : QuadNo take quadruple Value as a target.
5364 : */
5365 :
5366 : static void BackPatch (unsigned int QuadNo, unsigned int Value);
5367 :
5368 : /*
5369 : Merge - joins two quad lists, QuadList2 to the end of QuadList1.
5370 : A QuadList of value zero is a nul list.
5371 : */
5372 :
5373 : static unsigned int Merge (unsigned int QuadList1, unsigned int QuadList2);
5374 :
5375 : /*
5376 : DisplayProcedureAttributes -
5377 : */
5378 :
5379 : static void DisplayProcedureAttributes (unsigned int proc);
5380 :
5381 : /*
5382 : WriteQuad - Writes out the Quad BufferQuad.
5383 : */
5384 :
5385 : static void WriteQuad (unsigned int BufferQuad);
5386 :
5387 : /*
5388 : WriteOperand - displays the operands name, symbol id and mode of addressing.
5389 : */
5390 :
5391 : static void WriteMode (SymbolTable_ModeOfAddr Mode);
5392 :
5393 : /*
5394 : PushExit - pushes the exit value onto the EXIT stack.
5395 : */
5396 :
5397 : static void PushExit (unsigned int Exit);
5398 :
5399 : /*
5400 : PopExit - pops the exit value from the EXIT stack.
5401 : */
5402 :
5403 : static unsigned int PopExit (void);
5404 :
5405 : /*
5406 : PushFor - pushes the exit value onto the FOR stack.
5407 : */
5408 :
5409 : static void PushFor (unsigned int Exit);
5410 :
5411 : /*
5412 : PopFor - pops the exit value from the FOR stack.
5413 : */
5414 :
5415 : static unsigned int PopFor (void);
5416 :
5417 : /*
5418 : OperandTno - returns the ident operand stored in the true position
5419 : on the boolean stack. This is exactly the same as
5420 : OperandT but it has no IsBoolean checking.
5421 : */
5422 :
5423 : static unsigned int OperandTno (unsigned int pos);
5424 :
5425 : /*
5426 : OperandFno - returns the ident operand stored in the false position
5427 : on the boolean stack. This is exactly the same as
5428 : OperandF but it has no IsBoolean checking.
5429 : */
5430 :
5431 : static unsigned int OperandFno (unsigned int pos);
5432 :
5433 : /*
5434 : OperandTtok - returns the token associated with the position, pos
5435 : on the boolean stack.
5436 : */
5437 :
5438 : static unsigned int OperandTtok (unsigned int pos);
5439 :
5440 : /*
5441 : PopBooltok - Pops a True and a False exit quad number from the True/False
5442 : stack.
5443 : */
5444 :
5445 : static void PopBooltok (unsigned int *True, unsigned int *False, unsigned int *tokno);
5446 :
5447 : /*
5448 : PushBooltok - Push a True and a False exit quad numbers onto the
5449 : True/False stack.
5450 : */
5451 :
5452 : static void PushBooltok (unsigned int True, unsigned int False, unsigned int tokno);
5453 :
5454 : /*
5455 : PopBool - Pops a True and a False exit quad number from the True/False
5456 : stack.
5457 : */
5458 :
5459 : static void PopBool (unsigned int *True, unsigned int *False);
5460 :
5461 : /*
5462 : PushBool - Push a True and a False exit quad numbers onto the
5463 : True/False stack.
5464 : */
5465 :
5466 : static void PushBool (unsigned int True, unsigned int False);
5467 :
5468 : /*
5469 : IsBoolean - returns true is the Stack position pos contains a Boolean
5470 : Exit. False is returned if an Ident is stored.
5471 : */
5472 :
5473 : static bool IsBoolean (unsigned int pos);
5474 :
5475 : /*
5476 : OperandD - returns possible array dimension associated with the ident
5477 : operand stored on the boolean stack.
5478 : */
5479 :
5480 : static unsigned int OperandD (unsigned int pos);
5481 :
5482 : /*
5483 : OperandRW - returns the rw operand stored on the boolean stack.
5484 : */
5485 :
5486 : static unsigned int OperandRW (unsigned int pos);
5487 :
5488 : /*
5489 : OperandMergeRW - returns the rw operand if not NulSym else it
5490 : returns True.
5491 : */
5492 :
5493 : static unsigned int OperandMergeRW (unsigned int pos);
5494 :
5495 : /*
5496 : OperandRangeDep - return the range dependant associated with the quad stack.
5497 : */
5498 :
5499 : static unsigned int OperandRangeDep (unsigned int pos);
5500 :
5501 : /*
5502 : PutRangeDep - assigns the quad stack pos RangeDep to dep.
5503 : */
5504 :
5505 : static void PutRangeDep (unsigned int pos, unsigned int dep);
5506 :
5507 : /*
5508 : UseLineNote - uses the line note and returns it to the free list.
5509 : */
5510 :
5511 : static void UseLineNote (M2Quads_LineNote l);
5512 :
5513 : /*
5514 : PopLineNo - pops a line note from the line stack.
5515 : */
5516 :
5517 : static M2Quads_LineNote PopLineNo (void);
5518 :
5519 : /*
5520 : InitLineNote - creates a line note and initializes it to
5521 : contain, file, line.
5522 : */
5523 :
5524 : static M2Quads_LineNote InitLineNote (NameKey_Name file, unsigned int line);
5525 :
5526 : /*
5527 : PushLineNote -
5528 : */
5529 :
5530 : static void PushLineNote (M2Quads_LineNote l);
5531 :
5532 : /*
5533 : BuildStmtNoteTok - adds a nop (with an assigned tokenno location) to the code.
5534 : */
5535 :
5536 : static void BuildStmtNoteTok (unsigned int tokenno);
5537 :
5538 : /*
5539 : GetRecordOrField -
5540 : */
5541 :
5542 : static unsigned int GetRecordOrField (void);
5543 :
5544 : /*
5545 : PushTFAD - Push True, False, Array, Dim, numbers onto the
5546 : True/False stack. True and False are assumed to
5547 : contain Symbols or Ident etc.
5548 : */
5549 :
5550 : static void PushTFAD (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim);
5551 :
5552 : /*
5553 : PushTFADtok - Push True, False, Array, Dim, numbers onto the
5554 : True/False stack. True and False are assumed to
5555 : contain Symbols or Ident etc.
5556 : */
5557 :
5558 : static void PushTFADtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int tokno);
5559 :
5560 : /*
5561 : PushTFADrwtok - Push True, False, Array, Dim, rw, numbers onto the
5562 : True/False stack. True and False are assumed to
5563 : contain Symbols or Ident etc.
5564 : */
5565 :
5566 : static void PushTFADrwtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int rw, unsigned int Tok);
5567 :
5568 : /*
5569 : PopTFrwtok - Pop a True and False number from the True/False stack.
5570 : True and False are assumed to contain Symbols or Ident etc.
5571 : */
5572 :
5573 : static void PopTFrwtok (unsigned int *True, unsigned int *False, unsigned int *rw, unsigned int *tokno);
5574 :
5575 : /*
5576 : PushTFrwtok - Push an item onto the stack in the T (true) position,
5577 : it is assummed to be a token and its token location is recorded.
5578 : */
5579 :
5580 : static void PushTFrwtok (unsigned int True, unsigned int False, unsigned int rw, unsigned int tokno);
5581 :
5582 : /*
5583 : PushTFDtok - Push True, False, Dim, numbers onto the
5584 : True/False stack. True and False are assumed to
5585 : contain Symbols or Ident etc.
5586 : */
5587 :
5588 : static void PushTFDtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int Tok);
5589 :
5590 : /*
5591 : PopTFDtok - Pop a True, False, Dim number from the True/False stack.
5592 : True and False are assumed to contain Symbols or Ident etc.
5593 : */
5594 :
5595 : static void PopTFDtok (unsigned int *True, unsigned int *False, unsigned int *Dim, unsigned int *Tok);
5596 :
5597 : /*
5598 : PushTFDrwtok - Push True, False, Dim, numbers onto the
5599 : True/False stack. True and False are assumed to
5600 : contain Symbols or Ident etc.
5601 : */
5602 :
5603 : static void PushTFDrwtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int rw, unsigned int Tok);
5604 :
5605 : /*
5606 : PushTFrw - Push a True and False numbers onto the True/False stack.
5607 : True and False are assumed to contain Symbols or Ident etc.
5608 : It also pushes the higher level symbol which is associated
5609 : with the True symbol. Eg record variable or array variable.
5610 : */
5611 :
5612 : static void PushTFrw (unsigned int True, unsigned int False, unsigned int rw);
5613 :
5614 : /*
5615 : PopTFrw - Pop a True and False number from the True/False stack.
5616 : True and False are assumed to contain Symbols or Ident etc.
5617 : */
5618 :
5619 : static void PopTFrw (unsigned int *True, unsigned int *False, unsigned int *rw);
5620 :
5621 : /*
5622 : newBoolFrame - creates a new BoolFrame with all fields initialised to their defaults.
5623 : */
5624 :
5625 : static M2Quads_BoolFrame newBoolFrame (void);
5626 :
5627 : /*
5628 : PushTrwtok - Push an item onto the True/False stack. The False value will be zero.
5629 : */
5630 :
5631 : static void PushTrwtok (unsigned int True, unsigned int rw, unsigned int tok);
5632 :
5633 : /*
5634 : PopTrw - Pop a True field and rw symbol from the stack.
5635 : */
5636 :
5637 : static void PopTrw (unsigned int *True, unsigned int *rw);
5638 :
5639 : /*
5640 : PopTrwtok - Pop a True field and rw symbol from the stack.
5641 : */
5642 :
5643 : static void PopTrwtok (unsigned int *True, unsigned int *rw, unsigned int *tok);
5644 :
5645 : /*
5646 : PopTntok - Pop a True/number/tok from the True/False stack.
5647 : True and False are assumed to contain Symbols.
5648 : The number is word sized.
5649 : */
5650 :
5651 : static void PopTntok (unsigned int *True, unsigned int *n, unsigned int *tokno);
5652 :
5653 : /*
5654 : gdbhook - a debugger convenience hook.
5655 : */
5656 :
5657 : static void gdbhook (void);
5658 :
5659 : /*
5660 : BreakWhenQuadCreated - to be called interactively by gdb.
5661 : */
5662 :
5663 : static void BreakWhenQuadCreated (unsigned int quad);
5664 :
5665 : /*
5666 : CheckBreak - if quad = BreakQuad then call gdbhook.
5667 : */
5668 :
5669 : static void CheckBreak (unsigned int quad);
5670 :
5671 : /*
5672 : Init - initialize the M2Quads module, all the stacks, all the lists
5673 : and the quads list.
5674 : */
5675 :
5676 : static void Init (void);
5677 :
5678 :
5679 : /*
5680 : DSdbEnter -
5681 : */
5682 :
5683 0 : static void DSdbEnter (void)
5684 : {
5685 0 : }
5686 :
5687 :
5688 : /*
5689 : DSdbExit -
5690 : */
5691 :
5692 0 : static void DSdbExit (void)
5693 : {
5694 0 : }
5695 :
5696 :
5697 : /*
5698 : GetQF - returns the QuadFrame associated with, q.
5699 : */
5700 :
5701 14299951610 : static M2Quads_QuadFrame GetQF (unsigned int q)
5702 : {
5703 0 : return (M2Quads_QuadFrame) (Indexing_GetIndice (QuadArray, q));
5704 : /* static analysis guarentees a RETURN statement will be used before here. */
5705 : __builtin_unreachable ();
5706 : }
5707 :
5708 :
5709 : /*
5710 : IsQuadA - returns true if QuadNo is a op.
5711 : */
5712 :
5713 1058457771 : static bool IsQuadA (unsigned int QuadNo, M2Quads_QuadOperator op)
5714 : {
5715 1058457771 : M2Quads_QuadFrame f;
5716 :
5717 0 : f = GetQF (QuadNo);
5718 1058457771 : return f->Operator == op;
5719 : /* static analysis guarentees a RETURN statement will be used before here. */
5720 : __builtin_unreachable ();
5721 : }
5722 :
5723 :
5724 : /*
5725 : OpUsesOp1 - return TRUE if op allows op1.
5726 : */
5727 :
5728 428763 : static bool OpUsesOp1 (M2Quads_QuadOperator op)
5729 : {
5730 428763 : switch (op)
5731 : {
5732 : case M2Quads_StringConvertCnulOp:
5733 : case M2Quads_StringConvertM2nulOp:
5734 : case M2Quads_StringLengthOp:
5735 : case M2Quads_InclOp:
5736 : case M2Quads_ExclOp:
5737 : case M2Quads_UnboundedOp:
5738 : case M2Quads_FunctValueOp:
5739 : case M2Quads_NegateOp:
5740 : case M2Quads_BecomesOp:
5741 : case M2Quads_HighOp:
5742 : case M2Quads_SizeOp:
5743 : case M2Quads_AddrOp:
5744 : case M2Quads_RecordFieldOp:
5745 : case M2Quads_ArrayOp:
5746 : case M2Quads_LogicalShiftOp:
5747 : case M2Quads_LogicalRotateOp:
5748 : case M2Quads_LogicalOrOp:
5749 : case M2Quads_LogicalAndOp:
5750 : case M2Quads_LogicalXorOp:
5751 : case M2Quads_CoerceOp:
5752 : case M2Quads_ConvertOp:
5753 : case M2Quads_CastOp:
5754 : case M2Quads_AddOp:
5755 : case M2Quads_SubOp:
5756 : case M2Quads_MultOp:
5757 : case M2Quads_ModFloorOp:
5758 : case M2Quads_DivCeilOp:
5759 : case M2Quads_ModCeilOp:
5760 : case M2Quads_DivFloorOp:
5761 : case M2Quads_ModTruncOp:
5762 : case M2Quads_DivTruncOp:
5763 : case M2Quads_DivM2Op:
5764 : case M2Quads_ModM2Op:
5765 : case M2Quads_XIndrOp:
5766 : case M2Quads_IndrXOp:
5767 : case M2Quads_SaveExceptionOp:
5768 : case M2Quads_RestoreExceptionOp:
5769 : return true;
5770 104344 : break;
5771 :
5772 :
5773 104344 : default:
5774 104344 : return false;
5775 : break;
5776 : }
5777 : /* static analysis guarentees a RETURN statement will be used before here. */
5778 : __builtin_unreachable ();
5779 : }
5780 :
5781 :
5782 : /*
5783 : AddQuadInformation - adds variable analysis and jump analysis to the new quadruple.
5784 : */
5785 :
5786 6377484 : static void AddQuadInformation (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
5787 : {
5788 6377484 : switch (Op)
5789 : {
5790 175078 : case M2Quads_IfInOp:
5791 175078 : case M2Quads_IfNotInOp:
5792 175078 : case M2Quads_IfEquOp:
5793 175078 : case M2Quads_IfNotEquOp:
5794 175078 : case M2Quads_IfLessOp:
5795 175078 : case M2Quads_IfLessEquOp:
5796 175078 : case M2Quads_IfGreOp:
5797 175078 : case M2Quads_IfGreEquOp:
5798 175078 : ManipulateReference (QuadNo, Oper3);
5799 175078 : CheckAddVariableRead (Oper1, false, QuadNo);
5800 175078 : CheckAddVariableRead (Oper2, false, QuadNo);
5801 175078 : break;
5802 :
5803 2552 : case M2Quads_LastForIteratorOp:
5804 2552 : CheckAddVariableWrite (Oper1, false, QuadNo);
5805 2552 : CheckAddTuple2Read (Oper2, false, QuadNo);
5806 2552 : CheckAddVariableRead (Oper3, false, QuadNo);
5807 2552 : break;
5808 :
5809 186539 : case M2Quads_TryOp:
5810 186539 : case M2Quads_RetryOp:
5811 186539 : case M2Quads_GotoOp:
5812 186539 : ManipulateReference (QuadNo, Oper3);
5813 186539 : break;
5814 :
5815 2003 : case M2Quads_InclOp:
5816 2003 : case M2Quads_ExclOp:
5817 : /* variable references */
5818 2003 : CheckConst (Oper1);
5819 2003 : CheckAddVariableRead (Oper3, false, QuadNo);
5820 2003 : CheckAddVariableWrite (Oper1, true, QuadNo);
5821 2003 : break;
5822 :
5823 675188 : case M2Quads_UnboundedOp:
5824 675188 : case M2Quads_FunctValueOp:
5825 675188 : case M2Quads_NegateOp:
5826 675188 : case M2Quads_BecomesOp:
5827 675188 : case M2Quads_HighOp:
5828 675188 : case M2Quads_SizeOp:
5829 675188 : CheckConst (Oper1);
5830 675188 : CheckAddVariableWrite (Oper1, false, QuadNo);
5831 675188 : CheckAddVariableRead (Oper3, false, QuadNo);
5832 675188 : break;
5833 :
5834 196064 : case M2Quads_AddrOp:
5835 196064 : CheckConst (Oper1);
5836 196064 : CheckAddVariableWrite (Oper1, false, QuadNo);
5837 : /* the next line is a kludge and assumes we _will_
5838 : write to the variable as we have taken its address */
5839 196064 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
5840 196064 : break;
5841 :
5842 29799 : case M2Quads_ReturnValueOp:
5843 29799 : CheckAddVariableRead (Oper1, false, QuadNo);
5844 29799 : break;
5845 :
5846 : case M2Quads_ReturnOp:
5847 : case M2Quads_NewLocalVarOp:
5848 : case M2Quads_KillLocalVarOp:
5849 : break;
5850 :
5851 218988 : case M2Quads_CallOp:
5852 218988 : CheckAddVariableRead (Oper3, true, QuadNo);
5853 218988 : break;
5854 :
5855 614714 : case M2Quads_ParamOp:
5856 614714 : CheckAddVariableRead (Oper2, false, QuadNo);
5857 614714 : CheckAddVariableRead (Oper3, false, QuadNo);
5858 614714 : if (((Oper1 > 0) && (Oper1 <= (SymbolTable_NoOfParamAny (Oper2)))) && (SymbolTable_IsVarParamAny (Oper2, Oper1)))
5859 : {
5860 : /* _may_ also write to a var parameter, although we dont know */
5861 20206 : CheckAddVariableWrite (Oper3, true, QuadNo);
5862 : }
5863 : break;
5864 :
5865 357406 : case M2Quads_RecordFieldOp:
5866 357406 : case M2Quads_ArrayOp:
5867 357406 : case M2Quads_LogicalShiftOp:
5868 357406 : case M2Quads_LogicalRotateOp:
5869 357406 : case M2Quads_LogicalOrOp:
5870 357406 : case M2Quads_LogicalAndOp:
5871 357406 : case M2Quads_LogicalXorOp:
5872 357406 : case M2Quads_CoerceOp:
5873 357406 : case M2Quads_ConvertOp:
5874 357406 : case M2Quads_CastOp:
5875 357406 : case M2Quads_AddOp:
5876 357406 : case M2Quads_SubOp:
5877 357406 : case M2Quads_MultOp:
5878 357406 : case M2Quads_DivM2Op:
5879 357406 : case M2Quads_ModM2Op:
5880 357406 : case M2Quads_ModFloorOp:
5881 357406 : case M2Quads_DivCeilOp:
5882 357406 : case M2Quads_ModCeilOp:
5883 357406 : case M2Quads_DivFloorOp:
5884 357406 : case M2Quads_ModTruncOp:
5885 357406 : case M2Quads_DivTruncOp:
5886 357406 : CheckConst (Oper1);
5887 357406 : CheckAddVariableWrite (Oper1, false, QuadNo);
5888 357406 : CheckAddVariableRead (Oper2, false, QuadNo);
5889 357406 : CheckAddVariableRead (Oper3, false, QuadNo);
5890 357406 : break;
5891 :
5892 43526 : case M2Quads_XIndrOp:
5893 43526 : CheckConst (Oper1);
5894 43526 : CheckAddVariableWrite (Oper1, true, QuadNo);
5895 43526 : CheckAddVariableRead (Oper3, false, QuadNo);
5896 43526 : break;
5897 :
5898 17249 : case M2Quads_IndrXOp:
5899 17249 : CheckConst (Oper1);
5900 17249 : CheckAddVariableWrite (Oper1, false, QuadNo);
5901 17249 : CheckAddVariableRead (Oper3, true, QuadNo);
5902 17249 : break;
5903 :
5904 2977 : case M2Quads_SaveExceptionOp:
5905 : /* RangeCheckOp : CheckRangeAddVariableRead(Oper3, QuadNo) | */
5906 2977 : CheckConst (Oper1);
5907 2977 : CheckAddVariableWrite (Oper1, false, QuadNo);
5908 2977 : break;
5909 :
5910 3139 : case M2Quads_RestoreExceptionOp:
5911 3139 : CheckAddVariableRead (Oper1, false, QuadNo);
5912 3139 : break;
5913 :
5914 :
5915 : default:
5916 : break;
5917 : }
5918 6377484 : }
5919 :
5920 :
5921 : /*
5922 : PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
5923 : sets a boolean to determinine whether overflow should be checked.
5924 : */
5925 :
5926 5421234 : static void PutQuadO (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow)
5927 : {
5928 0 : PutQuadOType (QuadNo, Op, Oper1, Oper2, Oper3, overflow, true);
5929 0 : }
5930 :
5931 :
5932 : /*
5933 : PutQuadOType -
5934 : */
5935 :
5936 6296630 : static void PutQuadOType (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3, bool overflow, bool checktype)
5937 : {
5938 6296630 : M2Quads_QuadFrame f;
5939 :
5940 6296630 : if (QuadrupleGeneration)
5941 : {
5942 6296630 : M2Quads_EraseQuad (QuadNo);
5943 6296630 : AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3);
5944 6296630 : f = GetQF (QuadNo);
5945 6296630 : f->Operator = Op;
5946 6296630 : f->Operand1 = Oper1;
5947 6296630 : f->Operand2 = Oper2;
5948 6296630 : f->Operand3 = Oper3;
5949 6296630 : f->CheckOverflow = overflow;
5950 6296630 : f->CheckType = checktype;
5951 6296630 : f->ConstExpr = false; /* IsInConstExpression () */
5952 : }
5953 : /* IsInConstExpression () */
5954 6296630 : }
5955 :
5956 :
5957 : /*
5958 : UndoReadWriteInfo -
5959 : */
5960 :
5961 8303601 : static void UndoReadWriteInfo (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
5962 : {
5963 8303601 : switch (Op)
5964 : {
5965 96712 : case M2Quads_IfInOp:
5966 96712 : case M2Quads_IfNotInOp:
5967 96712 : case M2Quads_IfEquOp:
5968 96712 : case M2Quads_IfNotEquOp:
5969 96712 : case M2Quads_IfLessOp:
5970 96712 : case M2Quads_IfLessEquOp:
5971 96712 : case M2Quads_IfGreOp:
5972 96712 : case M2Quads_IfGreEquOp:
5973 : /* jumps, calls and branches */
5974 96712 : RemoveReference (QuadNo);
5975 96712 : CheckRemoveVariableRead (Oper1, false, QuadNo);
5976 96712 : CheckRemoveVariableRead (Oper2, false, QuadNo);
5977 96712 : break;
5978 :
5979 137303 : case M2Quads_TryOp:
5980 137303 : case M2Quads_RetryOp:
5981 137303 : case M2Quads_GotoOp:
5982 137303 : RemoveReference (QuadNo);
5983 137303 : break;
5984 :
5985 0 : case M2Quads_InclOp:
5986 0 : case M2Quads_ExclOp:
5987 : /* variable references */
5988 0 : CheckRemoveVariableRead (Oper1, false, QuadNo);
5989 0 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
5990 0 : break;
5991 :
5992 335930 : case M2Quads_UnboundedOp:
5993 335930 : case M2Quads_FunctValueOp:
5994 335930 : case M2Quads_NegateOp:
5995 335930 : case M2Quads_BecomesOp:
5996 335930 : case M2Quads_HighOp:
5997 335930 : case M2Quads_SizeOp:
5998 335930 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
5999 335930 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6000 335930 : break;
6001 :
6002 1690 : case M2Quads_AddrOp:
6003 1690 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6004 : /* the next line is a kludge and assumes we _will_
6005 : write to the variable as we have taken its address */
6006 1690 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
6007 1690 : break;
6008 :
6009 184 : case M2Quads_ReturnValueOp:
6010 184 : CheckRemoveVariableRead (Oper1, false, QuadNo);
6011 184 : break;
6012 :
6013 : case M2Quads_ReturnOp:
6014 : case M2Quads_CallOp:
6015 : case M2Quads_NewLocalVarOp:
6016 : case M2Quads_KillLocalVarOp:
6017 : break;
6018 :
6019 11482 : case M2Quads_ParamOp:
6020 11482 : CheckRemoveVariableRead (Oper2, false, QuadNo);
6021 11482 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6022 11482 : if (((Oper1 > 0) && (Oper1 <= (SymbolTable_NoOfParamAny (Oper2)))) && (SymbolTable_IsVarParamAny (Oper2, Oper1)))
6023 : {
6024 : /* _may_ also write to a var parameter, although we dont know */
6025 112 : CheckRemoveVariableWrite (Oper3, true, QuadNo);
6026 : }
6027 : break;
6028 :
6029 50671 : case M2Quads_RecordFieldOp:
6030 50671 : case M2Quads_ArrayOp:
6031 50671 : case M2Quads_LogicalShiftOp:
6032 50671 : case M2Quads_LogicalRotateOp:
6033 50671 : case M2Quads_LogicalOrOp:
6034 50671 : case M2Quads_LogicalAndOp:
6035 50671 : case M2Quads_LogicalXorOp:
6036 50671 : case M2Quads_CoerceOp:
6037 50671 : case M2Quads_ConvertOp:
6038 50671 : case M2Quads_CastOp:
6039 50671 : case M2Quads_AddOp:
6040 50671 : case M2Quads_SubOp:
6041 50671 : case M2Quads_MultOp:
6042 50671 : case M2Quads_DivM2Op:
6043 50671 : case M2Quads_ModM2Op:
6044 50671 : case M2Quads_ModFloorOp:
6045 50671 : case M2Quads_DivCeilOp:
6046 50671 : case M2Quads_ModCeilOp:
6047 50671 : case M2Quads_DivFloorOp:
6048 50671 : case M2Quads_ModTruncOp:
6049 50671 : case M2Quads_DivTruncOp:
6050 50671 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6051 50671 : CheckRemoveVariableRead (Oper2, false, QuadNo);
6052 50671 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6053 50671 : break;
6054 :
6055 4 : case M2Quads_XIndrOp:
6056 4 : CheckRemoveVariableWrite (Oper1, true, QuadNo);
6057 4 : CheckRemoveVariableRead (Oper3, false, QuadNo);
6058 4 : break;
6059 :
6060 494 : case M2Quads_IndrXOp:
6061 494 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6062 494 : CheckRemoveVariableRead (Oper3, true, QuadNo);
6063 494 : break;
6064 :
6065 0 : case M2Quads_SaveExceptionOp:
6066 : /* RangeCheckOp : CheckRangeRemoveVariableRead(Oper3, QuadNo) | */
6067 0 : CheckRemoveVariableWrite (Oper1, false, QuadNo);
6068 0 : break;
6069 :
6070 216 : case M2Quads_RestoreExceptionOp:
6071 216 : CheckRemoveVariableRead (Oper1, false, QuadNo);
6072 216 : break;
6073 :
6074 :
6075 : default:
6076 : break;
6077 : }
6078 8303601 : }
6079 :
6080 :
6081 : /*
6082 : CheckAddTuple2Read - checks to see whether symbol tuple contains variables or
6083 : parameters and if so it then adds them to the quadruple
6084 : variable list.
6085 : */
6086 :
6087 2552 : static void CheckAddTuple2Read (unsigned int tuple, bool canDereference, unsigned int Quad)
6088 : {
6089 2552 : if (SymbolTable_IsTuple (tuple))
6090 : {
6091 2552 : CheckAddVariableRead (SymbolTable_GetNth (tuple, 1), canDereference, Quad);
6092 2552 : CheckAddVariableRead (SymbolTable_GetNth (tuple, 2), canDereference, Quad);
6093 : }
6094 2552 : }
6095 :
6096 :
6097 : /*
6098 : CheckAddVariableRead - checks to see whether symbol, Sym, is a variable or
6099 : a parameter and if so it then adds this quadruple
6100 : to the variable list.
6101 : */
6102 :
6103 3291944 : static void CheckAddVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad)
6104 : {
6105 3291944 : if (SymbolTable_IsVar (Sym))
6106 : {
6107 1169259 : SymbolTable_PutReadQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6108 1169259 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6109 : {
6110 17317 : SymbolTable_PutReadQuad (Sym, SymbolTable_RightValue, Quad);
6111 : }
6112 : }
6113 3291944 : }
6114 :
6115 :
6116 : /*
6117 : CheckRemoveVariableRead - checks to see whether, Sym, is a variable or
6118 : a parameter and if so then it removes the
6119 : quadruple from the variable list.
6120 : */
6121 :
6122 654558 : static void CheckRemoveVariableRead (unsigned int Sym, bool canDereference, unsigned int Quad)
6123 : {
6124 654558 : if (SymbolTable_IsVar (Sym))
6125 : {
6126 122598 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6127 122598 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6128 : {
6129 494 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_RightValue, Quad);
6130 : }
6131 : }
6132 654558 : }
6133 :
6134 :
6135 : /*
6136 : CheckAddVariableWrite - checks to see whether symbol, Sym, is a variable and
6137 : if so it then adds this quadruple to the variable list.
6138 : */
6139 :
6140 1317171 : static void CheckAddVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad)
6141 : {
6142 1317171 : if (SymbolTable_IsVar (Sym))
6143 : {
6144 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6145 944056 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6146 : {
6147 59694 : SymbolTable_PutReadQuad (Sym, SymbolTable_LeftValue, Quad);
6148 59694 : SymbolTable_PutWriteQuad (Sym, SymbolTable_RightValue, Quad);
6149 : }
6150 : else
6151 : {
6152 884362 : SymbolTable_PutWriteQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6153 : }
6154 : }
6155 1317171 : }
6156 :
6157 :
6158 : /*
6159 : CheckRemoveVariableWrite - checks to see whether, Sym, is a variable and
6160 : if so then it removes the quadruple from the
6161 : variable list.
6162 : */
6163 :
6164 586655 : static void CheckRemoveVariableWrite (unsigned int Sym, bool canDereference, unsigned int Quad)
6165 : {
6166 586655 : if (SymbolTable_IsVar (Sym))
6167 : {
6168 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6169 217709 : if (((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue) && canDereference)
6170 : {
6171 11115 : SymbolTable_RemoveReadQuad (Sym, SymbolTable_LeftValue, Quad);
6172 11115 : SymbolTable_RemoveWriteQuad (Sym, SymbolTable_RightValue, Quad);
6173 : }
6174 : else
6175 : {
6176 206594 : SymbolTable_RemoveWriteQuad (Sym, SymbolTable_GetMode (Sym), Quad);
6177 : }
6178 : }
6179 586655 : }
6180 :
6181 :
6182 : /*
6183 : CheckConst -
6184 : */
6185 :
6186 1294413 : static void CheckConst (unsigned int sym)
6187 : {
6188 1294413 : if (SymbolTable_IsConst (sym))
6189 : {
6190 371343 : M2GCCDeclare_PutToBeSolvedByQuads (sym);
6191 : }
6192 1294413 : }
6193 :
6194 :
6195 : /*
6196 : AlterReference - alters all references from OldQuad, to NewQuad in a
6197 : quadruple list Head.
6198 : */
6199 :
6200 1926117 : static void AlterReference (unsigned int Head, unsigned int OldQuad, unsigned int NewQuad)
6201 : {
6202 1926117 : M2Quads_QuadFrame f;
6203 1926117 : M2Quads_QuadFrame g;
6204 1926117 : unsigned int i;
6205 :
6206 1926117 : f = GetQF (OldQuad);
6207 12852849 : while ((f->NoOfTimesReferenced > 0) && (Head != 0))
6208 : {
6209 9000615 : g = GetQF (Head);
6210 9000615 : switch (g->Operator)
6211 : {
6212 397833 : case M2Quads_IfInOp:
6213 397833 : case M2Quads_IfNotInOp:
6214 397833 : case M2Quads_IfEquOp:
6215 397833 : case M2Quads_IfNotEquOp:
6216 397833 : case M2Quads_IfLessOp:
6217 397833 : case M2Quads_IfLessEquOp:
6218 397833 : case M2Quads_IfGreOp:
6219 397833 : case M2Quads_IfGreEquOp:
6220 397833 : case M2Quads_TryOp:
6221 397833 : case M2Quads_RetryOp:
6222 397833 : case M2Quads_GotoOp:
6223 397833 : if (g->Operand3 == OldQuad)
6224 : {
6225 8959 : ManipulateReference (Head, NewQuad);
6226 : }
6227 : break;
6228 :
6229 :
6230 : default:
6231 : break;
6232 : }
6233 9000615 : i = g->Next;
6234 9000615 : Head = i;
6235 : }
6236 1926117 : }
6237 :
6238 :
6239 : /*
6240 : GrowQuads - grows the list of quadruples to the quadruple, to.
6241 : */
6242 :
6243 639229 : static void GrowQuads (unsigned int to)
6244 : {
6245 639229 : unsigned int i;
6246 639229 : M2Quads_QuadFrame f;
6247 :
6248 639229 : if ((to != 0) && (to > GrowInitialization))
6249 : {
6250 9963 : i = GrowInitialization+1;
6251 19926 : while (i <= to)
6252 : {
6253 9963 : if (Indexing_InBounds (QuadArray, i))
6254 : {
6255 0 : M2Debug_Assert ((Indexing_GetIndice (QuadArray, i)) != NULL);
6256 : }
6257 : else
6258 : {
6259 9963 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T3));
6260 9963 : if (f == NULL)
6261 : {
6262 0 : M2Error_InternalError ((const char *) "out of memory error when trying to allocate a quadruple", 55);
6263 : }
6264 9963 : Indexing_PutIndice (QuadArray, i, reinterpret_cast <void *> (f));
6265 9963 : f->NoOfTimesReferenced = 0;
6266 : }
6267 9963 : i += 1;
6268 : }
6269 9963 : GrowInitialization = to;
6270 : }
6271 639229 : }
6272 :
6273 :
6274 : /*
6275 : ManipulateReference - manipulates the quadruple, q, so that it now points to quad, to.
6276 : */
6277 :
6278 639229 : static void ManipulateReference (unsigned int q, unsigned int to)
6279 : {
6280 639229 : M2Quads_QuadFrame f;
6281 :
6282 1278458 : M2Debug_Assert ((GrowInitialization >= q) || (to == 0));
6283 639229 : GrowQuads (to);
6284 639229 : RemoveReference (q);
6285 639229 : f = GetQF (q);
6286 639229 : f->Operand3 = to;
6287 639229 : if (to != 0)
6288 : {
6289 405791 : f = GetQF (to);
6290 405791 : f->NoOfTimesReferenced += 1;
6291 : }
6292 639229 : }
6293 :
6294 :
6295 : /*
6296 : RemoveReference - remove the reference by quadruple q to wherever
6297 : it was pointing.
6298 : */
6299 :
6300 873244 : static void RemoveReference (unsigned int q)
6301 : {
6302 873244 : M2Quads_QuadFrame f;
6303 873244 : M2Quads_QuadFrame g;
6304 :
6305 873244 : f = GetQF (q);
6306 873244 : if ((f->Operand3 != 0) && (f->Operand3 < NextQuad))
6307 : {
6308 278189 : CheckBreak (f->Operand3);
6309 278189 : g = GetQF (f->Operand3);
6310 278189 : M2Debug_Assert (g->NoOfTimesReferenced != 0);
6311 278189 : g->NoOfTimesReferenced -= 1;
6312 : }
6313 873244 : }
6314 :
6315 :
6316 : /*
6317 : NewQuad - sets QuadNo to a new quadruple.
6318 : */
6319 :
6320 6297428 : static void NewQuad (unsigned int *QuadNo)
6321 : {
6322 6297428 : M2Quads_QuadFrame f;
6323 :
6324 6297428 : (*QuadNo) = FreeList;
6325 6297428 : if ((Indexing_InBounds (QuadArray, (*QuadNo))) && ((Indexing_GetIndice (QuadArray, (*QuadNo))) != NULL))
6326 : {
6327 9963 : f = static_cast<M2Quads_QuadFrame> (Indexing_GetIndice (QuadArray, (*QuadNo)));
6328 : }
6329 : else
6330 : {
6331 6287465 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T3));
6332 6287465 : if (f == NULL)
6333 : {
6334 0 : M2Error_InternalError ((const char *) "out of memory error trying to allocate a quadruple", 50);
6335 : }
6336 : else
6337 : {
6338 6287465 : NoOfQuads += 1;
6339 6287465 : Indexing_PutIndice (QuadArray, (*QuadNo), reinterpret_cast <void *> (f));
6340 6287465 : f->NoOfTimesReferenced = 0;
6341 6287465 : M2Diagnostic_MemSet (QuadMemDiag, 1, NoOfQuads);
6342 6287465 : M2Diagnostic_MemIncr (QuadMemDiag, 2, sizeof ((*f)));
6343 : }
6344 : }
6345 6297428 : f->Operator = M2Quads_DummyOp;
6346 6297428 : f->Operand3 = 0;
6347 6297428 : f->Next = 0;
6348 6297428 : FreeList += 1;
6349 6297428 : if (GrowInitialization < FreeList)
6350 : {
6351 6287465 : GrowInitialization = FreeList;
6352 : }
6353 6297428 : }
6354 :
6355 :
6356 : /*
6357 : CheckVariableAt - checks to see whether, sym, was declared at a particular address.
6358 : */
6359 :
6360 4163320 : static void CheckVariableAt (unsigned int sym)
6361 : {
6362 4163320 : if ((SymbolTable_IsVar (sym)) && (SymbolTable_IsVariableAtAddress (sym)))
6363 : {
6364 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6365 54 : if ((SymbolTable_GetMode (sym)) == SymbolTable_LeftValue)
6366 : {
6367 54 : GenQuad (M2Quads_InitAddressOp, sym, SymbolTable_NulSym, SymbolTable_GetVariableAtAddress (sym));
6368 : }
6369 : else
6370 : {
6371 0 : M2Error_InternalError ((const char *) "expecting lvalue for this variable which is declared at an explicit address", 75);
6372 : }
6373 : }
6374 4163320 : }
6375 :
6376 :
6377 : /*
6378 : CheckVariablesAt - checks to see whether we need to initialize any pointers
6379 : which point to variable declared at addresses.
6380 : */
6381 :
6382 167505 : static void CheckVariablesAt (unsigned int scope)
6383 : {
6384 0 : SymbolTable_ForeachLocalSymDo (scope, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) CheckVariableAt});
6385 0 : }
6386 :
6387 :
6388 : /*
6389 : GetTurnInterrupts - returns the TurnInterrupts procedure function.
6390 : */
6391 :
6392 840 : static unsigned int GetTurnInterrupts (unsigned int tok)
6393 : {
6394 840 : if (M2Options_Iso)
6395 : {
6396 0 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "TurnInterrupts", 14), NameKey_MakeKey ((const char *) "COROUTINES", 10));
6397 : }
6398 : else
6399 : {
6400 840 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "TurnInterrupts", 14), NameKey_MakeKey ((const char *) "SYSTEM", 6));
6401 : }
6402 : /* static analysis guarentees a RETURN statement will be used before here. */
6403 : __builtin_unreachable ();
6404 : }
6405 :
6406 :
6407 : /*
6408 : GetProtection - returns the PROTECTION data type.
6409 : */
6410 :
6411 420 : static unsigned int GetProtection (unsigned int tok)
6412 : {
6413 420 : if (M2Options_Iso)
6414 : {
6415 0 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "PROTECTION", 10), NameKey_MakeKey ((const char *) "COROUTINES", 10));
6416 : }
6417 : else
6418 : {
6419 420 : return GetQualidentImport (tok, NameKey_MakeKey ((const char *) "PROTECTION", 10), NameKey_MakeKey ((const char *) "SYSTEM", 6));
6420 : }
6421 : /* static analysis guarentees a RETURN statement will be used before here. */
6422 : __builtin_unreachable ();
6423 : }
6424 :
6425 :
6426 : /*
6427 : CheckNeedPriorityBegin - checks to see whether we need to save the old
6428 : module priority and change to another module
6429 : priority.
6430 : The current module initialization or procedure
6431 : being built is defined by, scope. The module whose
6432 : priority will be used is defined by, module.
6433 : */
6434 :
6435 183313 : static void CheckNeedPriorityBegin (unsigned int tok, unsigned int scope, unsigned int module)
6436 : {
6437 183313 : unsigned int ProcSym;
6438 183313 : unsigned int old;
6439 :
6440 183313 : if ((SymbolTable_GetPriority (module)) != SymbolTable_NulSym)
6441 : {
6442 : /* module has been given a priority */
6443 420 : ProcSym = GetTurnInterrupts (tok);
6444 420 : if (ProcSym != SymbolTable_NulSym)
6445 : {
6446 420 : old = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
6447 420 : SymbolTable_PutVar (old, GetProtection (tok));
6448 840 : GenQuadO (tok, M2Quads_SavePriorityOp, old, scope, ProcSym, false);
6449 420 : M2StackWord_PushWord (PriorityStack, old);
6450 : }
6451 : }
6452 183313 : }
6453 :
6454 :
6455 : /*
6456 : CheckNeedPriorityEnd - checks to see whether we need to restore the old
6457 : module priority.
6458 : The current module initialization or procedure
6459 : being built is defined by, scope.
6460 : */
6461 :
6462 183130 : static void CheckNeedPriorityEnd (unsigned int tok, unsigned int scope, unsigned int module)
6463 : {
6464 183130 : unsigned int ProcSym;
6465 183130 : unsigned int old;
6466 :
6467 183130 : if ((SymbolTable_GetPriority (module)) != SymbolTable_NulSym)
6468 : {
6469 : /* module has been given a priority */
6470 420 : ProcSym = GetTurnInterrupts (tok);
6471 420 : if (ProcSym != SymbolTable_NulSym)
6472 : {
6473 420 : old = static_cast<unsigned int> (M2StackWord_PopWord (PriorityStack));
6474 420 : GenQuad (M2Quads_RestorePriorityOp, old, scope, ProcSym);
6475 : }
6476 : }
6477 183130 : }
6478 :
6479 :
6480 : /*
6481 : BuildRTExceptEnter - informs RTExceptions that we are about to enter the except state.
6482 : */
6483 :
6484 2977 : static void BuildRTExceptEnter (unsigned int tok)
6485 : {
6486 2977 : unsigned int old;
6487 2977 : unsigned int ProcSym;
6488 :
6489 2977 : if (M2Options_Exceptions)
6490 : {
6491 : /* now inform the Modula-2 runtime we are in the exception state */
6492 2977 : ProcSym = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "SetExceptionState", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6493 2977 : if (ProcSym == SymbolTable_NulSym)
6494 : {
6495 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%W}no procedure SetExceptionState found in RTExceptions which is needed to implement exception handling", 104);
6496 : }
6497 : else
6498 : {
6499 2977 : old = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
6500 2977 : SymbolTable_PutVar (old, M2Base_Boolean);
6501 5954 : GenQuadO (tok, M2Quads_SaveExceptionOp, old, SymbolTable_NulSym, ProcSym, false);
6502 2977 : M2StackWord_PushWord (ExceptStack, old);
6503 : }
6504 : }
6505 : else
6506 : {
6507 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}cannot use {%kEXCEPT} blocks with the -fno-exceptions flag", 62);
6508 : }
6509 2977 : }
6510 :
6511 :
6512 : /*
6513 : BuildRTExceptLeave - informs RTExceptions that we are about to leave the except state.
6514 : If, destroy, is TRUE then pop the ExceptStack.
6515 : */
6516 :
6517 3139 : static void BuildRTExceptLeave (unsigned int tok, bool destroy)
6518 : {
6519 3139 : unsigned int old;
6520 3139 : unsigned int ProcSym;
6521 :
6522 3139 : if (M2Options_Exceptions)
6523 : {
6524 : /* avoid dangling else. */
6525 : /* now inform the Modula-2 runtime we are in the exception state */
6526 3139 : ProcSym = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "SetExceptionState", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6527 3139 : if (ProcSym != SymbolTable_NulSym)
6528 : {
6529 3139 : if (destroy)
6530 : {
6531 2977 : old = static_cast<unsigned int> (M2StackWord_PopWord (ExceptStack));
6532 : }
6533 : else
6534 : {
6535 162 : old = static_cast<unsigned int> (M2StackWord_PeepWord (ExceptStack, 1));
6536 : }
6537 3139 : GenQuadO (tok, M2Quads_RestoreExceptionOp, old, SymbolTable_NulSym, ProcSym, false);
6538 : }
6539 : }
6540 : /* no need for an error message here as it will be generated in the Enter procedure above */
6541 3139 : }
6542 :
6543 :
6544 : /*
6545 : SafeRequestSym - only used during scaffold to get argc, argv, envp.
6546 : It attempts to get symbol name from the current scope(s) and if
6547 : it fails then it falls back onto default constants.
6548 : */
6549 :
6550 16530 : static unsigned int SafeRequestSym (unsigned int tok, NameKey_Name name)
6551 : {
6552 16530 : unsigned int sym;
6553 :
6554 16530 : sym = SymbolTable_GetSym (name);
6555 16530 : if (sym == SymbolTable_NulSym)
6556 : {
6557 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
6558 0 : if (name == (NameKey_MakeKey ((const char *) "argc", 4)))
6559 : {
6560 0 : return SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType);
6561 : }
6562 0 : else if ((name == (NameKey_MakeKey ((const char *) "argv", 4))) || (name == (NameKey_MakeKey ((const char *) "envp", 4))))
6563 : {
6564 : /* avoid dangling else. */
6565 0 : return M2Base_Nil;
6566 : }
6567 : else
6568 : {
6569 : /* avoid dangling else. */
6570 0 : M2Error_InternalError ((const char *) "not expecting this parameter name", 33);
6571 : return M2Base_Nil;
6572 : }
6573 : }
6574 : return sym;
6575 : /* static analysis guarentees a RETURN statement will be used before here. */
6576 : __builtin_unreachable ();
6577 : }
6578 :
6579 :
6580 : /*
6581 : callRequestDependant - create a call:
6582 : RequestDependant (GetSymName (modulesym), GetLibName (modulesym),
6583 : GetSymName (depModuleSym), GetLibName (depModuleSym));
6584 : */
6585 :
6586 38544 : static void callRequestDependant (unsigned int tokno, unsigned int moduleSym, unsigned int depModuleSym, unsigned int requestDep)
6587 : {
6588 38544 : M2Debug_Assert (requestDep != SymbolTable_NulSym);
6589 38544 : M2Quads_PushTtok (requestDep, tokno);
6590 38544 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6591 38544 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetSymName (moduleSym)), tokno);
6592 38544 : M2Quads_PushT (static_cast<unsigned int> (1));
6593 38544 : BuildAdrFunction ();
6594 38544 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6595 38544 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetLibName (moduleSym)), tokno);
6596 38544 : M2Quads_PushT (static_cast<unsigned int> (1));
6597 38544 : BuildAdrFunction ();
6598 38544 : if (depModuleSym == SymbolTable_NulSym)
6599 : {
6600 15519 : M2Quads_PushTF (M2Base_Nil, M2System_Address);
6601 15519 : M2Quads_PushTF (M2Base_Nil, M2System_Address);
6602 : }
6603 : else
6604 : {
6605 23025 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6606 23025 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetSymName (depModuleSym)), tokno);
6607 23025 : M2Quads_PushT (static_cast<unsigned int> (1));
6608 23025 : BuildAdrFunction ();
6609 23025 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tokno);
6610 23025 : M2Quads_PushTtok (SymbolTable_MakeConstString (tokno, SymbolTable_GetLibName (depModuleSym)), tokno);
6611 23025 : M2Quads_PushT (static_cast<unsigned int> (1));
6612 23025 : BuildAdrFunction ();
6613 : }
6614 38544 : M2Quads_PushT (static_cast<unsigned int> (4));
6615 38544 : M2Quads_BuildProcedureCall (tokno);
6616 38544 : }
6617 :
6618 :
6619 : /*
6620 : ForeachImportInDepDo -
6621 : */
6622 :
6623 31038 : static void ForeachImportInDepDo (Lists_List importStatements, unsigned int moduleSym, unsigned int requestDep)
6624 : {
6625 31038 : unsigned int i;
6626 31038 : unsigned int j;
6627 31038 : unsigned int m;
6628 31038 : unsigned int n;
6629 31038 : unsigned int imported;
6630 31038 : unsigned int stmt;
6631 31038 : Lists_List l;
6632 :
6633 31038 : if (importStatements != NULL)
6634 : {
6635 19323 : i = 1;
6636 19323 : n = Lists_NoOfItemsInList (importStatements);
6637 60921 : while (i <= n)
6638 : {
6639 22275 : stmt = static_cast<unsigned int> (Lists_GetItemFromList (importStatements, i));
6640 22275 : M2Debug_Assert (SymbolTable_IsImportStatement (stmt));
6641 22275 : l = SymbolTable_GetImportStatementList (stmt);
6642 22275 : j = 1;
6643 22275 : m = Lists_NoOfItemsInList (l);
6644 67575 : while (j <= m)
6645 : {
6646 23025 : imported = static_cast<unsigned int> (Lists_GetItemFromList (l, j));
6647 23025 : M2Debug_Assert (SymbolTable_IsImport (imported));
6648 23025 : callRequestDependant (SymbolTable_GetImportDeclared (imported), moduleSym, SymbolTable_GetImportModule (imported), requestDep);
6649 23025 : j += 1;
6650 : }
6651 22275 : i += 1;
6652 : }
6653 : }
6654 31038 : }
6655 :
6656 :
6657 : /*
6658 : ForeachImportedModuleDo -
6659 : */
6660 :
6661 15519 : static void ForeachImportedModuleDo (unsigned int moduleSym, unsigned int requestDep)
6662 : {
6663 15519 : Lists_List importStatements;
6664 :
6665 15519 : importStatements = SymbolTable_GetModuleModImportStatementList (moduleSym);
6666 15519 : ForeachImportInDepDo (importStatements, moduleSym, requestDep);
6667 15519 : importStatements = SymbolTable_GetModuleDefImportStatementList (moduleSym);
6668 15519 : ForeachImportInDepDo (importStatements, moduleSym, requestDep);
6669 15519 : }
6670 :
6671 :
6672 : /*
6673 : BuildM2DepFunction - creates the dependency graph procedure using IR:
6674 : static void
6675 : dependencies (void)
6676 : {
6677 : M2RTS_RequestDependant (module_name, libname, "b", "b libname");
6678 : M2RTS_RequestDependant (module_name, libname, NULL, NULL);
6679 : }
6680 : */
6681 :
6682 15595 : static void BuildM2DepFunction (unsigned int tokno, unsigned int moduleSym)
6683 : {
6684 15595 : unsigned int requestDep;
6685 15595 : unsigned int ctor;
6686 15595 : unsigned int init;
6687 15595 : unsigned int fini;
6688 15595 : unsigned int dep;
6689 :
6690 15595 : if (M2Options_ScaffoldDynamic)
6691 : {
6692 : /* Scaffold required and dynamic dependency graph should be produced. */
6693 15519 : SymbolTable_GetModuleCtors (moduleSym, &ctor, &init, &fini, &dep);
6694 15519 : M2Quads_PushT (dep);
6695 15519 : M2Quads_BuildProcedureStart ();
6696 15519 : M2Quads_BuildProcedureBegin ();
6697 15519 : SymbolTable_StartScope (dep);
6698 15519 : requestDep = GetQualidentImport (tokno, NameKey_MakeKey ((const char *) "RequestDependant", 16), NameKey_MakeKey ((const char *) "M2RTS", 5));
6699 15519 : if (requestDep != SymbolTable_NulSym)
6700 : {
6701 15519 : ForeachImportedModuleDo (moduleSym, requestDep);
6702 15519 : callRequestDependant (tokno, moduleSym, SymbolTable_NulSym, requestDep);
6703 : }
6704 15519 : SymbolTable_EndScope ();
6705 15519 : M2Quads_BuildProcedureEnd ();
6706 15519 : M2Quads_PopN (1);
6707 : }
6708 15595 : }
6709 :
6710 :
6711 : /*
6712 : BuildM2LinkFunction - creates the _M2_link procedure which will
6713 : cause the linker to pull in all the module ctors.
6714 : */
6715 :
6716 2823 : static void BuildM2LinkFunction (unsigned int tokno)
6717 : {
6718 2823 : if (M2Options_ScaffoldDynamic)
6719 : {
6720 2755 : if (M2Scaffold_linkFunction != SymbolTable_NulSym)
6721 : {
6722 : /* void
6723 : _M2_link (void)
6724 : {
6725 : for each module in uselist do
6726 : PROC foo_%d = _M2_module_ctor
6727 : done
6728 : }. */
6729 2738 : M2Quads_PushT (M2Scaffold_linkFunction);
6730 2738 : M2Quads_BuildProcedureStart ();
6731 2738 : M2Quads_BuildProcedureBegin ();
6732 2738 : SymbolTable_StartScope (M2Scaffold_linkFunction);
6733 2738 : M2Scaffold_PopulateCtorArray (tokno);
6734 2738 : SymbolTable_EndScope ();
6735 2738 : M2Quads_BuildProcedureEnd ();
6736 2738 : M2Quads_PopN (1);
6737 : }
6738 : }
6739 2823 : }
6740 :
6741 :
6742 : /*
6743 : BuildTry - build the try statement for main.
6744 : */
6745 :
6746 2755 : static void BuildTry (unsigned int tokno)
6747 : {
6748 2755 : if (M2Options_Exceptions)
6749 : {
6750 2755 : M2StackWord_PushWord (TryStack, NextQuad);
6751 2755 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
6752 2755 : GenQuadO (tokno, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
6753 : }
6754 2755 : }
6755 :
6756 :
6757 : /*
6758 : BuildExcept - build the except block for main.
6759 : */
6760 :
6761 2755 : static void BuildExcept (unsigned int tokno)
6762 : {
6763 2755 : unsigned int catchProcedure;
6764 :
6765 2755 : if (M2Options_Exceptions)
6766 : {
6767 2755 : M2Quads_BuildExceptInitial (tokno);
6768 2755 : catchProcedure = GetQualidentImport (tokno, NameKey_MakeKey ((const char *) "DefaultErrorCatch", 17), NameKey_MakeKey ((const char *) "RTExceptions", 12));
6769 2755 : if (catchProcedure != SymbolTable_NulSym)
6770 : {
6771 2755 : M2Quads_PushTtok (catchProcedure, tokno);
6772 2755 : M2Quads_PushT (static_cast<unsigned int> (0));
6773 2755 : M2Quads_BuildProcedureCall (tokno);
6774 : }
6775 2755 : BuildRTExceptLeave (tokno, true);
6776 2755 : GenQuadO (tokno, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
6777 : }
6778 2755 : }
6779 :
6780 :
6781 : /*
6782 : BuildM2MainFunction - creates the main function with appropriate calls to the scaffold.
6783 : */
6784 :
6785 2823 : static void BuildM2MainFunction (unsigned int tokno)
6786 : {
6787 2823 : if ((M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic) && ! M2Options_SharedFlag)
6788 : {
6789 : /*
6790 : int
6791 : main (int argc, char *argv[], char *envp[])
6792 : {
6793 : try {
6794 : _M2_init (argc, argv, envp);
6795 : _M2_fini (argc, argv, envp);
6796 : return 0;
6797 : }
6798 : catch (...) {
6799 : RTExceptions_DefaultErrorCatch ();
6800 : return 0;
6801 : }
6802 : }
6803 : */
6804 2755 : M2Quads_PushT (M2Scaffold_mainFunction);
6805 2755 : M2Quads_BuildProcedureStart ();
6806 2755 : M2Quads_BuildProcedureBegin ();
6807 2755 : SymbolTable_StartScope (M2Scaffold_mainFunction);
6808 2755 : BuildTry (tokno);
6809 : /* _M2_init (argc, argv, envp); */
6810 2755 : M2Quads_PushTtok (M2Scaffold_initFunction, tokno);
6811 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argc", 4)), tokno);
6812 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argv", 4)), tokno);
6813 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "envp", 4)), tokno);
6814 2755 : M2Quads_PushT (static_cast<unsigned int> (3));
6815 2755 : M2Quads_BuildProcedureCall (tokno);
6816 : /* _M2_fini (argc, argv, envp); */
6817 2755 : M2Quads_PushTtok (M2Scaffold_finiFunction, tokno);
6818 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argc", 4)), tokno);
6819 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "argv", 4)), tokno);
6820 2755 : M2Quads_PushTtok (SymbolTable_RequestSym (tokno, NameKey_MakeKey ((const char *) "envp", 4)), tokno);
6821 2755 : M2Quads_PushT (static_cast<unsigned int> (3));
6822 2755 : M2Quads_BuildProcedureCall (tokno);
6823 2755 : PushZero (tokno, M2Base_Integer);
6824 2755 : M2Quads_BuildReturn (tokno);
6825 2755 : BuildExcept (tokno);
6826 2755 : PushZero (tokno, M2Base_Integer);
6827 2755 : M2Quads_BuildReturn (tokno);
6828 2755 : SymbolTable_EndScope ();
6829 2755 : M2Quads_BuildProcedureEnd ();
6830 2755 : M2Quads_PopN (1);
6831 : }
6832 2823 : }
6833 :
6834 :
6835 : /*
6836 : DeferMakeConstStringCnul - return a C const string which will be nul terminated.
6837 : */
6838 :
6839 9762 : static unsigned int DeferMakeConstStringCnul (unsigned int tok, unsigned int sym)
6840 : {
6841 9762 : unsigned int const_;
6842 :
6843 9762 : const_ = SymbolTable_MakeConstStringCnul (tok, NameKey_NulName, false);
6844 19524 : GenQuadO (tok, M2Quads_StringConvertCnulOp, const_, 0, sym, false);
6845 9762 : return const_;
6846 : /* static analysis guarentees a RETURN statement will be used before here. */
6847 : __builtin_unreachable ();
6848 : }
6849 :
6850 :
6851 : /*
6852 : DeferMakeConstStringM2nul - return a const string which will be nul terminated.
6853 : */
6854 :
6855 34638 : static unsigned int DeferMakeConstStringM2nul (unsigned int tok, unsigned int sym)
6856 : {
6857 34638 : unsigned int const_;
6858 :
6859 34638 : const_ = SymbolTable_MakeConstStringM2nul (tok, NameKey_NulName, false);
6860 69276 : GenQuadO (tok, M2Quads_StringConvertM2nulOp, const_, 0, sym, false);
6861 34638 : return const_;
6862 : /* static analysis guarentees a RETURN statement will be used before here. */
6863 : __builtin_unreachable ();
6864 : }
6865 :
6866 :
6867 : /*
6868 : BuildStringAdrParam - push the address of a nul terminated string onto the quad stack.
6869 : */
6870 :
6871 8265 : static void BuildStringAdrParam (unsigned int tok, NameKey_Name name)
6872 : {
6873 8265 : unsigned int str;
6874 8265 : unsigned int m2strnul;
6875 :
6876 8265 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6877 8265 : str = SymbolTable_MakeConstString (tok, name);
6878 8265 : SymbolTable_PutConstStringKnown (tok, str, name, false, true);
6879 8265 : m2strnul = DeferMakeConstStringM2nul (tok, str);
6880 8265 : M2Quads_PushTtok (m2strnul, tok);
6881 8265 : M2Quads_PushT (static_cast<unsigned int> (1));
6882 8265 : BuildAdrFunction ();
6883 8265 : }
6884 :
6885 :
6886 : /*
6887 : BuildM2InitFunction -
6888 : */
6889 :
6890 2823 : static void BuildM2InitFunction (unsigned int tok, unsigned int moduleSym)
6891 : {
6892 2823 : unsigned int constructModules;
6893 :
6894 2823 : if (M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic)
6895 : {
6896 : /* int
6897 : _M2_init (int argc, char *argv[], char *envp[])
6898 : {
6899 : M2RTS_ConstructModules (module_name, libname,
6900 : overrideliborder, argc, argv, envp);
6901 : } */
6902 2755 : M2Quads_PushT (M2Scaffold_initFunction);
6903 2755 : M2Quads_BuildProcedureStart ();
6904 2755 : M2Quads_BuildProcedureBegin ();
6905 2755 : SymbolTable_StartScope (M2Scaffold_initFunction);
6906 2755 : if (M2Options_ScaffoldDynamic)
6907 : {
6908 : /* avoid dangling else. */
6909 2755 : if (M2Scaffold_linkFunction != SymbolTable_NulSym)
6910 : {
6911 : /* _M2_link (); */
6912 2738 : M2Quads_PushTtok (M2Scaffold_linkFunction, tok);
6913 2738 : M2Quads_PushT (static_cast<unsigned int> (0));
6914 2738 : M2Quads_BuildProcedureCall (tok);
6915 : }
6916 : /* Lookup ConstructModules and call it. */
6917 2755 : constructModules = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "ConstructModules", 16), NameKey_MakeKey ((const char *) "M2RTS", 5));
6918 2755 : if (constructModules != SymbolTable_NulSym)
6919 : {
6920 : /* ConstructModules (module_name, argc, argv, envp); */
6921 2755 : M2Quads_PushTtok (constructModules, tok);
6922 2755 : BuildStringAdrParam (tok, SymbolTable_GetSymName (moduleSym));
6923 2755 : BuildStringAdrParam (tok, SymbolTable_GetLibName (moduleSym));
6924 2755 : BuildStringAdrParam (tok, NameKey_makekey (M2Options_GetRuntimeModuleOverride ()));
6925 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), tok);
6926 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), tok);
6927 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)), tok);
6928 2755 : M2Quads_PushT (static_cast<unsigned int> (6));
6929 2755 : M2Quads_BuildProcedureCall (tok);
6930 : }
6931 : }
6932 0 : else if (M2Options_ScaffoldStatic)
6933 : {
6934 : /* avoid dangling else. */
6935 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)));
6936 : }
6937 2755 : SymbolTable_EndScope ();
6938 2755 : M2Quads_BuildProcedureEnd ();
6939 2755 : M2Quads_PopN (1);
6940 : }
6941 2823 : }
6942 :
6943 :
6944 : /*
6945 : BuildM2FiniFunction -
6946 : */
6947 :
6948 2823 : static void BuildM2FiniFunction (unsigned int tok, unsigned int moduleSym)
6949 : {
6950 2823 : unsigned int deconstructModules;
6951 :
6952 2823 : if (M2Options_ScaffoldDynamic || M2Options_ScaffoldStatic)
6953 : {
6954 : /* Scaffold required and main should be produced. */
6955 2755 : M2Quads_PushT (M2Scaffold_finiFunction);
6956 2755 : M2Quads_BuildProcedureStart ();
6957 2755 : M2Quads_BuildProcedureBegin ();
6958 2755 : SymbolTable_StartScope (M2Scaffold_finiFunction);
6959 2755 : if (M2Options_ScaffoldDynamic)
6960 : {
6961 : /* avoid dangling else. */
6962 : /* static void
6963 : _M2_finish (int argc, char *argv[], char *envp[])
6964 : {
6965 : M2RTS_DeconstructModules (module_name, argc, argv, envp);
6966 : } */
6967 2755 : deconstructModules = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "DeconstructModules", 18), NameKey_MakeKey ((const char *) "M2RTS", 5));
6968 2755 : if (deconstructModules != SymbolTable_NulSym)
6969 : {
6970 : /* DeconstructModules (module_name, argc, argv, envp); */
6971 2755 : M2Quads_PushTtok (deconstructModules, tok);
6972 2755 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6973 2755 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetSymName (moduleSym)), tok);
6974 2755 : M2Quads_PushT (static_cast<unsigned int> (1));
6975 2755 : BuildAdrFunction ();
6976 2755 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
6977 2755 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetLibName (moduleSym)), tok);
6978 2755 : M2Quads_PushT (static_cast<unsigned int> (1));
6979 2755 : BuildAdrFunction ();
6980 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argc", 4)), tok);
6981 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "argv", 4)), tok);
6982 2755 : M2Quads_PushTtok (SafeRequestSym (tok, NameKey_MakeKey ((const char *) "envp", 4)), tok);
6983 2755 : M2Quads_PushT (static_cast<unsigned int> (5));
6984 2755 : M2Quads_BuildProcedureCall (tok);
6985 : }
6986 : }
6987 0 : else if (M2Options_ScaffoldStatic)
6988 : {
6989 : /* avoid dangling else. */
6990 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)));
6991 : }
6992 2755 : SymbolTable_EndScope ();
6993 2755 : M2Quads_BuildProcedureEnd ();
6994 2755 : M2Quads_PopN (1);
6995 : }
6996 2823 : }
6997 :
6998 :
6999 : /*
7000 : BuildM2CtorFunction - create a constructor function associated with moduleSym.
7001 :
7002 : void
7003 : ctorFunction ()
7004 : {
7005 : M2RTS_RegisterModule (GetSymName (moduleSym), GetLibName (moduleSym),
7006 : init, fini, dependencies);
7007 : }
7008 : */
7009 :
7010 15595 : static void BuildM2CtorFunction (unsigned int tok, unsigned int moduleSym)
7011 : {
7012 15595 : unsigned int RegisterModule;
7013 15595 : unsigned int ctor;
7014 15595 : unsigned int init;
7015 15595 : unsigned int fini;
7016 15595 : unsigned int dep;
7017 :
7018 15595 : if (M2Options_ScaffoldDynamic)
7019 : {
7020 15519 : SymbolTable_GetModuleCtors (moduleSym, &ctor, &init, &fini, &dep);
7021 15519 : if (ctor != SymbolTable_NulSym)
7022 : {
7023 15519 : M2Debug_Assert (SymbolTable_IsProcedure (ctor));
7024 15519 : M2Quads_PushT (ctor);
7025 15519 : M2Quads_BuildProcedureStart ();
7026 15519 : M2Quads_BuildProcedureBegin ();
7027 15519 : SymbolTable_StartScope (ctor);
7028 15519 : RegisterModule = GetQualidentImport (tok, NameKey_MakeKey ((const char *) "RegisterModule", 14), NameKey_MakeKey ((const char *) "M2RTS", 5));
7029 15519 : if (RegisterModule != SymbolTable_NulSym)
7030 : {
7031 : /* RegisterModule (module_name, init, fini, dependencies); */
7032 15519 : M2Quads_PushTtok (RegisterModule, tok);
7033 15519 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
7034 15519 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetSymName (moduleSym)), tok);
7035 15519 : M2Quads_PushT (static_cast<unsigned int> (1));
7036 15519 : BuildAdrFunction ();
7037 15519 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok);
7038 15519 : M2Quads_PushTtok (SymbolTable_MakeConstString (tok, SymbolTable_GetLibName (moduleSym)), tok);
7039 15519 : M2Quads_PushT (static_cast<unsigned int> (1));
7040 15519 : BuildAdrFunction ();
7041 15519 : M2Quads_PushTtok (init, tok);
7042 15519 : M2Quads_PushTtok (fini, tok);
7043 15519 : M2Quads_PushTtok (dep, tok);
7044 15519 : M2Quads_PushT (static_cast<unsigned int> (5));
7045 15519 : M2Quads_BuildProcedureCall (tok);
7046 : }
7047 15519 : SymbolTable_EndScope ();
7048 15519 : M2Quads_BuildProcedureEnd ();
7049 15519 : M2Quads_PopN (1);
7050 : }
7051 : }
7052 15595 : }
7053 :
7054 :
7055 : /*
7056 : AddForInfo - adds the description of the FOR loop into the record list.
7057 : This is used if -pedantic is turned on to check index variable
7058 : usage.
7059 : */
7060 :
7061 2570 : static void AddForInfo (unsigned int Start, unsigned int End, unsigned int IncQuad, unsigned int Sym, unsigned int idtok)
7062 : {
7063 2570 : M2Quads_ForLoopInfo forDesc;
7064 :
7065 2570 : if (M2Options_Pedantic)
7066 : {
7067 0 : Storage_ALLOCATE ((void **) &forDesc, sizeof (M2Quads__T5));
7068 0 : forDesc->IncrementQuad = IncQuad;
7069 0 : forDesc->StartOfForLoop = Start;
7070 0 : forDesc->EndOfForLoop = End;
7071 0 : forDesc->ForLoopIndex = Sym;
7072 0 : forDesc->IndexTok = idtok;
7073 0 : Indexing_IncludeIndiceIntoIndex (ForInfo, reinterpret_cast <void *> (forDesc));
7074 : }
7075 2570 : }
7076 :
7077 :
7078 : /*
7079 : CheckForIndex - checks the quadruples: Start..End to see whether a
7080 : for loop index is manipulated by the programmer.
7081 : It generates a warning if this is the case.
7082 : It also checks to see whether the IndexSym is read
7083 : immediately outside the loop in which case a warning
7084 : is issued.
7085 : */
7086 :
7087 0 : static void CheckForIndex (M2Quads_ForLoopInfo forDesc)
7088 : {
7089 0 : unsigned int ReadStart;
7090 0 : unsigned int ReadEnd;
7091 0 : unsigned int WriteStart;
7092 0 : unsigned int WriteEnd;
7093 :
7094 0 : SymbolTable_GetWriteLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->StartOfForLoop, forDesc->EndOfForLoop, &WriteStart, &WriteEnd);
7095 0 : if ((WriteStart < forDesc->IncrementQuad) && (WriteStart > forDesc->StartOfForLoop))
7096 : {
7097 0 : M2MetaError_MetaErrorT1 (forDesc->IndexTok, (const char *) "{%kFOR} loop index variable {%1Wad} is being manipulated inside the loop", 72, forDesc->ForLoopIndex);
7098 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);
7099 : }
7100 0 : SymbolTable_GetWriteLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->EndOfForLoop, 0, &WriteStart, &WriteEnd);
7101 0 : SymbolTable_GetReadLimitQuads (forDesc->ForLoopIndex, SymbolTable_RightValue, forDesc->EndOfForLoop, 0, &ReadStart, &ReadEnd);
7102 0 : if ((ReadStart != 0) && ((ReadStart < WriteStart) || (WriteStart == 0)))
7103 : {
7104 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);
7105 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);
7106 : }
7107 0 : }
7108 :
7109 :
7110 : /*
7111 : BuildRange - generates a RangeCheckOp quad with, r, as its operand.
7112 : */
7113 :
7114 2071858 : static void BuildRange (unsigned int r)
7115 : {
7116 2071858 : GenQuad (M2Quads_RangeCheckOp, (unsigned int ) (M2LexBuf_GetLineNo ()), SymbolTable_NulSym, r);
7117 2071858 : }
7118 :
7119 :
7120 : /*
7121 : BuildError - generates a ErrorOp quad, indicating that if this
7122 : quadruple is reachable, then a runtime error would
7123 : occur.
7124 : */
7125 :
7126 21362 : static void BuildError (unsigned int r)
7127 : {
7128 21362 : GenQuad (M2Quads_ErrorOp, (unsigned int ) (M2LexBuf_GetLineNo ()), SymbolTable_NulSym, r);
7129 21362 : }
7130 :
7131 :
7132 : /*
7133 : CheckPointerThroughNil - builds a range quadruple, providing, sym, is
7134 : a candidate for checking against NIL.
7135 : This range quadruple is only expanded into
7136 : code during the code generation phase
7137 : thus allowing limited compile time checking.
7138 : */
7139 :
7140 80204 : static void CheckPointerThroughNil (unsigned int tokpos, unsigned int sym)
7141 : {
7142 80204 : if ((SymbolTable_IsVar (sym)) && (SymbolTable_GetVarPointerCheck (sym)))
7143 : {
7144 : /* PutVarPointerCheck(sym, FALSE) ; so we do not detect this again */
7145 23402 : BuildRange (M2Range_InitPointerRangeCheck (tokpos, sym, (SymbolTable_GetMode (sym)) == SymbolTable_LeftValue));
7146 : }
7147 80204 : }
7148 :
7149 :
7150 : /*
7151 : CollectLow - returns the low of the subrange value.
7152 : */
7153 :
7154 306 : static unsigned int CollectLow (unsigned int sym)
7155 : {
7156 306 : unsigned int low;
7157 306 : unsigned int high;
7158 :
7159 306 : if (SymbolTable_IsSubrange (sym))
7160 : {
7161 306 : SymbolTable_GetSubrange (sym, &high, &low);
7162 306 : return low;
7163 : }
7164 : else
7165 : {
7166 0 : M2Error_InternalError ((const char *) "expecting Subrange symbol", 25);
7167 : }
7168 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
7169 : __builtin_unreachable ();
7170 : }
7171 :
7172 :
7173 : /*
7174 : CollectHigh - returns the high of the subrange value, sym.
7175 : */
7176 :
7177 558 : static unsigned int CollectHigh (unsigned int sym)
7178 : {
7179 558 : unsigned int low;
7180 558 : unsigned int high;
7181 :
7182 558 : if (SymbolTable_IsSubrange (sym))
7183 : {
7184 558 : SymbolTable_GetSubrange (sym, &high, &low);
7185 558 : return high;
7186 : }
7187 : else
7188 : {
7189 0 : M2Error_InternalError ((const char *) "expecting Subrange symbol", 25);
7190 : }
7191 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
7192 : __builtin_unreachable ();
7193 : }
7194 :
7195 :
7196 : /*
7197 : CheckCompatibleWithBecomes - checks to see that symbol, sym, is
7198 : compatible with the := operator.
7199 : */
7200 :
7201 498996 : static void CheckCompatibleWithBecomes (unsigned int des, unsigned int expr, unsigned int destok, unsigned int exprtok)
7202 : {
7203 498996 : if (SymbolTable_IsType (des))
7204 : {
7205 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to a type {%1a}", 51, des);
7206 : }
7207 498996 : else if (SymbolTable_IsProcedure (des))
7208 : {
7209 : /* avoid dangling else. */
7210 6 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to a procedure {%1a}", 56, des);
7211 : }
7212 498990 : else if (SymbolTable_IsFieldEnumeration (des))
7213 : {
7214 : /* avoid dangling else. */
7215 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "an assignment cannot assign a value to an enumeration field {%1a}", 65, des);
7216 : }
7217 498996 : if ((M2Base_IsPseudoBaseProcedure (expr)) || (M2Base_IsPseudoBaseFunction (expr)))
7218 : {
7219 6 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "an assignment cannot assign a {%1dv} {%1a}", 42, expr);
7220 : }
7221 498996 : }
7222 :
7223 :
7224 : /*
7225 : BuildAssignmentWithoutBounds - calls BuildAssignment but makes sure we do not
7226 : check bounds.
7227 : */
7228 :
7229 82694 : static void BuildAssignmentWithoutBounds (unsigned int tok, bool checkTypes, bool checkOverflow)
7230 : {
7231 82694 : bool old;
7232 :
7233 82694 : old = MustNotCheckBounds;
7234 82694 : MustNotCheckBounds = true;
7235 0 : doBuildAssignment (tok, checkTypes, checkOverflow);
7236 82694 : MustNotCheckBounds = old;
7237 0 : }
7238 :
7239 :
7240 : /*
7241 : MarkArrayWritten - marks, Array, as being written.
7242 : */
7243 :
7244 101126 : static void MarkArrayWritten (unsigned int Array)
7245 : {
7246 101126 : if ((Array != SymbolTable_NulSym) && (SymbolTable_IsVarAParam (Array)))
7247 : {
7248 12649 : SymbolTable_PutVarWritten (Array, true);
7249 : }
7250 101126 : }
7251 :
7252 :
7253 : /*
7254 : MarkAsReadWrite - marks the variable or parameter as being
7255 : read/write.
7256 : */
7257 :
7258 31038 : static void MarkAsReadWrite (unsigned int sym)
7259 : {
7260 31038 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7261 : {
7262 21276 : SymbolTable_PutReadQuad (sym, SymbolTable_RightValue, NextQuad);
7263 21276 : SymbolTable_PutWriteQuad (sym, SymbolTable_RightValue, NextQuad);
7264 : }
7265 31038 : }
7266 :
7267 :
7268 : /*
7269 : MarkAsRead - marks the variable or parameter as being read.
7270 : */
7271 :
7272 1266515 : static void MarkAsRead (unsigned int sym)
7273 : {
7274 1266515 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7275 : {
7276 358727 : SymbolTable_PutReadQuad (sym, SymbolTable_RightValue, NextQuad);
7277 : }
7278 1266515 : }
7279 :
7280 :
7281 : /*
7282 : MarkAsWrite - marks the variable or parameter as being written.
7283 : */
7284 :
7285 498996 : static void MarkAsWrite (unsigned int sym)
7286 : {
7287 498996 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsVar (sym)))
7288 : {
7289 85468 : SymbolTable_PutWriteQuad (sym, SymbolTable_RightValue, NextQuad);
7290 : }
7291 498996 : }
7292 :
7293 :
7294 : /*
7295 : doVal - return an expression which is VAL(type, expr). If
7296 : expr is a constant then return expr.
7297 : */
7298 :
7299 43922 : static unsigned int doVal (unsigned int type, unsigned int expr)
7300 : {
7301 43922 : if ((! (SymbolTable_IsConst (expr))) && ((SymbolTable_SkipType (type)) != (SymbolTable_GetDType (expr))))
7302 : {
7303 33295 : M2Quads_PushTF (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym));
7304 33295 : M2Quads_PushT (SymbolTable_SkipType (type));
7305 33295 : M2Quads_PushT (expr);
7306 33295 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7307 33295 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
7308 33295 : M2Quads_PopT (&expr);
7309 : }
7310 43922 : return expr;
7311 : /* static analysis guarentees a RETURN statement will be used before here. */
7312 : __builtin_unreachable ();
7313 : }
7314 :
7315 :
7316 : /*
7317 : MoveWithMode -
7318 : */
7319 :
7320 498990 : static void MoveWithMode (unsigned int tokno, unsigned int Des, unsigned int Exp, unsigned int Array, unsigned int destok, unsigned int exptok, bool checkOverflow)
7321 : {
7322 498990 : unsigned int t;
7323 :
7324 498990 : if ((SymbolTable_IsConstString (Exp)) && (SymbolTable_IsConst (Des)))
7325 : {
7326 1295 : GenQuadOtok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7327 : }
7328 : else
7329 : {
7330 497695 : if ((SymbolTable_GetMode (Des)) == SymbolTable_RightValue)
7331 : {
7332 155740 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
7333 : {
7334 2648 : CheckPointerThroughNil (tokno, Exp); /* Des = *Exp */
7335 2648 : doIndrX (tokno, Des, Exp); /* Des = *Exp */
7336 : }
7337 : else
7338 : {
7339 153092 : GenQuadOtok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7340 : }
7341 : }
7342 341955 : else if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7343 : {
7344 : /* avoid dangling else. */
7345 43404 : MarkArrayWritten (Array);
7346 43404 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
7347 : {
7348 1103 : t = SymbolTable_MakeTemporary (tokno, SymbolTable_RightValue);
7349 1103 : SymbolTable_PutVar (t, SymbolTable_GetSType (Exp));
7350 1103 : CheckPointerThroughNil (tokno, Exp);
7351 1103 : doIndrX (tokno, t, Exp);
7352 1103 : CheckPointerThroughNil (tokno, Des); /* *Des = Exp */
7353 1103 : GenQuadO (tokno, M2Quads_XIndrOp, Des, SymbolTable_GetSType (Des), doVal (SymbolTable_GetSType (Des), t), checkOverflow); /* *Des = Exp */
7354 : }
7355 : else
7356 : {
7357 42301 : CheckPointerThroughNil (tokno, Des); /* *Des = Exp */
7358 42301 : GenQuadO (tokno, M2Quads_XIndrOp, Des, SymbolTable_GetSType (Des), doVal (SymbolTable_GetSType (Des), Exp), checkOverflow); /* *Des = Exp */
7359 : }
7360 : }
7361 : else
7362 : {
7363 : /* avoid dangling else. */
7364 : /* This might be inside a const expression. */
7365 298551 : GenQuadOTypetok (tokno, M2Quads_BecomesOp, Des, SymbolTable_NulSym, Exp, true, true, destok, M2LexBuf_UnknownTokenNo, exptok);
7366 : }
7367 : }
7368 498990 : }
7369 :
7370 :
7371 : /*
7372 : CheckBecomesMeta - checks to make sure that we are not
7373 : assigning a variable to a constant.
7374 : Also check we are not assigning to an
7375 : unbounded array.
7376 : */
7377 :
7378 428006 : static void CheckBecomesMeta (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok)
7379 : {
7380 428006 : if ((SymbolTable_IsConst (Des)) && (SymbolTable_IsVar (Exp)))
7381 : {
7382 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);
7383 : }
7384 428006 : if ((((SymbolTable_GetDType (Des)) != SymbolTable_NulSym) && (SymbolTable_IsVar (Des))) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (Des))))
7385 : {
7386 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "in assignment, cannot assign to an unbounded array {%1ad}", 57, Des);
7387 : }
7388 428006 : if ((((SymbolTable_GetDType (Exp)) != SymbolTable_NulSym) && (SymbolTable_IsVar (Exp))) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (Exp))))
7389 : {
7390 0 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "in assignment, cannot assign from an unbounded array {%1ad}", 59, Exp);
7391 : }
7392 428006 : }
7393 :
7394 :
7395 : /*
7396 : BuildAssignmentBoolean - build the quadruples for a boolean variable or constant
7397 : which will be assigned to the result of a boolean expression.
7398 : For example:
7399 :
7400 : foo := a = b ;
7401 : foo := a IN b ;
7402 :
7403 : The boolean result is contained in the control flow
7404 : the true value will emerge from the quad path t.
7405 : The false value will emerge from the quad path f.
7406 : This procedure terminates both paths by backpatching
7407 : and assigns TRUE or FALSE to the variable/constant.
7408 : A variable maybe an L value so it will require dereferencing.
7409 : */
7410 :
7411 9963 : static void BuildAssignmentBoolean (unsigned int becomesTokNo, bool checkOverflow, unsigned int t, unsigned int f, unsigned int Des, unsigned int destok)
7412 : {
7413 9963 : SymbolTable_PutVarConditional (Des, true); /* Des will contain the result of a boolean relop. */
7414 : /* Conditional Boolean Assignment. */
7415 9963 : BackPatch (t, NextQuad);
7416 9963 : if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7417 : {
7418 61 : CheckPointerThroughNil (destok, Des);
7419 122 : GenQuadO (destok, M2Quads_XIndrOp, Des, M2Base_Boolean, M2Base_True, checkOverflow);
7420 61 : GenQuadO (destok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, NextQuad+2, false);
7421 : }
7422 : else
7423 : {
7424 : /* This might be inside a const expression. */
7425 19804 : GenQuadO (becomesTokNo, M2Quads_BecomesOp, Des, SymbolTable_NulSym, M2Base_True, checkOverflow);
7426 9902 : GenQuadO (destok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, NextQuad+2, false);
7427 : }
7428 9963 : BackPatch (f, NextQuad);
7429 9963 : if ((SymbolTable_GetMode (Des)) == SymbolTable_LeftValue)
7430 : {
7431 61 : CheckPointerThroughNil (destok, Des);
7432 61 : GenQuadO (destok, M2Quads_XIndrOp, Des, M2Base_Boolean, M2Base_False, checkOverflow);
7433 : }
7434 : else
7435 : {
7436 9902 : GenQuadO (becomesTokNo, M2Quads_BecomesOp, Des, SymbolTable_NulSym, M2Base_False, checkOverflow);
7437 : }
7438 9963 : }
7439 :
7440 :
7441 : /*
7442 : doBuildAssignment - subsiduary procedure of BuildAssignment.
7443 : It builds the assignment and optionally
7444 : checks the types are compatible.
7445 : */
7446 :
7447 508959 : static void doBuildAssignment (unsigned int becomesTokNo, bool checkTypes, bool checkOverflow)
7448 : {
7449 508959 : unsigned int r;
7450 508959 : unsigned int w;
7451 508959 : unsigned int t;
7452 508959 : unsigned int f;
7453 508959 : unsigned int Array;
7454 508959 : unsigned int Des;
7455 508959 : unsigned int Exp;
7456 508959 : unsigned int combinedtok;
7457 508959 : unsigned int destok;
7458 508959 : unsigned int exptok;
7459 :
7460 508959 : M2Quads_DisplayStack ();
7461 508959 : if (IsBoolean (1))
7462 : {
7463 19926 : PopBool (&t, &f);
7464 9963 : M2Quads_PopTtok (&Des, &destok);
7465 9963 : if ((SymbolTable_IsVar (Des)) || (SymbolTable_IsConstVar (Des)))
7466 : {
7467 9963 : BuildAssignmentBoolean (becomesTokNo, checkOverflow, t, f, Des, destok);
7468 : }
7469 : else
7470 : {
7471 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "expecting the designator {%1Ead} to be a constant or a variable and not a {%1dv}", 80, Des);
7472 : }
7473 : }
7474 : else
7475 : {
7476 498996 : PopTrwtok (&Exp, &r, &exptok);
7477 498996 : MarkAsRead (r);
7478 498996 : if (Exp == SymbolTable_NulSym)
7479 : {
7480 0 : M2MetaError_MetaError0 ((const char *) "{%E}unknown expression found during assignment", 46);
7481 0 : M2Error_FlushErrors ();
7482 : }
7483 498996 : Array = static_cast<unsigned int> (M2Quads_OperandA (1));
7484 498996 : PopTrwtok (&Des, &w, &destok);
7485 498996 : MarkAsWrite (w);
7486 498996 : CheckCompatibleWithBecomes (Des, Exp, destok, exptok);
7487 498996 : if (DebugTokPos)
7488 : {
7489 : M2MetaError_MetaErrorT1 (becomesTokNo, (const char *) "becomestok {%1Oad}", 18, Des);
7490 : M2MetaError_MetaErrorT1 (destok, (const char *) "destok {%1Oad}", 14, Des);
7491 : M2MetaError_MetaErrorT1 (exptok, (const char *) "exptok {%1Oad}", 14, Exp);
7492 : }
7493 498996 : combinedtok = M2LexBuf_MakeVirtualTok (becomesTokNo, destok, exptok);
7494 498996 : if (DebugTokPos)
7495 : {
7496 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "combined {%1Oad}", 16, Des);
7497 : }
7498 498996 : if (M2Options_StrictTypeAssignment)
7499 : {
7500 498996 : BuildRange (M2Range_InitTypesAssignmentCheck (combinedtok, Des, Exp));
7501 : }
7502 498996 : if (((SymbolTable_GetSType (Des)) != SymbolTable_NulSym) && (! (SymbolTable_IsSet (SymbolTable_GetDType (Des)))))
7503 : {
7504 : /* Tell code generator to test runtime values of assignment so ensure we
7505 : catch overflow and underflow. */
7506 489479 : BuildRange (M2Range_InitAssignmentRangeCheck (combinedtok, Des, Exp, destok, exptok));
7507 : }
7508 498990 : if (checkTypes)
7509 : {
7510 428006 : CheckBecomesMeta (Des, Exp, combinedtok, destok, exptok);
7511 : }
7512 : /* Simple assignment. */
7513 498990 : MoveWithMode (combinedtok, Des, Exp, Array, destok, exptok, checkOverflow);
7514 498990 : if (checkTypes)
7515 : {
7516 428006 : CheckAssignCompatible (Des, Exp, combinedtok, destok, exptok);
7517 : }
7518 : }
7519 508953 : M2Quads_DisplayStack ();
7520 508953 : }
7521 :
7522 :
7523 : /*
7524 : CheckAssignCompatible - checks to see that an assignment is compatible.
7525 : It performs limited checking - thorough checking
7526 : is done in pass 3. But we do what we can here
7527 : given knowledge so far.
7528 : */
7529 :
7530 428006 : static void CheckAssignCompatible (unsigned int Des, unsigned int Exp, unsigned int combinedtok, unsigned int destok, unsigned int exprtok)
7531 : {
7532 428006 : unsigned int DesT;
7533 428006 : unsigned int ExpT;
7534 428006 : unsigned int DesL;
7535 :
7536 428006 : DesT = SymbolTable_GetSType (Des);
7537 428006 : ExpT = SymbolTable_GetSType (Exp);
7538 428006 : DesL = SymbolTable_GetLType (Des);
7539 428006 : if (((SymbolTable_IsProcedure (Exp)) && ((DesT != SymbolTable_NulSym) && (! (SymbolTable_IsProcType (DesT))))) && ((DesL != SymbolTable_NulSym) && (! (SymbolTable_IsProcType (DesL)))))
7540 : {
7541 0 : M2MetaError_MetaErrorT1 (destok, (const char *) "incorrectly assigning a procedure to a designator {%1Ead} (designator is not a procedure type, {%1ast})", 103, Des);
7542 : }
7543 : /* We ignore checking of these types in pass 3 - but we do check them thoroughly post pass 3 */
7544 428006 : else if ((SymbolTable_IsProcedure (Exp)) && (SymbolTable_IsProcedureNested (Exp)))
7545 : {
7546 : /* avoid dangling else. */
7547 6 : M2MetaError_MetaErrorT1 (exprtok, (const char *) "cannot call nested procedure {%1Ead} indirectly as the outer scope will not be known", 84, Exp);
7548 : }
7549 428000 : else if (SymbolTable_IsConstString (Exp))
7550 : {
7551 : /* avoid dangling else. */
7552 : }
7553 425050 : else if ((DesT != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (DesT)))
7554 : {
7555 : /* avoid dangling else. */
7556 : }
7557 425050 : else if ((ExpT != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (ExpT)))
7558 : {
7559 : /* avoid dangling else. */
7560 : }
7561 425050 : else if ((DesL != SymbolTable_NulSym) && (SymbolTable_IsArray (DesL)))
7562 : {
7563 : /* avoid dangling else. */
7564 : }
7565 424202 : else if (SymbolTable_IsConstructor (Exp))
7566 : {
7567 : /* avoid dangling else. */
7568 6417 : if (ExpT == SymbolTable_NulSym)
7569 : {} /* empty. */
7570 6377 : else if (((DesT == SymbolTable_NulSym) && (SymbolTable_IsConst (Des))) && ((SymbolTable_IsConstructor (Des)) || (SymbolTable_IsConstSet (Des))))
7571 : {
7572 : /* avoid dangling else. */
7573 0 : SymbolTable_PutConst (Des, ExpT);
7574 : }
7575 6377 : else if (! (M2Base_IsAssignmentCompatible (DesT, ExpT)))
7576 : {
7577 : /* avoid dangling else. */
7578 0 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "constructor expression is not compatible during assignment to {%1Ead}", 69, Des);
7579 : }
7580 : }
7581 417785 : else if (((DesT != SymbolTable_NulSym) && (SymbolTable_IsSet (DesT))) && (SymbolTable_IsConst (Exp)))
7582 : {
7583 : /* avoid dangling else. */
7584 : }
7585 417655 : else if ((((((SymbolTable_IsConst (Exp)) && (ExpT != M2System_Address)) && (! (SymbolTable_IsConst (Des)))) && (DesL != SymbolTable_NulSym)) && ((DesL == M2Base_Cardinal) || (! (SymbolTable_IsSubrange (DesL))))) && (! (SymbolTable_IsEnumeration (DesL))))
7586 : {
7587 : /* avoid dangling else. */
7588 24660 : if ((M2Base_IsBaseType (DesL)) || (M2System_IsSystemType (DesL)))
7589 : {
7590 24660 : M2Base_CheckAssignmentCompatible (combinedtok, ExpT, DesT);
7591 : }
7592 : else
7593 : {
7594 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);
7595 : }
7596 : }
7597 : else
7598 : {
7599 : /* avoid dangling else. */
7600 392995 : if (((DesT != SymbolTable_NulSym) && (SymbolTable_IsProcType (DesT))) && (SymbolTable_IsProcedure (Exp)))
7601 : {
7602 32574 : DesT = SymbolTable_GetSType (DesT); /* we can at least check RETURN values of procedure variables */
7603 : /* remember that thorough assignment checking is done post pass 3 */
7604 32574 : M2Base_CheckAssignmentCompatible (combinedtok, ExpT, DesT);
7605 : }
7606 : }
7607 428006 : }
7608 :
7609 :
7610 : /*
7611 : CheckBooleanId - Checks to see if the top operand is a boolean.
7612 : If the operand is not a boolean then it is tested
7613 : with true and a boolean is generated.
7614 : The Stack:
7615 :
7616 :
7617 : Entry Exit
7618 : Ptr -> <- Ptr
7619 : +------------+ +------------+
7620 : | Sym | | t | f |
7621 : |------------| |------------|
7622 :
7623 : Quadruples
7624 :
7625 : q If= Sym True _
7626 : q+1 GotoOp _ _ _
7627 : */
7628 :
7629 84704 : static void CheckBooleanId (void)
7630 : {
7631 84704 : unsigned int tok;
7632 :
7633 84704 : if (! (IsBoolean (1)))
7634 : {
7635 17713 : tok = static_cast<unsigned int> (M2Quads_OperandTok (1));
7636 17713 : if (SymbolTable_IsVar (M2Quads_OperandT (1)))
7637 : {
7638 14036 : if ((SymbolTable_GetSType (M2Quads_OperandT (1))) != M2Base_Boolean)
7639 : {
7640 0 : M2MetaError_MetaError1 ((const char *) "{%1Ua:is not a boolean expression}{!%1Ua:boolean expression expected}", 69, M2Quads_OperandT (1));
7641 : }
7642 : }
7643 17713 : M2Quads_PushT (M2Reserved_EqualTok);
7644 17713 : M2Quads_PushT (M2Base_True);
7645 17713 : M2Quads_BuildRelOp (tok);
7646 : }
7647 84704 : }
7648 :
7649 :
7650 : /*
7651 : PushOne - pushes the value one to the stack.
7652 : The Stack is changed:
7653 :
7654 :
7655 : Entry Exit
7656 : ===== ====
7657 :
7658 : <- Ptr
7659 : +------------+
7660 : Ptr -> | 1 | type |
7661 : |------------|
7662 : */
7663 :
7664 15977 : static void PushOne (unsigned int tok, unsigned int type, const char *message_, unsigned int _message_high)
7665 : {
7666 15977 : unsigned int const_;
7667 15977 : char message[_message_high+1];
7668 :
7669 : /* make a local copy of each unbounded array. */
7670 15977 : memcpy (message, message_, _message_high+1);
7671 :
7672 15977 : if (type == SymbolTable_NulSym)
7673 : {
7674 220 : const_ = SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), SymbolTable_NulSym);
7675 220 : SymbolTable_PutConstLitInternal (const_, true);
7676 220 : M2Quads_PushTFtok (const_, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7677 : }
7678 15757 : else if (SymbolTable_IsEnumeration (type))
7679 : {
7680 : /* avoid dangling else. */
7681 238 : if ((SymbolTable_NoOfElements (type)) == 0)
7682 : {
7683 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);
7684 0 : PushZero (tok, type);
7685 : }
7686 : else
7687 : {
7688 238 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7689 238 : M2Quads_PushT (type);
7690 238 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_ZType), M2Base_ZType, tok);
7691 238 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7692 238 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters */
7693 : }
7694 : }
7695 : else
7696 : {
7697 : /* avoid dangling else. */
7698 15519 : const_ = SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), type);
7699 15519 : SymbolTable_PutConstLitInternal (const_, true);
7700 15519 : M2Quads_PushTFtok (const_, type, tok);
7701 : }
7702 15977 : }
7703 :
7704 :
7705 : /*
7706 : PushZero - pushes the value zero to the stack.
7707 : The Stack is changed:
7708 :
7709 :
7710 : Entry Exit
7711 : ===== ====
7712 :
7713 : <- Ptr
7714 : +------------+
7715 : Ptr -> | 0 | type |
7716 : |------------|
7717 : */
7718 :
7719 8080 : static void PushZero (unsigned int tok, unsigned int type)
7720 : {
7721 8080 : if (type == SymbolTable_NulSym)
7722 : {
7723 424 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym), static_cast<unsigned int> (SymbolTable_NulSym), tok);
7724 : }
7725 7656 : else if (SymbolTable_IsEnumeration (type))
7726 : {
7727 : /* avoid dangling else. */
7728 196 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
7729 196 : M2Quads_PushTtok (type, tok);
7730 196 : M2Quads_PushTtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType), tok);
7731 196 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
7732 196 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters */
7733 : }
7734 : else
7735 : {
7736 : /* avoid dangling else. */
7737 7460 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "0", 1), type), type, tok);
7738 : }
7739 8080 : }
7740 :
7741 :
7742 : /*
7743 : ForLoopLastIterator - calculate the last iterator value but avoid setting
7744 : LastIterator twice if it is a constant (in the quads).
7745 : In the ForLoopLastIteratorVariable case only one
7746 : path will be chosen but at the time of quadruple
7747 : generation we do not know the value of BySym.
7748 : */
7749 :
7750 2570 : static void ForLoopLastIterator (unsigned int LastIterator, unsigned int e1, unsigned int e2, unsigned int BySym, unsigned int e1tok, unsigned int e2tok, unsigned int bytok)
7751 : {
7752 2570 : if (! (SymbolTable_IsConst (BySym)))
7753 : {
7754 18 : M2MetaError_MetaErrorT1 (bytok, (const char *) "{%E}the {%kFOR} loop {%kBY} expression must be constant, the expression {%1a} is variable", 89, BySym);
7755 18 : M2MetaError_MetaErrorDecl (BySym, true);
7756 : }
7757 : else
7758 : {
7759 2552 : e1 = DereferenceLValue (e1tok, e1);
7760 2552 : e2 = DereferenceLValue (e2tok, e2);
7761 2552 : GenQuadOTypetok (bytok, M2Quads_LastForIteratorOp, LastIterator, SymbolTable_Make2Tuple (e1, e2), BySym, false, false, bytok, M2LexBuf_MakeVirtual2Tok (e1tok, e2tok), bytok);
7762 : }
7763 2570 : }
7764 :
7765 :
7766 : /*
7767 : BuildSizeCheckEnd - checks to see whether the function "called" was in fact SIZE.
7768 : If so then we restore quadruple generation.
7769 : */
7770 :
7771 16340 : static void BuildSizeCheckEnd (unsigned int ProcSym)
7772 : {
7773 16340 : if (((ProcSym == M2Size_Size) || (ProcSym == M2System_TSize)) || (ProcSym == M2System_TBitSize))
7774 : {
7775 13364 : QuadrupleGeneration = true;
7776 13364 : BuildingSize = false;
7777 : }
7778 2976 : else if (ProcSym == M2Base_High)
7779 : {
7780 : /* avoid dangling else. */
7781 2976 : QuadrupleGeneration = true;
7782 2976 : BuildingHigh = false;
7783 : }
7784 16340 : }
7785 :
7786 :
7787 : /*
7788 : BuildRealProcedureCall - builds a real procedure call.
7789 : The Stack:
7790 :
7791 :
7792 : Entry Exit
7793 :
7794 : Ptr ->
7795 : +----------------+
7796 : | NoOfParam |
7797 : |----------------|
7798 : | Param 1 |
7799 : |----------------|
7800 : | Param 2 |
7801 : |----------------|
7802 : . .
7803 : . .
7804 : . .
7805 : |----------------|
7806 : | Param # |
7807 : |----------------|
7808 : | ProcSym | Type | Empty
7809 : |----------------|
7810 : */
7811 :
7812 156436 : static void BuildRealProcedureCall (unsigned int tokno)
7813 : {
7814 156436 : unsigned int NoOfParam;
7815 156436 : unsigned int ProcSym;
7816 :
7817 156436 : M2Quads_PopT (&NoOfParam);
7818 156436 : M2Quads_PushT (NoOfParam);
7819 156436 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+2));
7820 156436 : ProcSym = PCSymBuild_SkipConst (ProcSym);
7821 : /* --checkme-- */
7822 156436 : if (SymbolTable_IsVar (ProcSym))
7823 : {
7824 : /* Procedure Variable ? */
7825 684 : ProcSym = SymbolTable_SkipType (M2Quads_OperandF (NoOfParam+2));
7826 : }
7827 156436 : if ((SymbolTable_IsDefImp (SymbolTable_GetScope (ProcSym))) && (SymbolTable_IsDefinitionForC (SymbolTable_GetScope (ProcSym))))
7828 : {
7829 14773 : BuildRealFuncProcCall (tokno, false, true, false);
7830 : }
7831 : else
7832 : {
7833 141663 : BuildRealFuncProcCall (tokno, false, false, false);
7834 : }
7835 156430 : }
7836 :
7837 :
7838 : /*
7839 : BuildRealFuncProcCall - builds a real procedure or function call.
7840 : The Stack:
7841 :
7842 :
7843 : Entry Exit
7844 :
7845 : Ptr ->
7846 : +----------------+
7847 : | NoOfParam |
7848 : |----------------|
7849 : | Param 1 |
7850 : |----------------|
7851 : | Param 2 |
7852 : |----------------|
7853 : . .
7854 : . .
7855 : . .
7856 : |----------------|
7857 : | Param # |
7858 : |----------------|
7859 : | ProcSym | Type | Empty
7860 : |----------------|
7861 : */
7862 :
7863 219006 : static void BuildRealFuncProcCall (unsigned int tokno, bool IsFunc, bool IsForC, bool ConstExpr)
7864 : {
7865 219006 : bool AllocateProc;
7866 219006 : bool DeallocateProc;
7867 219006 : bool ForcedFunc;
7868 219006 : bool ParamConstant;
7869 219006 : unsigned int trash;
7870 219006 : unsigned int resulttok;
7871 219006 : unsigned int paramtok;
7872 219006 : unsigned int proctok;
7873 219006 : unsigned int NoOfParameters;
7874 219006 : unsigned int i;
7875 219006 : unsigned int pi;
7876 219006 : unsigned int ParamType;
7877 219006 : unsigned int Param1;
7878 219006 : unsigned int ReturnVar;
7879 219006 : unsigned int ProcSym;
7880 219006 : unsigned int Proc;
7881 :
7882 219006 : Param1 = SymbolTable_NulSym; /* Used to remember first param for allocate/deallocate. */
7883 219006 : ParamType = SymbolTable_NulSym;
7884 219006 : CheckProcedureParameters (IsForC);
7885 218988 : M2Quads_PopT (&NoOfParameters);
7886 218988 : M2Quads_PushT (NoOfParameters); /* Restore stack to original state. */
7887 218988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+2)); /* Restore stack to original state. */
7888 218988 : proctok = tokno; /* OperandTtok (NoOfParameters+2) ; */
7889 218988 : if (proctok == M2LexBuf_UnknownTokenNo) /* OperandTtok (NoOfParameters+2) ; */
7890 : {
7891 0 : proctok = M2LexBuf_GetTokenNo ();
7892 : }
7893 218988 : paramtok = proctok;
7894 218988 : ProcSym = PCSymBuild_SkipConst (ProcSym);
7895 218988 : ForcedFunc = false;
7896 218988 : AllocateProc = false;
7897 218988 : DeallocateProc = false;
7898 218988 : if (SymbolTable_IsVar (ProcSym))
7899 : {
7900 : /* Procedure Variable ? */
7901 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF (NoOfParameters+2));
7902 772 : ParamConstant = false;
7903 : }
7904 : else
7905 : {
7906 218216 : Proc = ProcSym;
7907 218216 : ParamConstant = true;
7908 218216 : AllocateProc = (SymbolTable_GetSymName (Proc)) == (NameKey_MakeKey ((const char *) "ALLOCATE", 8));
7909 218216 : DeallocateProc = (SymbolTable_GetSymName (Proc)) == (NameKey_MakeKey ((const char *) "DEALLOCATE", 10));
7910 : }
7911 218988 : if (IsFunc)
7912 : {
7913 : /* avoid dangling else. */
7914 62558 : if ((SymbolTable_GetSType (Proc)) == SymbolTable_NulSym)
7915 : {
7916 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);
7917 : }
7918 : }
7919 : else
7920 : {
7921 : /* is being called as a procedure */
7922 156430 : if ((SymbolTable_GetSType (Proc)) != SymbolTable_NulSym)
7923 : {
7924 : /* however it was declared as a procedure function */
7925 9109 : if (! (SymbolTable_IsReturnOptionalAny (Proc)))
7926 : {
7927 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);
7928 : }
7929 : IsFunc = true;
7930 : ForcedFunc = true;
7931 : }
7932 : }
7933 218988 : if (AllocateProc || DeallocateProc)
7934 : {
7935 1838 : Param1 = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+1)); /* Remember this before manipulating. */
7936 : }
7937 218988 : ManipulateParameters (IsForC);
7938 218988 : CheckParameterOrdinals ();
7939 218988 : M2Quads_PopT (&NoOfParameters);
7940 218988 : if (IsFunc)
7941 : {
7942 71667 : GenQuad (M2Quads_ParamOp, 0, Proc, ProcSym); /* Space for return value */
7943 : }
7944 218988 : if (((NoOfParameters+1) == (SymbolTable_NoOfParamAny (Proc))) && (SymbolTable_UsesOptArgAny (Proc)))
7945 : {
7946 3493 : GenQuad (M2Quads_OptParamOp, SymbolTable_NoOfParamAny (Proc), Proc, Proc);
7947 : }
7948 218988 : i = NoOfParameters;
7949 218988 : pi = 1; /* stack index referencing stacked parameter, i */
7950 762011 : while (i > 0) /* stack index referencing stacked parameter, i */
7951 : {
7952 543023 : paramtok = OperandTtok (pi);
7953 543023 : if (((AllocateProc || DeallocateProc) && (i == 1)) && (Param1 != SymbolTable_NulSym))
7954 : {
7955 1838 : ParamType = GetItemPointedTo (Param1);
7956 1838 : if (ParamType == SymbolTable_NulSym)
7957 : {
7958 0 : GenQuadO (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true);
7959 : }
7960 : else
7961 : {
7962 1838 : if (AllocateProc)
7963 : {
7964 1288 : trash = SymbolTable_MakeTemporary (paramtok, SymbolTable_RightValue);
7965 1288 : SymbolTable_PutVar (trash, ParamType);
7966 1288 : SymbolTable_PutVarHeap (trash, true);
7967 : }
7968 : else
7969 : {
7970 550 : M2Debug_Assert (DeallocateProc);
7971 550 : trash = M2Base_Nil;
7972 : }
7973 1838 : GenQuadOTrash (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true, trash);
7974 : }
7975 : }
7976 : else
7977 : {
7978 541185 : GenQuadO (paramtok, M2Quads_ParamOp, i, Proc, M2Quads_OperandT (pi), true);
7979 : }
7980 543023 : if (! (SymbolTable_IsConst (M2Quads_OperandT (pi))))
7981 : {
7982 458466 : ParamConstant = false;
7983 : }
7984 543023 : i -= 1;
7985 543023 : pi += 1;
7986 : }
7987 437976 : GenQuadO (proctok, M2Quads_CallOp, SymbolTable_NulSym, SymbolTable_NulSym, ProcSym, true);
7988 218988 : M2Quads_PopN (NoOfParameters+1); /* Destroy arguments and procedure call */
7989 218988 : if (IsFunc)
7990 : {
7991 : /* ReturnVar has the type of the procedure. */
7992 71667 : resulttok = M2LexBuf_MakeVirtualTok (proctok, proctok, paramtok);
7993 71667 : if (ConstExpr && (! (SymbolTable_IsProcedureBuiltinAvailable (Proc))))
7994 : {
7995 0 : M2MetaError_MetaError1 ((const char *) "{%1d} {%1ad} cannot be used in a constant expression", 52, Proc);
7996 0 : ParamConstant = false;
7997 : }
7998 71667 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (ParamConstant && ConstExpr));
7999 71667 : SymbolTable_PutVar (ReturnVar, SymbolTable_GetSType (Proc));
8000 143334 : GenQuadO (resulttok, M2Quads_FunctValueOp, ReturnVar, SymbolTable_NulSym, Proc, true);
8001 71667 : if (! ForcedFunc)
8002 : {
8003 62558 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (Proc), resulttok);
8004 : }
8005 : }
8006 218988 : }
8007 :
8008 :
8009 : /*
8010 : CheckProcedureParameters - Checks the parameters which are being passed to
8011 : procedure ProcSym.
8012 :
8013 : The Stack:
8014 :
8015 :
8016 : Entry Exit
8017 :
8018 : Ptr -> <- Ptr
8019 : +----------------+ +----------------+
8020 : | NoOfParam | | NoOfParam |
8021 : |----------------| |----------------|
8022 : | Param 1 | | Param 1 |
8023 : |----------------| |----------------|
8024 : | Param 2 | | Param 2 |
8025 : |----------------| |----------------|
8026 : . . . .
8027 : . . . .
8028 : . . . .
8029 : |----------------| |----------------|
8030 : | Param # | | Param # |
8031 : |----------------| |----------------|
8032 : | ProcSym | Type | | ProcSym | Type |
8033 : |----------------| |----------------|
8034 :
8035 : */
8036 :
8037 219006 : static void CheckProcedureParameters (bool IsForC)
8038 : {
8039 219006 : unsigned int proctok;
8040 219006 : unsigned int paramtok;
8041 219006 : NameKey_Name n1;
8042 219006 : NameKey_Name n2;
8043 219006 : unsigned int ParamCheckId;
8044 219006 : unsigned int Dim;
8045 219006 : unsigned int Actual;
8046 219006 : unsigned int FormalI;
8047 219006 : unsigned int ParamTotal;
8048 219006 : unsigned int pi;
8049 219006 : unsigned int Proc;
8050 219006 : unsigned int ProcSym;
8051 219006 : unsigned int i;
8052 219006 : DynamicStrings_String s;
8053 :
8054 219006 : M2Quads_PopT (&ParamTotal);
8055 219006 : M2Quads_PushT (ParamTotal); /* Restore stack to origional state */
8056 219006 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((ParamTotal+1)+1)); /* Restore stack to origional state */
8057 219006 : proctok = OperandTtok ((ParamTotal+1)+1);
8058 219006 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (SymbolTable_GetDType (ProcSym))))
8059 : {
8060 : /* Procedure Variable ? */
8061 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF ((ParamTotal+1)+1));
8062 : }
8063 : else
8064 : {
8065 218234 : Proc = PCSymBuild_SkipConst (ProcSym);
8066 : }
8067 219006 : if (! ((SymbolTable_IsProcedure (Proc)) || (SymbolTable_IsProcType (Proc))))
8068 : {
8069 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8070 12 : if (SymbolTable_IsUnknown (Proc))
8071 : {
8072 : /* Spellcheck. */
8073 0 : M2MetaError_MetaError1 ((const char *) "{%1Ua} is not recognised as a procedure, check declaration or import {%1&s}", 75, Proc);
8074 0 : SymbolTable_UnknownReported (Proc);
8075 : }
8076 : else
8077 : {
8078 : /* --fixme-- filter on Var, Const, Procedure. */
8079 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);
8080 : }
8081 : }
8082 219006 : if (M2Options_CompilerDebugging)
8083 : {
8084 0 : n1 = SymbolTable_GetSymName (Proc);
8085 0 : M2Printf_printf1 ((const char *) " %a ( ", 7, (const unsigned char *) &n1, (sizeof (n1)-1));
8086 : }
8087 219006 : if (DebugTokPos)
8088 : {
8089 : s = DynamicStrings_InitString ((const char *) "procedure", 9);
8090 : M2Error_WarnStringAt (s, proctok);
8091 : }
8092 219006 : i = 1;
8093 219006 : pi = ParamTotal+1; /* stack index referencing stacked parameter, i */
8094 758843 : while (i <= ParamTotal) /* stack index referencing stacked parameter, i */
8095 : {
8096 539855 : if (i <= (SymbolTable_NoOfParamAny (Proc)))
8097 : {
8098 : /* FormalI := GetParam(Proc, i) ; */
8099 534556 : FormalI = SymbolTable_GetNthParamAnyClosest (Proc, i, SymbolTable_GetCurrentModule ());
8100 534556 : if (M2Options_CompilerDebugging)
8101 : {
8102 0 : n1 = SymbolTable_GetSymName (FormalI);
8103 0 : n2 = SymbolTable_GetSymName (SymbolTable_GetSType (FormalI));
8104 0 : M2Printf_printf2 ((const char *) "%a: %a", 6, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
8105 : }
8106 534556 : Actual = static_cast<unsigned int> (M2Quads_OperandT (pi));
8107 534556 : Dim = static_cast<unsigned int> (OperandD (pi));
8108 534556 : paramtok = OperandTtok (pi);
8109 534556 : if (DebugTokPos)
8110 : {
8111 : s = DynamicStrings_InitString ((const char *) "actual", 6);
8112 : M2Error_WarnStringAt (s, paramtok);
8113 : }
8114 534556 : ParamCheckId = M2Range_InitTypesParameterCheck (paramtok, Proc, i, FormalI, Actual, 0);
8115 534556 : BuildRange (ParamCheckId);
8116 : /* Store the ParamCheckId on the quad stack so that any dependant checks
8117 : can be cancelled if the type check above detects an error. */
8118 534556 : PutRangeDep (pi, ParamCheckId);
8119 534556 : if (SymbolTable_IsConst (Actual))
8120 : {
8121 : /* avoid dangling else. */
8122 119728 : if (SymbolTable_IsVarParamAny (Proc, i))
8123 : {
8124 0 : FailParameter (paramtok, (const char *) "trying to pass a constant to a VAR parameter", 44, Actual, Proc, i);
8125 : }
8126 119728 : else if (SymbolTable_IsConstString (Actual))
8127 : {
8128 : /* avoid dangling else. */
8129 39202 : if (! (SymbolTable_IsConstStringKnown (Actual)))
8130 : {} /* empty. */
8131 38968 : else if ((SymbolTable_IsArray (SymbolTable_GetDType (FormalI))) && ((SymbolTable_GetSType (SymbolTable_GetDType (FormalI))) == M2Base_Char))
8132 : {
8133 : /* avoid dangling else. */
8134 : }
8135 38944 : else if ((SymbolTable_GetStringLength (paramtok, Actual)) == 1)
8136 : {
8137 : /* avoid dangling else. */
8138 5378 : CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, static_cast<Lists_List> (NULL), ParamCheckId);
8139 : }
8140 33566 : else if (! (SymbolTable_IsUnboundedParamAny (Proc, i)))
8141 : {
8142 : /* avoid dangling else. */
8143 0 : if (IsForC && ((SymbolTable_GetSType (FormalI)) == M2System_Address))
8144 : {
8145 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);
8146 : }
8147 : else
8148 : {
8149 0 : FailParameter (paramtok, (const char *) "cannot pass a string constant to a non unbounded array parameter", 64, Actual, Proc, i);
8150 : }
8151 : }
8152 : }
8153 : }
8154 : else
8155 : {
8156 414828 : CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, static_cast<Lists_List> (NULL), ParamCheckId);
8157 : }
8158 : }
8159 : else
8160 : {
8161 5287 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8162 : {
8163 : /* these are varargs, therefore we don't check them */
8164 5287 : i = ParamTotal;
8165 : }
8166 : else
8167 : {
8168 0 : M2MetaError_MetaErrorT2 (proctok, (const char *) "too many parameters, {%2n} passed to {%1a} ", 43, Proc, i);
8169 : }
8170 : }
8171 539837 : i += 1;
8172 539837 : pi -= 1;
8173 539837 : if (M2Options_CompilerDebugging)
8174 : {
8175 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8176 0 : if (i <= ParamTotal)
8177 : {
8178 0 : M2Printf_printf0 ((const char *) "; ", 2);
8179 : }
8180 : else
8181 : {
8182 0 : M2Printf_printf0 ((const char *) " ) ; \\n", 7);
8183 : }
8184 : }
8185 : }
8186 218988 : }
8187 :
8188 :
8189 : /*
8190 : CheckProcTypeAndProcedure - checks the ProcType with the call.
8191 : */
8192 :
8193 48462 : static void CheckProcTypeAndProcedure (unsigned int tokno, unsigned int ProcType, unsigned int call, unsigned int ParamCheckId)
8194 : {
8195 48462 : NameKey_Name n1;
8196 48462 : NameKey_Name n2;
8197 48462 : unsigned int i;
8198 48462 : unsigned int n;
8199 48462 : unsigned int t;
8200 48462 : unsigned int CheckedProcedure;
8201 48462 : M2Error_Error e;
8202 :
8203 48462 : if (((SymbolTable_IsVar (call)) || (SymbolTable_IsTemporary (call))) || (SymbolTable_IsParameter (call)))
8204 : {
8205 592 : CheckedProcedure = SymbolTable_GetDType (call);
8206 : }
8207 : else
8208 : {
8209 : CheckedProcedure = call;
8210 : }
8211 48462 : if (ProcType != CheckedProcedure)
8212 : {
8213 47940 : n = SymbolTable_NoOfParamAny (ProcType);
8214 : /* We need to check the formal parameters between the procedure and proc type. */
8215 47940 : if (n != (SymbolTable_NoOfParamAny (CheckedProcedure)))
8216 : {
8217 0 : e = M2Error_NewError (SymbolTable_GetDeclaredMod (ProcType));
8218 0 : n1 = SymbolTable_GetSymName (call);
8219 0 : n2 = SymbolTable_GetSymName (ProcType);
8220 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));
8221 0 : e = M2Error_ChainError (SymbolTable_GetDeclaredMod (call), e);
8222 0 : t = SymbolTable_NoOfParamAny (CheckedProcedure);
8223 0 : if (n < 2)
8224 : {
8225 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));
8226 : }
8227 : else
8228 : {
8229 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));
8230 : }
8231 : }
8232 : else
8233 : {
8234 : i = 1;
8235 142862 : while (i <= n)
8236 : {
8237 94922 : if ((SymbolTable_IsVarParamAny (ProcType, i)) != (SymbolTable_IsVarParamAny (CheckedProcedure, i)))
8238 : {
8239 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);
8240 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);
8241 : }
8242 94922 : BuildRange (M2Range_InitTypesParameterCheck (tokno, CheckedProcedure, i, SymbolTable_GetNthParamAnyClosest (CheckedProcedure, i, SymbolTable_GetCurrentModule ()), SymbolTable_GetParam (ProcType, i), ParamCheckId));
8243 94922 : i += 1;
8244 : }
8245 : }
8246 : }
8247 48462 : }
8248 :
8249 :
8250 : /*
8251 : IsReallyPointer - returns TRUE is sym is a pointer, address or a type declared
8252 : as a pointer or address.
8253 : */
8254 :
8255 1269 : static bool IsReallyPointer (unsigned int Sym)
8256 : {
8257 1269 : if (SymbolTable_IsVar (Sym))
8258 : {
8259 1268 : Sym = SymbolTable_GetSType (Sym);
8260 : }
8261 1269 : Sym = SymbolTable_SkipType (Sym);
8262 1269 : return (SymbolTable_IsPointer (Sym)) || (Sym == M2System_Address);
8263 : /* static analysis guarentees a RETURN statement will be used before here. */
8264 : __builtin_unreachable ();
8265 : }
8266 :
8267 :
8268 : /*
8269 : LegalUnboundedParam - returns TRUE if the parameter, Actual, can legitimately be
8270 : passed to ProcSym, i, the, Formal, parameter.
8271 : */
8272 :
8273 9797 : static bool LegalUnboundedParam (unsigned int tokpos, unsigned int ProcSym, unsigned int i, unsigned int ActualType, unsigned int Actual, unsigned int Dimension, unsigned int Formal)
8274 : {
8275 9797 : unsigned int FormalType;
8276 9797 : unsigned int n;
8277 9797 : unsigned int m;
8278 :
8279 9797 : ActualType = SymbolTable_SkipType (ActualType);
8280 9797 : FormalType = SymbolTable_GetDType (Formal);
8281 9797 : FormalType = SymbolTable_GetSType (FormalType); /* type of the unbounded ARRAY */
8282 9797 : if (SymbolTable_IsArray (ActualType)) /* type of the unbounded ARRAY */
8283 : {
8284 6771 : m = SymbolTable_GetDimension (Formal);
8285 6771 : n = 0;
8286 13788 : while (SymbolTable_IsArray (ActualType))
8287 : {
8288 6939 : n += 1;
8289 6939 : ActualType = SymbolTable_GetDType (ActualType);
8290 6939 : if ((m == n) && (ActualType == FormalType))
8291 : {
8292 : return true;
8293 : }
8294 : }
8295 78 : if (n == m)
8296 : {} /* empty. */
8297 : else
8298 : {
8299 : /* now we fall though and test ActualType against FormalType */
8300 24 : if (M2System_IsGenericSystemType (FormalType))
8301 : {
8302 : return true;
8303 : }
8304 : else
8305 : {
8306 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);
8307 12 : return false;
8308 : }
8309 : }
8310 : }
8311 3026 : else if (SymbolTable_IsUnbounded (ActualType))
8312 : {
8313 : /* avoid dangling else. */
8314 36 : if ((Dimension == 0) && ((SymbolTable_GetDimension (Formal)) == (SymbolTable_GetDimension (Actual))))
8315 : {
8316 : /* now we fall though and test ActualType against FormalType */
8317 0 : ActualType = SymbolTable_GetSType (ActualType);
8318 : }
8319 : else
8320 : {
8321 36 : if (M2System_IsGenericSystemType (FormalType))
8322 : {
8323 : return true;
8324 : }
8325 : else
8326 : {
8327 12 : if (((SymbolTable_GetDimension (Actual))-Dimension) == (SymbolTable_GetDimension (Formal)))
8328 : {
8329 12 : ActualType = SymbolTable_GetSType (ActualType);
8330 : }
8331 : else
8332 : {
8333 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);
8334 0 : return false;
8335 : }
8336 : }
8337 : }
8338 : }
8339 3056 : if (((M2System_IsGenericSystemType (FormalType)) || (M2System_IsGenericSystemType (ActualType))) || (M2Base_IsAssignmentCompatible (FormalType, ActualType)))
8340 : {
8341 : /* we think it is legal, but we ask post pass 3 to check as
8342 : not all types are known at this point */
8343 : return true;
8344 : }
8345 : else
8346 : {
8347 6 : FailParameter (tokpos, (const char *) "identifier with an incompatible type is being passed to this procedure", 70, Actual, ProcSym, i);
8348 6 : return false;
8349 : }
8350 : /* static analysis guarentees a RETURN statement will be used before here. */
8351 : __builtin_unreachable ();
8352 : }
8353 :
8354 :
8355 : /*
8356 : CheckParameter - checks that types ActualType and FormalType are compatible for parameter
8357 : passing. ProcSym is the procedure and i is the parameter number.
8358 :
8359 : We obey the following rules:
8360 :
8361 : (1) we allow WORD, BYTE, LOC to be compitable with any like sized
8362 : type.
8363 : (2) we allow ADDRESS to be compatible with any pointer type.
8364 : (3) we relax INTEGER and CARDINAL checking for Temporary variables.
8365 :
8366 : Note that type sizes are checked during the code generation pass.
8367 : */
8368 :
8369 420206 : 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)
8370 : {
8371 420206 : bool NewList;
8372 420206 : unsigned int ActualType;
8373 420206 : unsigned int FormalType;
8374 :
8375 420206 : if ((SymbolTable_IsConstString (Actual)) && (! (SymbolTable_IsConstStringKnown (Actual))))
8376 : {
8377 : /* Cannot check if the string content is not yet known. */
8378 : return;
8379 : }
8380 420206 : FormalType = SymbolTable_GetDType (Formal);
8381 420206 : if ((SymbolTable_IsConstString (Actual)) && ((SymbolTable_GetStringLength (tokpos, Actual)) == 1)) /* if = 1 then it maybe treated as a char */
8382 : {
8383 5378 : ActualType = M2Base_Char;
8384 : }
8385 414828 : else if (Actual == M2Base_Boolean)
8386 : {
8387 : /* avoid dangling else. */
8388 : ActualType = Actual;
8389 : }
8390 : else
8391 : {
8392 : /* avoid dangling else. */
8393 414828 : ActualType = SymbolTable_GetDType (Actual);
8394 : }
8395 420200 : if (TypeList == NULL)
8396 : {
8397 420200 : NewList = true;
8398 420200 : Lists_InitList (&TypeList);
8399 : }
8400 : else
8401 : {
8402 : NewList = false;
8403 : }
8404 420200 : if (Lists_IsItemInList (TypeList, ActualType))
8405 : {
8406 : /* no need to check */
8407 : return;
8408 : }
8409 420200 : Lists_IncludeItemIntoList (TypeList, ActualType);
8410 420200 : if (SymbolTable_IsProcType (FormalType))
8411 : {
8412 48462 : if ((! (SymbolTable_IsProcedure (Actual))) && ((ActualType == SymbolTable_NulSym) || (! (SymbolTable_IsProcType (SymbolTable_SkipType (ActualType))))))
8413 : {
8414 0 : FailParameter (tokpos, (const char *) "expecting a procedure or procedure variable as a parameter", 58, Actual, ProcSym, i);
8415 0 : return;
8416 : }
8417 48462 : if ((SymbolTable_IsProcedure (Actual)) && (SymbolTable_IsProcedureNested (Actual)))
8418 : {
8419 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);
8420 : }
8421 : /* we can check the return type of both proc types */
8422 48462 : if ((ActualType != SymbolTable_NulSym) && (SymbolTable_IsProcType (ActualType)))
8423 : {
8424 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
8425 592 : if (((SymbolTable_GetSType (ActualType)) != SymbolTable_NulSym) && ((SymbolTable_GetSType (FormalType)) == SymbolTable_NulSym))
8426 : {
8427 0 : FailParameter (tokpos, (const char *) "the item being passed is a function whereas the formal procedure parameter is a procedure", 89, Actual, ProcSym, i);
8428 0 : return;
8429 : }
8430 592 : else if (((SymbolTable_GetSType (ActualType)) == SymbolTable_NulSym) && ((SymbolTable_GetSType (FormalType)) != SymbolTable_NulSym))
8431 : {
8432 : /* avoid dangling else. */
8433 0 : FailParameter (tokpos, (const char *) "the item being passed is a procedure whereas the formal procedure parameter is a function", 89, Actual, ProcSym, i);
8434 0 : return;
8435 : }
8436 592 : else if (M2Base_AssignmentRequiresWarning (SymbolTable_GetSType (ActualType), SymbolTable_GetSType (FormalType)))
8437 : {
8438 : /* avoid dangling else. */
8439 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);
8440 0 : return;
8441 : }
8442 592 : else if (((M2System_IsGenericSystemType (SymbolTable_GetSType (FormalType))) || (M2System_IsGenericSystemType (SymbolTable_GetSType (ActualType)))) || (M2Base_IsAssignmentCompatible (SymbolTable_GetSType (ActualType), SymbolTable_GetSType (FormalType))))
8443 : {
8444 : /* avoid dangling else. */
8445 : }
8446 : else
8447 : {
8448 : /* avoid dangling else. */
8449 : /* pass */
8450 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);
8451 0 : return;
8452 : }
8453 : }
8454 : /* now to check each parameter of the proc type */
8455 48462 : CheckProcTypeAndProcedure (tokpos, FormalType, Actual, ParamCheckId);
8456 : }
8457 371738 : else if ((ActualType != FormalType) && (ActualType != SymbolTable_NulSym))
8458 : {
8459 : /* avoid dangling else. */
8460 17744 : if (SymbolTable_IsUnknown (FormalType))
8461 : {
8462 : /* Spellcheck. */
8463 0 : FailParameter (tokpos, (const char *) "procedure parameter type is undeclared {%1&s}", 45, Actual, ProcSym, i);
8464 0 : return;
8465 : }
8466 17744 : if ((SymbolTable_IsUnbounded (ActualType)) && (! (SymbolTable_IsUnboundedParamAny (ProcSym, i))))
8467 : {
8468 0 : FailParameter (tokpos, (const char *) "attempting to pass an unbounded array to a NON unbounded parameter", 66, Actual, ProcSym, i);
8469 0 : return;
8470 : }
8471 17744 : else if (SymbolTable_IsUnboundedParamAny (ProcSym, i))
8472 : {
8473 : /* avoid dangling else. */
8474 9797 : if (! (LegalUnboundedParam (tokpos, ProcSym, i, ActualType, Actual, Dimension, Formal)))
8475 : {
8476 : return;
8477 : }
8478 : }
8479 7947 : else if (ActualType != FormalType)
8480 : {
8481 : /* avoid dangling else. */
8482 7947 : if (M2Base_AssignmentRequiresWarning (FormalType, ActualType))
8483 : {
8484 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);
8485 : }
8486 7947 : else if (((M2System_IsGenericSystemType (FormalType)) || (M2System_IsGenericSystemType (ActualType))) || (M2Base_IsAssignmentCompatible (ActualType, FormalType)))
8487 : {
8488 : /* avoid dangling else. */
8489 : }
8490 : else
8491 : {
8492 : /* avoid dangling else. */
8493 : /* so far we know it is legal, but not all types have been resolved
8494 : and so this is checked later on in another pass. */
8495 24 : FailParameter (tokpos, (const char *) "identifier with an incompatible type is being passed to this procedure", 70, Actual, ProcSym, i);
8496 : }
8497 : }
8498 : }
8499 420182 : if (NewList)
8500 : {
8501 420182 : Lists_KillList (&TypeList);
8502 : }
8503 : }
8504 :
8505 :
8506 : /*
8507 : DescribeType - returns a String describing a symbol, Sym, name and its type.
8508 : */
8509 :
8510 0 : static DynamicStrings_String DescribeType (unsigned int Sym)
8511 : {
8512 0 : DynamicStrings_String s;
8513 0 : DynamicStrings_String s1;
8514 0 : DynamicStrings_String s2;
8515 0 : unsigned int Low;
8516 0 : unsigned int High;
8517 0 : unsigned int Subrange;
8518 0 : unsigned int Subscript;
8519 0 : unsigned int Type;
8520 :
8521 0 : s = static_cast<DynamicStrings_String> (NULL);
8522 0 : if (SymbolTable_IsConstString (Sym))
8523 : {
8524 : /* If = 1 then it maybe treated as a char. */
8525 0 : if ((SymbolTable_IsConstStringKnown (Sym)) && ((SymbolTable_GetStringLength (SymbolTable_GetDeclaredMod (Sym), Sym)) == 1))
8526 : {
8527 0 : s = DynamicStrings_InitString ((const char *) "(constant string) or {%kCHAR}", 29);
8528 : }
8529 : else
8530 : {
8531 0 : s = DynamicStrings_InitString ((const char *) "(constant string)", 17);
8532 : }
8533 : }
8534 0 : else if (SymbolTable_IsConst (Sym))
8535 : {
8536 : /* avoid dangling else. */
8537 0 : s = DynamicStrings_InitString ((const char *) "(constant)", 10);
8538 : }
8539 0 : else if (SymbolTable_IsUnknown (Sym))
8540 : {
8541 : /* avoid dangling else. */
8542 0 : s = DynamicStrings_InitString ((const char *) "(unknown)", 9);
8543 : }
8544 : else
8545 : {
8546 : /* avoid dangling else. */
8547 0 : Type = SymbolTable_GetSType (Sym);
8548 0 : if (Type == SymbolTable_NulSym)
8549 : {
8550 0 : s = DynamicStrings_InitString ((const char *) "(unknown)", 9);
8551 : }
8552 0 : else if (SymbolTable_IsUnbounded (Type))
8553 : {
8554 : /* avoid dangling else. */
8555 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (SymbolTable_GetSType (Type)))));
8556 0 : s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{%%kARRAY} {%%kOF} %s", 21)), (const unsigned char *) &s1, (sizeof (s1)-1));
8557 : }
8558 0 : else if (SymbolTable_IsArray (Type))
8559 : {
8560 : /* avoid dangling else. */
8561 0 : s = DynamicStrings_InitString ((const char *) "{%kARRAY} [", 11);
8562 0 : Subscript = SymbolTable_GetArraySubscript (Type);
8563 0 : if (Subscript != SymbolTable_NulSym)
8564 : {
8565 0 : M2Debug_Assert (SymbolTable_IsSubscript (Subscript));
8566 0 : Subrange = SymbolTable_GetSType (Subscript);
8567 0 : if (! (SymbolTable_IsSubrange (Subrange)))
8568 : {
8569 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);
8570 : }
8571 0 : M2Debug_Assert (SymbolTable_IsSubrange (Subrange));
8572 0 : SymbolTable_GetSubrange (Subrange, &High, &Low);
8573 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Low))));
8574 0 : s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (High))));
8575 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))));
8576 : }
8577 0 : s1 = DynamicStrings_Mark (DescribeType (Type));
8578 0 : s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "] OF ", 5))), s1);
8579 : }
8580 : else
8581 : {
8582 : /* avoid dangling else. */
8583 0 : if (SymbolTable_IsUnknown (Type))
8584 : {
8585 : /* Spellcheck. */
8586 0 : s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Type))));
8587 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));
8588 : }
8589 : else
8590 : {
8591 0 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Type)));
8592 : }
8593 : }
8594 : }
8595 0 : return s;
8596 : /* static analysis guarentees a RETURN statement will be used before here. */
8597 : __builtin_unreachable ();
8598 : }
8599 :
8600 :
8601 : /*
8602 : FailParameter - generates an error message indicating that a parameter
8603 : declaration has failed.
8604 :
8605 : The parameters are:
8606 :
8607 : CurrentState - string describing the current failing state.
8608 : Actual - actual parameter.
8609 : ParameterNo - parameter number that has failed.
8610 : ProcedureSym - procedure symbol where parameter has failed.
8611 :
8612 : If any parameter is Nul then it is ignored.
8613 : */
8614 :
8615 42 : static void FailParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo)
8616 : {
8617 42 : unsigned int FormalParam;
8618 42 : DynamicStrings_String Msg;
8619 42 : char CurrentState[_CurrentState_high+1];
8620 :
8621 : /* make a local copy of each unbounded array. */
8622 42 : memcpy (CurrentState, CurrentState_, _CurrentState_high+1);
8623 :
8624 84 : Msg = DynamicStrings_InitString ((const char *) "parameter mismatch between the {%2N} parameter of procedure {%1Ead}, ", 69);
8625 42 : Msg = DynamicStrings_ConCat (Msg, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) CurrentState, _CurrentState_high)));
8626 42 : M2MetaError_MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo);
8627 42 : if ((SymbolTable_NoOfParamAny (ProcedureSym)) >= ParameterNo)
8628 : {
8629 42 : FormalParam = SymbolTable_GetNthParamAnyClosest (ProcedureSym, ParameterNo, SymbolTable_GetCurrentModule ());
8630 42 : if (SymbolTable_IsUnboundedParamAny (ProcedureSym, ParameterNo))
8631 : {
8632 18 : M2MetaError_MetaErrorT2 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "formal parameter {%1ad} has an open array type {%2tad}", 54, FormalParam, SymbolTable_GetSType (SymbolTable_GetSType (FormalParam)));
8633 : }
8634 : else
8635 : {
8636 24 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "formal parameter {%1ad} has type {%1tad}", 40, FormalParam);
8637 : }
8638 : }
8639 : else
8640 : {
8641 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetDeclaredMod (ProcedureSym), (const char *) "procedure declaration", 21, ProcedureSym);
8642 : }
8643 42 : if ((SymbolTable_GetLType (Actual)) == SymbolTable_NulSym)
8644 : {
8645 0 : M2MetaError_MetaError1 ((const char *) "actual parameter being passed is {%1Eda} {%1ad}", 47, Actual);
8646 : }
8647 : else
8648 : {
8649 42 : if (SymbolTable_IsVar (Actual))
8650 : {
8651 36 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (Actual), (const char *) "actual parameter variable being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}", 87, Actual);
8652 : }
8653 : else
8654 : {
8655 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "actual parameter being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}", 78, Actual);
8656 : }
8657 : }
8658 42 : }
8659 :
8660 :
8661 : /*
8662 : WarnParameter - generates a warning message indicating that a parameter
8663 : use might cause problems on another target.
8664 :
8665 : CurrentState - string describing the current failing state.
8666 : Actual - actual parameter.
8667 : ParameterNo - parameter number that has failed.
8668 : ProcedureSym - procedure symbol where parameter has failed.
8669 :
8670 : If any parameter is Nul then it is ignored.
8671 : */
8672 :
8673 0 : static void WarnParameter (unsigned int tokpos, const char *CurrentState_, unsigned int _CurrentState_high, unsigned int Actual, unsigned int ProcedureSym, unsigned int ParameterNo)
8674 : {
8675 0 : unsigned int FormalParam;
8676 0 : DynamicStrings_String Msg;
8677 0 : char CurrentState[_CurrentState_high+1];
8678 :
8679 : /* make a local copy of each unbounded array. */
8680 0 : memcpy (CurrentState, CurrentState_, _CurrentState_high+1);
8681 :
8682 0 : Msg = DynamicStrings_InitString ((const char *) "{%W}parameter mismatch between the {%2N} parameter of procedure {%1ad}, ", 72);
8683 0 : Msg = DynamicStrings_ConCat (Msg, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) CurrentState, _CurrentState_high)));
8684 0 : M2MetaError_MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo);
8685 0 : if ((SymbolTable_NoOfParamAny (ProcedureSym)) >= ParameterNo)
8686 : {
8687 0 : FormalParam = SymbolTable_GetNthParamAnyClosest (ProcedureSym, ParameterNo, SymbolTable_GetCurrentModule ());
8688 0 : if (SymbolTable_IsUnboundedParamAny (ProcedureSym, ParameterNo))
8689 : {
8690 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)));
8691 : }
8692 : else
8693 : {
8694 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (FormalParam), (const char *) "{%W}formal parameter {%1ad} has type {%1tad}", 44, FormalParam);
8695 : }
8696 : }
8697 : else
8698 : {
8699 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetDeclaredMod (ProcedureSym), (const char *) "{%W}procedure declaration", 25, ProcedureSym);
8700 : }
8701 0 : if ((SymbolTable_GetLType (Actual)) == SymbolTable_NulSym)
8702 : {
8703 0 : M2MetaError_MetaError1 ((const char *) "actual parameter being passed is {%1Wda} {%1ad}", 47, Actual);
8704 : }
8705 : else
8706 : {
8707 0 : if (SymbolTable_IsVar (Actual))
8708 : {
8709 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetVarDeclFullTok (Actual), (const char *) "actual parameter variable being passed is {%1Wda} {%1ad} of type {%1ts}", 71, Actual);
8710 : }
8711 : else
8712 : {
8713 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "actual parameter being passed is {%1Wda} {%1ad} of type {%1ts}", 62, Actual);
8714 : }
8715 : }
8716 0 : }
8717 :
8718 :
8719 : /*
8720 : doIndrX - perform des = *exp with a conversion if necessary.
8721 : */
8722 :
8723 16799 : static void doIndrX (unsigned int tok, unsigned int des, unsigned int exp)
8724 : {
8725 16799 : unsigned int t;
8726 :
8727 16799 : if ((SymbolTable_GetDType (des)) == (SymbolTable_GetDType (exp)))
8728 : {
8729 16281 : GenQuadOtok (tok, M2Quads_IndrXOp, des, SymbolTable_GetSType (des), exp, true, tok, tok, tok);
8730 : }
8731 : else
8732 : {
8733 518 : if (M2Options_StrictTypeAssignment)
8734 : {
8735 518 : BuildRange (M2Range_InitTypesIndrXCheck (tok, des, exp));
8736 : }
8737 518 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8738 518 : SymbolTable_PutVar (t, SymbolTable_GetSType (exp));
8739 518 : GenQuadOtok (tok, M2Quads_IndrXOp, t, SymbolTable_GetSType (exp), exp, true, tok, tok, tok);
8740 518 : GenQuadOtok (tok, M2Quads_BecomesOp, des, SymbolTable_NulSym, doVal (SymbolTable_GetSType (des), t), true, tok, M2LexBuf_UnknownTokenNo, tok);
8741 : }
8742 16799 : }
8743 :
8744 :
8745 : /*
8746 : MakeRightValue - returns a temporary which will have the RightValue of symbol, Sym.
8747 : If Sym is a right value and has type, type, then no quadruples are
8748 : generated and Sym is returned. Otherwise a new temporary is created
8749 : and an IndrX quadruple is generated.
8750 : */
8751 :
8752 1515 : static unsigned int MakeRightValue (unsigned int tok, unsigned int Sym, unsigned int type)
8753 : {
8754 1515 : unsigned int t;
8755 :
8756 1515 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_RightValue)
8757 : {
8758 0 : if ((SymbolTable_GetSType (Sym)) == type)
8759 : {
8760 : return Sym;
8761 : }
8762 : else
8763 : {
8764 : /*
8765 : type change or mode change, type changes are a pain, but I've
8766 : left them here as it is perhaps easier to remove them later.
8767 : */
8768 0 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8769 0 : SymbolTable_PutVar (t, type);
8770 0 : GenQuadOtok (tok, M2Quads_BecomesOp, t, SymbolTable_NulSym, doVal (type, Sym), true, tok, tok, tok);
8771 0 : return t;
8772 : }
8773 : }
8774 : else
8775 : {
8776 1515 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
8777 1515 : SymbolTable_PutVar (t, type);
8778 1515 : CheckPointerThroughNil (tok, Sym);
8779 1515 : doIndrX (tok, t, Sym);
8780 1515 : return t;
8781 : }
8782 : /* static analysis guarentees a RETURN statement will be used before here. */
8783 : __builtin_unreachable ();
8784 : }
8785 :
8786 :
8787 : /*
8788 : MakeLeftValue - returns a temporary coresponding to the LeftValue of
8789 : symbol, Sym. No quadruple is generated if Sym is already
8790 : a LeftValue and has the same type.
8791 : */
8792 :
8793 196032 : static unsigned int MakeLeftValue (unsigned int tok, unsigned int Sym, SymbolTable_ModeOfAddr with, unsigned int type)
8794 : {
8795 196032 : unsigned int t;
8796 :
8797 196032 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
8798 : {
8799 5181 : if ((SymbolTable_GetSType (Sym)) == type)
8800 : {
8801 : return Sym;
8802 : }
8803 : else
8804 : {
8805 : /*
8806 : type change or mode change, type changes are a pain, but I've
8807 : left them here as it is perhaps easier to remove them later
8808 : */
8809 172 : t = SymbolTable_MakeTemporary (tok, with);
8810 172 : SymbolTable_PutVar (t, type);
8811 172 : GenQuadOtok (tok, M2Quads_BecomesOp, t, SymbolTable_NulSym, Sym, true, tok, M2LexBuf_UnknownTokenNo, tok);
8812 172 : return t;
8813 : }
8814 : }
8815 : else
8816 : {
8817 190851 : t = SymbolTable_MakeTemporary (tok, with);
8818 190851 : SymbolTable_PutVar (t, type);
8819 190851 : GenQuadOtok (tok, M2Quads_AddrOp, t, SymbolTable_NulSym, Sym, true, tok, M2LexBuf_UnknownTokenNo, tok);
8820 190851 : return t;
8821 : }
8822 : /* static analysis guarentees a RETURN statement will be used before here. */
8823 : __builtin_unreachable ();
8824 : }
8825 :
8826 :
8827 : /*
8828 : ManipulatePseudoCallParameters - manipulates the parameters to a pseudo function or
8829 : procedure. It dereferences all LeftValue parameters
8830 : and Boolean parameters.
8831 : The Stack:
8832 :
8833 :
8834 : Entry Exit
8835 :
8836 : Ptr -> exactly the same
8837 : +----------------+
8838 : | NoOfParameters |
8839 : |----------------|
8840 : | Param 1 |
8841 : |----------------|
8842 : | Param 2 |
8843 : |----------------|
8844 : . .
8845 : . .
8846 : . .
8847 : |----------------|
8848 : | Param # |
8849 : |----------------|
8850 : | ProcSym | Type |
8851 : |----------------|
8852 :
8853 : */
8854 :
8855 66462 : static void ManipulatePseudoCallParameters (void)
8856 : {
8857 66462 : unsigned int NoOfParameters;
8858 66462 : unsigned int ProcSym;
8859 66462 : unsigned int Proc;
8860 66462 : unsigned int i;
8861 66462 : unsigned int pi;
8862 66462 : M2Quads_BoolFrame f;
8863 :
8864 66462 : M2Quads_PopT (&NoOfParameters);
8865 66462 : M2Quads_PushT (NoOfParameters); /* restored to original state */
8866 : /* Ptr points to the ProcSym */
8867 66462 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((NoOfParameters+1)+1));
8868 66462 : if (SymbolTable_IsVar (ProcSym))
8869 : {
8870 0 : M2Error_InternalError ((const char *) "expecting a pseudo procedure or a type", 38);
8871 : }
8872 : else
8873 : {
8874 66462 : Proc = ProcSym;
8875 : }
8876 66462 : i = 1;
8877 66462 : pi = NoOfParameters+1;
8878 145744 : while (i <= NoOfParameters)
8879 : {
8880 79282 : 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)))
8881 : {
8882 : /* must dereference LeftValue */
8883 1344 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pi));
8884 1344 : f->TrueExit = MakeRightValue (M2LexBuf_GetTokenNo (), M2Quads_OperandT (pi), SymbolTable_GetSType (M2Quads_OperandT (pi)));
8885 : }
8886 79282 : i += 1;
8887 79282 : pi -= 1;
8888 : }
8889 66462 : }
8890 :
8891 :
8892 : /*
8893 : ManipulateParameters - manipulates the procedure parameters in
8894 : preparation for a procedure call.
8895 : Prepares Boolean, Unbounded and VAR parameters.
8896 : The Stack:
8897 :
8898 :
8899 : Entry Exit
8900 :
8901 : Ptr -> exactly the same
8902 : +----------------+
8903 : | NoOfParameters |
8904 : |----------------|
8905 : | Param 1 |
8906 : |----------------|
8907 : | Param 2 |
8908 : |----------------|
8909 : . .
8910 : . .
8911 : . .
8912 : |----------------|
8913 : | Param # |
8914 : |----------------|
8915 : | ProcSym | Type |
8916 : |----------------|
8917 : */
8918 :
8919 218988 : static void ManipulateParameters (bool IsForC)
8920 : {
8921 218988 : unsigned int tokpos;
8922 218988 : unsigned int np;
8923 218988 : DynamicStrings_String s;
8924 218988 : unsigned int ArraySym;
8925 218988 : unsigned int UnboundedType;
8926 218988 : unsigned int ParamType;
8927 218988 : unsigned int NoOfParameters;
8928 218988 : unsigned int i;
8929 218988 : unsigned int pi;
8930 218988 : unsigned int ProcSym;
8931 218988 : unsigned int rw;
8932 218988 : unsigned int Proc;
8933 218988 : unsigned int t;
8934 218988 : M2Quads_BoolFrame f;
8935 :
8936 218988 : M2Quads_PopT (&NoOfParameters);
8937 218988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParameters+1));
8938 218988 : tokpos = OperandTtok (NoOfParameters+1);
8939 218988 : if (SymbolTable_IsVar (ProcSym))
8940 : {
8941 : /* Procedure Variable ? */
8942 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF (NoOfParameters+1));
8943 : }
8944 : else
8945 : {
8946 218216 : Proc = PCSymBuild_SkipConst (ProcSym);
8947 : }
8948 218988 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8949 : {
8950 : /* avoid dangling else. */
8951 9791 : if (NoOfParameters < (SymbolTable_NoOfParamAny (Proc)))
8952 : {
8953 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8954 0 : np = SymbolTable_NoOfParamAny (Proc);
8955 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));
8956 : }
8957 : }
8958 209197 : else if (SymbolTable_UsesOptArgAny (Proc))
8959 : {
8960 : /* avoid dangling else. */
8961 3673 : if (! ((NoOfParameters == (SymbolTable_NoOfParamAny (Proc))) || ((NoOfParameters+1) == (SymbolTable_NoOfParamAny (Proc)))))
8962 : {
8963 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8964 0 : np = SymbolTable_NoOfParamAny (Proc);
8965 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));
8966 : }
8967 : }
8968 205524 : else if (NoOfParameters != (SymbolTable_NoOfParamAny (Proc)))
8969 : {
8970 : /* avoid dangling else. */
8971 0 : s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (Proc))));
8972 0 : np = SymbolTable_NoOfParamAny (Proc);
8973 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));
8974 : }
8975 218988 : i = 1;
8976 218988 : pi = NoOfParameters;
8977 762011 : while (i <= NoOfParameters)
8978 : {
8979 543023 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pi));
8980 543023 : rw = static_cast<unsigned int> (OperandMergeRW (pi));
8981 543023 : M2Debug_Assert (SymbolTable_IsLegal (rw));
8982 543023 : if (i > (SymbolTable_NoOfParamAny (Proc)))
8983 : {
8984 8473 : if (IsForC && (SymbolTable_UsesVarArgs (Proc)))
8985 : {
8986 : /* avoid dangling else. */
8987 8473 : if (((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym) && (SymbolTable_IsArray (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
8988 : {
8989 156 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_RightValue, M2System_Address);
8990 156 : MarkAsReadWrite (rw);
8991 : }
8992 8317 : else if (SymbolTable_IsConstString (M2Quads_OperandT (pi)))
8993 : {
8994 : /* avoid dangling else. */
8995 283 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), DeferMakeConstStringCnul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi)), SymbolTable_RightValue, M2System_Address);
8996 283 : MarkAsReadWrite (rw);
8997 : }
8998 8034 : else if (((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (M2Quads_OperandT (pi)))))
8999 : {
9000 : /* avoid dangling else. */
9001 200 : MarkAsReadWrite (rw);
9002 : /* pass the address field of an unbounded variable */
9003 200 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, M2Quads_OperandTok (pi));
9004 200 : PushTFAD (f->TrueExit, f->FalseExit, f->Unbounded, f->Dimension);
9005 200 : M2Quads_PushT (static_cast<unsigned int> (1));
9006 200 : BuildAdrFunction ();
9007 200 : M2Quads_PopT (&f->TrueExit);
9008 : }
9009 7834 : else if ((SymbolTable_GetMode (M2Quads_OperandT (pi))) == SymbolTable_LeftValue)
9010 : {
9011 : /* avoid dangling else. */
9012 506 : MarkAsReadWrite (rw);
9013 : /* must dereference LeftValue (even if we are passing variable as a vararg) */
9014 506 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9015 506 : SymbolTable_PutVar (t, SymbolTable_GetSType (M2Quads_OperandT (pi)));
9016 506 : CheckPointerThroughNil (tokpos, M2Quads_OperandT (pi));
9017 506 : doIndrX (M2Quads_OperandTok (pi), t, M2Quads_OperandT (pi));
9018 506 : f->TrueExit = t;
9019 : }
9020 : }
9021 : else
9022 : {
9023 0 : M2MetaError_MetaErrorT2 (tokpos, (const char *) "attempting to pass too many parameters to procedure {%1a}, the {%2N} parameter does not exist", 93, Proc, i);
9024 : }
9025 : }
9026 534550 : else if (((IsForC && (SymbolTable_IsUnboundedParamAny (Proc, i))) && ((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym)) && (SymbolTable_IsArray (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
9027 : {
9028 : /* avoid dangling else. */
9029 24 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_RightValue, M2System_Address);
9030 24 : MarkAsReadWrite (rw);
9031 : }
9032 534526 : else if (((IsForC && (SymbolTable_IsUnboundedParamAny (Proc, i))) && ((SymbolTable_GetSType (M2Quads_OperandT (pi))) != SymbolTable_NulSym)) && (SymbolTable_IsUnbounded (SymbolTable_GetDType (M2Quads_OperandT (pi)))))
9033 : {
9034 : /* avoid dangling else. */
9035 184 : MarkAsReadWrite (rw);
9036 : /* pass the address field of an unbounded variable */
9037 184 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, M2Quads_OperandTok (pi));
9038 184 : PushTFAD (f->TrueExit, f->FalseExit, f->Unbounded, f->Dimension);
9039 184 : M2Quads_PushT (static_cast<unsigned int> (1));
9040 184 : BuildAdrFunction ();
9041 184 : M2Quads_PopT (&f->TrueExit);
9042 : }
9043 534342 : else if ((IsForC && (SymbolTable_IsConstString (M2Quads_OperandT (pi)))) && ((SymbolTable_IsUnboundedParamAny (Proc, i)) || ((SymbolTable_GetDType (SymbolTable_GetParam (Proc, i))) == M2System_Address)))
9044 : {
9045 : /* avoid dangling else. */
9046 9479 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), DeferMakeConstStringCnul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi)), SymbolTable_RightValue, M2System_Address);
9047 9479 : MarkAsReadWrite (rw);
9048 : }
9049 524863 : else if (SymbolTable_IsUnboundedParamAny (Proc, i))
9050 : {
9051 : /* avoid dangling else. */
9052 : /* always pass constant strings with a nul terminator, but leave the HIGH as before. */
9053 40323 : if (SymbolTable_IsConstString (M2Quads_OperandT (pi)))
9054 : {
9055 : /* this is a Modula-2 string which must be nul terminated. */
9056 26373 : f->TrueExit = DeferMakeConstStringM2nul (M2Quads_OperandTok (pi), M2Quads_OperandT (pi));
9057 : }
9058 40323 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9059 40323 : UnboundedType = SymbolTable_GetSType (SymbolTable_GetParam (Proc, i));
9060 40323 : SymbolTable_PutVar (t, UnboundedType);
9061 40323 : ParamType = SymbolTable_GetSType (UnboundedType);
9062 40323 : if ((OperandD (pi)) == 0)
9063 : {
9064 40275 : ArraySym = static_cast<unsigned int> (M2Quads_OperandT (pi));
9065 : }
9066 : else
9067 : {
9068 48 : ArraySym = static_cast<unsigned int> (M2Quads_OperandA (pi));
9069 : }
9070 40323 : if (SymbolTable_IsVarParamAny (Proc, i))
9071 : {
9072 4383 : MarkArrayWritten (M2Quads_OperandT (pi));
9073 4383 : MarkArrayWritten (M2Quads_OperandA (pi));
9074 4383 : MarkAsReadWrite (rw);
9075 4383 : AssignUnboundedVar (OperandTtok (pi), M2Quads_OperandT (pi), ArraySym, t, ParamType, OperandD (pi));
9076 : }
9077 : else
9078 : {
9079 35940 : MarkAsRead (rw);
9080 35940 : AssignUnboundedNonVar (OperandTtok (pi), M2Quads_OperandT (pi), ArraySym, t, ParamType, OperandD (pi));
9081 : }
9082 40323 : f->TrueExit = t;
9083 : }
9084 484540 : else if (SymbolTable_IsVarParamAny (Proc, i))
9085 : {
9086 : /* avoid dangling else. */
9087 : /* must reference by address, but we contain the type of the referenced entity */
9088 15823 : MarkArrayWritten (M2Quads_OperandT (pi));
9089 15823 : MarkArrayWritten (M2Quads_OperandA (pi));
9090 15823 : MarkAsReadWrite (rw);
9091 15823 : f->TrueExit = MakeLeftValue (M2Quads_OperandTok (pi), M2Quads_OperandT (pi), SymbolTable_LeftValue, SymbolTable_GetSType (SymbolTable_GetParam (Proc, i)));
9092 : }
9093 468717 : else if ((! (SymbolTable_IsVarParamAny (Proc, i))) && ((SymbolTable_GetMode (M2Quads_OperandT (pi))) == SymbolTable_LeftValue))
9094 : {
9095 : /* avoid dangling else. */
9096 : /* must dereference LeftValue */
9097 1504 : t = SymbolTable_MakeTemporary (M2Quads_OperandTok (pi), SymbolTable_RightValue);
9098 1504 : SymbolTable_PutVar (t, SymbolTable_GetSType (M2Quads_OperandT (pi)));
9099 1504 : CheckPointerThroughNil (tokpos, M2Quads_OperandT (pi));
9100 1504 : doIndrX (M2Quads_OperandTok (pi), t, M2Quads_OperandT (pi));
9101 1504 : f->TrueExit = t;
9102 1504 : MarkAsRead (rw);
9103 : }
9104 : else
9105 : {
9106 : /* avoid dangling else. */
9107 467213 : MarkAsRead (rw);
9108 : }
9109 543023 : i += 1;
9110 543023 : pi -= 1;
9111 : }
9112 218988 : M2Quads_PushT (NoOfParameters);
9113 218988 : }
9114 :
9115 :
9116 : /*
9117 : CheckParameterOrdinals - check that ordinal values are within type range.
9118 : */
9119 :
9120 218988 : static void CheckParameterOrdinals (void)
9121 : {
9122 218988 : unsigned int tokno;
9123 218988 : unsigned int Proc;
9124 218988 : unsigned int ProcSym;
9125 218988 : unsigned int Actual;
9126 218988 : unsigned int FormalI;
9127 218988 : unsigned int ParamTotal;
9128 218988 : unsigned int pi;
9129 218988 : unsigned int i;
9130 :
9131 218988 : M2Quads_PopT (&ParamTotal);
9132 218988 : M2Quads_PushT (ParamTotal); /* Restore stack to origional state */
9133 218988 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT ((ParamTotal+1)+1)); /* Restore stack to origional state */
9134 218988 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (SymbolTable_GetDType (ProcSym))))
9135 : {
9136 : /* Indirect procedure call. */
9137 772 : Proc = SymbolTable_SkipType (M2Quads_OperandF ((ParamTotal+1)+1));
9138 : }
9139 : else
9140 : {
9141 218216 : Proc = PCSymBuild_SkipConst (ProcSym);
9142 : }
9143 218988 : i = 1;
9144 218988 : pi = ParamTotal+1; /* stack index referencing stacked parameter, i */
9145 762011 : while (i <= ParamTotal) /* stack index referencing stacked parameter, i */
9146 : {
9147 543023 : if (i <= (SymbolTable_NoOfParamAny (Proc)))
9148 : {
9149 534550 : FormalI = SymbolTable_GetParam (Proc, i);
9150 534550 : Actual = static_cast<unsigned int> (M2Quads_OperandT (pi));
9151 534550 : tokno = static_cast<unsigned int> (M2Quads_OperandTok (pi));
9152 534550 : if (M2Base_IsOrdinalType (SymbolTable_GetLType (FormalI)))
9153 : {
9154 140251 : if (! (SymbolTable_IsSet (SymbolTable_GetDType (FormalI))))
9155 : {
9156 : /* Tell the code generator to test the runtime values of the assignment
9157 : so ensure we catch overflow and underflow. */
9158 140251 : BuildRange (M2Range_InitParameterRangeCheck (tokno, Proc, i, FormalI, Actual, OperandRangeDep (pi)));
9159 : }
9160 : }
9161 : }
9162 543023 : i += 1;
9163 543023 : pi -= 1;
9164 : }
9165 218988 : }
9166 :
9167 :
9168 : /*
9169 : IsSameUnbounded - returns TRUE if unbounded types, t1, and, t2,
9170 : are compatible.
9171 : */
9172 :
9173 36 : static bool IsSameUnbounded (unsigned int t1, unsigned int t2)
9174 : {
9175 36 : M2Debug_Assert (SymbolTable_IsUnbounded (t1));
9176 36 : M2Debug_Assert (SymbolTable_IsUnbounded (t2));
9177 36 : return (SymbolTable_GetDType (t1)) == (SymbolTable_GetDType (t2));
9178 : /* static analysis guarentees a RETURN statement will be used before here. */
9179 : __builtin_unreachable ();
9180 : }
9181 :
9182 :
9183 : /*
9184 : AssignUnboundedVar - assigns an Unbounded symbol fields,
9185 : ArrayAddress and ArrayHigh, from an array symbol.
9186 : UnboundedSym is not a VAR parameter and therefore
9187 : this procedure can complete both of the fields.
9188 : Sym can be a Variable with type Unbounded.
9189 : Sym can be a Variable with type Array.
9190 : Sym can be a String Constant.
9191 :
9192 : ParamType is the TYPE of the parameter
9193 : */
9194 :
9195 4383 : static void AssignUnboundedVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9196 : {
9197 4383 : unsigned int Type;
9198 :
9199 4383 : if (SymbolTable_IsConst (Sym))
9200 : {
9201 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9202 : }
9203 4383 : else if (SymbolTable_IsVar (Sym))
9204 : {
9205 : /* avoid dangling else. */
9206 4383 : Type = SymbolTable_GetDType (Sym);
9207 4383 : if (Type == SymbolTable_NulSym)
9208 : {
9209 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} has no type and cannot be passed to a VAR formal parameter", 65, Sym);
9210 : }
9211 4383 : else if (SymbolTable_IsUnbounded (Type))
9212 : {
9213 : /* avoid dangling else. */
9214 1462 : if (Type == (SymbolTable_GetSType (UnboundedSym)))
9215 : {
9216 : /* Copy Unbounded Symbol ie. UnboundedSym := Sym */
9217 1426 : M2Quads_PushT (UnboundedSym);
9218 1426 : M2Quads_PushT (Sym);
9219 1426 : BuildAssignmentWithoutBounds (tok, false, true);
9220 : }
9221 36 : else if ((IsSameUnbounded (Type, SymbolTable_GetSType (UnboundedSym))) || (M2System_IsGenericSystemType (ParamType)))
9222 : {
9223 : /* avoid dangling else. */
9224 36 : UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9225 : }
9226 : else
9227 : {
9228 : /* avoid dangling else. */
9229 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9230 : }
9231 : }
9232 2921 : else if ((SymbolTable_IsArray (Type)) || (M2System_IsGenericSystemType (ParamType)))
9233 : {
9234 : /* avoid dangling else. */
9235 2921 : UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9236 : }
9237 : else
9238 : {
9239 : /* avoid dangling else. */
9240 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9241 : }
9242 : }
9243 : else
9244 : {
9245 : /* avoid dangling else. */
9246 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} cannot be passed to a VAR formal parameter", 49, Sym);
9247 : }
9248 4383 : }
9249 :
9250 :
9251 : /*
9252 : AssignUnboundedNonVar - assigns an Unbounded symbol fields,
9253 : The difference between this procedure and
9254 : AssignUnboundedVar is that this procedure cannot
9255 : set the Unbounded.Address since the data from
9256 : Sym will be copied because parameter is NOT a VAR
9257 : parameter.
9258 : UnboundedSym is not a VAR parameter and therefore
9259 : this procedure can only complete the HIGH field
9260 : and not the ADDRESS field.
9261 : Sym can be a Variable with type Unbounded.
9262 : Sym can be a Variable with type Array.
9263 : Sym can be a String Constant.
9264 :
9265 : ParamType is the TYPE of the paramater
9266 : */
9267 :
9268 35940 : static void AssignUnboundedNonVar (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9269 : {
9270 35940 : unsigned int Type;
9271 :
9272 35940 : if (SymbolTable_IsConst (Sym)) /* was IsConstString(Sym) */
9273 : {
9274 26427 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9275 : }
9276 9513 : else if (SymbolTable_IsVar (Sym))
9277 : {
9278 : /* avoid dangling else. */
9279 9513 : Type = SymbolTable_GetDType (Sym);
9280 9513 : if (Type == SymbolTable_NulSym)
9281 : {
9282 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "{%1ad} has no type and cannot be passed to a non VAR formal parameter", 69, Sym);
9283 : }
9284 9513 : else if (SymbolTable_IsUnbounded (Type))
9285 : {
9286 : /* avoid dangling else. */
9287 4781 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9288 : }
9289 4732 : else if ((SymbolTable_IsArray (Type)) || (M2System_IsGenericSystemType (ParamType)))
9290 : {
9291 : /* avoid dangling else. */
9292 4720 : UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9293 : }
9294 : else
9295 : {
9296 : /* avoid dangling else. */
9297 12 : M2MetaError_MetaErrorT1 (tok, (const char *) "illegal type parameter {%1Ead} expecting array or dynamic array", 63, Sym);
9298 : }
9299 : }
9300 : else
9301 : {
9302 : /* avoid dangling else. */
9303 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "illegal parameter {%1Ead} which cannot be passed as {%kVAR} {%kARRAY} {%kOF} {%1tsad}", 85, Sym);
9304 : }
9305 35940 : }
9306 :
9307 :
9308 : /*
9309 : GenHigh - generates a HighOp but it checks if op3 is a
9310 : L value and if so it dereferences it. This
9311 : is inefficient, however it is clean and we let the gcc
9312 : backend detect these as common subexpressions.
9313 : It will also detect that a R value -> L value -> R value
9314 : via indirection and eleminate these.
9315 : */
9316 :
9317 41765 : static void GenHigh (unsigned int tok, unsigned int op1, unsigned int op2, unsigned int op3)
9318 : {
9319 41765 : unsigned int sym;
9320 :
9321 41765 : if (((SymbolTable_GetMode (op3)) == SymbolTable_LeftValue) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (op3))))
9322 : {
9323 48 : sym = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
9324 48 : SymbolTable_PutVar (sym, SymbolTable_GetSType (op3));
9325 48 : doIndrX (tok, sym, op3);
9326 48 : GenQuadO (tok, M2Quads_HighOp, op1, op2, sym, true);
9327 : }
9328 : else
9329 : {
9330 41717 : GenQuadO (tok, M2Quads_HighOp, op1, op2, op3, true);
9331 : }
9332 41765 : }
9333 :
9334 :
9335 : /*
9336 : AssignHighField -
9337 : */
9338 :
9339 39041 : static void AssignHighField (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int actuali, unsigned int formali)
9340 : {
9341 39041 : unsigned int ReturnVar;
9342 39041 : unsigned int ArrayType;
9343 39041 : unsigned int Field;
9344 :
9345 : /* Unbounded.ArrayHigh := HIGH(ArraySym) */
9346 39041 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9347 39041 : Field = SymbolTable_GetUnboundedHighOffset (SymbolTable_GetSType (UnboundedSym), formali);
9348 39041 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9349 39041 : M2Quads_PushT (static_cast<unsigned int> (1));
9350 39041 : M2Quads_BuildDesignatorRecord (tok);
9351 39041 : if (M2System_IsGenericSystemType (ParamType))
9352 : {
9353 2036 : if (SymbolTable_IsConstString (Sym))
9354 : {
9355 18 : M2Quads_PushTtok (DeferMakeLengthConst (tok, Sym), tok);
9356 : }
9357 : else
9358 : {
9359 2018 : ArrayType = SymbolTable_GetSType (Sym);
9360 2018 : if (SymbolTable_IsUnbounded (ArrayType))
9361 : {
9362 : /*
9363 : * SIZE(parameter) DIV TSIZE(ParamType)
9364 : * however in this case parameter
9365 : * is an unbounded symbol and therefore we must use
9366 : * (HIGH(parameter)+1)*SIZE(unbounded type) DIV TSIZE(ParamType)
9367 : *
9368 : * we call upon the function SIZE(ArraySym)
9369 : * remember SIZE doubles as
9370 : * (HIGH(a)+1) * SIZE(ArrayType) for unbounded symbols
9371 : */
9372 1106 : M2Quads_PushTFtok (calculateMultipicand (tok, ArraySym, ArrayType, actuali-1), M2Base_Cardinal, tok);
9373 1106 : M2Quads_PushT (M2Reserved_DivideTok); /* Divide by */
9374 1106 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ParamType) */
9375 1106 : M2Quads_PushTtok (ParamType, tok); /* TSIZE(ParamType) */
9376 1106 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9377 1106 : M2Quads_BuildFunctionCall (false); /* 1 parameter for TSIZE() */
9378 1106 : M2Quads_BuildBinaryOp ();
9379 : }
9380 : else
9381 : {
9382 : /* SIZE(parameter) DIV TSIZE(ParamType) */
9383 912 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ArrayType) */
9384 912 : M2Quads_PushTtok (ArrayType, tok); /* TSIZE(ArrayType) */
9385 912 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9386 912 : M2Quads_BuildFunctionCall (true); /* 1 parameter for TSIZE() */
9387 912 : M2Quads_PushT (M2Reserved_DivideTok); /* Divide by */
9388 912 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, tok); /* TSIZE(ParamType) */
9389 912 : M2Quads_PushTtok (ParamType, tok); /* TSIZE(ParamType) */
9390 912 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for TSIZE() */
9391 912 : M2Quads_BuildFunctionCall (true); /* 1 parameter for TSIZE() */
9392 912 : M2Quads_BuildBinaryOp ();
9393 : }
9394 : /* now convert from no of elements into HIGH by subtracting 1 */
9395 2018 : M2Quads_PushT (M2Reserved_MinusTok); /* -1 */
9396 2018 : M2Quads_PushTtok (SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal), tok); /* -1 */
9397 2018 : M2Quads_BuildBinaryOp ();
9398 : }
9399 : }
9400 : else
9401 : {
9402 37005 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
9403 37005 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
9404 37005 : if (((actuali != formali) && (ArraySym != SymbolTable_NulSym)) && (SymbolTable_IsUnbounded (SymbolTable_GetSType (ArraySym))))
9405 : {
9406 12 : GenHigh (tok, ReturnVar, actuali, ArraySym);
9407 : }
9408 : else
9409 : {
9410 36993 : GenHigh (tok, ReturnVar, formali, Sym);
9411 : }
9412 37005 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), tok);
9413 : }
9414 39041 : BuildAssignmentWithoutBounds (tok, false, true);
9415 39041 : }
9416 :
9417 :
9418 : /*
9419 : AssignHighFields -
9420 : */
9421 :
9422 38885 : static void AssignHighFields (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9423 : {
9424 38885 : unsigned int type;
9425 38885 : unsigned int actuali;
9426 38885 : unsigned int formali;
9427 38885 : unsigned int actualn;
9428 38885 : unsigned int formaln;
9429 :
9430 38885 : type = SymbolTable_GetDType (Sym);
9431 38885 : actualn = 1;
9432 38885 : if ((type != SymbolTable_NulSym) && ((SymbolTable_IsUnbounded (type)) || (SymbolTable_IsArray (type))))
9433 : {
9434 11576 : actualn = SymbolTable_GetDimension (type);
9435 : }
9436 38885 : actuali = dim+1;
9437 38885 : formali = 1;
9438 38885 : formaln = SymbolTable_GetDimension (SymbolTable_GetDType (UnboundedSym));
9439 77926 : while ((actuali < actualn) && (formali < formaln))
9440 : {
9441 156 : AssignHighField (tok, Sym, ArraySym, UnboundedSym, SymbolTable_NulSym, actuali, formali);
9442 156 : actuali += 1;
9443 156 : formali += 1;
9444 : }
9445 38885 : AssignHighField (tok, Sym, ArraySym, UnboundedSym, ParamType, actuali, formali);
9446 38885 : }
9447 :
9448 :
9449 : /*
9450 : UnboundedNonVarLinkToArray - links an array, ArraySym, to an unbounded
9451 : array, UnboundedSym. The parameter is a
9452 : NON VAR variety.
9453 : */
9454 :
9455 35928 : static void UnboundedNonVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9456 : {
9457 35928 : unsigned int Field;
9458 35928 : unsigned int AddressField;
9459 :
9460 : /* Unbounded.ArrayAddress := to be assigned at runtime. */
9461 35928 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9462 35928 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
9463 35928 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9464 35928 : M2Quads_PushT (static_cast<unsigned int> (1));
9465 35928 : M2Quads_BuildDesignatorRecord (tok);
9466 35928 : M2Quads_PopT (&AddressField);
9467 : /* caller saves non var unbounded array contents. */
9468 71856 : GenQuadO (tok, M2Quads_UnboundedOp, AddressField, SymbolTable_NulSym, Sym, false);
9469 35928 : AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9470 35928 : }
9471 :
9472 :
9473 : /*
9474 : UnboundedVarLinkToArray - links an array, ArraySym, to an unbounded array,
9475 : UnboundedSym. The parameter is a VAR variety.
9476 : */
9477 :
9478 2957 : static void UnboundedVarLinkToArray (unsigned int tok, unsigned int Sym, unsigned int ArraySym, unsigned int UnboundedSym, unsigned int ParamType, unsigned int dim)
9479 : {
9480 2957 : unsigned int SymType;
9481 2957 : unsigned int Field;
9482 :
9483 2957 : SymType = SymbolTable_GetSType (Sym);
9484 : /* Unbounded.ArrayAddress := ADR(Sym) */
9485 2957 : M2Quads_PushTFtok (UnboundedSym, SymbolTable_GetSType (UnboundedSym), tok);
9486 2957 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
9487 2957 : M2Quads_PushTFtok (Field, SymbolTable_GetSType (Field), tok);
9488 2957 : M2Quads_PushT (static_cast<unsigned int> (1));
9489 2957 : M2Quads_BuildDesignatorRecord (tok);
9490 2957 : M2Quads_PushTFtok (M2System_Adr, M2System_Address, tok); /* ADR (Sym). */
9491 2957 : if ((SymbolTable_IsUnbounded (SymType)) && (dim == 0)) /* ADR (Sym). */
9492 : {
9493 12 : PushTFADtok (Sym, SymType, UnboundedSym, dim, tok);
9494 : }
9495 : else
9496 : {
9497 2945 : PushTFADtok (Sym, SymType, ArraySym, dim, tok);
9498 : }
9499 2957 : M2Quads_PushT (static_cast<unsigned int> (1)); /* 1 parameter for ADR(). */
9500 2957 : M2Quads_BuildFunctionCall (false); /* 1 parameter for ADR(). */
9501 2957 : BuildAssignmentWithoutBounds (tok, false, true);
9502 2957 : AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim);
9503 2957 : }
9504 :
9505 :
9506 : /*
9507 : BuildPseudoProcedureCall - builds a pseudo procedure call.
9508 : This procedure does not directly alter the
9509 : stack, but by calling routines the stack
9510 : will change in the following way when this
9511 : procedure returns.
9512 :
9513 : The Stack:
9514 :
9515 :
9516 : Entry Exit
9517 :
9518 : Ptr ->
9519 : +----------------+
9520 : | NoOfParam |
9521 : |----------------|
9522 : | Param 1 |
9523 : |----------------|
9524 : | Param 2 |
9525 : |----------------|
9526 : . .
9527 : . .
9528 : . .
9529 : |----------------|
9530 : | Param # |
9531 : |----------------|
9532 : | ProcSym | Type | Empty
9533 : |----------------|
9534 : */
9535 :
9536 21047 : static void BuildPseudoProcedureCall (unsigned int tokno)
9537 : {
9538 21047 : unsigned int NoOfParam;
9539 21047 : unsigned int ProcSym;
9540 :
9541 21047 : M2Quads_PopT (&NoOfParam);
9542 21047 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
9543 21047 : M2Quads_PushT (NoOfParam);
9544 : /* Compile time stack restored to entry state */
9545 21047 : if (ProcSym == M2Base_New)
9546 : {
9547 867 : BuildNewProcedure (tokno);
9548 : }
9549 20180 : else if (ProcSym == M2Base_Dispose)
9550 : {
9551 : /* avoid dangling else. */
9552 330 : BuildDisposeProcedure (tokno);
9553 : }
9554 19850 : else if (ProcSym == M2Base_Inc)
9555 : {
9556 : /* avoid dangling else. */
9557 13996 : BuildIncProcedure (tokno);
9558 : }
9559 5854 : else if (ProcSym == M2Base_Dec)
9560 : {
9561 : /* avoid dangling else. */
9562 3865 : BuildDecProcedure (tokno);
9563 : }
9564 1989 : else if (ProcSym == M2Base_Incl)
9565 : {
9566 : /* avoid dangling else. */
9567 1112 : BuildInclProcedure (tokno);
9568 : }
9569 877 : else if (ProcSym == M2Base_Excl)
9570 : {
9571 : /* avoid dangling else. */
9572 766 : BuildExclProcedure (tokno);
9573 : }
9574 111 : else if (ProcSym == M2System_Throw)
9575 : {
9576 : /* avoid dangling else. */
9577 111 : BuildThrowProcedure (tokno);
9578 : }
9579 : else
9580 : {
9581 : /* avoid dangling else. */
9582 0 : M2Error_InternalError ((const char *) "pseudo procedure not implemented yet", 36);
9583 : }
9584 21047 : }
9585 :
9586 :
9587 : /*
9588 : GetItemPointedTo - returns the symbol type that is being pointed to
9589 : by Sym.
9590 : */
9591 :
9592 3034 : static unsigned int GetItemPointedTo (unsigned int Sym)
9593 : {
9594 6076 : if (SymbolTable_IsPointer (Sym))
9595 : {
9596 3034 : return SymbolTable_GetSType (Sym);
9597 : }
9598 3042 : else if ((SymbolTable_IsVar (Sym)) || (SymbolTable_IsType (Sym)))
9599 : {
9600 : /* avoid dangling else. */
9601 3042 : return GetItemPointedTo (SymbolTable_GetSType (Sym));
9602 : }
9603 : else
9604 : {
9605 : /* avoid dangling else. */
9606 : return SymbolTable_NulSym;
9607 : }
9608 : /* static analysis guarentees a RETURN statement will be used before here. */
9609 : __builtin_unreachable ();
9610 : }
9611 :
9612 :
9613 : /*
9614 : BuildThrowProcedure - builds the pseudo procedure call M2RTS.Throw.
9615 : The Stack:
9616 :
9617 :
9618 : Entry Exit
9619 :
9620 : Ptr ->
9621 : +----------------+
9622 : | NoOfParam |
9623 : |----------------|
9624 : | Param 1 |
9625 : |----------------|
9626 : | Param 2 |
9627 : |----------------|
9628 : . .
9629 : . .
9630 : . .
9631 : |----------------|
9632 : | Param # |
9633 : |----------------|
9634 : | ProcSym | Type | Empty
9635 : |----------------|
9636 : */
9637 :
9638 111 : static void BuildThrowProcedure (unsigned int functok)
9639 : {
9640 111 : unsigned int op;
9641 111 : unsigned int NoOfParam;
9642 :
9643 111 : M2Quads_PopT (&NoOfParam);
9644 111 : if (NoOfParam == 1)
9645 : {
9646 111 : op = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9647 111 : GenQuadO (functok, M2Quads_ThrowOp, SymbolTable_NulSym, SymbolTable_NulSym, op, false);
9648 : }
9649 : else
9650 : {
9651 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure %{1Ea} takes one INTEGER parameter", 55, M2System_Throw);
9652 : }
9653 111 : M2Quads_PopN (NoOfParam+1);
9654 111 : }
9655 :
9656 :
9657 : /*
9658 : BuildNewProcedure - builds the pseudo procedure call NEW.
9659 : This procedure is traditionally a "macro" for
9660 : NEW(x, ...) --> ALLOCATE(x, TSIZE(x^, ...))
9661 : One method of implementation is to emulate a "macro"
9662 : processor by pushing the relevant input tokens
9663 : back onto the input stack.
9664 : However this causes two problems:
9665 :
9666 : (i) Unnecessary code is produced for x^
9667 : (ii) SIZE must be imported from SYSTEM
9668 : Therefore we chose an alternative method of
9669 : implementation;
9670 : generate quadruples for ALLOCATE(x, TSIZE(x^, ...))
9671 : this, although slightly more efficient,
9672 : is more complex and circumvents problems (i) and (ii).
9673 :
9674 : The Stack:
9675 :
9676 :
9677 : Entry Exit
9678 :
9679 : Ptr ->
9680 : +----------------+
9681 : | NoOfParam |
9682 : |----------------|
9683 : | Param 1 |
9684 : |----------------|
9685 : | Param 2 |
9686 : |----------------|
9687 : . .
9688 : . .
9689 : . .
9690 : |----------------|
9691 : | Param # |
9692 : |----------------|
9693 : | ProcSym | Type | Empty
9694 : |----------------|
9695 : */
9696 :
9697 867 : static void BuildNewProcedure (unsigned int functok)
9698 : {
9699 867 : unsigned int NoOfParam;
9700 867 : unsigned int SizeSym;
9701 867 : unsigned int PtrSym;
9702 867 : unsigned int ProcSym;
9703 867 : unsigned int paramtok;
9704 867 : unsigned int combinedtok;
9705 :
9706 867 : M2Quads_PopT (&NoOfParam);
9707 867 : if (NoOfParam >= 1)
9708 : {
9709 867 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "ALLOCATE", 8));
9710 867 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
9711 : {
9712 867 : PtrSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9713 867 : paramtok = OperandTtok (1);
9714 867 : if (IsReallyPointer (PtrSym))
9715 : {
9716 866 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
9717 : /*
9718 : Build macro: ALLOCATE( PtrSym, SIZE(PtrSym^) )
9719 : */
9720 866 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, paramtok); /* Procedure */
9721 : /* x^ */
9722 866 : M2Quads_PushTtok (GetItemPointedTo (PtrSym), paramtok);
9723 866 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One parameter */
9724 866 : M2Quads_BuildFunctionCall (false); /* One parameter */
9725 866 : M2Quads_PopT (&SizeSym);
9726 866 : M2Quads_PushTtok (ProcSym, combinedtok); /* ALLOCATE */
9727 866 : M2Quads_PushTtok (PtrSym, paramtok); /* x */
9728 866 : M2Quads_PushTtok (SizeSym, paramtok); /* TSIZE(x^) */
9729 866 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9730 866 : M2Quads_BuildProcedureCall (combinedtok); /* Two parameters */
9731 : }
9732 : else
9733 : {
9734 1 : M2MetaError_MetaErrorT1 (paramtok, (const char *) "parameter to {%EkNEW} must be a pointer, seen {%1Ed} {%1&s}", 59, PtrSym);
9735 : }
9736 : }
9737 : else
9738 : {
9739 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}ALLOCATE procedure not found for NEW substitution", 53);
9740 : }
9741 : }
9742 : else
9743 : {
9744 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the pseudo procedure {%EkNEW} has one or more parameters", 56);
9745 : }
9746 867 : M2Quads_PopN (NoOfParam+1);
9747 867 : }
9748 :
9749 :
9750 : /*
9751 : BuildDisposeProcedure - builds the pseudo procedure call DISPOSE.
9752 : This procedure is traditionally a "macro" for
9753 : DISPOSE(x) --> DEALLOCATE(x, TSIZE(x^))
9754 : One method of implementation is to emulate a "macro"
9755 : processor by pushing the relevant input tokens
9756 : back onto the input stack.
9757 : However this causes two problems:
9758 :
9759 : (i) Unnecessary code is produced for x^
9760 : (ii) TSIZE must be imported from SYSTEM
9761 : Therefore we chose an alternative method of
9762 : implementation;
9763 : generate quadruples for DEALLOCATE(x, TSIZE(x^))
9764 : this, although slightly more efficient,
9765 : is more complex and circumvents problems (i)
9766 : and (ii).
9767 :
9768 : The Stack:
9769 :
9770 :
9771 : Entry Exit
9772 :
9773 : Ptr ->
9774 : +----------------+
9775 : | NoOfParam |
9776 : |----------------|
9777 : | Param 1 |
9778 : |----------------|
9779 : | Param 2 |
9780 : |----------------|
9781 : . .
9782 : . .
9783 : . .
9784 : |----------------|
9785 : | Param # |
9786 : |----------------|
9787 : | ProcSym | Type | Empty
9788 : |----------------|
9789 : */
9790 :
9791 330 : static void BuildDisposeProcedure (unsigned int functok)
9792 : {
9793 330 : unsigned int NoOfParam;
9794 330 : unsigned int SizeSym;
9795 330 : unsigned int PtrSym;
9796 330 : unsigned int ProcSym;
9797 330 : unsigned int combinedtok;
9798 330 : unsigned int paramtok;
9799 :
9800 330 : M2Quads_PopT (&NoOfParam);
9801 330 : if (NoOfParam >= 1)
9802 : {
9803 330 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "DEALLOCATE", 10));
9804 330 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
9805 : {
9806 330 : PtrSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
9807 330 : paramtok = OperandTtok (1);
9808 330 : if (IsReallyPointer (PtrSym))
9809 : {
9810 330 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
9811 : /*
9812 : Build macro: DEALLOCATE( PtrSym, TSIZE(PtrSym^) )
9813 : */
9814 330 : M2Quads_PushTFtok (M2System_TSize, M2Base_Cardinal, paramtok); /* Procedure */
9815 : /* x^ */
9816 330 : M2Quads_PushTtok (GetItemPointedTo (PtrSym), paramtok);
9817 330 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One parameter */
9818 330 : M2Quads_BuildFunctionCall (false); /* One parameter */
9819 330 : M2Quads_PopT (&SizeSym);
9820 330 : M2Quads_PushTtok (ProcSym, combinedtok); /* DEALLOCATE */
9821 330 : M2Quads_PushTtok (PtrSym, paramtok); /* x */
9822 330 : M2Quads_PushTtok (SizeSym, paramtok); /* TSIZE(x^) */
9823 330 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9824 330 : M2Quads_BuildProcedureCall (combinedtok); /* Two parameters */
9825 : }
9826 : else
9827 : {
9828 0 : M2MetaError_MetaErrorT1 (paramtok, (const char *) "argument to {%EkDISPOSE} must be a pointer, seen {%1Ed} {%1&s}", 62, PtrSym);
9829 : }
9830 : }
9831 : else
9832 : {
9833 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}DEALLOCATE procedure not found for DISPOSE substitution", 59);
9834 : }
9835 : }
9836 : else
9837 : {
9838 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the pseudo procedure {%EkDISPOSE} has one or more parameters", 60);
9839 : }
9840 330 : M2Quads_PopN (NoOfParam+1);
9841 330 : }
9842 :
9843 :
9844 : /*
9845 : CheckRangeIncDec - performs des := des <tok> expr
9846 : with range checking (if enabled).
9847 :
9848 : Stack
9849 : Entry Exit
9850 :
9851 : +------------+
9852 : empty | des + expr |
9853 : |------------|
9854 : */
9855 :
9856 17859 : static void CheckRangeIncDec (unsigned int tokenpos, unsigned int des, unsigned int expr, NameKey_Name tok)
9857 : {
9858 17859 : unsigned int dtype;
9859 17859 : unsigned int etype;
9860 :
9861 17859 : dtype = SymbolTable_GetDType (des);
9862 17859 : etype = SymbolTable_GetDType (expr);
9863 17859 : if ((etype == SymbolTable_NulSym) && (SymbolTable_IsPointer (SymbolTable_GetTypeMode (des))))
9864 : {
9865 24 : expr = ConvertToAddress (tokenpos, expr);
9866 24 : etype = M2System_Address;
9867 : }
9868 17859 : if (M2Options_WholeValueChecking && ! MustNotCheckBounds)
9869 : {
9870 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
9871 1488 : if (tok == M2Reserved_PlusTok)
9872 : {
9873 804 : BuildRange (M2Range_InitIncRangeCheck (des, expr));
9874 : }
9875 : else
9876 : {
9877 684 : BuildRange (M2Range_InitDecRangeCheck (des, expr));
9878 : }
9879 : }
9880 17859 : if (M2Base_IsExpressionCompatible (dtype, etype))
9881 : {
9882 : /* the easy case simulate a straightforward macro */
9883 16389 : M2Quads_PushTFtok (des, dtype, tokenpos);
9884 16389 : M2Quads_PushT (tok);
9885 16389 : M2Quads_PushTFtok (expr, etype, tokenpos);
9886 16389 : doBuildBinaryOp (false, true);
9887 : }
9888 : else
9889 : {
9890 1470 : if ((((M2Base_IsOrdinalType (dtype)) || (dtype == M2System_Address)) || (SymbolTable_IsPointer (dtype))) && (((M2Base_IsOrdinalType (etype)) || (etype == M2System_Address)) || (SymbolTable_IsPointer (etype))))
9891 : {
9892 1470 : M2Quads_PushTFtok (des, dtype, tokenpos);
9893 1470 : M2Quads_PushT (tok);
9894 1470 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tokenpos);
9895 1470 : M2Quads_PushTtok (dtype, tokenpos);
9896 1470 : M2Quads_PushTtok (expr, tokenpos);
9897 1470 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
9898 1470 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
9899 1470 : doBuildBinaryOp (false, true);
9900 : }
9901 : else
9902 : {
9903 0 : if (tok == M2Reserved_PlusTok)
9904 : {
9905 0 : M2MetaError_MetaError0 ((const char *) "cannot perform {%EkINC} using non ordinal types", 47);
9906 : }
9907 : else
9908 : {
9909 0 : M2MetaError_MetaError0 ((const char *) "cannot perform {%EkDEC} using non ordinal types", 47);
9910 : }
9911 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (tokenpos, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym), static_cast<unsigned int> (SymbolTable_NulSym), tokenpos);
9912 : }
9913 : }
9914 17859 : }
9915 :
9916 :
9917 : /*
9918 : BuildIncProcedure - builds the pseudo procedure call INC.
9919 : INC is a procedure which increments a variable.
9920 : It takes one or two parameters:
9921 : INC(a, b) or INC(a)
9922 : a := a+b or a := a+1
9923 :
9924 : The Stack:
9925 :
9926 :
9927 : Entry Exit
9928 :
9929 : Ptr ->
9930 : +----------------+
9931 : | NoOfParam |
9932 : |----------------|
9933 : | Param 1 |
9934 : |----------------|
9935 : | Param 2 |
9936 : |----------------|
9937 : . .
9938 : . .
9939 : . .
9940 : |----------------|
9941 : | Param # |
9942 : |----------------|
9943 : | ProcSym | Type | Empty
9944 : |----------------|
9945 : */
9946 :
9947 13996 : static void BuildIncProcedure (unsigned int proctok)
9948 : {
9949 13996 : unsigned int vartok;
9950 13996 : unsigned int NoOfParam;
9951 13996 : unsigned int dtype;
9952 13996 : unsigned int OperandSym;
9953 13996 : unsigned int VarSym;
9954 13996 : unsigned int TempSym;
9955 :
9956 13996 : M2Quads_PopT (&NoOfParam);
9957 13996 : if ((NoOfParam == 1) || (NoOfParam == 2))
9958 : {
9959 13996 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam)); /* Bottom/first parameter. */
9960 13996 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam)); /* Bottom/first parameter. */
9961 13996 : if (SymbolTable_IsVar (VarSym))
9962 : {
9963 13995 : dtype = SymbolTable_GetDType (VarSym);
9964 13995 : if (NoOfParam == 2)
9965 : {
9966 2731 : OperandSym = DereferenceLValue (proctok, M2Quads_OperandT (1));
9967 : }
9968 : else
9969 : {
9970 11264 : PushOne (proctok, dtype, (const char *) "the {%EkINC} will cause an overflow {%1ad}", 42);
9971 11264 : M2Quads_PopT (&OperandSym);
9972 : }
9973 13995 : M2Quads_PushTtok (VarSym, vartok);
9974 13995 : TempSym = DereferenceLValue (vartok, VarSym);
9975 13995 : CheckRangeIncDec (proctok, TempSym, OperandSym, M2Reserved_PlusTok); /* TempSym + OperandSym. */
9976 13995 : BuildAssignmentWithoutBounds (proctok, false, true); /* VarSym := TempSym + OperandSym. */
9977 : }
9978 : else
9979 : {
9980 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed} {%1&s}", 85, VarSym);
9981 : }
9982 : }
9983 : else
9984 : {
9985 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkINC} expects 1 or 2 parameters", 53);
9986 : }
9987 13996 : M2Quads_PopN (NoOfParam+1);
9988 13996 : }
9989 :
9990 :
9991 : /*
9992 : BuildDecProcedure - builds the pseudo procedure call DEC.
9993 : DEC is a procedure which decrements a variable.
9994 : It takes one or two parameters:
9995 : DEC(a, b) or DEC(a)
9996 : a := a-b or a := a-1
9997 :
9998 : The Stack:
9999 :
10000 :
10001 : Entry Exit
10002 :
10003 : Ptr ->
10004 : +----------------+
10005 : | NoOfParam |
10006 : |----------------|
10007 : | Param 1 |
10008 : |----------------|
10009 : | Param 2 |
10010 : |----------------|
10011 : . .
10012 : . .
10013 : . .
10014 : |----------------|
10015 : | Param # |
10016 : |----------------|
10017 : | ProcSym | Type | Empty
10018 : |----------------|
10019 : */
10020 :
10021 3865 : static void BuildDecProcedure (unsigned int proctok)
10022 : {
10023 3865 : unsigned int vartok;
10024 3865 : unsigned int NoOfParam;
10025 3865 : unsigned int dtype;
10026 3865 : unsigned int OperandSym;
10027 3865 : unsigned int VarSym;
10028 3865 : unsigned int TempSym;
10029 :
10030 3865 : M2Quads_PopT (&NoOfParam);
10031 3865 : if ((NoOfParam == 1) || (NoOfParam == 2))
10032 : {
10033 3865 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam)); /* Bottom/first parameter. */
10034 3865 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam)); /* Bottom/first parameter. */
10035 3865 : if (SymbolTable_IsVar (VarSym))
10036 : {
10037 3864 : dtype = SymbolTable_GetDType (VarSym);
10038 3864 : if (NoOfParam == 2)
10039 : {
10040 1361 : OperandSym = DereferenceLValue (proctok, M2Quads_OperandT (1));
10041 : }
10042 : else
10043 : {
10044 2503 : PushOne (proctok, dtype, (const char *) "the {%EkDEC} will cause an overflow {%1ad}", 42);
10045 2503 : M2Quads_PopT (&OperandSym);
10046 : }
10047 3864 : M2Quads_PushTtok (VarSym, vartok);
10048 3864 : TempSym = DereferenceLValue (vartok, VarSym);
10049 3864 : CheckRangeIncDec (proctok, TempSym, OperandSym, M2Reserved_MinusTok); /* TempSym - OperandSym. */
10050 3864 : BuildAssignmentWithoutBounds (proctok, false, true); /* VarSym := TempSym - OperandSym. */
10051 : }
10052 : else
10053 : {
10054 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed} {%1&s}", 85, VarSym);
10055 : }
10056 : }
10057 : else
10058 : {
10059 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkDEC} expects 1 or 2 parameters", 53);
10060 : }
10061 3865 : M2Quads_PopN (NoOfParam+1);
10062 3865 : }
10063 :
10064 :
10065 : /*
10066 : DereferenceLValue - checks to see whether, operand, is declare as an LValue
10067 : and if so it dereferences it.
10068 : */
10069 :
10070 30073 : static unsigned int DereferenceLValue (unsigned int tok, unsigned int operand)
10071 : {
10072 30073 : unsigned int sym;
10073 :
10074 30073 : if ((SymbolTable_GetMode (operand)) == SymbolTable_LeftValue)
10075 : {
10076 : /* dereference the pointer */
10077 1442 : sym = SymbolTable_MakeTemporary (tok, AreConstant (SymbolTable_IsConst (operand)));
10078 721 : SymbolTable_PutVar (sym, SymbolTable_GetSType (operand));
10079 721 : M2Quads_PushTtok (sym, tok);
10080 721 : M2Quads_PushTtok (operand, tok);
10081 721 : BuildAssignmentWithoutBounds (tok, false, true);
10082 721 : return sym;
10083 : }
10084 : else
10085 : {
10086 : return operand;
10087 : }
10088 : /* static analysis guarentees a RETURN statement will be used before here. */
10089 : __builtin_unreachable ();
10090 : }
10091 :
10092 :
10093 : /*
10094 : BuildInclProcedure - builds the pseudo procedure call INCL.
10095 : INCL is a procedure which adds bit b into a BITSET a.
10096 : It takes two parameters:
10097 : INCL(a, b)
10098 :
10099 : a := a + {b}
10100 :
10101 : The Stack:
10102 :
10103 :
10104 : Entry Exit
10105 :
10106 : Ptr ->
10107 : +----------------+
10108 : | NoOfParam |
10109 : |----------------|
10110 : | Param 1 |
10111 : |----------------|
10112 : | Param 2 |
10113 : |----------------|
10114 : | ProcSym | Type | Empty
10115 : |----------------|
10116 : */
10117 :
10118 1112 : static void BuildInclProcedure (unsigned int proctok)
10119 : {
10120 1112 : unsigned int vartok;
10121 1112 : unsigned int optok;
10122 1112 : unsigned int NoOfParam;
10123 1112 : unsigned int DerefSym;
10124 1112 : unsigned int OperandSym;
10125 1112 : unsigned int VarSym;
10126 :
10127 1112 : M2Quads_PopT (&NoOfParam);
10128 1112 : if (NoOfParam == 2)
10129 : {
10130 1112 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10131 1112 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10132 1112 : MarkArrayWritten (M2Quads_OperandA (2));
10133 1112 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10134 1112 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10135 1112 : if (SymbolTable_IsVar (VarSym))
10136 : {
10137 1105 : if (SymbolTable_IsSet (SymbolTable_GetDType (VarSym)))
10138 : {
10139 1105 : DerefSym = DereferenceLValue (optok, OperandSym);
10140 1105 : BuildRange (M2Range_InitInclCheck (VarSym, DerefSym));
10141 1105 : GenQuadO (proctok, M2Quads_InclOp, VarSym, SymbolTable_NulSym, DerefSym, false);
10142 : }
10143 : else
10144 : {
10145 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the first parameter to {%EkINCL} must be a set variable, seen {%1Ed} {%1&s}", 75, VarSym);
10146 : }
10147 : }
10148 : else
10149 : {
10150 7 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkINCL} expects a variable as a parameter, seen {%1Ed} {%1&s}", 78, VarSym);
10151 : }
10152 : }
10153 : else
10154 : {
10155 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkINCL} expects 1 or 2 parameters", 54);
10156 : }
10157 1112 : M2Quads_PopN (NoOfParam+1);
10158 1112 : }
10159 :
10160 :
10161 : /*
10162 : BuildExclProcedure - builds the pseudo procedure call EXCL.
10163 : INCL is a procedure which removes bit b from SET a.
10164 : It takes two parameters:
10165 : EXCL(a, b)
10166 :
10167 : a := a - {b}
10168 :
10169 : The Stack:
10170 :
10171 :
10172 : Entry Exit
10173 :
10174 : Ptr ->
10175 : +----------------+
10176 : | NoOfParam |
10177 : |----------------|
10178 : | Param 1 |
10179 : |----------------|
10180 : | Param 2 |
10181 : |----------------|
10182 : | ProcSym | Type | Empty
10183 : |----------------|
10184 : */
10185 :
10186 766 : static void BuildExclProcedure (unsigned int proctok)
10187 : {
10188 766 : unsigned int vartok;
10189 766 : unsigned int optok;
10190 766 : unsigned int NoOfParam;
10191 766 : unsigned int DerefSym;
10192 766 : unsigned int OperandSym;
10193 766 : unsigned int VarSym;
10194 :
10195 766 : M2Quads_PopT (&NoOfParam);
10196 766 : if (NoOfParam == 2)
10197 : {
10198 766 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10199 766 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10200 766 : MarkArrayWritten (M2Quads_OperandA (2));
10201 766 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10202 766 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10203 766 : if (SymbolTable_IsVar (VarSym))
10204 : {
10205 765 : if (SymbolTable_IsSet (SymbolTable_GetDType (VarSym)))
10206 : {
10207 765 : DerefSym = DereferenceLValue (optok, OperandSym);
10208 765 : BuildRange (M2Range_InitExclCheck (VarSym, DerefSym));
10209 765 : GenQuadO (proctok, M2Quads_ExclOp, VarSym, SymbolTable_NulSym, DerefSym, false);
10210 : }
10211 : else
10212 : {
10213 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the first parameter to {%EkEXCL} must be a set variable, seen {%1Ed} {%1&s}", 75, VarSym);
10214 : }
10215 : }
10216 : else
10217 : {
10218 1 : M2MetaError_MetaErrorT1 (vartok, (const char *) "base procedure {%EkEXCL} expects a variable as a parameter, seen {%1Ed} {%1&s}", 78, VarSym);
10219 : }
10220 : }
10221 : else
10222 : {
10223 0 : M2MetaError_MetaErrorT0 (proctok, (const char *) "the base procedure {%EkEXCL} expects 1 or 2 parameters", 54);
10224 : }
10225 766 : M2Quads_PopN (NoOfParam+1);
10226 766 : }
10227 :
10228 :
10229 : /*
10230 : BuildTypeCoercion - builds the type coersion.
10231 : Modula-2 allows types to be coersed with no runtime
10232 : penility.
10233 : It insists that the TSIZE(t1)=TSIZE(t2) where
10234 : t2 variable := t2(variable of type t1).
10235 : The ReturnVar on the stack is of type t2.
10236 :
10237 : The Stack:
10238 :
10239 :
10240 : Entry Exit
10241 :
10242 : Ptr ->
10243 : +----------------+
10244 : | NoOfParam |
10245 : |----------------|
10246 : | Param 1 |
10247 : |----------------|
10248 : | Param 2 |
10249 : |----------------|
10250 : . .
10251 : . .
10252 : . .
10253 : |----------------|
10254 : | Param # | <- Ptr
10255 : |----------------| +------------+
10256 : | ProcSym | Type | | ReturnVar |
10257 : |----------------| |------------|
10258 :
10259 : Quadruples:
10260 :
10261 : CoerceOp ReturnVar Type Param1
10262 :
10263 : A type coercion will only be legal if the different
10264 : types have exactly the same size.
10265 : Since we can only decide this after M2Eval has processed
10266 : the symbol table then we create a quadruple explaining
10267 : the coercion taking place, the code generator can test
10268 : this assertion and report an error if the type sizes
10269 : differ.
10270 : */
10271 :
10272 2574 : static void BuildTypeCoercion (bool ConstExpr)
10273 : {
10274 2574 : unsigned int resulttok;
10275 2574 : unsigned int proctok;
10276 2574 : unsigned int exptok;
10277 2574 : unsigned int r;
10278 2574 : unsigned int exp;
10279 2574 : unsigned int NoOfParam;
10280 2574 : unsigned int ReturnVar;
10281 2574 : unsigned int ProcSym;
10282 :
10283 2574 : M2Quads_PopT (&NoOfParam);
10284 2574 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10285 2574 : proctok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
10286 2574 : if (! (SymbolTable_IsAModula2Type (ProcSym)))
10287 : {
10288 0 : M2MetaError_MetaError1 ((const char *) "coersion expecting a type, seen {%1Ea} which is {%1Ed} {%1&s}", 61, ProcSym);
10289 : }
10290 2574 : if (NoOfParam == 1)
10291 : {
10292 2574 : PopTrwtok (&exp, &r, &exptok);
10293 2574 : MarkAsRead (r);
10294 2574 : resulttok = M2LexBuf_MakeVirtual2Tok (proctok, exptok);
10295 2574 : M2Quads_PopN (1); /* Pop procedure. */
10296 2574 : if (ConstExprError (ProcSym, exp, exptok, ConstExpr)) /* Pop procedure. */
10297 : {
10298 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
10299 0 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10300 : }
10301 : /* Set ReturnVar's TYPE. */
10302 2574 : else if ((SymbolTable_IsConst (exp)) || (SymbolTable_IsVar (exp)))
10303 : {
10304 : /* avoid dangling else. */
10305 5148 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (SymbolTable_IsConst (exp)));
10306 2574 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10307 2574 : GenQuad (M2Quads_CoerceOp, ReturnVar, ProcSym, exp); /* Set ReturnVar's TYPE. */
10308 : }
10309 : else
10310 : {
10311 : /* avoid dangling else. */
10312 0 : M2MetaError_MetaError2 ((const char *) "trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}", 74, exp, ProcSym);
10313 0 : M2MetaError_MetaError2 ((const char *) "trying to coerse {%1ECad} which is not a variable or constant into {%2ad}", 73, exp, ProcSym);
10314 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_RightValue);
10315 0 : SymbolTable_PutVar (ReturnVar, ProcSym); /* Set ReturnVar's TYPE. */
10316 : }
10317 2574 : M2Quads_PushTFtok (ReturnVar, ProcSym, resulttok);
10318 : }
10319 : else
10320 : {
10321 0 : M2MetaError_MetaError0 ((const char *) "{%E}only one parameter expected in a TYPE coersion", 50);
10322 : }
10323 2574 : }
10324 :
10325 :
10326 : /*
10327 : BuildRealFunctionCall - builds a function call.
10328 : The Stack:
10329 :
10330 :
10331 : Entry Exit
10332 :
10333 : Ptr ->
10334 : +----------------+
10335 : | NoOfParam |
10336 : |----------------|
10337 : | Param 1 |
10338 : |----------------|
10339 : | Param 2 |
10340 : |----------------|
10341 : . .
10342 : . .
10343 : . .
10344 : |----------------|
10345 : | Param # | <- Ptr
10346 : |----------------| +------------+
10347 : | ProcSym | Type | | ReturnVar |
10348 : |----------------| |------------|
10349 : */
10350 :
10351 62570 : static void BuildRealFunctionCall (unsigned int tokno, bool ConstExpr)
10352 : {
10353 62570 : unsigned int NoOfParam;
10354 62570 : unsigned int ProcSym;
10355 :
10356 62570 : M2Quads_PopT (&NoOfParam);
10357 62570 : M2Quads_PushT (NoOfParam);
10358 62570 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+2));
10359 62570 : ProcSym = PCSymBuild_SkipConst (ProcSym);
10360 62570 : if (SymbolTable_IsVar (ProcSym))
10361 : {
10362 : /* Procedure Variable therefore get its type to see if it is a FOR "C" call. */
10363 94 : ProcSym = SymbolTable_SkipType (M2Quads_OperandF (NoOfParam+2));
10364 : }
10365 62570 : if ((SymbolTable_IsDefImp (SymbolTable_GetScope (ProcSym))) && (SymbolTable_IsDefinitionForC (SymbolTable_GetScope (ProcSym))))
10366 : {
10367 8552 : BuildRealFuncProcCall (tokno, true, true, ConstExpr);
10368 : }
10369 : else
10370 : {
10371 54018 : BuildRealFuncProcCall (tokno, true, false, ConstExpr);
10372 : }
10373 62558 : }
10374 :
10375 :
10376 : /*
10377 : BuildPseudoFunctionCall - builds the pseudo function
10378 : The Stack:
10379 :
10380 :
10381 : Entry Exit
10382 :
10383 : Ptr ->
10384 : +----------------+
10385 : | NoOfParam |
10386 : |----------------|
10387 : | Param 1 |
10388 : |----------------|
10389 : | Param 2 |
10390 : |----------------|
10391 : . .
10392 : . .
10393 : . .
10394 : |----------------|
10395 : | Param # | <- Ptr
10396 : |----------------| +------------+
10397 : | ProcSym | Type | | ReturnVar |
10398 : |----------------| |------------|
10399 :
10400 : */
10401 :
10402 42871 : static void BuildPseudoFunctionCall (bool ConstExpr)
10403 : {
10404 42871 : unsigned int NoOfParam;
10405 42871 : unsigned int ProcSym;
10406 :
10407 42871 : M2Quads_PopT (&NoOfParam);
10408 42871 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10409 42871 : ProcSym = PCSymBuild_SkipConst (ProcSym);
10410 42871 : M2Quads_PushT (NoOfParam);
10411 : /* Compile time stack restored to entry state. */
10412 42871 : if (ProcSym == M2Base_High)
10413 : {
10414 2976 : BuildHighFunction ();
10415 : }
10416 39895 : else if (ProcSym == M2Base_LengthS)
10417 : {
10418 : /* avoid dangling else. */
10419 346 : BuildLengthFunction (ProcSym, ConstExpr);
10420 : }
10421 39549 : else if (ProcSym == M2System_Adr)
10422 : {
10423 : /* avoid dangling else. */
10424 9649 : BuildAdrFunction ();
10425 : }
10426 29900 : else if (ProcSym == M2Size_Size)
10427 : {
10428 : /* avoid dangling else. */
10429 2097 : BuildSizeFunction ();
10430 : }
10431 27803 : else if (ProcSym == M2System_TSize)
10432 : {
10433 : /* avoid dangling else. */
10434 4766 : BuildTSizeFunction ();
10435 : }
10436 23037 : else if (ProcSym == M2System_TBitSize)
10437 : {
10438 : /* avoid dangling else. */
10439 6508 : BuildTBitSizeFunction ();
10440 : }
10441 16529 : else if (ProcSym == M2Base_Convert)
10442 : {
10443 : /* avoid dangling else. */
10444 12 : BuildConvertFunction (ProcSym, ConstExpr);
10445 : }
10446 16517 : else if (ProcSym == M2Base_Odd)
10447 : {
10448 : /* avoid dangling else. */
10449 44 : BuildOddFunction (ProcSym, ConstExpr);
10450 : }
10451 16473 : else if (ProcSym == M2Base_Abs)
10452 : {
10453 : /* avoid dangling else. */
10454 177 : BuildAbsFunction (ProcSym, ConstExpr);
10455 : }
10456 16296 : else if (ProcSym == M2Base_Cap)
10457 : {
10458 : /* avoid dangling else. */
10459 125 : BuildCapFunction (ProcSym, ConstExpr);
10460 : }
10461 16171 : else if (ProcSym == M2Base_Val)
10462 : {
10463 : /* avoid dangling else. */
10464 4922 : BuildValFunction (ProcSym, ConstExpr);
10465 : }
10466 11249 : else if (ProcSym == M2Base_Chr)
10467 : {
10468 : /* avoid dangling else. */
10469 1020 : BuildChrFunction (ProcSym, ConstExpr);
10470 : }
10471 10229 : else if (M2Base_IsOrd (ProcSym))
10472 : {
10473 : /* avoid dangling else. */
10474 4708 : BuildOrdFunction (ProcSym, ConstExpr);
10475 : }
10476 5521 : else if (M2Base_IsInt (ProcSym))
10477 : {
10478 : /* avoid dangling else. */
10479 6 : BuildIntFunction (ProcSym, ConstExpr);
10480 : }
10481 5515 : else if (M2Base_IsTrunc (ProcSym))
10482 : {
10483 : /* avoid dangling else. */
10484 60 : BuildTruncFunction (ProcSym, ConstExpr);
10485 : }
10486 5455 : else if (M2Base_IsFloat (ProcSym))
10487 : {
10488 : /* avoid dangling else. */
10489 88 : BuildFloatFunction (ProcSym, ConstExpr);
10490 : }
10491 5367 : else if (ProcSym == M2Base_Min)
10492 : {
10493 : /* avoid dangling else. */
10494 1248 : BuildMinFunction ();
10495 : }
10496 4119 : else if (ProcSym == M2Base_Max)
10497 : {
10498 : /* avoid dangling else. */
10499 2023 : BuildMaxFunction ();
10500 : }
10501 2096 : else if (ProcSym == M2System_AddAdr)
10502 : {
10503 : /* avoid dangling else. */
10504 36 : BuildAddAdrFunction (ProcSym, ConstExpr);
10505 : }
10506 2060 : else if (ProcSym == M2System_SubAdr)
10507 : {
10508 : /* avoid dangling else. */
10509 12 : BuildSubAdrFunction (ProcSym, ConstExpr);
10510 : }
10511 2048 : else if (ProcSym == M2System_DifAdr)
10512 : {
10513 : /* avoid dangling else. */
10514 12 : BuildDifAdrFunction (ProcSym, ConstExpr);
10515 : }
10516 2036 : else if (ProcSym == M2System_Cast)
10517 : {
10518 : /* avoid dangling else. */
10519 156 : BuildCastFunction (ProcSym, ConstExpr);
10520 : }
10521 1880 : else if (ProcSym == M2System_Shift)
10522 : {
10523 : /* avoid dangling else. */
10524 682 : BuildShiftFunction ();
10525 : }
10526 1198 : else if (ProcSym == M2System_Rotate)
10527 : {
10528 : /* avoid dangling else. */
10529 406 : BuildRotateFunction ();
10530 : }
10531 792 : else if (ProcSym == M2System_MakeAdr)
10532 : {
10533 : /* avoid dangling else. */
10534 12 : BuildMakeAdrFunction ();
10535 : }
10536 780 : else if (ProcSym == M2Base_Re)
10537 : {
10538 : /* avoid dangling else. */
10539 84 : BuildReFunction (ProcSym, ConstExpr);
10540 : }
10541 696 : else if (ProcSym == M2Base_Im)
10542 : {
10543 : /* avoid dangling else. */
10544 84 : BuildImFunction (ProcSym, ConstExpr);
10545 : }
10546 612 : else if (ProcSym == M2Base_Cmplx)
10547 : {
10548 : /* avoid dangling else. */
10549 612 : BuildCmplxFunction (ProcSym, ConstExpr);
10550 : }
10551 : else
10552 : {
10553 : /* avoid dangling else. */
10554 0 : M2Error_InternalError ((const char *) "pseudo function not implemented yet", 35);
10555 : }
10556 42853 : }
10557 :
10558 :
10559 : /*
10560 : BuildAddAdrFunction - builds the pseudo procedure call ADDADR.
10561 :
10562 : PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
10563 :
10564 : Which returns address given by (addr + offset),
10565 : [ the standard says that it _may_
10566 : "raise an exception if this address is not valid."
10567 : currently we do not generate any exception code ]
10568 :
10569 : The Stack:
10570 :
10571 : Entry Exit
10572 :
10573 : Ptr ->
10574 : +----------------+
10575 : | NoOfParam |
10576 : |----------------|
10577 : | Param 1 |
10578 : |----------------|
10579 : | Param 2 | <- Ptr
10580 : |----------------| +------------+
10581 : | ProcSym | Type | | ReturnVar |
10582 : |----------------| |------------|
10583 : */
10584 :
10585 36 : static void BuildAddAdrFunction (unsigned int ProcSym, bool ConstExpr)
10586 : {
10587 36 : unsigned int combinedtok;
10588 36 : unsigned int functok;
10589 36 : unsigned int vartok;
10590 36 : unsigned int optok;
10591 36 : unsigned int opa;
10592 36 : unsigned int ReturnVar;
10593 36 : unsigned int NoOfParam;
10594 36 : unsigned int OperandSym;
10595 36 : unsigned int VarSym;
10596 :
10597 36 : M2Quads_PopT (&NoOfParam);
10598 36 : functok = OperandTtok (NoOfParam+1);
10599 36 : if (NoOfParam == 2)
10600 : {
10601 36 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10602 36 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10603 36 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10604 36 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10605 36 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
10606 36 : M2Quads_PopN (NoOfParam+1);
10607 36 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10608 : {
10609 : /* Fake return result. */
10610 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10611 : }
10612 36 : else if (SymbolTable_IsVar (VarSym))
10613 : {
10614 : /* avoid dangling else. */
10615 36 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10616 : {
10617 36 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
10618 36 : SymbolTable_PutVar (ReturnVar, M2System_Address);
10619 36 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10620 72 : GenQuadOtok (combinedtok, M2Quads_AddOp, ReturnVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10621 36 : M2Quads_PushTFtok (ReturnVar, M2System_Address, combinedtok);
10622 : }
10623 : else
10624 : {
10625 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);
10626 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10627 : }
10628 : }
10629 : else
10630 : {
10631 : /* avoid dangling else. */
10632 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure ADDADR expects a variable of type ADDRESS or POINTER as its first parameter", 96);
10633 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10634 : }
10635 : }
10636 : else
10637 : {
10638 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure {%EkADDADR} expects 2 parameters", 53);
10639 0 : M2Quads_PopN (NoOfParam+1);
10640 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, functok);
10641 : }
10642 36 : }
10643 :
10644 :
10645 : /*
10646 : BuildSubAdrFunction - builds the pseudo procedure call ADDADR.
10647 :
10648 : PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
10649 :
10650 : Which returns address given by (addr - offset),
10651 : [ the standard says that it _may_
10652 : "raise an exception if this address is not valid."
10653 : currently we do not generate any exception code ]
10654 :
10655 : The Stack:
10656 :
10657 : Entry Exit
10658 :
10659 : Ptr ->
10660 : +----------------+
10661 : | NoOfParam |
10662 : |----------------|
10663 : | Param 1 |
10664 : |----------------|
10665 : | Param 2 | <- Ptr
10666 : |----------------| +------------+
10667 : | ProcSym | Type | | ReturnVar |
10668 : |----------------| |------------|
10669 : */
10670 :
10671 12 : static void BuildSubAdrFunction (unsigned int ProcSym, bool ConstExpr)
10672 : {
10673 12 : unsigned int functok;
10674 12 : unsigned int combinedtok;
10675 12 : unsigned int optok;
10676 12 : unsigned int vartok;
10677 12 : unsigned int ReturnVar;
10678 12 : unsigned int NoOfParam;
10679 12 : unsigned int OperandSym;
10680 12 : unsigned int opa;
10681 12 : unsigned int VarSym;
10682 :
10683 12 : M2Quads_PopT (&NoOfParam);
10684 12 : functok = OperandTtok (NoOfParam+1);
10685 12 : if (NoOfParam == 2)
10686 : {
10687 12 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10688 12 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10689 12 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10690 12 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10691 12 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10692 12 : M2Quads_PopN (NoOfParam+1);
10693 12 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10694 : {
10695 : /* Fake return result. */
10696 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10697 : }
10698 12 : else if (SymbolTable_IsVar (VarSym))
10699 : {
10700 : /* avoid dangling else. */
10701 12 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10702 : {
10703 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
10704 12 : SymbolTable_PutVar (ReturnVar, M2System_Address);
10705 12 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10706 24 : GenQuadOtok (combinedtok, M2Quads_SubOp, ReturnVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10707 12 : M2Quads_PushTFtok (ReturnVar, M2System_Address, combinedtok);
10708 : }
10709 : else
10710 : {
10711 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);
10712 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (vartok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, vartok);
10713 : }
10714 : }
10715 : else
10716 : {
10717 : /* avoid dangling else. */
10718 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10719 0 : M2MetaError_MetaErrorT0 (combinedtok, (const char *) "{%E}SYSTEM procedure {%EkSUBADR} expects a variable of type ADDRESS or POINTER as its first parameter", 101);
10720 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, combinedtok);
10721 : }
10722 : }
10723 : else
10724 : {
10725 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure {%EkSUBADR} expects 2 parameters", 53);
10726 0 : M2Quads_PopN (NoOfParam+1);
10727 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2System_Address), M2System_Address, functok);
10728 : }
10729 12 : }
10730 :
10731 :
10732 : /*
10733 : BuildDifAdrFunction - builds the pseudo procedure call DIFADR.
10734 :
10735 : PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER ;
10736 :
10737 : Which returns address given by (addr1 - addr2),
10738 : [ the standard says that it _may_
10739 : "raise an exception if this address is invalid or
10740 : address space is non-contiguous."
10741 : currently we do not generate any exception code ]
10742 :
10743 : The Stack:
10744 :
10745 : Entry Exit
10746 :
10747 : Ptr ->
10748 : +----------------+
10749 : | NoOfParam |
10750 : |----------------|
10751 : | Param 1 |
10752 : |----------------|
10753 : | Param 2 | <- Ptr
10754 : |----------------| +------------+
10755 : | ProcSym | Type | | ReturnVar |
10756 : |----------------| |------------|
10757 : */
10758 :
10759 12 : static void BuildDifAdrFunction (unsigned int ProcSym, bool ConstExpr)
10760 : {
10761 12 : unsigned int functok;
10762 12 : unsigned int optok;
10763 12 : unsigned int vartok;
10764 12 : unsigned int combinedtok;
10765 12 : unsigned int TempVar;
10766 12 : unsigned int NoOfParam;
10767 12 : unsigned int OperandSym;
10768 12 : unsigned int opa;
10769 12 : unsigned int VarSym;
10770 :
10771 12 : M2Quads_PopT (&NoOfParam);
10772 12 : functok = OperandTtok (NoOfParam+1);
10773 12 : if (NoOfParam >= 1)
10774 : {
10775 12 : OperandSym = static_cast<unsigned int> (M2Quads_OperandT (1));
10776 12 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10777 : }
10778 : else
10779 : {
10780 : optok = functok;
10781 : }
10782 12 : if (NoOfParam == 2)
10783 : {
10784 12 : VarSym = static_cast<unsigned int> (M2Quads_OperandT (2));
10785 12 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (2));
10786 12 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
10787 12 : M2Quads_PopN (NoOfParam+1);
10788 12 : if ((ConstExprError (ProcSym, VarSym, vartok, ConstExpr)) || (ConstExprError (ProcSym, OperandSym, optok, ConstExpr)))
10789 : {
10790 : /* Fake return result. */
10791 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10792 : }
10793 12 : else if (SymbolTable_IsVar (VarSym))
10794 : {
10795 : /* avoid dangling else. */
10796 12 : if ((IsReallyPointer (VarSym)) || ((SymbolTable_GetSType (VarSym)) == M2System_Address))
10797 : {
10798 12 : if ((IsReallyPointer (OperandSym)) || ((SymbolTable_GetSType (OperandSym)) == M2System_Address))
10799 : {
10800 12 : TempVar = SymbolTable_MakeTemporary (vartok, SymbolTable_RightValue);
10801 12 : SymbolTable_PutVar (TempVar, M2System_Address);
10802 12 : opa = ConvertToAddress (optok, DereferenceLValue (optok, OperandSym));
10803 24 : GenQuadOtok (combinedtok, M2Quads_SubOp, TempVar, VarSym, opa, true, combinedtok, combinedtok, combinedtok);
10804 : /*
10805 : Build macro: CONVERT( INTEGER, TempVar )
10806 : */
10807 12 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
10808 12 : M2Quads_PushTtok (M2Base_Integer, functok);
10809 12 : M2Quads_PushTtok (TempVar, vartok);
10810 12 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
10811 12 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
10812 : }
10813 : else
10814 : {
10815 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);
10816 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10817 : }
10818 : }
10819 : else
10820 : {
10821 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);
10822 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10823 : }
10824 : }
10825 : else
10826 : {
10827 : /* avoid dangling else. */
10828 0 : M2MetaError_MetaError0 ((const char *) "{%E}SYSTEM procedure {%EkDIFADR} expects a variable of type ADDRESS or POINTER as its first parameter", 101);
10829 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10830 : }
10831 : }
10832 : else
10833 : {
10834 0 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
10835 0 : M2MetaError_MetaErrorT0 (combinedtok, (const char *) "{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters", 53);
10836 0 : M2Quads_PopN (NoOfParam+1);
10837 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Integer), M2Base_Integer, combinedtok);
10838 : }
10839 12 : }
10840 :
10841 :
10842 : /*
10843 : BuildHighFunction - checks the stack in preparation for generating
10844 : quadruples which perform HIGH.
10845 : This procedure does not alter the stack but
10846 : determines whether, a, in HIGH(a) is an ArraySym
10847 : or UnboundedSym.
10848 : Both cases are different and appropriate quadruple
10849 : generating routines are called.
10850 :
10851 : The Stack:
10852 :
10853 :
10854 : Entry Exit
10855 :
10856 : Ptr ->
10857 : +----------------+
10858 : | NoOfParam |
10859 : |----------------|
10860 : | Param 1 |
10861 : |----------------|
10862 : | Param 2 |
10863 : |----------------|
10864 : . .
10865 : . .
10866 : . .
10867 : |----------------|
10868 : | Param # | <- Ptr
10869 : |----------------| +------------+
10870 : | ProcSym | Type | | ReturnVar |
10871 : |----------------| |------------|
10872 :
10873 : */
10874 :
10875 2976 : static void BuildHighFunction (void)
10876 : {
10877 2976 : unsigned int functok;
10878 2976 : unsigned int combinedtok;
10879 2976 : unsigned int paramtok;
10880 2976 : unsigned int ProcSym;
10881 2976 : unsigned int Type;
10882 2976 : unsigned int NoOfParam;
10883 2976 : unsigned int Param;
10884 :
10885 2976 : M2Quads_PopT (&NoOfParam);
10886 2976 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
10887 2976 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
10888 2976 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
10889 2976 : if (NoOfParam == 1) /* quadruple generation now on */
10890 : {
10891 2976 : Param = static_cast<unsigned int> (M2Quads_OperandT (1));
10892 2976 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
10893 2976 : combinedtok = M2LexBuf_MakeVirtualTok (paramtok, functok, paramtok);
10894 2976 : Type = SymbolTable_GetDType (Param);
10895 : /* Restore stack to original form */
10896 2976 : M2Quads_PushT (NoOfParam);
10897 2976 : if (((! (SymbolTable_IsVar (Param))) && (! (SymbolTable_IsConstString (Param)))) && (! (SymbolTable_IsConst (Param))))
10898 : {
10899 : /* we cannot test for IsConst(Param) AND (GetSType(Param)=Char) as the type might not be assigned yet */
10900 0 : M2MetaError_MetaError1 ((const char *) "base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}", 111, Param);
10901 : }
10902 2976 : else if ((Type != SymbolTable_NulSym) && (SymbolTable_IsUnbounded (Type)))
10903 : {
10904 : /* avoid dangling else. */
10905 2743 : BuildHighFromUnbounded (combinedtok);
10906 : }
10907 : else
10908 : {
10909 : /* avoid dangling else. */
10910 233 : BuildConstHighFromSym (combinedtok);
10911 : }
10912 : }
10913 : else
10914 : {
10915 0 : M2MetaError_MetaError0 ((const char *) "base procedure {%EkHIGH} requires one parameter", 47);
10916 0 : M2Quads_PopN (2);
10917 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
10918 : }
10919 2976 : }
10920 :
10921 :
10922 : /*
10923 : BuildConstHighFromSym - builds the pseudo function HIGH from an Sym.
10924 : Sym is a constant or an array which has constant bounds
10925 : and therefore it can be calculated at compile time.
10926 :
10927 : The Stack:
10928 :
10929 :
10930 : Entry Exit
10931 :
10932 : Ptr ->
10933 : +----------------+
10934 : | NoOfParam |
10935 : |----------------|
10936 : | Param 1 |
10937 : |----------------|
10938 : | Param 2 |
10939 : |----------------|
10940 : . .
10941 : . .
10942 : . .
10943 : |----------------|
10944 : | Param # | <- Ptr
10945 : |----------------| +------------+
10946 : | ProcSym | Type | | ReturnVar |
10947 : |----------------| |------------|
10948 : */
10949 :
10950 233 : static void BuildConstHighFromSym (unsigned int tok)
10951 : {
10952 233 : unsigned int NoOfParam;
10953 233 : unsigned int ReturnVar;
10954 :
10955 233 : M2Quads_PopT (&NoOfParam);
10956 233 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
10957 233 : SymbolTable_PutConst (ReturnVar, M2Base_Cardinal);
10958 233 : GenHigh (tok, ReturnVar, 1, M2Quads_OperandT (1));
10959 233 : M2Quads_PopN (NoOfParam+1);
10960 233 : M2Quads_PushTtok (ReturnVar, tok);
10961 233 : }
10962 :
10963 :
10964 : /*
10965 : BuildHighFromUnbounded - builds the pseudo function HIGH from an
10966 : UnboundedSym.
10967 :
10968 : The Stack:
10969 :
10970 :
10971 : Entry Exit
10972 :
10973 : Ptr ->
10974 : +----------------+
10975 : | NoOfParam |
10976 : |----------------|
10977 : | Param # | <- Ptr
10978 : |----------------| +------------+
10979 : | ProcSym | Type | | ReturnVar |
10980 : |----------------| |------------|
10981 :
10982 : */
10983 :
10984 2743 : static void BuildHighFromUnbounded (unsigned int tok)
10985 : {
10986 2743 : unsigned int Dim;
10987 2743 : unsigned int NoOfParam;
10988 2743 : unsigned int ReturnVar;
10989 :
10990 2743 : M2Quads_PopT (&NoOfParam);
10991 2743 : M2Debug_Assert (NoOfParam == 1);
10992 2743 : ReturnVar = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
10993 2743 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
10994 2743 : Dim = static_cast<unsigned int> (OperandD (1));
10995 2743 : Dim += 1;
10996 2743 : if (Dim > 1)
10997 : {
10998 36 : GenHigh (tok, ReturnVar, Dim, M2Quads_OperandA (1));
10999 : }
11000 : else
11001 : {
11002 2707 : GenHigh (tok, ReturnVar, Dim, M2Quads_OperandT (1));
11003 : }
11004 2743 : M2Quads_PopN (2);
11005 2743 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), tok);
11006 2743 : }
11007 :
11008 :
11009 : /*
11010 : GetQualidentImport - returns the symbol as if it were qualified from, module.n.
11011 : This is used to reference runtime support procedures and an
11012 : error is generated if the symbol cannot be obtained.
11013 : */
11014 :
11015 46971 : static unsigned int GetQualidentImport (unsigned int tokno, NameKey_Name n, NameKey_Name module)
11016 : {
11017 46971 : unsigned int sym;
11018 46971 : unsigned int ModSym;
11019 :
11020 46971 : ModSym = M2Batch_MakeDefinitionSource (tokno, module);
11021 46971 : if (ModSym == SymbolTable_NulSym)
11022 : {
11023 0 : M2MetaError_MetaErrorNT2 (tokno, (const char *) "module %a cannot be found and is needed to import %a", 52, module, n);
11024 0 : M2Error_FlushErrors ();
11025 0 : return SymbolTable_NulSym;
11026 : }
11027 46971 : M2Debug_Assert (SymbolTable_IsDefImp (ModSym));
11028 46971 : if (((SymbolTable_GetExported (tokno, ModSym, n)) == SymbolTable_NulSym) || (SymbolTable_IsUnknown (SymbolTable_GetExported (tokno, ModSym, n))))
11029 : {
11030 0 : sym = SymbolTable_GetExported (tokno, ModSym, n);
11031 0 : if (SymbolTable_IsUnknown (sym))
11032 : {
11033 : /* Spellcheck. */
11034 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);
11035 0 : M2MetaError_MetaErrorT1 (tokno, (const char *) "unknown symbol {%1&s}", 21, sym);
11036 0 : SymbolTable_UnknownReported (sym);
11037 : }
11038 : else
11039 : {
11040 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);
11041 : }
11042 0 : M2Error_FlushErrors ();
11043 0 : return SymbolTable_NulSym;
11044 : }
11045 46971 : return SymbolTable_GetExported (tokno, M2Batch_MakeDefinitionSource (tokno, module), n);
11046 : /* static analysis guarentees a RETURN statement will be used before here. */
11047 : __builtin_unreachable ();
11048 : }
11049 :
11050 :
11051 : /*
11052 : ConstExprError - return TRUE if a constant expression is being built and Var is a variable.
11053 : */
11054 :
11055 72164 : static bool ConstExprError (unsigned int Func, unsigned int Var, unsigned int optok, bool ConstExpr)
11056 : {
11057 72164 : if (ConstExpr && (SymbolTable_IsVar (Var)))
11058 : {
11059 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);
11060 108 : return true;
11061 : }
11062 : else
11063 : {
11064 : return false;
11065 : }
11066 : /* static analysis guarentees a RETURN statement will be used before here. */
11067 : __builtin_unreachable ();
11068 : }
11069 :
11070 :
11071 : /*
11072 : DeferMakeLengthConst - creates a constant which contains the length of string, sym.
11073 : */
11074 :
11075 66 : static unsigned int DeferMakeLengthConst (unsigned int tok, unsigned int sym)
11076 : {
11077 66 : unsigned int const_;
11078 :
11079 66 : const_ = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
11080 66 : SymbolTable_PutVar (const_, M2Base_ZType);
11081 132 : GenQuadO (tok, M2Quads_StringLengthOp, const_, 0, sym, false);
11082 66 : return const_;
11083 : /* static analysis guarentees a RETURN statement will be used before here. */
11084 : __builtin_unreachable ();
11085 : }
11086 :
11087 :
11088 : /*
11089 : BuildLengthFunction - builds the inline standard function LENGTH.
11090 :
11091 : The Stack:
11092 :
11093 :
11094 : Entry Exit
11095 :
11096 : Ptr ->
11097 : +----------------+
11098 : | NoOfParam |
11099 : |----------------|
11100 : | Param 1 | <- Ptr
11101 : |----------------| +------------+
11102 : | ProcSym | Type | | ReturnVar |
11103 : |----------------| |------------|
11104 :
11105 : */
11106 :
11107 346 : static void BuildLengthFunction (unsigned int Function, bool ConstExpr)
11108 : {
11109 346 : unsigned int combinedtok;
11110 346 : unsigned int paramtok;
11111 346 : unsigned int functok;
11112 346 : unsigned int ProcSym;
11113 346 : unsigned int Type;
11114 346 : unsigned int NoOfParam;
11115 346 : unsigned int Param;
11116 346 : unsigned int ReturnVar;
11117 :
11118 346 : M2Quads_PopT (&NoOfParam);
11119 346 : Param = static_cast<unsigned int> (M2Quads_OperandT (1));
11120 346 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11121 346 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11122 : /* Restore stack to origional form. */
11123 346 : M2Quads_PushT (NoOfParam);
11124 346 : Type = SymbolTable_GetSType (Param); /* Get the type from the symbol, not the stack. */
11125 346 : if (NoOfParam != 1) /* Get the type from the symbol, not the stack. */
11126 : {
11127 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "base procedure {%1EkLENGTH} expects 1 parameter, seen {%1n} parameters", 70, NoOfParam);
11128 : }
11129 346 : if (NoOfParam >= 1)
11130 : {
11131 346 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, paramtok);
11132 346 : if ((SymbolTable_IsConst (Param)) && ((SymbolTable_GetSType (Param)) == M2Base_Char))
11133 : {
11134 6 : M2Quads_PopT (&NoOfParam);
11135 6 : M2Quads_PopN (NoOfParam+1);
11136 6 : ReturnVar = SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal);
11137 6 : M2Quads_PushTtok (ReturnVar, combinedtok);
11138 : }
11139 340 : else if (SymbolTable_IsConstString (Param))
11140 : {
11141 : /* avoid dangling else. */
11142 48 : M2Quads_PopT (&NoOfParam);
11143 48 : ReturnVar = DeferMakeLengthConst (combinedtok, M2Quads_OperandT (1));
11144 48 : M2Quads_PopN (NoOfParam+1);
11145 48 : M2Quads_PushTtok (ReturnVar, combinedtok);
11146 : }
11147 : else
11148 : {
11149 : /* avoid dangling else. */
11150 292 : ProcSym = GetQualidentImport (functok, NameKey_MakeKey ((const char *) "Length", 6), NameKey_MakeKey ((const char *) "M2RTS", 5));
11151 292 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
11152 : {
11153 292 : M2Quads_PopT (&NoOfParam);
11154 292 : if (SymbolTable_IsConst (Param))
11155 : {
11156 : /* This can be folded in M2GenGCC. */
11157 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_ImmediateValue);
11158 0 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
11159 0 : GenQuad (M2Quads_StandardFunctionOp, ReturnVar, ProcSym, Param);
11160 0 : M2Quads_PopN (NoOfParam+1);
11161 0 : M2Quads_PushTtok (ReturnVar, combinedtok);
11162 : }
11163 292 : else if (ConstExprError (Function, Param, paramtok, ConstExpr))
11164 : {
11165 : /* avoid dangling else. */
11166 : /* Fake a result as we have detected and reported an error. */
11167 6 : M2Quads_PopN (NoOfParam+1);
11168 6 : ReturnVar = SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal);
11169 6 : M2Quads_PushTtok (ReturnVar, combinedtok);
11170 : }
11171 : else
11172 : {
11173 : /* avoid dangling else. */
11174 : /* We must resolve this at runtime or in the GCC optimizer. */
11175 286 : M2Quads_PopTF (&Param, &Type);
11176 286 : M2Quads_PopN (NoOfParam);
11177 286 : M2Quads_PushTtok (ProcSym, functok);
11178 286 : M2Quads_PushTFtok (Param, Type, paramtok);
11179 286 : M2Quads_PushT (NoOfParam);
11180 286 : BuildRealFunctionCall (functok, false);
11181 : }
11182 : }
11183 : else
11184 : {
11185 0 : M2Quads_PopT (&NoOfParam);
11186 0 : M2Quads_PopN (NoOfParam+1);
11187 0 : M2Quads_PushTtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), combinedtok);
11188 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);
11189 : }
11190 : }
11191 : }
11192 : else
11193 : {
11194 : /* NoOfParam is _very_ wrong, we flush all outstanding errors */
11195 0 : M2Error_FlushErrors ();
11196 : }
11197 346 : }
11198 :
11199 :
11200 : /*
11201 : BuildOddFunction - builds the pseudo procedure call ODD.
11202 : This procedure is actually a "macro" for
11203 : ORD(x) --> VAL(BOOLEAN, x MOD 2)
11204 : However we cannot push tokens back onto the input stack
11205 : because the compiler is currently building a function
11206 : call and expecting a ReturnVar on the stack.
11207 : Hence we manipulate the stack and call
11208 : BuildConvertFunction.
11209 :
11210 : The Stack:
11211 :
11212 :
11213 : Entry Exit
11214 :
11215 : Ptr ->
11216 : +----------------+
11217 : | NoOfParam |
11218 : |----------------|
11219 : | Param 1 |
11220 : |----------------|
11221 : | Param 2 |
11222 : |----------------|
11223 : . .
11224 : . .
11225 : . .
11226 : |----------------|
11227 : | Param # |
11228 : |----------------|
11229 : | ProcSym | Type | Empty
11230 : |----------------|
11231 : */
11232 :
11233 44 : static void BuildOddFunction (unsigned int ProcSym, bool ConstExpr)
11234 : {
11235 44 : unsigned int combinedtok;
11236 44 : unsigned int optok;
11237 44 : unsigned int functok;
11238 44 : unsigned int NoOfParam;
11239 44 : unsigned int Res;
11240 44 : unsigned int Var;
11241 :
11242 44 : M2Quads_PopT (&NoOfParam);
11243 44 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11244 44 : if (NoOfParam == 1)
11245 : {
11246 44 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11247 44 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11248 44 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, optok);
11249 44 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11250 : {
11251 : /* Nothing to do. */
11252 6 : M2Quads_PushTtok (M2Base_False, combinedtok);
11253 : }
11254 38 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11255 : {
11256 : /* avoid dangling else. */
11257 38 : M2Quads_PopN (NoOfParam+1);
11258 : /* compute (x MOD 2) */
11259 38 : M2Quads_PushTFtok (Var, SymbolTable_GetSType (Var), optok);
11260 38 : M2Quads_PushT (M2Reserved_ModTok);
11261 38 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (optok, NameKey_MakeKey ((const char *) "2", 1), M2Base_ZType), M2Base_ZType, optok);
11262 38 : M2Quads_BuildBinaryOp ();
11263 38 : M2Quads_PopT (&Res);
11264 : /* compute IF ...=0 */
11265 38 : M2Quads_PushTtok (Res, optok);
11266 38 : M2Quads_PushT (M2Reserved_EqualTok);
11267 38 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (optok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType), M2Base_ZType, optok);
11268 38 : M2Quads_BuildRelOp (combinedtok);
11269 38 : M2Quads_BuildThenIf ();
11270 38 : Res = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11271 38 : SymbolTable_PutVar (Res, M2Base_Boolean);
11272 38 : M2Quads_PushTtok (Res, combinedtok);
11273 38 : M2Quads_PushTtok (M2Base_False, combinedtok);
11274 38 : M2Quads_BuildAssignment (combinedtok);
11275 38 : M2Quads_BuildElse ();
11276 38 : M2Quads_PushTtok (Res, combinedtok);
11277 38 : M2Quads_PushTtok (M2Base_True, combinedtok);
11278 38 : M2Quads_BuildAssignment (combinedtok);
11279 38 : M2Quads_BuildEndIf ();
11280 38 : M2Quads_PushTtok (Res, combinedtok);
11281 : }
11282 : else
11283 : {
11284 : /* avoid dangling else. */
11285 0 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%1EkODD} must be a variable or constant, seen {%1ad} {%1&s}", 77, Var);
11286 0 : M2Quads_PushTtok (M2Base_False, combinedtok);
11287 : }
11288 : }
11289 : else
11290 : {
11291 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%E1kODD} only has one parameter, seen {%1n} parameters", 76, NoOfParam);
11292 0 : M2Quads_PushTtok (M2Base_False, functok);
11293 : }
11294 44 : }
11295 :
11296 :
11297 : /*
11298 : BuildAbsFunction - builds a call to the standard function ABS.
11299 :
11300 : We cannot implement it as a macro or inline an
11301 : IF THEN statement as the IF THEN ELSE requires
11302 : we write the value to the same variable (or constant)
11303 : twice. The macro implementation will fail as
11304 : the compiler maybe building a function
11305 : call and expecting a ReturnVar on the stack.
11306 : The only method to implement this is to pass it to the
11307 : gcc backend.
11308 :
11309 : The Stack:
11310 :
11311 :
11312 : Entry Exit
11313 :
11314 : Ptr ->
11315 : +----------------+
11316 : | NoOfParam |
11317 : |----------------|
11318 : | Param 1 |
11319 : |----------------|
11320 : | Param 2 |
11321 : |----------------|
11322 : . .
11323 : . .
11324 : . .
11325 : |----------------|
11326 : | Param # |
11327 : |----------------|
11328 : | ProcSym | Type | Empty
11329 : |----------------|
11330 : */
11331 :
11332 177 : static void BuildAbsFunction (unsigned int ProcSym, bool ConstExpr)
11333 : {
11334 177 : unsigned int vartok;
11335 177 : unsigned int functok;
11336 177 : unsigned int combinedtok;
11337 177 : unsigned int NoOfParam;
11338 177 : unsigned int Res;
11339 177 : unsigned int Var;
11340 :
11341 177 : M2Quads_PopT (&NoOfParam);
11342 177 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11343 177 : if (NoOfParam == 1)
11344 : {
11345 177 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11346 177 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11347 177 : M2Quads_PopN (NoOfParam+1);
11348 177 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
11349 177 : if (ConstExprError (ProcSym, Var, vartok, ConstExpr))
11350 : {
11351 : /* Create fake result. */
11352 24 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11353 12 : SymbolTable_PutVar (Res, SymbolTable_GetSType (Var));
11354 12 : M2Quads_PushTFtok (Res, SymbolTable_GetSType (Var), combinedtok);
11355 : }
11356 165 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11357 : {
11358 : /* avoid dangling else. */
11359 316 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11360 158 : SymbolTable_PutVar (Res, SymbolTable_GetSType (Var));
11361 316 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, Res, ProcSym, Var, false);
11362 158 : M2Quads_PushTFtok (Res, SymbolTable_GetSType (Var), combinedtok);
11363 : }
11364 : else
11365 : {
11366 : /* avoid dangling else. */
11367 7 : M2MetaError_MetaErrorT1 (vartok, (const char *) "the parameter to {%AkABS} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11368 : }
11369 : }
11370 : else
11371 : {
11372 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkABS} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11373 : }
11374 170 : }
11375 :
11376 :
11377 : /*
11378 : BuildCapFunction - builds the pseudo procedure call CAP.
11379 : We generate a the following quad:
11380 :
11381 :
11382 : StandardFunctionOp ReturnVal Cap Param1
11383 :
11384 : The Stack:
11385 :
11386 :
11387 : Entry Exit
11388 :
11389 : Ptr ->
11390 : +----------------+
11391 : | NoOfParam = 1 |
11392 : |----------------|
11393 : | Param 1 |
11394 : |----------------| +-------------+
11395 : | ProcSym | Type | | ReturnVal |
11396 : |----------------| |-------------|
11397 : */
11398 :
11399 125 : static void BuildCapFunction (unsigned int ProcSym, bool ConstExpr)
11400 : {
11401 125 : unsigned int optok;
11402 125 : unsigned int functok;
11403 125 : unsigned int combinedtok;
11404 125 : unsigned int NoOfParam;
11405 125 : unsigned int Res;
11406 125 : unsigned int Var;
11407 :
11408 125 : M2Quads_PopT (&NoOfParam);
11409 125 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11410 125 : if (NoOfParam == 1)
11411 : {
11412 125 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11413 125 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11414 125 : M2Quads_PopN (NoOfParam+1);
11415 125 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11416 : {
11417 : /* Create fake result. */
11418 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11419 24 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11420 12 : SymbolTable_PutVar (Res, M2Base_Char);
11421 12 : M2Quads_PushTFtok (Res, M2Base_Char, combinedtok);
11422 : }
11423 113 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11424 : {
11425 : /* avoid dangling else. */
11426 112 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11427 224 : Res = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11428 112 : SymbolTable_PutVar (Res, M2Base_Char);
11429 224 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, Res, ProcSym, Var, false);
11430 112 : M2Quads_PushTFtok (Res, M2Base_Char, combinedtok);
11431 : }
11432 : else
11433 : {
11434 : /* avoid dangling else. */
11435 1 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%AkCAP} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11436 : }
11437 : }
11438 : else
11439 : {
11440 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkCAP} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11441 : }
11442 124 : }
11443 :
11444 :
11445 : /*
11446 : BuildChrFunction - builds the pseudo procedure call CHR.
11447 : This procedure is actually a "macro" for
11448 : CHR(x) --> CONVERT(CHAR, x)
11449 : However we cannot push tokens back onto the input stack
11450 : because the compiler is currently building a function
11451 : call and expecting a ReturnVar on the stack.
11452 : Hence we manipulate the stack and call
11453 : BuildConvertFunction.
11454 :
11455 : The Stack:
11456 :
11457 :
11458 : Entry Exit
11459 :
11460 : Ptr ->
11461 : +----------------+
11462 : | NoOfParam |
11463 : |----------------|
11464 : | Param 1 |
11465 : |----------------|
11466 : | Param 2 |
11467 : |----------------|
11468 : . .
11469 : . .
11470 : . .
11471 : |----------------|
11472 : | Param # |
11473 : |----------------|
11474 : | ProcSym | Type | Empty
11475 : |----------------|
11476 : */
11477 :
11478 1020 : static void BuildChrFunction (unsigned int ProcSym, bool ConstExpr)
11479 : {
11480 1020 : unsigned int functok;
11481 1020 : unsigned int combinedtok;
11482 1020 : unsigned int optok;
11483 1020 : unsigned int ReturnVar;
11484 1020 : unsigned int NoOfParam;
11485 1020 : unsigned int Var;
11486 :
11487 1020 : M2Quads_PopT (&NoOfParam);
11488 1020 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11489 1020 : if (NoOfParam == 1)
11490 : {
11491 1020 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11492 1020 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11493 1020 : M2Quads_PopN (NoOfParam+1);
11494 1020 : if (ConstExprError (ProcSym, Var, optok, ConstExpr))
11495 : {
11496 : /* Generate fake result. */
11497 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11498 24 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11499 12 : SymbolTable_PutVar (ReturnVar, M2Base_Char);
11500 12 : M2Quads_PushTFtok (ReturnVar, M2Base_Char, combinedtok);
11501 : }
11502 1008 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11503 : {
11504 : /* avoid dangling else. */
11505 : /*
11506 : Build macro: CONVERT( CHAR, Var )
11507 : */
11508 1007 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11509 1007 : M2Quads_PushTtok (M2Base_Char, functok);
11510 1007 : M2Quads_PushTtok (Var, optok);
11511 1007 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11512 1007 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11513 : }
11514 : else
11515 : {
11516 : /* avoid dangling else. */
11517 1 : M2MetaError_MetaErrorT1 (optok, (const char *) "the parameter to {%AkCHR} must be a variable or constant, seen {%1ad} {%1&s}", 76, Var);
11518 : }
11519 : }
11520 : else
11521 : {
11522 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%AkCHR} only has one parameter, seen {%1n} parameters", 75, NoOfParam);
11523 : }
11524 1019 : }
11525 :
11526 :
11527 : /*
11528 : BuildOrdFunction - builds the pseudo procedure call ORD.
11529 : This procedure is actually a "macro" for
11530 : ORD(x) --> CONVERT(GetSType(sym), x)
11531 : However we cannot push tokens back onto the input stack
11532 : because the compiler is currently building a function
11533 : call and expecting a ReturnVar on the stack.
11534 : Hence we manipulate the stack and call
11535 : BuildConvertFunction.
11536 :
11537 : The Stack:
11538 :
11539 :
11540 : Entry Exit
11541 :
11542 : Ptr ->
11543 : +----------------+
11544 : | NoOfParam |
11545 : |----------------|
11546 : | Param 1 |
11547 : |----------------|
11548 : | Param 2 |
11549 : |----------------|
11550 : . .
11551 : . .
11552 : . .
11553 : |----------------|
11554 : | Param # |
11555 : |----------------|
11556 : | ProcSym | Type | Empty
11557 : |----------------|
11558 : */
11559 :
11560 4708 : static void BuildOrdFunction (unsigned int Sym, bool ConstExpr)
11561 : {
11562 4708 : unsigned int combinedtok;
11563 4708 : unsigned int functok;
11564 4708 : unsigned int optok;
11565 4708 : unsigned int ReturnVar;
11566 4708 : unsigned int NoOfParam;
11567 4708 : unsigned int Type;
11568 4708 : unsigned int Var;
11569 :
11570 4708 : M2Quads_PopT (&NoOfParam);
11571 4708 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11572 4708 : if (NoOfParam == 1)
11573 : {
11574 4708 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11575 4708 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11576 4708 : M2Quads_PopN (NoOfParam+1);
11577 4708 : if (ConstExprError (Sym, Var, optok, ConstExpr))
11578 : {
11579 : /* Generate fake result. */
11580 12 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11581 24 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11582 12 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
11583 12 : M2Quads_PushTFtok (ReturnVar, M2Base_Cardinal, combinedtok);
11584 : }
11585 4696 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11586 : {
11587 : /* avoid dangling else. */
11588 4696 : Type = SymbolTable_GetSType (Sym);
11589 : /*
11590 : Build macro: CONVERT( CARDINAL, Var )
11591 : */
11592 4696 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11593 4696 : M2Quads_PushTtok (Type, optok);
11594 4696 : M2Quads_PushTtok (Var, optok);
11595 4696 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11596 4696 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11597 : }
11598 : else
11599 : {
11600 : /* avoid dangling else. */
11601 0 : M2MetaError_MetaErrorT2 (optok, (const char *) "the parameter to {%1Aa} must be a variable or constant, seen {%2ad} {%2&s}", 74, Sym, Var);
11602 : }
11603 : }
11604 : else
11605 : {
11606 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the pseudo procedure {%1Aa} only has one parameter, seen {%2n} parameters", 73, Sym, NoOfParam);
11607 : }
11608 4708 : }
11609 :
11610 :
11611 : /*
11612 : BuildIntFunction - builds the pseudo procedure call INT.
11613 : This procedure is actually a "macro" for
11614 : INT(x) --> CONVERT(INTEGER, x)
11615 : However we cannot push tokens back onto the input stack
11616 : because the compiler is currently building a function
11617 : call and expecting a ReturnVar on the stack.
11618 : Hence we manipulate the stack and call
11619 : BuildConvertFunction.
11620 :
11621 : The Stack:
11622 :
11623 :
11624 : Entry Exit
11625 :
11626 : Ptr ->
11627 : +----------------+
11628 : | NoOfParam |
11629 : |----------------|
11630 : | Param 1 |
11631 : |----------------|
11632 : | Param 2 |
11633 : |----------------|
11634 : . .
11635 : . .
11636 : . .
11637 : |----------------|
11638 : | Param # |
11639 : |----------------|
11640 : | ProcSym | Type | Empty
11641 : |----------------|
11642 : */
11643 :
11644 6 : static void BuildIntFunction (unsigned int Sym, bool ConstExpr)
11645 : {
11646 6 : unsigned int combinedtok;
11647 6 : unsigned int functok;
11648 6 : unsigned int optok;
11649 6 : unsigned int ReturnVar;
11650 6 : unsigned int NoOfParam;
11651 6 : unsigned int Type;
11652 6 : unsigned int Var;
11653 :
11654 6 : M2Quads_PopT (&NoOfParam);
11655 6 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11656 6 : if (NoOfParam == 1)
11657 : {
11658 6 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
11659 6 : optok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11660 6 : M2Quads_PopN (NoOfParam+1);
11661 6 : if (ConstExprError (Sym, Var, optok, ConstExpr))
11662 : {
11663 : /* Generate fake result. */
11664 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, optok);
11665 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
11666 6 : SymbolTable_PutVar (ReturnVar, M2Base_Integer);
11667 6 : M2Quads_PushTFtok (ReturnVar, M2Base_Integer, combinedtok);
11668 : }
11669 0 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
11670 : {
11671 : /* avoid dangling else. */
11672 0 : Type = SymbolTable_GetSType (Sym); /* return type of function */
11673 : /* Build macro: CONVERT( CARDINAL, Var ). */
11674 0 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
11675 0 : M2Quads_PushTtok (Type, functok);
11676 0 : M2Quads_PushTtok (Var, optok);
11677 0 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
11678 0 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* Two parameters */
11679 : }
11680 : else
11681 : {
11682 : /* avoid dangling else. */
11683 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, optok, optok);
11684 0 : M2MetaError_MetaErrorT2 (optok, (const char *) "the parameter to {%1Ea} must be a variable or constant, seen {%2ad} {%2&s}", 74, Sym, Var);
11685 0 : M2Quads_PushTtok (combinedtok, SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType));
11686 : }
11687 : }
11688 : else
11689 : {
11690 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the pseudo procedure {%1Ea} only has one parameter, seen {%2n} parameters", 73, Sym, NoOfParam);
11691 0 : M2Quads_PushTtok (functok, SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_ZType));
11692 : }
11693 6 : }
11694 :
11695 :
11696 : /*
11697 : BuildMakeAdrFunction - builds the pseudo procedure call MAKEADR.
11698 :
11699 : The Stack:
11700 :
11701 :
11702 : Entry Exit
11703 :
11704 : Ptr ->
11705 : +----------------+
11706 : | NoOfParam |
11707 : |----------------|
11708 : | Param 1 |
11709 : |----------------|
11710 : | Param 2 |
11711 : |----------------|
11712 : . .
11713 : . .
11714 : . .
11715 : |----------------|
11716 : | Param # |
11717 : |----------------|
11718 : | ProcSym | Type | Empty
11719 : |----------------|
11720 : */
11721 :
11722 12 : static void BuildMakeAdrFunction (void)
11723 : {
11724 12 : unsigned int functok;
11725 12 : unsigned int starttok;
11726 12 : unsigned int endtok;
11727 12 : unsigned int resulttok;
11728 12 : bool AreConst;
11729 12 : unsigned int i;
11730 12 : unsigned int pi;
11731 12 : unsigned int NoOfParameters;
11732 12 : unsigned int ReturnVar;
11733 :
11734 12 : M2Quads_PopT (&NoOfParameters);
11735 12 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParameters+1));
11736 12 : if (NoOfParameters > 0)
11737 : {
11738 12 : starttok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParameters+1)); /* ADR token. */
11739 12 : endtok = static_cast<unsigned int> (M2Quads_OperandTok (1)); /* last parameter. */
11740 24 : GenQuad (M2Quads_ParamOp, 0, M2System_MakeAdr, M2System_MakeAdr); /* last parameter. */
11741 12 : i = NoOfParameters;
11742 : /* stack index referencing stacked parameter, i */
11743 12 : pi = 1;
11744 24 : while (i > 0)
11745 : {
11746 12 : GenQuadO (M2Quads_OperandTok (pi), M2Quads_ParamOp, i, M2System_MakeAdr, M2Quads_OperandT (pi), true);
11747 12 : i -= 1;
11748 12 : pi += 1;
11749 : }
11750 : AreConst = true;
11751 : i = 1;
11752 24 : while (i <= NoOfParameters)
11753 : {
11754 12 : if (SymbolTable_IsVar (M2Quads_OperandT (i)))
11755 : {
11756 : AreConst = false;
11757 : }
11758 12 : else if (! (SymbolTable_IsConst (M2Quads_OperandT (i))))
11759 : {
11760 : /* avoid dangling else. */
11761 0 : M2MetaError_MetaError1 ((const char *) "problem in the {%1EN} argument for {%kMAKEADR}, all arguments to {%kMAKEADR} must be either variables or constants", 114, i);
11762 : }
11763 12 : i += 1;
11764 : }
11765 : /* ReturnVar - will have the type of the procedure */
11766 12 : resulttok = M2LexBuf_MakeVirtualTok (starttok, starttok, endtok);
11767 12 : ReturnVar = SymbolTable_MakeTemporary (resulttok, AreConstant (AreConst));
11768 12 : SymbolTable_PutVar (ReturnVar, SymbolTable_GetSType (M2System_MakeAdr));
11769 24 : GenQuadO (resulttok, M2Quads_FunctValueOp, ReturnVar, SymbolTable_NulSym, M2System_MakeAdr, true);
11770 12 : M2Quads_PopN (NoOfParameters+1);
11771 12 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (M2System_MakeAdr), resulttok);
11772 : }
11773 : else
11774 : {
11775 0 : M2MetaError_MetaError1 ((const char *) "the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%1n}", 77, NoOfParameters);
11776 0 : M2Quads_PopN (1);
11777 0 : M2Quads_PushTFtok (M2Base_Nil, SymbolTable_GetSType (M2System_MakeAdr), functok);
11778 : }
11779 12 : }
11780 :
11781 :
11782 : /*
11783 : BuildShiftFunction - builds the pseudo procedure call SHIFT.
11784 :
11785 : PROCEDURE SHIFT (val: <any type>;
11786 : num: INTEGER): <any type> ;
11787 :
11788 : "Returns a bit sequence obtained from val by
11789 : shifting up or down (left or right) by the
11790 : absolute value of num, introducing
11791 : zeros as necessary. The direction is down if
11792 : the sign of num is negative, otherwise the
11793 : direction is up."
11794 :
11795 : The Stack:
11796 :
11797 : Entry Exit
11798 :
11799 : Ptr ->
11800 : +----------------+
11801 : | NoOfParam |
11802 : |----------------|
11803 : | Param 1 |
11804 : |----------------|
11805 : | Param 2 | <- Ptr
11806 : |----------------| +------------+
11807 : | ProcSym | Type | | ReturnVar |
11808 : |----------------| |------------|
11809 : */
11810 :
11811 682 : static void BuildShiftFunction (void)
11812 : {
11813 682 : unsigned int combinedtok;
11814 682 : unsigned int paramtok;
11815 682 : unsigned int functok;
11816 682 : unsigned int vartok;
11817 682 : unsigned int exptok;
11818 682 : unsigned int r;
11819 682 : unsigned int procSym;
11820 682 : unsigned int returnVar;
11821 682 : unsigned int NoOfParam;
11822 682 : unsigned int derefExp;
11823 682 : unsigned int Exp;
11824 682 : unsigned int varSet;
11825 :
11826 682 : M2Quads_PopT (&NoOfParam);
11827 682 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
11828 682 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11829 682 : if (NoOfParam == 2)
11830 : {
11831 682 : PopTrwtok (&Exp, &r, &exptok);
11832 682 : MarkAsRead (r);
11833 682 : M2Quads_PopTtok (&varSet, &vartok);
11834 682 : M2Quads_PopT (&procSym);
11835 682 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
11836 682 : if (((SymbolTable_GetSType (varSet)) != SymbolTable_NulSym) && ((SymbolTable_IsSet (SymbolTable_GetDType (varSet))) || (M2System_IsGenericSystemType (SymbolTable_GetDType (varSet)))))
11837 : {
11838 682 : derefExp = DereferenceLValue (exptok, Exp);
11839 682 : BuildRange (M2Range_InitShiftCheck (varSet, derefExp));
11840 682 : returnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11841 682 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (varSet));
11842 1364 : GenQuadO (combinedtok, M2Quads_LogicalShiftOp, returnVar, varSet, derefExp, true);
11843 682 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (varSet), combinedtok);
11844 : }
11845 : else
11846 : {
11847 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);
11848 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, combinedtok);
11849 : }
11850 : }
11851 : else
11852 : {
11853 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
11854 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo procedure {%kSHIFT} requires at least two parameters, seen {%1En}", 76, NoOfParam);
11855 0 : M2Quads_PopN (NoOfParam+1);
11856 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, combinedtok);
11857 : }
11858 682 : }
11859 :
11860 :
11861 : /*
11862 : BuildRotateFunction - builds the pseudo procedure call ROTATE.
11863 :
11864 : PROCEDURE ROTATE (val: <any type>;
11865 : num: INTEGER): <any type> ;
11866 :
11867 : "Returns a bit sequence obtained from val
11868 : by rotating up or down (left or right) by
11869 : the absolute value of num. The direction is
11870 : down if the sign of num is negative, otherwise
11871 : the direction is up."
11872 :
11873 : The Stack:
11874 :
11875 : Entry Exit
11876 :
11877 : Ptr ->
11878 : +----------------+
11879 : | NoOfParam |
11880 : |----------------|
11881 : | Param 1 |
11882 : |----------------|
11883 : | Param 2 | <- Ptr
11884 : |----------------| +------------+
11885 : | ProcSym | Type | | ReturnVar |
11886 : |----------------| |------------|
11887 : */
11888 :
11889 406 : static void BuildRotateFunction (void)
11890 : {
11891 406 : unsigned int combinedtok;
11892 406 : unsigned int functok;
11893 406 : unsigned int vartok;
11894 406 : unsigned int exptok;
11895 406 : unsigned int r;
11896 406 : unsigned int procSym;
11897 406 : unsigned int returnVar;
11898 406 : unsigned int NoOfParam;
11899 406 : unsigned int derefExp;
11900 406 : unsigned int Exp;
11901 406 : unsigned int varSet;
11902 :
11903 406 : M2Quads_PopT (&NoOfParam);
11904 406 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11905 406 : if (NoOfParam == 2)
11906 : {
11907 406 : PopTrwtok (&Exp, &r, &exptok);
11908 406 : MarkAsRead (r);
11909 406 : M2Quads_PopTtok (&varSet, &vartok);
11910 406 : M2Quads_PopT (&procSym);
11911 406 : if (((SymbolTable_GetSType (varSet)) != SymbolTable_NulSym) && ((SymbolTable_IsSet (SymbolTable_GetDType (varSet))) || (M2System_IsGenericSystemType (SymbolTable_GetDType (varSet)))))
11912 : {
11913 406 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
11914 406 : derefExp = DereferenceLValue (exptok, Exp);
11915 406 : BuildRange (M2Range_InitRotateCheck (varSet, derefExp));
11916 406 : returnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
11917 406 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (varSet));
11918 812 : GenQuadO (combinedtok, M2Quads_LogicalRotateOp, returnVar, varSet, derefExp, true);
11919 406 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (varSet), combinedtok);
11920 : }
11921 : else
11922 : {
11923 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);
11924 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
11925 : }
11926 : }
11927 : else
11928 : {
11929 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "SYSTEM procedure {%EkROTATE} expects 2 parameters and was given {%1n} parameters", 80, NoOfParam);
11930 0 : M2Quads_PopN (NoOfParam+1);
11931 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal), M2Base_Cardinal, functok);
11932 : }
11933 406 : }
11934 :
11935 :
11936 : /*
11937 : BuildValFunction - builds the pseudo procedure call VAL.
11938 : This procedure is actually a "macro" for
11939 : VAL(Type, x) --> CONVERT(Type, x)
11940 : However we cannot push tokens back onto the input stack
11941 : because the compiler is currently building a function
11942 : call and expecting a ReturnVar on the stack.
11943 : Hence we manipulate the stack and call
11944 : BuildConvertFunction.
11945 :
11946 : The Stack:
11947 :
11948 :
11949 : Entry Exit
11950 :
11951 : Ptr ->
11952 : +----------------+
11953 : | NoOfParam |
11954 : |----------------|
11955 : | Param 1 |
11956 : |----------------|
11957 : | Param 2 |
11958 : |----------------|
11959 : . .
11960 : . .
11961 : . .
11962 : |----------------|
11963 : | Param # |
11964 : |----------------|
11965 : | ProcSym | Type | Empty
11966 : |----------------|
11967 : */
11968 :
11969 4922 : static void BuildValFunction (unsigned int ProcSym, bool ConstExpr)
11970 : {
11971 4922 : unsigned int combinedtok;
11972 4922 : unsigned int functok;
11973 4922 : unsigned int ReturnVar;
11974 4922 : unsigned int NoOfParam;
11975 4922 : unsigned int Exp;
11976 4922 : unsigned int Type;
11977 4922 : unsigned int tok;
11978 4922 : unsigned int r;
11979 4922 : unsigned int typetok;
11980 4922 : unsigned int exptok;
11981 :
11982 4922 : M2Quads_PopT (&NoOfParam);
11983 4922 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
11984 4922 : if (NoOfParam == 2)
11985 : {
11986 4922 : PopTrwtok (&Exp, &r, &exptok);
11987 4922 : MarkAsRead (r);
11988 4922 : M2Quads_PopTtok (&Type, &typetok);
11989 4922 : M2Quads_PopTtok (&ProcSym, &tok);
11990 4922 : if (SymbolTable_IsUnknown (Type))
11991 : {
11992 : /* It is sensible not to try and recover when we dont know the return type. */
11993 7 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type found in builtin procedure function {%AkVAL} {%1ad} {%1&Ts}", 75, Type);
11994 : /* Non recoverable error. */
11995 0 : SymbolTable_UnknownReported (Type);
11996 : }
11997 4915 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
11998 : {
11999 : /* avoid dangling else. */
12000 : /* Generate fake result. */
12001 6 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12002 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12003 6 : SymbolTable_PutVar (ReturnVar, Type);
12004 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12005 : }
12006 4909 : else if (SymbolTable_IsUnknown (Exp))
12007 : {
12008 : /* avoid dangling else. */
12009 : /* Spellcheck. */
12010 2 : M2MetaError_MetaErrorT1 (exptok, (const char *) "undeclared variable or constant expression found in builtin procedure function {%AkVAL} {%1ad} {%1&VCs}", 103, Exp);
12011 : /* Non recoverable error. */
12012 0 : SymbolTable_UnknownReported (Exp);
12013 : }
12014 4907 : 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))))
12015 : {
12016 : /* avoid dangling else. */
12017 : /*
12018 : Build macro: CONVERT( Type, Var )
12019 : */
12020 4907 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), tok);
12021 4907 : M2Quads_PushTtok (Type, typetok);
12022 4907 : M2Quads_PushTtok (Exp, exptok);
12023 4907 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
12024 4907 : BuildConvertFunction (M2Base_Convert, ConstExpr);
12025 : }
12026 : else
12027 : {
12028 : /* avoid dangling else. */
12029 : /* non recoverable error. */
12030 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkVAL} has the following formal parameter declaration {%kVAL} (type, expression)", 104);
12031 : }
12032 : }
12033 : else
12034 : {
12035 : /* non recoverable error. */
12036 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);
12037 : }
12038 4913 : }
12039 :
12040 :
12041 : /*
12042 : BuildCastFunction - builds the pseudo procedure call CAST.
12043 : This procedure is actually a "macro" for
12044 : CAST(Type, x) --> Type(x)
12045 : However we cannot push tokens back onto the input stack
12046 : because the compiler is currently building a function
12047 : call and expecting a ReturnVar on the stack.
12048 : Hence we manipulate the stack and call
12049 : BuildConvertFunction.
12050 :
12051 : The Stack:
12052 :
12053 :
12054 : Entry Exit
12055 :
12056 : Ptr ->
12057 : +----------------+
12058 : | NoOfParam |
12059 : |----------------|
12060 : | Param 1 |
12061 : |----------------|
12062 : | Param 2 |
12063 : |----------------|
12064 : . .
12065 : . .
12066 : . .
12067 : |----------------|
12068 : | Param # |
12069 : |----------------|
12070 : | ProcSym | Type | Empty
12071 : |----------------|
12072 : */
12073 :
12074 156 : static void BuildCastFunction (unsigned int ProcSym, bool ConstExpr)
12075 : {
12076 156 : unsigned int combinedtok;
12077 156 : unsigned int exptok;
12078 156 : unsigned int typetok;
12079 156 : unsigned int functok;
12080 156 : unsigned int ReturnVar;
12081 156 : unsigned int NoOfParam;
12082 156 : unsigned int Exp;
12083 156 : unsigned int Type;
12084 :
12085 156 : M2Quads_PopT (&NoOfParam);
12086 156 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
12087 156 : if (NoOfParam == 2)
12088 : {
12089 156 : Type = static_cast<unsigned int> (M2Quads_OperandT (2));
12090 156 : typetok = static_cast<unsigned int> (M2Quads_OperandTok (2));
12091 156 : Exp = static_cast<unsigned int> (M2Quads_OperandT (1));
12092 156 : exptok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12093 156 : if (SymbolTable_IsUnknown (Type))
12094 : {
12095 : /* We cannot recover if we dont have a type. */
12096 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type {%1Aad} found in {%kCAST} {%1&s}", 48, Type);
12097 : /* Non recoverable error. */
12098 0 : SymbolTable_UnknownReported (Type);
12099 : }
12100 156 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
12101 : {
12102 : /* avoid dangling else. */
12103 : /* Generate fake result. */
12104 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12105 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12106 0 : SymbolTable_PutVar (ReturnVar, Type);
12107 0 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12108 : }
12109 156 : else if (((((((SymbolTable_IsSet (Type)) || (SymbolTable_IsEnumeration (Type))) || (SymbolTable_IsSubrange (Type))) || (SymbolTable_IsType (Type))) || (SymbolTable_IsPointer (Type))) || (SymbolTable_IsArray (Type))) || (SymbolTable_IsProcType (Type)))
12110 : {
12111 : /* avoid dangling else. */
12112 156 : if (SymbolTable_IsConst (Exp))
12113 : {
12114 30 : M2Quads_PopN (NoOfParam+1);
12115 : /*
12116 : Build macro: Type( Var )
12117 : */
12118 30 : M2Quads_PushTFtok (Type, static_cast<unsigned int> (SymbolTable_NulSym), typetok);
12119 30 : M2Quads_PushTtok (Exp, exptok);
12120 30 : M2Quads_PushT (static_cast<unsigned int> (1)); /* one parameter */
12121 30 : BuildTypeCoercion (ConstExpr); /* one parameter */
12122 : }
12123 126 : else if ((SymbolTable_IsVar (Exp)) || (SymbolTable_IsProcedure (Exp)))
12124 : {
12125 : /* avoid dangling else. */
12126 126 : M2Quads_PopN (NoOfParam+1);
12127 126 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, exptok);
12128 126 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, SymbolTable_RightValue);
12129 126 : SymbolTable_PutVar (ReturnVar, Type);
12130 252 : GenQuadO (combinedtok, M2Quads_CastOp, ReturnVar, Type, Exp, false);
12131 126 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12132 : }
12133 : else
12134 : {
12135 : /* avoid dangling else. */
12136 : /* non recoverable error. */
12137 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);
12138 : }
12139 : }
12140 : else
12141 : {
12142 : /* avoid dangling else. */
12143 : /* non recoverable error. */
12144 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkCAST} has the following formal parameter declaration {%kCAST} (type, expression)", 106);
12145 : }
12146 : }
12147 : else
12148 : {
12149 : /* non recoverable error. */
12150 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);
12151 : }
12152 156 : }
12153 :
12154 :
12155 : /*
12156 : BuildConvertFunction - builds the pseudo function CONVERT.
12157 : CONVERT( Type, Variable ) ;
12158 :
12159 : The Stack:
12160 :
12161 :
12162 : Entry Exit
12163 :
12164 : Ptr ->
12165 : +----------------+
12166 : | NoOfParam |
12167 : |----------------|
12168 : | Param 1 |
12169 : |----------------|
12170 : | Param 2 |
12171 : |----------------|
12172 : . .
12173 : . .
12174 : . .
12175 : |----------------|
12176 : | Param # | <- Ptr
12177 : |----------------| +---------------------+
12178 : | ProcSym | Type | | ReturnVar | Param1 |
12179 : |----------------| |---------------------|
12180 :
12181 : Quadruples:
12182 :
12183 : ConvertOp ReturnVar Param1 Param2
12184 :
12185 : Converts variable Param2 into a variable Param1
12186 : with a type Param1.
12187 : */
12188 :
12189 56487 : static void BuildConvertFunction (unsigned int ProcSym, bool ConstExpr)
12190 : {
12191 56487 : unsigned int combinedtok;
12192 56487 : unsigned int functok;
12193 56487 : unsigned int typetok;
12194 56487 : unsigned int exptok;
12195 56487 : unsigned int t;
12196 56487 : unsigned int r;
12197 56487 : unsigned int Exp;
12198 56487 : unsigned int Type;
12199 56487 : unsigned int NoOfParam;
12200 56487 : unsigned int ReturnVar;
12201 :
12202 56487 : M2Quads_PopT (&NoOfParam);
12203 56487 : functok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfParam+1));
12204 56487 : if (NoOfParam == 2)
12205 : {
12206 56487 : PopTrwtok (&Exp, &r, &exptok);
12207 56487 : MarkAsRead (r);
12208 56487 : M2Quads_PopTtok (&Type, &typetok);
12209 56487 : M2Quads_PopT (&ProcSym);
12210 56487 : if (SymbolTable_IsUnknown (Type))
12211 : {
12212 : /* We cannot recover if we dont have a type. */
12213 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "undeclared type {%1Aad} found in {%kCONVERT} {%1&s}", 51, Type);
12214 : /* Non recoverable error. */
12215 0 : SymbolTable_UnknownReported (Type);
12216 : }
12217 56487 : else if (SymbolTable_IsUnknown (Exp))
12218 : {
12219 : /* avoid dangling else. */
12220 : /* We cannot recover if we dont have an expression. */
12221 0 : M2MetaError_MetaErrorT1 (typetok, (const char *) "unknown {%1Ad} {%1ad} found in {%kCONVERT} {%1&s}", 49, Exp);
12222 : /* Non recoverable error. */
12223 0 : SymbolTable_UnknownReported (Exp);
12224 : }
12225 56487 : else if (ConstExprError (ProcSym, Exp, exptok, ConstExpr))
12226 : {
12227 : /* avoid dangling else. */
12228 : /* Generate fake result. */
12229 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12230 0 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12231 0 : SymbolTable_PutVar (ReturnVar, Type);
12232 0 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12233 : }
12234 56487 : 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))))
12235 : {
12236 : /* avoid dangling else. */
12237 : /* firstly dereference Var */
12238 56481 : if ((SymbolTable_GetMode (Exp)) == SymbolTable_LeftValue)
12239 : {
12240 0 : t = SymbolTable_MakeTemporary (exptok, SymbolTable_RightValue);
12241 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (Exp));
12242 0 : CheckPointerThroughNil (exptok, Exp);
12243 0 : doIndrX (exptok, t, Exp);
12244 0 : Exp = t;
12245 : }
12246 56481 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, exptok);
12247 112962 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Exp)));
12248 56481 : SymbolTable_PutVar (ReturnVar, Type);
12249 112962 : GenQuadO (combinedtok, M2Quads_ConvertOp, ReturnVar, Type, Exp, true);
12250 56481 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12251 : }
12252 : else
12253 : {
12254 : /* avoid dangling else. */
12255 : /* non recoverable error. */
12256 6 : M2MetaError_MetaErrorT0 (functok, (const char *) "the builtin procedure {%AkCONVERT} has the following formal parameter declaration {%kCONVERT} (type, expression)", 112);
12257 : }
12258 : }
12259 : else
12260 : {
12261 : /* non recoverable error. */
12262 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);
12263 : }
12264 56481 : }
12265 :
12266 :
12267 : /*
12268 : CheckBaseTypeValue - checks to see whether the value, min, really exists.
12269 : */
12270 :
12271 2019 : static unsigned int CheckBaseTypeValue (unsigned int tok, unsigned int type, unsigned int min, unsigned int func)
12272 : {
12273 2019 : if (((type == M2Base_Real) || (type == M2Base_LongReal)) || (type == M2Base_ShortReal))
12274 : {
12275 102 : SymbolTable_PushValue (min);
12276 102 : if (! (M2ALU_IsValueAndTreeKnown ()))
12277 : {
12278 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1Ead} ({%2ad}) cannot be calculated at compile time for the target architecture", 81, func, type);
12279 0 : return SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType);
12280 : }
12281 : }
12282 : return min;
12283 : /* static analysis guarentees a RETURN statement will be used before here. */
12284 : __builtin_unreachable ();
12285 : }
12286 :
12287 :
12288 : /*
12289 : GetTypeMin - returns the minimium value of type and generate an error
12290 : if this is unavailable.
12291 : */
12292 :
12293 1324 : static unsigned int GetTypeMin (unsigned int tok, unsigned int func, unsigned int type)
12294 : {
12295 1324 : unsigned int min;
12296 :
12297 1324 : min = GetTypeMinLower (tok, func, type);
12298 1324 : if (min == SymbolTable_NulSym)
12299 : {
12300 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "unable to obtain the {%AkMIN} value for type {%1ad}", 51, type);
12301 : }
12302 1324 : return min;
12303 : /* static analysis guarentees a RETURN statement will be used before here. */
12304 : __builtin_unreachable ();
12305 : }
12306 :
12307 :
12308 : /*
12309 : GetTypeMinLower - obtain the maximum value for type.
12310 : */
12311 :
12312 1324 : static unsigned int GetTypeMinLower (unsigned int tok, unsigned int func, unsigned int type)
12313 : {
12314 1324 : unsigned int min;
12315 1324 : unsigned int max;
12316 :
12317 1324 : if (SymbolTable_IsSubrange (type))
12318 : {
12319 306 : min = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
12320 306 : SymbolTable_PutVar (min, type);
12321 612 : GenQuad (M2Quads_SubrangeLowOp, min, SymbolTable_NulSym, type);
12322 306 : return min;
12323 : }
12324 1018 : else if (SymbolTable_IsSet (SymbolTable_SkipType (type)))
12325 : {
12326 : /* avoid dangling else. */
12327 60 : return GetTypeMin (tok, func, SymbolTable_GetSType (SymbolTable_SkipType (type)));
12328 : }
12329 958 : else if ((M2Base_IsBaseType (type)) || (SymbolTable_IsEnumeration (type)))
12330 : {
12331 : /* avoid dangling else. */
12332 756 : M2Base_GetBaseTypeMinMax (type, &min, &max);
12333 756 : min = CheckBaseTypeValue (tok, type, min, func);
12334 756 : return min;
12335 : }
12336 202 : else if (M2System_IsSystemType (type))
12337 : {
12338 : /* avoid dangling else. */
12339 186 : M2System_GetSystemTypeMinMax (type, &min, &max);
12340 186 : return min;
12341 : }
12342 16 : else if ((SymbolTable_GetSType (type)) == SymbolTable_NulSym)
12343 : {
12344 : /* avoid dangling else. */
12345 : return SymbolTable_NulSym;
12346 : }
12347 : else
12348 : {
12349 : /* avoid dangling else. */
12350 16 : return GetTypeMin (tok, func, SymbolTable_GetSType (type));
12351 : }
12352 : /* static analysis guarentees a RETURN statement will be used before here. */
12353 : __builtin_unreachable ();
12354 : }
12355 :
12356 :
12357 : /*
12358 : GetTypeMax - returns the maximum value of type and generate an error
12359 : if this is unavailable.
12360 : */
12361 :
12362 2249 : static unsigned int GetTypeMax (unsigned int tok, unsigned int func, unsigned int type)
12363 : {
12364 2249 : unsigned int max;
12365 :
12366 2249 : max = GetTypeMaxLower (tok, func, type);
12367 2249 : if (max == SymbolTable_NulSym)
12368 : {
12369 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "unable to obtain the {%AkMAX} value for type {%1ad}", 51, type);
12370 : }
12371 2249 : return max;
12372 : /* static analysis guarentees a RETURN statement will be used before here. */
12373 : __builtin_unreachable ();
12374 : }
12375 :
12376 :
12377 : /*
12378 : GetTypeMaxLower - obtain the maximum value for type.
12379 : */
12380 :
12381 2249 : static unsigned int GetTypeMaxLower (unsigned int tok, unsigned int func, unsigned int type)
12382 : {
12383 2249 : unsigned int min;
12384 2249 : unsigned int max;
12385 :
12386 2249 : if (SymbolTable_IsSubrange (type))
12387 : {
12388 558 : max = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
12389 558 : SymbolTable_PutVar (max, type);
12390 1116 : GenQuad (M2Quads_SubrangeHighOp, max, SymbolTable_NulSym, type);
12391 558 : return max;
12392 : }
12393 1691 : else if (SymbolTable_IsSet (SymbolTable_SkipType (type)))
12394 : {
12395 : /* avoid dangling else. */
12396 210 : return GetTypeMax (tok, func, SymbolTable_GetSType (SymbolTable_SkipType (type)));
12397 : }
12398 1481 : else if ((M2Base_IsBaseType (type)) || (SymbolTable_IsEnumeration (type)))
12399 : {
12400 : /* avoid dangling else. */
12401 1263 : M2Base_GetBaseTypeMinMax (type, &min, &max);
12402 1263 : min = CheckBaseTypeValue (tok, type, min, func);
12403 1263 : return max;
12404 : }
12405 218 : else if (M2System_IsSystemType (type))
12406 : {
12407 : /* avoid dangling else. */
12408 202 : M2System_GetSystemTypeMinMax (type, &min, &max);
12409 202 : return max;
12410 : }
12411 16 : else if ((SymbolTable_GetSType (type)) == SymbolTable_NulSym)
12412 : {
12413 : /* avoid dangling else. */
12414 : return SymbolTable_NulSym;
12415 : }
12416 : else
12417 : {
12418 : /* avoid dangling else. */
12419 16 : return GetTypeMax (tok, func, SymbolTable_GetSType (type));
12420 : }
12421 : /* static analysis guarentees a RETURN statement will be used before here. */
12422 : __builtin_unreachable ();
12423 : }
12424 :
12425 :
12426 : /*
12427 : BuildMinFunction - builds the pseudo function call Min.
12428 :
12429 : The Stack:
12430 :
12431 : Entry Exit
12432 :
12433 : Ptr ->
12434 : +----------------+
12435 : | NoOfParam=1 |
12436 : |----------------|
12437 : | Param 1 |
12438 : |----------------|
12439 : | ProcSym | Type | Empty
12440 : |----------------|
12441 : */
12442 :
12443 1248 : static void BuildMinFunction (void)
12444 : {
12445 1248 : unsigned int combinedtok;
12446 1248 : unsigned int functok;
12447 1248 : unsigned int vartok;
12448 1248 : unsigned int func;
12449 1248 : unsigned int min;
12450 1248 : unsigned int NoOfParam;
12451 1248 : unsigned int Var;
12452 :
12453 1248 : M2Quads_PopT (&NoOfParam);
12454 1248 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12455 1248 : functok = OperandTtok (NoOfParam+1);
12456 1248 : if (NoOfParam == 1)
12457 : {
12458 1248 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12459 1248 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12460 1248 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12461 1248 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok); /* destroy arguments to this function */
12462 1248 : if (SymbolTable_IsAModula2Type (Var))
12463 : {
12464 1224 : min = GetTypeMin (vartok, func, Var);
12465 1224 : M2Quads_PushTFtok (min, SymbolTable_GetSType (min), combinedtok);
12466 : }
12467 24 : else if (SymbolTable_IsVar (Var))
12468 : {
12469 : /* avoid dangling else. */
12470 24 : min = GetTypeMin (vartok, func, SymbolTable_GetSType (Var));
12471 24 : M2Quads_PushTFtok (min, SymbolTable_GetSType (Var), combinedtok);
12472 : }
12473 : else
12474 : {
12475 : /* avoid dangling else. */
12476 : /* non recoverable error. */
12477 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "parameter to {%AkMIN} must be a type or a variable, seen {%1ad} {%1&s}", 70, Var);
12478 : }
12479 : }
12480 : else
12481 : {
12482 : /* non recoverable error. */
12483 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkMIN} only has one parameter, seen {%1n}", 82, NoOfParam);
12484 : }
12485 1248 : }
12486 :
12487 :
12488 : /*
12489 : BuildMaxFunction - builds the pseudo function call Max.
12490 :
12491 : The Stack:
12492 :
12493 : Entry Exit
12494 :
12495 : Ptr ->
12496 : +----------------+
12497 : | NoOfParam=1 |
12498 : |----------------|
12499 : | Param 1 |
12500 : |----------------|
12501 : | ProcSym | Type | Empty
12502 : |----------------|
12503 : */
12504 :
12505 2023 : static void BuildMaxFunction (void)
12506 : {
12507 2023 : unsigned int combinedtok;
12508 2023 : unsigned int functok;
12509 2023 : unsigned int vartok;
12510 2023 : unsigned int func;
12511 2023 : unsigned int max;
12512 2023 : unsigned int NoOfParam;
12513 2023 : unsigned int Var;
12514 :
12515 2023 : M2Quads_PopT (&NoOfParam);
12516 2023 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12517 2023 : functok = OperandTtok (NoOfParam+1);
12518 2023 : if (NoOfParam == 1)
12519 : {
12520 2023 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12521 2023 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12522 2023 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12523 2023 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok); /* destroy arguments to this function */
12524 2023 : if (SymbolTable_IsAModula2Type (Var))
12525 : {
12526 2023 : max = GetTypeMax (vartok, func, Var);
12527 2023 : M2Quads_PushTFtok (max, SymbolTable_GetSType (max), combinedtok);
12528 : }
12529 0 : else if (SymbolTable_IsVar (Var))
12530 : {
12531 : /* avoid dangling else. */
12532 0 : max = GetTypeMax (vartok, func, SymbolTable_GetSType (Var));
12533 0 : M2Quads_PushTFtok (max, SymbolTable_GetSType (Var), combinedtok);
12534 : }
12535 : else
12536 : {
12537 : /* avoid dangling else. */
12538 : /* non recoverable error. */
12539 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "parameter to {%AkMAX} must be a type or a variable, seen {%1ad} {%1&s}", 70, Var);
12540 : }
12541 : }
12542 : else
12543 : {
12544 : /* non recoverable error. */
12545 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkMAX} only has one parameter, seen {%1n}", 81, NoOfParam);
12546 : }
12547 2023 : }
12548 :
12549 :
12550 : /*
12551 : BuildTruncFunction - builds the pseudo procedure call TRUNC.
12552 : This procedure is actually a "macro" for
12553 : TRUNC(x) --> CONVERT(INTEGER, x)
12554 : However we cannot push tokens back onto the input stack
12555 : because the compiler is currently building a function
12556 : call and expecting a ReturnVar on the stack.
12557 : Hence we manipulate the stack and call
12558 : BuildConvertFunction.
12559 :
12560 : The Stack:
12561 :
12562 :
12563 : Entry Exit
12564 :
12565 : Ptr ->
12566 : +----------------+
12567 : | NoOfParam |
12568 : |----------------|
12569 : | Param 1 |
12570 : |----------------|
12571 : | Param 2 |
12572 : |----------------|
12573 : . .
12574 : . .
12575 : . .
12576 : |----------------|
12577 : | Param # |
12578 : |----------------|
12579 : | ProcSym | Type | Empty
12580 : |----------------|
12581 : */
12582 :
12583 60 : static void BuildTruncFunction (unsigned int Sym, bool ConstExpr)
12584 : {
12585 60 : unsigned int combinedtok;
12586 60 : unsigned int vartok;
12587 60 : unsigned int functok;
12588 60 : unsigned int NoOfParam;
12589 60 : unsigned int ReturnVar;
12590 60 : unsigned int ProcSym;
12591 60 : unsigned int Type;
12592 60 : unsigned int Var;
12593 :
12594 60 : M2Quads_PopT (&NoOfParam);
12595 60 : M2Debug_Assert (M2Base_IsTrunc (M2Quads_OperandT (NoOfParam+1)));
12596 60 : functok = OperandTtok (NoOfParam+1);
12597 60 : if (NoOfParam == 1)
12598 : {
12599 60 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "CONVERT", 7));
12600 60 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
12601 : {
12602 60 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12603 60 : vartok = OperandTtok (1);
12604 60 : Type = SymbolTable_GetSType (Sym);
12605 60 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12606 60 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12607 : {
12608 : /* Generate fake result. */
12609 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12610 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12611 6 : SymbolTable_PutVar (ReturnVar, Type);
12612 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12613 : }
12614 54 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12615 : {
12616 : /* avoid dangling else. */
12617 54 : if (M2Base_IsRealType (SymbolTable_GetSType (Var)))
12618 : {
12619 : /* build macro: CONVERT( INTEGER, Var ). */
12620 54 : M2Quads_PushTFtok (ProcSym, static_cast<unsigned int> (SymbolTable_NulSym), functok);
12621 54 : M2Quads_PushTtok (Type, functok);
12622 54 : M2Quads_PushTtok (Var, vartok);
12623 54 : M2Quads_PushT (static_cast<unsigned int> (2)); /* two parameters */
12624 54 : BuildConvertFunction (M2Base_Convert, ConstExpr); /* two parameters */
12625 : }
12626 : else
12627 : {
12628 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "argument to {%1Ead} must be a float point type", 46, Sym);
12629 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), Type), Type, functok);
12630 : }
12631 : }
12632 : else
12633 : {
12634 : /* avoid dangling else. */
12635 0 : M2MetaError_MetaErrorT2 (vartok, (const char *) "argument to {%1Ead} must be a variable or constant, seen {%2ad} {%2&s}", 70, Sym, Var);
12636 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), Type), Type, functok);
12637 : }
12638 : }
12639 : else
12640 : {
12641 0 : M2Error_InternalError ((const char *) "CONVERT procedure not found for TRUNC substitution", 50);
12642 : }
12643 : }
12644 : else
12645 : {
12646 : /* non recoverable error. */
12647 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the pseudo builtin procedure function {%AkTRUNC} only has one parameter, seen {%1n}", 84, NoOfParam);
12648 : }
12649 60 : }
12650 :
12651 :
12652 : /*
12653 : BuildFloatFunction - builds the pseudo procedure call FLOAT.
12654 : This procedure is actually a "macro" for
12655 : FLOAT(x) --> CONVERT(REAL, x)
12656 : However we cannot push tokens back onto the input stack
12657 : because the compiler is currently building a function
12658 : call and expecting a ReturnVar on the stack.
12659 : Hence we manipulate the stack and call
12660 : BuildConvertFunction.
12661 :
12662 : The Stack:
12663 :
12664 :
12665 : Entry Exit
12666 :
12667 : Ptr ->
12668 : +----------------+
12669 : | NoOfParam |
12670 : |----------------|
12671 : | Param 1 |
12672 : |----------------|
12673 : | Param 2 |
12674 : |----------------|
12675 : . .
12676 : . .
12677 : . .
12678 : |----------------|
12679 : | Param # |
12680 : |----------------|
12681 : | ProcSym | Type | Empty
12682 : |----------------|
12683 : */
12684 :
12685 88 : static void BuildFloatFunction (unsigned int Sym, bool ConstExpr)
12686 : {
12687 88 : unsigned int combinedtok;
12688 88 : unsigned int vartok;
12689 88 : unsigned int functok;
12690 88 : unsigned int NoOfParam;
12691 88 : unsigned int ReturnVar;
12692 88 : unsigned int Type;
12693 88 : unsigned int Var;
12694 88 : unsigned int ProcSym;
12695 :
12696 88 : M2Quads_PopT (&NoOfParam);
12697 88 : functok = OperandTtok (NoOfParam+1);
12698 88 : Type = SymbolTable_GetSType (Sym);
12699 88 : if (NoOfParam == 1)
12700 : {
12701 88 : ProcSym = SymbolTable_RequestSym (functok, NameKey_MakeKey ((const char *) "CONVERT", 7));
12702 88 : if ((ProcSym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (ProcSym)))
12703 : {
12704 88 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12705 88 : vartok = OperandTtok (1);
12706 88 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function. */
12707 88 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12708 : {
12709 : /* Generate fake result. */
12710 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12711 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12712 6 : SymbolTable_PutVar (ReturnVar, Type);
12713 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12714 : }
12715 82 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12716 : {
12717 : /* avoid dangling else. */
12718 : /* build macro: CONVERT (REAL, Var). */
12719 82 : M2Quads_PushTFtok (ProcSym, static_cast<unsigned int> (SymbolTable_NulSym), functok);
12720 82 : M2Quads_PushTtok (Type, functok);
12721 82 : M2Quads_PushTtok (Var, vartok);
12722 82 : M2Quads_PushT (static_cast<unsigned int> (2)); /* two parameters. */
12723 82 : BuildConvertFunction (ProcSym, ConstExpr); /* two parameters. */
12724 : }
12725 : else
12726 : {
12727 : /* avoid dangling else. */
12728 0 : M2MetaError_MetaErrorT1 (vartok, (const char *) "argument to {%1Ead} must be a variable or constant", 50, ProcSym);
12729 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0.0", 3), Type), Type, functok);
12730 : }
12731 : }
12732 : else
12733 : {
12734 0 : M2Error_InternalError ((const char *) "CONVERT procedure not found for FLOAT substitution", 50);
12735 : }
12736 : }
12737 : else
12738 : {
12739 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function. */
12740 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter", 61, Sym); /* destroy arguments to this function. */
12741 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0.0", 3), Type), Type, functok);
12742 : }
12743 88 : }
12744 :
12745 :
12746 : /*
12747 : BuildReFunction - builds the pseudo procedure call RE.
12748 :
12749 : The Stack:
12750 :
12751 :
12752 : Entry Exit
12753 :
12754 : Ptr ->
12755 : +----------------+
12756 : | NoOfParam |
12757 : |----------------|
12758 : | Param 1 |
12759 : |----------------|
12760 : | Param 2 |
12761 : |----------------|
12762 : . .
12763 : . .
12764 : . .
12765 : |----------------|
12766 : | Param # |
12767 : |----------------|
12768 : | ProcSym | Type | Empty
12769 : |----------------|
12770 : */
12771 :
12772 84 : static void BuildReFunction (unsigned int Sym, bool ConstExpr)
12773 : {
12774 84 : unsigned int func;
12775 84 : unsigned int combinedtok;
12776 84 : unsigned int vartok;
12777 84 : unsigned int functok;
12778 84 : unsigned int NoOfParam;
12779 84 : unsigned int ReturnVar;
12780 84 : unsigned int Type;
12781 84 : unsigned int Var;
12782 :
12783 84 : M2Quads_PopT (&NoOfParam);
12784 84 : functok = OperandTtok (NoOfParam+1);
12785 84 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12786 84 : if (NoOfParam == 1)
12787 : {
12788 84 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12789 84 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12790 84 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
12791 84 : Type = M2Base_ComplexToScalar (SymbolTable_GetDType (Var));
12792 84 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12793 84 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12794 : {
12795 : /* Generate fake result. */
12796 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12797 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12798 6 : SymbolTable_PutVar (ReturnVar, Type);
12799 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12800 : }
12801 78 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12802 : {
12803 : /* avoid dangling else. */
12804 156 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12805 78 : SymbolTable_PutVar (ReturnVar, Type);
12806 156 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Re, Var, false);
12807 78 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12808 : }
12809 : else
12810 : {
12811 : /* avoid dangling else. */
12812 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, combinedtok);
12813 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);
12814 : }
12815 : }
12816 : else
12817 : {
12818 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12819 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, functok); /* destroy arguments to this function */
12820 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter, seen {%2n}", 73, func, NoOfParam);
12821 : }
12822 84 : }
12823 :
12824 :
12825 : /*
12826 : BuildImFunction - builds the pseudo procedure call IM.
12827 :
12828 : The Stack:
12829 :
12830 :
12831 : Entry Exit
12832 :
12833 : Ptr ->
12834 : +----------------+
12835 : | NoOfParam |
12836 : |----------------|
12837 : | Param 1 |
12838 : |----------------|
12839 : | Param 2 |
12840 : |----------------|
12841 : . .
12842 : . .
12843 : . .
12844 : |----------------|
12845 : | Param # |
12846 : |----------------|
12847 : | ProcSym | Type | Empty
12848 : |----------------|
12849 : */
12850 :
12851 84 : static void BuildImFunction (unsigned int Sym, bool ConstExpr)
12852 : {
12853 84 : unsigned int func;
12854 84 : unsigned int combinedtok;
12855 84 : unsigned int vartok;
12856 84 : unsigned int functok;
12857 84 : unsigned int NoOfParam;
12858 84 : unsigned int ReturnVar;
12859 84 : unsigned int Type;
12860 84 : unsigned int Var;
12861 :
12862 84 : M2Quads_PopT (&NoOfParam);
12863 84 : functok = OperandTtok (NoOfParam+1);
12864 84 : func = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
12865 84 : if (NoOfParam == 1)
12866 : {
12867 84 : Var = static_cast<unsigned int> (M2Quads_OperandT (1));
12868 84 : vartok = static_cast<unsigned int> (M2Quads_OperandTok (1));
12869 84 : Type = M2Base_ComplexToScalar (SymbolTable_GetDType (Var));
12870 84 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, vartok);
12871 84 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12872 84 : if (ConstExprError (Sym, Var, vartok, ConstExpr))
12873 : {
12874 : /* Generate fake result. */
12875 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, vartok);
12876 12 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12877 6 : SymbolTable_PutVar (ReturnVar, Type);
12878 6 : M2Quads_PushTFtok (ReturnVar, Type, combinedtok);
12879 : }
12880 78 : else if ((SymbolTable_IsVar (Var)) || (SymbolTable_IsConst (Var)))
12881 : {
12882 : /* avoid dangling else. */
12883 156 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant (SymbolTable_IsConst (Var)));
12884 78 : SymbolTable_PutVar (ReturnVar, M2Base_ComplexToScalar (SymbolTable_GetDType (Var)));
12885 156 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Im, Var, false);
12886 78 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ReturnVar), combinedtok);
12887 : }
12888 : else
12889 : {
12890 : /* avoid dangling else. */
12891 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, combinedtok);
12892 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);
12893 : }
12894 : }
12895 : else
12896 : {
12897 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12898 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_RType), M2Base_RType, functok); /* destroy arguments to this function */
12899 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure function {%1Ead} only has one parameter, seen {%2n}", 73, func, NoOfParam);
12900 : }
12901 84 : }
12902 :
12903 :
12904 : /*
12905 : BuildCmplxFunction - builds the pseudo procedure call CMPLX.
12906 :
12907 : The Stack:
12908 :
12909 :
12910 : Entry Exit
12911 :
12912 : Ptr ->
12913 : +----------------+
12914 : | NoOfParam |
12915 : |----------------|
12916 : | Param 1 |
12917 : |----------------|
12918 : | Param 2 |
12919 : |----------------|
12920 : . .
12921 : . .
12922 : . .
12923 : |----------------|
12924 : | Param # |
12925 : |----------------|
12926 : | ProcSym | Type | Empty
12927 : |----------------|
12928 : */
12929 :
12930 612 : static void BuildCmplxFunction (unsigned int func, bool ConstExpr)
12931 : {
12932 612 : bool failure;
12933 612 : unsigned int functok;
12934 612 : unsigned int rtok;
12935 612 : unsigned int ltok;
12936 612 : unsigned int combinedtok;
12937 612 : unsigned int NoOfParam;
12938 612 : unsigned int type;
12939 612 : unsigned int ReturnVar;
12940 612 : unsigned int l;
12941 612 : unsigned int r;
12942 :
12943 612 : M2Quads_PopT (&NoOfParam);
12944 612 : functok = OperandTtok (NoOfParam+1);
12945 612 : if (NoOfParam == 2)
12946 : {
12947 612 : l = static_cast<unsigned int> (M2Quads_OperandT (2));
12948 612 : ltok = OperandTtok (2);
12949 612 : r = static_cast<unsigned int> (M2Quads_OperandT (1));
12950 612 : rtok = OperandTtok (1);
12951 612 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, rtok);
12952 612 : M2Quads_PopN (NoOfParam+1); /* Destroy arguments to this function. */
12953 612 : type = M2Base_GetCmplxReturnType (SymbolTable_GetDType (l), SymbolTable_GetDType (r)); /* Destroy arguments to this function. */
12954 738 : ReturnVar = SymbolTable_MakeTemporary (combinedtok, AreConstant ((SymbolTable_IsConst (l)) && (SymbolTable_IsConst (r))));
12955 612 : SymbolTable_PutVar (ReturnVar, type);
12956 612 : failure = false;
12957 612 : if (ConstExprError (func, l, ltok, ConstExpr))
12958 : {
12959 : /* ConstExprError has generated an error message we will fall through
12960 : and check the right operand. */
12961 : failure = true;
12962 : }
12963 612 : if (ConstExprError (func, r, rtok, ConstExpr))
12964 : {
12965 : /* Right operand is in error as a variable. */
12966 : failure = true;
12967 : }
12968 606 : if (failure)
12969 : {
12970 : /* Generate a fake result if either operand was a variable (and we
12971 : are in a const expression). */
12972 6 : M2Quads_PushTFtok (ReturnVar, type, combinedtok);
12973 : }
12974 606 : else if (((SymbolTable_IsVar (l)) || (SymbolTable_IsConst (l))) && ((SymbolTable_IsVar (r)) || (SymbolTable_IsConst (r))))
12975 : {
12976 : /* avoid dangling else. */
12977 606 : M2Base_CheckExpressionCompatible (combinedtok, SymbolTable_GetSType (l), SymbolTable_GetSType (r));
12978 606 : GenQuadO (combinedtok, M2Quads_StandardFunctionOp, ReturnVar, M2Base_Cmplx, SymbolTable_Make2Tuple (l, r), true);
12979 606 : M2Quads_PushTFtok (ReturnVar, type, combinedtok);
12980 : }
12981 : else
12982 : {
12983 : /* avoid dangling else. */
12984 0 : if ((SymbolTable_IsVar (l)) || (SymbolTable_IsConst (l)))
12985 : {
12986 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);
12987 : }
12988 : else
12989 : {
12990 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);
12991 : }
12992 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_CType), M2Base_CType, combinedtok);
12993 : }
12994 : }
12995 : else
12996 : {
12997 0 : M2MetaError_MetaErrorT2 (functok, (const char *) "the builtin procedure {%1Ead} requires two parameters, seen {%2n}", 65, func, NoOfParam);
12998 0 : M2Quads_PopN (NoOfParam+1); /* destroy arguments to this function */
12999 0 : M2Quads_PushTFtok (SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "1.0", 3), M2Base_CType), M2Base_CType, functok); /* destroy arguments to this function */
13000 : }
13001 612 : }
13002 :
13003 :
13004 : /*
13005 : BuildAdrFunction - builds the pseudo function ADR
13006 : The Stack:
13007 :
13008 :
13009 : Entry Exit
13010 :
13011 : Ptr ->
13012 : +----------------+
13013 : | NoOfParam |
13014 : |----------------|
13015 : | Param 1 |
13016 : |----------------|
13017 : | Param 2 |
13018 : |----------------|
13019 : . .
13020 : . .
13021 : . .
13022 : |----------------|
13023 : | Param # | <- Ptr
13024 : |----------------| +------------+
13025 : | ProcSym | Type | | ReturnVar |
13026 : |----------------| |------------|
13027 :
13028 : */
13029 :
13030 177984 : static void BuildAdrFunction (void)
13031 : {
13032 177984 : unsigned int param;
13033 177984 : unsigned int paramTok;
13034 177984 : unsigned int combinedTok;
13035 177984 : unsigned int procTok;
13036 177984 : unsigned int t;
13037 177984 : unsigned int UnboundedSym;
13038 177984 : unsigned int Dim;
13039 177984 : unsigned int Field;
13040 177984 : unsigned int noOfParameters;
13041 177984 : unsigned int procSym;
13042 177984 : unsigned int returnVar;
13043 177984 : unsigned int Type;
13044 177984 : unsigned int rw;
13045 :
13046 177984 : M2Quads_DisplayStack ();
13047 177984 : M2Quads_PopT (&noOfParameters);
13048 177984 : procSym = static_cast<unsigned int> (M2Quads_OperandT (noOfParameters+1));
13049 177984 : procTok = static_cast<unsigned int> (M2Quads_OperandTok (noOfParameters+1)); /* token of procedure ADR. */
13050 177984 : paramTok = static_cast<unsigned int> (M2Quads_OperandTok (1)); /* last parameter. */
13051 177984 : param = static_cast<unsigned int> (M2Quads_OperandT (1)); /* last parameter. */
13052 177984 : combinedTok = M2LexBuf_MakeVirtualTok (procTok, procTok, static_cast<unsigned int> (M2Reserved_endtok));
13053 177984 : if (noOfParameters != 1)
13054 : {
13055 0 : M2MetaError_MetaErrorNT0 (combinedTok, (const char *) "SYSTEM procedure ADR expects 1 parameter", 40);
13056 0 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13057 0 : M2Quads_PushTF (M2Base_Nil, M2System_Address); /* destroy the arguments and function */
13058 : }
13059 177984 : else if (SymbolTable_IsConstString (param))
13060 : {
13061 : /* avoid dangling else. */
13062 170243 : returnVar = MakeLeftValue (combinedTok, param, SymbolTable_RightValue, SymbolTable_GetSType (procSym));
13063 170243 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13064 170243 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (returnVar), combinedTok); /* destroy the arguments and function */
13065 : }
13066 7741 : else if ((! (SymbolTable_IsVar (param))) && (! (SymbolTable_IsProcedure (param))))
13067 : {
13068 : /* avoid dangling else. */
13069 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);
13070 1 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13071 1 : M2Quads_PushTFtok (M2Base_Nil, M2System_Address, combinedTok); /* destroy the arguments and function */
13072 : }
13073 7740 : else if (SymbolTable_IsProcedure (param))
13074 : {
13075 : /* avoid dangling else. */
13076 24 : returnVar = MakeLeftValue (combinedTok, param, SymbolTable_RightValue, SymbolTable_GetSType (procSym));
13077 24 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13078 24 : M2Quads_PushTFtok (returnVar, SymbolTable_GetSType (returnVar), combinedTok); /* destroy the arguments and function */
13079 : }
13080 : else
13081 : {
13082 : /* avoid dangling else. */
13083 7716 : Type = SymbolTable_GetSType (param);
13084 7716 : Dim = static_cast<unsigned int> (OperandD (1));
13085 7716 : MarkArrayWritten (param);
13086 7716 : MarkArrayWritten (M2Quads_OperandA (1));
13087 : /* if the operand is an unbounded which has not been indexed
13088 : then we will lookup its address from the unbounded record.
13089 : Otherwise we obtain the address of the operand.
13090 : */
13091 7716 : if ((SymbolTable_IsUnbounded (Type)) && (Dim == 0))
13092 : {
13093 : /* we will reference the address field of the unbounded structure */
13094 2369 : UnboundedSym = param;
13095 2369 : rw = static_cast<unsigned int> (OperandRW (1));
13096 2369 : PushTFrw (UnboundedSym, SymbolTable_GetSType (UnboundedSym), rw);
13097 2369 : Field = SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (UnboundedSym));
13098 2369 : M2Quads_PushTF (Field, SymbolTable_GetSType (Field));
13099 2369 : M2Quads_PushT (static_cast<unsigned int> (1));
13100 2369 : M2Quads_BuildDesignatorRecord (combinedTok);
13101 2369 : PopTrw (&returnVar, &rw);
13102 2369 : if ((SymbolTable_GetMode (returnVar)) == SymbolTable_LeftValue)
13103 : {
13104 0 : t = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13105 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (procSym));
13106 0 : doIndrX (combinedTok, t, returnVar);
13107 0 : returnVar = t;
13108 : }
13109 : else
13110 : {
13111 : /* we need to cast returnVar into ADDRESS */
13112 2369 : t = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13113 2369 : SymbolTable_PutVar (t, SymbolTable_GetSType (procSym));
13114 2369 : GenQuadO (combinedTok, M2Quads_ConvertOp, t, SymbolTable_GetSType (procSym), returnVar, false);
13115 2369 : returnVar = t;
13116 : }
13117 : }
13118 : else
13119 : {
13120 5347 : returnVar = SymbolTable_MakeTemporary (combinedTok, SymbolTable_RightValue);
13121 5347 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (procSym));
13122 5347 : if ((SymbolTable_GetMode (param)) == SymbolTable_LeftValue)
13123 : {
13124 439 : SymbolTable_PutVar (returnVar, SymbolTable_GetSType (procSym));
13125 439 : GenQuadO (combinedTok, M2Quads_ConvertOp, returnVar, SymbolTable_GetSType (procSym), param, false);
13126 : }
13127 : else
13128 : {
13129 4908 : GenQuadO (combinedTok, M2Quads_AddrOp, returnVar, SymbolTable_NulSym, param, false);
13130 : }
13131 5347 : SymbolTable_PutWriteQuad (param, SymbolTable_GetMode (param), NextQuad-1);
13132 5347 : rw = static_cast<unsigned int> (OperandMergeRW (1));
13133 5347 : M2Debug_Assert (SymbolTable_IsLegal (rw));
13134 : }
13135 7716 : M2Quads_PopN (noOfParameters+1); /* destroy the arguments and function */
13136 7716 : PushTFrwtok (returnVar, SymbolTable_GetSType (returnVar), rw, combinedTok); /* destroy the arguments and function */
13137 : }
13138 177984 : }
13139 :
13140 :
13141 : /*
13142 : BuildSizeFunction - builds the pseudo function SIZE
13143 : The Stack:
13144 :
13145 :
13146 : Entry Exit
13147 :
13148 : Ptr ->
13149 : +----------------+
13150 : | NoOfParam |
13151 : |----------------|
13152 : | Param 1 |
13153 : |----------------|
13154 : | Param 2 |
13155 : |----------------|
13156 : . .
13157 : . .
13158 : . .
13159 : |----------------|
13160 : | Param # | <- Ptr
13161 : |----------------| +------------+
13162 : | ProcSym | Type | | ReturnVar |
13163 : |----------------| |------------|
13164 : */
13165 :
13166 2097 : static void BuildSizeFunction (void)
13167 : {
13168 2097 : unsigned int resulttok;
13169 2097 : unsigned int paramtok;
13170 2097 : unsigned int functok;
13171 2097 : unsigned int dim;
13172 2097 : unsigned int Type;
13173 2097 : unsigned int NoOfParam;
13174 2097 : unsigned int ProcSym;
13175 2097 : unsigned int ReturnVar;
13176 :
13177 2097 : M2Quads_PopT (&NoOfParam);
13178 2097 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13179 2097 : functok = OperandTtok (NoOfParam+1);
13180 2097 : if (NoOfParam != 1)
13181 : {
13182 0 : M2MetaError_MetaErrorT1 (functok, (const char *) "{%E} SYSTEM procedure function {%kSIZE} requires one parameter, seen {%1n}", 74, NoOfParam);
13183 0 : resulttok = functok;
13184 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13185 : }
13186 : else
13187 : {
13188 2097 : paramtok = static_cast<unsigned int> (M2Quads_OperandTok (1));
13189 2097 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13190 2097 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13191 : {
13192 992 : BuildSizeCheckEnd (ProcSym); /* Quadruple generation now on. */
13193 992 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue); /* Quadruple generation now on. */
13194 992 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, M2Quads_OperandT (1), true);
13195 : }
13196 1105 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13197 : {
13198 : /* avoid dangling else. */
13199 1098 : BuildSizeCheckEnd (ProcSym); /* Quadruple generation now on. */
13200 1098 : Type = SymbolTable_GetSType (M2Quads_OperandT (1)); /* Quadruple generation now on. */
13201 1098 : if (SymbolTable_IsUnbounded (Type))
13202 : {
13203 : /* Eg. SIZE(a) ; where a is unbounded dereference HIGH and multiply by the TYPE. */
13204 168 : dim = static_cast<unsigned int> (OperandD (1));
13205 168 : if (dim == 0)
13206 : {
13207 72 : ReturnVar = calculateMultipicand (resulttok, M2Quads_OperandT (1), Type, dim);
13208 : }
13209 : else
13210 : {
13211 96 : ReturnVar = calculateMultipicand (resulttok, M2Quads_OperandA (1), Type, dim);
13212 : }
13213 : }
13214 : else
13215 : {
13216 930 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13217 930 : if (Type == SymbolTable_NulSym)
13218 : {
13219 0 : M2MetaError_MetaErrorT1 (resulttok, (const char *) "cannot get the type and size of {%1Ead}", 39, M2Quads_OperandT (1));
13220 : }
13221 930 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, Type, true);
13222 : }
13223 : }
13224 : else
13225 : {
13226 : /* avoid dangling else. */
13227 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));
13228 7 : ReturnVar = SymbolTable_MakeConstLit (paramtok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13229 : }
13230 : }
13231 2097 : M2Quads_PopN (NoOfParam+1); /* Destroy the arguments and function. */
13232 2097 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* Destroy the arguments and function. */
13233 2097 : }
13234 :
13235 :
13236 : /*
13237 : BuildTSizeFunction - builds the pseudo function TSIZE
13238 : The Stack:
13239 :
13240 :
13241 : Entry Exit
13242 :
13243 : Ptr ->
13244 : +----------------+
13245 : | NoOfParam |
13246 : |----------------|
13247 : | Param 1 |
13248 : |----------------|
13249 : | Param 2 |
13250 : |----------------|
13251 : . .
13252 : . .
13253 : . .
13254 : |----------------|
13255 : | Param # | <- Ptr
13256 : |----------------| +------------+
13257 : | ProcSym | Type | | ReturnVar |
13258 : |----------------| |------------|
13259 :
13260 : */
13261 :
13262 4766 : static void BuildTSizeFunction (void)
13263 : {
13264 4766 : unsigned int resulttok;
13265 4766 : unsigned int paramtok;
13266 4766 : unsigned int functok;
13267 4766 : unsigned int NoOfParam;
13268 4766 : unsigned int ProcSym;
13269 4766 : unsigned int Record;
13270 4766 : unsigned int ReturnVar;
13271 :
13272 4766 : M2Quads_PopT (&NoOfParam);
13273 4766 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13274 4766 : functok = OperandTtok (NoOfParam);
13275 4766 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
13276 4766 : if (NoOfParam == 1) /* quadruple generation now on */
13277 : {
13278 4766 : paramtok = OperandTtok (1);
13279 4766 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13280 4766 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13281 : {
13282 4732 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13283 4732 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13284 4732 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, M2Quads_OperandT (1), false);
13285 : }
13286 34 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13287 : {
13288 : /* avoid dangling else. */
13289 28 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13290 28 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13291 28 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, SymbolTable_GetSType (M2Quads_OperandT (1)), false);
13292 : }
13293 : else
13294 : {
13295 : /* avoid dangling else. */
13296 : /* Spellcheck. */
13297 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));
13298 6 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13299 : }
13300 : }
13301 0 : else if (NoOfParam == 0)
13302 : {
13303 : /* avoid dangling else. */
13304 0 : resulttok = functok;
13305 0 : M2MetaError_MetaErrorT0 (resulttok, (const char *) "{%E}SYSTEM procedure function {%kTSIZE} expects either one or two parameters, seen none", 87);
13306 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13307 : }
13308 : else
13309 : {
13310 : /* avoid dangling else. */
13311 0 : Record = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
13312 0 : paramtok = OperandTtok (1);
13313 0 : resulttok = OperandTtok (NoOfParam);
13314 0 : if (SymbolTable_IsRecord (Record))
13315 : {
13316 0 : paramtok = OperandTtok (1);
13317 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13318 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13319 0 : SymbolTable_PutVar (ReturnVar, M2Base_Cardinal);
13320 0 : GenQuadO (resulttok, M2Quads_SizeOp, ReturnVar, SymbolTable_NulSym, Record, false);
13321 : }
13322 : else
13323 : {
13324 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13325 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);
13326 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13327 : }
13328 : }
13329 4766 : M2Quads_PopN (NoOfParam+1); /* destroy the arguments and function */
13330 4766 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* destroy the arguments and function */
13331 4766 : }
13332 :
13333 :
13334 : /*
13335 : BuildTBitSizeFunction - builds the pseudo function TBITSIZE
13336 : The Stack:
13337 :
13338 :
13339 : Entry Exit
13340 :
13341 : Ptr ->
13342 : +----------------+
13343 : | NoOfParam |
13344 : |----------------|
13345 : | Param 1 |
13346 : |----------------|
13347 : | Param 2 |
13348 : |----------------|
13349 : . .
13350 : . .
13351 : . .
13352 : |----------------|
13353 : | Param # | <- Ptr
13354 : |----------------| +------------+
13355 : | ProcSym | Type | | ReturnVar |
13356 : |----------------| |------------|
13357 :
13358 : */
13359 :
13360 6508 : static void BuildTBitSizeFunction (void)
13361 : {
13362 6508 : unsigned int resulttok;
13363 6508 : unsigned int paramtok;
13364 6508 : unsigned int functok;
13365 6508 : unsigned int NoOfParam;
13366 6508 : unsigned int ProcSym;
13367 6508 : unsigned int Record;
13368 6508 : unsigned int ReturnVar;
13369 :
13370 6508 : M2Quads_PopT (&NoOfParam);
13371 6508 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
13372 6508 : functok = OperandTtok (NoOfParam);
13373 6508 : BuildSizeCheckEnd (ProcSym); /* quadruple generation now on */
13374 6508 : if (NoOfParam == 1) /* quadruple generation now on */
13375 : {
13376 6508 : paramtok = OperandTtok (1);
13377 6508 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13378 6508 : if (SymbolTable_IsAModula2Type (M2Quads_OperandT (1)))
13379 : {
13380 6436 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13381 6436 : GenQuadO (resulttok, M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1), false);
13382 : }
13383 72 : else if (SymbolTable_IsVar (M2Quads_OperandT (1)))
13384 : {
13385 : /* avoid dangling else. */
13386 72 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13387 72 : GenQuadO (resulttok, M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1), false);
13388 : }
13389 : else
13390 : {
13391 : /* avoid dangling else. */
13392 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));
13393 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13394 : }
13395 : }
13396 0 : else if (NoOfParam == 0)
13397 : {
13398 : /* avoid dangling else. */
13399 0 : resulttok = functok;
13400 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}SYSTEM procedure function {%kTBITSIZE} expects either one or two parameters, seen none", 90);
13401 0 : ReturnVar = SymbolTable_MakeConstLit (functok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13402 : }
13403 : else
13404 : {
13405 : /* avoid dangling else. */
13406 0 : Record = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam));
13407 0 : paramtok = OperandTtok (1);
13408 0 : resulttok = OperandTtok (NoOfParam);
13409 0 : if (SymbolTable_IsRecord (Record))
13410 : {
13411 0 : paramtok = OperandTtok (1);
13412 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13413 0 : ReturnVar = SymbolTable_MakeTemporary (resulttok, SymbolTable_ImmediateValue);
13414 0 : GenQuad (M2Quads_StandardFunctionOp, ReturnVar, ProcSym, M2Quads_OperandT (1));
13415 : }
13416 : else
13417 : {
13418 0 : resulttok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
13419 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);
13420 0 : ReturnVar = SymbolTable_MakeConstLit (resulttok, NameKey_MakeKey ((const char *) "0", 1), M2Base_Cardinal);
13421 : }
13422 : }
13423 6508 : M2Quads_PopN (NoOfParam+1); /* destroy the arguments and function */
13424 6508 : M2Quads_PushTFtok (ReturnVar, SymbolTable_GetSType (ProcSym), resulttok); /* destroy the arguments and function */
13425 6508 : }
13426 :
13427 :
13428 : /*
13429 : ExpectingParameterType -
13430 : */
13431 :
13432 94156 : static void ExpectingParameterType (unsigned int BlockSym, unsigned int Type)
13433 : {
13434 94156 : if (! (SymbolTable_IsAModula2Type (Type)))
13435 : {
13436 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13437 6 : if (((Type == SymbolTable_NulSym) || (SymbolTable_IsPartialUnbounded (Type))) || (SymbolTable_IsUnknown (Type)))
13438 : {
13439 0 : if (SymbolTable_IsUnknown (Type))
13440 : {
13441 : /* Spellcheck. */
13442 0 : M2MetaError_MetaError2 ((const char *) "the type used in the formal parameter declaration in {%1Md} {%1a} is unknown {%2&s}", 83, BlockSym, Type);
13443 0 : SymbolTable_UnknownReported (Type);
13444 : }
13445 : else
13446 : {
13447 0 : M2MetaError_MetaError1 ((const char *) "the type used in the formal parameter declaration in {%1Md} {%1a} is unknown", 76, BlockSym);
13448 : }
13449 : }
13450 : else
13451 : {
13452 : /* --fixme-- filter spellcheck on type. */
13453 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);
13454 : }
13455 : }
13456 94156 : }
13457 :
13458 :
13459 : /*
13460 : ExpectingVariableType -
13461 : */
13462 :
13463 82244 : static void ExpectingVariableType (unsigned int BlockSym, unsigned int Type)
13464 : {
13465 82244 : if (! (SymbolTable_IsAModula2Type (Type)))
13466 : {
13467 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13468 0 : if (Type == SymbolTable_NulSym)
13469 : {
13470 0 : M2MetaError_MetaError1 ((const char *) "the type used during the variable declaration section in procedure {%1EMad} is unknown", 86, BlockSym);
13471 0 : M2MetaError_MetaError1 ((const char *) "the type used during the variable declaration section in procedure {%1Ead} is unknown", 85, BlockSym);
13472 : }
13473 0 : else if ((SymbolTable_IsPartialUnbounded (Type)) || (SymbolTable_IsUnknown (Type)))
13474 : {
13475 : /* avoid dangling else. */
13476 : /* Spellcheck. */
13477 0 : M2MetaError_MetaError2 ((const char *) "the type {%1EMad} used during variable declaration section in procedure {%2ad} is unknown {%1&s}", 96, Type, BlockSym);
13478 0 : M2MetaError_MetaError2 ((const char *) "the type {%1Ead} used during variable declaration section in procedure {%2Mad} is unknown", 89, Type, BlockSym);
13479 0 : SymbolTable_UnknownReported (Type);
13480 : }
13481 : else
13482 : {
13483 : /* avoid dangling else. */
13484 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);
13485 : }
13486 : }
13487 82244 : }
13488 :
13489 :
13490 : /*
13491 : CheckVariablesAndParameterTypesInBlock - checks to make sure that block, BlockSym, has
13492 : parameters types and variable types which are legal.
13493 : */
13494 :
13495 183130 : static void CheckVariablesAndParameterTypesInBlock (unsigned int BlockSym)
13496 : {
13497 183130 : unsigned int i;
13498 183130 : unsigned int n;
13499 183130 : unsigned int ParamNo;
13500 :
13501 183130 : if (SymbolTable_IsProcedure (BlockSym))
13502 : {
13503 82730 : ParamNo = SymbolTable_NoOfParamAny (BlockSym);
13504 : }
13505 : else
13506 : {
13507 : ParamNo = 0;
13508 : }
13509 183130 : i = 1;
13510 1315055 : do {
13511 1315055 : n = SymbolTable_GetNth (BlockSym, i);
13512 1315055 : if (((n != SymbolTable_NulSym) && (! (SymbolTable_IsTemporary (n)))) && ((SymbolTable_IsProcedure (BlockSym)) || (((SymbolTable_IsDefImp (BlockSym)) && ((SymbolTable_GetMainModule ()) == BlockSym)) || (SymbolTable_IsModule (BlockSym)))))
13513 : {
13514 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13515 176400 : if (i <= ParamNo)
13516 : {
13517 : /* n is a parameter */
13518 94156 : ExpectingParameterType (BlockSym, SymbolTable_GetSType (n));
13519 : }
13520 : else
13521 : {
13522 : /* n is a local variable */
13523 82244 : ExpectingVariableType (BlockSym, SymbolTable_GetSType (n));
13524 : }
13525 : }
13526 1315055 : i += 1;
13527 1315055 : } while (! (n == SymbolTable_NulSym));
13528 183130 : }
13529 :
13530 :
13531 : /*
13532 : IsNeverAltered - returns TRUE if variable, sym, is never altered
13533 : between quadruples: Start..End
13534 : */
13535 :
13536 30 : static bool IsNeverAltered (unsigned int sym, unsigned int Start, unsigned int End)
13537 : {
13538 30 : unsigned int WriteStart;
13539 30 : unsigned int WriteEnd;
13540 :
13541 30 : SymbolTable_GetWriteLimitQuads (sym, SymbolTable_GetMode (sym), Start, End, &WriteStart, &WriteEnd);
13542 30 : return (WriteStart == 0) && (WriteEnd == 0);
13543 : /* static analysis guarentees a RETURN statement will be used before here. */
13544 : __builtin_unreachable ();
13545 : }
13546 :
13547 :
13548 : /*
13549 : IsConditionVariable - returns TRUE if the condition at quadruple, q, is variable.
13550 : */
13551 :
13552 24 : static bool IsConditionVariable (unsigned int q, unsigned int Start, unsigned int End)
13553 : {
13554 24 : M2Quads_QuadOperator op;
13555 24 : unsigned int op1;
13556 24 : unsigned int op2;
13557 24 : unsigned int op3;
13558 24 : bool LeftFixed;
13559 24 : bool RightFixed;
13560 :
13561 24 : M2Quads_GetQuad (q, &op, &op1, &op2, &op3);
13562 24 : if (op == M2Quads_GotoOp)
13563 : {
13564 : return false;
13565 : }
13566 : else
13567 : {
13568 24 : LeftFixed = SymbolTable_IsConst (op1);
13569 24 : RightFixed = SymbolTable_IsConst (op2);
13570 24 : if (! LeftFixed)
13571 : {
13572 24 : LeftFixed = IsNeverAltered (op1, Start, End);
13573 : }
13574 24 : if (! RightFixed)
13575 : {
13576 6 : RightFixed = IsNeverAltered (op2, Start, End);
13577 : }
13578 24 : return ! (LeftFixed && RightFixed);
13579 : }
13580 : /* static analysis guarentees a RETURN statement will be used before here. */
13581 : __builtin_unreachable ();
13582 : }
13583 :
13584 :
13585 : /*
13586 : IsInfiniteLoop - returns TRUE if an infinite loop is found.
13587 : Given a backwards jump at, End, it returns a BOOLEAN which depends on
13588 : whether a jump is found to jump beyond, End. If a conditonal jump is found
13589 : to pass over, End, the condition is tested for global variables, procedure variables and
13590 : constants.
13591 :
13592 : constant - ignored
13593 : variables - tested to see whether they are altered inside the loop
13594 : global variable - the procedure tests to see whether it is altered as above
13595 : but will also test to see whether this loop calls a procedure
13596 : in which case it believes the loop NOT to be infinite
13597 : (as this procedure call might alter the global variable)
13598 :
13599 : Note that this procedure can easily be fooled by the user altering variables
13600 : with pointers.
13601 : */
13602 :
13603 24 : static bool IsInfiniteLoop (unsigned int End)
13604 : {
13605 24 : bool SeenCall;
13606 24 : bool IsGlobal;
13607 24 : unsigned int Current;
13608 24 : unsigned int Start;
13609 24 : M2Quads_QuadOperator op;
13610 24 : unsigned int op1;
13611 24 : unsigned int op2;
13612 24 : unsigned int op3;
13613 :
13614 24 : SeenCall = false;
13615 24 : IsGlobal = false;
13616 24 : M2Quads_GetQuad (End, &op, &op1, &op2, &Start);
13617 24 : Current = Start;
13618 216 : while (Current != End)
13619 : {
13620 216 : M2Quads_GetQuad (Current, &op, &op1, &op2, &op3);
13621 : /* remember that this function is only called once we have optimized the redundant gotos and conditionals */
13622 216 : if ((M2Quads_IsConditional (Current)) && ! IsGlobal)
13623 : {
13624 24 : IsGlobal = ((SymbolTable_IsVar (op1)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op1))))) || ((SymbolTable_IsVar (op2)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op2)))));
13625 : }
13626 216 : if (op == M2Quads_CallOp)
13627 : {
13628 12 : SeenCall = true;
13629 : }
13630 216 : if ((op == M2Quads_GotoOp) || ((M2Quads_IsConditional (Current)) && (IsConditionVariable (Current, Start, End))))
13631 : {
13632 24 : if ((op3 > End) || (op3 < Start))
13633 : {
13634 : return false; /* may jump out of this loop, good */
13635 : }
13636 : }
13637 192 : Current = M2Quads_GetNextQuad (Current);
13638 : }
13639 0 : M2Quads_GetQuad (End, &op, &op1, &op2, &op3);
13640 0 : if (M2Quads_IsConditional (End))
13641 : {
13642 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
13643 0 : if (IsConditionVariable (End, Start, End))
13644 : {
13645 : return false;
13646 : }
13647 : else
13648 : {
13649 0 : if (! IsGlobal)
13650 : {
13651 0 : IsGlobal = ((SymbolTable_IsVar (op1)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op1))))) || ((SymbolTable_IsVar (op2)) && (! (SymbolTable_IsProcedure (SymbolTable_GetVarScope (op2)))));
13652 : }
13653 : }
13654 : }
13655 : /* we have found a likely infinite loop if no conditional uses a global and no procedure call was seen */
13656 0 : return ! (IsGlobal && SeenCall);
13657 : /* static analysis guarentees a RETURN statement will be used before here. */
13658 : __builtin_unreachable ();
13659 : }
13660 :
13661 :
13662 : /*
13663 : CheckVariablesInBlock - given a block, BlockSym, check whether all variables are used.
13664 : */
13665 :
13666 183130 : static void CheckVariablesInBlock (unsigned int BlockSym)
13667 : {
13668 0 : CheckVariablesAndParameterTypesInBlock (BlockSym);
13669 0 : }
13670 :
13671 :
13672 : /*
13673 : CheckFunctionReturn - checks to see that a RETURN statement was present in a function.
13674 : */
13675 :
13676 82730 : static void CheckFunctionReturn (unsigned int ProcSym)
13677 : {
13678 82730 : M2Quads_QuadOperator Op;
13679 82730 : unsigned int Op1;
13680 82730 : unsigned int Op2;
13681 82730 : unsigned int Op3;
13682 82730 : unsigned int Scope;
13683 82730 : unsigned int Start;
13684 82730 : unsigned int End;
13685 :
13686 82730 : if ((SymbolTable_GetSType (ProcSym)) != SymbolTable_NulSym)
13687 : {
13688 : /* yes it is a function */
13689 20871 : SymbolTable_GetProcedureQuads (ProcSym, &Scope, &Start, &End);
13690 20871 : M2Quads_GetQuad (Start, &Op, &Op1, &Op2, &Op3);
13691 20871 : if (Start == 0)
13692 : {
13693 0 : M2Error_InternalError ((const char *) "incorrect start quad", 20);
13694 : }
13695 788702 : while (((Start != End) && (Op != M2Quads_ReturnValueOp)) && (Op != M2Quads_InlineOp))
13696 : {
13697 767831 : Start = M2Quads_GetNextQuad (Start);
13698 767831 : M2Quads_GetQuad (Start, &Op, &Op1, &Op2, &Op3);
13699 : }
13700 20871 : if ((Op != M2Quads_ReturnValueOp) && (Op != M2Quads_InlineOp))
13701 : {
13702 : /* an InlineOp can always be used to emulate a RETURN */
13703 6 : M2MetaError_MetaError1 ((const char *) "procedure function {%1Ea} does not RETURN a value", 49, ProcSym);
13704 : }
13705 : }
13706 82730 : }
13707 :
13708 :
13709 : /*
13710 : CheckReturnType - checks to see that the return type from currentProc is
13711 : assignment compatible with actualType.
13712 : */
13713 :
13714 29799 : static void CheckReturnType (unsigned int tokno, unsigned int currentProc, unsigned int actualVal, unsigned int actualType)
13715 : {
13716 29799 : unsigned int procType;
13717 29799 : DynamicStrings_String s1;
13718 29799 : DynamicStrings_String s2;
13719 29799 : NameKey_Name n1;
13720 29799 : NameKey_Name n2;
13721 :
13722 29799 : procType = SymbolTable_GetSType (currentProc);
13723 29799 : if (procType == SymbolTable_NulSym)
13724 : {
13725 0 : M2MetaError_MetaError1 ((const char *) "attempting to RETURN a value from procedure {%1Ea} which was not a declared as a procedure function", 99, currentProc);
13726 : }
13727 29799 : else if (M2Base_AssignmentRequiresWarning (actualType, SymbolTable_GetSType (currentProc)))
13728 : {
13729 : /* avoid dangling else. */
13730 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);
13731 : }
13732 29799 : else if (! (M2Base_IsAssignmentCompatible (actualType, procType)))
13733 : {
13734 : /* avoid dangling else. */
13735 0 : n1 = SymbolTable_GetSymName (actualType);
13736 0 : n2 = SymbolTable_GetSymName (procType);
13737 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));
13738 : }
13739 29799 : else if ((SymbolTable_IsProcedure (actualVal)) && (! (M2Base_IsAssignmentCompatible (actualVal, procType))))
13740 : {
13741 : /* avoid dangling else. */
13742 : /*
13743 : MetaWarnings2('attempting to RETURN a value with an incompatible type {%1ad} from function {%2a} which returns {%2ta}',
13744 : actualVal, currentProc)
13745 :
13746 : --fixme-- introduce MetaWarning, MetaWarning2, MetaWarning3 into M2MetaError
13747 : */
13748 0 : s1 = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (actualVal)));
13749 0 : s2 = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (procType)));
13750 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)));
13751 : }
13752 29799 : else if ((SymbolTable_IsProcedure (actualVal)) && (! (M2Base_IsAssignmentCompatible (actualVal, SymbolTable_GetSType (CurrentProc)))))
13753 : {
13754 : /* avoid dangling else. */
13755 0 : n1 = SymbolTable_GetSymName (actualVal);
13756 0 : n2 = SymbolTable_GetSymName (SymbolTable_GetSType (currentProc));
13757 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));
13758 : }
13759 : else
13760 : {
13761 : /* avoid dangling else. */
13762 : /* this checks the types are compatible, not the data contents. */
13763 29799 : BuildRange (M2Range_InitTypesReturnTypeCheck (tokno, currentProc, actualVal));
13764 : }
13765 29799 : }
13766 :
13767 :
13768 : /*
13769 : BuildReturnLower - check the return type and value to ensure type
13770 : compatibility and no range overflow will occur.
13771 : */
13772 :
13773 29799 : static void BuildReturnLower (unsigned int tokcombined, unsigned int tokexpr, unsigned int e1, unsigned int t1)
13774 : {
13775 29799 : unsigned int e2;
13776 29799 : unsigned int t2;
13777 :
13778 : /* This will check that the type returned is compatible with
13779 : the formal return type of the procedure. */
13780 29799 : CheckReturnType (tokcombined, CurrentProc, e1, t1);
13781 : /* Dereference LeftValue if necessary. */
13782 29799 : if ((SymbolTable_GetMode (e1)) == SymbolTable_LeftValue)
13783 : {
13784 172 : t2 = SymbolTable_GetSType (CurrentProc);
13785 172 : e2 = SymbolTable_MakeTemporary (tokexpr, SymbolTable_RightValue);
13786 172 : SymbolTable_PutVar (e2, t2);
13787 172 : CheckPointerThroughNil (tokexpr, e1);
13788 172 : doIndrX (tokexpr, e2, e1);
13789 172 : e1 = e2;
13790 : }
13791 : /* Here we check the data contents to ensure no overflow. */
13792 29799 : BuildRange (M2Range_InitReturnRangeCheck (tokcombined, CurrentProc, e1));
13793 29799 : GenQuadOtok (tokcombined, M2Quads_ReturnValueOp, e1, SymbolTable_NulSym, CurrentProc, false, tokcombined, M2LexBuf_UnknownTokenNo, SymbolTable_GetDeclaredMod (CurrentProc));
13794 29799 : }
13795 :
13796 :
13797 : /*
13798 : IsReadOnly - a helper procedure function to detect constants.
13799 : */
13800 :
13801 272655 : static bool IsReadOnly (unsigned int sym)
13802 : {
13803 272655 : return (SymbolTable_IsConst (sym)) || ((SymbolTable_IsVar (sym)) && (SymbolTable_IsVarConst (sym)));
13804 : /* static analysis guarentees a RETURN statement will be used before here. */
13805 : __builtin_unreachable ();
13806 : }
13807 :
13808 :
13809 : /*
13810 : BuildDesignatorError - removes the designator from the stack and replaces
13811 : it with an error symbol.
13812 : */
13813 :
13814 54 : static void BuildDesignatorError (const char *message_, unsigned int _message_high)
13815 : {
13816 54 : unsigned int combinedTok;
13817 54 : unsigned int arrayTok;
13818 54 : unsigned int exprTok;
13819 54 : unsigned int e;
13820 54 : unsigned int d;
13821 54 : unsigned int error;
13822 54 : unsigned int Sym;
13823 54 : unsigned int Type;
13824 54 : char message[_message_high+1];
13825 :
13826 : /* make a local copy of each unbounded array. */
13827 54 : memcpy (message, message_, _message_high+1);
13828 :
13829 54 : M2Quads_PopTtok (&e, &exprTok);
13830 54 : PopTFDtok (&Sym, &Type, &d, &arrayTok);
13831 54 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, exprTok);
13832 54 : error = SymbolTable_MakeError (combinedTok, NameKey_MakeKey ((const char *) message, _message_high));
13833 54 : PushTFDtok (error, Type, d, arrayTok);
13834 54 : }
13835 :
13836 :
13837 : /*
13838 : BuildDesignatorPointerError - removes the designator from the stack and replaces
13839 : it with an error symbol.
13840 : */
13841 :
13842 2 : static void BuildDesignatorPointerError (unsigned int type, unsigned int rw, unsigned int tokpos, const char *message_, unsigned int _message_high)
13843 : {
13844 2 : unsigned int error;
13845 2 : char message[_message_high+1];
13846 :
13847 : /* make a local copy of each unbounded array. */
13848 2 : memcpy (message, message_, _message_high+1);
13849 :
13850 2 : error = SymbolTable_MakeError (tokpos, NameKey_MakeKey ((const char *) message, _message_high));
13851 2 : if ((SymbolTable_GetSType (type)) != SymbolTable_NulSym)
13852 : {
13853 2 : type = SymbolTable_GetSType (type);
13854 : }
13855 2 : PushTFrwtok (error, type, rw, tokpos);
13856 2 : }
13857 :
13858 :
13859 : /*
13860 : BuildDesignatorArrayStaticDynamic - Builds the array referencing.
13861 : The purpose of this procedure is to work out
13862 : whether the DesignatorArray is a static or
13863 : dynamic array and to call the appropriate
13864 : BuildRoutine.
13865 :
13866 : The Stack is expected to contain:
13867 :
13868 :
13869 : Entry Exit
13870 : ===== ====
13871 :
13872 : Ptr ->
13873 : +--------------+
13874 : | e | <- Ptr
13875 : |--------------| +------------+
13876 : | Sym | Type | | S | T |
13877 : |--------------| |------------|
13878 : */
13879 :
13880 56480 : static void BuildDesignatorArrayStaticDynamic (void)
13881 : {
13882 56480 : unsigned int combinedTok;
13883 56480 : unsigned int arrayTok;
13884 56480 : unsigned int exprTok;
13885 56480 : unsigned int e;
13886 56480 : unsigned int type;
13887 56480 : unsigned int dim;
13888 56480 : unsigned int result;
13889 56480 : unsigned int Sym;
13890 56480 : unsigned int Type;
13891 :
13892 56480 : if (SymbolTable_IsConst (M2Quads_OperandT (2)))
13893 : {
13894 204 : type = SymbolTable_GetDType (M2Quads_OperandT (2));
13895 204 : if ((type != SymbolTable_NulSym) && (SymbolTable_IsArray (type)))
13896 : {
13897 204 : M2Quads_PopTtok (&e, &exprTok);
13898 204 : PopTFDtok (&Sym, &Type, &dim, &arrayTok);
13899 204 : result = SymbolTable_MakeTemporary (exprTok, SymbolTable_RightValue);
13900 204 : SymbolTable_PutVar (result, Type);
13901 204 : M2Quads_PushTFtok (result, SymbolTable_GetSType (result), exprTok);
13902 204 : M2Quads_PushTtok (Sym, arrayTok);
13903 204 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, exprTok);
13904 204 : SymbolTable_PutVarConst (result, true);
13905 204 : M2Quads_BuildAssignConstant (combinedTok);
13906 204 : PushTFDtok (result, SymbolTable_GetDType (result), dim, arrayTok);
13907 204 : M2Quads_PushTtok (e, exprTok);
13908 : }
13909 : }
13910 56480 : if ((! (SymbolTable_IsVar (M2Quads_OperandT (2)))) && (! (SymbolTable_IsTemporary (M2Quads_OperandT (2)))))
13911 : {
13912 18 : M2MetaError_MetaErrorT1 (OperandTtok (2), (const char *) "can only access arrays using constants, variables or formal parameters not {%1Ead}", 82, M2Quads_OperandT (2));
13913 18 : BuildDesignatorError ((const char *) "bad array access", 16);
13914 : }
13915 56480 : Sym = static_cast<unsigned int> (M2Quads_OperandT (2));
13916 56480 : Type = SymbolTable_GetDType (Sym);
13917 56480 : arrayTok = OperandTtok (2);
13918 56480 : if (Type == SymbolTable_NulSym)
13919 : {
13920 0 : if ((arrayTok == M2LexBuf_UnknownTokenNo) || (arrayTok == M2LexBuf_BuiltinTokenNo))
13921 : {
13922 0 : arrayTok = M2LexBuf_GetTokenNo ();
13923 : }
13924 0 : M2MetaError_MetaErrorT0 (arrayTok, (const char *) "type of array is undefined", 26);
13925 0 : BuildDesignatorError ((const char *) "bad array access", 16);
13926 : }
13927 56480 : else if (SymbolTable_IsUnbounded (Type))
13928 : {
13929 : /* avoid dangling else. */
13930 8980 : BuildDynamicArray ();
13931 : }
13932 47500 : else if (SymbolTable_IsArray (Type))
13933 : {
13934 : /* avoid dangling else. */
13935 47470 : BuildStaticArray ();
13936 : }
13937 : else
13938 : {
13939 : /* avoid dangling else. */
13940 30 : M2MetaError_MetaErrorT1 (arrayTok, (const char *) "can only index static or dynamic arrays, {%1Ead} is not an array but a {%tadv}", 78, Sym);
13941 30 : BuildDesignatorError ((const char *) "bad array access", 16);
13942 : }
13943 56474 : }
13944 :
13945 :
13946 : /*
13947 : BuildStaticArray - Builds the array referencing for static arrays.
13948 : The Stack is expected to contain:
13949 :
13950 :
13951 : Entry Exit
13952 : ===== ====
13953 :
13954 : Ptr ->
13955 : +--------------+
13956 : | e | <- Ptr
13957 : |--------------| +------------+
13958 : | Sym | Type | | S | T |
13959 : |--------------| |------------|
13960 : */
13961 :
13962 47470 : static void BuildStaticArray (void)
13963 : {
13964 47470 : unsigned int combinedTok;
13965 47470 : unsigned int indexTok;
13966 47470 : unsigned int arrayTok;
13967 47470 : unsigned int rw;
13968 47470 : unsigned int Dim;
13969 47470 : unsigned int Array;
13970 47470 : unsigned int Index;
13971 47470 : unsigned int BackEndType;
13972 47470 : unsigned int Type;
13973 47470 : unsigned int Adr;
13974 :
13975 47470 : Index = static_cast<unsigned int> (M2Quads_OperandT (1));
13976 47470 : indexTok = OperandTtok (1);
13977 47470 : Array = static_cast<unsigned int> (M2Quads_OperandT (2));
13978 47470 : arrayTok = OperandTtok (2);
13979 47470 : Type = SymbolTable_SkipType (M2Quads_OperandF (2));
13980 47470 : rw = static_cast<unsigned int> (OperandMergeRW (2));
13981 47470 : M2Debug_Assert (SymbolTable_IsLegal (rw));
13982 47470 : Dim = static_cast<unsigned int> (OperandD (2));
13983 47470 : Dim += 1;
13984 47470 : if ((SymbolTable_GetMode (Index)) == SymbolTable_LeftValue)
13985 : {
13986 171 : Index = MakeRightValue (indexTok, Index, SymbolTable_GetSType (Index));
13987 : }
13988 47464 : BuildRange (M2Range_InitStaticArraySubscriptRangeCheck (SymbolTable_GetArraySubscript (Type), Index, Dim));
13989 : /* now make Adr point to the address of the indexed element */
13990 47464 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, indexTok);
13991 47464 : Adr = SymbolTable_MakeTemporary (combinedTok, SymbolTable_LeftValue);
13992 47464 : if (SymbolTable_IsVar (Array))
13993 : {
13994 : /* BuildDesignatorArray may have detected des is a constant. */
13995 47464 : SymbolTable_PutVarConst (Adr, SymbolTable_IsVarConst (Array));
13996 : }
13997 47464 : SymbolTable_PutVarArrayRef (Adr, true);
13998 : /*
13999 : From now on it must reference the array element by its lvalue
14000 : - so we create the type of the referenced entity
14001 : */
14002 47464 : BackEndType = SymbolTable_MakePointer (combinedTok, NameKey_NulName);
14003 47464 : SymbolTable_PutPointer (BackEndType, SymbolTable_GetDType (Type));
14004 : /* PutVar(Adr, BackEndType) ; */
14005 47464 : SymbolTable_PutLeftValueFrontBackType (Adr, SymbolTable_GetDType (Type), BackEndType);
14006 94928 : GenQuadO (combinedTok, M2Quads_ArrayOp, Adr, Index, Array, true);
14007 47464 : M2Quads_PopN (2); /* remove all parameters to this procedure */
14008 47464 : PushTFDrwtok (Adr, SymbolTable_GetSType (Adr), Dim, rw, combinedTok); /* remove all parameters to this procedure */
14009 47464 : }
14010 :
14011 :
14012 : /*
14013 : calculateMultipicand - generates quadruples which calculate the
14014 : multiplicand for the array at dimension, dim.
14015 : */
14016 :
14017 12038 : static unsigned int calculateMultipicand (unsigned int tok, unsigned int arraySym, unsigned int arrayType, unsigned int dim)
14018 : {
14019 12038 : unsigned int ti;
14020 12038 : unsigned int tj;
14021 12038 : unsigned int tk;
14022 12038 : unsigned int tl;
14023 :
14024 12038 : if (dim == (SymbolTable_GetDimension (arrayType)))
14025 : {
14026 : /* ti has no type since constant */
14027 10254 : ti = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
14028 10254 : SymbolTable_PutVar (ti, M2Base_Cardinal);
14029 10254 : GenQuadO (tok, M2Quads_ElementSizeOp, ti, arrayType, 1, true);
14030 : }
14031 : else
14032 : {
14033 1784 : dim += 1;
14034 1784 : tk = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14035 1784 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14036 1784 : GenHigh (tok, tk, dim, arraySym);
14037 1784 : tl = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14038 1784 : SymbolTable_PutVar (tl, M2Base_Cardinal);
14039 1784 : GenQuadOtok (tok, M2Quads_AddOp, tl, tk, SymbolTable_MakeConstLit (tok, NameKey_MakeKey ((const char *) "1", 1), M2Base_Cardinal), true, tok, tok, tok);
14040 1784 : tj = calculateMultipicand (tok, arraySym, arrayType, dim);
14041 1784 : ti = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
14042 1784 : SymbolTable_PutVar (ti, M2Base_Cardinal);
14043 1784 : GenQuadO (tok, M2Quads_MultOp, ti, tj, tl, true);
14044 : }
14045 12038 : return ti;
14046 : /* static analysis guarentees a RETURN statement will be used before here. */
14047 : __builtin_unreachable ();
14048 : }
14049 :
14050 :
14051 : /*
14052 : ConvertToAddress - convert sym to an address.
14053 : */
14054 :
14055 9064 : static unsigned int ConvertToAddress (unsigned int tokpos, unsigned int sym)
14056 : {
14057 9064 : unsigned int adr;
14058 :
14059 9064 : if ((SymbolTable_GetSType (sym)) == M2System_Address)
14060 : {
14061 : return sym;
14062 : }
14063 : else
14064 : {
14065 9052 : M2Quads_PushTF (SymbolTable_RequestSym (tokpos, NameKey_MakeKey ((const char *) "CONVERT", 7)), static_cast<unsigned int> (SymbolTable_NulSym));
14066 9052 : M2Quads_PushT (M2System_Address);
14067 9052 : M2Quads_PushTtok (sym, tokpos);
14068 9052 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14069 9052 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14070 9052 : M2Quads_PopT (&adr);
14071 9052 : return adr;
14072 : }
14073 : /* static analysis guarentees a RETURN statement will be used before here. */
14074 : __builtin_unreachable ();
14075 : }
14076 :
14077 :
14078 : /*
14079 : BuildDynamicArray - Builds the array referencing for dynamic arrays.
14080 : The Stack is expected to contain:
14081 :
14082 :
14083 : Entry Exit
14084 : ===== ====
14085 :
14086 : Ptr ->
14087 : +-----------------------+
14088 : | Index | <- Ptr
14089 : |-----------------------| +---------------------------+
14090 : | ArraySym | Type | Dim | | S | T | ArraySym | Dim+1 |
14091 : |-----------------------| |---------------------------|
14092 :
14093 :
14094 : if Dim=1
14095 : then
14096 : S := base of ArraySym + TSIZE(Type)*Index
14097 : else
14098 : S := S + TSIZE(Type)*Index
14099 : fi
14100 : */
14101 :
14102 8980 : static void BuildDynamicArray (void)
14103 : {
14104 8980 : unsigned int combinedTok;
14105 8980 : unsigned int arrayTok;
14106 8980 : unsigned int indexTok;
14107 8980 : unsigned int Sym;
14108 8980 : unsigned int idx;
14109 8980 : unsigned int Type;
14110 8980 : unsigned int Adr;
14111 8980 : unsigned int ArraySym;
14112 8980 : unsigned int BackEndType;
14113 8980 : unsigned int UnboundedType;
14114 8980 : unsigned int PtrToBase;
14115 8980 : unsigned int Base;
14116 8980 : unsigned int Dim;
14117 8980 : unsigned int rw;
14118 8980 : unsigned int ti;
14119 8980 : unsigned int tj;
14120 8980 : unsigned int tk;
14121 8980 : unsigned int tka;
14122 :
14123 8980 : M2Quads_DisplayStack ();
14124 8980 : Sym = static_cast<unsigned int> (M2Quads_OperandT (2));
14125 8980 : Type = SymbolTable_SkipType (M2Quads_OperandF (2));
14126 8980 : arrayTok = static_cast<unsigned int> (M2Quads_OperandTok (2));
14127 8980 : indexTok = static_cast<unsigned int> (M2Quads_OperandTok (1));
14128 8980 : combinedTok = M2LexBuf_MakeVirtualTok (arrayTok, arrayTok, indexTok);
14129 8980 : Dim = static_cast<unsigned int> (OperandD (2));
14130 8980 : rw = static_cast<unsigned int> (OperandMergeRW (2));
14131 8980 : M2Debug_Assert (SymbolTable_IsLegal (rw));
14132 8980 : Dim += 1;
14133 8980 : if (Dim == 1)
14134 : {
14135 : /*
14136 : Base has type address since
14137 : BuildDesignatorRecord references by address.
14138 :
14139 : Build a record for retrieving the address of dynamic array.
14140 : BuildDesignatorRecord will generate the required quadruples,
14141 : therefore build sets up the stack for BuildDesignatorRecord
14142 : which will generate the quads to access the record.
14143 : */
14144 8842 : ArraySym = Sym;
14145 8842 : UnboundedType = SymbolTable_GetUnboundedRecordType (SymbolTable_GetSType (Sym));
14146 8842 : PushTFrwtok (Sym, UnboundedType, rw, arrayTok);
14147 8842 : M2Quads_PushTF (SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (Sym)), SymbolTable_GetSType (SymbolTable_GetUnboundedAddressOffset (SymbolTable_GetSType (Sym))));
14148 8842 : M2Quads_PushT (static_cast<unsigned int> (1)); /* One record field to dereference */
14149 8842 : M2Quads_BuildDesignatorRecord (combinedTok); /* One record field to dereference */
14150 8842 : M2Quads_PopT (&PtrToBase);
14151 8842 : M2Quads_DisplayStack ();
14152 : /* Now actually copy Unbounded.ArrayAddress into base */
14153 8842 : if ((SymbolTable_GetMode (PtrToBase)) == SymbolTable_LeftValue)
14154 : {
14155 0 : Base = SymbolTable_MakeTemporary (arrayTok, SymbolTable_RightValue);
14156 0 : SymbolTable_PutVar (Base, M2System_Address); /* has type ADDRESS */
14157 0 : CheckPointerThroughNil (arrayTok, PtrToBase); /* has type ADDRESS */
14158 0 : GenQuad (M2Quads_IndrXOp, Base, M2System_Address, PtrToBase); /* Base = *PtrToBase */
14159 : }
14160 : else
14161 : {
14162 8842 : M2Debug_Assert ((SymbolTable_GetMode (PtrToBase)) != SymbolTable_ImmediateValue);
14163 8842 : Base = PtrToBase;
14164 : }
14165 : }
14166 : else
14167 : {
14168 : /* Base already calculated previously and pushed to stack */
14169 138 : UnboundedType = SymbolTable_SkipType (M2Quads_OperandF (2));
14170 138 : Base = Sym;
14171 138 : ArraySym = static_cast<unsigned int> (M2Quads_OperandA (2));
14172 : }
14173 8980 : M2Debug_Assert ((SymbolTable_GetSType (Sym)) == Type);
14174 8980 : ti = calculateMultipicand (indexTok, Sym, Type, Dim);
14175 8980 : idx = static_cast<unsigned int> (M2Quads_OperandT (1));
14176 8980 : if ((SymbolTable_IsConst (idx)) && (SymbolTable_IsConst (ti)))
14177 : {
14178 : /* tj has no type since constant */
14179 460 : tj = SymbolTable_MakeTemporary (indexTok, SymbolTable_ImmediateValue);
14180 460 : tk = SymbolTable_MakeTemporary (indexTok, SymbolTable_ImmediateValue);
14181 460 : SymbolTable_PutVar (tj, M2Base_Cardinal);
14182 460 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14183 : }
14184 : else
14185 : {
14186 : /* tj has Cardinal type since we have multiplied array indices */
14187 8520 : tj = SymbolTable_MakeTemporary (indexTok, SymbolTable_RightValue);
14188 8520 : if ((SymbolTable_GetSType (idx)) != M2Base_Cardinal)
14189 : {
14190 270 : M2Quads_PushTF (SymbolTable_RequestSym (indexTok, NameKey_MakeKey ((const char *) "CONVERT", 7)), static_cast<unsigned int> (SymbolTable_NulSym));
14191 270 : M2Quads_PushT (M2Base_Cardinal);
14192 270 : M2Quads_PushTtok (idx, indexTok);
14193 270 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14194 270 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14195 270 : M2Quads_PopT (&idx);
14196 : }
14197 8520 : SymbolTable_PutVar (tj, M2Base_Cardinal);
14198 8520 : tk = SymbolTable_MakeTemporary (indexTok, SymbolTable_RightValue);
14199 8520 : SymbolTable_PutVar (tk, M2Base_Cardinal);
14200 : }
14201 8980 : BuildRange (M2Range_InitDynamicArraySubscriptRangeCheck (ArraySym, idx, Dim));
14202 8980 : M2Quads_PushTtok (tj, indexTok);
14203 8980 : M2Quads_PushTtok (idx, indexTok);
14204 8980 : BuildAssignmentWithoutBounds (indexTok, false, true);
14205 17960 : GenQuad (M2Quads_MultOp, tk, ti, tj);
14206 17960 : Adr = SymbolTable_MakeTemporary (combinedTok, SymbolTable_LeftValue);
14207 8980 : SymbolTable_PutVarArrayRef (Adr, true);
14208 : /*
14209 : Ok must reference by address
14210 : - but we contain the type of the referenced entity
14211 : */
14212 8980 : BackEndType = SymbolTable_MakePointer (combinedTok, NameKey_NulName);
14213 8980 : SymbolTable_PutPointer (BackEndType, SymbolTable_GetSType (Type));
14214 : /* Create a temporary pointer for addition. */
14215 8980 : tka = ConvertToAddress (combinedTok, tk);
14216 8980 : if (Dim == (SymbolTable_GetDimension (Type)))
14217 : {
14218 8662 : SymbolTable_PutLeftValueFrontBackType (Adr, SymbolTable_GetSType (Type), BackEndType);
14219 17324 : GenQuadOtok (combinedTok, M2Quads_AddOp, Adr, Base, tka, false, combinedTok, combinedTok, combinedTok);
14220 8662 : M2Quads_PopN (2);
14221 8662 : PushTFADrwtok (Adr, SymbolTable_GetSType (Adr), ArraySym, Dim, rw, combinedTok);
14222 : }
14223 : else
14224 : {
14225 : /* more to index */
14226 318 : SymbolTable_PutLeftValueFrontBackType (Adr, Type, BackEndType);
14227 636 : GenQuadOtok (combinedTok, M2Quads_AddOp, Adr, Base, tka, false, combinedTok, combinedTok, combinedTok);
14228 318 : M2Quads_PopN (2);
14229 318 : PushTFADrwtok (Adr, SymbolTable_GetSType (Adr), ArraySym, Dim, rw, combinedTok);
14230 : }
14231 8980 : }
14232 :
14233 :
14234 : /*
14235 : DebugLocation -
14236 : */
14237 :
14238 57763 : static void DebugLocation (unsigned int tok, const char *message_, unsigned int _message_high)
14239 : {
14240 57763 : char message[_message_high+1];
14241 :
14242 : /* make a local copy of each unbounded array. */
14243 57763 : memcpy (message, message_, _message_high+1);
14244 :
14245 57763 : if (DebugTokPos)
14246 : {
14247 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) message, _message_high), tok);
14248 : }
14249 57763 : }
14250 :
14251 :
14252 : /*
14253 : PushWith - pushes sym and type onto the with stack. It checks for
14254 : previous declaration of this record type.
14255 : */
14256 :
14257 5965 : static void PushWith (unsigned int Sym, unsigned int Type, unsigned int Ref, unsigned int Tok)
14258 : {
14259 5965 : unsigned int i;
14260 5965 : unsigned int n;
14261 5965 : M2Quads_WithFrame f;
14262 :
14263 5965 : if (M2Options_Pedantic)
14264 : {
14265 0 : n = M2StackAddress_NoOfItemsInStackAddress (WithStack);
14266 0 : i = 1; /* Top of the stack. */
14267 : /* Search for other declarations of the with using Type. */
14268 0 : while (i <= n)
14269 : {
14270 0 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PeepAddress (WithStack, i));
14271 0 : if (f->RecordSym == Type)
14272 : {
14273 0 : M2MetaError_MetaErrorT1 (Tok, (const char *) "cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}", 78, Sym);
14274 0 : M2MetaError_MetaErrorT1 (f->RecordTokPos, (const char *) "cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}", 78, f->RecordSym);
14275 : }
14276 0 : i += 1;
14277 : }
14278 : }
14279 5965 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T4));
14280 5965 : f->RecordSym = Sym;
14281 5965 : f->RecordType = Type;
14282 5965 : f->RecordRef = Ref;
14283 5965 : f->rw = Sym;
14284 5965 : f->RecordTokPos = Tok;
14285 5965 : M2StackAddress_PushAddress (WithStack, reinterpret_cast <void *> (f));
14286 5965 : }
14287 :
14288 5965 : static void PopWith (void)
14289 : {
14290 5965 : M2Quads_WithFrame f;
14291 :
14292 5965 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PopAddress (WithStack));
14293 5965 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T4));
14294 5965 : }
14295 :
14296 :
14297 : /*
14298 : BuildAccessWithField - similar to BuildDesignatorRecord except it
14299 : does not perform the address operation.
14300 : The address will have been computed at the
14301 : beginning of the WITH statement.
14302 : It also stops the GenQuad procedure from examining the
14303 : with stack.
14304 :
14305 : The Stack
14306 :
14307 : Entry
14308 :
14309 : Ptr ->
14310 : +--------------+
14311 : | Field | Type1| <- Ptr
14312 : |-------|------| +-------------+
14313 : | Adr | Type2| | Sym | Type1|
14314 : |--------------| |-------------|
14315 : */
14316 :
14317 30024 : static void BuildAccessWithField (void)
14318 : {
14319 30024 : unsigned int rectok;
14320 30024 : unsigned int fieldtok;
14321 30024 : bool OldSuppressWith;
14322 30024 : unsigned int rw;
14323 30024 : unsigned int Field;
14324 30024 : unsigned int FieldType;
14325 30024 : unsigned int Record;
14326 30024 : unsigned int RecordType;
14327 30024 : unsigned int Ref;
14328 :
14329 30024 : OldSuppressWith = SuppressWith;
14330 30024 : SuppressWith = true;
14331 : /*
14332 : now the WITH cannot look at the stack of outstanding WITH records.
14333 : */
14334 30024 : M2Quads_PopTFtok (&Field, &FieldType, &fieldtok);
14335 30024 : PopTFrwtok (&Record, &RecordType, &rw, &rectok);
14336 30024 : Ref = SymbolTable_MakeComponentRef (SymbolTable_MakeComponentRecord (fieldtok, SymbolTable_RightValue, Record), Field);
14337 30024 : SymbolTable_PutVarConst (Ref, IsReadOnly (Record));
14338 60048 : GenQuadO (fieldtok, M2Quads_RecordFieldOp, Ref, Record, Field, true);
14339 30024 : PushTFrwtok (Ref, FieldType, rw, fieldtok);
14340 30024 : SuppressWith = OldSuppressWith;
14341 30024 : }
14342 :
14343 :
14344 : /*
14345 : SafeCheckWithField - only call CheckWithReference if the top of stack
14346 : contains a record field.
14347 : */
14348 :
14349 12040 : static void SafeCheckWithField (void)
14350 : {
14351 12040 : if (SymbolTable_IsRecordField (M2Quads_OperandT (1)))
14352 : {
14353 24 : M2Quads_CheckWithReference ();
14354 : }
14355 12040 : }
14356 :
14357 :
14358 : /*
14359 : PushConstructor -
14360 : */
14361 :
14362 48319 : static void PushConstructor (unsigned int sym)
14363 : {
14364 48319 : M2Quads_ConstructorFrame c;
14365 :
14366 48319 : Storage_ALLOCATE ((void **) &c, sizeof (M2Quads__T1));
14367 48319 : c->type = SymbolTable_SkipType (sym);
14368 48319 : c->index = 1;
14369 48319 : M2StackAddress_PushAddress (ConstructorStack, reinterpret_cast <void *> (c));
14370 48319 : }
14371 :
14372 :
14373 : /*
14374 : AddFieldTo - adds field to value.
14375 : */
14376 :
14377 25782 : static unsigned int AddFieldTo (unsigned int value, unsigned int field, unsigned int valuetok, unsigned int fieldtok)
14378 : {
14379 25782 : if (SymbolTable_IsSet (SymbolTable_GetDType (value)))
14380 : {
14381 12040 : SymbolTable_PutConstSet (value);
14382 12040 : M2Quads_PushTtok (value, valuetok);
14383 12040 : M2Quads_PushTtok (field, fieldtok);
14384 12040 : M2Quads_BuildInclBit ();
14385 12040 : M2Quads_PopT (&value);
14386 : }
14387 : else
14388 : {
14389 13742 : SymbolTable_PushValue (value);
14390 13742 : M2ALU_AddField (fieldtok, field);
14391 13742 : SymbolTable_PopValue (value);
14392 : }
14393 25782 : return value;
14394 : /* static analysis guarentees a RETURN statement will be used before here. */
14395 : __builtin_unreachable ();
14396 : }
14397 :
14398 :
14399 : /*
14400 : CheckLogicalOperator - returns a logical operator if the operands imply
14401 : a logical operation should be performed.
14402 : */
14403 :
14404 78406 : static NameKey_Name CheckLogicalOperator (NameKey_Name Tok, unsigned int left, unsigned int lefttype)
14405 : {
14406 78406 : if ((((Tok == M2Reserved_PlusTok) || (Tok == M2Reserved_TimesTok)) || (Tok == M2Reserved_DivideTok)) || (Tok == M2Reserved_MinusTok))
14407 : {
14408 : /* --fixme-- when we add complex arithmetic, we must check constructor is not a complex constant. */
14409 69164 : if ((((lefttype != SymbolTable_NulSym) && (SymbolTable_IsSet (SymbolTable_SkipType (lefttype)))) || (SymbolTable_IsConstSet (left))) || (SymbolTable_IsConstructor (left)))
14410 : {
14411 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
14412 1448 : if (Tok == M2Reserved_PlusTok)
14413 : {
14414 974 : return LogicalOrTok;
14415 : }
14416 474 : else if (Tok == M2Reserved_DivideTok)
14417 : {
14418 : /* avoid dangling else. */
14419 124 : return LogicalXorTok;
14420 : }
14421 350 : else if (Tok == M2Reserved_TimesTok)
14422 : {
14423 : /* avoid dangling else. */
14424 284 : return LogicalAndTok;
14425 : }
14426 66 : else if (Tok == M2Reserved_MinusTok)
14427 : {
14428 : /* avoid dangling else. */
14429 66 : return LogicalDifferenceTok;
14430 : }
14431 : }
14432 : }
14433 : return Tok;
14434 : /* static analysis guarentees a RETURN statement will be used before here. */
14435 : __builtin_unreachable ();
14436 : }
14437 :
14438 :
14439 : /*
14440 : CheckDivModRem - initiates calls to check the divisor for DIV, MOD, REM
14441 : expressions.
14442 : */
14443 :
14444 77806 : static void CheckDivModRem (unsigned int TokPos, NameKey_Name tok, unsigned int d, unsigned int e)
14445 : {
14446 77806 : if (tok == M2Reserved_DivTok)
14447 : {
14448 6786 : BuildRange (M2Range_InitWholeZeroDivisionCheck (TokPos, d, e));
14449 : }
14450 71020 : else if (tok == M2Reserved_ModTok)
14451 : {
14452 : /* avoid dangling else. */
14453 2360 : BuildRange (M2Range_InitWholeZeroDivisionCheck (TokPos, d, e));
14454 : }
14455 68660 : else if (tok == M2Reserved_RemTok)
14456 : {
14457 : /* avoid dangling else. */
14458 96 : BuildRange (M2Range_InitWholeZeroRemainderCheck (TokPos, d, e));
14459 : }
14460 77806 : }
14461 :
14462 :
14463 : /*
14464 : doConvert - convert, sym, to a new symbol with, type.
14465 : Return the new symbol.
14466 : */
14467 :
14468 5152 : static unsigned int doConvert (unsigned int type, unsigned int sym)
14469 : {
14470 5152 : if ((SymbolTable_GetSType (sym)) != type)
14471 : {
14472 1064 : M2Quads_PushTF (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym));
14473 1064 : M2Quads_PushT (type);
14474 1064 : M2Quads_PushT (sym);
14475 1064 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters */
14476 1064 : BuildConvertFunction (M2Base_Convert, false); /* Two parameters */
14477 1058 : M2Quads_PopT (&sym);
14478 : }
14479 5146 : return sym;
14480 : /* static analysis guarentees a RETURN statement will be used before here. */
14481 : __builtin_unreachable ();
14482 : }
14483 :
14484 :
14485 : /*
14486 : doBuildBinaryOp - build the binary op, with or without type
14487 : checking.
14488 : */
14489 :
14490 91578 : static void doBuildBinaryOp (bool checkTypes, bool checkOverflow)
14491 : {
14492 91578 : DynamicStrings_String s;
14493 91578 : NameKey_Name NewOp;
14494 91578 : NameKey_Name Operator;
14495 91578 : unsigned int OperatorPos;
14496 91578 : unsigned int OldPos;
14497 91578 : unsigned int leftrw;
14498 91578 : unsigned int rightrw;
14499 91578 : unsigned int t1;
14500 91578 : unsigned int f1;
14501 91578 : unsigned int t2;
14502 91578 : unsigned int f2;
14503 91578 : unsigned int lefttype;
14504 91578 : unsigned int righttype;
14505 91578 : unsigned int left;
14506 91578 : unsigned int right;
14507 91578 : unsigned int leftpos;
14508 91578 : unsigned int rightpos;
14509 91578 : unsigned int value;
14510 :
14511 91578 : Operator = static_cast<NameKey_Name> (M2Quads_OperandT (2));
14512 91578 : if (Operator == M2Reserved_OrTok)
14513 : {
14514 3536 : CheckBooleanId ();
14515 3536 : PopBooltok (&t1, &f1, &rightpos);
14516 3536 : M2Quads_PopTtok (&Operator, &OperatorPos);
14517 3536 : PopBooltok (&t2, &f2, &leftpos);
14518 3536 : M2Debug_Assert (f2 == 0);
14519 3536 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14520 3536 : PushBooltok (Merge (t1, t2), f1, OperatorPos);
14521 : }
14522 88042 : else if ((Operator == M2Reserved_AndTok) || (Operator == M2Reserved_AmbersandTok))
14523 : {
14524 : /* avoid dangling else. */
14525 9636 : CheckBooleanId ();
14526 9636 : PopBooltok (&t1, &f1, &rightpos);
14527 9636 : M2Quads_PopTtok (&Operator, &OperatorPos);
14528 9636 : PopBooltok (&t2, &f2, &leftpos);
14529 9636 : M2Debug_Assert (t2 == 0);
14530 9636 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14531 9636 : PushBooltok (t1, Merge (f1, f2), OperatorPos);
14532 : }
14533 : else
14534 : {
14535 : /* avoid dangling else. */
14536 78406 : PopTFrwtok (&right, &righttype, &rightrw, &rightpos);
14537 78406 : M2Quads_PopTtok (&Operator, &OperatorPos);
14538 78406 : PopTFrwtok (&left, &lefttype, &leftrw, &leftpos);
14539 78406 : MarkAsRead (rightrw);
14540 78406 : MarkAsRead (leftrw);
14541 78406 : NewOp = CheckLogicalOperator (Operator, left, lefttype); /* right, righttype, */
14542 78406 : if (NewOp == Operator)
14543 : {
14544 : /* avoid dangling else. */
14545 : /*
14546 : BinaryOps and UnaryOps only work with immediate and
14547 : offset addressing. This is fine for calculating
14548 : array and record offsets but we need to get the real
14549 : values to perform normal arithmetic. Not address
14550 : arithmetic.
14551 :
14552 : However the set operators will dereference LValues
14553 : (to optimize large set arithemetic)
14554 : */
14555 76958 : if ((SymbolTable_GetMode (right)) == SymbolTable_LeftValue)
14556 : {
14557 298 : value = SymbolTable_MakeTemporary (rightpos, SymbolTable_RightValue);
14558 298 : SymbolTable_PutVar (value, righttype);
14559 298 : CheckPointerThroughNil (rightpos, right);
14560 298 : doIndrX (rightpos, value, right);
14561 298 : right = value;
14562 : }
14563 76958 : if ((SymbolTable_GetMode (left)) == SymbolTable_LeftValue)
14564 : {
14565 844 : value = SymbolTable_MakeTemporary (leftpos, SymbolTable_RightValue);
14566 844 : SymbolTable_PutVar (value, lefttype);
14567 844 : CheckPointerThroughNil (leftpos, left);
14568 844 : doIndrX (leftpos, value, left);
14569 844 : left = value;
14570 : }
14571 : }
14572 : /* CheckForGenericNulSet(e1, e2, t1, t2) */
14573 78406 : OldPos = OperatorPos;
14574 78406 : OperatorPos = M2LexBuf_MakeVirtualTok (OperatorPos, leftpos, rightpos);
14575 78406 : if (((Operator == M2Reserved_PlusTok) && (SymbolTable_IsConstString (left))) && (SymbolTable_IsConstString (right)))
14576 : {
14577 492 : value = SymbolTable_MakeConstString (OperatorPos, NameKey_NulName);
14578 492 : SymbolTable_PutConstStringKnown (OperatorPos, value, NameKey_NulName, false, false);
14579 492 : GenQuadOtok (OperatorPos, MakeOp (M2Reserved_PlusTok), value, left, right, false, OperatorPos, leftpos, rightpos);
14580 : }
14581 : else
14582 : {
14583 77914 : if (checkTypes)
14584 : {
14585 60055 : BuildRange (M2Range_InitTypesExpressionCheck (OperatorPos, left, right, false, false));
14586 : }
14587 120654 : value = SymbolTable_MakeTemporaryFromExpressions (OperatorPos, right, left, AreConstant ((SymbolTable_IsConst (left)) && (SymbolTable_IsConst (right))));
14588 77806 : CheckDivModRem (OperatorPos, NewOp, value, right);
14589 77806 : if (DebugTokPos)
14590 : {
14591 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (M2LexBuf_GetTokenName (Operator)));
14592 : M2Error_WarnStringAt (s, OldPos);
14593 : s = DynamicStrings_InitString ((const char *) "left", 4);
14594 : M2Error_WarnStringAt (s, leftpos);
14595 : s = DynamicStrings_InitString ((const char *) "right", 5);
14596 : M2Error_WarnStringAt (s, rightpos);
14597 : s = DynamicStrings_InitString ((const char *) "caret", 5);
14598 : M2Error_WarnStringAt (s, OldPos);
14599 : s = DynamicStrings_InitString ((const char *) "combined", 8);
14600 : M2Error_WarnStringAt (s, OperatorPos);
14601 : }
14602 : /* MetaErrorT1 (GetDeclaredMod (t), 'in binary with a {%1av}', t) */
14603 77806 : GenQuadOtok (OperatorPos, MakeOp (NewOp), value, left, right, checkOverflow, OperatorPos, leftpos, rightpos);
14604 : }
14605 78298 : M2Quads_PushTFtok (value, SymbolTable_GetSType (value), OperatorPos);
14606 : }
14607 91470 : }
14608 :
14609 :
14610 : /*
14611 : AreConstant - returns immediate addressing mode if b is true else
14612 : offset mode is returned. b determines whether the
14613 : operands are all constant - in which case we can use
14614 : a constant temporary variable.
14615 : */
14616 :
14617 160359 : static SymbolTable_ModeOfAddr AreConstant (bool b)
14618 : {
14619 131965 : if (b)
14620 : {
14621 : return SymbolTable_ImmediateValue;
14622 : }
14623 : else
14624 : {
14625 60056 : return SymbolTable_RightValue;
14626 : }
14627 : /* static analysis guarentees a RETURN statement will be used before here. */
14628 : __builtin_unreachable ();
14629 : }
14630 :
14631 :
14632 : /*
14633 : ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
14634 : exit pair into a variable containing the value TRUE or
14635 : FALSE. The parameter i is relative to the top
14636 : of the stack.
14637 : */
14638 :
14639 7344 : static void ConvertBooleanToVariable (unsigned int tok, unsigned int i)
14640 : {
14641 7344 : unsigned int Des;
14642 7344 : M2Quads_BoolFrame f;
14643 :
14644 7344 : M2Debug_Assert (IsBoolean (i));
14645 : /* We need to convert the boolean top of stack into a variable or
14646 : constant boolean. */
14647 14556 : Des = SymbolTable_MakeTemporary (tok, AreConstant (M2Quads_IsInConstExpression ()));
14648 7344 : SymbolTable_PutVar (Des, M2Base_Boolean);
14649 7344 : SymbolTable_PutVarConditional (Des, true);
14650 7344 : M2Quads_PushTtok (Des, tok); /* we have just increased the stack so we must use i+1 */
14651 7344 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, i+1)); /* we have just increased the stack so we must use i+1 */
14652 14688 : PushBool (f->TrueExit, f->FalseExit);
14653 7344 : BuildAssignmentWithoutBounds (tok, false, true);
14654 : /* Restored stack after the BuildAssign... above. */
14655 7344 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, i));
14656 7344 : f->TrueExit = Des; /* Alter Stack(i) to contain the variable. */
14657 7344 : f->FalseExit = M2Base_Boolean; /* Alter Stack(i) to contain the variable. */
14658 7344 : f->BooleanOp = false; /* No longer a Boolean True|False pair. */
14659 7344 : f->Unbounded = SymbolTable_NulSym; /* No longer a Boolean True|False pair. */
14660 7344 : f->Dimension = 0;
14661 7344 : f->ReadWrite = SymbolTable_NulSym;
14662 7344 : f->tokenno = tok;
14663 7344 : f->Annotation = DynamicStrings_KillString (f->Annotation);
14664 7344 : f->Annotation = DynamicStrings_InitString ((const char *) "%1s(%1d)|%2s(%2d)||boolean var|type", 35);
14665 7344 : f->RangeDep = 0;
14666 7344 : }
14667 :
14668 :
14669 : /*
14670 : DumpQuadSummary -
14671 : */
14672 :
14673 0 : static void DumpQuadSummary (unsigned int quad)
14674 : {
14675 0 : M2Quads_QuadFrame f;
14676 :
14677 0 : if (quad != 0)
14678 : {
14679 0 : f = GetQF (quad);
14680 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));
14681 : }
14682 0 : }
14683 :
14684 :
14685 : /*
14686 : BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
14687 : instead of using a temporary boolean variable.
14688 : This function can only be used when we perform
14689 : the following translation:
14690 :
14691 : (a=b) # (c=d) alternatively (a=b) = (c=d)
14692 : ^ ^
14693 :
14694 : it only allows # = to be used as >= <= > < all
14695 : assume a particular value for TRUE and FALSE.
14696 : (In which case the user should specify ORD)
14697 :
14698 :
14699 : before
14700 :
14701 : q if r1 op1 op2 t2
14702 : q+1 Goto f2
14703 : ...
14704 : q+n if r2 op3 op4 t1
14705 : q+n+1 Goto f1
14706 :
14707 : after (in case of =)
14708 :
14709 : q if r1 op1 op2 q+2
14710 : q+1 Goto q+4
14711 : q+2 if r2 op3 op4 t
14712 : q+3 Goto f
14713 : q+4 if r2 op3 op4 f
14714 : q+5 Goto t
14715 :
14716 : after (in case of #)
14717 :
14718 : q if r1 op1 op2 q+2
14719 : q+1 Goto q+n+2
14720 : q+2 ...
14721 : ... ...
14722 : q+n if r2 op3 op4 f
14723 : q+n+1 Goto t
14724 : q+n+2 if r2 op3 op4 t
14725 : q+n+3 Goto f
14726 :
14727 : The Stack is expected to contain:
14728 :
14729 :
14730 : Entry Exit
14731 : ===== ====
14732 :
14733 : Ptr ->
14734 : +------------+
14735 : | t1 | f1 |
14736 : |------------|
14737 : | Operator | <- Ptr
14738 : |------------| +------------+
14739 : | t2 | f2 | | t | f |
14740 : |------------| |------------|
14741 :
14742 :
14743 : */
14744 :
14745 0 : static void BuildRelOpFromBoolean (unsigned int tokpos)
14746 : {
14747 0 : unsigned int Tok;
14748 0 : unsigned int t1;
14749 0 : unsigned int f1;
14750 0 : unsigned int t2;
14751 0 : unsigned int f2;
14752 0 : M2Quads_QuadFrame f;
14753 :
14754 0 : M2Debug_Assert ((IsBoolean (1)) && (IsBoolean (3)));
14755 0 : if ((M2Quads_OperandT (2)) == M2Reserved_EqualTok)
14756 : {
14757 : /* Are the two boolean expressions the same? */
14758 0 : PopBool (&t1, &f1);
14759 0 : M2Quads_PopT (&Tok);
14760 0 : PopBool (&t2, &f2);
14761 : /* Give the false exit a second chance. */
14762 0 : BackPatch (t2, t1); /* q if _ _ q+2 */
14763 0 : BackPatch (f2, NextQuad); /* q+1 if _ _ q+4 */
14764 0 : M2Debug_Assert (NextQuad == (f1+1)); /* q+1 if _ _ q+4 */
14765 0 : f = GetQF (t1);
14766 0 : GenQuadO (tokpos, f->Operator, f->Operand1, f->Operand2, 0, false);
14767 0 : GenQuadO (tokpos, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
14768 0 : PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos);
14769 : }
14770 0 : else if (((M2Quads_OperandT (2)) == M2Reserved_HashTok) || ((M2Quads_OperandT (2)) == M2Reserved_LessGreaterTok))
14771 : {
14772 : /* avoid dangling else. */
14773 0 : if (M2Options_CompilerDebugging)
14774 : {
14775 0 : M2Printf_printf0 ((const char *) "BuildRelOpFromBoolean (NotEqualTok)\\n", 37);
14776 0 : M2Quads_DisplayStack ();
14777 : }
14778 : /* Are the two boolean expressions different? */
14779 0 : PopBool (&t1, &f1);
14780 0 : M2Quads_PopT (&Tok);
14781 0 : PopBool (&t2, &f2);
14782 0 : if (M2Options_CompilerDebugging)
14783 : {
14784 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));
14785 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));
14786 0 : DumpQuadSummary (t1);
14787 0 : DumpQuadSummary (f1);
14788 0 : DumpQuadSummary (t2);
14789 0 : DumpQuadSummary (f2);
14790 : }
14791 : /* Give the false exit a second chance. */
14792 0 : BackPatch (t2, t1); /* q if _ _ q+2 */
14793 0 : BackPatch (f2, NextQuad); /* q+1 if _ _ q+4 */
14794 0 : M2Debug_Assert (NextQuad == (f1+1)); /* q+1 if _ _ q+4 */
14795 0 : f = GetQF (t1);
14796 0 : GenQuadO (tokpos, f->Operator, f->Operand1, f->Operand2, 0, false);
14797 0 : GenQuadO (tokpos, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
14798 0 : PushBooltok (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1), tokpos);
14799 : }
14800 : else
14801 : {
14802 : /* avoid dangling else. */
14803 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);
14804 : }
14805 0 : }
14806 :
14807 :
14808 : /*
14809 : CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
14810 : */
14811 :
14812 181532 : static void CheckVariableOrConstantOrProcedure (unsigned int tokpos, unsigned int sym)
14813 : {
14814 181532 : unsigned int type;
14815 :
14816 181532 : type = SymbolTable_GetSType (sym);
14817 181532 : if (SymbolTable_IsUnknown (sym))
14818 : {
14819 : /* Spellcheck. */
14820 12 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1EUad} has not been declared {%1&s}", 37, sym);
14821 12 : SymbolTable_UnknownReported (sym);
14822 : }
14823 181520 : else if ((M2System_IsPseudoSystemFunction (sym)) || (M2Base_IsPseudoBaseFunction (sym)))
14824 : {
14825 : /* avoid dangling else. */
14826 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1Ead} expected a variable, procedure, constant or expression, not an intrinsic procedure function", 99, sym);
14827 : }
14828 181514 : else if (((((! (SymbolTable_IsConst (sym))) && (! (SymbolTable_IsVar (sym)))) && (! (SymbolTable_IsProcedure (sym)))) && (! (SymbolTable_IsTemporary (sym)))) && ! MustNotCheckBounds)
14829 : {
14830 : /* avoid dangling else. */
14831 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);
14832 : }
14833 181514 : else if ((type != SymbolTable_NulSym) && (SymbolTable_IsArray (type)))
14834 : {
14835 : /* avoid dangling else. */
14836 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);
14837 : }
14838 181514 : else if (((SymbolTable_IsConstString (sym)) && (SymbolTable_IsConstStringKnown (sym))) && ((SymbolTable_GetStringLength (tokpos, sym)) > 1))
14839 : {
14840 : /* avoid dangling else. */
14841 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1EU} not expecting a string constant as an operand for either comparison or binary operation", 94, sym);
14842 : }
14843 181532 : }
14844 :
14845 :
14846 : /*
14847 : MakeOp - returns the equalent quadruple operator to a token, t.
14848 : */
14849 :
14850 169064 : static M2Quads_QuadOperator MakeOp (NameKey_Name t)
14851 : {
14852 169064 : if (t == ArithPlusTok)
14853 : {
14854 : return M2Quads_ArithAddOp;
14855 : }
14856 169064 : else if (t == M2Reserved_PlusTok)
14857 : {
14858 : /* avoid dangling else. */
14859 : return M2Quads_AddOp;
14860 : }
14861 144581 : else if (t == M2Reserved_MinusTok)
14862 : {
14863 : /* avoid dangling else. */
14864 : return M2Quads_SubOp;
14865 : }
14866 121837 : else if (t == M2Reserved_DivTok)
14867 : {
14868 : /* avoid dangling else. */
14869 : return M2Quads_DivM2Op;
14870 : }
14871 115051 : else if (t == M2Reserved_DivideTok)
14872 : {
14873 : /* avoid dangling else. */
14874 : return M2Quads_DivTruncOp;
14875 : }
14876 112593 : else if (t == M2Reserved_RemTok)
14877 : {
14878 : /* avoid dangling else. */
14879 : return M2Quads_ModTruncOp;
14880 : }
14881 112497 : else if (t == M2Reserved_ModTok)
14882 : {
14883 : /* avoid dangling else. */
14884 : return M2Quads_ModM2Op;
14885 : }
14886 110137 : else if (t == M2Reserved_TimesTok)
14887 : {
14888 : /* avoid dangling else. */
14889 : return M2Quads_MultOp;
14890 : }
14891 92196 : else if (t == M2Reserved_HashTok)
14892 : {
14893 : /* avoid dangling else. */
14894 : return M2Quads_IfNotEquOp;
14895 : }
14896 79739 : else if (t == M2Reserved_LessGreaterTok)
14897 : {
14898 : /* avoid dangling else. */
14899 : return M2Quads_IfNotEquOp;
14900 : }
14901 79655 : else if (t == M2Reserved_GreaterEqualTok)
14902 : {
14903 : /* avoid dangling else. */
14904 : return M2Quads_IfGreEquOp;
14905 : }
14906 69173 : else if (t == M2Reserved_LessEqualTok)
14907 : {
14908 : /* avoid dangling else. */
14909 : return M2Quads_IfLessEquOp;
14910 : }
14911 64427 : else if (t == M2Reserved_EqualTok)
14912 : {
14913 : /* avoid dangling else. */
14914 : return M2Quads_IfEquOp;
14915 : }
14916 17473 : else if (t == M2Reserved_LessTok)
14917 : {
14918 : /* avoid dangling else. */
14919 : return M2Quads_IfLessOp;
14920 : }
14921 9916 : else if (t == M2Reserved_GreaterTok)
14922 : {
14923 : /* avoid dangling else. */
14924 : return M2Quads_IfGreOp;
14925 : }
14926 3876 : else if (t == M2Reserved_InTok)
14927 : {
14928 : /* avoid dangling else. */
14929 : return M2Quads_IfInOp;
14930 : }
14931 1430 : else if (t == LogicalOrTok)
14932 : {
14933 : /* avoid dangling else. */
14934 : return M2Quads_LogicalOrOp;
14935 : }
14936 474 : else if (t == LogicalAndTok)
14937 : {
14938 : /* avoid dangling else. */
14939 : return M2Quads_LogicalAndOp;
14940 : }
14941 190 : else if (t == LogicalXorTok)
14942 : {
14943 : /* avoid dangling else. */
14944 : return M2Quads_LogicalXorOp;
14945 : }
14946 66 : else if (t == LogicalDifferenceTok)
14947 : {
14948 : /* avoid dangling else. */
14949 : return M2Quads_LogicalDiffOp;
14950 : }
14951 : else
14952 : {
14953 : /* avoid dangling else. */
14954 0 : M2Error_InternalError ((const char *) "binary operation not implemented yet", 36);
14955 : }
14956 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
14957 : __builtin_unreachable ();
14958 : }
14959 :
14960 :
14961 : /*
14962 : GenQuadO - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
14963 : */
14964 :
14965 5406988 : static void GenQuadO (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow)
14966 : {
14967 1200539 : GenQuadOTrash (TokPos, Operation, Op1, Op2, Op3, overflow, SymbolTable_NulSym);
14968 0 : }
14969 :
14970 :
14971 : /*
14972 : GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
14973 : */
14974 :
14975 5408826 : static void GenQuadOTrash (unsigned int TokPos, M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3, bool overflow, unsigned int trash)
14976 : {
14977 5408826 : M2Quads_QuadFrame f;
14978 :
14979 : /* WriteString('Potential Quad: ') ; */
14980 5408826 : if (QuadrupleGeneration)
14981 : {
14982 5406581 : if (NextQuad != Head)
14983 : {
14984 5391514 : f = GetQF (NextQuad-1);
14985 5391514 : f->Next = NextQuad;
14986 : }
14987 5406581 : PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow);
14988 5406581 : f = GetQF (NextQuad);
14989 5406581 : f->Trash = trash;
14990 5406581 : f->Next = 0;
14991 5406581 : f->LineNo = M2LexBuf_GetLineNo ();
14992 5406581 : if (TokPos == M2LexBuf_UnknownTokenNo)
14993 : {
14994 3236541 : f->TokenNo = M2LexBuf_GetTokenNo ();
14995 : }
14996 : else
14997 : {
14998 2170040 : f->TokenNo = TokPos;
14999 : }
15000 5406581 : if (M2Options_GetDebugTraceQuad ())
15001 : {
15002 0 : M2Printf_printf0 ((const char *) "generating: ", 12);
15003 0 : M2Quads_DisplayQuad (NextQuad);
15004 : }
15005 : /* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) */
15006 5406581 : CheckBreak (NextQuad);
15007 5406581 : NewQuad (&NextQuad);
15008 : }
15009 5408826 : }
15010 :
15011 :
15012 : /*
15013 : GenQuad - Generate a quadruple with Operation, Op1, Op2, Op3.
15014 : */
15015 :
15016 3166350 : static void GenQuad (M2Quads_QuadOperator Operation, unsigned int Op1, unsigned int Op2, unsigned int Op3)
15017 : {
15018 2181284 : GenQuadO (M2LexBuf_UnknownTokenNo, Operation, Op1, Op2, Op3, true);
15019 0 : }
15020 :
15021 :
15022 : /*
15023 : GenQuadOtok - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
15024 : */
15025 :
15026 572414 : 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)
15027 : {
15028 481648 : GenQuadOTypetok (TokPos, Operation, Op1, Op2, Op3, overflow, true, Op1Pos, Op2Pos, Op3Pos);
15029 0 : }
15030 :
15031 :
15032 : /*
15033 : GenQuadOTypetok - assigns the fields of the quadruple with
15034 : the parameters.
15035 : */
15036 :
15037 876087 : 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)
15038 : {
15039 876087 : M2Quads_QuadFrame f;
15040 :
15041 : /* WriteString('Potential Quad: ') ; */
15042 876087 : if (QuadrupleGeneration)
15043 : {
15044 875396 : if (NextQuad != Head)
15045 : {
15046 875396 : f = GetQF (NextQuad-1);
15047 875396 : f->Next = NextQuad;
15048 : }
15049 875396 : PutQuadOType (NextQuad, Operation, Op1, Op2, Op3, overflow, typecheck);
15050 875396 : f = GetQF (NextQuad);
15051 875396 : f->Next = 0;
15052 875396 : f->LineNo = M2LexBuf_GetLineNo ();
15053 875396 : if (TokPos == M2LexBuf_UnknownTokenNo)
15054 : {
15055 0 : f->TokenNo = M2LexBuf_GetTokenNo ();
15056 : }
15057 : else
15058 : {
15059 875396 : f->TokenNo = TokPos;
15060 : }
15061 875396 : f->op1pos = Op1Pos;
15062 875396 : f->op2pos = Op2Pos;
15063 875396 : f->op3pos = Op3Pos;
15064 875396 : if (M2Options_GetDebugTraceQuad ())
15065 : {
15066 0 : M2Printf_printf0 ((const char *) "generating: ", 12);
15067 0 : M2Quads_DisplayQuad (NextQuad);
15068 : }
15069 : /* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) */
15070 875396 : CheckBreak (NextQuad);
15071 875396 : NewQuad (&NextQuad);
15072 : }
15073 876087 : }
15074 :
15075 :
15076 : /*
15077 : DumpUntil - dump all quadruples until we seen the ending quadruple
15078 : with procsym in the third operand.
15079 : Return the quad number containing the match.
15080 : */
15081 :
15082 0 : static unsigned int DumpUntil (M2Quads_QuadOperator ending, unsigned int procsym, unsigned int quad)
15083 : {
15084 0 : M2Quads_QuadOperator op;
15085 0 : unsigned int op1;
15086 0 : unsigned int op2;
15087 0 : unsigned int op3;
15088 0 : M2Quads_QuadFrame f;
15089 :
15090 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "\\n...\\n\\n", 9);
15091 0 : do {
15092 0 : M2Quads_GetQuad (quad, &op, &op1, &op2, &op3);
15093 0 : M2Quads_DisplayQuad (quad);
15094 0 : f = GetQF (quad);
15095 0 : quad = f->Next;
15096 0 : } while (! ((op == ending) && (op3 == procsym)));
15097 0 : return quad;
15098 : /* static analysis guarentees a RETURN statement will be used before here. */
15099 : __builtin_unreachable ();
15100 : }
15101 :
15102 :
15103 : /*
15104 : GetCtorInit - return the init procedure for the module.
15105 : */
15106 :
15107 0 : static unsigned int GetCtorInit (unsigned int sym)
15108 : {
15109 0 : unsigned int ctor;
15110 0 : unsigned int init;
15111 0 : unsigned int fini;
15112 0 : unsigned int dep;
15113 :
15114 0 : SymbolTable_GetModuleCtors (sym, &ctor, &init, &fini, &dep);
15115 0 : return init;
15116 : /* static analysis guarentees a RETURN statement will be used before here. */
15117 : __builtin_unreachable ();
15118 : }
15119 :
15120 :
15121 : /*
15122 : GetCtorFini - return the fini procedure for the module.
15123 : */
15124 :
15125 0 : static unsigned int GetCtorFini (unsigned int sym)
15126 : {
15127 0 : unsigned int ctor;
15128 0 : unsigned int init;
15129 0 : unsigned int fini;
15130 0 : unsigned int dep;
15131 :
15132 0 : SymbolTable_GetModuleCtors (sym, &ctor, &init, &fini, &dep);
15133 0 : return fini;
15134 : /* static analysis guarentees a RETURN statement will be used before here. */
15135 : __builtin_unreachable ();
15136 : }
15137 :
15138 :
15139 : /*
15140 : DumpQuadrupleFilter -
15141 : */
15142 :
15143 0 : static void DumpQuadrupleFilter (void)
15144 : {
15145 0 : M2Quads_QuadFrame f;
15146 0 : unsigned int i;
15147 0 : M2Quads_QuadOperator op;
15148 0 : unsigned int op1;
15149 0 : unsigned int op2;
15150 0 : unsigned int op3;
15151 :
15152 0 : i = Head;
15153 0 : while (i != 0)
15154 : {
15155 0 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
15156 0 : if ((op == M2Quads_ProcedureScopeOp) && (M2LangDump_IsDumpRequired (op3, true)))
15157 : {
15158 0 : i = DumpUntil (M2Quads_KillLocalVarOp, op3, i);
15159 : }
15160 0 : else if ((op == M2Quads_InitStartOp) && (M2LangDump_IsDumpRequired (GetCtorInit (op3), true)))
15161 : {
15162 : /* avoid dangling else. */
15163 0 : i = DumpUntil (M2Quads_InitEndOp, op3, i);
15164 : }
15165 0 : else if ((op == M2Quads_FinallyStartOp) && (M2LangDump_IsDumpRequired (GetCtorFini (op3), true)))
15166 : {
15167 : /* avoid dangling else. */
15168 0 : i = DumpUntil (M2Quads_FinallyEndOp, op3, i);
15169 : }
15170 : else
15171 : {
15172 : /* avoid dangling else. */
15173 0 : f = GetQF (i);
15174 0 : i = f->Next;
15175 : }
15176 : }
15177 0 : }
15178 :
15179 :
15180 : /*
15181 : DumpQuadrupleAll - dump all quadruples.
15182 : */
15183 :
15184 0 : static void DumpQuadrupleAll (void)
15185 : {
15186 0 : M2Quads_QuadFrame f;
15187 0 : unsigned int i;
15188 :
15189 0 : i = Head;
15190 0 : while (i != 0)
15191 : {
15192 0 : M2Quads_DisplayQuad (i);
15193 0 : f = GetQF (i);
15194 0 : i = f->Next;
15195 : }
15196 0 : }
15197 :
15198 :
15199 : /*
15200 : BackPatch - Makes each of the quadruples on the list pointed to by
15201 : QuadNo take quadruple Value as a target.
15202 : */
15203 :
15204 416214 : static void BackPatch (unsigned int QuadNo, unsigned int Value)
15205 : {
15206 416214 : unsigned int i;
15207 416214 : M2Quads_QuadFrame f;
15208 :
15209 416214 : if (QuadrupleGeneration)
15210 : {
15211 661626 : while (QuadNo != 0)
15212 : {
15213 245429 : f = GetQF (QuadNo);
15214 245429 : i = f->Operand3; /* Next Link along the BackPatch */
15215 245429 : ManipulateReference (QuadNo, Value); /* Filling in the BackPatch. */
15216 245429 : QuadNo = i;
15217 : }
15218 : }
15219 416214 : }
15220 :
15221 :
15222 : /*
15223 : Merge - joins two quad lists, QuadList2 to the end of QuadList1.
15224 : A QuadList of value zero is a nul list.
15225 : */
15226 :
15227 53920 : static unsigned int Merge (unsigned int QuadList1, unsigned int QuadList2)
15228 : {
15229 53920 : unsigned int i;
15230 53920 : unsigned int j;
15231 53920 : M2Quads_QuadFrame f;
15232 :
15233 53920 : if (QuadList1 == 0)
15234 : {
15235 : return QuadList2;
15236 : }
15237 26430 : else if (QuadList2 == 0)
15238 : {
15239 : /* avoid dangling else. */
15240 : return QuadList1;
15241 : }
15242 : else
15243 : {
15244 : /* avoid dangling else. */
15245 : i = QuadList1;
15246 51806 : do {
15247 51806 : j = i;
15248 51806 : f = GetQF (i);
15249 51806 : i = f->Operand3;
15250 51806 : } while (! (i == 0));
15251 23224 : ManipulateReference (j, QuadList2);
15252 23224 : return QuadList1;
15253 : }
15254 : /* static analysis guarentees a RETURN statement will be used before here. */
15255 : __builtin_unreachable ();
15256 : }
15257 :
15258 :
15259 : /*
15260 : DisplayProcedureAttributes -
15261 : */
15262 :
15263 0 : static void DisplayProcedureAttributes (unsigned int proc)
15264 : {
15265 0 : if (SymbolTable_IsCtor (proc))
15266 : {
15267 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (ctor)", 7);
15268 : }
15269 0 : if (SymbolTable_IsPublic (proc))
15270 : {
15271 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (public)", 9);
15272 : }
15273 0 : if (SymbolTable_IsExtern (proc))
15274 : {
15275 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (extern)", 9);
15276 : }
15277 0 : if (SymbolTable_IsMonoName (proc))
15278 : {
15279 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " (mononame)", 11);
15280 : }
15281 0 : }
15282 :
15283 :
15284 : /*
15285 : WriteQuad - Writes out the Quad BufferQuad.
15286 : */
15287 :
15288 0 : static void WriteQuad (unsigned int BufferQuad)
15289 : {
15290 0 : NameKey_Name n1;
15291 0 : NameKey_Name n2;
15292 0 : M2Quads_QuadFrame f;
15293 0 : NameKey_Name n;
15294 0 : unsigned int l;
15295 :
15296 0 : f = GetQF (BufferQuad);
15297 0 : M2Quads_WriteOperator (f->Operator);
15298 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " [%d]", 5, (const unsigned char *) &f->NoOfTimesReferenced, (sizeof (f->NoOfTimesReferenced)-1));
15299 0 : if (f->ConstExpr)
15300 : {
15301 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " const ", 7);
15302 : }
15303 : else
15304 : {
15305 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 7);
15306 : }
15307 0 : switch (f->Operator)
15308 : {
15309 0 : case M2Quads_LastForIteratorOp:
15310 0 : M2Quads_WriteOperand (f->Operand1);
15311 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15312 0 : M2Quads_WriteOperand (f->Operand2);
15313 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15314 0 : M2Quads_WriteOperand (f->Operand3);
15315 0 : break;
15316 :
15317 0 : case M2Quads_HighOp:
15318 0 : M2Quads_WriteOperand (f->Operand1);
15319 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %4d ", 7, (const unsigned char *) &f->Operand2, (sizeof (f->Operand2)-1));
15320 0 : M2Quads_WriteOperand (f->Operand3);
15321 0 : break;
15322 :
15323 0 : case M2Quads_InitAddressOp:
15324 0 : case M2Quads_SavePriorityOp:
15325 0 : case M2Quads_RestorePriorityOp:
15326 0 : case M2Quads_SubrangeLowOp:
15327 0 : case M2Quads_SubrangeHighOp:
15328 0 : case M2Quads_BecomesOp:
15329 0 : case M2Quads_InclOp:
15330 0 : case M2Quads_ExclOp:
15331 0 : case M2Quads_UnboundedOp:
15332 0 : case M2Quads_ReturnValueOp:
15333 0 : case M2Quads_FunctValueOp:
15334 0 : case M2Quads_NegateOp:
15335 0 : case M2Quads_AddrOp:
15336 0 : case M2Quads_StringConvertCnulOp:
15337 0 : case M2Quads_StringConvertM2nulOp:
15338 0 : case M2Quads_StringLengthOp:
15339 0 : M2Quads_WriteOperand (f->Operand1);
15340 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15341 0 : M2Quads_WriteOperand (f->Operand3);
15342 0 : break;
15343 :
15344 0 : case M2Quads_ElementSizeOp:
15345 0 : case M2Quads_IfInOp:
15346 0 : case M2Quads_IfNotInOp:
15347 0 : case M2Quads_IfNotEquOp:
15348 0 : case M2Quads_IfEquOp:
15349 0 : case M2Quads_IfLessOp:
15350 0 : case M2Quads_IfGreOp:
15351 0 : case M2Quads_IfLessEquOp:
15352 0 : case M2Quads_IfGreEquOp:
15353 0 : M2Quads_WriteOperand (f->Operand1);
15354 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15355 0 : M2Quads_WriteOperand (f->Operand2);
15356 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %4d", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15357 0 : break;
15358 :
15359 0 : case M2Quads_InlineOp:
15360 0 : case M2Quads_RetryOp:
15361 0 : case M2Quads_TryOp:
15362 0 : case M2Quads_GotoOp:
15363 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d", 3, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15364 0 : break;
15365 :
15366 0 : case M2Quads_StatementNoteOp:
15367 0 : l = M2LexBuf_TokenToLineNo (f->Operand3, 0);
15368 0 : n = M2LexBuf_GetTokenName (f->Operand3);
15369 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));
15370 0 : break;
15371 :
15372 0 : case M2Quads_LineNumberOp:
15373 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));
15374 0 : break;
15375 :
15376 0 : case M2Quads_EndFileOp:
15377 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15378 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%a", 2, (const unsigned char *) &n1, (sizeof (n1)-1));
15379 0 : break;
15380 :
15381 0 : case M2Quads_ThrowOp:
15382 0 : case M2Quads_ReturnOp:
15383 0 : case M2Quads_CallOp:
15384 0 : case M2Quads_KillLocalVarOp:
15385 0 : M2Quads_WriteOperand (f->Operand3);
15386 0 : break;
15387 :
15388 0 : case M2Quads_ProcedureScopeOp:
15389 0 : n1 = SymbolTable_GetSymName (f->Operand2);
15390 0 : n2 = SymbolTable_GetSymName (f->Operand3);
15391 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));
15392 0 : DisplayProcedureAttributes (f->Operand3);
15393 0 : break;
15394 :
15395 0 : case M2Quads_NewLocalVarOp:
15396 0 : case M2Quads_FinallyStartOp:
15397 0 : case M2Quads_FinallyEndOp:
15398 0 : case M2Quads_InitEndOp:
15399 0 : case M2Quads_InitStartOp:
15400 0 : n1 = SymbolTable_GetSymName (f->Operand2);
15401 0 : n2 = SymbolTable_GetSymName (f->Operand3);
15402 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));
15403 0 : break;
15404 :
15405 0 : case M2Quads_ModuleScopeOp:
15406 0 : case M2Quads_StartModFileOp:
15407 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15408 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));
15409 0 : break;
15410 :
15411 0 : case M2Quads_StartDefFileOp:
15412 0 : n1 = SymbolTable_GetSymName (f->Operand3);
15413 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));
15414 0 : break;
15415 :
15416 0 : case M2Quads_OptParamOp:
15417 0 : case M2Quads_ParamOp:
15418 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d ", 5, (const unsigned char *) &f->Operand1, (sizeof (f->Operand1)-1));
15419 0 : M2Quads_WriteOperand (f->Operand2);
15420 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15421 0 : M2Quads_WriteOperand (f->Operand3);
15422 0 : break;
15423 :
15424 0 : case M2Quads_SizeOp:
15425 0 : case M2Quads_RecordFieldOp:
15426 0 : case M2Quads_IndrXOp:
15427 0 : case M2Quads_XIndrOp:
15428 0 : case M2Quads_ArrayOp:
15429 0 : case M2Quads_LogicalShiftOp:
15430 0 : case M2Quads_LogicalRotateOp:
15431 0 : case M2Quads_LogicalOrOp:
15432 0 : case M2Quads_LogicalAndOp:
15433 0 : case M2Quads_LogicalXorOp:
15434 0 : case M2Quads_LogicalDiffOp:
15435 0 : case M2Quads_ArithAddOp:
15436 0 : case M2Quads_CoerceOp:
15437 0 : case M2Quads_ConvertOp:
15438 0 : case M2Quads_CastOp:
15439 0 : case M2Quads_AddOp:
15440 0 : case M2Quads_SubOp:
15441 0 : case M2Quads_MultOp:
15442 0 : case M2Quads_DivM2Op:
15443 0 : case M2Quads_ModM2Op:
15444 0 : case M2Quads_ModFloorOp:
15445 0 : case M2Quads_DivCeilOp:
15446 0 : case M2Quads_ModCeilOp:
15447 0 : case M2Quads_DivFloorOp:
15448 0 : case M2Quads_ModTruncOp:
15449 0 : case M2Quads_DivTruncOp:
15450 0 : M2Quads_WriteOperand (f->Operand1);
15451 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15452 0 : M2Quads_WriteOperand (f->Operand2);
15453 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15454 0 : M2Quads_WriteOperand (f->Operand3);
15455 0 : break;
15456 :
15457 : case M2Quads_DummyOp:
15458 : case M2Quads_CodeOnOp:
15459 : case M2Quads_CodeOffOp:
15460 : case M2Quads_ProfileOnOp:
15461 : case M2Quads_ProfileOffOp:
15462 : case M2Quads_OptimizeOnOp:
15463 : case M2Quads_OptimizeOffOp:
15464 : break;
15465 :
15466 0 : case M2Quads_BuiltinConstOp:
15467 0 : M2Quads_WriteOperand (f->Operand1);
15468 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15469 0 : break;
15470 :
15471 0 : case M2Quads_BuiltinTypeInfoOp:
15472 0 : M2Quads_WriteOperand (f->Operand1);
15473 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand2, (sizeof (f->Operand2)-1));
15474 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) " %a", 5, (const unsigned char *) &f->Operand3, (sizeof (f->Operand3)-1));
15475 0 : break;
15476 :
15477 0 : case M2Quads_StandardFunctionOp:
15478 0 : M2Quads_WriteOperand (f->Operand1);
15479 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15480 0 : M2Quads_WriteOperand (f->Operand2);
15481 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15482 0 : M2Quads_WriteOperand (f->Operand3);
15483 0 : break;
15484 :
15485 : case M2Quads_CatchBeginOp:
15486 : case M2Quads_CatchEndOp:
15487 : break;
15488 :
15489 0 : case M2Quads_RangeCheckOp:
15490 0 : case M2Quads_ErrorOp:
15491 0 : M2Range_WriteRangeCheck (f->Operand3);
15492 0 : break;
15493 :
15494 0 : case M2Quads_SaveExceptionOp:
15495 0 : case M2Quads_RestoreExceptionOp:
15496 0 : M2Quads_WriteOperand (f->Operand1);
15497 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) " ", 2);
15498 0 : M2Quads_WriteOperand (f->Operand3);
15499 0 : break;
15500 :
15501 :
15502 0 : default:
15503 0 : M2Error_InternalError ((const char *) "quadruple not recognised", 24);
15504 0 : break;
15505 : }
15506 0 : }
15507 :
15508 :
15509 : /*
15510 : WriteOperand - displays the operands name, symbol id and mode of addressing.
15511 : */
15512 :
15513 0 : static void WriteMode (SymbolTable_ModeOfAddr Mode)
15514 : {
15515 0 : switch (Mode)
15516 : {
15517 0 : case SymbolTable_ImmediateValue:
15518 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "i", 1);
15519 0 : break;
15520 :
15521 0 : case SymbolTable_NoValue:
15522 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "n", 1);
15523 0 : break;
15524 :
15525 0 : case SymbolTable_RightValue:
15526 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "r", 1);
15527 0 : break;
15528 :
15529 0 : case SymbolTable_LeftValue:
15530 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "l", 1);
15531 0 : break;
15532 :
15533 :
15534 0 : default:
15535 0 : M2Error_InternalError ((const char *) "unrecognised mode", 17);
15536 0 : break;
15537 : }
15538 0 : }
15539 :
15540 :
15541 : /*
15542 : PushExit - pushes the exit value onto the EXIT stack.
15543 : */
15544 :
15545 603 : static void PushExit (unsigned int Exit)
15546 : {
15547 0 : M2StackWord_PushWord (ExitStack, Exit);
15548 0 : }
15549 :
15550 :
15551 : /*
15552 : PopExit - pops the exit value from the EXIT stack.
15553 : */
15554 :
15555 603 : static unsigned int PopExit (void)
15556 : {
15557 0 : return M2StackWord_PopWord (ExitStack);
15558 : /* static analysis guarentees a RETURN statement will be used before here. */
15559 : __builtin_unreachable ();
15560 : }
15561 :
15562 :
15563 : /*
15564 : PushFor - pushes the exit value onto the FOR stack.
15565 : */
15566 :
15567 10286 : static void PushFor (unsigned int Exit)
15568 : {
15569 0 : M2StackWord_PushWord (ForStack, Exit);
15570 0 : }
15571 :
15572 :
15573 : /*
15574 : PopFor - pops the exit value from the FOR stack.
15575 : */
15576 :
15577 10280 : static unsigned int PopFor (void)
15578 : {
15579 0 : return M2StackWord_PopWord (ForStack);
15580 : /* static analysis guarentees a RETURN statement will be used before here. */
15581 : __builtin_unreachable ();
15582 : }
15583 :
15584 :
15585 : /*
15586 : OperandTno - returns the ident operand stored in the true position
15587 : on the boolean stack. This is exactly the same as
15588 : OperandT but it has no IsBoolean checking.
15589 : */
15590 :
15591 214826127 : static unsigned int OperandTno (unsigned int pos)
15592 : {
15593 214826127 : M2Quads_BoolFrame f;
15594 :
15595 214826127 : M2Debug_Assert (pos > 0);
15596 214826127 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15597 214826127 : return static_cast<unsigned int> (f->TrueExit);
15598 : /* static analysis guarentees a RETURN statement will be used before here. */
15599 : __builtin_unreachable ();
15600 : }
15601 :
15602 :
15603 : /*
15604 : OperandFno - returns the ident operand stored in the false position
15605 : on the boolean stack. This is exactly the same as
15606 : OperandF but it has no IsBoolean checking.
15607 : */
15608 :
15609 176325 : static unsigned int OperandFno (unsigned int pos)
15610 : {
15611 176325 : M2Quads_BoolFrame f;
15612 :
15613 176325 : M2Debug_Assert (pos > 0);
15614 176325 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15615 176325 : return static_cast<unsigned int> (f->FalseExit);
15616 : /* static analysis guarentees a RETURN statement will be used before here. */
15617 : __builtin_unreachable ();
15618 : }
15619 :
15620 :
15621 : /*
15622 : OperandTtok - returns the token associated with the position, pos
15623 : on the boolean stack.
15624 : */
15625 :
15626 58852536 : static unsigned int OperandTtok (unsigned int pos)
15627 : {
15628 58852536 : M2Quads_BoolFrame f;
15629 :
15630 58852536 : M2Debug_Assert (pos > 0);
15631 58852536 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15632 58852536 : return f->tokenno;
15633 : /* static analysis guarentees a RETURN statement will be used before here. */
15634 : __builtin_unreachable ();
15635 : }
15636 :
15637 :
15638 : /*
15639 : PopBooltok - Pops a True and a False exit quad number from the True/False
15640 : stack.
15641 : */
15642 :
15643 223263 : static void PopBooltok (unsigned int *True, unsigned int *False, unsigned int *tokno)
15644 : {
15645 223263 : M2Quads_BoolFrame f;
15646 :
15647 223263 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
15648 223263 : (*True) = f->TrueExit;
15649 223263 : (*False) = f->FalseExit;
15650 223263 : (*tokno) = f->tokenno;
15651 223263 : M2Debug_Assert (f->BooleanOp);
15652 223263 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
15653 223263 : }
15654 :
15655 :
15656 : /*
15657 : PushBooltok - Push a True and a False exit quad numbers onto the
15658 : True/False stack.
15659 : */
15660 :
15661 230607 : static void PushBooltok (unsigned int True, unsigned int False, unsigned int tokno)
15662 : {
15663 230607 : M2Quads_BoolFrame f;
15664 :
15665 230607 : M2Debug_Assert (True <= NextQuad);
15666 230607 : M2Debug_Assert (False <= NextQuad);
15667 230607 : f = newBoolFrame ();
15668 230607 : f->TrueExit = True;
15669 230607 : f->FalseExit = False;
15670 230607 : f->BooleanOp = true;
15671 230607 : f->tokenno = tokno;
15672 230607 : f->Annotation = static_cast<DynamicStrings_String> (NULL);
15673 230607 : f->RangeDep = 0;
15674 230607 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15675 230607 : M2Quads_Annotate ((const char *) "<q%1d>|<q%2d>||true quad|false quad", 35);
15676 230607 : }
15677 :
15678 :
15679 : /*
15680 : PopBool - Pops a True and a False exit quad number from the True/False
15681 : stack.
15682 : */
15683 :
15684 190279 : static void PopBool (unsigned int *True, unsigned int *False)
15685 : {
15686 190279 : unsigned int tokno;
15687 :
15688 9963 : PopBooltok (True, False, &tokno);
15689 0 : }
15690 :
15691 :
15692 : /*
15693 : PushBool - Push a True and a False exit quad numbers onto the
15694 : True/False stack.
15695 : */
15696 :
15697 120029 : static void PushBool (unsigned int True, unsigned int False)
15698 : {
15699 7344 : PushBooltok (True, False, M2LexBuf_UnknownTokenNo);
15700 0 : }
15701 :
15702 :
15703 : /*
15704 : IsBoolean - returns true is the Stack position pos contains a Boolean
15705 : Exit. False is returned if an Ident is stored.
15706 : */
15707 :
15708 277624557 : static bool IsBoolean (unsigned int pos)
15709 : {
15710 277624557 : M2Quads_BoolFrame f;
15711 :
15712 277624557 : M2Debug_Assert (pos > 0);
15713 277624557 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15714 277624557 : return f->BooleanOp;
15715 : /* static analysis guarentees a RETURN statement will be used before here. */
15716 : __builtin_unreachable ();
15717 : }
15718 :
15719 :
15720 : /*
15721 : OperandD - returns possible array dimension associated with the ident
15722 : operand stored on the boolean stack.
15723 : */
15724 :
15725 682279 : static unsigned int OperandD (unsigned int pos)
15726 : {
15727 682279 : M2Quads_BoolFrame f;
15728 :
15729 682279 : M2Debug_Assert (pos > 0);
15730 682279 : M2Debug_Assert (! (IsBoolean (pos)));
15731 682279 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15732 682279 : return static_cast<unsigned int> (f->Dimension);
15733 : /* static analysis guarentees a RETURN statement will be used before here. */
15734 : __builtin_unreachable ();
15735 : }
15736 :
15737 :
15738 : /*
15739 : OperandRW - returns the rw operand stored on the boolean stack.
15740 : */
15741 :
15742 744485 : static unsigned int OperandRW (unsigned int pos)
15743 : {
15744 744485 : M2Quads_BoolFrame f;
15745 :
15746 744485 : M2Debug_Assert (pos > 0);
15747 744485 : M2Debug_Assert (! (IsBoolean (pos)));
15748 744485 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15749 744485 : return static_cast<unsigned int> (f->ReadWrite);
15750 : /* static analysis guarentees a RETURN statement will be used before here. */
15751 : __builtin_unreachable ();
15752 : }
15753 :
15754 :
15755 : /*
15756 : OperandMergeRW - returns the rw operand if not NulSym else it
15757 : returns True.
15758 : */
15759 :
15760 720691 : static unsigned int OperandMergeRW (unsigned int pos)
15761 : {
15762 720691 : if ((OperandRW (pos)) == SymbolTable_NulSym)
15763 : {
15764 699266 : return M2Quads_OperandT (pos);
15765 : }
15766 : else
15767 : {
15768 21425 : return OperandRW (pos);
15769 : }
15770 : /* static analysis guarentees a RETURN statement will be used before here. */
15771 : __builtin_unreachable ();
15772 : }
15773 :
15774 :
15775 : /*
15776 : OperandRangeDep - return the range dependant associated with the quad stack.
15777 : */
15778 :
15779 140251 : static unsigned int OperandRangeDep (unsigned int pos)
15780 : {
15781 140251 : M2Quads_BoolFrame f;
15782 :
15783 140251 : M2Debug_Assert (! (IsBoolean (pos)));
15784 140251 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15785 140251 : return f->RangeDep;
15786 : /* static analysis guarentees a RETURN statement will be used before here. */
15787 : __builtin_unreachable ();
15788 : }
15789 :
15790 :
15791 : /*
15792 : PutRangeDep - assigns the quad stack pos RangeDep to dep.
15793 : */
15794 :
15795 534556 : static void PutRangeDep (unsigned int pos, unsigned int dep)
15796 : {
15797 534556 : M2Quads_BoolFrame f;
15798 :
15799 534556 : M2Debug_Assert (! (IsBoolean (pos)));
15800 534556 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
15801 534556 : f->RangeDep = dep;
15802 534556 : }
15803 :
15804 :
15805 : /*
15806 : UseLineNote - uses the line note and returns it to the free list.
15807 : */
15808 :
15809 5152 : static void UseLineNote (M2Quads_LineNote l)
15810 : {
15811 5152 : M2Quads_QuadFrame f;
15812 :
15813 5152 : f = GetQF (NextQuad-1);
15814 5152 : if ((f->Operator == M2Quads_LineNumberOp) && (f->Operand1 == ((unsigned int ) (l->File))))
15815 : {} /* empty. */
15816 : else
15817 : {
15818 : /* do nothing */
15819 : if (false)
15820 : {
15821 : GenQuad (M2Quads_LineNumberOp, (unsigned int ) (l->File), SymbolTable_NulSym, (unsigned int ) (l->Line));
15822 : }
15823 : }
15824 5152 : l->Next = FreeLineList;
15825 5152 : FreeLineList = l;
15826 5152 : }
15827 :
15828 :
15829 : /*
15830 : PopLineNo - pops a line note from the line stack.
15831 : */
15832 :
15833 5152 : static M2Quads_LineNote PopLineNo (void)
15834 : {
15835 5152 : M2Quads_LineNote l;
15836 :
15837 5152 : l = static_cast<M2Quads_LineNote> (M2StackAddress_PopAddress (LineStack));
15838 5152 : if (l == NULL)
15839 : {
15840 0 : M2Error_InternalError ((const char *) "no line note available", 22);
15841 : }
15842 5152 : return l;
15843 : /* static analysis guarentees a RETURN statement will be used before here. */
15844 : __builtin_unreachable ();
15845 : }
15846 :
15847 :
15848 : /*
15849 : InitLineNote - creates a line note and initializes it to
15850 : contain, file, line.
15851 : */
15852 :
15853 5152 : static M2Quads_LineNote InitLineNote (NameKey_Name file, unsigned int line)
15854 : {
15855 5152 : M2Quads_LineNote l;
15856 :
15857 5152 : if (FreeLineList == NULL)
15858 : {
15859 2396 : Storage_ALLOCATE ((void **) &l, sizeof (M2Quads__T6));
15860 : }
15861 : else
15862 : {
15863 2756 : l = FreeLineList;
15864 2756 : FreeLineList = FreeLineList->Next;
15865 : }
15866 5152 : l->File = file;
15867 5152 : l->Line = line;
15868 5152 : return l;
15869 : /* static analysis guarentees a RETURN statement will be used before here. */
15870 : __builtin_unreachable ();
15871 : }
15872 :
15873 :
15874 : /*
15875 : PushLineNote -
15876 : */
15877 :
15878 5152 : static void PushLineNote (M2Quads_LineNote l)
15879 : {
15880 0 : M2StackAddress_PushAddress (LineStack, reinterpret_cast <void *> (l));
15881 0 : }
15882 :
15883 :
15884 : /*
15885 : BuildStmtNoteTok - adds a nop (with an assigned tokenno location) to the code.
15886 : */
15887 :
15888 548247 : static void BuildStmtNoteTok (unsigned int tokenno)
15889 : {
15890 548247 : NameKey_Name filename;
15891 548247 : M2Quads_QuadFrame f;
15892 :
15893 548247 : f = GetQF (NextQuad-1);
15894 : /* no need to have multiple notes at the same position. */
15895 548247 : if ((f->Operator != M2Quads_StatementNoteOp) || (f->Operand3 != tokenno))
15896 : {
15897 540872 : filename = NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()));
15898 540872 : GenQuad (M2Quads_StatementNoteOp, (unsigned int ) (filename), SymbolTable_NulSym, tokenno);
15899 : }
15900 548247 : }
15901 :
15902 :
15903 : /*
15904 : GetRecordOrField -
15905 : */
15906 :
15907 12330 : static unsigned int GetRecordOrField (void)
15908 : {
15909 12330 : unsigned int f;
15910 :
15911 12330 : VarientFieldNo += 1;
15912 12330 : f = static_cast<unsigned int> (Lists_GetItemFromList (VarientFields, VarientFieldNo));
15913 12330 : if (DebugVarients)
15914 : {
15915 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
15916 : if (SymbolTable_IsRecord (f))
15917 : {
15918 : 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));
15919 : }
15920 : else
15921 : {
15922 : 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));
15923 : }
15924 : }
15925 12330 : return f;
15926 : /* static analysis guarentees a RETURN statement will be used before here. */
15927 : __builtin_unreachable ();
15928 : }
15929 :
15930 :
15931 : /*
15932 : PushTFAD - Push True, False, Array, Dim, numbers onto the
15933 : True/False stack. True and False are assumed to
15934 : contain Symbols or Ident etc.
15935 : */
15936 :
15937 384 : static void PushTFAD (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim)
15938 : {
15939 384 : M2Quads_BoolFrame f;
15940 :
15941 384 : f = newBoolFrame ();
15942 384 : f->TrueExit = static_cast<unsigned int> (True);
15943 384 : f->FalseExit = static_cast<unsigned int> (False);
15944 384 : f->Unbounded = static_cast<unsigned int> (Array);
15945 384 : f->Dimension = static_cast<unsigned int> (Dim);
15946 384 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15947 384 : }
15948 :
15949 :
15950 : /*
15951 : PushTFADtok - Push True, False, Array, Dim, numbers onto the
15952 : True/False stack. True and False are assumed to
15953 : contain Symbols or Ident etc.
15954 : */
15955 :
15956 2957 : static void PushTFADtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int tokno)
15957 : {
15958 2957 : M2Quads_BoolFrame f;
15959 :
15960 2957 : f = newBoolFrame ();
15961 2957 : f->TrueExit = static_cast<unsigned int> (True);
15962 2957 : f->FalseExit = static_cast<unsigned int> (False);
15963 2957 : f->Unbounded = static_cast<unsigned int> (Array);
15964 2957 : f->Dimension = static_cast<unsigned int> (Dim);
15965 2957 : f->tokenno = tokno;
15966 2957 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15967 2957 : }
15968 :
15969 :
15970 : /*
15971 : PushTFADrwtok - Push True, False, Array, Dim, rw, numbers onto the
15972 : True/False stack. True and False are assumed to
15973 : contain Symbols or Ident etc.
15974 : */
15975 :
15976 8980 : static void PushTFADrwtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int Dim, unsigned int rw, unsigned int Tok)
15977 : {
15978 8980 : M2Quads_BoolFrame f;
15979 :
15980 8980 : f = newBoolFrame ();
15981 8980 : f->TrueExit = static_cast<unsigned int> (True);
15982 8980 : f->FalseExit = static_cast<unsigned int> (False);
15983 8980 : f->Unbounded = static_cast<unsigned int> (Array);
15984 8980 : f->Dimension = static_cast<unsigned int> (Dim);
15985 8980 : f->ReadWrite = static_cast<unsigned int> (rw);
15986 8980 : f->tokenno = Tok;
15987 8980 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
15988 8980 : }
15989 :
15990 :
15991 : /*
15992 : PopTFrwtok - Pop a True and False number from the True/False stack.
15993 : True and False are assumed to contain Symbols or Ident etc.
15994 : */
15995 :
15996 309422 : static void PopTFrwtok (unsigned int *True, unsigned int *False, unsigned int *rw, unsigned int *tokno)
15997 : {
15998 309422 : M2Quads_BoolFrame f;
15999 :
16000 309422 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16001 309422 : (*True) = static_cast<unsigned int> (f->TrueExit);
16002 309422 : (*False) = static_cast<unsigned int> (f->FalseExit);
16003 309422 : M2Debug_Assert (! f->BooleanOp);
16004 309422 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16005 309422 : (*tokno) = f->tokenno;
16006 309422 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16007 309422 : }
16008 :
16009 :
16010 : /*
16011 : PushTFrwtok - Push an item onto the stack in the T (true) position,
16012 : it is assummed to be a token and its token location is recorded.
16013 : */
16014 :
16015 341117 : static void PushTFrwtok (unsigned int True, unsigned int False, unsigned int rw, unsigned int tokno)
16016 : {
16017 341117 : M2Quads_BoolFrame f;
16018 :
16019 341117 : f = newBoolFrame ();
16020 341117 : f->TrueExit = static_cast<unsigned int> (True);
16021 341117 : f->FalseExit = static_cast<unsigned int> (False);
16022 341117 : f->ReadWrite = static_cast<unsigned int> (rw);
16023 341117 : f->tokenno = tokno;
16024 341117 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16025 341117 : }
16026 :
16027 :
16028 : /*
16029 : PushTFDtok - Push True, False, Dim, numbers onto the
16030 : True/False stack. True and False are assumed to
16031 : contain Symbols or Ident etc.
16032 : */
16033 :
16034 258 : static void PushTFDtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int Tok)
16035 : {
16036 258 : M2Quads_BoolFrame f;
16037 :
16038 258 : f = newBoolFrame ();
16039 258 : f->TrueExit = static_cast<unsigned int> (True);
16040 258 : f->FalseExit = static_cast<unsigned int> (False);
16041 258 : f->Dimension = static_cast<unsigned int> (Dim);
16042 258 : f->tokenno = Tok;
16043 258 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16044 258 : }
16045 :
16046 :
16047 : /*
16048 : PopTFDtok - Pop a True, False, Dim number from the True/False stack.
16049 : True and False are assumed to contain Symbols or Ident etc.
16050 : */
16051 :
16052 258 : static void PopTFDtok (unsigned int *True, unsigned int *False, unsigned int *Dim, unsigned int *Tok)
16053 : {
16054 258 : M2Quads_BoolFrame f;
16055 :
16056 258 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16057 258 : (*True) = static_cast<unsigned int> (f->TrueExit);
16058 258 : (*False) = static_cast<unsigned int> (f->FalseExit);
16059 258 : (*Dim) = static_cast<unsigned int> (f->Dimension);
16060 258 : (*Tok) = f->tokenno;
16061 258 : M2Debug_Assert (! f->BooleanOp);
16062 258 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16063 258 : }
16064 :
16065 :
16066 : /*
16067 : PushTFDrwtok - Push True, False, Dim, numbers onto the
16068 : True/False stack. True and False are assumed to
16069 : contain Symbols or Ident etc.
16070 : */
16071 :
16072 47464 : static void PushTFDrwtok (unsigned int True, unsigned int False, unsigned int Dim, unsigned int rw, unsigned int Tok)
16073 : {
16074 47464 : M2Quads_BoolFrame f;
16075 :
16076 47464 : f = newBoolFrame ();
16077 47464 : f->TrueExit = static_cast<unsigned int> (True);
16078 47464 : f->FalseExit = static_cast<unsigned int> (False);
16079 47464 : f->Dimension = static_cast<unsigned int> (Dim);
16080 47464 : f->ReadWrite = static_cast<unsigned int> (rw);
16081 47464 : f->tokenno = Tok;
16082 47464 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16083 47464 : }
16084 :
16085 :
16086 : /*
16087 : PushTFrw - Push a True and False numbers onto the True/False stack.
16088 : True and False are assumed to contain Symbols or Ident etc.
16089 : It also pushes the higher level symbol which is associated
16090 : with the True symbol. Eg record variable or array variable.
16091 : */
16092 :
16093 2369 : static void PushTFrw (unsigned int True, unsigned int False, unsigned int rw)
16094 : {
16095 2369 : M2Quads_BoolFrame f;
16096 :
16097 2369 : f = newBoolFrame ();
16098 2369 : f->TrueExit = static_cast<unsigned int> (True);
16099 2369 : f->FalseExit = static_cast<unsigned int> (False);
16100 2369 : f->ReadWrite = rw;
16101 2369 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16102 2369 : }
16103 :
16104 :
16105 : /*
16106 : PopTFrw - Pop a True and False number from the True/False stack.
16107 : True and False are assumed to contain Symbols or Ident etc.
16108 : */
16109 :
16110 30024 : static void PopTFrw (unsigned int *True, unsigned int *False, unsigned int *rw)
16111 : {
16112 30024 : M2Quads_BoolFrame f;
16113 :
16114 30024 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16115 30024 : (*True) = static_cast<unsigned int> (f->TrueExit);
16116 30024 : (*False) = static_cast<unsigned int> (f->FalseExit);
16117 30024 : M2Debug_Assert (! f->BooleanOp);
16118 30024 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16119 30024 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16120 30024 : }
16121 :
16122 :
16123 : /*
16124 : newBoolFrame - creates a new BoolFrame with all fields initialised to their defaults.
16125 : */
16126 :
16127 353202921 : static M2Quads_BoolFrame newBoolFrame (void)
16128 : {
16129 353202921 : M2Quads_BoolFrame f;
16130 :
16131 353202921 : Storage_ALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16132 353202921 : f->TrueExit = 0;
16133 353202921 : f->FalseExit = 0;
16134 353202921 : f->Unbounded = SymbolTable_NulSym;
16135 353202921 : f->BooleanOp = false;
16136 353202921 : f->Dimension = 0;
16137 353202921 : f->ReadWrite = SymbolTable_NulSym;
16138 353202921 : f->name = SymbolTable_NulSym;
16139 353202921 : f->Annotation = static_cast<DynamicStrings_String> (NULL);
16140 353202921 : f->tokenno = M2LexBuf_UnknownTokenNo;
16141 353202921 : return f;
16142 : /* static analysis guarentees a RETURN statement will be used before here. */
16143 : __builtin_unreachable ();
16144 : }
16145 :
16146 :
16147 : /*
16148 : PushTrwtok - Push an item onto the True/False stack. The False value will be zero.
16149 : */
16150 :
16151 156 : static void PushTrwtok (unsigned int True, unsigned int rw, unsigned int tok)
16152 : {
16153 156 : M2Quads_BoolFrame f;
16154 :
16155 156 : f = newBoolFrame ();
16156 156 : f->TrueExit = static_cast<unsigned int> (True);
16157 156 : f->ReadWrite = static_cast<unsigned int> (rw);
16158 156 : f->tokenno = tok;
16159 156 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
16160 156 : }
16161 :
16162 :
16163 : /*
16164 : PopTrw - Pop a True field and rw symbol from the stack.
16165 : */
16166 :
16167 2369 : static void PopTrw (unsigned int *True, unsigned int *rw)
16168 : {
16169 2369 : M2Quads_BoolFrame f;
16170 :
16171 2369 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16172 2369 : (*True) = static_cast<unsigned int> (f->TrueExit);
16173 2369 : M2Debug_Assert (! f->BooleanOp);
16174 2369 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16175 2369 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16176 2369 : }
16177 :
16178 :
16179 : /*
16180 : PopTrwtok - Pop a True field and rw symbol from the stack.
16181 : */
16182 :
16183 1084269 : static void PopTrwtok (unsigned int *True, unsigned int *rw, unsigned int *tok)
16184 : {
16185 1084269 : M2Quads_BoolFrame f;
16186 :
16187 1084269 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16188 1084269 : (*True) = static_cast<unsigned int> (f->TrueExit);
16189 1084269 : M2Debug_Assert (! f->BooleanOp);
16190 1084269 : (*rw) = static_cast<unsigned int> (f->ReadWrite);
16191 1084269 : (*tok) = f->tokenno;
16192 1084269 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16193 1084269 : }
16194 :
16195 :
16196 : /*
16197 : PopTntok - Pop a True/number/tok from the True/False stack.
16198 : True and False are assumed to contain Symbols.
16199 : The number is word sized.
16200 : */
16201 :
16202 37185 : static void PopTntok (unsigned int *True, unsigned int *n, unsigned int *tokno)
16203 : {
16204 37185 : M2Quads_BoolFrame f;
16205 :
16206 37185 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
16207 37185 : (*True) = static_cast<unsigned int> (f->TrueExit);
16208 37185 : (*n) = static_cast<unsigned int> (f->name);
16209 37185 : (*tokno) = f->tokenno;
16210 37185 : M2Debug_Assert (! f->BooleanOp);
16211 37185 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
16212 37185 : }
16213 :
16214 :
16215 : /*
16216 : gdbhook - a debugger convenience hook.
16217 : */
16218 :
16219 0 : static void gdbhook (void)
16220 : {
16221 0 : }
16222 :
16223 :
16224 : /*
16225 : BreakWhenQuadCreated - to be called interactively by gdb.
16226 : */
16227 :
16228 15451 : static void BreakWhenQuadCreated (unsigned int quad)
16229 : {
16230 15451 : BreakQuad = quad;
16231 0 : }
16232 :
16233 :
16234 : /*
16235 : CheckBreak - if quad = BreakQuad then call gdbhook.
16236 : */
16237 :
16238 0 : static void CheckBreak (unsigned int quad)
16239 : {
16240 0 : if (quad == BreakQuad)
16241 : {
16242 0 : gdbhook ();
16243 : }
16244 0 : }
16245 :
16246 :
16247 : /*
16248 : Init - initialize the M2Quads module, all the stacks, all the lists
16249 : and the quads list.
16250 : */
16251 :
16252 15451 : static void Init (void)
16253 : {
16254 15451 : BreakWhenQuadCreated (0); /* Disable the intereactive quad watch. */
16255 : /* To examine the quad table when a quad is created run cc1gm2 from gdb
16256 : and set a break point on gdbhook.
16257 : (gdb) break gdbhook
16258 : (gdb) run
16259 : Now below interactively call BreakWhenQuadCreated with the quad
16260 : under investigation. */
16261 15451 : gdbhook ();
16262 : /* Now is the time to interactively call gdb, for example:
16263 : (gdb) print BreakWhenQuadCreated (1234)
16264 : (gdb) cont
16265 : and you will arrive at gdbhook when this quad is created. */
16266 15451 : LogicalOrTok = NameKey_MakeKey ((const char *) "_LOR", 4);
16267 15451 : LogicalAndTok = NameKey_MakeKey ((const char *) "_LAND", 5);
16268 15451 : LogicalXorTok = NameKey_MakeKey ((const char *) "_LXOR", 5);
16269 15451 : LogicalDifferenceTok = NameKey_MakeKey ((const char *) "_LDIFF", 6);
16270 15451 : ArithPlusTok = NameKey_MakeKey ((const char *) "_ARITH_+", 8);
16271 15451 : QuadArray = Indexing_InitIndexTuned (1, (1024*1024) / 16, 16);
16272 15451 : FreeList = 1;
16273 15451 : NewQuad (&NextQuad);
16274 15451 : M2Debug_Assert (NextQuad == 1);
16275 15451 : BoolStack = M2StackAddress_InitStackAddress ();
16276 15451 : ExitStack = M2StackWord_InitStackWord ();
16277 15451 : RepeatStack = M2StackWord_InitStackWord ();
16278 15451 : WhileStack = M2StackWord_InitStackWord ();
16279 15451 : ForStack = M2StackWord_InitStackWord ();
16280 15451 : WithStack = M2StackAddress_InitStackAddress ();
16281 15451 : ReturnStack = M2StackWord_InitStackWord ();
16282 15451 : LineStack = M2StackAddress_InitStackAddress ();
16283 15451 : PriorityStack = M2StackWord_InitStackWord ();
16284 15451 : TryStack = M2StackWord_InitStackWord ();
16285 15451 : CatchStack = M2StackWord_InitStackWord ();
16286 15451 : ExceptStack = M2StackWord_InitStackWord ();
16287 15451 : ConstructorStack = M2StackAddress_InitStackAddress ();
16288 15451 : ConstParamStack = M2StackWord_InitStackWord ();
16289 15451 : ConstExprStack = M2StackWord_InitStackWord ();
16290 : /* StressStack ; */
16291 15451 : SuppressWith = false;
16292 15451 : Head = 1;
16293 15451 : LastQuadNo = 0;
16294 15451 : MustNotCheckBounds = false;
16295 15451 : InitQuad = 0;
16296 15451 : GrowInitialization = 0;
16297 15451 : ForInfo = Indexing_InitIndex (1);
16298 15451 : QuadrupleGeneration = true;
16299 15451 : BuildingHigh = false;
16300 15451 : BuildingSize = false;
16301 15451 : AutoStack = M2StackWord_InitStackWord ();
16302 15451 : IsAutoOn = true;
16303 15451 : InConstExpression = false;
16304 15451 : InConstParameters = false;
16305 15451 : FreeLineList = NULL;
16306 15451 : Lists_InitList (&VarientFields);
16307 15451 : VarientFieldNo = 0;
16308 15451 : NoOfQuads = 0;
16309 15451 : QuadMemDiag = M2Diagnostic_InitMemDiagnostic ((const char *) "M2Quad:Quadruples", 17, (const char *) "{0N} total quadruples {1d} consuming {2M} ram {0M} ({2P})", 57);
16310 15451 : }
16311 :
16312 :
16313 : /*
16314 : SetOptionCoding - builds a code quadruple if the profiling
16315 : option was given to the compiler.
16316 : */
16317 :
16318 0 : extern "C" void M2Quads_SetOptionCoding (bool b)
16319 : {
16320 0 : if (b != M2Options_Coding)
16321 : {
16322 0 : if (b)
16323 : {
16324 0 : M2Quads_BuildCodeOn ();
16325 : }
16326 : else
16327 : {
16328 0 : M2Quads_BuildCodeOff ();
16329 : }
16330 0 : M2Options_Coding = b;
16331 : }
16332 0 : }
16333 :
16334 :
16335 : /*
16336 : SetOptionProfiling - builds a profile quadruple if the profiling
16337 : option was given to the compiler.
16338 : */
16339 :
16340 0 : extern "C" void M2Quads_SetOptionProfiling (bool b)
16341 : {
16342 0 : if (b != M2Options_Profiling)
16343 : {
16344 0 : if (b)
16345 : {
16346 0 : M2Quads_BuildProfileOn ();
16347 : }
16348 : else
16349 : {
16350 0 : M2Quads_BuildProfileOff ();
16351 : }
16352 0 : M2Options_Profiling = b;
16353 : }
16354 0 : }
16355 :
16356 :
16357 : /*
16358 : SetOptionOptimizing - builds a quadruple to say that the optimization option
16359 : has been found in a comment.
16360 : */
16361 :
16362 0 : extern "C" void M2Quads_SetOptionOptimizing (bool b)
16363 : {
16364 0 : if (b)
16365 : {
16366 0 : M2Quads_BuildOptimizeOn ();
16367 : }
16368 : else
16369 : {
16370 0 : M2Quads_BuildOptimizeOff ();
16371 : }
16372 0 : }
16373 :
16374 :
16375 : /*
16376 : Opposite - returns the opposite comparison operator.
16377 : */
16378 :
16379 80861 : extern "C" M2Quads_QuadOperator M2Quads_Opposite (M2Quads_QuadOperator Operator)
16380 : {
16381 80861 : M2Quads_QuadOperator Op;
16382 :
16383 80861 : switch (Operator)
16384 : {
16385 : case M2Quads_IfNotEquOp:
16386 : Op = M2Quads_IfEquOp;
16387 : break;
16388 :
16389 : case M2Quads_IfEquOp:
16390 : Op = M2Quads_IfNotEquOp;
16391 : break;
16392 :
16393 : case M2Quads_IfLessEquOp:
16394 : Op = M2Quads_IfGreOp;
16395 : break;
16396 :
16397 : case M2Quads_IfGreOp:
16398 : Op = M2Quads_IfLessEquOp;
16399 : break;
16400 :
16401 : case M2Quads_IfGreEquOp:
16402 : Op = M2Quads_IfLessOp;
16403 : break;
16404 :
16405 : case M2Quads_IfLessOp:
16406 : Op = M2Quads_IfGreEquOp;
16407 : break;
16408 :
16409 : case M2Quads_IfInOp:
16410 : Op = M2Quads_IfNotInOp;
16411 : break;
16412 :
16413 : case M2Quads_IfNotInOp:
16414 : Op = M2Quads_IfInOp;
16415 : break;
16416 :
16417 :
16418 0 : default:
16419 0 : M2Error_InternalError ((const char *) "unexpected operator", 19);
16420 80861 : break;
16421 : }
16422 80861 : return Op;
16423 : /* static analysis guarentees a RETURN statement will be used before here. */
16424 : __builtin_unreachable ();
16425 : }
16426 :
16427 :
16428 : /*
16429 : IsReferenced - returns true if QuadNo is referenced by another quadruple.
16430 : */
16431 :
16432 259659258 : extern "C" bool M2Quads_IsReferenced (unsigned int QuadNo)
16433 : {
16434 259659258 : M2Quads_QuadFrame f;
16435 :
16436 259659258 : f = GetQF (QuadNo);
16437 259659258 : return ((f->Operator == M2Quads_ProcedureScopeOp) || (f->Operator == M2Quads_NewLocalVarOp)) || (f->NoOfTimesReferenced > 0);
16438 : /* static analysis guarentees a RETURN statement will be used before here. */
16439 : __builtin_unreachable ();
16440 : }
16441 :
16442 :
16443 : /*
16444 : IsBackReference - returns TRUE if quadruple, q, is referenced from a quad further on.
16445 : */
16446 :
16447 97601 : extern "C" bool M2Quads_IsBackReference (unsigned int q)
16448 : {
16449 97601 : unsigned int i;
16450 97601 : M2Quads_QuadOperator op;
16451 97601 : unsigned int op1;
16452 97601 : unsigned int op2;
16453 97601 : unsigned int op3;
16454 :
16455 97601 : i = q;
16456 3822488 : while (i != 0)
16457 : {
16458 3822488 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
16459 3822488 : switch (op)
16460 : {
16461 : case M2Quads_NewLocalVarOp:
16462 : case M2Quads_KillLocalVarOp:
16463 : case M2Quads_FinallyStartOp:
16464 : case M2Quads_FinallyEndOp:
16465 : case M2Quads_InitEndOp:
16466 : case M2Quads_InitStartOp:
16467 : case M2Quads_EndFileOp:
16468 : case M2Quads_StartDefFileOp:
16469 : case M2Quads_StartModFileOp:
16470 : return false; /* run into end of procedure or module */
16471 169184 : break;
16472 :
16473 169184 : case M2Quads_GotoOp:
16474 169184 : case M2Quads_IfEquOp:
16475 169184 : case M2Quads_IfLessEquOp:
16476 169184 : case M2Quads_IfGreEquOp:
16477 169184 : case M2Quads_IfGreOp:
16478 169184 : case M2Quads_IfLessOp:
16479 169184 : case M2Quads_IfNotEquOp:
16480 169184 : case M2Quads_IfInOp:
16481 169184 : case M2Quads_IfNotInOp:
16482 169184 : if (op3 == q) /* run into end of procedure or module */
16483 : {
16484 : return true;
16485 : }
16486 : break;
16487 :
16488 :
16489 : default:
16490 : break;
16491 : }
16492 3724887 : i = M2Quads_GetNextQuad (i);
16493 : }
16494 0 : M2Error_InternalError ((const char *) "fix this for the sake of efficiency..", 37);
16495 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
16496 : __builtin_unreachable ();
16497 : }
16498 :
16499 :
16500 : /*
16501 : IsUnConditional - returns true if QuadNo is an unconditional jump.
16502 : */
16503 :
16504 528447391 : extern "C" bool M2Quads_IsUnConditional (unsigned int QuadNo)
16505 : {
16506 528447391 : M2Quads_QuadFrame f;
16507 :
16508 528447391 : f = GetQF (QuadNo);
16509 528447391 : switch (f->Operator)
16510 : {
16511 : case M2Quads_ThrowOp:
16512 : case M2Quads_RetryOp:
16513 : case M2Quads_CallOp:
16514 : case M2Quads_ReturnOp:
16515 : case M2Quads_GotoOp:
16516 : return true;
16517 507896200 : break;
16518 :
16519 :
16520 507896200 : default:
16521 507896200 : return false;
16522 : break;
16523 : }
16524 : /* static analysis guarentees a RETURN statement will be used before here. */
16525 : __builtin_unreachable ();
16526 : }
16527 :
16528 :
16529 : /*
16530 : IsConditional - returns true if QuadNo is a conditional jump.
16531 : */
16532 :
16533 528555366 : extern "C" bool M2Quads_IsConditional (unsigned int QuadNo)
16534 : {
16535 528555366 : M2Quads_QuadFrame f;
16536 :
16537 528555366 : f = GetQF (QuadNo);
16538 528555366 : switch (f->Operator)
16539 : {
16540 : case M2Quads_IfInOp:
16541 : case M2Quads_IfNotInOp:
16542 : case M2Quads_IfEquOp:
16543 : case M2Quads_IfNotEquOp:
16544 : case M2Quads_IfLessOp:
16545 : case M2Quads_IfLessEquOp:
16546 : case M2Quads_IfGreOp:
16547 : case M2Quads_IfGreEquOp:
16548 : return true;
16549 524602120 : break;
16550 :
16551 :
16552 524602120 : default:
16553 524602120 : return false;
16554 : break;
16555 : }
16556 : /* static analysis guarentees a RETURN statement will be used before here. */
16557 : __builtin_unreachable ();
16558 : }
16559 :
16560 :
16561 : /*
16562 : IsBackReferenceConditional - returns TRUE if quadruple, q, is referenced from
16563 : a conditional quad further on.
16564 : */
16565 :
16566 0 : extern "C" bool M2Quads_IsBackReferenceConditional (unsigned int q)
16567 : {
16568 0 : unsigned int i;
16569 0 : M2Quads_QuadOperator op;
16570 0 : unsigned int op1;
16571 0 : unsigned int op2;
16572 0 : unsigned int op3;
16573 :
16574 0 : i = q;
16575 0 : while (i != 0)
16576 : {
16577 0 : M2Quads_GetQuad (i, &op, &op1, &op2, &op3);
16578 0 : switch (op)
16579 : {
16580 : case M2Quads_NewLocalVarOp:
16581 : case M2Quads_KillLocalVarOp:
16582 : case M2Quads_FinallyStartOp:
16583 : case M2Quads_FinallyEndOp:
16584 : case M2Quads_InitEndOp:
16585 : case M2Quads_InitStartOp:
16586 : case M2Quads_EndFileOp:
16587 : case M2Quads_StartDefFileOp:
16588 : case M2Quads_StartModFileOp:
16589 : return false; /* run into end of procedure or module */
16590 0 : break;
16591 :
16592 0 : case M2Quads_TryOp:
16593 0 : case M2Quads_RetryOp:
16594 0 : case M2Quads_GotoOp:
16595 0 : case M2Quads_IfEquOp:
16596 0 : case M2Quads_IfLessEquOp:
16597 0 : case M2Quads_IfGreEquOp:
16598 0 : case M2Quads_IfGreOp:
16599 0 : case M2Quads_IfLessOp:
16600 0 : case M2Quads_IfNotEquOp:
16601 0 : case M2Quads_IfInOp:
16602 0 : case M2Quads_IfNotInOp:
16603 0 : if ((op3 == q) && (M2Quads_IsConditional (q))) /* run into end of procedure or module */
16604 : {
16605 : return true;
16606 : }
16607 0 : break;
16608 :
16609 :
16610 : default:
16611 : return false;
16612 0 : break;
16613 : }
16614 0 : i = M2Quads_GetNextQuad (i);
16615 : }
16616 0 : M2Error_InternalError ((const char *) "fix this for the sake of efficiency..", 37);
16617 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Quads.def", 20, 1);
16618 : __builtin_unreachable ();
16619 : }
16620 :
16621 :
16622 : /*
16623 : IsGoto - returns true if QuadNo is a goto operation.
16624 : */
16625 :
16626 97601 : extern "C" bool M2Quads_IsGoto (unsigned int QuadNo)
16627 : {
16628 97601 : return IsQuadA (QuadNo, M2Quads_GotoOp);
16629 : /* static analysis guarentees a RETURN statement will be used before here. */
16630 : __builtin_unreachable ();
16631 : }
16632 :
16633 :
16634 : /*
16635 : IsCall - returns true if QuadNo is a call operation.
16636 : */
16637 :
16638 528544992 : extern "C" bool M2Quads_IsCall (unsigned int QuadNo)
16639 : {
16640 528544992 : return IsQuadA (QuadNo, M2Quads_CallOp);
16641 : /* static analysis guarentees a RETURN statement will be used before here. */
16642 : __builtin_unreachable ();
16643 : }
16644 :
16645 :
16646 : /*
16647 : IsReturn - returns true if QuadNo is a return operation.
16648 : */
16649 :
16650 528710518 : extern "C" bool M2Quads_IsReturn (unsigned int QuadNo)
16651 : {
16652 528710518 : return IsQuadA (QuadNo, M2Quads_ReturnOp);
16653 : /* static analysis guarentees a RETURN statement will be used before here. */
16654 : __builtin_unreachable ();
16655 : }
16656 :
16657 :
16658 : /*
16659 : IsProcedureScope - returns true if QuadNo is a ProcedureScope operation.
16660 : */
16661 :
16662 0 : extern "C" bool M2Quads_IsProcedureScope (unsigned int QuadNo)
16663 : {
16664 0 : return IsQuadA (QuadNo, M2Quads_ProcedureScopeOp);
16665 : /* static analysis guarentees a RETURN statement will be used before here. */
16666 : __builtin_unreachable ();
16667 : }
16668 :
16669 :
16670 : /*
16671 : IsNewLocalVar - returns true if QuadNo is a NewLocalVar operation.
16672 : */
16673 :
16674 0 : extern "C" bool M2Quads_IsNewLocalVar (unsigned int QuadNo)
16675 : {
16676 0 : return IsQuadA (QuadNo, M2Quads_NewLocalVarOp);
16677 : /* static analysis guarentees a RETURN statement will be used before here. */
16678 : __builtin_unreachable ();
16679 : }
16680 :
16681 :
16682 : /*
16683 : IsKillLocalVar - returns true if QuadNo is a KillLocalVar operation.
16684 : */
16685 :
16686 259110 : extern "C" bool M2Quads_IsKillLocalVar (unsigned int QuadNo)
16687 : {
16688 259110 : return IsQuadA (QuadNo, M2Quads_KillLocalVarOp);
16689 : /* static analysis guarentees a RETURN statement will be used before here. */
16690 : __builtin_unreachable ();
16691 : }
16692 :
16693 :
16694 : /*
16695 : IsCatchBegin - returns true if QuadNo is a catch begin quad.
16696 : */
16697 :
16698 140884 : extern "C" bool M2Quads_IsCatchBegin (unsigned int QuadNo)
16699 : {
16700 140884 : return IsQuadA (QuadNo, M2Quads_CatchBeginOp);
16701 : /* static analysis guarentees a RETURN statement will be used before here. */
16702 : __builtin_unreachable ();
16703 : }
16704 :
16705 :
16706 : /*
16707 : IsCatchEnd - returns true if QuadNo is a catch end quad.
16708 : */
16709 :
16710 157492 : extern "C" bool M2Quads_IsCatchEnd (unsigned int QuadNo)
16711 : {
16712 157492 : return IsQuadA (QuadNo, M2Quads_CatchEndOp);
16713 : /* static analysis guarentees a RETURN statement will be used before here. */
16714 : __builtin_unreachable ();
16715 : }
16716 :
16717 :
16718 : /*
16719 : IsInitStart - returns true if QuadNo is a init start quad.
16720 : */
16721 :
16722 140884 : extern "C" bool M2Quads_IsInitStart (unsigned int QuadNo)
16723 : {
16724 140884 : return IsQuadA (QuadNo, M2Quads_InitStartOp);
16725 : /* static analysis guarentees a RETURN statement will be used before here. */
16726 : __builtin_unreachable ();
16727 : }
16728 :
16729 :
16730 : /*
16731 : IsInitEnd - returns true if QuadNo is a init end quad.
16732 : */
16733 :
16734 140884 : extern "C" bool M2Quads_IsInitEnd (unsigned int QuadNo)
16735 : {
16736 140884 : return IsQuadA (QuadNo, M2Quads_InitEndOp);
16737 : /* static analysis guarentees a RETURN statement will be used before here. */
16738 : __builtin_unreachable ();
16739 : }
16740 :
16741 :
16742 : /*
16743 : IsFinallyStart - returns true if QuadNo is a finally start quad.
16744 : */
16745 :
16746 135430 : extern "C" bool M2Quads_IsFinallyStart (unsigned int QuadNo)
16747 : {
16748 135430 : return IsQuadA (QuadNo, M2Quads_FinallyStartOp);
16749 : /* static analysis guarentees a RETURN statement will be used before here. */
16750 : __builtin_unreachable ();
16751 : }
16752 :
16753 :
16754 : /*
16755 : IsFinallyEnd - returns true if QuadNo is a finally end quad.
16756 : */
16757 :
16758 129976 : extern "C" bool M2Quads_IsFinallyEnd (unsigned int QuadNo)
16759 : {
16760 129976 : return IsQuadA (QuadNo, M2Quads_FinallyEndOp);
16761 : /* static analysis guarentees a RETURN statement will be used before here. */
16762 : __builtin_unreachable ();
16763 : }
16764 :
16765 :
16766 : /*
16767 : IsBecomes - return TRUE if QuadNo is a BecomesOp.
16768 : */
16769 :
16770 0 : extern "C" bool M2Quads_IsBecomes (unsigned int QuadNo)
16771 : {
16772 0 : return IsQuadA (QuadNo, M2Quads_BecomesOp);
16773 : /* static analysis guarentees a RETURN statement will be used before here. */
16774 : __builtin_unreachable ();
16775 : }
16776 :
16777 :
16778 : /*
16779 : IsDummy - return TRUE if QuadNo is a DummyOp.
16780 : */
16781 :
16782 0 : extern "C" bool M2Quads_IsDummy (unsigned int QuadNo)
16783 : {
16784 0 : return IsQuadA (QuadNo, M2Quads_DummyOp);
16785 : /* static analysis guarentees a RETURN statement will be used before here. */
16786 : __builtin_unreachable ();
16787 : }
16788 :
16789 :
16790 : /*
16791 : IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
16792 : */
16793 :
16794 0 : extern "C" bool M2Quads_IsQuadConstExpr (unsigned int QuadNo)
16795 : {
16796 0 : M2Quads_QuadFrame f;
16797 :
16798 0 : f = GetQF (QuadNo);
16799 0 : return f->ConstExpr;
16800 : /* static analysis guarentees a RETURN statement will be used before here. */
16801 : __builtin_unreachable ();
16802 : }
16803 :
16804 :
16805 : /*
16806 : SetQuadConstExpr - sets the constexpr field to value.
16807 : */
16808 :
16809 0 : extern "C" void M2Quads_SetQuadConstExpr (unsigned int QuadNo, bool value)
16810 : {
16811 0 : M2Quads_QuadFrame f;
16812 :
16813 0 : f = GetQF (QuadNo);
16814 0 : f->ConstExpr = value;
16815 0 : }
16816 :
16817 :
16818 : /*
16819 : GetQuadDest - returns the jump destination associated with quad.
16820 : */
16821 :
16822 0 : extern "C" unsigned int M2Quads_GetQuadDest (unsigned int QuadNo)
16823 : {
16824 0 : return M2Quads_GetQuadOp3 (QuadNo);
16825 : /* static analysis guarentees a RETURN statement will be used before here. */
16826 : __builtin_unreachable ();
16827 : }
16828 :
16829 :
16830 : /*
16831 : GetQuadOp1 - returns the 1st operand associated with quad.
16832 : */
16833 :
16834 0 : extern "C" unsigned int M2Quads_GetQuadOp1 (unsigned int QuadNo)
16835 : {
16836 0 : M2Quads_QuadFrame f;
16837 :
16838 0 : f = GetQF (QuadNo);
16839 0 : return f->Operand1;
16840 : /* static analysis guarentees a RETURN statement will be used before here. */
16841 : __builtin_unreachable ();
16842 : }
16843 :
16844 :
16845 : /*
16846 : GetQuadOp2 - returns the 2nd operand associated with quad.
16847 : */
16848 :
16849 0 : extern "C" unsigned int M2Quads_GetQuadOp2 (unsigned int QuadNo)
16850 : {
16851 0 : M2Quads_QuadFrame f;
16852 :
16853 0 : f = GetQF (QuadNo);
16854 0 : return f->Operand2;
16855 : /* static analysis guarentees a RETURN statement will be used before here. */
16856 : __builtin_unreachable ();
16857 : }
16858 :
16859 :
16860 : /*
16861 : GetQuadOp3 - returns the 3rd operand associated with quad.
16862 : */
16863 :
16864 0 : extern "C" unsigned int M2Quads_GetQuadOp3 (unsigned int QuadNo)
16865 : {
16866 0 : M2Quads_QuadFrame f;
16867 :
16868 0 : f = GetQF (QuadNo);
16869 0 : return f->Operand3;
16870 : /* static analysis guarentees a RETURN statement will be used before here. */
16871 : __builtin_unreachable ();
16872 : }
16873 :
16874 :
16875 : /*
16876 : IsInitialisingConst - returns TRUE if the quadruple is setting
16877 : a const (op1) with a value.
16878 : */
16879 :
16880 0 : extern "C" bool M2Quads_IsInitialisingConst (unsigned int QuadNo)
16881 : {
16882 0 : M2Quads_QuadOperator op;
16883 0 : unsigned int op1;
16884 0 : unsigned int op2;
16885 0 : unsigned int op3;
16886 :
16887 0 : M2Quads_GetQuad (QuadNo, &op, &op1, &op2, &op3);
16888 0 : return (OpUsesOp1 (op)) && (SymbolTable_IsConst (op1));
16889 : /* static analysis guarentees a RETURN statement will be used before here. */
16890 : __builtin_unreachable ();
16891 : }
16892 :
16893 :
16894 : /*
16895 : IsConstQuad - return TRUE if the quadruple is marked as a constexpr.
16896 : */
16897 :
16898 0 : extern "C" bool M2Quads_IsConstQuad (unsigned int quad)
16899 : {
16900 0 : M2Quads_QuadFrame f;
16901 :
16902 0 : f = GetQF (quad);
16903 0 : return f->ConstExpr;
16904 : /* static analysis guarentees a RETURN statement will be used before here. */
16905 : __builtin_unreachable ();
16906 : }
16907 :
16908 :
16909 : /*
16910 : IsConditionalBooleanQuad - return TRUE if operand 1 is a boolean result.
16911 : */
16912 :
16913 428763 : extern "C" bool M2Quads_IsConditionalBooleanQuad (unsigned int quad)
16914 : {
16915 428763 : M2Quads_QuadFrame f;
16916 :
16917 428763 : f = GetQF (quad);
16918 428763 : return ((OpUsesOp1 (f->Operator)) && ((SymbolTable_IsVar (f->Operand1)) || (SymbolTable_IsConst (f->Operand1)))) && (SymbolTable_IsVarConditional (f->Operand1));
16919 : /* static analysis guarentees a RETURN statement will be used before here. */
16920 : __builtin_unreachable ();
16921 : }
16922 :
16923 :
16924 : /*
16925 : IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
16926 : */
16927 :
16928 0 : extern "C" bool M2Quads_IsOptimizeOn (unsigned int QuadNo)
16929 : {
16930 0 : M2Quads_QuadFrame f;
16931 0 : unsigned int n;
16932 0 : unsigned int q;
16933 0 : bool On;
16934 :
16935 0 : On = M2Options_Optimizing;
16936 0 : q = Head;
16937 0 : while ((q != 0) && (q != QuadNo))
16938 : {
16939 0 : f = GetQF (q);
16940 0 : if (f->Operator == M2Quads_OptimizeOnOp)
16941 : {
16942 : On = true;
16943 : }
16944 0 : else if (f->Operator == M2Quads_OptimizeOffOp)
16945 : {
16946 : /* avoid dangling else. */
16947 0 : On = false;
16948 : }
16949 0 : n = f->Next;
16950 0 : q = n;
16951 : }
16952 0 : return On;
16953 : /* static analysis guarentees a RETURN statement will be used before here. */
16954 : __builtin_unreachable ();
16955 : }
16956 :
16957 :
16958 : /*
16959 : IsProfileOn - returns true if the Profile flag was true at QuadNo.
16960 : */
16961 :
16962 0 : extern "C" bool M2Quads_IsProfileOn (unsigned int QuadNo)
16963 : {
16964 0 : M2Quads_QuadFrame f;
16965 0 : unsigned int n;
16966 0 : unsigned int q;
16967 0 : bool On;
16968 :
16969 0 : On = M2Options_Profiling;
16970 0 : q = Head;
16971 0 : while ((q != 0) && (q != QuadNo))
16972 : {
16973 0 : f = GetQF (q);
16974 0 : if (f->Operator == M2Quads_ProfileOnOp)
16975 : {
16976 : On = true;
16977 : }
16978 0 : else if (f->Operator == M2Quads_ProfileOffOp)
16979 : {
16980 : /* avoid dangling else. */
16981 0 : On = false;
16982 : }
16983 0 : n = f->Next;
16984 0 : q = n;
16985 : }
16986 0 : return On;
16987 : /* static analysis guarentees a RETURN statement will be used before here. */
16988 : __builtin_unreachable ();
16989 : }
16990 :
16991 :
16992 : /*
16993 : IsCodeOn - returns true if the Code flag was true at QuadNo.
16994 : */
16995 :
16996 0 : extern "C" bool M2Quads_IsCodeOn (unsigned int QuadNo)
16997 : {
16998 0 : M2Quads_QuadFrame f;
16999 0 : unsigned int n;
17000 0 : unsigned int q;
17001 0 : bool On;
17002 :
17003 0 : On = M2Options_Coding;
17004 0 : q = Head;
17005 0 : while ((q != 0) && (q != QuadNo))
17006 : {
17007 0 : f = GetQF (q);
17008 0 : if (f->Operator == M2Quads_CodeOnOp)
17009 : {
17010 : On = true;
17011 : }
17012 0 : else if (f->Operator == M2Quads_CodeOffOp)
17013 : {
17014 : /* avoid dangling else. */
17015 0 : On = false;
17016 : }
17017 0 : n = f->Next;
17018 0 : q = n;
17019 : }
17020 0 : return On;
17021 : /* static analysis guarentees a RETURN statement will be used before here. */
17022 : __builtin_unreachable ();
17023 : }
17024 :
17025 :
17026 : /*
17027 : IsPseudoQuad - returns true if QuadNo is a compiler directive.
17028 : ie code, profile and optimize.
17029 : StartFile, EndFile,
17030 : */
17031 :
17032 23164398 : extern "C" bool M2Quads_IsPseudoQuad (unsigned int QuadNo)
17033 : {
17034 23164398 : M2Quads_QuadFrame f;
17035 :
17036 23164398 : f = GetQF (QuadNo);
17037 23164398 : 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);
17038 : /* static analysis guarentees a RETURN statement will be used before here. */
17039 : __builtin_unreachable ();
17040 : }
17041 :
17042 :
17043 : /*
17044 : IsDefOrModFile - returns TRUE if QuadNo is a start of Module or Def file
17045 : directive.
17046 : */
17047 :
17048 528447391 : extern "C" bool M2Quads_IsDefOrModFile (unsigned int QuadNo)
17049 : {
17050 528447391 : M2Quads_QuadFrame f;
17051 :
17052 528447391 : f = GetQF (QuadNo);
17053 528447391 : return (f->Operator == M2Quads_StartDefFileOp) || (f->Operator == M2Quads_StartModFileOp);
17054 : /* static analysis guarentees a RETURN statement will be used before here. */
17055 : __builtin_unreachable ();
17056 : }
17057 :
17058 :
17059 : /*
17060 : DumpQuadruples - dump all quadruples providing the -fq, -fdump-lang-quad,
17061 : -fdump-lang-quad= or -fdump-lang-all were issued to the
17062 : command line.
17063 : */
17064 :
17065 71837 : extern "C" void M2Quads_DumpQuadruples (const char *title_, unsigned int _title_high)
17066 : {
17067 71837 : char title[_title_high+1];
17068 :
17069 : /* make a local copy of each unbounded array. */
17070 71837 : memcpy (title, title_, _title_high+1);
17071 :
17072 71837 : if (M2Options_GetDumpQuad ())
17073 : {
17074 0 : M2LangDump_CreateDumpQuad ((const char *) title, _title_high);
17075 0 : if ((M2Options_GetM2DumpFilter ()) == NULL)
17076 : {
17077 0 : DumpQuadrupleAll ();
17078 : }
17079 : else
17080 : {
17081 0 : DumpQuadrupleFilter ();
17082 : }
17083 0 : M2LangDump_CloseDumpQuad ();
17084 : }
17085 71837 : }
17086 :
17087 :
17088 : /*
17089 : DisplayQuadRange - displays all quads in list range, start..end.
17090 : */
17091 :
17092 0 : extern "C" void M2Quads_DisplayQuadRange (unsigned int scope, unsigned int start, unsigned int end)
17093 : {
17094 0 : M2Quads_QuadFrame f;
17095 :
17096 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "Quadruples for scope: %d\\n", 26, (const unsigned char *) &scope, (sizeof (scope)-1));
17097 0 : while ((start <= end) && (start != 0))
17098 : {
17099 0 : M2Quads_DisplayQuad (start);
17100 0 : f = GetQF (start);
17101 0 : start = f->Next;
17102 : }
17103 0 : }
17104 :
17105 :
17106 : /*
17107 : DisplayQuad - displays a quadruple, QuadNo.
17108 : */
17109 :
17110 0 : extern "C" void M2Quads_DisplayQuad (unsigned int QuadNo)
17111 : {
17112 0 : if (QuadNo != 0)
17113 : {
17114 0 : DSdbEnter ();
17115 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%4d ", 5, (const unsigned char *) &QuadNo, (sizeof (QuadNo)-1));
17116 0 : WriteQuad (QuadNo);
17117 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "\\n", 2);
17118 0 : DSdbExit ();
17119 : }
17120 0 : }
17121 :
17122 :
17123 : /*
17124 : GetLastFileQuad - returns the Quadruple number of the last StartDefFile or
17125 : StartModFile quadruple.
17126 : */
17127 :
17128 0 : extern "C" unsigned int M2Quads_GetLastFileQuad (unsigned int QuadNo)
17129 : {
17130 0 : M2Quads_QuadFrame f;
17131 0 : unsigned int q;
17132 0 : unsigned int i;
17133 0 : unsigned int FileQuad;
17134 :
17135 0 : q = Head;
17136 0 : FileQuad = 0;
17137 0 : do {
17138 0 : f = GetQF (q);
17139 0 : if ((f->Operator == M2Quads_StartModFileOp) || (f->Operator == M2Quads_StartDefFileOp))
17140 : {
17141 0 : FileQuad = q;
17142 : }
17143 0 : i = f->Next;
17144 0 : q = i;
17145 0 : } while (! ((i == QuadNo) || (i == 0)));
17146 0 : M2Debug_Assert (i != 0);
17147 0 : M2Debug_Assert (FileQuad != 0);
17148 0 : return FileQuad;
17149 : /* static analysis guarentees a RETURN statement will be used before here. */
17150 : __builtin_unreachable ();
17151 : }
17152 :
17153 :
17154 : /*
17155 : GetLastQuadNo - returns the last quadruple number referenced
17156 : by a GetQuad.
17157 : */
17158 :
17159 0 : extern "C" unsigned int M2Quads_GetLastQuadNo (void)
17160 : {
17161 0 : return LastQuadNo;
17162 : /* static analysis guarentees a RETURN statement will be used before here. */
17163 : __builtin_unreachable ();
17164 : }
17165 :
17166 :
17167 : /*
17168 : QuadToTokenNo - Converts a QuadNo into the approprate token number of the
17169 : source file, the line number is returned.
17170 :
17171 : This may be used to yield an idea where abouts in the
17172 : source file the code generetion is
17173 : processing.
17174 : */
17175 :
17176 7348650 : extern "C" unsigned int M2Quads_QuadToTokenNo (unsigned int QuadNo)
17177 : {
17178 7348650 : M2Quads_QuadFrame f;
17179 :
17180 7348650 : if ((((LastQuadNo == 0) && (! (M2Pass_IsNoPass ()))) && (! (M2Pass_IsPassCodeGeneration ()))) || (! (Indexing_InBounds (QuadArray, QuadNo))))
17181 : {
17182 : return 0;
17183 : }
17184 : else
17185 : {
17186 7348650 : f = GetQF (QuadNo);
17187 7348650 : return f->TokenNo;
17188 : }
17189 : /* static analysis guarentees a RETURN statement will be used before here. */
17190 : __builtin_unreachable ();
17191 : }
17192 :
17193 :
17194 : /*
17195 : QuadToLineNo - Converts a QuadNo into the approprate line number of the
17196 : source file, the line number is returned.
17197 :
17198 : This may be used to yield an idea where abouts in the
17199 : source file the code generetion is
17200 : processing.
17201 : */
17202 :
17203 0 : extern "C" unsigned int M2Quads_QuadToLineNo (unsigned int QuadNo)
17204 : {
17205 0 : M2Quads_QuadFrame f;
17206 :
17207 0 : if ((((LastQuadNo == 0) && (! (M2Pass_IsNoPass ()))) && (! (M2Pass_IsPassCodeGeneration ()))) || (! (Indexing_InBounds (QuadArray, QuadNo))))
17208 : {
17209 : return 0;
17210 : }
17211 : else
17212 : {
17213 0 : f = GetQF (QuadNo);
17214 0 : return f->LineNo;
17215 : }
17216 : /* static analysis guarentees a RETURN statement will be used before here. */
17217 : __builtin_unreachable ();
17218 : }
17219 :
17220 :
17221 : /*
17222 : GetQuad - returns the Quadruple QuadNo.
17223 : */
17224 :
17225 2685160747 : extern "C" void M2Quads_GetQuad (unsigned int QuadNo, M2Quads_QuadOperator *Op, unsigned int *Oper1, unsigned int *Oper2, unsigned int *Oper3)
17226 : {
17227 2685160747 : M2Quads_QuadFrame f;
17228 :
17229 2685160747 : f = GetQF (QuadNo);
17230 2685160747 : LastQuadNo = QuadNo;
17231 2685160747 : (*Op) = f->Operator;
17232 2685160747 : (*Oper1) = f->Operand1;
17233 2685160747 : (*Oper2) = f->Operand2;
17234 2685160747 : (*Oper3) = f->Operand3;
17235 2685160747 : }
17236 :
17237 :
17238 : /*
17239 : GetQuadOp - returns the operator for quad.
17240 : */
17241 :
17242 24 : extern "C" M2Quads_QuadOperator M2Quads_GetQuadOp (unsigned int quad)
17243 : {
17244 24 : M2Quads_QuadFrame f;
17245 :
17246 24 : f = GetQF (quad);
17247 24 : return f->Operator;
17248 : /* static analysis guarentees a RETURN statement will be used before here. */
17249 : __builtin_unreachable ();
17250 : }
17251 :
17252 :
17253 : /*
17254 : GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
17255 : (if possible). It returns NIL if no there is not an obvious match
17256 : in Modula-2. It is assummed that the string will be used during
17257 : construction of error messages and therefore keywords are
17258 : wrapped with a format specifier.
17259 : */
17260 :
17261 31 : extern "C" DynamicStrings_String M2Quads_GetM2OperatorDesc (M2Quads_QuadOperator op)
17262 : {
17263 31 : switch (op)
17264 : {
17265 6 : case M2Quads_NegateOp:
17266 6 : return DynamicStrings_InitString ((const char *) "-", 1);
17267 18 : break;
17268 :
17269 18 : case M2Quads_AddOp:
17270 18 : return DynamicStrings_InitString ((const char *) "+", 1);
17271 0 : break;
17272 :
17273 0 : case M2Quads_SubOp:
17274 0 : return DynamicStrings_InitString ((const char *) "-", 1);
17275 0 : break;
17276 :
17277 0 : case M2Quads_MultOp:
17278 0 : return DynamicStrings_InitString ((const char *) "*", 1);
17279 0 : break;
17280 :
17281 0 : case M2Quads_DivM2Op:
17282 0 : case M2Quads_DivCeilOp:
17283 0 : case M2Quads_DivFloorOp:
17284 0 : case M2Quads_DivTruncOp:
17285 0 : return DynamicStrings_InitString ((const char *) "{%kDIV}", 7);
17286 0 : break;
17287 :
17288 0 : case M2Quads_ModM2Op:
17289 0 : case M2Quads_ModCeilOp:
17290 0 : case M2Quads_ModFloorOp:
17291 0 : return DynamicStrings_InitString ((const char *) "{%kMOD}", 7);
17292 0 : break;
17293 :
17294 0 : case M2Quads_ModTruncOp:
17295 0 : return DynamicStrings_InitString ((const char *) "{%kREM}", 7);
17296 0 : break;
17297 :
17298 0 : case M2Quads_LogicalOrOp:
17299 0 : return DynamicStrings_InitString ((const char *) "{%kOR}", 6);
17300 0 : break;
17301 :
17302 0 : case M2Quads_LogicalAndOp:
17303 0 : return DynamicStrings_InitString ((const char *) "{%kAND}", 7);
17304 0 : break;
17305 :
17306 0 : case M2Quads_InclOp:
17307 0 : return DynamicStrings_InitString ((const char *) "{%kINCL}", 8);
17308 0 : break;
17309 :
17310 0 : case M2Quads_ExclOp:
17311 0 : return DynamicStrings_InitString ((const char *) "{%kEXCL}", 8);
17312 7 : break;
17313 :
17314 7 : case M2Quads_IfEquOp:
17315 7 : return DynamicStrings_InitString ((const char *) "=", 1);
17316 0 : break;
17317 :
17318 0 : case M2Quads_IfLessEquOp:
17319 0 : return DynamicStrings_InitString ((const char *) "<=", 2);
17320 0 : break;
17321 :
17322 0 : case M2Quads_IfGreEquOp:
17323 0 : return DynamicStrings_InitString ((const char *) ">=", 2);
17324 0 : break;
17325 :
17326 0 : case M2Quads_IfGreOp:
17327 0 : return DynamicStrings_InitString ((const char *) ">", 1);
17328 0 : break;
17329 :
17330 0 : case M2Quads_IfLessOp:
17331 0 : return DynamicStrings_InitString ((const char *) "<", 1);
17332 0 : break;
17333 :
17334 0 : case M2Quads_IfNotEquOp:
17335 0 : return DynamicStrings_InitString ((const char *) "#", 1);
17336 0 : break;
17337 :
17338 0 : case M2Quads_IfInOp:
17339 0 : return DynamicStrings_InitString ((const char *) "IN", 2);
17340 0 : break;
17341 :
17342 0 : case M2Quads_IfNotInOp:
17343 0 : return DynamicStrings_InitString ((const char *) "NOT IN", 6);
17344 : break;
17345 :
17346 :
17347 : default:
17348 : return static_cast<DynamicStrings_String> (NULL);
17349 : break;
17350 : }
17351 : /* static analysis guarentees a RETURN statement will be used before here. */
17352 : __builtin_unreachable ();
17353 : }
17354 :
17355 :
17356 : /*
17357 : GetQuadtok - returns the Quadruple QuadNo.
17358 : */
17359 :
17360 173441259 : 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)
17361 : {
17362 173441259 : M2Quads_QuadFrame f;
17363 :
17364 173441259 : f = GetQF (QuadNo);
17365 173441259 : LastQuadNo = QuadNo;
17366 173441259 : (*Op) = f->Operator;
17367 173441259 : (*Oper1) = f->Operand1;
17368 173441259 : (*Oper2) = f->Operand2;
17369 173441259 : (*Oper3) = f->Operand3;
17370 173441259 : (*Op1Pos) = f->op1pos;
17371 173441259 : (*Op2Pos) = f->op2pos;
17372 173441259 : (*Op3Pos) = f->op3pos;
17373 173441259 : }
17374 :
17375 :
17376 : /*
17377 : GetQuadOtok - returns the Quadruple QuadNo.
17378 : */
17379 :
17380 6962897 : 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)
17381 : {
17382 6962897 : M2Quads_QuadFrame f;
17383 :
17384 6962897 : f = GetQF (QuadNo);
17385 6962897 : LastQuadNo = QuadNo;
17386 6962897 : (*Op) = f->Operator;
17387 6962897 : (*Oper1) = f->Operand1;
17388 6962897 : (*Oper2) = f->Operand2;
17389 6962897 : (*Oper3) = f->Operand3;
17390 6962897 : (*Op1Pos) = f->op1pos;
17391 6962897 : (*Op2Pos) = f->op2pos;
17392 6962897 : (*Op3Pos) = f->op3pos;
17393 6962897 : (*tok) = f->TokenNo;
17394 6962897 : (*overflowChecking) = f->CheckOverflow;
17395 6962897 : (*constExpr) = f->ConstExpr;
17396 6962897 : }
17397 :
17398 :
17399 : /*
17400 : GetQuadOTypetok - returns the fields associated with quadruple QuadNo.
17401 : */
17402 :
17403 6456 : 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)
17404 : {
17405 6456 : M2Quads_QuadFrame f;
17406 :
17407 6456 : f = GetQF (QuadNo);
17408 6456 : LastQuadNo = QuadNo;
17409 6456 : (*Op) = f->Operator;
17410 6456 : (*Oper1) = f->Operand1;
17411 6456 : (*Oper2) = f->Operand2;
17412 6456 : (*Oper3) = f->Operand3;
17413 6456 : (*Op1Pos) = f->op1pos;
17414 6456 : (*Op2Pos) = f->op2pos;
17415 6456 : (*Op3Pos) = f->op3pos;
17416 6456 : (*tok) = f->TokenNo;
17417 6456 : (*overflowChecking) = f->CheckOverflow;
17418 6456 : (*typeChecking) = f->CheckType;
17419 6456 : (*constExpr) = f->ConstExpr;
17420 6456 : }
17421 :
17422 :
17423 : /*
17424 : PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
17425 : sets a boolean to determinine whether overflow should be checked.
17426 : */
17427 :
17428 80854 : 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)
17429 : {
17430 80854 : M2Quads_QuadFrame f;
17431 :
17432 80854 : if (QuadrupleGeneration)
17433 : {
17434 80854 : M2Quads_EraseQuad (QuadNo);
17435 80854 : AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3);
17436 80854 : f = GetQF (QuadNo);
17437 80854 : f->Operator = Op;
17438 80854 : f->Operand1 = Oper1;
17439 80854 : f->Operand2 = Oper2;
17440 80854 : f->Operand3 = Oper3;
17441 80854 : f->CheckOverflow = overflowChecking;
17442 80854 : f->op1pos = Op1Pos;
17443 80854 : f->op2pos = Op2Pos;
17444 80854 : f->op3pos = Op3Pos;
17445 80854 : f->TokenNo = tok;
17446 80854 : f->ConstExpr = constExpr;
17447 : }
17448 80854 : }
17449 :
17450 :
17451 : /*
17452 : PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
17453 : */
17454 :
17455 14653 : extern "C" void M2Quads_PutQuad (unsigned int QuadNo, M2Quads_QuadOperator Op, unsigned int Oper1, unsigned int Oper2, unsigned int Oper3)
17456 : {
17457 14653 : PutQuadO (QuadNo, Op, Oper1, Oper2, Oper3, true);
17458 14653 : }
17459 :
17460 :
17461 : /*
17462 : GetFirstQuad - returns the first quadruple.
17463 : */
17464 :
17465 798769 : extern "C" unsigned int M2Quads_GetFirstQuad (void)
17466 : {
17467 798769 : return Head;
17468 : /* static analysis guarentees a RETURN statement will be used before here. */
17469 : __builtin_unreachable ();
17470 : }
17471 :
17472 :
17473 : /*
17474 : GetNextQuad - returns the Quadruple number following QuadNo.
17475 : */
17476 :
17477 3387595096 : extern "C" unsigned int M2Quads_GetNextQuad (unsigned int QuadNo)
17478 : {
17479 3387595096 : M2Quads_QuadFrame f;
17480 :
17481 3387595096 : f = GetQF (QuadNo);
17482 3387595096 : return f->Next;
17483 : /* static analysis guarentees a RETURN statement will be used before here. */
17484 : __builtin_unreachable ();
17485 : }
17486 :
17487 :
17488 : /*
17489 : GetRealQuad - returns the Quadruple number of the real quadruple
17490 : at QuadNo or beyond.
17491 : */
17492 :
17493 15211840 : extern "C" unsigned int M2Quads_GetRealQuad (unsigned int QuadNo)
17494 : {
17495 15211840 : M2Quads_QuadFrame f;
17496 :
17497 23077222 : while (QuadNo != 0)
17498 : {
17499 23077222 : if (Indexing_InBounds (QuadArray, QuadNo))
17500 : {
17501 22993418 : f = GetQF (QuadNo);
17502 22993418 : if ((((! (M2Quads_IsPseudoQuad (QuadNo))) && (f->Operator != M2Quads_DummyOp)) && (f->Operator != M2Quads_LineNumberOp)) && (f->Operator != M2Quads_StatementNoteOp))
17503 : {
17504 : return QuadNo;
17505 : }
17506 7865382 : QuadNo += 1;
17507 : }
17508 : else
17509 : {
17510 : return 0;
17511 : }
17512 : }
17513 : return 0;
17514 : /* static analysis guarentees a RETURN statement will be used before here. */
17515 : __builtin_unreachable ();
17516 : }
17517 :
17518 :
17519 : /*
17520 : SubQuad - subtracts a quadruple QuadNo from a list Head.
17521 : */
17522 :
17523 1926117 : extern "C" void M2Quads_SubQuad (unsigned int QuadNo)
17524 : {
17525 1926117 : unsigned int i;
17526 1926117 : M2Quads_QuadFrame f;
17527 1926117 : M2Quads_QuadFrame g;
17528 :
17529 1926117 : CheckBreak (QuadNo);
17530 1926117 : f = GetQF (QuadNo);
17531 1926117 : AlterReference (Head, QuadNo, f->Next);
17532 1926117 : UndoReadWriteInfo (QuadNo, f->Operator, f->Operand1, f->Operand2, f->Operand3);
17533 1926117 : if (Head == QuadNo)
17534 : {
17535 0 : Head = f->Next;
17536 : }
17537 : else
17538 : {
17539 1926117 : i = Head;
17540 1926117 : g = GetQF (i);
17541 5043237402 : while (g->Next != QuadNo)
17542 : {
17543 5039385168 : i = g->Next;
17544 5039385168 : g = GetQF (i);
17545 : }
17546 1926117 : g->Next = f->Next;
17547 : }
17548 1926117 : f->Operator = M2Quads_DummyOp;
17549 1926117 : NoOfQuads -= 1;
17550 1926117 : }
17551 :
17552 :
17553 : /*
17554 : EraseQuad - erases a quadruple QuadNo, the quadruple is still in the list
17555 : but wiped clean.
17556 : */
17557 :
17558 6377484 : extern "C" void M2Quads_EraseQuad (unsigned int QuadNo)
17559 : {
17560 6377484 : M2Quads_QuadFrame f;
17561 :
17562 6377484 : CheckBreak (QuadNo);
17563 6377484 : f = GetQF (QuadNo);
17564 6377484 : UndoReadWriteInfo (QuadNo, f->Operator, f->Operand1, f->Operand2, f->Operand3);
17565 6377484 : f->Operator = M2Quads_DummyOp; /* finally blank it out */
17566 6377484 : f->Operand1 = 0; /* finally blank it out */
17567 6377484 : f->Operand2 = 0;
17568 6377484 : f->Operand3 = 0;
17569 6377484 : f->Trash = 0;
17570 6377484 : f->op1pos = M2LexBuf_UnknownTokenNo;
17571 6377484 : f->op2pos = M2LexBuf_UnknownTokenNo;
17572 6377484 : f->op3pos = M2LexBuf_UnknownTokenNo;
17573 6377484 : f->ConstExpr = false;
17574 6377484 : }
17575 :
17576 :
17577 : /*
17578 : CountQuads - returns the number of quadruples.
17579 : */
17580 :
17581 9228580 : extern "C" unsigned int M2Quads_CountQuads (void)
17582 : {
17583 9228580 : return NoOfQuads;
17584 : /* static analysis guarentees a RETURN statement will be used before here. */
17585 : __builtin_unreachable ();
17586 : }
17587 :
17588 :
17589 : /*
17590 : BuildScaffold - generate the main, init, finish functions if
17591 : no -c and this is the application module.
17592 : */
17593 :
17594 15595 : extern "C" void M2Quads_BuildScaffold (unsigned int tok, unsigned int moduleSym)
17595 : {
17596 15595 : if ((SymbolTable_GetMainModule ()) == moduleSym)
17597 : {
17598 15067 : M2Scaffold_DeclareScaffold (tok);
17599 15067 : if (M2Options_ScaffoldMain || ! M2Options_cflag)
17600 : {
17601 : /* There are module init/fini functions and
17602 : application init/fini functions.
17603 : Here we create the application pair. */
17604 2823 : BuildM2LinkFunction (tok);
17605 2823 : BuildM2MainFunction (tok);
17606 2823 : BuildM2InitFunction (tok, moduleSym); /* Application init. */
17607 2823 : BuildM2FiniFunction (tok, moduleSym); /* Application fini. */
17608 : }
17609 : /* Application fini. */
17610 15067 : BuildM2DepFunction (tok, moduleSym); /* Per module dependency. */
17611 : /* Each module needs a ctor to register the module
17612 : init/finish/dep with M2RTS. */
17613 15067 : BuildM2CtorFunction (tok, moduleSym);
17614 : }
17615 528 : else if (M2Options_WholeProgram)
17616 : {
17617 : /* avoid dangling else. */
17618 528 : M2Scaffold_DeclareScaffold (tok);
17619 528 : BuildM2DepFunction (tok, moduleSym); /* Per module dependency. */
17620 : /* Each module needs a ctor to register the module
17621 : init/finish/dep with M2RTS. */
17622 528 : BuildM2CtorFunction (tok, moduleSym);
17623 : }
17624 15595 : }
17625 :
17626 :
17627 : /*
17628 : StartBuildDefFile - generates a StartFileDefOp quadruple indicating the file
17629 : that has produced the subsequent quadruples.
17630 : The code generator uses the StartDefFileOp quadruples
17631 : to relate any error to the appropriate file.
17632 :
17633 :
17634 : Entry Exit
17635 : ===== ====
17636 :
17637 :
17638 : Ptr -> <- Ptr
17639 : +------------+ +------------+
17640 : | ModuleName | | ModuleName |
17641 : |------------| |------------|
17642 :
17643 :
17644 : Quadruples Produced
17645 :
17646 : q StartDefFileOp _ _ ModuleSym
17647 : */
17648 :
17649 164816 : extern "C" void M2Quads_StartBuildDefFile (unsigned int tok)
17650 : {
17651 164816 : NameKey_Name ModuleName;
17652 :
17653 164816 : M2Quads_PopT (&ModuleName);
17654 164816 : M2Quads_PushT (ModuleName);
17655 164816 : GenQuadO (tok, M2Quads_StartDefFileOp, tok, SymbolTable_NulSym, SymbolTable_GetModule (ModuleName), false);
17656 164816 : }
17657 :
17658 :
17659 : /*
17660 : StartBuildModFile - generates a StartModFileOp quadruple indicating the file
17661 : that has produced the subsequent quadruples.
17662 : The code generator uses the StartModFileOp quadruples
17663 : to relate any error to the appropriate file.
17664 :
17665 :
17666 : Entry Exit
17667 : ===== ====
17668 :
17669 :
17670 : Ptr -> <- Ptr
17671 : +------------+ +------------+
17672 : | ModuleName | | ModuleName |
17673 : |------------| |------------|
17674 :
17675 :
17676 : Quadruples Produced
17677 :
17678 : q StartModFileOp lineno filename ModuleSym
17679 : */
17680 :
17681 84373 : extern "C" void M2Quads_StartBuildModFile (unsigned int tok)
17682 : {
17683 84373 : GenQuadO (tok, M2Quads_StartModFileOp, tok, (unsigned int ) (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()))), SymbolTable_GetFileModule (), false);
17684 84373 : }
17685 :
17686 :
17687 : /*
17688 : EndBuildFile - generates an EndFileOp quadruple indicating the file
17689 : that has produced the previous quadruples has ended.
17690 :
17691 : Entry Exit
17692 : ===== ====
17693 :
17694 :
17695 : Ptr -> <- Ptr
17696 : +------------+ +------------+
17697 : | ModuleName | | ModuleName |
17698 : |------------| |------------|
17699 :
17700 :
17701 : Quadruples Produced
17702 :
17703 : q EndFileOp _ _ ModuleSym
17704 : */
17705 :
17706 248970 : extern "C" void M2Quads_EndBuildFile (unsigned int tok)
17707 : {
17708 248970 : NameKey_Name ModuleName;
17709 :
17710 248970 : ModuleName = static_cast<NameKey_Name> (M2Quads_OperandT (1));
17711 248970 : GenQuadO (tok, M2Quads_EndFileOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_GetModule (ModuleName), false);
17712 248970 : }
17713 :
17714 :
17715 : /*
17716 : StartBuildInit - Sets the start of initialization code of the
17717 : current module to the next quadruple.
17718 : */
17719 :
17720 84749 : extern "C" void M2Quads_StartBuildInit (unsigned int tok)
17721 : {
17722 84749 : NameKey_Name name;
17723 84749 : unsigned int ModuleSym;
17724 :
17725 84749 : M2Quads_PopT (&name);
17726 84749 : ModuleSym = SymbolTable_GetCurrentModule ();
17727 169498 : M2Debug_Assert ((SymbolTable_IsModule (ModuleSym)) || (SymbolTable_IsDefImp (ModuleSym)));
17728 84749 : M2Debug_Assert ((SymbolTable_GetSymName (ModuleSym)) == name);
17729 84743 : SymbolTable_PutModuleStartQuad (ModuleSym, NextQuad);
17730 84743 : GenQuad (M2Quads_InitStartOp, tok, SymbolTable_GetFileModule (), ModuleSym);
17731 84743 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17732 84743 : M2Quads_PushT (name);
17733 84743 : CheckVariablesAt (ModuleSym);
17734 84743 : CheckNeedPriorityBegin (tok, ModuleSym, ModuleSym);
17735 84743 : M2StackWord_PushWord (TryStack, NextQuad);
17736 84743 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17737 84743 : if (SymbolTable_HasExceptionBlock (ModuleSym))
17738 : {
17739 54 : GenQuad (M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
17740 : }
17741 84743 : }
17742 :
17743 :
17744 : /*
17745 : EndBuildInit - Sets the end initialization code of a module.
17746 : */
17747 :
17748 84592 : extern "C" void M2Quads_EndBuildInit (unsigned int tok)
17749 : {
17750 84592 : if (SymbolTable_HasExceptionBlock (SymbolTable_GetCurrentModule ()))
17751 : {
17752 54 : BuildRTExceptLeave (tok, true);
17753 54 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17754 : }
17755 84592 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17756 84592 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17757 84592 : SymbolTable_PutModuleEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17758 84592 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17759 84592 : GenQuadO (tok, M2Quads_InitEndOp, tok, SymbolTable_GetFileModule (), SymbolTable_GetCurrentModule (), false);
17760 84592 : }
17761 :
17762 :
17763 : /*
17764 : StartBuildFinally - Sets the start of finalization code of the
17765 : current module to the next quadruple.
17766 : */
17767 :
17768 15814 : extern "C" void M2Quads_StartBuildFinally (unsigned int tok)
17769 : {
17770 15814 : NameKey_Name name;
17771 15814 : unsigned int ModuleSym;
17772 :
17773 15814 : M2Quads_PopT (&name);
17774 15808 : ModuleSym = SymbolTable_GetCurrentModule ();
17775 31616 : M2Debug_Assert ((SymbolTable_IsModule (ModuleSym)) || (SymbolTable_IsDefImp (ModuleSym)));
17776 15808 : M2Debug_Assert ((SymbolTable_GetSymName (ModuleSym)) == name);
17777 15808 : SymbolTable_PutModuleFinallyStartQuad (ModuleSym, NextQuad);
17778 15808 : GenQuadO (tok, M2Quads_FinallyStartOp, tok, SymbolTable_GetFileModule (), ModuleSym, false);
17779 15808 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17780 15808 : M2Quads_PushT (name);
17781 : /* CheckVariablesAt(ModuleSym) ; */
17782 15808 : CheckNeedPriorityBegin (tok, ModuleSym, ModuleSym);
17783 15808 : M2StackWord_PushWord (TryStack, NextQuad);
17784 15808 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17785 15808 : if (SymbolTable_HasExceptionFinally (ModuleSym))
17786 : {
17787 0 : GenQuadO (tok, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
17788 : }
17789 15808 : }
17790 :
17791 :
17792 : /*
17793 : EndBuildFinally - Sets the end finalization code of a module.
17794 : */
17795 :
17796 15808 : extern "C" void M2Quads_EndBuildFinally (unsigned int tok)
17797 : {
17798 15808 : if (SymbolTable_HasExceptionFinally (SymbolTable_GetCurrentModule ()))
17799 : {
17800 0 : BuildRTExceptLeave (tok, true);
17801 0 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17802 : }
17803 15808 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17804 15808 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17805 15808 : SymbolTable_PutModuleFinallyEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17806 15808 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17807 15808 : GenQuadO (tok, M2Quads_FinallyEndOp, tok, SymbolTable_GetFileModule (), SymbolTable_GetCurrentModule (), false);
17808 15808 : }
17809 :
17810 :
17811 : /*
17812 : BuildExceptInitial - adds an CatchBeginOp, CatchEndOp quadruple
17813 : in the current block.
17814 : */
17815 :
17816 2977 : extern "C" void M2Quads_BuildExceptInitial (unsigned int tok)
17817 : {
17818 2977 : unsigned int previous;
17819 :
17820 : /* we have finished the 'try' block, so now goto the return
17821 : section which will tidy up (any) priorities before returning.
17822 : */
17823 2977 : GenQuadO (tok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PopWord (ReturnStack), false);
17824 2977 : M2StackWord_PushWord (ReturnStack, NextQuad-1);
17825 : /*
17826 : this is the 'catch' block.
17827 : */
17828 2977 : BackPatch (M2StackWord_PeepWord (TryStack, 1), NextQuad);
17829 2977 : GenQuadO (tok, M2Quads_CatchBeginOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17830 2977 : previous = static_cast<unsigned int> (M2StackWord_PopWord (CatchStack));
17831 2977 : if (previous != 0)
17832 : {
17833 0 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}only allowed one EXCEPT statement in a procedure or module", 62);
17834 : }
17835 2977 : M2StackWord_PushWord (CatchStack, NextQuad-1);
17836 2977 : BuildRTExceptEnter (tok);
17837 2977 : }
17838 :
17839 :
17840 : /*
17841 : BuildExceptFinally - adds an ExceptOp quadruple in a modules
17842 : finally block.
17843 : */
17844 :
17845 0 : extern "C" void M2Quads_BuildExceptFinally (unsigned int tok)
17846 : {
17847 0 : M2Quads_BuildExceptInitial (tok);
17848 0 : }
17849 :
17850 :
17851 : /*
17852 : BuildExceptProcedure - adds an ExceptOp quadruple in a procedure
17853 : block.
17854 : */
17855 :
17856 168 : extern "C" void M2Quads_BuildExceptProcedure (unsigned int tok)
17857 : {
17858 168 : M2Quads_BuildExceptInitial (tok);
17859 168 : }
17860 :
17861 :
17862 : /*
17863 : BuildRetry - adds an RetryOp quadruple.
17864 : */
17865 :
17866 168 : extern "C" void M2Quads_BuildRetry (unsigned int tok)
17867 : {
17868 168 : if ((M2StackWord_PeepWord (CatchStack, 1)) == 0)
17869 : {
17870 6 : M2MetaError_MetaErrorT0 (tok, (const char *) "{%E}the {%kRETRY} statement must occur after an {%kEXCEPT} statement in the same module or procedure block", 106);
17871 : }
17872 : else
17873 : {
17874 162 : BuildRTExceptLeave (tok, false);
17875 162 : GenQuadO (tok, M2Quads_RetryOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PeepWord (TryStack, 1), false);
17876 : }
17877 168 : }
17878 :
17879 :
17880 : /*
17881 : BuildReThrow - creates a ThrowOp _ _ NulSym, indicating that
17882 : the exception needs to be rethrown. The stack
17883 : is unaltered.
17884 : */
17885 :
17886 222 : extern "C" void M2Quads_BuildReThrow (unsigned int tokenno)
17887 : {
17888 222 : GenQuadO (tokenno, M2Quads_ThrowOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17889 222 : }
17890 :
17891 :
17892 : /*
17893 : StartBuildInnerInit - Sets the start of initialization code of the
17894 : inner module to the next quadruple.
17895 : */
17896 :
17897 0 : extern "C" void M2Quads_StartBuildInnerInit (unsigned int tok)
17898 : {
17899 0 : SymbolTable_PutModuleStartQuad (SymbolTable_GetCurrentModule (), NextQuad);
17900 0 : GenQuadO (tok, M2Quads_InitStartOp, tok, SymbolTable_NulSym, SymbolTable_GetCurrentModule (), false);
17901 0 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
17902 0 : CheckNeedPriorityBegin (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17903 0 : M2StackWord_PushWord (TryStack, NextQuad);
17904 0 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
17905 0 : if (SymbolTable_HasExceptionFinally (SymbolTable_GetCurrentModule ()))
17906 : {
17907 0 : GenQuadO (tok, M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false);
17908 : }
17909 0 : }
17910 :
17911 :
17912 : /*
17913 : EndBuildInnerInit - Sets the end initialization code of a module.
17914 : */
17915 :
17916 0 : extern "C" void M2Quads_EndBuildInnerInit (unsigned int tok)
17917 : {
17918 0 : if (SymbolTable_HasExceptionBlock (SymbolTable_GetCurrentModule ()))
17919 : {
17920 0 : BuildRTExceptLeave (tok, true);
17921 0 : GenQuadO (tok, M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym, false);
17922 : }
17923 0 : SymbolTable_PutModuleEndQuad (SymbolTable_GetCurrentModule (), NextQuad);
17924 0 : CheckVariablesInBlock (SymbolTable_GetCurrentModule ());
17925 0 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
17926 0 : CheckNeedPriorityEnd (tok, SymbolTable_GetCurrentModule (), SymbolTable_GetCurrentModule ());
17927 0 : GenQuadO (tok, M2Quads_InitEndOp, tok, SymbolTable_NulSym, SymbolTable_GetCurrentModule (), false);
17928 0 : }
17929 :
17930 :
17931 : /*
17932 : BuildBuiltinConst - makes reference to a builtin constant within gm2.
17933 :
17934 : Entry Exit
17935 :
17936 : Ptr ->
17937 : +------------+ +------------+
17938 : | Ident | | Sym |
17939 : |------------| |------------|
17940 :
17941 : Quadruple produced:
17942 :
17943 : q Sym BuiltinConstOp Ident
17944 : */
17945 :
17946 29742 : extern "C" void M2Quads_BuildBuiltinConst (void)
17947 : {
17948 29742 : unsigned int idtok;
17949 29742 : unsigned int Id;
17950 29742 : unsigned int Sym;
17951 :
17952 29742 : M2Quads_PopTtok (&Id, &idtok);
17953 29742 : Sym = SymbolTable_MakeTemporary (idtok, SymbolTable_ImmediateValue);
17954 29742 : SymbolTable_PutVar (Sym, M2Base_Integer);
17955 : /*
17956 : CASE GetBuiltinConstType(KeyToCharStar(Name(Id))) OF
17957 :
17958 : 0: ErrorFormat1(NewError(GetTokenNo()),
17959 : '%a unrecognised builtin constant', Id) |
17960 : 1: PutVar(Sym, Integer) |
17961 : 2: PutVar(Sym, Real)
17962 :
17963 : ELSE
17964 : InternalError ('unrecognised value')
17965 : END ;
17966 : */
17967 29742 : GenQuadO (idtok, M2Quads_BuiltinConstOp, Sym, SymbolTable_NulSym, Id, false);
17968 29742 : M2Quads_PushTtok (Sym, idtok);
17969 29742 : }
17970 :
17971 :
17972 : /*
17973 : BuildBuiltinTypeInfo - make reference to a builtin typeinfo function
17974 : within gm2.
17975 :
17976 : Entry Exit
17977 :
17978 : Ptr ->
17979 : +-------------+
17980 : | Type |
17981 : |-------------| +------------+
17982 : | Ident | | Sym |
17983 : |-------------| |------------|
17984 :
17985 : Quadruple produced:
17986 :
17987 : q Sym BuiltinTypeInfoOp Type Ident
17988 : */
17989 :
17990 360 : extern "C" void M2Quads_BuildBuiltinTypeInfo (void)
17991 : {
17992 360 : unsigned int idtok;
17993 360 : unsigned int Ident;
17994 360 : unsigned int Type;
17995 360 : unsigned int Sym;
17996 :
17997 360 : M2Quads_PopTtok (&Ident, &idtok);
17998 360 : M2Quads_PopT (&Type);
17999 360 : Sym = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
18000 360 : switch (m2builtins_GetBuiltinTypeInfoType (const_cast <const char * > (static_cast <char * > (NameKey_KeyToCharStar ((NameKey_Name) (Ident))))))
18001 : {
18002 0 : case 0:
18003 0 : M2Error_ErrorFormat1 (M2Error_NewError (idtok), (const char *) "%a unrecognised builtin constant", 32, (const unsigned char *) &Ident, (sizeof (Ident)-1));
18004 0 : break;
18005 :
18006 192 : case 1:
18007 192 : SymbolTable_PutVar (Sym, M2Base_Boolean);
18008 192 : break;
18009 :
18010 120 : case 2:
18011 120 : SymbolTable_PutVar (Sym, M2Base_ZType);
18012 120 : break;
18013 :
18014 48 : case 3:
18015 48 : SymbolTable_PutVar (Sym, M2Base_RType);
18016 48 : break;
18017 :
18018 :
18019 0 : default:
18020 0 : M2Error_InternalError ((const char *) "unrecognised value", 18);
18021 360 : break;
18022 : }
18023 360 : GenQuadO (idtok, M2Quads_BuiltinTypeInfoOp, Sym, Type, Ident, false);
18024 360 : M2Quads_PushTtok (Sym, idtok);
18025 360 : }
18026 :
18027 :
18028 : /*
18029 : BuildAssignment - Builds an assignment from the values given on the
18030 : quad stack. Either an assignment to an
18031 : arithmetic expression or an assignment to a
18032 : boolean expression. This procedure should not
18033 : be called in CONST declarations.
18034 : The Stack is expected to contain:
18035 :
18036 :
18037 : Either
18038 :
18039 : Entry Exit
18040 : ===== ====
18041 :
18042 : Ptr ->
18043 : +------------+
18044 : | Expression |
18045 : |------------|
18046 : | Designator |
18047 : |------------| +------------+
18048 : | | | | <- Ptr
18049 : |------------| |------------|
18050 :
18051 :
18052 : Quadruples Produced
18053 :
18054 : q BecomesOp Designator _ Expression
18055 :
18056 : OR
18057 :
18058 : Entry Exit
18059 : ===== ====
18060 :
18061 : Ptr ->
18062 : +------------+
18063 : | True |False|
18064 : |------------|
18065 : | Designator |
18066 : |------------| +------------+
18067 : | | | | <- Ptr
18068 : |------------| |------------|
18069 :
18070 :
18071 : Quadruples Produced
18072 :
18073 : q BecomesOp Designator _ TRUE
18074 : q+1 GotoOp q+3
18075 : q+2 BecomesOp Designator _ FALSE
18076 :
18077 : */
18078 :
18079 126760 : extern "C" void M2Quads_BuildAssignment (unsigned int becomesTokNo)
18080 : {
18081 126760 : unsigned int des;
18082 126760 : unsigned int exp;
18083 126760 : unsigned int destok;
18084 126760 : unsigned int exptok;
18085 126760 : unsigned int combinedtok;
18086 :
18087 126760 : des = static_cast<unsigned int> (M2Quads_OperandT (2));
18088 126760 : if (IsReadOnly (des))
18089 : {
18090 36 : destok = static_cast<unsigned int> (M2Quads_OperandTok (2));
18091 36 : exptok = static_cast<unsigned int> (M2Quads_OperandTok (1));
18092 36 : exp = static_cast<unsigned int> (M2Quads_OperandT (1));
18093 36 : if (DebugTokPos)
18094 : {
18095 : M2MetaError_MetaErrorT1 (destok, (const char *) "destok {%1Ead}", 14, des);
18096 : M2MetaError_MetaErrorT1 (exptok, (const char *) "exptok {%1Ead}", 14, exp);
18097 : }
18098 36 : combinedtok = M2LexBuf_MakeVirtualTok (becomesTokNo, destok, exptok);
18099 36 : if (DebugTokPos)
18100 : {
18101 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "combined {%1Ead}", 16, des);
18102 : }
18103 36 : if (IsBoolean (1))
18104 : {
18105 0 : M2MetaError_MetaErrorT1 (combinedtok, (const char *) "cannot assign expression to a constant designator {%1Ead}", 57, des);
18106 : }
18107 : else
18108 : {
18109 36 : exp = static_cast<unsigned int> (M2Quads_OperandT (1));
18110 36 : M2MetaError_MetaErrorT2 (combinedtok, (const char *) "cannot assign a constant designator {%1Ead} with an expression {%2Ead}", 70, des, exp);
18111 : }
18112 36 : M2Quads_PopN (2); /* Remove both parameters. */
18113 : }
18114 126724 : else if (SymbolTable_IsError (des))
18115 : {
18116 : /* avoid dangling else. */
18117 25 : M2Quads_PopN (2); /* Remove both parameters. */
18118 : }
18119 : else
18120 : {
18121 : /* avoid dangling else. */
18122 126699 : doBuildAssignment (becomesTokNo, true, true);
18123 : }
18124 126754 : }
18125 :
18126 :
18127 : /*
18128 : BuildAssignConstant - used to create constant in the CONST declaration.
18129 : The stack is expected to contain:
18130 :
18131 : Either
18132 :
18133 : Entry Exit
18134 : ===== ====
18135 :
18136 : Ptr ->
18137 : +------------+
18138 : | Expression |
18139 : |------------|
18140 : | Designator |
18141 : |------------| +------------+
18142 : | | | | <- Ptr
18143 : |------------| |------------|
18144 :
18145 :
18146 : Quadruples Produced
18147 :
18148 : q BecomesOp Designator _ Expression
18149 :
18150 : OR
18151 :
18152 : Entry Exit
18153 : ===== ====
18154 :
18155 : Ptr ->
18156 : +------------+
18157 : | True |False|
18158 : |------------|
18159 : | Designator |
18160 : |------------| +------------+
18161 : | | | | <- Ptr
18162 : |------------| |------------|
18163 :
18164 :
18165 : Quadruples Produced
18166 :
18167 : q BecomesOp Designator _ TRUE
18168 : q+1 GotoOp q+3
18169 : q+2 BecomesOp Designator _ FALSE
18170 : */
18171 :
18172 299566 : extern "C" void M2Quads_BuildAssignConstant (unsigned int equalsTokNo)
18173 : {
18174 299566 : doBuildAssignment (equalsTokNo, true, true);
18175 299566 : }
18176 :
18177 :
18178 : /*
18179 : BuildAlignment - builds an assignment to an alignment constant.
18180 :
18181 : The Stack is expected to contain:
18182 :
18183 :
18184 : Entry Exit
18185 : ===== ====
18186 :
18187 : Ptr ->
18188 : +---------------+
18189 : | Expression |
18190 : |---------------|
18191 : | bytealignment |
18192 : |---------------| empty
18193 : */
18194 :
18195 72 : extern "C" void M2Quads_BuildAlignment (unsigned int tokno)
18196 : {
18197 72 : NameKey_Name name;
18198 72 : unsigned int expr;
18199 72 : unsigned int align;
18200 :
18201 72 : M2Quads_PopT (&expr);
18202 72 : M2Quads_PopT (&name);
18203 72 : if (name != (NameKey_MakeKey ((const char *) "bytealignment", 13)))
18204 : {
18205 0 : M2MetaError_MetaError1 ((const char *) "expecting bytealignment identifier, rather than {%1Ea}", 54, SymbolTable_MakeError (tokno, name));
18206 : }
18207 72 : FifoQueue_GetConstFromFifoQueue (&align);
18208 72 : M2Quads_PushT (align);
18209 72 : M2Quads_PushT (expr);
18210 72 : M2Quads_BuildAssignConstant (tokno);
18211 72 : }
18212 :
18213 :
18214 : /*
18215 : BuildBitLength - builds an assignment to a bit length constant.
18216 :
18217 : The Stack is expected to contain:
18218 :
18219 :
18220 : Entry Exit
18221 : ===== ====
18222 :
18223 : Ptr ->
18224 : +------------+
18225 : | Expression |
18226 : |------------| empty
18227 : */
18228 :
18229 0 : extern "C" void M2Quads_BuildBitLength (unsigned int tokno)
18230 : {
18231 0 : unsigned int expr;
18232 0 : unsigned int length;
18233 :
18234 0 : M2Quads_PopT (&expr);
18235 0 : FifoQueue_GetConstFromFifoQueue (&length);
18236 0 : M2Quads_PushT (length);
18237 0 : M2Quads_PushT (expr);
18238 0 : M2Quads_BuildAssignConstant (tokno);
18239 0 : }
18240 :
18241 :
18242 : /*
18243 : BuildPragmaField - builds an assignment to an alignment constant.
18244 :
18245 : The Stack is expected to contain:
18246 :
18247 :
18248 : Entry Exit
18249 : ===== ====
18250 :
18251 : Ptr ->
18252 : +------------+
18253 : | Expression |
18254 : |------------| empty
18255 : */
18256 :
18257 12 : extern "C" void M2Quads_BuildPragmaField (void)
18258 : {
18259 12 : unsigned int expr;
18260 12 : unsigned int const_;
18261 12 : NameKey_Name name;
18262 :
18263 12 : M2Quads_PopT (&expr);
18264 12 : M2Quads_PopT (&name);
18265 12 : if ((name != (NameKey_MakeKey ((const char *) "unused", 6))) && (name != (NameKey_MakeKey ((const char *) "bytealignment", 13))))
18266 : {
18267 0 : M2MetaError_MetaError0 ((const char *) "only allowed to use the attribute {%Ekbytealignment} in the default record field alignment pragma", 97);
18268 : }
18269 12 : if (expr != SymbolTable_NulSym)
18270 : {
18271 12 : FifoQueue_GetConstFromFifoQueue (&const_);
18272 12 : M2Quads_PushT (const_);
18273 12 : M2Quads_PushT (expr);
18274 12 : M2Quads_BuildAssignConstant (M2LexBuf_GetTokenNo ());
18275 : }
18276 12 : }
18277 :
18278 :
18279 : /*
18280 : BuildDefaultFieldAlignment - builds an assignment to an alignment constant.
18281 :
18282 : The Stack is expected to contain:
18283 :
18284 :
18285 : Entry Exit
18286 : ===== ====
18287 :
18288 : Ptr ->
18289 : +------------+
18290 : | Expression |
18291 : |------------| empty
18292 : */
18293 :
18294 36 : extern "C" void M2Quads_BuildDefaultFieldAlignment (void)
18295 : {
18296 36 : unsigned int expr;
18297 36 : unsigned int align;
18298 36 : NameKey_Name name;
18299 :
18300 36 : M2Quads_PopT (&expr);
18301 36 : M2Quads_PopT (&name);
18302 36 : if (name != (NameKey_MakeKey ((const char *) "bytealignment", 13)))
18303 : {
18304 0 : M2MetaError_MetaError0 ((const char *) "{%E}only allowed to use the attribute {%kbytealignment} in the default record field alignment pragma", 100);
18305 : }
18306 36 : FifoQueue_GetConstFromFifoQueue (&align);
18307 36 : M2Quads_PushT (align);
18308 36 : M2Quads_PushT (expr);
18309 36 : M2Quads_BuildAssignConstant (M2LexBuf_GetTokenNo ());
18310 36 : }
18311 :
18312 :
18313 : /*
18314 : BuildRepeat - Builds the repeat statement from the quad stack.
18315 : The Stack is expected to contain:
18316 :
18317 :
18318 : Entry Exit
18319 : ===== ====
18320 :
18321 :
18322 : Empty
18323 : <- Ptr
18324 : +------------+
18325 : | RepeatQuad |
18326 : |------------|
18327 :
18328 : */
18329 :
18330 1381 : extern "C" void M2Quads_BuildRepeat (void)
18331 : {
18332 1381 : M2Quads_PushT (NextQuad);
18333 1381 : }
18334 :
18335 :
18336 : /*
18337 : BuildUntil - Builds the until part of the repeat statement
18338 : from the quad stack.
18339 : The Stack is expected to contain:
18340 :
18341 :
18342 : Entry Exit
18343 : ===== ====
18344 :
18345 : Ptr ->
18346 : +------------+
18347 : | t | f |
18348 : |------------|
18349 : | RepeatQuad | Empty
18350 : |------------|
18351 : */
18352 :
18353 1381 : extern "C" void M2Quads_BuildUntil (void)
18354 : {
18355 1381 : unsigned int t;
18356 1381 : unsigned int f;
18357 1381 : unsigned int Repeat;
18358 :
18359 1381 : CheckBooleanId ();
18360 1381 : PopBool (&t, &f);
18361 1381 : M2Quads_PopT (&Repeat);
18362 1381 : BackPatch (f, Repeat); /* If False then keep on repeating */
18363 1381 : BackPatch (t, NextQuad); /* If True then exit repeat */
18364 1381 : }
18365 :
18366 :
18367 : /*
18368 : BuildWhile - Builds the While part of the While statement
18369 : from the quad stack.
18370 : The Stack is expected to contain:
18371 :
18372 :
18373 : Entry Exit
18374 : ===== ====
18375 :
18376 : <- Ptr
18377 : |------------|
18378 : Empty | WhileQuad |
18379 : |------------|
18380 : */
18381 :
18382 7639 : extern "C" void M2Quads_BuildWhile (void)
18383 : {
18384 7639 : M2Quads_PushT (NextQuad);
18385 7639 : }
18386 :
18387 :
18388 : /*
18389 : BuildDoWhile - Builds the Do part of the while statement
18390 : from the quad stack.
18391 : The Stack is expected to contain:
18392 :
18393 :
18394 : Entry Exit
18395 : ===== ====
18396 :
18397 : Ptr ->
18398 : +------------+ +------------+
18399 : | t | f | | 0 | f |
18400 : |------------| |------------|
18401 : | WhileQuad | | WhileQuad |
18402 : |------------| |------------|
18403 :
18404 : Quadruples
18405 :
18406 : BackPatch t exit to the NextQuad
18407 : */
18408 :
18409 7639 : extern "C" void M2Quads_BuildDoWhile (void)
18410 : {
18411 7639 : unsigned int t;
18412 7639 : unsigned int f;
18413 :
18414 7639 : CheckBooleanId ();
18415 7639 : PopBool (&t, &f);
18416 7639 : BackPatch (t, NextQuad);
18417 7639 : PushBool (0, f);
18418 7639 : }
18419 :
18420 :
18421 : /*
18422 : BuildEndWhile - Builds the end part of the while statement
18423 : from the quad stack.
18424 : The Stack is expected to contain:
18425 :
18426 :
18427 : Entry Exit
18428 : ===== ====
18429 :
18430 : Ptr ->
18431 : +------------+
18432 : | t | f |
18433 : |------------|
18434 : | WhileQuad | Empty
18435 : |------------|
18436 :
18437 : Quadruples
18438 :
18439 : q GotoOp WhileQuad
18440 : False exit is backpatched with q+1
18441 : */
18442 :
18443 7639 : extern "C" void M2Quads_BuildEndWhile (int reltokpos)
18444 : {
18445 7639 : unsigned int tok;
18446 7639 : unsigned int While;
18447 7639 : unsigned int t;
18448 7639 : unsigned int f;
18449 :
18450 7639 : tok = M2LexBuf_GetTokenNo ();
18451 7639 : tok = ((int ) (tok))+reltokpos;
18452 7639 : PopBool (&t, &f);
18453 7639 : M2Debug_Assert (t == 0);
18454 7639 : M2Quads_PopT (&While);
18455 7639 : GenQuadO (tok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, While, false);
18456 7639 : BackPatch (f, NextQuad);
18457 7639 : }
18458 :
18459 :
18460 : /*
18461 : BuildLoop - Builds the Loop part of the Loop statement
18462 : from the quad stack.
18463 : The Stack is expected to contain:
18464 :
18465 :
18466 : Entry Exit
18467 : ===== ====
18468 :
18469 : <- Ptr
18470 : Empty +------------+
18471 : | LoopQuad |
18472 : |------------|
18473 : */
18474 :
18475 509 : extern "C" void M2Quads_BuildLoop (void)
18476 : {
18477 509 : M2Quads_PushT (NextQuad);
18478 509 : PushExit (0); /* Seperate Exit Stack for loop end */
18479 509 : }
18480 :
18481 :
18482 : /*
18483 : BuildExit - Builds the Exit part of the Loop statement.
18484 : */
18485 :
18486 94 : extern "C" void M2Quads_BuildExit (void)
18487 : {
18488 94 : if (M2StackWord_IsEmptyWord (ExitStack))
18489 : {
18490 0 : M2MetaError_MetaError0 ((const char *) "{%EkEXIT} is only allowed in a {%kLOOP} statement", 49);
18491 : }
18492 : else
18493 : {
18494 94 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18495 94 : PushExit (Merge (PopExit (), NextQuad-1));
18496 : }
18497 94 : }
18498 :
18499 :
18500 : /*
18501 : BuildEndLoop - Builds the End part of the Loop statement
18502 : from the quad stack.
18503 : The Stack is expected to contain:
18504 :
18505 :
18506 : Entry Exit
18507 : ===== ====
18508 :
18509 : Ptr ->
18510 : +------------+
18511 : | LoopQuad | Empty
18512 : |------------|
18513 :
18514 : Quadruples
18515 :
18516 : Goto _ _ LoopQuad
18517 : */
18518 :
18519 509 : extern "C" void M2Quads_BuildEndLoop (void)
18520 : {
18521 509 : unsigned int Loop;
18522 :
18523 509 : M2Quads_PopT (&Loop);
18524 509 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, Loop);
18525 509 : BackPatch (PopExit (), NextQuad);
18526 509 : }
18527 :
18528 :
18529 : /*
18530 : BuildThenIf - Builds the Then part of the If statement
18531 : from the quad stack.
18532 : The Stack is expected to contain:
18533 :
18534 :
18535 : Entry Exit
18536 : ===== ====
18537 :
18538 : Ptr -> <- Ptr
18539 : +------------+ +------------+
18540 : | t | f | | 0 | f |
18541 : |------------| |------------|
18542 :
18543 : Quadruples
18544 :
18545 : The true exit is BackPatched to point to
18546 : the NextQuad.
18547 : */
18548 :
18549 44490 : extern "C" void M2Quads_BuildThenIf (void)
18550 : {
18551 44490 : unsigned int t;
18552 44490 : unsigned int f;
18553 :
18554 44490 : CheckBooleanId ();
18555 44490 : PopBool (&t, &f);
18556 44490 : BackPatch (t, NextQuad);
18557 44490 : PushBool (0, f);
18558 44490 : }
18559 :
18560 :
18561 : /*
18562 : BuildElse - Builds the Else part of the If statement
18563 : from the quad stack.
18564 : The Stack is expected to contain:
18565 :
18566 :
18567 : Entry Exit
18568 : ===== ====
18569 :
18570 : Ptr ->
18571 : +------------+ +------------+
18572 : | t | f | | t+q | 0 |
18573 : |------------| |------------|
18574 :
18575 : Quadruples
18576 :
18577 : q GotoOp _ _ 0
18578 : q+1 <- BackPatched from f
18579 : */
18580 :
18581 15059 : extern "C" void M2Quads_BuildElse (void)
18582 : {
18583 15059 : unsigned int t;
18584 15059 : unsigned int f;
18585 :
18586 15059 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18587 15059 : PopBool (&t, &f);
18588 15059 : BackPatch (f, NextQuad);
18589 15059 : PushBool (Merge (t, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
18590 15059 : }
18591 :
18592 :
18593 : /*
18594 : BuildEndIf - Builds the End part of the If statement
18595 : from the quad stack.
18596 : The Stack is expected to contain:
18597 :
18598 :
18599 : Entry Exit
18600 : ===== ====
18601 :
18602 : Ptr ->
18603 : +------------+
18604 : | t | f | Empty
18605 : |------------|
18606 :
18607 : Quadruples
18608 :
18609 : Both t and f are backpatched to point to the NextQuad
18610 : */
18611 :
18612 41284 : extern "C" void M2Quads_BuildEndIf (void)
18613 : {
18614 41284 : unsigned int t;
18615 41284 : unsigned int f;
18616 :
18617 41284 : PopBool (&t, &f);
18618 41284 : BackPatch (t, NextQuad);
18619 41284 : BackPatch (f, NextQuad);
18620 41284 : }
18621 :
18622 :
18623 : /*
18624 : BuildElsif1 - Builds the Elsif part of the If statement
18625 : from the quad stack.
18626 : The Stack is expected to contain:
18627 :
18628 :
18629 : Entry Exit
18630 : ===== ====
18631 :
18632 : Ptr ->
18633 : +------------+ +------------+
18634 : | t | f | | t+q | 0 |
18635 : |------------| |------------|
18636 :
18637 : Quadruples
18638 :
18639 : q GotoOp _ _ 0
18640 : q+1 <- BackPatched from f
18641 : */
18642 :
18643 3206 : extern "C" void M2Quads_BuildElsif1 (void)
18644 : {
18645 3206 : unsigned int t;
18646 3206 : unsigned int f;
18647 :
18648 3206 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18649 3206 : PopBool (&t, &f);
18650 3206 : BackPatch (f, NextQuad);
18651 3206 : PushBool (Merge (t, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
18652 3206 : }
18653 :
18654 :
18655 : /*
18656 : BuildElsif2 - Builds the Elsif until part of the If statement
18657 : from the quad stack.
18658 : The Stack is expected to contain:
18659 :
18660 :
18661 : Entry Exit
18662 : ===== ====
18663 :
18664 : Ptr ->
18665 : +--------------+
18666 : | 0 | f1 | <- Ptr
18667 : |--------------| +---------------+
18668 : | t2 | f2 | | t2 | f1+f2 |
18669 : |--------------| |---------------|
18670 : */
18671 :
18672 3206 : extern "C" void M2Quads_BuildElsif2 (void)
18673 : {
18674 3206 : unsigned int t1;
18675 3206 : unsigned int f1;
18676 3206 : unsigned int t2;
18677 3206 : unsigned int f2;
18678 :
18679 3206 : PopBool (&t1, &f1);
18680 3206 : M2Debug_Assert (t1 == 0);
18681 3206 : PopBool (&t2, &f2);
18682 3206 : PushBool (t2, Merge (f1, f2));
18683 3206 : }
18684 :
18685 :
18686 : /*
18687 : BuildForToByDo - Builds the For To By Do part of the For statement
18688 : from the quad stack.
18689 : The Stack is expected to contain:
18690 :
18691 :
18692 : Entry Exit
18693 : ===== ====
18694 :
18695 : <- Ptr
18696 : +----------------+
18697 : Ptr -> | RangeId |
18698 : +----------------+ |----------------|
18699 : | BySym | ByType | | ForQuad |
18700 : |----------------| |----------------|
18701 : | e2 | | LastValue |
18702 : |----------------| |----------------|
18703 : | e1 | | BySym | ByType |
18704 : |----------------| |----------------|
18705 : | Ident | | IdentSym |
18706 : |----------------| |----------------|
18707 :
18708 :
18709 : x := e1 ;
18710 : Note that LASTVALUE is calculated during M2GenGCC
18711 : after all the types have been resolved.
18712 : LASTVALUE := ((e2-e1) DIV BySym) * BySym + e1
18713 : IF BySym<0
18714 : THEN
18715 : IF e1<e2
18716 : THEN
18717 : goto exit
18718 : END
18719 : ELSE
18720 : IF e1>e2
18721 : THEN
18722 : goto exit
18723 : END
18724 : END ;
18725 : LOOP
18726 : body
18727 : IF x=LASTVALUE
18728 : THEN
18729 : goto exit
18730 : END ;
18731 : INC(x, BySym)
18732 : END
18733 :
18734 : Quadruples:
18735 :
18736 : q BecomesOp IdentSym _ e1
18737 : q+ LastForIteratorOp LastValue := ((e1-e2) DIV by) * by + e1
18738 : q+1 if >= by 0 q+..2
18739 : q+2 GotoOp q+3
18740 : q+3 If >= e1 e2 q+5
18741 : q+4 GotoOp exit
18742 : q+5 ..
18743 : q+..1 Goto q+..5
18744 : q+..2 If >= e2 e1 q+..4
18745 : q+..3 GotoOp exit
18746 : q+..4 ..
18747 :
18748 : The For Loop is regarded:
18749 :
18750 : For ident := e1 To e2 By by Do
18751 :
18752 : End
18753 : */
18754 :
18755 2576 : extern "C" void M2Quads_BuildForToByDo (void)
18756 : {
18757 2576 : M2Quads_LineNote l1;
18758 2576 : M2Quads_LineNote l2;
18759 2576 : NameKey_Name e1;
18760 2576 : NameKey_Name e2;
18761 2576 : NameKey_Name Id;
18762 2576 : unsigned int e1tok;
18763 2576 : unsigned int e2tok;
18764 2576 : unsigned int idtok;
18765 2576 : unsigned int bytok;
18766 2576 : unsigned int LastIterator;
18767 2576 : unsigned int exit1;
18768 2576 : unsigned int IdSym;
18769 2576 : unsigned int BySym;
18770 2576 : unsigned int ByType;
18771 2576 : unsigned int ForLoop;
18772 2576 : unsigned int RangeId;
18773 2576 : unsigned int t;
18774 2576 : unsigned int f;
18775 2576 : unsigned int etype;
18776 2576 : unsigned int t1;
18777 :
18778 2576 : l2 = PopLineNo ();
18779 2576 : l1 = PopLineNo ();
18780 2576 : UseLineNote (l1);
18781 2576 : PushFor (0);
18782 2576 : M2Quads_PopTFtok (&BySym, &ByType, &bytok);
18783 2576 : M2Quads_PopTtok (&e2, &e2tok);
18784 2576 : M2Quads_PopTtok (&e1, &e1tok);
18785 2576 : M2Quads_PopTtok (&Id, &idtok);
18786 2576 : IdSym = SymbolTable_RequestSym (idtok, Id);
18787 2576 : RangeId = M2Range_InitForLoopBeginRangeCheck (IdSym, idtok, e1, e1tok, e2, e2tok, BySym, bytok);
18788 2576 : BuildRange (RangeId);
18789 2576 : M2Quads_PushTtok (IdSym, idtok);
18790 2576 : M2Quads_PushTtok (e1, e1tok);
18791 2576 : BuildAssignmentWithoutBounds (idtok, true, true);
18792 2576 : UseLineNote (l2);
18793 3434 : LastIterator = SymbolTable_MakeTemporary (e2tok, AreConstant (((SymbolTable_IsConst (e1)) && (SymbolTable_IsConst (e2))) && (SymbolTable_IsConst (BySym))));
18794 2576 : SymbolTable_PutVar (LastIterator, SymbolTable_GetSType (IdSym));
18795 2576 : etype = M2Base_MixTypes (SymbolTable_GetSType (e1), SymbolTable_GetSType (e2), e2tok);
18796 2576 : e1 = doConvert (etype, e1);
18797 2576 : e2 = doConvert (etype, e2);
18798 2570 : ForLoopLastIterator (LastIterator, e1, e2, BySym, e1tok, e2tok, bytok);
18799 : /* q+2 GotoOp q+3 */
18800 2570 : M2Quads_PushTFtok (BySym, ByType, bytok); /* BuildRelOp 1st parameter. */
18801 2570 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter. */
18802 : /* 3rd parameter. */
18803 2570 : PushZero (bytok, ByType);
18804 2570 : M2Quads_BuildRelOp (e2tok); /* Choose final expression position. */
18805 2570 : PopBool (&t, &f); /* Choose final expression position. */
18806 2570 : BackPatch (f, NextQuad);
18807 : /* q+4 GotoOp Exit */
18808 2570 : M2Quads_PushTFtok (e1, SymbolTable_GetSType (e1), e1tok); /* BuildRelOp 1st parameter */
18809 2570 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter */
18810 2570 : M2Quads_PushTFtok (e2, SymbolTable_GetSType (e2), e2tok); /* 3rd parameter */
18811 2570 : M2Quads_BuildRelOp (e2tok); /* Choose final expression position. */
18812 2570 : PopBool (&t1, &exit1); /* Choose final expression position. */
18813 2570 : BackPatch (t1, NextQuad);
18814 2570 : PushFor (Merge (PopFor (), exit1)); /* Merge exit1. */
18815 2570 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0); /* Merge exit1. */
18816 2570 : ForLoop = NextQuad-1;
18817 : /* ELSE. */
18818 2570 : BackPatch (t, NextQuad);
18819 2570 : M2Quads_PushTFtok (e2, SymbolTable_GetSType (e2), e2tok); /* BuildRelOp 1st parameter */
18820 2570 : M2Quads_PushT (M2Reserved_GreaterEqualTok); /* 2nd parameter */
18821 2570 : M2Quads_PushTFtok (e1, SymbolTable_GetSType (e1), e1tok); /* 3rd parameter */
18822 2570 : M2Quads_BuildRelOp (e2tok); /* 3rd parameter */
18823 2570 : PopBool (&t1, &exit1);
18824 2570 : BackPatch (t1, NextQuad);
18825 2570 : PushFor (Merge (PopFor (), exit1)); /* Merge exit1. */
18826 2570 : BackPatch (ForLoop, NextQuad); /* Fixes the start of the for loop. */
18827 2570 : ForLoop = NextQuad;
18828 : /* And set up the stack. */
18829 2570 : M2Quads_PushTFtok (IdSym, SymbolTable_GetSym (IdSym), idtok);
18830 2570 : M2Quads_PushTFtok (BySym, ByType, bytok);
18831 2570 : M2Quads_PushTFtok (LastIterator, SymbolTable_GetSType (LastIterator), e2tok);
18832 2570 : M2Quads_PushT (ForLoop);
18833 2570 : M2Quads_PushT (RangeId);
18834 2570 : }
18835 :
18836 :
18837 : /*
18838 : BuildPseudoBy - Builds the Non existant part of the By
18839 : clause of the For statement
18840 : from the quad stack.
18841 : The Stack is expected to contain:
18842 :
18843 :
18844 : Entry Exit
18845 : ===== ====
18846 :
18847 : <- Ptr
18848 : +------------+
18849 : Ptr -> | BySym | t |
18850 : +------------+ |------------|
18851 : | e | t | | e | t |
18852 : |------------| |------------|
18853 : */
18854 :
18855 2210 : extern "C" void M2Quads_BuildPseudoBy (void)
18856 : {
18857 2210 : unsigned int expr;
18858 2210 : unsigned int type;
18859 2210 : unsigned int dotok;
18860 :
18861 : /* As there is no BY token this position is the DO at the end of the last expression. */
18862 2210 : M2Quads_PopTFtok (&expr, &type, &dotok);
18863 2210 : M2Quads_PushTFtok (expr, type, dotok);
18864 2210 : if (type == SymbolTable_NulSym)
18865 : {} /* empty. */
18866 : /* Use type. */
18867 1990 : else if ((SymbolTable_IsEnumeration (SymbolTable_SkipType (type))) || ((SymbolTable_SkipType (type)) == M2Base_Char))
18868 : {
18869 : /* avoid dangling else. */
18870 : }
18871 1770 : else if (M2Base_IsOrdinalType (SymbolTable_SkipType (type)))
18872 : {
18873 : /* avoid dangling else. */
18874 1770 : type = M2Base_ZType;
18875 : }
18876 2210 : PushOne (dotok, type, (const char *) "the implied {%kFOR} loop increment will cause an overflow {%1ad}", 64);
18877 2210 : }
18878 :
18879 :
18880 : /*
18881 : BuildEndFor - Builds the End part of the For statement
18882 : from the quad stack.
18883 : The Stack is expected to contain:
18884 :
18885 :
18886 : Entry Exit
18887 : ===== ====
18888 :
18889 : Ptr ->
18890 : +----------------+
18891 : | RangeId |
18892 : |----------------|
18893 : | ForQuad |
18894 : |----------------|
18895 : | LastValue |
18896 : |----------------|
18897 : | BySym | ByType |
18898 : |----------------|
18899 : | IdSym | Empty
18900 : |----------------|
18901 : */
18902 :
18903 2570 : extern "C" void M2Quads_BuildEndFor (unsigned int endpostok)
18904 : {
18905 2570 : unsigned int t;
18906 2570 : unsigned int f;
18907 2570 : unsigned int tsym;
18908 2570 : unsigned int RangeId;
18909 2570 : unsigned int IncQuad;
18910 2570 : unsigned int ForQuad;
18911 2570 : unsigned int LastSym;
18912 2570 : unsigned int ByType;
18913 2570 : unsigned int BySym;
18914 2570 : unsigned int bytok;
18915 2570 : unsigned int IdSym;
18916 2570 : unsigned int idtok;
18917 :
18918 2570 : M2Quads_PopT (&RangeId);
18919 2570 : M2Quads_PopT (&ForQuad);
18920 2570 : M2Quads_PopT (&LastSym);
18921 2570 : M2Quads_PopTFtok (&BySym, &ByType, &bytok);
18922 2570 : M2Quads_PopTtok (&IdSym, &idtok);
18923 : /* IF IdSym=LastSym THEN exit END */
18924 2570 : M2Quads_PushTF (IdSym, SymbolTable_GetSType (IdSym));
18925 2570 : M2Quads_PushT (M2Reserved_EqualTok);
18926 2570 : M2Quads_PushTF (LastSym, SymbolTable_GetSType (LastSym));
18927 2570 : M2Quads_BuildRelOp (endpostok);
18928 2570 : PopBool (&t, &f);
18929 2570 : BackPatch (t, NextQuad);
18930 2570 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
18931 2570 : PushFor (Merge (PopFor (), NextQuad-1));
18932 2570 : BackPatch (f, NextQuad);
18933 2570 : if ((SymbolTable_GetMode (IdSym)) == SymbolTable_LeftValue)
18934 : {
18935 : /* index variable is a LeftValue, therefore we must dereference it */
18936 0 : tsym = SymbolTable_MakeTemporary (idtok, SymbolTable_RightValue);
18937 0 : SymbolTable_PutVar (tsym, SymbolTable_GetSType (IdSym));
18938 0 : CheckPointerThroughNil (idtok, IdSym);
18939 0 : doIndrX (endpostok, tsym, IdSym);
18940 0 : BuildRange (M2Range_InitForLoopEndRangeCheck (tsym, BySym)); /* --fixme-- pass endpostok. */
18941 0 : IncQuad = NextQuad;
18942 : /* we have explicitly checked using the above and also
18943 : this addition can legitimately overflow if a cardinal type
18944 : is counting down. The above test will generate a more
18945 : precise error message, so we suppress overflow detection
18946 : here. */
18947 0 : GenQuadOTypetok (bytok, M2Quads_AddOp, tsym, tsym, BySym, false, false, idtok, idtok, bytok);
18948 0 : CheckPointerThroughNil (idtok, IdSym);
18949 0 : GenQuadOtok (idtok, M2Quads_XIndrOp, IdSym, SymbolTable_GetSType (IdSym), tsym, false, idtok, idtok, idtok);
18950 : }
18951 : else
18952 : {
18953 2570 : BuildRange (M2Range_InitForLoopEndRangeCheck (IdSym, BySym));
18954 2570 : IncQuad = NextQuad;
18955 : /* we have explicitly checked using the above and also
18956 : this addition can legitimately overflow if a cardinal type
18957 : is counting down. The above test will generate a more
18958 : precise error message, so we suppress overflow detection
18959 : here.
18960 :
18961 : This quadruple suppresses the generic binary op type
18962 : check (performed in M2GenGCC.mod) as there
18963 : will be a more informative/exhaustive check performed by the
18964 : InitForLoopBeginRangeCheck setup in BuildForToByDo and
18965 : performed by M2Range.mod. */
18966 2570 : GenQuadOTypetok (idtok, M2Quads_AddOp, IdSym, IdSym, BySym, false, false, idtok, idtok, bytok);
18967 : }
18968 2570 : GenQuadO (endpostok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, ForQuad, false);
18969 2570 : BackPatch (PopFor (), NextQuad);
18970 2570 : AddForInfo (ForQuad, NextQuad-1, IncQuad, IdSym, idtok);
18971 2570 : M2Range_PutRangeForIncrement (RangeId, IncQuad);
18972 2570 : }
18973 :
18974 :
18975 : /*
18976 : BuildCaseStart - starts the case statement.
18977 : It initializes a backpatch list on the compile
18978 : time stack, the list is used to contain all
18979 : case break points. The list is later backpatched
18980 : and contains all positions of the case statement
18981 : which jump to the end of the case statement.
18982 : The stack also contains room for a boolean
18983 : expression, this is needed to allow , operator
18984 : in the CaseField alternatives.
18985 :
18986 : The Stack is expected to contain:
18987 :
18988 :
18989 : Entry Exit
18990 : ===== ====
18991 :
18992 : <- Ptr
18993 : +------------+
18994 : | 0 | 0 |
18995 : |------------|
18996 : | 0 | 0 |
18997 : +-------------+ |------------|
18998 : | Expr | | | Expr | |
18999 : |-------------| |------------|
19000 : */
19001 :
19002 989 : extern "C" void M2Quads_BuildCaseStart (void)
19003 : {
19004 989 : BuildRange (M2Range_InitCaseBounds (M2CaseList_PushCase (SymbolTable_NulSym, SymbolTable_NulSym, M2Quads_OperandT (1))));
19005 989 : PushBool (0, 0); /* BackPatch list initialized */
19006 989 : PushBool (0, 0); /* Room for a boolean expression */
19007 989 : }
19008 :
19009 :
19010 : /*
19011 : BuildCaseStartStatementSequence - starts the statement sequence
19012 : inside a case clause.
19013 : BackPatches the true exit to the
19014 : NextQuad.
19015 : The Stack:
19016 :
19017 : Entry Exit
19018 :
19019 : Ptr -> <- Ptr
19020 : +-----------+ +------------+
19021 : | t | f | | 0 | f |
19022 : |-----------| |------------|
19023 : */
19024 :
19025 3791 : extern "C" void M2Quads_BuildCaseStartStatementSequence (void)
19026 : {
19027 3791 : unsigned int t;
19028 3791 : unsigned int f;
19029 :
19030 3791 : PopBool (&t, &f);
19031 3791 : BackPatch (t, NextQuad);
19032 3791 : PushBool (0, f);
19033 3791 : }
19034 :
19035 :
19036 : /*
19037 : BuildCaseEndStatementSequence - ends the statement sequence
19038 : inside a case clause.
19039 : BackPatches the false exit f1 to the
19040 : NextQuad.
19041 : Asserts that t1 and f2 is 0
19042 : Pushes t2+q and 0
19043 :
19044 : Quadruples:
19045 :
19046 : q GotoOp _ _ 0
19047 :
19048 : The Stack:
19049 :
19050 : Entry Exit
19051 :
19052 : Ptr -> <- Ptr
19053 : +-----------+ +------------+
19054 : | t1 | f1 | | 0 | 0 |
19055 : |-----------| |------------|
19056 : | t2 | f2 | | t2+q | 0 |
19057 : |-----------| |------------|
19058 : */
19059 :
19060 3791 : extern "C" void M2Quads_BuildCaseEndStatementSequence (void)
19061 : {
19062 3791 : unsigned int t1;
19063 3791 : unsigned int f1;
19064 3791 : unsigned int t2;
19065 3791 : unsigned int f2;
19066 :
19067 3791 : GenQuad (M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
19068 3791 : PopBool (&t1, &f1);
19069 3791 : PopBool (&t2, &f2); /* t2 contains the break list for the case */
19070 3791 : BackPatch (f1, NextQuad); /* f1 no longer needed */
19071 3791 : M2Debug_Assert (t1 == 0); /* f1 no longer needed */
19072 3791 : M2Debug_Assert (f2 == 0);
19073 3791 : PushBool (Merge (t2, NextQuad-1), 0); /* NextQuad-1 = Goto Quad */
19074 3791 : PushBool (0, 0); /* Room for boolean expression */
19075 3791 : }
19076 :
19077 :
19078 : /*
19079 : BuildCaseRange - builds the range testing quaruples for
19080 : a case clause.
19081 :
19082 : IF (e1>=ce1) AND (e1<=ce2)
19083 : THEN
19084 :
19085 : ELS..
19086 :
19087 : The Stack:
19088 :
19089 : Entry Exit
19090 :
19091 : Ptr ->
19092 : +-----------+
19093 : | ce2 | <- Ptr
19094 : |-----------| +-----------+
19095 : | ce1 | | t | f |
19096 : |-----------| |-----------|
19097 : | t1 | f1 | | t1 | f1 |
19098 : |-----------| |-----------|
19099 : | t2 | f2 | | t2 | f2 |
19100 : |-----------| |-----------|
19101 : | e1 | | e1 |
19102 : |-----------| |-----------|
19103 : */
19104 :
19105 170 : extern "C" void M2Quads_BuildCaseRange (void)
19106 : {
19107 170 : unsigned int ce1;
19108 170 : unsigned int ce2;
19109 170 : unsigned int combinedtok;
19110 170 : unsigned int ce1tok;
19111 170 : unsigned int ce2tok;
19112 170 : unsigned int e1tok;
19113 170 : unsigned int e1;
19114 170 : unsigned int t2;
19115 170 : unsigned int f2;
19116 170 : unsigned int t1;
19117 170 : unsigned int f1;
19118 :
19119 170 : M2Quads_PopTtok (&ce2, &ce2tok);
19120 170 : M2Quads_PopTtok (&ce1, &ce1tok);
19121 170 : combinedtok = M2LexBuf_MakeVirtualTok (ce2tok, ce2tok, ce1tok);
19122 170 : M2CaseList_AddRange (ce1, ce2, combinedtok);
19123 170 : PopBool (&t1, &f1);
19124 170 : PopBool (&t2, &f2);
19125 170 : M2Quads_PopTtok (&e1, &e1tok);
19126 170 : M2Quads_PushTtok (e1, e1tok); /* leave e1 on bottom of stack when exit procedure */
19127 170 : PushBool (t2, f2); /* leave e1 on bottom of stack when exit procedure */
19128 170 : PushBool (t1, f1); /* also leave t1 and f1 on the bottom of the stack */
19129 170 : M2Quads_PushTtok (e1, e1tok); /* also leave t1 and f1 on the bottom of the stack */
19130 170 : M2Quads_PushT (M2Reserved_GreaterEqualTok);
19131 170 : M2Quads_PushTtok (ce1, ce1tok);
19132 170 : M2Quads_BuildRelOp (combinedtok);
19133 170 : M2Quads_PushT (M2Reserved_AndTok);
19134 170 : M2Quads_RecordOp ();
19135 170 : M2Quads_PushTtok (e1, e1tok);
19136 170 : M2Quads_PushT (M2Reserved_LessEqualTok);
19137 170 : M2Quads_PushTtok (ce2, ce2tok);
19138 170 : M2Quads_BuildRelOp (combinedtok);
19139 170 : M2Quads_BuildBinaryOp ();
19140 170 : }
19141 :
19142 :
19143 : /*
19144 : BuildCaseEquality - builds the range testing quadruples for
19145 : a case clause.
19146 :
19147 : IF e1=ce1
19148 : THEN
19149 :
19150 : ELS..
19151 :
19152 : The Stack:
19153 :
19154 : Entry Exit
19155 :
19156 : Ptr ->
19157 : +-----------+ +-----------+
19158 : | ce1 | | t | f |
19159 : |-----------| |-----------|
19160 : | t1 | f1 | | t1 | f1 |
19161 : |-----------| |-----------|
19162 : | t2 | f2 | | t2 | f2 |
19163 : |-----------| |-----------|
19164 : | e1 | | e1 |
19165 : |-----------| |-----------|
19166 : */
19167 :
19168 3671 : extern "C" void M2Quads_BuildCaseEquality (void)
19169 : {
19170 3671 : unsigned int ce1tok;
19171 3671 : unsigned int e1tok;
19172 3671 : unsigned int ce1;
19173 3671 : unsigned int e1;
19174 3671 : unsigned int t2;
19175 3671 : unsigned int f2;
19176 3671 : unsigned int t1;
19177 3671 : unsigned int f1;
19178 :
19179 3671 : M2Quads_PopTtok (&ce1, &ce1tok);
19180 3671 : M2CaseList_AddRange (ce1, SymbolTable_NulSym, ce1tok);
19181 3671 : PopBool (&t1, &f1);
19182 3671 : PopBool (&t2, &f2);
19183 3671 : M2Quads_PopTtok (&e1, &e1tok);
19184 3671 : M2Quads_PushTtok (e1, e1tok); /* leave e1 on bottom of stack when exit procedure */
19185 3671 : PushBool (t2, f2); /* also leave t2 and f2 on the bottom of the stack */
19186 3671 : PushBool (t1, f1); /* also leave t2 and f2 on the bottom of the stack */
19187 3671 : M2Quads_PushTtok (e1, e1tok);
19188 3671 : M2Quads_PushT (M2Reserved_EqualTok);
19189 3671 : M2Quads_PushTtok (ce1, ce1tok);
19190 3671 : M2Quads_BuildRelOp (ce1tok);
19191 3671 : }
19192 :
19193 :
19194 : /*
19195 : BuildCaseList - merges two case tests into one
19196 :
19197 : The Stack:
19198 :
19199 : Entry Exit
19200 :
19201 : Ptr ->
19202 : +-----------+
19203 : | t2 | f2 |
19204 : |-----------| +-------------+
19205 : | t1 | f1 | | t1+t2| f1+f2|
19206 : |-----------| |-------------|
19207 : */
19208 :
19209 3841 : extern "C" void M2Quads_BuildCaseList (void)
19210 : {
19211 3841 : unsigned int t2;
19212 3841 : unsigned int f2;
19213 3841 : unsigned int t1;
19214 3841 : unsigned int f1;
19215 :
19216 3841 : PopBool (&t2, &f2);
19217 3841 : PopBool (&t1, &f1);
19218 3841 : PushBool (Merge (t1, t2), Merge (f1, f2));
19219 3841 : }
19220 :
19221 :
19222 : /*
19223 : BuildCaseOr - builds the , in the case clause.
19224 :
19225 : The Stack:
19226 :
19227 : Entry Exit
19228 :
19229 : Ptr -> <- Ptr
19230 : +-----------+ +------------+
19231 : | t | f | | t | 0 |
19232 : |-----------| |------------|
19233 : */
19234 :
19235 50 : extern "C" void M2Quads_BuildCaseOr (void)
19236 : {
19237 50 : unsigned int t;
19238 50 : unsigned int f;
19239 :
19240 50 : PopBool (&t, &f);
19241 50 : BackPatch (f, NextQuad);
19242 50 : PushBool (t, 0);
19243 50 : }
19244 :
19245 :
19246 : /*
19247 : BuildCaseElse - builds the else of case clause.
19248 :
19249 : The Stack:
19250 :
19251 : Entry Exit
19252 :
19253 : Ptr -> <- Ptr
19254 : +-----------+ +------------+
19255 : | t | f | | t | 0 |
19256 : |-----------| |------------|
19257 : */
19258 :
19259 989 : extern "C" void M2Quads_BuildCaseElse (void)
19260 : {
19261 989 : unsigned int t;
19262 989 : unsigned int f;
19263 :
19264 989 : PopBool (&t, &f);
19265 989 : BackPatch (f, NextQuad);
19266 989 : PushBool (t, 0);
19267 989 : }
19268 :
19269 :
19270 : /*
19271 : BuildCaseEnd - builds the end of case clause.
19272 :
19273 : The Stack:
19274 :
19275 : Entry Exit
19276 :
19277 : Ptr ->
19278 : +-----------+
19279 : | t1 | f1 |
19280 : |-----------|
19281 : | t2 | f2 |
19282 : |-----------|
19283 : | e1 |
19284 : |-----------| Empty
19285 : */
19286 :
19287 989 : extern "C" void M2Quads_BuildCaseEnd (void)
19288 : {
19289 989 : unsigned int e1;
19290 989 : unsigned int t;
19291 989 : unsigned int f;
19292 :
19293 989 : PopBool (&t, &f);
19294 989 : BackPatch (f, NextQuad);
19295 989 : BackPatch (t, NextQuad);
19296 989 : PopBool (&t, &f);
19297 989 : BackPatch (f, NextQuad);
19298 989 : BackPatch (t, NextQuad);
19299 989 : M2Quads_PopT (&e1);
19300 989 : M2CaseList_PopCase ();
19301 989 : }
19302 :
19303 :
19304 : /*
19305 : BuildCaseCheck - builds the case checking code to ensure that
19306 : the program does not need an else clause at runtime.
19307 : The stack is unaltered.
19308 : */
19309 :
19310 491 : extern "C" void M2Quads_BuildCaseCheck (void)
19311 : {
19312 491 : BuildError (M2Range_InitNoElseRangeCheck ());
19313 491 : }
19314 :
19315 :
19316 : /*
19317 : BuildNulParam - Builds a nul parameter on the stack.
19318 : The Stack:
19319 :
19320 : Entry Exit
19321 :
19322 : <- Ptr
19323 : Empty +------------+
19324 : | 0 |
19325 : |------------|
19326 : */
19327 :
19328 18046 : extern "C" void M2Quads_BuildNulParam (void)
19329 : {
19330 18046 : M2Quads_PushT (static_cast<unsigned int> (0));
19331 18046 : }
19332 :
19333 :
19334 : /*
19335 : BuildProcedureCall - builds a procedure call.
19336 : Although this procedure does not directly
19337 : destroy the procedure parameters, it calls
19338 : routine which will manipulate the stack and
19339 : so the entry and exit states of the stack are shown.
19340 :
19341 : The Stack:
19342 :
19343 :
19344 : Entry Exit
19345 :
19346 : Ptr ->
19347 : +----------------+
19348 : | NoOfParam |
19349 : |----------------|
19350 : | Param 1 |
19351 : |----------------|
19352 : | Param 2 |
19353 : |----------------|
19354 : . .
19355 : . .
19356 : . .
19357 : |----------------|
19358 : | Param # |
19359 : |----------------|
19360 : | ProcSym | Type | Empty
19361 : |----------------|
19362 : */
19363 :
19364 177513 : extern "C" void M2Quads_BuildProcedureCall (unsigned int tokno)
19365 : {
19366 177513 : unsigned int NoOfParam;
19367 177513 : unsigned int ProcSym;
19368 :
19369 177513 : M2Quads_PopT (&NoOfParam);
19370 177513 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19371 177513 : M2Quads_PushT (NoOfParam); /* Compile time stack restored to entry state */
19372 177513 : if ((M2Base_IsPseudoBaseProcedure (ProcSym)) || (M2System_IsPseudoSystemProcedure (ProcSym))) /* Compile time stack restored to entry state */
19373 : {
19374 21047 : M2Quads_DisplayStack ();
19375 21047 : ManipulatePseudoCallParameters ();
19376 21047 : M2Quads_DisplayStack ();
19377 21047 : BuildPseudoProcedureCall (tokno);
19378 21047 : M2Quads_DisplayStack ();
19379 : }
19380 156466 : else if (SymbolTable_IsUnknown (ProcSym))
19381 : {
19382 : /* avoid dangling else. */
19383 : /* Spellcheck. */
19384 30 : M2MetaError_MetaError1 ((const char *) "{%1Ua} is not recognised as a procedure {%1&s}", 46, ProcSym);
19385 30 : M2Quads_PopN (NoOfParam+2);
19386 30 : SymbolTable_UnknownReported (ProcSym);
19387 : }
19388 : else
19389 : {
19390 : /* avoid dangling else. */
19391 156436 : M2Quads_DisplayStack ();
19392 156436 : BuildRealProcedureCall (tokno);
19393 156430 : M2Quads_DisplayStack ();
19394 : }
19395 177507 : }
19396 :
19397 :
19398 : /*
19399 : CheckBuildFunction - checks to see whether ProcSym is a function
19400 : and if so it adds a TempSym value which will
19401 : hold the return value once the function finishes.
19402 : This procedure also generates an error message
19403 : if the user is calling a function and ignoring
19404 : the return result. The additional TempSym
19405 : is not created if ProcSym is a procedure
19406 : and the stack is unaltered.
19407 :
19408 : The Stack:
19409 :
19410 :
19411 : Entry Exit
19412 :
19413 : Ptr ->
19414 :
19415 : +----------------+
19416 : | ProcSym | Type |
19417 : +----------------+ |----------------|
19418 : | ProcSym | Type | | TempSym | Type |
19419 : |----------------| |----------------|
19420 : */
19421 :
19422 105741 : extern "C" bool M2Quads_CheckBuildFunction (void)
19423 : {
19424 105741 : unsigned int tokpos;
19425 105741 : unsigned int TempSym;
19426 105741 : unsigned int ProcSym;
19427 105741 : unsigned int Type;
19428 :
19429 105741 : M2Quads_PopTFtok (&ProcSym, &Type, &tokpos);
19430 105741 : if ((SymbolTable_IsVar (ProcSym)) && (SymbolTable_IsProcType (Type)))
19431 : {
19432 : /* avoid dangling else. */
19433 684 : if ((SymbolTable_GetSType (Type)) != SymbolTable_NulSym)
19434 : {
19435 0 : TempSym = SymbolTable_MakeTemporary (tokpos, SymbolTable_RightValue);
19436 0 : SymbolTable_PutVar (TempSym, SymbolTable_GetSType (Type));
19437 0 : M2Quads_PushTFtok (TempSym, SymbolTable_GetSType (Type), tokpos);
19438 0 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19439 0 : if (! (SymbolTable_IsReturnOptionalAny (Type)))
19440 : {
19441 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "function {%1Ea} is called but its return value is ignored", 57, ProcSym);
19442 : }
19443 : return true;
19444 : }
19445 : }
19446 105057 : else if ((SymbolTable_IsProcedure (ProcSym)) && (Type != SymbolTable_NulSym))
19447 : {
19448 : /* avoid dangling else. */
19449 0 : TempSym = SymbolTable_MakeTemporary (tokpos, SymbolTable_RightValue);
19450 0 : SymbolTable_PutVar (TempSym, Type);
19451 0 : M2Quads_PushTFtok (TempSym, Type, tokpos);
19452 0 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19453 0 : if (! (SymbolTable_IsReturnOptionalAny (ProcSym)))
19454 : {
19455 0 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "function {%1Ea} is called but its return value is ignored", 57, ProcSym);
19456 : }
19457 : return true;
19458 : }
19459 105741 : M2Quads_PushTFtok (ProcSym, Type, tokpos);
19460 105741 : return false;
19461 : /* static analysis guarentees a RETURN statement will be used before here. */
19462 : __builtin_unreachable ();
19463 : }
19464 :
19465 :
19466 : /*
19467 : BuildFunctionCall - builds a function call.
19468 : The Stack:
19469 :
19470 :
19471 : Entry Exit
19472 :
19473 : Ptr ->
19474 : +----------------+
19475 : | NoOfParam |
19476 : |----------------|
19477 : | Param 1 |
19478 : |----------------|
19479 : | Param 2 |
19480 : |----------------|
19481 : . .
19482 : . .
19483 : . .
19484 : |----------------|
19485 : | Param # | <- Ptr
19486 : |----------------| +------------+
19487 : | ProcSym | Type | | ReturnVar |
19488 : |----------------| |------------|
19489 : */
19490 :
19491 107705 : extern "C" void M2Quads_BuildFunctionCall (bool ConstExpr)
19492 : {
19493 107705 : unsigned int paramtok;
19494 107705 : unsigned int combinedtok;
19495 107705 : unsigned int functok;
19496 107705 : unsigned int NoOfParam;
19497 107705 : unsigned int ProcSym;
19498 :
19499 107705 : M2Quads_PopT (&NoOfParam);
19500 107705 : functok = OperandTtok (NoOfParam+1);
19501 107705 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19502 107705 : ProcSym = PCSymBuild_SkipConst (ProcSym);
19503 107705 : M2Quads_PushT (NoOfParam);
19504 : /* Compile time stack restored to entry state. */
19505 107705 : if (SymbolTable_IsUnknown (ProcSym))
19506 : {
19507 : /* Spellcheck. */
19508 6 : paramtok = OperandTtok (1);
19509 6 : combinedtok = M2LexBuf_MakeVirtual2Tok (functok, paramtok);
19510 6 : M2MetaError_MetaErrorT1 (functok, (const char *) "procedure function {%1Ea} is undefined {%1&s}", 45, ProcSym);
19511 6 : SymbolTable_UnknownReported (ProcSym);
19512 6 : M2Quads_PopN (NoOfParam+2);
19513 : /* Fake return value to continue compiling. */
19514 6 : M2Quads_PushT (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym));
19515 : }
19516 107699 : else if (SymbolTable_IsAModula2Type (ProcSym))
19517 : {
19518 : /* avoid dangling else. */
19519 2544 : ManipulatePseudoCallParameters ();
19520 2544 : BuildTypeCoercion (ConstExpr);
19521 : }
19522 105155 : else if ((M2System_IsPseudoSystemFunction (ProcSym)) || (M2Base_IsPseudoBaseFunction (ProcSym)))
19523 : {
19524 : /* avoid dangling else. */
19525 42871 : ManipulatePseudoCallParameters ();
19526 42871 : BuildPseudoFunctionCall (ConstExpr);
19527 : }
19528 : else
19529 : {
19530 : /* avoid dangling else. */
19531 62284 : BuildRealFunctionCall (functok, ConstExpr);
19532 : }
19533 107675 : }
19534 :
19535 :
19536 : /*
19537 : BuildConstFunctionCall - builds a function call and checks that this function can be
19538 : called inside a ConstExpression.
19539 :
19540 : The Stack:
19541 :
19542 :
19543 : Entry Exit
19544 :
19545 : Ptr ->
19546 : +----------------+
19547 : | NoOfParam |
19548 : |----------------|
19549 : | Param 1 |
19550 : |----------------|
19551 : | Param 2 |
19552 : |----------------|
19553 : . .
19554 : . .
19555 : . .
19556 : |----------------|
19557 : | Param # | <- Ptr
19558 : |----------------| +------------+
19559 : | ProcSym | Type | | ReturnVar |
19560 : |----------------| |------------|
19561 :
19562 : */
19563 :
19564 7477 : extern "C" void M2Quads_BuildConstFunctionCall (void)
19565 : {
19566 7477 : unsigned int functok;
19567 7477 : unsigned int combinedtok;
19568 7477 : unsigned int paramtok;
19569 7477 : unsigned int ConstExpression;
19570 7477 : unsigned int NoOfParam;
19571 7477 : unsigned int ProcSym;
19572 :
19573 7477 : M2Quads_DisplayStack ();
19574 7477 : M2Quads_PopT (&NoOfParam);
19575 7477 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19576 7477 : functok = OperandTtok (NoOfParam+1);
19577 7477 : if (M2Options_CompilerDebugging)
19578 : {
19579 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));
19580 : }
19581 : /* ErrorStringAt (InitString ('constant function'), functok). */
19582 7477 : M2Quads_PushT (NoOfParam);
19583 7477 : if ((ProcSym != M2Base_Convert) && (((M2Base_IsPseudoBaseFunction (ProcSym)) || (M2System_IsPseudoSystemFunctionConstExpression (ProcSym))) || ((SymbolTable_IsProcedure (ProcSym)) && (SymbolTable_IsProcedureBuiltin (ProcSym)))))
19584 : {
19585 7345 : M2Quads_BuildFunctionCall (true);
19586 : }
19587 : else
19588 : {
19589 132 : if (SymbolTable_IsAModula2Type (ProcSym))
19590 : {
19591 : /* Type conversion. */
19592 132 : if (NoOfParam == 1)
19593 : {
19594 132 : ConstExpression = static_cast<unsigned int> (M2Quads_OperandT (NoOfParam+1));
19595 132 : paramtok = OperandTtok (NoOfParam+1);
19596 132 : M2Quads_PopN (NoOfParam+2);
19597 : /* Build macro: CONVERT( ProcSym, ConstExpression ). */
19598 132 : M2Quads_PushTFtok (M2Base_Convert, static_cast<unsigned int> (SymbolTable_NulSym), functok);
19599 132 : M2Quads_PushTtok (ProcSym, functok);
19600 132 : M2Quads_PushTtok (ConstExpression, paramtok);
19601 132 : M2Quads_PushT (static_cast<unsigned int> (2)); /* Two parameters. */
19602 132 : BuildConvertFunction (M2Base_Convert, true); /* Two parameters. */
19603 : }
19604 : else
19605 : {
19606 0 : M2MetaError_MetaErrorT0 (functok, (const char *) "{%E}a constant type conversion can only have one argument", 57);
19607 : }
19608 : }
19609 : else
19610 : {
19611 : /* Error issue message and fake return stack. */
19612 0 : if (M2Options_Iso)
19613 : {
19614 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);
19615 : }
19616 : else
19617 : {
19618 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);
19619 : }
19620 0 : if (NoOfParam > 0)
19621 : {
19622 0 : paramtok = OperandTtok (NoOfParam+1);
19623 0 : combinedtok = M2LexBuf_MakeVirtualTok (functok, functok, paramtok);
19624 : }
19625 : else
19626 : {
19627 0 : combinedtok = functok;
19628 : }
19629 0 : M2Quads_PopN (NoOfParam+2);
19630 0 : M2Quads_PushT (SymbolTable_MakeConstLit (combinedtok, NameKey_MakeKey ((const char *) "0", 1), SymbolTable_NulSym)); /* Fake return value to continue compiling. */
19631 : }
19632 : }
19633 7477 : }
19634 :
19635 :
19636 : /*
19637 : BuildBooleanVariable - tests to see whether top of stack is a boolean
19638 : conditional and if so it converts it into a boolean
19639 : variable.
19640 : */
19641 :
19642 359048 : extern "C" void M2Quads_BuildBooleanVariable (void)
19643 : {
19644 359048 : if (IsBoolean (1))
19645 : {
19646 7228 : ConvertBooleanToVariable (OperandTtok (1), 1);
19647 : }
19648 359048 : }
19649 :
19650 :
19651 : /*
19652 : BuildModuleStart - starts current module scope.
19653 : */
19654 :
19655 84805 : extern "C" void M2Quads_BuildModuleStart (unsigned int tok)
19656 : {
19657 84805 : GenQuadO (tok, M2Quads_ModuleScopeOp, tok, (unsigned int ) (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()))), SymbolTable_GetCurrentModule (), false);
19658 84805 : }
19659 :
19660 :
19661 : /*
19662 : BuildProcedureStart - Builds start of the procedure. Generates a
19663 : quadruple which indicated the start of
19664 : this procedure declarations scope.
19665 : The Stack is expected to contain:
19666 :
19667 :
19668 : Entry Exit
19669 : ===== ====
19670 :
19671 : Ptr -> <- Ptr
19672 : +------------+ +-----------+
19673 : | ProcSym | | ProcSym |
19674 : |------------| |-----------|
19675 : | Name | | Name |
19676 : |------------| |-----------|
19677 :
19678 :
19679 : Quadruples:
19680 :
19681 : q ProcedureScopeOp Line# Scope ProcSym
19682 : */
19683 :
19684 82774 : extern "C" void M2Quads_BuildProcedureStart (void)
19685 : {
19686 82774 : unsigned int ProcSym;
19687 :
19688 82774 : M2Quads_PopT (&ProcSym);
19689 82774 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
19690 82774 : SymbolTable_PutProcedureScopeQuad (ProcSym, NextQuad);
19691 82774 : GenQuad (M2Quads_ProcedureScopeOp, M2LexBuf_GetPreviousTokenLineNo (), SymbolTable_GetScope (ProcSym), ProcSym);
19692 82774 : M2Quads_PushT (ProcSym);
19693 82774 : }
19694 :
19695 :
19696 : /*
19697 : BuildProcedureBegin - determines the start of the BEGIN END block of
19698 : the procedure.
19699 : The Stack is expected to contain:
19700 :
19701 :
19702 : Entry Exit
19703 : ===== ====
19704 :
19705 : Ptr -> <- Ptr
19706 : +------------+ +-----------+
19707 : | ProcSym | | ProcSym |
19708 : |------------| |-----------|
19709 : | Name | | Name |
19710 : |------------| |-----------|
19711 :
19712 :
19713 : Quadruples:
19714 :
19715 : q NewLocalVarOp TokenNo(BEGIN) _ ProcSym
19716 : */
19717 :
19718 82762 : extern "C" void M2Quads_BuildProcedureBegin (void)
19719 : {
19720 82762 : unsigned int ProcSym;
19721 :
19722 82762 : M2Quads_PopT (&ProcSym);
19723 82762 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
19724 82762 : SymbolTable_PutProcedureStartQuad (ProcSym, NextQuad);
19725 82762 : SymbolTable_PutProcedureBegin (ProcSym, M2LexBuf_GetTokenNo ());
19726 82762 : GenQuad (M2Quads_NewLocalVarOp, M2LexBuf_GetTokenNo (), SymbolTable_GetScope (ProcSym), ProcSym);
19727 82762 : CurrentProc = ProcSym;
19728 82762 : M2StackWord_PushWord (ReturnStack, static_cast<unsigned int> (0));
19729 82762 : M2Quads_PushT (ProcSym);
19730 82762 : CheckVariablesAt (ProcSym);
19731 82762 : CheckNeedPriorityBegin (M2LexBuf_GetTokenNo (), ProcSym, SymbolTable_GetCurrentModule ());
19732 82762 : M2StackWord_PushWord (TryStack, NextQuad);
19733 82762 : M2StackWord_PushWord (CatchStack, static_cast<unsigned int> (0));
19734 82762 : if (SymbolTable_HasExceptionBlock (ProcSym))
19735 : {
19736 168 : GenQuad (M2Quads_TryOp, SymbolTable_NulSym, SymbolTable_NulSym, 0);
19737 : }
19738 82762 : }
19739 :
19740 :
19741 : /*
19742 : BuildProcedureEnd - Builds end of the procedure. Destroys space for
19743 : the local variables.
19744 : The Stack is expected to contain:
19745 :
19746 :
19747 : Entry Exit
19748 : ===== ====
19749 :
19750 : Ptr -> <- Ptr
19751 : +------------+ +-----------+
19752 : | ProcSym | | ProcSym |
19753 : |------------| |-----------|
19754 : | Name | | Name |
19755 : |------------| |-----------|
19756 :
19757 :
19758 : Quadruples:
19759 :
19760 : q KillLocalVarOp TokenNo(END) _ ProcSym
19761 : */
19762 :
19763 82730 : extern "C" void M2Quads_BuildProcedureEnd (void)
19764 : {
19765 82730 : unsigned int tok;
19766 82730 : unsigned int ProcSym;
19767 :
19768 82730 : M2Quads_PopTtok (&ProcSym, &tok);
19769 82730 : if (SymbolTable_HasExceptionBlock (ProcSym))
19770 : {
19771 168 : BuildRTExceptLeave (tok, true);
19772 168 : GenQuad (M2Quads_CatchEndOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
19773 : }
19774 82730 : if ((SymbolTable_GetSType (ProcSym)) != SymbolTable_NulSym)
19775 : {
19776 20871 : BuildError (M2Range_InitNoReturnRangeCheck ());
19777 : }
19778 82730 : BackPatch (M2StackWord_PopWord (ReturnStack), NextQuad);
19779 82730 : CheckNeedPriorityEnd (tok, ProcSym, SymbolTable_GetCurrentModule ());
19780 82730 : CurrentProc = SymbolTable_NulSym;
19781 82730 : SymbolTable_PutProcedureEnd (ProcSym, (M2LexBuf_GetTokenNo ())-1); /* --fixme-- */
19782 82730 : GenQuad (M2Quads_KillLocalVarOp, (M2LexBuf_GetTokenNo ())-1, SymbolTable_NulSym, ProcSym); /* --fixme-- */
19783 82730 : SymbolTable_PutProcedureEndQuad (ProcSym, NextQuad);
19784 82730 : GenQuad (M2Quads_ReturnOp, SymbolTable_NulSym, SymbolTable_NulSym, ProcSym);
19785 82730 : CheckFunctionReturn (ProcSym);
19786 82730 : CheckVariablesInBlock (ProcSym);
19787 : /* Call PutProcedureEndQuad so that any runtime procedure will be
19788 : seen as defined even if it not seen during pass 2 (which will also
19789 : call PutProcedureEndQuad). */
19790 82730 : SymbolTable_PutProcedureParametersDefined (ProcSym, SymbolTable_ProperProcedure);
19791 82730 : SymbolTable_PutProcedureDefined (ProcSym, SymbolTable_ProperProcedure);
19792 82730 : M2StackWord_RemoveTop (CatchStack);
19793 82730 : M2StackWord_RemoveTop (TryStack);
19794 82730 : M2Quads_PushT (ProcSym);
19795 82730 : }
19796 :
19797 :
19798 : /*
19799 : BuildReturn - Builds the Return part of the procedure.
19800 : tokreturn is the location of the RETURN keyword.
19801 : The Stack is expected to contain:
19802 :
19803 :
19804 : Entry Exit
19805 : ===== ====
19806 :
19807 : Ptr ->
19808 : +------------+
19809 : | e1 | Empty
19810 : |------------|
19811 : */
19812 :
19813 30655 : extern "C" void M2Quads_BuildReturn (unsigned int tokreturn)
19814 : {
19815 30655 : unsigned int tokcombined;
19816 30655 : unsigned int tokexpr;
19817 30655 : unsigned int e1;
19818 30655 : unsigned int t1;
19819 30655 : unsigned int t;
19820 30655 : unsigned int f;
19821 30655 : unsigned int Des;
19822 :
19823 30655 : if (IsBoolean (1))
19824 : {
19825 1790 : PopBooltok (&t, &f, &tokexpr);
19826 : /* Des will be a boolean type */
19827 1790 : Des = SymbolTable_MakeTemporary (tokexpr, SymbolTable_RightValue);
19828 1790 : SymbolTable_PutVar (Des, M2Base_Boolean);
19829 1790 : M2Quads_PushTFtok (Des, M2Base_Boolean, tokexpr);
19830 1790 : PushBooltok (t, f, tokexpr);
19831 1790 : BuildAssignmentWithoutBounds (tokreturn, false, true);
19832 1790 : M2Quads_PushTFtok (Des, M2Base_Boolean, tokexpr);
19833 : }
19834 30655 : M2Quads_PopTFtok (&e1, &t1, &tokexpr);
19835 30655 : tokcombined = M2LexBuf_MakeVirtualTok (tokreturn, tokreturn, tokexpr);
19836 30655 : if (e1 != SymbolTable_NulSym)
19837 : {
19838 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
19839 : /* Check we are in a procedure scope and that the procedure has a return type. */
19840 29811 : if (CurrentProc == SymbolTable_NulSym)
19841 : {
19842 6 : M2MetaError_MetaErrorT0 (tokcombined, (const char *) "{%1E} attempting to return a value when not in a procedure scope", 64);
19843 : }
19844 29805 : else if ((SymbolTable_GetSType (CurrentProc)) == SymbolTable_NulSym)
19845 : {
19846 : /* avoid dangling else. */
19847 6 : M2MetaError_MetaErrorT1 (tokcombined, (const char *) "attempting to return a value from procedure {%1Ea} which does not have a return type", 84, CurrentProc);
19848 : }
19849 : else
19850 : {
19851 : /* avoid dangling else. */
19852 29799 : BuildReturnLower (tokcombined, tokexpr, e1, t1);
19853 : }
19854 : }
19855 30655 : GenQuadO (tokcombined, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, M2StackWord_PopWord (ReturnStack), false);
19856 30655 : M2StackWord_PushWord (ReturnStack, NextQuad-1);
19857 30655 : }
19858 :
19859 :
19860 : /*
19861 : BuildModulePriority - assigns the current module with a priority
19862 : from the top of stack.
19863 :
19864 : Entry Exit
19865 : ===== ====
19866 :
19867 :
19868 : Ptr -> Empty
19869 : +------------+
19870 : | Priority |
19871 : |------------|
19872 : */
19873 :
19874 38 : extern "C" void M2Quads_BuildModulePriority (void)
19875 : {
19876 38 : unsigned int Priority;
19877 :
19878 38 : M2Quads_PopT (&Priority);
19879 38 : SymbolTable_PutPriority (SymbolTable_GetCurrentModule (), Priority);
19880 38 : }
19881 :
19882 :
19883 : /*
19884 : StartBuildWith - performs the with statement.
19885 : The Stack:
19886 :
19887 : Entry Exit
19888 :
19889 : +------------+
19890 : | Sym | Type | Empty
19891 : |------------|
19892 : */
19893 :
19894 5971 : extern "C" void M2Quads_StartBuildWith (unsigned int withTok)
19895 : {
19896 5971 : unsigned int tok;
19897 5971 : unsigned int Sym;
19898 5971 : unsigned int Type;
19899 5971 : unsigned int Ref;
19900 :
19901 5971 : DebugLocation (static_cast<unsigned int> (M2Reserved_withtok), (const char *) "with", 4);
19902 5971 : BuildStmtNoteTok (withTok);
19903 5971 : M2Quads_DisplayStack ();
19904 5971 : M2Quads_PopTFtok (&Sym, &Type, &tok);
19905 5971 : DebugLocation (tok, (const char *) "expression", 10);
19906 5971 : Type = SymbolTable_SkipType (Type);
19907 5971 : if (Type == SymbolTable_NulSym)
19908 : {
19909 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);
19910 : }
19911 : else
19912 : {
19913 5965 : Ref = SymbolTable_MakeTemporary (tok, SymbolTable_LeftValue);
19914 5965 : SymbolTable_PutVar (Ref, Type);
19915 5965 : if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
19916 : {
19917 : /* Copy LeftValue. */
19918 5660 : GenQuadO (tok, M2Quads_BecomesOp, Ref, SymbolTable_NulSym, Sym, true);
19919 : }
19920 : else
19921 : {
19922 : /* Calculate the address of Sym. */
19923 305 : GenQuadO (tok, M2Quads_AddrOp, Ref, SymbolTable_NulSym, Sym, true);
19924 : }
19925 5965 : PushWith (Sym, Type, Ref, tok);
19926 5965 : DebugLocation (tok, (const char *) "with ref", 8);
19927 5965 : if (! (SymbolTable_IsRecord (Type)))
19928 : {
19929 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "the {%kWITH} statement requires that {%1Ea} {%1d} be of a {%kRECORD} {%1tsa:type rather than {%1tsa}}", 101, Sym);
19930 : }
19931 5965 : SymbolTable_StartScope (Type);
19932 : }
19933 5965 : M2StackSpell_Push (Type);
19934 5965 : M2Quads_DisplayStack ();
19935 5965 : }
19936 :
19937 :
19938 : /*
19939 : EndBuildWith - terminates the innermost with scope.
19940 : */
19941 :
19942 5965 : extern "C" void M2Quads_EndBuildWith (void)
19943 : {
19944 5965 : M2Quads_DisplayStack ();
19945 5965 : SymbolTable_EndScope ();
19946 5965 : PopWith ();
19947 5965 : M2StackSpell_Pop ();
19948 5965 : M2Quads_DisplayStack ();
19949 5965 : }
19950 :
19951 :
19952 : /*
19953 : CheckWithReference - performs the with statement.
19954 : The Stack:
19955 :
19956 : Entry Exit
19957 :
19958 : +------------+ +------------+
19959 : | Sym | Type | | Sym | Type |
19960 : |------------| |------------|
19961 : */
19962 :
19963 690141 : extern "C" void M2Quads_CheckWithReference (void)
19964 : {
19965 690141 : M2Quads_WithFrame f;
19966 690141 : unsigned int tokpos;
19967 690141 : unsigned int i;
19968 690141 : unsigned int n;
19969 690141 : unsigned int rw;
19970 690141 : unsigned int Sym;
19971 690141 : unsigned int Type;
19972 :
19973 690141 : n = M2StackAddress_NoOfItemsInStackAddress (WithStack);
19974 690141 : if ((n > 0) && ! SuppressWith)
19975 : {
19976 102657 : PopTFrwtok (&Sym, &Type, &rw, &tokpos);
19977 102657 : M2Debug_Assert (tokpos != M2LexBuf_UnknownTokenNo);
19978 102657 : if (SymbolTable_IsUnknown (Sym))
19979 : {
19980 6 : M2MetaError_MetaErrorT1 (tokpos, (const char *) "{%1ad} is unknown {%1&s}", 24, Sym);
19981 6 : SymbolTable_UnknownReported (Sym);
19982 : }
19983 : else
19984 : {
19985 : /* Inner WITH always has precedence. */
19986 : i = 1; /* top of stack */
19987 : /* WriteString('Checking for a with') ; */
19988 217989 : while (i <= n)
19989 : {
19990 115338 : f = static_cast<M2Quads_WithFrame> (M2StackAddress_PeepAddress (WithStack, i));
19991 115338 : if ((SymbolTable_IsRecordField (Sym)) && ((SymbolTable_GetRecord (SymbolTable_GetParent (Sym))) == f->RecordType))
19992 : {
19993 30024 : if (SymbolTable_IsUnused (Sym))
19994 : {
19995 0 : M2MetaError_MetaError1 ((const char *) "record field {%1Dad} was declared as unused by a pragma", 55, Sym);
19996 : }
19997 : /* Fake a RecordSym.op */
19998 30024 : PushTFrwtok (f->RecordRef, f->RecordType, f->rw, f->RecordTokPos);
19999 30024 : M2Quads_PushTFtok (Sym, Type, tokpos);
20000 30024 : BuildAccessWithField ();
20001 30024 : PopTFrw (&Sym, &Type, &f->rw);
20002 30024 : i = n+1; /* Finish loop. */
20003 : }
20004 : else
20005 : {
20006 85314 : i += 1;
20007 : }
20008 : }
20009 : }
20010 102657 : PushTFrwtok (Sym, Type, rw, tokpos);
20011 : }
20012 690141 : }
20013 :
20014 :
20015 : /*
20016 : BuildDesignatorRecord - Builds the record referencing.
20017 : The Stack is expected to contain:
20018 :
20019 :
20020 : Entry Exit
20021 : ===== ====
20022 :
20023 : Ptr ->
20024 : +--------------+
20025 : | n |
20026 : |--------------|
20027 : | fld1 | type1 |
20028 : |--------------|
20029 : . .
20030 : . .
20031 : . .
20032 : |--------------|
20033 : | fldn | typen | <- Ptr
20034 : |--------------| +-------------+
20035 : | Sym | Type | | S | type1|
20036 : |--------------| |-------------|
20037 : */
20038 :
20039 115871 : extern "C" void M2Quads_BuildDesignatorRecord (unsigned int dottok)
20040 : {
20041 115871 : unsigned int RecordTok;
20042 115871 : unsigned int FieldTok;
20043 115871 : unsigned int combinedtok;
20044 115871 : unsigned int n;
20045 115871 : unsigned int rw;
20046 115871 : unsigned int Field;
20047 115871 : unsigned int FieldType;
20048 115871 : unsigned int RecordSym;
20049 115871 : unsigned int Res;
20050 :
20051 115871 : M2Quads_PopT (&n);
20052 115871 : RecordSym = static_cast<unsigned int> (M2Quads_OperandT (n+1));
20053 : /* RecordType could be found by: SkipType (OperandF (n+1)). */
20054 115871 : RecordTok = static_cast<unsigned int> (M2Quads_OperandTok (n+1));
20055 115871 : rw = static_cast<unsigned int> (OperandMergeRW (n+1));
20056 115871 : M2Debug_Assert (SymbolTable_IsLegal (rw));
20057 115871 : Field = static_cast<unsigned int> (M2Quads_OperandT (n));
20058 115871 : FieldType = SymbolTable_SkipType (M2Quads_OperandF (n));
20059 115871 : FieldTok = static_cast<unsigned int> (M2Quads_OperandTok (n));
20060 115871 : combinedtok = M2LexBuf_MakeVirtualTok (dottok, RecordTok, FieldTok);
20061 115871 : if (n > 1)
20062 : {
20063 0 : M2Error_InternalError ((const char *) "not expecting to see n>1", 24);
20064 : }
20065 115871 : if (SymbolTable_IsUnused (Field))
20066 : {
20067 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);
20068 : }
20069 115871 : Res = SymbolTable_MakeComponentRef (SymbolTable_MakeComponentRecord (combinedtok, SymbolTable_RightValue, RecordSym), Field);
20070 115871 : SymbolTable_PutVarConst (Res, IsReadOnly (RecordSym));
20071 115871 : GenQuadO (combinedtok, M2Quads_RecordFieldOp, Res, RecordSym, Field, false);
20072 115871 : M2Quads_PopN (n+1);
20073 115871 : PushTFrwtok (Res, FieldType, rw, combinedtok);
20074 115871 : }
20075 :
20076 :
20077 : /*
20078 : BuildDesignatorArray - Builds the array referencing.
20079 : The purpose of this procedure is to work out
20080 : whether the DesignatorArray is a constant string or
20081 : dynamic array/static array and to call the appropriate
20082 : BuildRoutine.
20083 :
20084 : The Stack is expected to contain:
20085 :
20086 : Entry Exit
20087 : ===== ====
20088 :
20089 : Ptr ->
20090 : +--------------+
20091 : | e | <- Ptr
20092 : |--------------| +------------+
20093 : | Sym | Type | | S | T |
20094 : |--------------| |------------|
20095 : */
20096 :
20097 56486 : extern "C" void M2Quads_BuildDesignatorArray (void)
20098 : {
20099 56486 : if ((SymbolTable_IsConst (M2Quads_OperandT (2))) && (SymbolTable_IsConstString (M2Quads_OperandT (2))))
20100 : {
20101 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));
20102 6 : BuildDesignatorError ((const char *) "bad array access", 16);
20103 : }
20104 : else
20105 : {
20106 56480 : BuildDesignatorArrayStaticDynamic ();
20107 : }
20108 56480 : }
20109 :
20110 :
20111 : /*
20112 : BuildDesignatorPointer - Builds a pointer reference.
20113 : The Stack is expected to contain:
20114 :
20115 :
20116 : Entry Exit
20117 : ===== ====
20118 :
20119 : Ptr -> <- Ptr
20120 : +--------------+ +--------------+
20121 : | Sym1 | Type1| | Sym2 | Type2|
20122 : |--------------| |--------------|
20123 : */
20124 :
20125 19929 : extern "C" void M2Quads_BuildDesignatorPointer (unsigned int ptrtok)
20126 : {
20127 19929 : unsigned int combinedtok;
20128 19929 : unsigned int destok;
20129 19929 : unsigned int rw;
20130 19929 : unsigned int Sym1;
20131 19929 : unsigned int Type1;
20132 19929 : unsigned int Sym2;
20133 19929 : unsigned int Type2;
20134 :
20135 19929 : PopTFrwtok (&Sym1, &Type1, &rw, &destok);
20136 19929 : DebugLocation (destok, (const char *) "des ptr expression", 18);
20137 19929 : Type1 = SymbolTable_SkipType (Type1);
20138 19929 : if (Type1 == SymbolTable_NulSym)
20139 : {
20140 0 : M2MetaError_MetaErrorT1 (ptrtok, (const char *) "{%1ad} has no type and therefore cannot be dereferenced by ^", 60, Sym1);
20141 : }
20142 19929 : else if (SymbolTable_IsUnknown (Sym1))
20143 : {
20144 : /* avoid dangling else. */
20145 : /* Spellcheck. */
20146 0 : M2MetaError_MetaError1 ((const char *) "{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved {%1&s}", 69, Sym1);
20147 0 : SymbolTable_UnknownReported (Sym1);
20148 : }
20149 : else
20150 : {
20151 : /* avoid dangling else. */
20152 19929 : combinedtok = M2LexBuf_MakeVirtual2Tok (destok, ptrtok);
20153 19929 : if (SymbolTable_IsPointer (Type1))
20154 : {
20155 19927 : Type2 = SymbolTable_GetSType (Type1);
20156 19927 : Sym2 = SymbolTable_MakeTemporary (ptrtok, SymbolTable_LeftValue);
20157 : /*
20158 : Ok must reference by address
20159 : - but we contain the type of the referenced entity
20160 : */
20161 19927 : MarkAsRead (rw);
20162 19927 : SymbolTable_PutVarPointerCheck (Sym1, true);
20163 19927 : CheckPointerThroughNil (ptrtok, Sym1);
20164 19927 : if ((SymbolTable_GetMode (Sym1)) == SymbolTable_LeftValue)
20165 : {
20166 510 : rw = SymbolTable_NulSym;
20167 510 : SymbolTable_PutLeftValueFrontBackType (Sym2, Type2, Type1);
20168 510 : GenQuadO (ptrtok, M2Quads_IndrXOp, Sym2, Type1, Sym1, false); /* Sym2 := *Sym1. */
20169 : }
20170 : else
20171 : {
20172 19417 : SymbolTable_PutLeftValueFrontBackType (Sym2, Type2, SymbolTable_NulSym);
20173 19417 : GenQuadO (ptrtok, M2Quads_BecomesOp, Sym2, SymbolTable_NulSym, Sym1, false); /* Sym2 := Sym1. */
20174 : }
20175 : /* We should check this for Sym2 later on (pointer via NIL). */
20176 19927 : SymbolTable_PutVarPointerCheck (Sym2, true);
20177 19927 : PushTFrwtok (Sym2, Type2, rw, combinedtok);
20178 19927 : DebugLocation (combinedtok, (const char *) "pointer expression", 18);
20179 : }
20180 2 : else if ((SymbolTable_IsHiddenType (Type1)) && ((SymbolTable_GetModuleScope (Type1)) != (SymbolTable_GetCurrentModuleScope ())))
20181 : {
20182 : /* avoid dangling else. */
20183 2 : M2MetaError_MetaErrorT1 (ptrtok, (const char *) "{%1Ead} is declared with an opaque type from a different module and cannot be dereferenced", 90, Sym1);
20184 2 : MarkAsRead (rw);
20185 2 : BuildDesignatorPointerError (Type1, rw, combinedtok, (const char *) "bad opaque pointer dereference", 30);
20186 : }
20187 : else
20188 : {
20189 : /* avoid dangling else. */
20190 0 : M2MetaError_MetaError2 ((const char *) "{%1Ead} is not a pointer type but a {%2dv}", 42, Sym1, Type1);
20191 0 : MarkAsRead (rw);
20192 0 : BuildDesignatorPointerError (Type1, rw, combinedtok, (const char *) "bad pointer dereference", 23);
20193 : }
20194 : }
20195 19929 : }
20196 :
20197 :
20198 : /*
20199 : BuildNulExpression - Builds a nul expression on the stack.
20200 : The Stack:
20201 :
20202 : Entry Exit
20203 :
20204 : <- Ptr
20205 : Empty +------------+
20206 : | NulSym |
20207 : |------------|
20208 : tokpos is the position of the RETURN token.
20209 : */
20210 :
20211 844 : extern "C" void M2Quads_BuildNulExpression (unsigned int tokpos)
20212 : {
20213 844 : M2Quads_PushTtok (static_cast<unsigned int> (SymbolTable_NulSym), tokpos);
20214 844 : }
20215 :
20216 :
20217 : /*
20218 : BuildSetStart - Pushes a Bitset type on the stack.
20219 :
20220 : The Stack:
20221 :
20222 : Entry Exit
20223 :
20224 : Ptr -> <- Ptr
20225 :
20226 : Empty +--------------+
20227 : | Bitset |
20228 : |--------------|
20229 : */
20230 :
20231 0 : extern "C" void M2Quads_BuildSetStart (unsigned int tokpos)
20232 : {
20233 0 : M2Quads_PushTtok (M2Bitset_Bitset, tokpos);
20234 0 : }
20235 :
20236 :
20237 : /*
20238 : BuildSetEnd - pops the set value and type from the stack
20239 : and pushes the value,type pair.
20240 :
20241 : Entry Exit
20242 :
20243 : Ptr ->
20244 : +--------------+
20245 : | Set Value | <- Ptr
20246 : |--------------| +--------------+
20247 : | Set Type | | Value | Type |
20248 : |--------------| |--------------|
20249 : */
20250 :
20251 0 : extern "C" void M2Quads_BuildSetEnd (void)
20252 : {
20253 0 : unsigned int valuepos;
20254 0 : unsigned int typepos;
20255 0 : unsigned int combined;
20256 0 : unsigned int value;
20257 0 : unsigned int type;
20258 :
20259 0 : M2Quads_PopTtok (&value, &valuepos);
20260 0 : M2Quads_PopTtok (&type, &typepos);
20261 0 : combined = M2LexBuf_MakeVirtual2Tok (typepos, valuepos);
20262 0 : M2Quads_PushTFtok (value, type, combined);
20263 0 : M2Debug_Assert (SymbolTable_IsSet (type));
20264 0 : }
20265 :
20266 :
20267 : /*
20268 : BuildEmptySet - Builds an empty set on the stack.
20269 : The Stack:
20270 :
20271 : Entry Exit
20272 :
20273 : <- Ptr
20274 : +-------------+
20275 : Ptr -> | Value |
20276 : +-----------+ |-------------|
20277 : | SetType | | SetType |
20278 : |-----------| |-------------|
20279 :
20280 : tokpos points to the opening '{'.
20281 : */
20282 :
20283 0 : extern "C" void M2Quads_BuildEmptySet (unsigned int tokpos)
20284 : {
20285 0 : NameKey_Name n;
20286 0 : unsigned int typepos;
20287 0 : unsigned int Type;
20288 0 : unsigned int NulSet;
20289 :
20290 0 : M2Quads_PopTtok (&Type, &typepos); /* type of set we are building */
20291 0 : if ((Type == SymbolTable_NulSym) && M2Options_Pim)
20292 : {
20293 : /* allowed generic {} in PIM Modula-2 */
20294 0 : typepos = tokpos;
20295 : }
20296 0 : else if (SymbolTable_IsUnknown (Type))
20297 : {
20298 : /* avoid dangling else. */
20299 : /* Spellcheck. */
20300 0 : M2MetaError_MetaError1 ((const char *) "set type {%1a} is undefined {%1&s}", 34, Type);
20301 0 : SymbolTable_UnknownReported (Type);
20302 0 : Type = M2Bitset_Bitset;
20303 : }
20304 0 : else if (! (SymbolTable_IsSet (SymbolTable_SkipType (Type))))
20305 : {
20306 : /* avoid dangling else. */
20307 0 : M2MetaError_MetaError1 ((const char *) "expecting a set type {%1a} and not a {%1d}", 42, Type);
20308 0 : Type = M2Bitset_Bitset;
20309 : }
20310 : else
20311 : {
20312 : /* avoid dangling else. */
20313 0 : Type = SymbolTable_SkipType (Type);
20314 0 : M2Debug_Assert (Type != SymbolTable_NulSym);
20315 : }
20316 0 : NulSet = SymbolTable_MakeTemporary (typepos, SymbolTable_ImmediateValue);
20317 0 : SymbolTable_PutVar (NulSet, Type);
20318 0 : SymbolTable_PutConstSet (NulSet);
20319 0 : if (M2Options_CompilerDebugging)
20320 : {
20321 0 : n = SymbolTable_GetSymName (Type);
20322 0 : M2Printf_printf1 ((const char *) "set type = %a\\n", 15, (const unsigned char *) &n, (sizeof (n)-1));
20323 : }
20324 0 : M2ALU_PushNulSet (Type); /* onto the ALU stack */
20325 0 : SymbolTable_PopValue (NulSet); /* ALU -> symbol table */
20326 : /* and now construct the M2Quads stack as defined by the comments above */
20327 0 : M2Quads_PushTtok (Type, typepos);
20328 0 : M2Quads_PushTtok (NulSet, typepos);
20329 0 : if (M2Options_CompilerDebugging)
20330 : {
20331 0 : n = SymbolTable_GetSymName (Type);
20332 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));
20333 0 : M2Quads_DisplayStack (); /* Debugging info */
20334 : }
20335 0 : }
20336 :
20337 :
20338 : /*
20339 : BuildInclRange - includes a set range with a set.
20340 :
20341 :
20342 : Entry Exit
20343 : ===== ====
20344 :
20345 :
20346 : Ptr ->
20347 : +------------+
20348 : | El2 |
20349 : |------------|
20350 : | El1 | <- Ptr
20351 : |------------| +-------------------+
20352 : | Set Value | | Value + {El1..El2}|
20353 : |------------| |-------------------|
20354 :
20355 : No quadruples produced as the range info is contained within
20356 : the set value.
20357 : */
20358 :
20359 0 : extern "C" void M2Quads_BuildInclRange (void)
20360 : {
20361 0 : NameKey_Name n;
20362 0 : unsigned int el1;
20363 0 : unsigned int el2;
20364 0 : unsigned int value;
20365 :
20366 0 : M2Quads_PopT (&el2);
20367 0 : SafeCheckWithField ();
20368 0 : M2Quads_PopT (&el1);
20369 0 : SafeCheckWithField ();
20370 0 : M2Quads_PopT (&value);
20371 0 : if (! (SymbolTable_IsConstSet (value)))
20372 : {
20373 0 : n = SymbolTable_GetSymName (el1);
20374 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));
20375 : }
20376 0 : if ((SymbolTable_IsConst (el1)) && (SymbolTable_IsConst (el2)))
20377 : {
20378 0 : SymbolTable_PushValue (value); /* onto ALU stack */
20379 0 : M2ALU_AddBitRange (M2LexBuf_GetTokenNo (), el1, el2); /* onto ALU stack */
20380 0 : SymbolTable_PopValue (value); /* ALU -> symboltable */
20381 : }
20382 : else
20383 : {
20384 0 : if (! (SymbolTable_IsConst (el1)))
20385 : {
20386 0 : n = SymbolTable_GetSymName (el1);
20387 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));
20388 : }
20389 0 : if (! (SymbolTable_IsConst (el2)))
20390 : {
20391 0 : n = SymbolTable_GetSymName (el2);
20392 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));
20393 : }
20394 : }
20395 0 : M2Quads_PushT (value);
20396 0 : }
20397 :
20398 :
20399 : /*
20400 : BuildInclBit - includes a bit into the set.
20401 :
20402 : Entry Exit
20403 : ===== ====
20404 :
20405 :
20406 : Ptr ->
20407 : +------------+
20408 : | Element | <- Ptr
20409 : |------------| +------------+
20410 : | Value | | Value |
20411 : |------------| |------------|
20412 :
20413 : */
20414 :
20415 12040 : extern "C" void M2Quads_BuildInclBit (void)
20416 : {
20417 12040 : unsigned int tok;
20418 12040 : unsigned int el;
20419 12040 : unsigned int value;
20420 12040 : unsigned int t;
20421 :
20422 12040 : SafeCheckWithField ();
20423 12040 : M2Quads_PopT (&el);
20424 12040 : M2Quads_PopT (&value);
20425 12040 : tok = M2LexBuf_GetTokenNo ();
20426 12040 : if (SymbolTable_IsConst (el))
20427 : {
20428 11907 : SymbolTable_PushValue (value); /* onto ALU stack */
20429 11907 : M2ALU_AddBit (tok, el); /* onto ALU stack */
20430 11907 : SymbolTable_PopValue (value); /* ALU -> symboltable */
20431 : }
20432 : else
20433 : {
20434 133 : if ((SymbolTable_GetMode (el)) == SymbolTable_LeftValue)
20435 : {
20436 0 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
20437 0 : SymbolTable_PutVar (t, SymbolTable_GetSType (el));
20438 0 : CheckPointerThroughNil (tok, el);
20439 0 : doIndrX (tok, t, el);
20440 0 : el = t;
20441 : }
20442 133 : if (SymbolTable_IsConst (value))
20443 : {
20444 : /* Move constant or record field into a variable to achieve the include. */
20445 133 : t = SymbolTable_MakeTemporary (tok, SymbolTable_RightValue);
20446 133 : SymbolTable_PutVar (t, SymbolTable_GetSType (value));
20447 133 : GenQuad (M2Quads_BecomesOp, t, SymbolTable_NulSym, value);
20448 133 : value = t;
20449 : }
20450 133 : GenQuad (M2Quads_InclOp, value, SymbolTable_NulSym, el);
20451 : }
20452 12040 : M2Quads_PushT (value);
20453 12040 : }
20454 :
20455 :
20456 : /*
20457 : SilentBuildConstructor - places NulSym into the constructor fifo queue.
20458 : */
20459 :
20460 0 : extern "C" void M2Quads_SilentBuildConstructor (void)
20461 : {
20462 0 : FifoQueue_PutConstructorIntoFifoQueue (SymbolTable_NulSym);
20463 0 : }
20464 :
20465 :
20466 : /*
20467 : SilentBuildConstructorStart - removes an entry from the constructor fifo queue.
20468 : */
20469 :
20470 26038 : extern "C" void M2Quads_SilentBuildConstructorStart (void)
20471 : {
20472 26038 : unsigned int constValue;
20473 :
20474 26038 : FifoQueue_GetConstructorFromFifoQueue (&constValue);
20475 26038 : }
20476 :
20477 :
20478 : /*
20479 : BuildConstructor - builds a constructor.
20480 : Stack
20481 :
20482 : Entry Exit
20483 :
20484 : Ptr ->
20485 : +------------+
20486 : | Type | <- Ptr
20487 : |------------+
20488 : */
20489 :
20490 37185 : extern "C" void M2Quads_BuildConstructor (unsigned int tokcbrpos)
20491 : {
20492 37185 : unsigned int tok;
20493 37185 : NameKey_Name name;
20494 37185 : unsigned int errsym;
20495 37185 : unsigned int constValue;
20496 37185 : unsigned int type;
20497 :
20498 37185 : PopTntok (&type, &name, &tok);
20499 37185 : constValue = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
20500 37185 : SymbolTable_PutVar (constValue, type);
20501 37185 : SymbolTable_PutConstructor (constValue);
20502 37185 : SymbolTable_PushValue (constValue);
20503 37185 : if (type == SymbolTable_NulSym)
20504 : {
20505 7 : if (tok == M2LexBuf_UnknownTokenNo)
20506 : {
20507 0 : M2MetaError_MetaErrorT0 (tokcbrpos, (const char *) "{%E}constructor requires a type before the opening %{", 53);
20508 : }
20509 : else
20510 : {
20511 : /* Spellcheck. */
20512 7 : errsym = SymbolTable_MakeError (tok, name);
20513 7 : M2MetaError_MetaErrorT1 (tok, (const char *) "constructor type {%1Ea} is undefined {%1&s}", 43, errsym);
20514 7 : SymbolTable_UnknownReported (errsym);
20515 : }
20516 : }
20517 : else
20518 : {
20519 37178 : M2ALU_ChangeToConstructor (tok, type);
20520 37178 : SymbolTable_PutConstructorFrom (constValue, type);
20521 37178 : SymbolTable_PopValue (constValue);
20522 37178 : FifoQueue_PutConstructorIntoFifoQueue (constValue);
20523 : }
20524 37185 : PushConstructor (type);
20525 37185 : }
20526 :
20527 :
20528 : /*
20529 : BuildConstructorStart - builds a constructor.
20530 : Stack
20531 :
20532 : Entry Exit
20533 :
20534 : Ptr -> <- Ptr
20535 : +------------+ +----------------+
20536 : | Type | | ConstructorSym |
20537 : |------------+ |----------------|
20538 : */
20539 :
20540 11134 : extern "C" void M2Quads_BuildConstructorStart (unsigned int cbratokpos)
20541 : {
20542 11134 : unsigned int typepos;
20543 11134 : unsigned int constValue;
20544 11134 : unsigned int type;
20545 :
20546 11134 : M2Quads_PopTtok (&type, &typepos); /* we ignore the type as we already have the constructor symbol from pass C */
20547 11134 : FifoQueue_GetConstructorFromFifoQueue (&constValue); /* we ignore the type as we already have the constructor symbol from pass C */
20548 11134 : if (type != (SymbolTable_GetSType (constValue)))
20549 : {
20550 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);
20551 : }
20552 11134 : M2Quads_PushTtok (constValue, cbratokpos);
20553 11134 : PushConstructor (type);
20554 11134 : }
20555 :
20556 :
20557 : /*
20558 : BuildConstructorEnd - removes the current constructor frame from the
20559 : constructor stack (it does not effect the quad
20560 : stack)
20561 :
20562 : Entry Exit
20563 :
20564 : Ptr -> <- Ptr
20565 : +------------+ +------------+
20566 : | const | | const |
20567 : |------------| |------------|
20568 :
20569 : startpos is the start of the constructor, either the typename or '{'
20570 : cbratokpos is the '}'.
20571 : */
20572 :
20573 11134 : extern "C" void M2Quads_BuildConstructorEnd (unsigned int startpos, unsigned int cbratokpos)
20574 : {
20575 11134 : unsigned int value;
20576 11134 : unsigned int valtok;
20577 :
20578 11134 : if (DebugTokPos)
20579 : {
20580 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "startpos", 8), startpos);
20581 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "cbratokpos", 10), cbratokpos);
20582 : }
20583 11134 : M2Quads_PopTtok (&value, &valtok);
20584 11134 : if (DebugTokPos)
20585 : {
20586 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "value valtok", 12), valtok);
20587 : }
20588 11134 : valtok = M2LexBuf_MakeVirtual2Tok (startpos, cbratokpos);
20589 11134 : SymbolTable_PutDeclared (valtok, value);
20590 11134 : M2Quads_PushTtok (value, valtok); /* Use valtok as we now know it was a constructor. */
20591 11134 : M2Quads_PopConstructor (); /* Use valtok as we now know it was a constructor. */
20592 11134 : if (DebugTokPos)
20593 : {
20594 : M2Error_WarnStringAt (DynamicStrings_InitString ((const char *) "aggregate constant", 18), valtok);
20595 : }
20596 11134 : }
20597 :
20598 :
20599 : /*
20600 : NextConstructorField - increments the top of constructor stacks index by one.
20601 : */
20602 :
20603 35121 : extern "C" void M2Quads_NextConstructorField (void)
20604 : {
20605 35121 : M2Quads_ConstructorFrame c;
20606 :
20607 35121 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PeepAddress (ConstructorStack, 1));
20608 35121 : c->index += 1;
20609 35121 : }
20610 :
20611 :
20612 : /*
20613 : BuildTypeForConstructor - pushes the type implied by the current constructor.
20614 : If no constructor is currently being built then
20615 : it Pushes a Bitset type.
20616 : */
20617 :
20618 1714 : extern "C" void M2Quads_BuildTypeForConstructor (unsigned int tokpos)
20619 : {
20620 1714 : M2Quads_ConstructorFrame c;
20621 :
20622 1714 : if ((M2StackAddress_NoOfItemsInStackAddress (ConstructorStack)) == 0)
20623 : {
20624 646 : M2Quads_PushTtok (M2Bitset_Bitset, tokpos);
20625 : }
20626 : else
20627 : {
20628 1068 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PeepAddress (ConstructorStack, 1));
20629 1068 : if ((SymbolTable_IsArray (c->type)) || (SymbolTable_IsSet (c->type)))
20630 : {
20631 972 : M2Quads_PushTtok (SymbolTable_GetSType (c->type), tokpos);
20632 : }
20633 96 : else if (SymbolTable_IsRecord (c->type))
20634 : {
20635 : /* avoid dangling else. */
20636 96 : M2Quads_PushTtok (SymbolTable_GetSType (SymbolTable_GetNth (c->type, c->index)), tokpos);
20637 : }
20638 : else
20639 : {
20640 : /* avoid dangling else. */
20641 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);
20642 : }
20643 : }
20644 1714 : }
20645 :
20646 :
20647 : /*
20648 : BuildComponentValue - builds a component value.
20649 :
20650 : Entry Exit
20651 :
20652 : Ptr -> <- Ptr
20653 :
20654 :
20655 : +------------+ +------------+
20656 : | const | | const |
20657 : |------------| |------------|
20658 : */
20659 :
20660 26054 : extern "C" void M2Quads_BuildComponentValue (void)
20661 : {
20662 26054 : unsigned int e1tok;
20663 26054 : unsigned int e2tok;
20664 26054 : unsigned int consttok;
20665 26054 : unsigned int const_;
20666 26054 : unsigned int e1;
20667 26054 : unsigned int e2;
20668 26054 : NameKey_Name nuldotdot;
20669 26054 : NameKey_Name nulby;
20670 :
20671 26054 : M2Quads_PopT (&nulby);
20672 26054 : if (nulby == M2Reserved_NulTok)
20673 : {
20674 26024 : M2Quads_PopT (&nuldotdot);
20675 26024 : if (nuldotdot == M2Reserved_NulTok)
20676 : {
20677 25782 : M2Quads_PopTtok (&e1, &e1tok);
20678 25782 : M2Quads_PopTtok (&const_, &consttok);
20679 25782 : const_ = AddFieldTo (const_, e1, consttok, e1tok);
20680 25782 : PushTFrwtok (const_, SymbolTable_GetSType (const_), static_cast<unsigned int> (SymbolTable_NulSym), M2LexBuf_MakeVirtual2Tok (consttok, e1tok));
20681 : }
20682 : else
20683 : {
20684 242 : M2Quads_PopTtok (&e2, &e2tok);
20685 242 : M2Quads_PopTtok (&e1, &e1tok);
20686 242 : M2Quads_PopTtok (&const_, &consttok);
20687 242 : SymbolTable_PushValue (const_);
20688 242 : M2ALU_AddBitRange (M2LexBuf_MakeVirtual2Tok (e1tok, e2tok), e1, e2);
20689 242 : SymbolTable_PopValue (const_);
20690 242 : PushTFrwtok (const_, SymbolTable_GetSType (const_), static_cast<unsigned int> (SymbolTable_NulSym), M2LexBuf_MakeVirtual2Tok (consttok, e2tok));
20691 : }
20692 : }
20693 : else
20694 : {
20695 30 : M2Quads_PopTtok (&e1, &e1tok);
20696 30 : M2Quads_PopT (&nuldotdot);
20697 30 : if (nuldotdot == M2Reserved_NulTok)
20698 : {
20699 30 : M2Quads_PopTtok (&e2, &e2tok);
20700 30 : M2Quads_PopTtok (&const_, &consttok);
20701 30 : SymbolTable_PushValue (const_);
20702 30 : M2ALU_AddElements (M2LexBuf_MakeVirtual2Tok (e1tok, e2tok), e2, e1);
20703 30 : SymbolTable_PopValue (const_);
20704 30 : PushTFrwtok (const_, SymbolTable_GetSType (const_), static_cast<unsigned int> (SymbolTable_NulSym), M2LexBuf_MakeVirtual2Tok (consttok, e2tok));
20705 : }
20706 : else
20707 : {
20708 0 : M2Quads_PopTtok (&e2, &e2tok);
20709 0 : M2Quads_PopTtok (&e1, &e1tok);
20710 0 : M2Quads_PopTtok (&const_, &consttok);
20711 0 : consttok = M2LexBuf_MakeVirtual2Tok (consttok, e2tok);
20712 0 : M2MetaError_MetaErrorT1 (consttok, (const char *) "the constant {%E1a} must be either an array constructor or a set constructor", 76, const_);
20713 0 : PushTFrwtok (const_, SymbolTable_GetSType (const_), static_cast<unsigned int> (SymbolTable_NulSym), consttok);
20714 : }
20715 : }
20716 26054 : }
20717 :
20718 :
20719 : /*
20720 : PopConstructor - removes the top constructor from the top of stack.
20721 : */
20722 :
20723 48319 : extern "C" void M2Quads_PopConstructor (void)
20724 : {
20725 48319 : M2Quads_ConstructorFrame c;
20726 :
20727 48319 : c = static_cast<M2Quads_ConstructorFrame> (M2StackAddress_PopAddress (ConstructorStack));
20728 48319 : Storage_DEALLOCATE ((void **) &c, sizeof (M2Quads__T1));
20729 48319 : }
20730 :
20731 :
20732 : /*
20733 : BuildNot - Builds a NOT operation from the quad stack.
20734 : The Stack is expected to contain:
20735 :
20736 :
20737 : Entry Exit
20738 : ===== ====
20739 :
20740 : Ptr -> <- Ptr
20741 : +------------+ +------------+
20742 : | t | f | | f | t |
20743 : |------------| |------------|
20744 : */
20745 :
20746 4850 : extern "C" void M2Quads_BuildNot (unsigned int notTokPos)
20747 : {
20748 4850 : unsigned int combinedTok;
20749 4850 : unsigned int exprTokPos;
20750 4850 : unsigned int t;
20751 4850 : unsigned int f;
20752 :
20753 4850 : CheckBooleanId ();
20754 4850 : PopBooltok (&t, &f, &exprTokPos);
20755 4850 : combinedTok = M2LexBuf_MakeVirtualTok (notTokPos, notTokPos, exprTokPos);
20756 4850 : PushBooltok (f, t, combinedTok);
20757 4850 : }
20758 :
20759 :
20760 : /*
20761 : RecordOp - Records the operator passed on the stack.
20762 : This is called when a boolean operator is found in an
20763 : expression. It is called just after the lhs has been built
20764 : and pushed to the quad stack and prior to the rhs build.
20765 : It checks to see if AND OR or equality tests are required.
20766 : It will short circuit AND and OR expressions. It also
20767 : converts a lhs to a boolean variable if an xor comparison
20768 : is about to be performed.
20769 :
20770 : Checks for AND operator or OR operator
20771 : if either of these operators are found then BackPatching
20772 : takes place.
20773 : The Expected Stack:
20774 :
20775 : Entry Exit
20776 :
20777 : Ptr -> <- Ptr
20778 : +-------------+ +-------------+
20779 : | OperatorTok | | OperatorTok |
20780 : |-------------| |-------------|
20781 : | t | f | | t | f |
20782 : |-------------| |-------------|
20783 :
20784 :
20785 : If OperatorTok=AndTok
20786 : Then
20787 : BackPatch(f, NextQuad)
20788 : Elsif OperatorTok=OrTok
20789 : Then
20790 : BackPatch(t, NextQuad)
20791 : End
20792 : */
20793 :
20794 105148 : extern "C" void M2Quads_RecordOp (void)
20795 : {
20796 105148 : NameKey_Name Op;
20797 105148 : unsigned int tokno;
20798 105148 : unsigned int t;
20799 105148 : unsigned int f;
20800 :
20801 105148 : M2Quads_PopTtok (&Op, &tokno);
20802 105148 : if ((Op == M2Reserved_AndTok) || (Op == M2Reserved_AmbersandTok))
20803 : {
20804 9636 : CheckBooleanId ();
20805 9636 : PopBool (&t, &f);
20806 9636 : BackPatch (t, NextQuad);
20807 9636 : PushBool (0, f);
20808 : }
20809 95512 : else if (Op == M2Reserved_OrTok)
20810 : {
20811 : /* avoid dangling else. */
20812 3536 : CheckBooleanId ();
20813 3536 : PopBool (&t, &f);
20814 3536 : BackPatch (f, NextQuad);
20815 3536 : PushBool (t, 0);
20816 : }
20817 91976 : else if ((IsBoolean (1)) && ((((Op == M2Reserved_EqualTok) || (Op == M2Reserved_LessGreaterTok)) || (Op == M2Reserved_HashTok)) || (Op == M2Reserved_InTok)))
20818 : {
20819 : /* avoid dangling else. */
20820 52 : ConvertBooleanToVariable (tokno, 1);
20821 : }
20822 105148 : M2Quads_PushTtok (Op, tokno);
20823 105148 : }
20824 :
20825 :
20826 : /*
20827 : BuildRelOp - Builds a relative operation from the quad stack.
20828 : The Stack is expected to contain:
20829 :
20830 :
20831 : Entry Exit
20832 : ===== ====
20833 :
20834 : Ptr ->
20835 : +------------+
20836 : | e1 |
20837 : |------------| <- Ptr
20838 : | Operator |
20839 : |------------| +------------+
20840 : | e2 | | t | f |
20841 : |------------| |------------|
20842 :
20843 :
20844 : Quadruples Produced
20845 :
20846 : q IFOperator e2 e1 TrueExit ; e2 e1 since
20847 : q+1 GotoOp FalseExit ; relation > etc
20848 : ; requires order.
20849 : */
20850 :
20851 90766 : extern "C" void M2Quads_BuildRelOp (unsigned int optokpos)
20852 : {
20853 90766 : unsigned int combinedTok;
20854 90766 : unsigned int rightpos;
20855 90766 : unsigned int leftpos;
20856 90766 : NameKey_Name Op;
20857 90766 : unsigned int t;
20858 90766 : unsigned int rightType;
20859 90766 : unsigned int leftType;
20860 90766 : unsigned int right;
20861 90766 : unsigned int left;
20862 90766 : DynamicStrings_String s;
20863 :
20864 90766 : if (M2Options_CompilerDebugging)
20865 : {
20866 0 : M2Quads_DisplayStack (); /* Debugging info */
20867 : }
20868 90766 : if (((M2Quads_IsInConstExpression ()) && (IsBoolean (1))) && (IsBoolean (3)))
20869 : {
20870 : /*
20871 : we allow # and = to be used with Boolean expressions.
20872 : we do not allow > < >= <= though. We only examine
20873 : this case if we are in a const expression as there will be
20874 : no dereferencing of operands.
20875 : */
20876 0 : BuildRelOpFromBoolean (optokpos);
20877 : }
20878 : else
20879 : {
20880 90766 : if (IsBoolean (1))
20881 : {
20882 64 : ConvertBooleanToVariable (OperandTtok (1), 1);
20883 : }
20884 90766 : if (IsBoolean (3))
20885 : {
20886 0 : ConvertBooleanToVariable (OperandTtok (3), 3);
20887 : }
20888 90766 : M2Quads_PopTFtok (&right, &rightType, &rightpos);
20889 90766 : M2Quads_PopT (&Op);
20890 90766 : M2Quads_PopTFtok (&left, &leftType, &leftpos);
20891 90766 : CheckVariableOrConstantOrProcedure (rightpos, right);
20892 90766 : CheckVariableOrConstantOrProcedure (leftpos, left);
20893 90766 : combinedTok = M2LexBuf_MakeVirtualTok (optokpos, leftpos, rightpos);
20894 90766 : if ((left != SymbolTable_NulSym) && (right != SymbolTable_NulSym))
20895 : {
20896 : /* BuildRange will check the expression later on once gcc knows about all data types. */
20897 90766 : BuildRange (M2Range_InitTypesExpressionCheck (combinedTok, left, right, true, Op == M2Reserved_InTok));
20898 : }
20899 : /* Must dereference LeftValue operands. */
20900 90766 : if ((SymbolTable_GetMode (right)) == SymbolTable_LeftValue)
20901 : {
20902 1928 : t = SymbolTable_MakeTemporary (rightpos, SymbolTable_RightValue);
20903 1928 : SymbolTable_PutVar (t, SymbolTable_GetSType (right));
20904 1928 : CheckPointerThroughNil (rightpos, right);
20905 1928 : doIndrX (rightpos, t, right);
20906 1928 : right = t;
20907 : }
20908 90766 : if ((SymbolTable_GetMode (left)) == SymbolTable_LeftValue)
20909 : {
20910 6233 : t = SymbolTable_MakeTemporary (leftpos, SymbolTable_RightValue);
20911 6233 : SymbolTable_PutVar (t, SymbolTable_GetSType (left));
20912 6233 : CheckPointerThroughNil (leftpos, left);
20913 6233 : doIndrX (leftpos, t, left);
20914 6233 : left = t;
20915 : }
20916 90766 : if (DebugTokPos)
20917 : {
20918 : s = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (M2LexBuf_GetTokenName (Op)));
20919 : M2Error_WarnStringAt (s, optokpos);
20920 : s = DynamicStrings_InitString ((const char *) "left", 4);
20921 : M2Error_WarnStringAt (s, leftpos);
20922 : s = DynamicStrings_InitString ((const char *) "right", 5);
20923 : M2Error_WarnStringAt (s, rightpos);
20924 : s = DynamicStrings_InitString ((const char *) "caret", 5);
20925 : M2Error_WarnStringAt (s, optokpos);
20926 : s = DynamicStrings_InitString ((const char *) "combined", 8);
20927 : M2Error_WarnStringAt (s, combinedTok);
20928 : }
20929 90766 : GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, false, leftpos, rightpos, M2LexBuf_UnknownTokenNo); /* True Exit */
20930 90766 : GenQuadO (combinedTok, M2Quads_GotoOp, SymbolTable_NulSym, SymbolTable_NulSym, 0, false); /* False Exit */
20931 90766 : PushBooltok (NextQuad-2, NextQuad-1, combinedTok); /* False Exit */
20932 : }
20933 90766 : }
20934 :
20935 :
20936 : /*
20937 : BuildBinaryOp - Builds a binary operation from the quad stack.
20938 : Be aware that this procedure will check for
20939 : the overloading of the bitset operators + - \ *.
20940 : So do NOT call this procedure if you are building
20941 : a reference to an array which has a bitset type or
20942 : the address arithmetic will be wrongly coersed into
20943 : logical ORs.
20944 :
20945 : The Stack is expected to contain:
20946 :
20947 :
20948 : Entry Exit
20949 : ===== ====
20950 :
20951 : Ptr ->
20952 : +------------+
20953 : | Sym1 |
20954 : |------------|
20955 : | Operator | <- Ptr
20956 : |------------| +------------+
20957 : | Sym2 | | Temporary |
20958 : |------------| |------------|
20959 :
20960 :
20961 : Quadruples Produced
20962 :
20963 : q Operator Temporary Sym1 Sym2
20964 :
20965 :
20966 : OR
20967 :
20968 :
20969 : Entry Exit
20970 : ===== ====
20971 :
20972 : Ptr ->
20973 : +------------+
20974 : | T1 | F1 |
20975 : |------------|
20976 : | OrTok | <- Ptr
20977 : |------------| +------------+
20978 : | T2 | F2 | | T1+T2| F1 |
20979 : |------------| |------------|
20980 :
20981 :
20982 : Quadruples Produced
20983 :
20984 : */
20985 :
20986 73719 : extern "C" void M2Quads_BuildBinaryOp (void)
20987 : {
20988 73719 : doBuildBinaryOp (true, true);
20989 73611 : }
20990 :
20991 :
20992 : /*
20993 : BuildUnaryOp - Builds a unary operation from the quad stack.
20994 : The Stack is expected to contain:
20995 :
20996 :
20997 : Entry Exit
20998 : ===== ====
20999 :
21000 : Ptr ->
21001 : +------------+
21002 : | Sym |
21003 : |------------| +------------+
21004 : | Operator | | Temporary | <- Ptr
21005 : |------------| |------------|
21006 :
21007 :
21008 : Quadruples Produced
21009 :
21010 : q Operator Temporary _ Sym
21011 :
21012 : */
21013 :
21014 21206 : extern "C" void M2Quads_BuildUnaryOp (void)
21015 : {
21016 21206 : unsigned int sympos;
21017 21206 : unsigned int tokpos;
21018 21206 : NameKey_Name Tok;
21019 21206 : unsigned int type;
21020 21206 : unsigned int Sym;
21021 21206 : unsigned int SymT;
21022 21206 : unsigned int r;
21023 21206 : unsigned int t;
21024 :
21025 21206 : PopTrwtok (&Sym, &r, &sympos);
21026 21206 : M2Quads_PopTtok (&Tok, &tokpos);
21027 21206 : if (Tok == M2Reserved_MinusTok)
21028 : {
21029 21050 : MarkAsRead (r);
21030 21050 : type = M2Base_NegateType (SymbolTable_GetSType (Sym)); /* , sympos */
21031 21050 : tokpos = M2LexBuf_MakeVirtualTok (tokpos, tokpos, sympos);
21032 22052 : t = SymbolTable_MakeTemporary (tokpos, AreConstant (SymbolTable_IsConst (Sym)));
21033 21050 : SymbolTable_PutVar (t, type);
21034 : /*
21035 : variables must have a type and REAL/LONGREAL constants must
21036 : be typed
21037 : */
21038 21050 : if (! (SymbolTable_IsConst (Sym)))
21039 : {
21040 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
21041 1002 : if ((type != SymbolTable_NulSym) && (SymbolTable_IsSet (SymbolTable_SkipType (type))))
21042 : {} /* empty. */
21043 : /* do not dereference set variables */
21044 924 : else if ((SymbolTable_GetMode (Sym)) == SymbolTable_LeftValue)
21045 : {
21046 : /* avoid dangling else. */
21047 : /* dereference symbols which are not sets and which are variables */
21048 0 : SymT = SymbolTable_MakeTemporary (sympos, SymbolTable_RightValue);
21049 0 : SymbolTable_PutVar (SymT, SymbolTable_GetSType (Sym));
21050 0 : CheckPointerThroughNil (sympos, Sym);
21051 0 : doIndrX (sympos, SymT, Sym);
21052 0 : Sym = SymT;
21053 : }
21054 : }
21055 21050 : GenQuadO (tokpos, M2Quads_NegateOp, t, SymbolTable_NulSym, Sym, true);
21056 21050 : M2Quads_PushTtok (t, tokpos);
21057 : }
21058 156 : else if (Tok == M2Reserved_PlusTok)
21059 : {
21060 : /* avoid dangling else. */
21061 156 : tokpos = M2LexBuf_MakeVirtualTok (tokpos, tokpos, sympos);
21062 156 : PushTrwtok (Sym, r, tokpos);
21063 : }
21064 : else
21065 : {
21066 : /* avoid dangling else. */
21067 0 : M2MetaError_MetaErrorNT1 (tokpos, (const char *) "expecting an unary operator, seen {%Ek%a}", 41, Tok);
21068 : }
21069 21206 : }
21070 :
21071 :
21072 : /*
21073 : OperandT - returns the ident operand stored in the true position on the boolean stack.
21074 : */
21075 :
21076 214826127 : extern "C" unsigned int M2Quads_OperandT (unsigned int pos)
21077 : {
21078 214826127 : M2Debug_Assert (! (IsBoolean (pos)));
21079 214826127 : return OperandTno (pos);
21080 : /* static analysis guarentees a RETURN statement will be used before here. */
21081 : __builtin_unreachable ();
21082 : }
21083 :
21084 :
21085 : /*
21086 : OperandF - returns the ident operand stored in the false position on the boolean stack.
21087 : */
21088 :
21089 176325 : extern "C" unsigned int M2Quads_OperandF (unsigned int pos)
21090 : {
21091 176325 : M2Debug_Assert (! (IsBoolean (pos)));
21092 176325 : return OperandFno (pos);
21093 : /* static analysis guarentees a RETURN statement will be used before here. */
21094 : __builtin_unreachable ();
21095 : }
21096 :
21097 :
21098 : /*
21099 : PushTF - Push a True and False numbers onto the True/False stack.
21100 : True and False are assumed to contain Symbols or Ident etc.
21101 : */
21102 :
21103 16053864 : extern "C" void M2Quads_PushTF (unsigned int True, unsigned int False)
21104 : {
21105 16053864 : M2Quads_BoolFrame f;
21106 :
21107 16053864 : f = newBoolFrame ();
21108 16053864 : f->TrueExit = static_cast<unsigned int> (True);
21109 16053864 : f->FalseExit = static_cast<unsigned int> (False);
21110 16053864 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21111 16053864 : }
21112 :
21113 :
21114 : /*
21115 : PopTF - Pop a True and False number from the True/False stack.
21116 : True and False are assumed to contain Symbols or Ident etc.
21117 : */
21118 :
21119 10794654 : extern "C" void M2Quads_PopTF (unsigned int *True, unsigned int *False)
21120 : {
21121 10794654 : M2Quads_BoolFrame f;
21122 :
21123 10794654 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21124 10794654 : (*True) = static_cast<unsigned int> (f->TrueExit);
21125 10794654 : (*False) = static_cast<unsigned int> (f->FalseExit);
21126 10794654 : M2Debug_Assert (! f->BooleanOp);
21127 10794654 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21128 10794654 : }
21129 :
21130 :
21131 : /*
21132 : PushT - Push an item onto the stack in the T (true) position.
21133 : */
21134 :
21135 99380482 : extern "C" void M2Quads_PushT (unsigned int True)
21136 : {
21137 99380482 : M2Quads_BoolFrame f;
21138 :
21139 99380482 : f = newBoolFrame ();
21140 99380482 : f->TrueExit = static_cast<unsigned int> (True);
21141 99380482 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21142 99380482 : }
21143 :
21144 :
21145 : /*
21146 : PopT - Pops the T value from the stack.
21147 : */
21148 :
21149 146526691 : extern "C" void M2Quads_PopT (unsigned int *True)
21150 : {
21151 146526691 : M2Quads_BoolFrame f;
21152 :
21153 146526691 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21154 146526685 : (*True) = static_cast<unsigned int> (f->TrueExit);
21155 146526685 : M2Debug_Assert (! f->BooleanOp);
21156 146526685 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21157 146526685 : }
21158 :
21159 :
21160 : /*
21161 : PushTtok - Push an item onto the stack in the T (true) position,
21162 : it is assummed to be a token and its token location is recorded.
21163 : */
21164 :
21165 78856593 : extern "C" void M2Quads_PushTtok (unsigned int True, unsigned int tokno)
21166 : {
21167 78856593 : M2Quads_BoolFrame f;
21168 :
21169 : /* PrintTokenNo (tokno) ; */
21170 78856593 : f = newBoolFrame ();
21171 78856593 : f->TrueExit = static_cast<unsigned int> (True);
21172 78856593 : f->tokenno = tokno;
21173 78856593 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21174 78856593 : }
21175 :
21176 :
21177 : /*
21178 : PushTFtok - Push an item onto the stack in the T (true) position,
21179 : it is assummed to be a token and its token location is recorded.
21180 : */
21181 :
21182 157610803 : extern "C" void M2Quads_PushTFtok (unsigned int True, unsigned int False, unsigned int tokno)
21183 : {
21184 157610803 : M2Quads_BoolFrame f;
21185 :
21186 157610803 : f = newBoolFrame ();
21187 157610803 : f->TrueExit = static_cast<unsigned int> (True);
21188 157610803 : f->FalseExit = static_cast<unsigned int> (False);
21189 157610803 : f->tokenno = tokno;
21190 157610803 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21191 157610803 : }
21192 :
21193 :
21194 : /*
21195 : PopTFtok - Pop T/F/tok from the stack.
21196 : */
21197 :
21198 9540543 : extern "C" void M2Quads_PopTFtok (unsigned int *True, unsigned int *False, unsigned int *tokno)
21199 : {
21200 9540543 : M2Quads_BoolFrame f;
21201 :
21202 9540543 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21203 9540543 : (*True) = static_cast<unsigned int> (f->TrueExit);
21204 9540543 : (*False) = static_cast<unsigned int> (f->FalseExit);
21205 9540543 : (*tokno) = f->tokenno;
21206 9540543 : }
21207 :
21208 :
21209 : /*
21210 : PushTFAtok - Push T/F/A/tok to the stack.
21211 : */
21212 :
21213 54 : extern "C" void M2Quads_PushTFAtok (unsigned int True, unsigned int False, unsigned int Array, unsigned int tokno)
21214 : {
21215 54 : M2Quads_BoolFrame f;
21216 :
21217 54 : f = newBoolFrame ();
21218 54 : f->TrueExit = static_cast<unsigned int> (True);
21219 54 : f->FalseExit = static_cast<unsigned int> (False);
21220 54 : f->Unbounded = static_cast<unsigned int> (Array);
21221 54 : f->tokenno = tokno;
21222 54 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21223 54 : }
21224 :
21225 :
21226 : /*
21227 : PopTtok - Pops the T value from the stack and token position.
21228 : */
21229 :
21230 117980809 : extern "C" void M2Quads_PopTtok (unsigned int *True, unsigned int *tok)
21231 : {
21232 117980809 : M2Quads_BoolFrame f;
21233 :
21234 117980809 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21235 117980809 : (*True) = static_cast<unsigned int> (f->TrueExit);
21236 117980809 : (*tok) = f->tokenno;
21237 117980809 : M2Debug_Assert (! f->BooleanOp);
21238 117980809 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21239 117980809 : }
21240 :
21241 :
21242 : /*
21243 : PushTFn - Push a True and False numbers onto the True/False stack.
21244 : True and False are assumed to contain Symbols or Ident etc.
21245 : */
21246 :
21247 0 : extern "C" void M2Quads_PushTFn (unsigned int True, unsigned int False, unsigned int n)
21248 : {
21249 0 : M2Quads_BoolFrame f;
21250 :
21251 0 : f = newBoolFrame ();
21252 0 : f->TrueExit = static_cast<unsigned int> (True);
21253 0 : f->FalseExit = static_cast<unsigned int> (False);
21254 0 : f->name = static_cast<unsigned int> (n);
21255 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21256 0 : }
21257 :
21258 :
21259 : /*
21260 : PushTFntok - Push a True and False numbers onto the True/False stack.
21261 : True and False are assumed to contain Symbols or Ident etc.
21262 : */
21263 :
21264 666833 : extern "C" void M2Quads_PushTFntok (unsigned int True, unsigned int False, unsigned int n, unsigned int tokno)
21265 : {
21266 666833 : M2Quads_BoolFrame f;
21267 :
21268 666833 : f = newBoolFrame ();
21269 666833 : f->TrueExit = static_cast<unsigned int> (True);
21270 666833 : f->FalseExit = static_cast<unsigned int> (False);
21271 666833 : f->name = static_cast<unsigned int> (n);
21272 666833 : f->tokenno = tokno;
21273 666833 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21274 666833 : }
21275 :
21276 :
21277 : /*
21278 : PopTFn - Pop a True and False number from the True/False stack.
21279 : True and False are assumed to contain Symbols or Ident etc.
21280 : */
21281 :
21282 0 : extern "C" void M2Quads_PopTFn (unsigned int *True, unsigned int *False, unsigned int *n)
21283 : {
21284 0 : M2Quads_BoolFrame f;
21285 :
21286 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21287 0 : (*True) = static_cast<unsigned int> (f->TrueExit);
21288 0 : (*False) = static_cast<unsigned int> (f->FalseExit);
21289 0 : (*n) = static_cast<unsigned int> (f->name);
21290 0 : M2Debug_Assert (! f->BooleanOp);
21291 0 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21292 0 : }
21293 :
21294 :
21295 : /*
21296 : PopNothing - pops the top element on the boolean stack.
21297 : */
21298 :
21299 66632489 : extern "C" void M2Quads_PopNothing (void)
21300 : {
21301 66632489 : M2Quads_BoolFrame f;
21302 :
21303 66632489 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21304 66632489 : Storage_DEALLOCATE ((void **) &f, sizeof (M2Quads__T2));
21305 66632489 : }
21306 :
21307 :
21308 : /*
21309 : PopN - pops multiple elements from the BoolStack.
21310 : */
21311 :
21312 12798261 : extern "C" void M2Quads_PopN (unsigned int n)
21313 : {
21314 48464297 : while (n > 0)
21315 : {
21316 35666036 : M2Quads_PopNothing ();
21317 35666036 : n -= 1;
21318 : }
21319 12798261 : }
21320 :
21321 :
21322 : /*
21323 : PushTFA - Push True, False, Array, numbers onto the
21324 : True/False stack. True and False are assumed to
21325 : contain Symbols or Ident etc.
21326 : */
21327 :
21328 0 : extern "C" void M2Quads_PushTFA (unsigned int True, unsigned int False, unsigned int Array)
21329 : {
21330 0 : M2Quads_BoolFrame f;
21331 :
21332 0 : f = newBoolFrame ();
21333 0 : f->TrueExit = static_cast<unsigned int> (True);
21334 0 : f->FalseExit = static_cast<unsigned int> (False);
21335 0 : f->Unbounded = static_cast<unsigned int> (Array);
21336 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21337 0 : }
21338 :
21339 :
21340 : /*
21341 : OperandTok - returns the token associated with pos, on the stack.
21342 : */
21343 :
21344 56991111 : extern "C" unsigned int M2Quads_OperandTok (unsigned int pos)
21345 : {
21346 56991111 : M2Debug_Assert (! (IsBoolean (pos)));
21347 56991111 : return static_cast<unsigned int> (OperandTtok (pos));
21348 : /* static analysis guarentees a RETURN statement will be used before here. */
21349 : __builtin_unreachable ();
21350 : }
21351 :
21352 :
21353 : /*
21354 : OperandA - returns possible array symbol associated with the ident
21355 : operand stored on the boolean stack.
21356 : */
21357 :
21358 2264995 : extern "C" unsigned int M2Quads_OperandA (unsigned int pos)
21359 : {
21360 2264995 : M2Quads_BoolFrame f;
21361 :
21362 2264995 : M2Debug_Assert (pos > 0);
21363 2264995 : M2Debug_Assert (! (IsBoolean (pos)));
21364 2264995 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, pos));
21365 2264995 : return static_cast<unsigned int> (f->Unbounded);
21366 : /* static analysis guarentees a RETURN statement will be used before here. */
21367 : __builtin_unreachable ();
21368 : }
21369 :
21370 :
21371 : /*
21372 : OperandAnno - returns the annotation string associated with the
21373 : position, n, on the stack.
21374 : */
21375 :
21376 0 : extern "C" DynamicStrings_String M2Quads_OperandAnno (unsigned int n)
21377 : {
21378 0 : M2Quads_BoolFrame f;
21379 :
21380 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, n));
21381 0 : return f->Annotation;
21382 : /* static analysis guarentees a RETURN statement will be used before here. */
21383 : __builtin_unreachable ();
21384 : }
21385 :
21386 :
21387 : /*
21388 : Annotate - annotate the top of stack.
21389 : */
21390 :
21391 126172649 : extern "C" void M2Quads_Annotate (const char *a_, unsigned int _a_high)
21392 : {
21393 126172649 : M2Quads_BoolFrame f;
21394 126172649 : char a[_a_high+1];
21395 :
21396 : /* make a local copy of each unbounded array. */
21397 126172649 : memcpy (a, a_, _a_high+1);
21398 :
21399 0 : if ((DebugStackOn && M2Options_CompilerDebugging) && ((M2StackAddress_NoOfItemsInStackAddress (BoolStack)) > 0))
21400 : {
21401 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PeepAddress (BoolStack, 1)); /* top of stack */
21402 0 : if (f->Annotation != NULL) /* top of stack */
21403 : {
21404 0 : f->Annotation = DynamicStrings_KillString (f->Annotation);
21405 : }
21406 0 : f->Annotation = DynamicStrings_InitString ((const char *) a, _a_high);
21407 : }
21408 126172649 : }
21409 :
21410 :
21411 : /*
21412 : DisplayStack - displays the compile time symbol stack.
21413 : */
21414 :
21415 20456448 : extern "C" void M2Quads_DisplayStack (void)
21416 : {
21417 20456448 : if (DebugStackOn && M2Options_CompilerDebugging)
21418 : {
21419 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});
21420 : }
21421 20456448 : }
21422 :
21423 :
21424 : /*
21425 : Top - returns the no of items held in the stack.
21426 : */
21427 :
21428 92077895 : extern "C" unsigned int M2Quads_Top (void)
21429 : {
21430 92077895 : return M2StackAddress_NoOfItemsInStackAddress (BoolStack);
21431 : /* static analysis guarentees a RETURN statement will be used before here. */
21432 : __builtin_unreachable ();
21433 : }
21434 :
21435 :
21436 : /*
21437 : DupFrame - duplicate the top of stack and push the new frame.
21438 : */
21439 :
21440 0 : extern "C" void M2Quads_DupFrame (void)
21441 : {
21442 0 : M2Quads_BoolFrame f;
21443 0 : M2Quads_BoolFrame newf;
21444 :
21445 0 : f = static_cast<M2Quads_BoolFrame> (M2StackAddress_PopAddress (BoolStack));
21446 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (f));
21447 0 : newf = newBoolFrame ();
21448 0 : (*newf) = (*f);
21449 0 : M2StackAddress_PushAddress (BoolStack, reinterpret_cast <void *> (newf));
21450 0 : }
21451 :
21452 :
21453 : /*
21454 : WriteOperand - displays the operands name, symbol id and mode of addressing.
21455 : */
21456 :
21457 0 : extern "C" void M2Quads_WriteOperand (unsigned int Sym)
21458 : {
21459 0 : NameKey_Name n;
21460 :
21461 0 : if (Sym == SymbolTable_NulSym)
21462 : {
21463 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "<nulsym>", 8);
21464 : }
21465 : else
21466 : {
21467 0 : n = SymbolTable_GetSymName (Sym);
21468 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "%a", 2, (const unsigned char *) &n, (sizeof (n)-1));
21469 0 : if ((SymbolTable_IsVar (Sym)) || (SymbolTable_IsConst (Sym)))
21470 : {
21471 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "[", 1);
21472 0 : WriteMode (SymbolTable_GetMode (Sym));
21473 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "]", 1);
21474 : }
21475 0 : M2Printf_fprintf1 (M2LangDump_GetDumpFile (), (const char *) "(%d)", 4, (const unsigned char *) &Sym, (sizeof (Sym)-1));
21476 0 : if (SymbolConversion_GccKnowsAbout (Sym))
21477 : {
21478 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "[gcc]", 5);
21479 : }
21480 : }
21481 0 : }
21482 :
21483 :
21484 : /*
21485 : BeginVarient - begin a varient record.
21486 : */
21487 :
21488 3054 : extern "C" void M2Quads_BeginVarient (void)
21489 : {
21490 3054 : unsigned int r;
21491 3054 : unsigned int v;
21492 :
21493 3054 : r = GetRecordOrField ();
21494 6108 : M2Debug_Assert ((SymbolTable_IsRecord (r)) || (SymbolTable_IsFieldVarient (r)));
21495 3054 : v = GetRecordOrField ();
21496 3054 : M2Debug_Assert (SymbolTable_IsVarient (v));
21497 3054 : BuildRange (M2Range_InitCaseBounds (M2CaseList_PushCase (r, v, SymbolTable_NulSym)));
21498 3054 : }
21499 :
21500 :
21501 : /*
21502 : EndVarient - end a varient record.
21503 : */
21504 :
21505 3054 : extern "C" void M2Quads_EndVarient (void)
21506 : {
21507 3054 : M2CaseList_PopCase ();
21508 3054 : }
21509 :
21510 :
21511 : /*
21512 : ElseVarient - associate an ELSE clause with a varient record.
21513 : */
21514 :
21515 114 : extern "C" void M2Quads_ElseVarient (void)
21516 : {
21517 114 : unsigned int f;
21518 :
21519 114 : f = GetRecordOrField ();
21520 114 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21521 114 : M2CaseList_ElseCase (f);
21522 114 : }
21523 :
21524 :
21525 : /*
21526 : BeginVarientList - begin an ident list containing ranges belonging to a
21527 : varient list.
21528 : */
21529 :
21530 6108 : extern "C" void M2Quads_BeginVarientList (void)
21531 : {
21532 6108 : unsigned int f;
21533 :
21534 6108 : f = GetRecordOrField ();
21535 6108 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21536 6108 : M2CaseList_BeginCaseList (f);
21537 6108 : }
21538 :
21539 :
21540 : /*
21541 : EndVarientList - end a range list for a varient field.
21542 : */
21543 :
21544 6108 : extern "C" void M2Quads_EndVarientList (void)
21545 : {
21546 6108 : M2CaseList_EndCaseList ();
21547 6108 : }
21548 :
21549 :
21550 : /*
21551 : AddRecordToList - adds the record held on the top of stack to the
21552 : list of records and varient fields.
21553 : */
21554 :
21555 3054 : extern "C" void M2Quads_AddRecordToList (void)
21556 : {
21557 3054 : unsigned int r;
21558 3054 : unsigned int n;
21559 :
21560 3054 : r = static_cast<unsigned int> (M2Quads_OperandT (1));
21561 6108 : M2Debug_Assert ((SymbolTable_IsRecord (r)) || (SymbolTable_IsFieldVarient (r)));
21562 : /*
21563 : r might be a field varient if the declaration consists of nested
21564 : varients. However ISO TSIZE can only utilise record types, we store
21565 : a varient field anyway as the next pass would not know whether to
21566 : ignore a varient field.
21567 : */
21568 3054 : Lists_PutItemIntoList (VarientFields, r);
21569 3054 : if (DebugVarients)
21570 : {
21571 : n = Lists_NoOfItemsInList (VarientFields);
21572 : if (SymbolTable_IsRecord (r))
21573 : {
21574 : 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));
21575 : }
21576 : else
21577 : {
21578 : 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));
21579 : }
21580 : }
21581 3054 : }
21582 :
21583 :
21584 : /*
21585 : AddVarientToList - adds varient held on the top of stack to the list.
21586 : */
21587 :
21588 3054 : extern "C" void M2Quads_AddVarientToList (void)
21589 : {
21590 3054 : unsigned int v;
21591 3054 : unsigned int n;
21592 :
21593 3054 : v = static_cast<unsigned int> (M2Quads_OperandT (1));
21594 3054 : M2Debug_Assert (SymbolTable_IsVarient (v));
21595 3054 : Lists_PutItemIntoList (VarientFields, v);
21596 3054 : if (DebugVarients)
21597 : {
21598 : n = Lists_NoOfItemsInList (VarientFields);
21599 : 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));
21600 : }
21601 3054 : }
21602 :
21603 :
21604 : /*
21605 : AddVarientFieldToList - adds varient field, f, to the list of all varient
21606 : fields created.
21607 : */
21608 :
21609 6222 : extern "C" void M2Quads_AddVarientFieldToList (unsigned int f)
21610 : {
21611 6222 : unsigned int n;
21612 :
21613 6222 : M2Debug_Assert (SymbolTable_IsFieldVarient (f));
21614 6222 : Lists_PutItemIntoList (VarientFields, f);
21615 6222 : if (DebugVarients)
21616 : {
21617 : n = Lists_NoOfItemsInList (VarientFields);
21618 : 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));
21619 : }
21620 6222 : }
21621 :
21622 :
21623 : /*
21624 : AddVarientRange - creates a range from the top two contant expressions
21625 : on the stack which are recorded with the current
21626 : varient field. The stack is unaltered.
21627 : */
21628 :
21629 0 : extern "C" void M2Quads_AddVarientRange (void)
21630 : {
21631 0 : unsigned int r1;
21632 0 : unsigned int r2;
21633 :
21634 0 : M2Quads_PopT (&r2);
21635 0 : M2Quads_PopT (&r1);
21636 0 : M2CaseList_AddRange (r1, r2, M2LexBuf_GetTokenNo ());
21637 0 : }
21638 :
21639 :
21640 : /*
21641 : AddVarientEquality - adds the contant expression on the top of the stack
21642 : to the current varient field being recorded.
21643 : The stack is unaltered.
21644 : */
21645 :
21646 6150 : extern "C" void M2Quads_AddVarientEquality (void)
21647 : {
21648 6150 : unsigned int r1;
21649 :
21650 6150 : M2Quads_PopT (&r1);
21651 6150 : M2CaseList_AddRange (r1, SymbolTable_NulSym, M2LexBuf_GetTokenNo ());
21652 6150 : }
21653 :
21654 :
21655 : /*
21656 : BuildCodeOn - generates a quadruple declaring that code should be
21657 : emmitted from henceforth.
21658 :
21659 : The Stack is unnaffected.
21660 : */
21661 :
21662 0 : extern "C" void M2Quads_BuildCodeOn (void)
21663 : {
21664 0 : GenQuad (M2Quads_CodeOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21665 0 : }
21666 :
21667 :
21668 : /*
21669 : BuildCodeOff - generates a quadruple declaring that code should not be
21670 : emmitted from henceforth.
21671 :
21672 : The Stack is unnaffected.
21673 : */
21674 :
21675 0 : extern "C" void M2Quads_BuildCodeOff (void)
21676 : {
21677 0 : GenQuad (M2Quads_CodeOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21678 0 : }
21679 :
21680 :
21681 : /*
21682 : BuildProfileOn - generates a quadruple declaring that profile timings
21683 : should be emmitted from henceforth.
21684 :
21685 : The Stack is unnaffected.
21686 : */
21687 :
21688 0 : extern "C" void M2Quads_BuildProfileOn (void)
21689 : {
21690 0 : GenQuad (M2Quads_ProfileOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21691 0 : }
21692 :
21693 0 : extern "C" void M2Quads_BuildProfileOff (void)
21694 : {
21695 : /*
21696 : BuildProfileOn - generates a quadruple declaring that profile timings
21697 : should be emmitted from henceforth.
21698 :
21699 : The Stack is unnaffected.
21700 : */
21701 0 : GenQuad (M2Quads_ProfileOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21702 0 : }
21703 :
21704 :
21705 : /*
21706 : BuildOptimizeOn - generates a quadruple declaring that optimization
21707 : should occur from henceforth.
21708 :
21709 : The Stack is unnaffected.
21710 : */
21711 :
21712 0 : extern "C" void M2Quads_BuildOptimizeOn (void)
21713 : {
21714 0 : GenQuad (M2Quads_OptimizeOnOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21715 0 : }
21716 :
21717 :
21718 : /*
21719 : BuildOptimizeOff - generates a quadruple declaring that optimization
21720 : should not occur from henceforth.
21721 :
21722 : The Stack is unnaffected.
21723 : */
21724 :
21725 0 : extern "C" void M2Quads_BuildOptimizeOff (void)
21726 : {
21727 0 : GenQuad (M2Quads_OptimizeOffOp, SymbolTable_NulSym, SymbolTable_NulSym, SymbolTable_NulSym);
21728 0 : }
21729 :
21730 :
21731 : /*
21732 : BuildAsm - builds an Inline pseudo quadruple operator.
21733 : The inline interface, Sym, is stored as the operand
21734 : to the operator InlineOp.
21735 :
21736 : The stack is expected to contain:
21737 :
21738 :
21739 : Entry Exit
21740 : ===== ====
21741 :
21742 : Ptr ->
21743 : +--------------+
21744 : | Sym | Empty
21745 : |--------------|
21746 : */
21747 :
21748 27 : extern "C" void M2Quads_BuildAsm (unsigned int tok)
21749 : {
21750 27 : unsigned int Sym;
21751 :
21752 27 : M2Quads_PopT (&Sym);
21753 27 : GenQuadO (tok, M2Quads_InlineOp, SymbolTable_NulSym, SymbolTable_NulSym, Sym, false);
21754 27 : }
21755 :
21756 :
21757 : /*
21758 : BuildLineNo - builds a LineNumberOp pseudo quadruple operator.
21759 : This quadruple indicates which source line has been
21760 : processed, these quadruples are only generated if we
21761 : are producing runtime debugging information.
21762 :
21763 : The stack is not affected, read or altered in any way.
21764 :
21765 :
21766 : Entry Exit
21767 : ===== ====
21768 :
21769 : Ptr -> <- Ptr
21770 : */
21771 :
21772 0 : extern "C" void M2Quads_BuildLineNo (void)
21773 : {
21774 0 : NameKey_Name filename;
21775 0 : M2Quads_QuadFrame f;
21776 :
21777 0 : if (((NextQuad != Head) && (M2Options_GenerateLineDebug || M2Options_GenerateDebugging)) && false)
21778 : {
21779 : filename = NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ()));
21780 : f = GetQF (NextQuad-1);
21781 : if (! ((f->Operator == M2Quads_LineNumberOp) && (f->Operand1 == ((unsigned int ) (filename)))))
21782 : {
21783 : GenQuad (M2Quads_LineNumberOp, (unsigned int ) (filename), SymbolTable_NulSym, (unsigned int ) (M2LexBuf_GetLineNo ()));
21784 : }
21785 : }
21786 0 : }
21787 :
21788 :
21789 : /*
21790 : PushLineNo - pushes the current file and line number to the stack.
21791 : */
21792 :
21793 5152 : extern "C" void M2Quads_PushLineNo (void)
21794 : {
21795 5152 : PushLineNote (InitLineNote (NameKey_makekey (DynamicStrings_string (M2LexBuf_GetFileName ())), M2LexBuf_GetLineNo ()));
21796 5152 : }
21797 :
21798 :
21799 : /*
21800 : BuildStmtNote - builds a StatementNoteOp pseudo quadruple operator.
21801 : This quadruple indicates which source line has been
21802 : processed and it represents the start of a statement
21803 : sequence.
21804 : It differs from LineNumberOp in that multiple successive
21805 : LineNumberOps will be removed and the final one is attached to
21806 : the next real GCC tree. Whereas a StatementNoteOp is always left
21807 : alone. Depending upon the debugging level it will issue a nop
21808 : instruction to ensure that the gdb single step will step into
21809 : this line. Practically it allows pedalogical debugging to
21810 : occur when there is syntax sugar such as:
21811 :
21812 :
21813 : END step
21814 : END step
21815 : END ; step
21816 : a := 1 ; step
21817 :
21818 : REPEAT step
21819 : i := 1 step
21820 :
21821 : The stack is not affected, read or altered in any way.
21822 :
21823 :
21824 : Entry Exit
21825 : ===== ====
21826 :
21827 : Ptr -> <- Ptr
21828 : */
21829 :
21830 542276 : extern "C" void M2Quads_BuildStmtNote (int offset)
21831 : {
21832 542276 : int tokenno;
21833 :
21834 542276 : if (NextQuad != Head)
21835 : {
21836 542276 : tokenno = offset;
21837 542276 : tokenno += M2LexBuf_GetTokenNo ();
21838 542276 : BuildStmtNoteTok ((unsigned int ) (tokenno));
21839 : }
21840 542276 : }
21841 :
21842 :
21843 : /*
21844 : LoopAnalysis - checks whether an infinite loop exists.
21845 : */
21846 :
21847 410204 : extern "C" void M2Quads_LoopAnalysis (unsigned int Scope, unsigned int Current, unsigned int End)
21848 : {
21849 410204 : M2Quads_QuadOperator op;
21850 410204 : unsigned int op1;
21851 410204 : unsigned int op2;
21852 410204 : unsigned int op3;
21853 :
21854 410204 : if (M2Options_Pedantic)
21855 : {
21856 11442 : while ((Current <= End) && (Current != 0))
21857 : {
21858 9990 : M2Quads_GetQuad (Current, &op, &op1, &op2, &op3);
21859 9990 : if ((op == M2Quads_GotoOp) || (M2Quads_IsConditional (Current)))
21860 : {
21861 114 : if (op3 <= Current)
21862 : {
21863 : /* found a loop - ie a branch which goes back in quadruple numbers */
21864 24 : if (IsInfiniteLoop (Current))
21865 : {
21866 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);
21867 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);
21868 : }
21869 : /*
21870 : WarnStringAt(InitString('it is very likely (although not absolutely certain) that the top of an infinite loop is here'),
21871 : QuadToTokenNo(op3)) ;
21872 : WarnStringAt(InitString('and the bottom of the infinite loop is ends here or alternatively a component of this loop is never executed'),
21873 : QuadToTokenNo(Current))
21874 : */
21875 : }
21876 : }
21877 9990 : Current = M2Quads_GetNextQuad (Current);
21878 : }
21879 : }
21880 410204 : }
21881 :
21882 :
21883 : /*
21884 : ForLoopAnalysis - checks all the FOR loops for index variable manipulation
21885 : and dangerous usage outside the loop.
21886 : */
21887 :
21888 14425 : extern "C" void M2Quads_ForLoopAnalysis (void)
21889 : {
21890 14425 : unsigned int i;
21891 14425 : unsigned int n;
21892 14425 : M2Quads_ForLoopInfo forDesc;
21893 :
21894 14425 : if (M2Options_Pedantic)
21895 : {
21896 108 : n = Indexing_HighIndice (ForInfo);
21897 108 : i = 1;
21898 216 : while (i <= n)
21899 : {
21900 0 : forDesc = static_cast<M2Quads_ForLoopInfo> (Indexing_GetIndice (ForInfo, i));
21901 0 : CheckForIndex (forDesc);
21902 0 : i += 1;
21903 : }
21904 : }
21905 14425 : }
21906 :
21907 :
21908 : /*
21909 : BuildSizeCheckStart - switches off all quadruple generation if the function SIZE or HIGH
21910 : is being "called". This should be done as SIZE only requires the
21911 : actual type of the expression, not its value. Consider the problem of
21912 : SIZE(UninitializedPointer^) which is quite legal and it must
21913 : also be safe!
21914 : ISO Modula-2 also allows HIGH(a[0]) for a two dimensional array
21915 : and there is no need to compute a[0], we just need to follow the
21916 : type and count dimensions. However if SIZE(a) or HIGH(a) occurs
21917 : and, a, is an unbounded array then we turn on quadruple generation.
21918 :
21919 : The Stack is expected to contain:
21920 :
21921 :
21922 : Entry Exit
21923 : ===== ====
21924 :
21925 : Ptr -> <- Ptr
21926 : +----------------------+ +----------------------+
21927 : | ProcSym | Type | tok | | ProcSym | Type | tok |
21928 : |----------------------| |----------------------|
21929 : */
21930 :
21931 191968 : extern "C" void M2Quads_BuildSizeCheckStart (void)
21932 : {
21933 191968 : unsigned int ProcSym;
21934 191968 : unsigned int Type;
21935 191968 : unsigned int tok;
21936 :
21937 191968 : M2Quads_PopTFtok (&ProcSym, &Type, &tok);
21938 191968 : if (((ProcSym == M2Size_Size) || (ProcSym == M2System_TSize)) || (ProcSym == M2System_TBitSize))
21939 : {
21940 9245 : QuadrupleGeneration = false;
21941 9245 : BuildingSize = true;
21942 : }
21943 182723 : else if (ProcSym == M2Base_High)
21944 : {
21945 : /* avoid dangling else. */
21946 2976 : QuadrupleGeneration = false;
21947 2976 : BuildingHigh = true;
21948 : }
21949 191968 : M2Quads_PushTFtok (ProcSym, Type, tok);
21950 191968 : }
21951 :
21952 :
21953 : /*
21954 : BackPatchSubrangesAndOptParam - runs through all the quadruples and finds SubrangeLow or SubrangeHigh
21955 : quadruples and replaces it by an assignment to the Low or High component
21956 : of the subrange type.
21957 :
21958 : Input:
21959 : SubrangeLow op1 op3 op3 is a subrange
21960 :
21961 : Output:
21962 : Becomes op1 low
21963 :
21964 : Input:
21965 : SubrangeHigh op1 op3 op3 is a subrange
21966 :
21967 : Output:
21968 : Becomes op1 high
21969 :
21970 : Input:
21971 : OptParam op1 op2 op3
21972 :
21973 : Output:
21974 : Param op1 op2 GetOptArgInit(op3)
21975 : */
21976 :
21977 14425 : extern "C" void M2Quads_BackPatchSubrangesAndOptParam (void)
21978 : {
21979 14425 : M2Quads_QuadFrame f;
21980 14425 : unsigned int q;
21981 :
21982 14425 : q = M2Quads_GetFirstQuad ();
21983 14425 : if (q != 0)
21984 : {
21985 6226458 : do {
21986 6226458 : f = GetQF (q);
21987 6226458 : switch (f->Operator)
21988 : {
21989 306 : case M2Quads_SubrangeLowOp:
21990 306 : f->Operand3 = CollectLow (f->Operand3);
21991 306 : f->Operator = M2Quads_BecomesOp;
21992 306 : f->ConstExpr = false;
21993 306 : break;
21994 :
21995 558 : case M2Quads_SubrangeHighOp:
21996 558 : f->Operand3 = CollectHigh (f->Operand3);
21997 558 : f->Operator = M2Quads_BecomesOp;
21998 558 : f->ConstExpr = false;
21999 558 : break;
22000 :
22001 3493 : case M2Quads_OptParamOp:
22002 3493 : f->Operand3 = SymbolTable_GetOptArgInit (f->Operand3);
22003 3493 : f->Operator = M2Quads_ParamOp;
22004 3493 : break;
22005 :
22006 :
22007 : default:
22008 : break;
22009 : }
22010 6226458 : q = f->Next;
22011 6226458 : } while (! (q == 0));
22012 : }
22013 14425 : }
22014 :
22015 :
22016 : /*
22017 : WriteOperator - writes the name of the quadruple operator.
22018 : */
22019 :
22020 0 : extern "C" void M2Quads_WriteOperator (M2Quads_QuadOperator Operator)
22021 : {
22022 0 : switch (Operator)
22023 : {
22024 0 : case M2Quads_ArithAddOp:
22025 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Arith + ", 18);
22026 0 : break;
22027 :
22028 0 : case M2Quads_InitAddressOp:
22029 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitAddress ", 18);
22030 0 : break;
22031 :
22032 0 : case M2Quads_LastForIteratorOp:
22033 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "LastForIterator ", 18);
22034 0 : break;
22035 :
22036 0 : case M2Quads_LogicalOrOp:
22037 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Or ", 18);
22038 0 : break;
22039 :
22040 0 : case M2Quads_LogicalAndOp:
22041 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "And ", 18);
22042 0 : break;
22043 :
22044 0 : case M2Quads_LogicalXorOp:
22045 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Xor ", 18);
22046 0 : break;
22047 :
22048 0 : case M2Quads_LogicalDiffOp:
22049 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Ldiff ", 18);
22050 0 : break;
22051 :
22052 0 : case M2Quads_LogicalShiftOp:
22053 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Shift ", 18);
22054 0 : break;
22055 :
22056 0 : case M2Quads_LogicalRotateOp:
22057 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Rotate ", 18);
22058 0 : break;
22059 :
22060 0 : case M2Quads_BecomesOp:
22061 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Becomes ", 18);
22062 0 : break;
22063 :
22064 0 : case M2Quads_IndrXOp:
22065 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "IndrX ", 18);
22066 0 : break;
22067 :
22068 0 : case M2Quads_XIndrOp:
22069 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "XIndr ", 18);
22070 0 : break;
22071 :
22072 0 : case M2Quads_ArrayOp:
22073 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Array ", 18);
22074 0 : break;
22075 :
22076 0 : case M2Quads_ElementSizeOp:
22077 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ElementSize ", 18);
22078 0 : break;
22079 :
22080 0 : case M2Quads_RecordFieldOp:
22081 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RecordField ", 18);
22082 0 : break;
22083 :
22084 0 : case M2Quads_AddrOp:
22085 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Addr ", 18);
22086 0 : break;
22087 :
22088 0 : case M2Quads_SizeOp:
22089 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Size ", 18);
22090 0 : break;
22091 :
22092 0 : case M2Quads_IfInOp:
22093 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If IN ", 18);
22094 0 : break;
22095 :
22096 0 : case M2Quads_IfNotInOp:
22097 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If NOT IN ", 18);
22098 0 : break;
22099 :
22100 0 : case M2Quads_IfNotEquOp:
22101 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If <> ", 18);
22102 0 : break;
22103 :
22104 0 : case M2Quads_IfEquOp:
22105 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If = ", 18);
22106 0 : break;
22107 :
22108 0 : case M2Quads_IfLessEquOp:
22109 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If <= ", 18);
22110 0 : break;
22111 :
22112 0 : case M2Quads_IfGreEquOp:
22113 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If >= ", 18);
22114 0 : break;
22115 :
22116 0 : case M2Quads_IfGreOp:
22117 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If > ", 18);
22118 0 : break;
22119 :
22120 0 : case M2Quads_IfLessOp:
22121 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "If < ", 18);
22122 0 : break;
22123 :
22124 0 : case M2Quads_GotoOp:
22125 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Goto ", 18);
22126 0 : break;
22127 :
22128 0 : case M2Quads_DummyOp:
22129 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Dummy ", 18);
22130 0 : break;
22131 :
22132 0 : case M2Quads_ModuleScopeOp:
22133 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ModuleScopeOp ", 18);
22134 0 : break;
22135 :
22136 0 : case M2Quads_StartDefFileOp:
22137 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StartDefFile ", 18);
22138 0 : break;
22139 :
22140 0 : case M2Quads_StartModFileOp:
22141 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StartModFile ", 18);
22142 0 : break;
22143 :
22144 0 : case M2Quads_EndFileOp:
22145 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "EndFileOp ", 18);
22146 0 : break;
22147 :
22148 0 : case M2Quads_InitStartOp:
22149 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitStart ", 18);
22150 0 : break;
22151 :
22152 0 : case M2Quads_InitEndOp:
22153 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "InitEnd ", 18);
22154 0 : break;
22155 :
22156 0 : case M2Quads_FinallyStartOp:
22157 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FinallyStart ", 18);
22158 0 : break;
22159 :
22160 0 : case M2Quads_FinallyEndOp:
22161 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FinallyEnd ", 18);
22162 0 : break;
22163 :
22164 0 : case M2Quads_RetryOp:
22165 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Retry ", 18);
22166 0 : break;
22167 :
22168 0 : case M2Quads_TryOp:
22169 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Try ", 18);
22170 0 : break;
22171 :
22172 0 : case M2Quads_ThrowOp:
22173 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Throw ", 18);
22174 0 : break;
22175 :
22176 0 : case M2Quads_CatchBeginOp:
22177 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CatchBegin ", 18);
22178 0 : break;
22179 :
22180 0 : case M2Quads_CatchEndOp:
22181 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CatchEnd ", 18);
22182 0 : break;
22183 :
22184 0 : case M2Quads_AddOp:
22185 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "+ ", 18);
22186 0 : break;
22187 :
22188 0 : case M2Quads_SubOp:
22189 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "- ", 18);
22190 0 : break;
22191 :
22192 0 : case M2Quads_DivM2Op:
22193 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV M2 ", 18);
22194 0 : break;
22195 :
22196 0 : case M2Quads_ModM2Op:
22197 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD M2 ", 18);
22198 0 : break;
22199 :
22200 0 : case M2Quads_DivCeilOp:
22201 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV ceil ", 18);
22202 0 : break;
22203 :
22204 0 : case M2Quads_ModCeilOp:
22205 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD ceil ", 18);
22206 0 : break;
22207 :
22208 0 : case M2Quads_DivFloorOp:
22209 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV floor ", 18);
22210 0 : break;
22211 :
22212 0 : case M2Quads_ModFloorOp:
22213 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD floor ", 18);
22214 0 : break;
22215 :
22216 0 : case M2Quads_DivTruncOp:
22217 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "DIV trunc ", 18);
22218 0 : break;
22219 :
22220 0 : case M2Quads_ModTruncOp:
22221 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "MOD trunc ", 18);
22222 0 : break;
22223 :
22224 0 : case M2Quads_MultOp:
22225 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "* ", 18);
22226 0 : break;
22227 :
22228 0 : case M2Quads_NegateOp:
22229 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Negate ", 18);
22230 0 : break;
22231 :
22232 0 : case M2Quads_InclOp:
22233 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Incl ", 18);
22234 0 : break;
22235 :
22236 0 : case M2Quads_ExclOp:
22237 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Excl ", 18);
22238 0 : break;
22239 :
22240 0 : case M2Quads_ReturnOp:
22241 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Return ", 18);
22242 0 : break;
22243 :
22244 0 : case M2Quads_ReturnValueOp:
22245 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ReturnValue ", 18);
22246 0 : break;
22247 :
22248 0 : case M2Quads_FunctValueOp:
22249 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "FunctValue ", 18);
22250 0 : break;
22251 :
22252 0 : case M2Quads_CallOp:
22253 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Call ", 18);
22254 0 : break;
22255 :
22256 0 : case M2Quads_ParamOp:
22257 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Param ", 18);
22258 0 : break;
22259 :
22260 0 : case M2Quads_OptParamOp:
22261 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptParam ", 18);
22262 0 : break;
22263 :
22264 0 : case M2Quads_NewLocalVarOp:
22265 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "NewLocalVar ", 18);
22266 0 : break;
22267 :
22268 0 : case M2Quads_KillLocalVarOp:
22269 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "KillLocalVar ", 18);
22270 0 : break;
22271 :
22272 0 : case M2Quads_ProcedureScopeOp:
22273 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProcedureScope ", 18);
22274 0 : break;
22275 :
22276 0 : case M2Quads_UnboundedOp:
22277 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Unbounded ", 18);
22278 0 : break;
22279 :
22280 0 : case M2Quads_CoerceOp:
22281 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Coerce ", 18);
22282 0 : break;
22283 :
22284 0 : case M2Quads_ConvertOp:
22285 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Convert ", 18);
22286 0 : break;
22287 :
22288 0 : case M2Quads_CastOp:
22289 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Cast ", 18);
22290 0 : break;
22291 :
22292 0 : case M2Quads_HighOp:
22293 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "High ", 18);
22294 0 : break;
22295 :
22296 0 : case M2Quads_CodeOnOp:
22297 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CodeOn ", 18);
22298 0 : break;
22299 :
22300 0 : case M2Quads_CodeOffOp:
22301 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "CodeOff ", 18);
22302 0 : break;
22303 :
22304 0 : case M2Quads_ProfileOnOp:
22305 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProfileOn ", 18);
22306 0 : break;
22307 :
22308 0 : case M2Quads_ProfileOffOp:
22309 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "ProfileOff ", 18);
22310 0 : break;
22311 :
22312 0 : case M2Quads_OptimizeOnOp:
22313 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptimizeOn ", 18);
22314 0 : break;
22315 :
22316 0 : case M2Quads_OptimizeOffOp:
22317 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "OptimizeOff ", 18);
22318 0 : break;
22319 :
22320 0 : case M2Quads_InlineOp:
22321 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Inline ", 18);
22322 0 : break;
22323 :
22324 0 : case M2Quads_StatementNoteOp:
22325 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StatementNote ", 18);
22326 0 : break;
22327 :
22328 0 : case M2Quads_LineNumberOp:
22329 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "LineNumber ", 18);
22330 0 : break;
22331 :
22332 0 : case M2Quads_BuiltinConstOp:
22333 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "BuiltinConst ", 18);
22334 0 : break;
22335 :
22336 0 : case M2Quads_BuiltinTypeInfoOp:
22337 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "BuiltinTypeInfo ", 18);
22338 0 : break;
22339 :
22340 0 : case M2Quads_StandardFunctionOp:
22341 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StandardFunction ", 18);
22342 0 : break;
22343 :
22344 0 : case M2Quads_SavePriorityOp:
22345 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SavePriority ", 18);
22346 0 : break;
22347 :
22348 0 : case M2Quads_RestorePriorityOp:
22349 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RestorePriority ", 18);
22350 0 : break;
22351 :
22352 0 : case M2Quads_RangeCheckOp:
22353 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RangeCheck ", 18);
22354 0 : break;
22355 :
22356 0 : case M2Quads_ErrorOp:
22357 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "Error ", 18);
22358 0 : break;
22359 :
22360 0 : case M2Quads_SaveExceptionOp:
22361 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SaveException ", 18);
22362 0 : break;
22363 :
22364 0 : case M2Quads_RestoreExceptionOp:
22365 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "RestoreException ", 18);
22366 0 : break;
22367 :
22368 0 : case M2Quads_StringConvertCnulOp:
22369 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringConvertCnul ", 18);
22370 0 : break;
22371 :
22372 0 : case M2Quads_StringConvertM2nulOp:
22373 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringConvertM2nul", 18);
22374 0 : break;
22375 :
22376 0 : case M2Quads_StringLengthOp:
22377 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "StringLength ", 18);
22378 0 : break;
22379 :
22380 0 : case M2Quads_SubrangeHighOp:
22381 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SubrangeHigh ", 18);
22382 0 : break;
22383 :
22384 0 : case M2Quads_SubrangeLowOp:
22385 0 : M2Printf_fprintf0 (M2LangDump_GetDumpFile (), (const char *) "SubrangeLow ", 18);
22386 0 : break;
22387 :
22388 :
22389 0 : default:
22390 0 : M2Error_InternalError ((const char *) "operator not expected", 21);
22391 0 : break;
22392 : }
22393 0 : }
22394 :
22395 :
22396 : /*
22397 : PushAutoOn - push the auto flag and then set it to TRUE.
22398 : Any call to ident in the parser will result in the token being pushed.
22399 : */
22400 :
22401 64259014 : extern "C" void M2Quads_PushAutoOn (void)
22402 : {
22403 64259014 : M2StackWord_PushWord (AutoStack, static_cast<unsigned int> (IsAutoOn));
22404 64259014 : IsAutoOn = true;
22405 64259014 : }
22406 :
22407 :
22408 : /*
22409 : PushAutoOff - push the auto flag and then set it to FALSE.
22410 : */
22411 :
22412 120356650 : extern "C" void M2Quads_PushAutoOff (void)
22413 : {
22414 120356650 : M2StackWord_PushWord (AutoStack, static_cast<unsigned int> (IsAutoOn));
22415 120356650 : IsAutoOn = false;
22416 120356650 : }
22417 :
22418 :
22419 : /*
22420 : IsAutoPushOn - returns the value of the current Auto ident push flag.
22421 : */
22422 :
22423 575375766 : extern "C" bool M2Quads_IsAutoPushOn (void)
22424 : {
22425 575375766 : return IsAutoOn;
22426 : /* static analysis guarentees a RETURN statement will be used before here. */
22427 : __builtin_unreachable ();
22428 : }
22429 :
22430 :
22431 : /*
22432 : PopAuto - restores the previous value of the Auto flag.
22433 : */
22434 :
22435 184590820 : extern "C" void M2Quads_PopAuto (void)
22436 : {
22437 184590820 : IsAutoOn = static_cast<bool> (M2StackWord_PopWord (AutoStack));
22438 184590820 : }
22439 :
22440 :
22441 : /*
22442 : MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
22443 : */
22444 :
22445 540923 : extern "C" bool M2Quads_MustCheckOverflow (unsigned int q)
22446 : {
22447 540923 : M2Quads_QuadFrame f;
22448 :
22449 540923 : f = GetQF (q);
22450 540923 : return f->CheckOverflow;
22451 : /* static analysis guarentees a RETURN statement will be used before here. */
22452 : __builtin_unreachable ();
22453 : }
22454 :
22455 :
22456 : /*
22457 : PushInConstExpression - push the InConstExpression flag and then set it to TRUE.
22458 : */
22459 :
22460 1251990 : extern "C" void M2Quads_PushInConstExpression (void)
22461 : {
22462 1251990 : M2StackWord_PushWord (ConstExprStack, static_cast<unsigned int> (InConstExpression));
22463 1251990 : InConstExpression = true;
22464 1251990 : }
22465 :
22466 :
22467 : /*
22468 : PopInConstExpression - restores the previous value of the InConstExpression.
22469 : */
22470 :
22471 1251966 : extern "C" void M2Quads_PopInConstExpression (void)
22472 : {
22473 1251966 : InConstExpression = static_cast<bool> (M2StackWord_PopWord (ConstExprStack));
22474 1251966 : }
22475 :
22476 :
22477 : /*
22478 : IsInConstExpression - returns the value of the InConstExpression.
22479 : */
22480 :
22481 98110 : extern "C" bool M2Quads_IsInConstExpression (void)
22482 : {
22483 98110 : return InConstExpression;
22484 : /* static analysis guarentees a RETURN statement will be used before here. */
22485 : __builtin_unreachable ();
22486 : }
22487 :
22488 :
22489 : /*
22490 : PushInConstParameters - push the InConstParameters flag and then set it to TRUE.
22491 : */
22492 :
22493 1797 : extern "C" void M2Quads_PushInConstParameters (void)
22494 : {
22495 1797 : M2StackWord_PushWord (ConstParamStack, static_cast<unsigned int> (InConstParameters));
22496 1797 : InConstParameters = true;
22497 1797 : }
22498 :
22499 :
22500 : /*
22501 : PopInConstParameters - restores the previous value of the InConstParameters.
22502 : */
22503 :
22504 1797 : extern "C" void M2Quads_PopInConstParameters (void)
22505 : {
22506 1797 : InConstParameters = static_cast<bool> (M2StackWord_PopWord (ConstParamStack));
22507 1797 : }
22508 :
22509 :
22510 : /*
22511 : IsInConstParameters - returns the value of the InConstParameters.
22512 : */
22513 :
22514 93325 : extern "C" bool M2Quads_IsInConstParameters (void)
22515 : {
22516 93325 : return InConstParameters;
22517 : /* static analysis guarentees a RETURN statement will be used before here. */
22518 : __builtin_unreachable ();
22519 : }
22520 :
22521 :
22522 : /*
22523 : BuildAsmElement - the stack is expected to contain:
22524 :
22525 :
22526 : Entry Exit
22527 : ===== ====
22528 :
22529 : Ptr ->
22530 : +------------------+
22531 : | expr | tokpos |
22532 : |------------------|
22533 : | str |
22534 : |------------------|
22535 : | name |
22536 : |------------------| +------------------+
22537 : | CurrentInterface | | CurrentInterface |
22538 : |------------------| |------------------|
22539 : | CurrentAsm | | CurrentAsm |
22540 : |------------------| |------------------|
22541 : | n | | n |
22542 : |------------------| |------------------|
22543 : */
22544 :
22545 33 : extern "C" void M2Quads_BuildAsmElement (bool input, bool output)
22546 : {
22547 33 : DynamicStrings_String s;
22548 33 : unsigned int n;
22549 33 : unsigned int str;
22550 33 : unsigned int expr;
22551 33 : unsigned int tokpos;
22552 33 : unsigned int CurrentInterface;
22553 33 : unsigned int CurrentAsm;
22554 33 : unsigned int name;
22555 :
22556 33 : M2Quads_PopTtok (&expr, &tokpos);
22557 33 : M2Quads_PopT (&str);
22558 33 : M2Quads_PopT (&name);
22559 33 : M2Quads_PopT (&CurrentInterface);
22560 33 : M2Quads_PopT (&CurrentAsm);
22561 66 : M2Debug_Assert ((SymbolTable_IsGnuAsm (CurrentAsm)) || (SymbolTable_IsGnuAsmVolatile (CurrentAsm)));
22562 33 : M2Quads_PopT (&n);
22563 33 : n += 1;
22564 33 : if (CurrentInterface == SymbolTable_NulSym)
22565 : {
22566 30 : CurrentInterface = SymbolTable_MakeRegInterface ();
22567 : }
22568 33 : if (input)
22569 : {
22570 18 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, name, str, expr, NextQuad, 0);
22571 18 : if (DebugAsmTokPos)
22572 : {
22573 : s = DynamicStrings_InitString ((const char *) "input expression", 16);
22574 : M2Error_WarnStringAt (s, tokpos);
22575 : }
22576 : }
22577 33 : if (output)
22578 : {
22579 15 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, name, str, expr, 0, NextQuad);
22580 15 : if (DebugAsmTokPos)
22581 : {
22582 : s = DynamicStrings_InitString ((const char *) "output expression", 17);
22583 : M2Error_WarnStringAt (s, tokpos);
22584 : }
22585 : }
22586 33 : M2Quads_PushT (n);
22587 33 : M2Quads_PushT (CurrentAsm);
22588 33 : M2Quads_PushT (CurrentInterface);
22589 33 : }
22590 :
22591 :
22592 : /*
22593 : BuildAsmTrash - the stack is expected to contain:
22594 :
22595 :
22596 : Entry Exit
22597 : ===== ====
22598 :
22599 : Ptr ->
22600 : +------------------+
22601 : | expr | tokpos |
22602 : |------------------| +------------------+
22603 : | CurrentInterface | | CurrentInterface |
22604 : |------------------| |------------------|
22605 : | CurrentAsm | | CurrentAsm |
22606 : |------------------| |------------------|
22607 : | n | | n |
22608 : |------------------| |------------------|
22609 : */
22610 :
22611 3 : extern "C" void M2Quads_BuildAsmTrash (void)
22612 : {
22613 3 : unsigned int n;
22614 3 : unsigned int expr;
22615 3 : unsigned int tokpos;
22616 3 : unsigned int CurrentInterface;
22617 3 : unsigned int CurrentAsm;
22618 :
22619 3 : M2Quads_PopTtok (&expr, &tokpos);
22620 3 : M2Quads_PopT (&CurrentInterface);
22621 3 : M2Quads_PopT (&CurrentAsm);
22622 6 : M2Debug_Assert ((SymbolTable_IsGnuAsm (CurrentAsm)) || (SymbolTable_IsGnuAsmVolatile (CurrentAsm)));
22623 3 : M2Quads_PopT (&n);
22624 3 : n += 1;
22625 3 : if (CurrentInterface == SymbolTable_NulSym)
22626 : {
22627 3 : CurrentInterface = SymbolTable_MakeRegInterface ();
22628 : }
22629 3 : SymbolTable_PutRegInterface (tokpos, CurrentInterface, n, NameKey_NulName, SymbolTable_NulSym, expr, 0, NextQuad);
22630 3 : M2Quads_PushT (n);
22631 3 : M2Quads_PushT (CurrentAsm);
22632 3 : M2Quads_PushT (CurrentInterface);
22633 3 : }
22634 :
22635 :
22636 : /*
22637 : GetQuadTrash - return the symbol associated with the trashed operand.
22638 : */
22639 :
22640 268 : extern "C" unsigned int M2Quads_GetQuadTrash (unsigned int quad)
22641 : {
22642 268 : M2Quads_QuadFrame f;
22643 :
22644 268 : f = GetQF (quad);
22645 268 : LastQuadNo = quad;
22646 268 : return f->Trash;
22647 : /* static analysis guarentees a RETURN statement will be used before here. */
22648 : __builtin_unreachable ();
22649 : }
22650 :
22651 15451 : extern "C" void _M2_M2Quads_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
22652 : {
22653 15451 : Init ();
22654 15451 : }
22655 :
22656 0 : extern "C" void _M2_M2Quads_fini (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
22657 : {
22658 0 : }
|
