Line data Source code
1 : /* do not edit automatically generated by mc from P2SymBuild. */
2 : /* P2SymBuild.mod pass 2 symbol creation.
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 : #if defined(__cplusplus)
43 : # undef NULL
44 : # define NULL 0
45 : #endif
46 : #define _P2SymBuild_C
47 :
48 : #include "GP2SymBuild.h"
49 : # include "Glibc.h"
50 : # include "GNameKey.h"
51 : # include "GStrLib.h"
52 : # include "GM2Debug.h"
53 : # include "GM2LexBuf.h"
54 : # include "GM2Error.h"
55 : # include "GDynamicStrings.h"
56 : # include "GFormatStrings.h"
57 : # include "GM2Printf.h"
58 : # include "GM2StackWord.h"
59 : # include "GM2Options.h"
60 : # include "GStrIO.h"
61 : # include "GM2Base.h"
62 : # include "GStorage.h"
63 : # include "Ggcctypes.h"
64 : # include "GM2Reserved.h"
65 : # include "GM2MetaError.h"
66 : # include "GFifoQueue.h"
67 : # include "GSymbolTable.h"
68 : # include "GM2Batch.h"
69 : # include "GM2Quads.h"
70 : # include "GM2Comp.h"
71 : # include "GM2Const.h"
72 : # include "GM2Students.h"
73 :
74 : # define Debugging false
75 : static unsigned int alignTypeNo;
76 : static unsigned int castType;
77 : static M2Const_constType type;
78 : static unsigned int RememberedConstant;
79 : static M2StackWord_StackOfWord RememberStack;
80 : static M2StackWord_StackOfWord TypeStack;
81 : static unsigned int curModuleSym;
82 : static unsigned int curBeginTok;
83 : static unsigned int curFinallyTok;
84 : static unsigned int curStartTok;
85 : static unsigned int curEndTok;
86 : static M2StackWord_StackOfWord BlockStack;
87 :
88 : /*
89 : BlockStart - tokno is the module/procedure/implementation/definition token
90 : */
91 :
92 : extern "C" void P2SymBuild_BlockStart (unsigned int tokno);
93 :
94 : /*
95 : BlockEnd - declare module ctor/init/fini/dep procedures.
96 : */
97 :
98 : extern "C" void P2SymBuild_BlockEnd (unsigned int tokno);
99 :
100 : /*
101 : BlockBegin - assign curBeginTok to tokno.
102 : */
103 :
104 : extern "C" void P2SymBuild_BlockBegin (unsigned int tokno);
105 :
106 : /*
107 : BlockFinally - assign curFinallyTok to tokno.
108 : */
109 :
110 : extern "C" void P2SymBuild_BlockFinally (unsigned int tokno);
111 : extern "C" void P2SymBuild_P2StartBuildDefModule (void);
112 : extern "C" void P2SymBuild_P2EndBuildDefModule (void);
113 : extern "C" void P2SymBuild_P2StartBuildImplementationModule (void);
114 : extern "C" void P2SymBuild_P2EndBuildImplementationModule (void);
115 : extern "C" void P2SymBuild_P2StartBuildProgramModule (void);
116 : extern "C" void P2SymBuild_P2EndBuildProgramModule (void);
117 :
118 : /*
119 : StartBuildInnerModule - Creates an Inner module and starts
120 : a new scope.
121 :
122 : The Stack is expected:
123 :
124 : Entry Exit
125 :
126 : Ptr -> <- Ptr
127 : +------------+ +-----------+
128 : | NameStart | | NameStart |
129 : |------------| |-----------|
130 :
131 : */
132 :
133 : extern "C" void P2SymBuild_StartBuildInnerModule (void);
134 :
135 : /*
136 : EndBuildInnerModule - Destroys the Inner module scope and
137 : checks for correct name.
138 :
139 : The Stack is expected:
140 :
141 : Entry Exit
142 :
143 : Ptr ->
144 : +------------+ +-----------+
145 : | NameEnd | | |
146 : |------------| |-----------|
147 : | NameStart | | | <- Ptr
148 : |------------| |-----------|
149 : */
150 :
151 : extern "C" void P2SymBuild_EndBuildInnerModule (void);
152 :
153 : /*
154 : BuildImportOuterModule - Builds imported identifiers into an outer module
155 : from a definition module.
156 :
157 : The Stack is expected:
158 :
159 : Entry OR Entry
160 :
161 : Ptr -> Ptr ->
162 : +------------+ +-----------+
163 : | # | | # |
164 : |------------| |-----------|
165 : | Id1 | | Id1 |
166 : |------------| |-----------|
167 : . . . .
168 : . . . .
169 : . . . .
170 : |------------| |-----------|
171 : | Id# | | Id# |
172 : |------------| |-----------|
173 : | ImportTok | | Ident |
174 : |------------| |-----------|
175 :
176 : IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
177 :
178 :
179 : Exit
180 :
181 : All above stack discarded
182 : */
183 :
184 : extern "C" void P2SymBuild_BuildImportOuterModule (void);
185 :
186 : /*
187 : BuildExportOuterModule - Builds exported identifiers from an outer module
188 : to the outside world of library modules.
189 :
190 : The Stack is expected:
191 :
192 : Entry OR Entry
193 :
194 : Ptr -> Ptr ->
195 : +------------+ +--------------+
196 : | # | | # |
197 : |------------| |--------------|
198 : | Id1 | | Id1 |
199 : |------------| |--------------|
200 : . . . .
201 : . . . .
202 : . . . .
203 : |------------| |--------------|
204 : | Id# | | Id# |
205 : |------------| |--------------|
206 : | ExportTok | | QualifiedTok |
207 : |------------| |--------------|
208 :
209 : EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
210 :
211 : Error Condition
212 :
213 :
214 : Exit
215 :
216 : All above stack discarded
217 : */
218 :
219 : extern "C" void P2SymBuild_BuildExportOuterModule (void);
220 :
221 : /*
222 : BuildImportInnerModule - Builds imported identifiers into an inner module
223 : from the last level of module.
224 :
225 : The Stack is expected:
226 :
227 : Entry OR Entry
228 :
229 : Ptr -> Ptr ->
230 : +------------+ +-----------+
231 : | # | | # |
232 : |------------| |-----------|
233 : | Id1 | | Id1 |
234 : |------------| |-----------|
235 : . . . .
236 : . . . .
237 : . . . .
238 : |------------| |-----------|
239 : | Id# | | Id# |
240 : |------------| |-----------|
241 : | ImportTok | | Ident |
242 : |------------| |-----------|
243 :
244 : IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
245 :
246 : Exit
247 :
248 : All above stack discarded
249 : */
250 :
251 : extern "C" void P2SymBuild_BuildImportInnerModule (void);
252 :
253 : /*
254 : BuildExportInnerModule - Builds exported identifiers from an inner module
255 : to the next layer module.
256 :
257 : The Stack is expected:
258 :
259 : Entry OR Entry
260 :
261 : Ptr -> Ptr ->
262 : +------------+ +--------------+
263 : | # | | # |
264 : |------------| |--------------|
265 : | Id1 | | Id1 |
266 : |------------| |--------------|
267 : . . . .
268 : . . . .
269 : . . . .
270 : |------------| |--------------|
271 : | Id# | | Id# |
272 : |------------| |--------------|
273 : | ExportTok | | QualifiedTok |
274 : |------------| |--------------|
275 :
276 : EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
277 :
278 :
279 : Exit
280 :
281 : All above stack discarded
282 : */
283 :
284 : extern "C" void P2SymBuild_BuildExportInnerModule (void);
285 :
286 : /*
287 : BuildNumber - Converts a number into a symbol.
288 :
289 :
290 : Stack
291 :
292 : Entry Exit
293 :
294 : Ptr -> <- Ptr
295 : +------------+ +-------------------+
296 : | Name | tok | | Sym | Type | tok |
297 : |------------+ |-------------------|
298 : */
299 :
300 : extern "C" void P2SymBuild_BuildNumber (void);
301 :
302 : /*
303 : BuildString - Converts a string into a symbol.
304 :
305 :
306 : Stack
307 :
308 : Entry Exit
309 :
310 : Ptr -> <- Ptr
311 : +-------------+ +--------------------+
312 : | Name | | tok| | Sym | NulSym | tok |
313 : |-------------+ |--------------------|
314 : */
315 :
316 : extern "C" void P2SymBuild_BuildString (void);
317 :
318 : /*
319 : BuildConst - builds a constant.
320 : Stack
321 :
322 : Entry Exit
323 :
324 : Ptr ->
325 : +------------+
326 : | Name |
327 : |------------+ <- Ptr
328 : */
329 :
330 : extern "C" void P2SymBuild_BuildConst (void);
331 :
332 : /*
333 : StartBuildEnumeration - Builds an Enumeration type Type.
334 :
335 :
336 : Stack
337 :
338 : Entry Exit
339 :
340 : Ptr ->
341 : +------------+
342 : | # |
343 : |------------|
344 : | en 1 |
345 : |------------|
346 : | en 2 |
347 : |------------|
348 : . .
349 : . .
350 : . . <- Ptr
351 : |------------| +------------+
352 : | en # | | Type |
353 : |------------| |------------|
354 : | Name | | Name |
355 : |------------| |------------|
356 : */
357 :
358 : extern "C" void P2SymBuild_StartBuildEnumeration (void);
359 :
360 : /*
361 : BuildSubrange - Builds a Subrange type Symbol, the base type can also be
362 : supplied if known.
363 :
364 : Stack
365 :
366 : Entry Exit
367 :
368 :
369 : <- Ptr
370 : +------------+
371 : Ptr -> | Type |
372 : +------------+ |------------|
373 : | Name | | Name |
374 : |------------| |------------|
375 : */
376 :
377 : extern "C" void P2SymBuild_BuildSubrange (unsigned int tok, unsigned int Base);
378 :
379 : /*
380 : BuildAligned - builds an alignment constant symbol which is placed onto
381 : the stack. It expects the ident ALIGNED to be on the
382 : stack.
383 :
384 : Stack
385 :
386 : Entry Exit
387 :
388 :
389 : Ptr -> <- Ptr
390 : +---------------+ +-----------------+
391 : | bytealignment | | AlignmentConst |
392 : +---------------+ |-----------------|
393 : */
394 :
395 : extern "C" void P2SymBuild_BuildAligned (void);
396 :
397 : /*
398 : BuildVarAlignment - the AlignmentConst is either a temporary or NulSym.
399 : A type may only have one alignment value and
400 : error checking is performed.
401 :
402 : Stack
403 :
404 : Entry Exit
405 :
406 :
407 : Ptr ->
408 : +-----------------+
409 : | AlignmentConst | <- Ptr
410 : |-----------------| +------------------+
411 : | Type | | Type | TypeName |
412 : |-----------------| |------------------|
413 : */
414 :
415 : extern "C" void P2SymBuild_BuildVarAlignment (void);
416 :
417 : /*
418 : BuildTypeAlignment - the AlignmentConst is either a temporary or NulSym.
419 : In the case of NulSym it is popped from the stack
420 : and the procedure returns. Otherwise the temporary
421 : is popped and recorded as the alignment value for this
422 : type. A type may only have one alignment value and
423 : error checking is performed.
424 :
425 : Stack
426 :
427 : Entry Exit
428 :
429 :
430 : Ptr ->
431 : +-----------------+
432 : | AlignmentConst |
433 : |-----------------|
434 : | Type | Empty
435 : |-----------------|
436 : */
437 :
438 : extern "C" void P2SymBuild_BuildTypeAlignment (void);
439 : extern "C" void P2SymBuild_P2BuildDefaultFieldAlignment (void);
440 :
441 : /*
442 : BuildPragmaConst - pushes a constant to the stack and stores it away into the
443 : const fifo queue ready for pass 3.
444 : */
445 :
446 : extern "C" void P2SymBuild_BuildPragmaConst (void);
447 :
448 : /*
449 : BuildVariable - Builds variables listed in an IdentList with a Type.
450 :
451 : Stack
452 :
453 : Entry Exit
454 :
455 : Ptr ->
456 : +------------+ +------------+
457 : | Type | Name| | |
458 : |------------| |------------|
459 : | # | | |
460 : |------------| |------------|
461 : | Ident 1 | | |
462 : |------------| |------------|
463 : | Ident 2 | | |
464 : |------------| |------------|
465 : . . . .
466 : . . . .
467 : . . . .
468 : |------------| |------------|
469 : | Ident # | | | <- Ptr
470 : |------------| |------------|
471 :
472 : Empty
473 : */
474 :
475 : extern "C" void P2SymBuild_BuildVariable (void);
476 :
477 : /*
478 : BuildType - Builds a Type.
479 :
480 :
481 : Stack
482 :
483 : Entry Exit
484 :
485 : Ptr ->
486 : +------------+
487 : | Type | <- Ptr
488 : |------------| +---------------+
489 : | Name | | Type | Name |
490 : |------------| |---------------|
491 :
492 : Empty
493 : */
494 :
495 : extern "C" void P2SymBuild_BuildType (void);
496 :
497 : /*
498 : StartBuildFormalParameters - Initialises the quadruple stack for
499 : Formal Parameters.
500 :
501 : The Stack:
502 :
503 : Entry Exit
504 :
505 : <- Ptr
506 : +------------+
507 : Empty | 0 |
508 : |------------|
509 : */
510 :
511 : extern "C" void P2SymBuild_StartBuildFormalParameters (void);
512 :
513 : /*
514 : EndBuildFormalParameters - Resets the quadruple stack after building
515 : Formal Parameters.
516 :
517 : The Stack:
518 :
519 : Entry Exit
520 :
521 : Ptr ->
522 : +------------+
523 : | NoOfParam | <- Ptr
524 : |------------| +------------+
525 : | ProcSym | | ProcSym |
526 : |------------| |------------|
527 : */
528 :
529 : extern "C" void P2SymBuild_EndBuildFormalParameters (void);
530 :
531 : /*
532 : BuildProcedureHeading - Builds a procedure heading for the definition
533 : module procedures.
534 :
535 : Operation only performed if compiling a
536 : definition module.
537 :
538 : The Stack:
539 :
540 : Entry Exit
541 :
542 : Ptr ->
543 : +------------+
544 : | ProcSym |
545 : |------------|
546 : | NameStart |
547 : |------------|
548 : Empty
549 :
550 : */
551 :
552 : extern "C" void P2SymBuild_BuildProcedureHeading (void);
553 :
554 : /*
555 : BuildFunction - Builds a procedures return type.
556 : Procedure becomes a function.
557 :
558 : The Stack:
559 :
560 : Entry Exit
561 :
562 : Ptr ->
563 : +------------+
564 : | TypeSym | <- Ptr
565 : |------------| +------------+
566 : | ProcSym | | ProcSym |
567 : |------------| |------------|
568 : */
569 :
570 : extern "C" void P2SymBuild_BuildFunction (void);
571 :
572 : /*
573 : BuildOptFunction - Builds a procedures optional return type.
574 : Procedure becomes a function and the user
575 : can either call it as a function or a procedure.
576 :
577 : The Stack:
578 :
579 : Entry Exit
580 :
581 : Ptr ->
582 : +------------+
583 : | TypeSym | <- Ptr
584 : |------------| +------------+
585 : | ProcSym | | ProcSym |
586 : |------------| |------------|
587 : */
588 :
589 : extern "C" void P2SymBuild_BuildOptFunction (void);
590 :
591 : /*
592 : BuildFPSection - Builds a Formal Parameter in a procedure.
593 :
594 : The Stack:
595 :
596 : Entry Exit
597 :
598 : Ptr ->
599 : +------------+
600 : | ParamTotal |
601 : |------------|
602 : | TypeSym |
603 : |------------|
604 : | Array/Nul |
605 : |------------|
606 : | NoOfIds |
607 : |------------|
608 : | Id 1 |
609 : |------------|
610 : . .
611 : . .
612 : . .
613 : |------------|
614 : | Id n | <- Ptr
615 : |------------| +------------+
616 : | Var / Nul | | ParamTotal |
617 : |------------| |------------|
618 : | ProcSym | | ProcSym |
619 : |------------| |------------|
620 : */
621 :
622 : extern "C" void P2SymBuild_BuildFPSection (void);
623 :
624 : /*
625 : BuildVarArgs - indicates that the ProcSym takes varargs
626 : after ParamTotal.
627 : <- Ptr
628 : +------------+ +------------+
629 : | ParamTotal | | ParamTotal |
630 : |------------| |------------|
631 : | ProcSym | | ProcSym |
632 : |------------| |------------|
633 :
634 : */
635 :
636 : extern "C" void P2SymBuild_BuildVarArgs (void);
637 :
638 : /*
639 : BuildFormalVarArgs - indicates that the procedure type takes varargs.
640 :
641 : <- Ptr
642 : +------------+ +------------+
643 : | ProcSym | | ProcSym |
644 : |------------| |------------|
645 :
646 : */
647 :
648 : extern "C" void P2SymBuild_BuildFormalVarArgs (void);
649 :
650 : /*
651 : BuildOptArg - indicates that the ProcSym takes a single optarg
652 : after ParamTotal.
653 :
654 : <- Ptr
655 : +------------+ +------------+
656 : | ParamTotal | | ParamTotal |
657 : |------------| |------------|
658 : | ProcSym | | ProcSym |
659 : |------------| |------------|
660 : */
661 :
662 : extern "C" void P2SymBuild_BuildOptArg (void);
663 :
664 : /*
665 : StartBuildProcedure - Builds a Procedure.
666 :
667 : The Stack:
668 :
669 : Entry Exit
670 :
671 : <- Ptr
672 : +------------+
673 : Ptr -> | ProcSym |
674 : +------------+ |------------|
675 : | Name | | Name |
676 : |------------| |------------|
677 : */
678 :
679 : extern "C" void P2SymBuild_StartBuildProcedure (void);
680 :
681 : /*
682 : EndBuildProcedure - Ends building a Procedure.
683 : It checks the start procedure name matches the end
684 : procedure name.
685 :
686 : The Stack:
687 :
688 : (Procedure Not Defined in definition module)
689 :
690 : Entry Exit
691 :
692 : Ptr ->
693 : +------------+
694 : | NameEnd |
695 : |------------|
696 : | ProcSym |
697 : |------------|
698 : | NameStart |
699 : |------------|
700 : Empty
701 : */
702 :
703 : extern "C" void P2SymBuild_EndBuildProcedure (void);
704 :
705 : /*
706 : EndBuildForward - ends building a forward procedure.
707 : */
708 :
709 : extern "C" void P2SymBuild_EndBuildForward (void);
710 :
711 : /*
712 : BuildNoReturnAttribute - provide an interface to the symbol table module.
713 : */
714 :
715 : extern "C" void P2SymBuild_BuildNoReturnAttribute (void);
716 :
717 : /*
718 : CheckProcedure - checks to see that the top of stack procedure
719 : has not been declared as a procedure function.
720 :
721 : The Stack:
722 :
723 : Entry Exit
724 :
725 : Ptr -> <- Ptr
726 : +------------+ +------------+
727 : | ProcSym | | ProcSym |
728 : |------------| |------------|
729 : */
730 :
731 : extern "C" void P2SymBuild_CheckProcedure (void);
732 :
733 : /*
734 : BuildPointerType - builds a pointer type.
735 : The Stack:
736 :
737 : Entry Exit
738 : ===== ====
739 :
740 :
741 : Ptr -> <- Ptr
742 : +------------+ +-------------+
743 : | Type | | PointerType |
744 : |------------| |-------------|
745 : | Name | | Name |
746 : |------------| |-------------|
747 : */
748 :
749 : extern "C" void P2SymBuild_BuildPointerType (unsigned int pointerpos);
750 :
751 : /*
752 : BuildSetType - builds a set type.
753 : The Stack:
754 :
755 : Entry Exit
756 : ===== ====
757 :
758 :
759 : Ptr -> <- Ptr
760 : +------------+ +-------------+
761 : | Type | | SetType |
762 : |------------| |-------------|
763 : | Name | | Name |
764 : |------------| |-------------|
765 : */
766 :
767 : extern "C" void P2SymBuild_BuildSetType (unsigned int setpos, bool ispacked);
768 :
769 : /*
770 : BuildRecord - Builds a record type.
771 : The Stack:
772 :
773 : Entry Exit
774 : ===== ====
775 :
776 :
777 : <- Ptr
778 : +-----------+
779 : Ptr -> | RecordSym |
780 : +------------------+ |-----------|
781 : | Name | | Name |
782 : |------------------| |-----------|
783 : */
784 :
785 : extern "C" void P2SymBuild_BuildRecord (void);
786 :
787 : /*
788 : BuildFieldRecord - Builds a field into a record sym.
789 : The Stack:
790 :
791 :
792 : Entry Exit
793 : ===== ====
794 :
795 : Ptr ->
796 : +-------------+
797 : | NoOfPragmas |
798 : |-------------|
799 : | Const1 |
800 : |-------------|
801 : | PragmaName1 |
802 : |-------------|
803 : | Type | Name |
804 : |-------------|
805 : | n |
806 : |-------------|
807 : | Id 1 |
808 : |-------------|
809 : . .
810 : . .
811 : . .
812 : |-------------|
813 : | Id n | <- Ptr
814 : |-------------| +-------------+
815 : | RecordSym | | RecordSym |
816 : |-------------| |-------------|
817 : | RecordName | | RecordName |
818 : |-------------| |-------------|
819 : */
820 :
821 : extern "C" void P2SymBuild_BuildFieldRecord (void);
822 :
823 : /*
824 : StartBuildVarient - Builds a varient symbol on top of a record sym.
825 : The Stack:
826 :
827 :
828 : Entry Exit
829 : ===== ====
830 :
831 : <- Ptr
832 : +-------------+
833 : Ptr -> | VarientSym |
834 : +-------------+ |-------------|
835 : | RecordSym | | RecordSym |
836 : |-------------| |-------------|
837 : | RecordName | | RecordName |
838 : |-------------| |-------------|
839 : */
840 :
841 : extern "C" void P2SymBuild_StartBuildVarient (void);
842 :
843 : /*
844 : EndBuildVarient - Removes the varient symbol from the stack.
845 : The Stack:
846 :
847 : Entry Exit
848 : ===== ====
849 :
850 : Ptr ->
851 : +-------------+
852 : | VarientSym | <- Ptr
853 : |-------------| +-------------+
854 : | RecordSym | | RecordSym |
855 : |-------------| |-------------|
856 : | RecordName | | RecordName |
857 : |-------------| |-------------|
858 : */
859 :
860 : extern "C" void P2SymBuild_EndBuildVarient (void);
861 :
862 : /*
863 : BuildVarientSelector - Builds a field into a record sym.
864 : The Stack:
865 :
866 :
867 : Entry Exit
868 : ===== ====
869 :
870 : Ptr ->
871 : +-------------+
872 : | Type |
873 : |-------------|
874 : | Tag | <- Ptr
875 : |-------------| +-------------+
876 : | RecordSym | | RecordSym |
877 : |-------------| |-------------|
878 : */
879 :
880 : extern "C" void P2SymBuild_BuildVarientSelector (void);
881 :
882 : /*
883 : StartBuildVarientFieldRecord - Builds a varient field into a varient sym.
884 : The Stack:
885 :
886 :
887 : Entry Exit
888 : ===== ====
889 :
890 : <- Ptr
891 : +-------------+
892 : Ptr -> | VarientField|
893 : +-------------+ |-------------|
894 : | VarientSym | | VarientSym |
895 : |-------------| |-------------|
896 : */
897 :
898 : extern "C" void P2SymBuild_StartBuildVarientFieldRecord (void);
899 :
900 : /*
901 : EndBuildVarientFieldRecord - Removes a varient field from the stack.
902 : The Stack:
903 :
904 :
905 : Entry Exit
906 : ===== ====
907 :
908 : Ptr ->
909 : +-------------+
910 : | VarientField| <- Ptr
911 : |-------------| +-------------+
912 : | VarientSym | | VarientSym |
913 : |-------------| |-------------|
914 : */
915 :
916 : extern "C" void P2SymBuild_EndBuildVarientFieldRecord (void);
917 :
918 : /*
919 : BuildNulName - Pushes a NulName onto the top of the stack.
920 : The Stack:
921 :
922 :
923 : Entry Exit
924 :
925 : <- Ptr
926 : Empty +------------+
927 : | NulName |
928 : |------------|
929 : */
930 :
931 : extern "C" void P2SymBuild_BuildNulName (void);
932 :
933 : /*
934 : BuildTypeEnd - Pops the type Type and Name.
935 : The Stack:
936 :
937 :
938 : Entry Exit
939 :
940 :
941 : Ptr ->
942 : +-------------+
943 : | Type | Name | Empty
944 : |-------------|
945 : */
946 :
947 : extern "C" void P2SymBuild_BuildTypeEnd (void);
948 :
949 : /*
950 : StartBuildArray - Builds an array type.
951 : The Stack:
952 :
953 : Entry Exit
954 : ===== ====
955 :
956 : <- Ptr
957 : +-----------+
958 : Ptr -> | ArraySym |
959 : +------------+ |-----------|
960 : | Name | | Name |
961 : |------------| |-----------|
962 : */
963 :
964 : extern "C" void P2SymBuild_StartBuildArray (void);
965 :
966 : /*
967 : EndBuildArray - Builds an array type.
968 : The Stack:
969 :
970 : Entry Exit
971 : ===== ====
972 :
973 : Ptr ->
974 : +------------+
975 : | TypeSym | <- Ptr
976 : |------------| +------------+
977 : | ArraySym | | ArraySym |
978 : |------------| |------------|
979 : | Name | | Name |
980 : |------------| |------------|
981 : */
982 :
983 : extern "C" void P2SymBuild_EndBuildArray (void);
984 :
985 : /*
986 : BuildFieldArray - Builds a field into an array sym.
987 : The Stack:
988 :
989 :
990 : Entry Exit
991 : ===== ====
992 :
993 : Ptr ->
994 : +-------------+
995 : | Type | Name | <- Ptr
996 : |-------------| +-------------+
997 : | ArraySym | | ArraySym |
998 : |-------------| |-------------|
999 : | ArrayName | | ArrayName |
1000 : |-------------| |-------------|
1001 : */
1002 :
1003 : extern "C" void P2SymBuild_BuildFieldArray (void);
1004 :
1005 : /*
1006 : BuildArrayComma - converts ARRAY [..], [..] OF into ARRAY [..] OF ARRAY [..]
1007 :
1008 :
1009 : Ptr -> <- Ptr
1010 : +-------------+ +-------------+
1011 : | ArraySym1 | | ArraySym2 |
1012 : |-------------| |-------------|
1013 : | ArrayName | | ArrayName |
1014 : |-------------| |-------------|
1015 : */
1016 :
1017 : extern "C" void P2SymBuild_BuildArrayComma (void);
1018 :
1019 : /*
1020 : BuildProcedureType - builds a procedure type symbol.
1021 : The Stack:
1022 :
1023 :
1024 : <- Ptr
1025 : +-------------+
1026 : Ptr -> | ProcTypeSym |
1027 : +-------------+ |-------------|
1028 : | Name | | Name |
1029 : |-------------| |-------------|
1030 : */
1031 :
1032 : extern "C" void P2SymBuild_BuildProcedureType (void);
1033 :
1034 : /*
1035 : BuildFormalType - Builds a Formal Parameter in a procedure type.
1036 :
1037 : The Stack:
1038 :
1039 : Entry Exit
1040 :
1041 : Ptr ->
1042 : +------------+
1043 : | TypeSym |
1044 : |------------|
1045 : | Array/Nul |
1046 : |------------|
1047 : | Var / Nul | <- Ptr
1048 : |------------| +--------------+
1049 : | ProcTypeSym| | ProcTypeSym |
1050 : |------------| |--------------|
1051 : */
1052 :
1053 : extern "C" void P2SymBuild_BuildFormalType (void);
1054 :
1055 : /*
1056 : SeenUnknown - sets the operand type to unknown.
1057 : */
1058 :
1059 : extern "C" void P2SymBuild_SeenUnknown (void);
1060 :
1061 : /*
1062 : SeenCast - sets the operand type to cast.
1063 : */
1064 :
1065 : extern "C" void P2SymBuild_SeenCast (unsigned int sym);
1066 :
1067 : /*
1068 : SeenSet - sets the operand type to set.
1069 : */
1070 :
1071 : extern "C" void P2SymBuild_SeenSet (void);
1072 :
1073 : /*
1074 : SeenConstructor - sets the operand type to constructor.
1075 : */
1076 :
1077 : extern "C" void P2SymBuild_SeenConstructor (void);
1078 :
1079 : /*
1080 : SeenArray - sets the operand type to array.
1081 : */
1082 :
1083 : extern "C" void P2SymBuild_SeenArray (void);
1084 :
1085 : /*
1086 : SeenString - sets the operand type to string.
1087 : */
1088 :
1089 : extern "C" void P2SymBuild_SeenString (void);
1090 :
1091 : /*
1092 : SeenBoolean - sets the operand type to a BOOLEAN.
1093 : */
1094 :
1095 : extern "C" void P2SymBuild_SeenBoolean (void);
1096 :
1097 : /*
1098 : SeenZType - sets the operand type to a Z type.
1099 : */
1100 :
1101 : extern "C" void P2SymBuild_SeenZType (void);
1102 :
1103 : /*
1104 : SeenRType - sets the operand type to a R type.
1105 : */
1106 :
1107 : extern "C" void P2SymBuild_SeenRType (void);
1108 :
1109 : /*
1110 : SeenCType - sets the operand type to a C type.
1111 : */
1112 :
1113 : extern "C" void P2SymBuild_SeenCType (void);
1114 :
1115 : /*
1116 : DetermineType - assigns the top of stack symbol with the type of
1117 : constant expression, if known.
1118 : */
1119 :
1120 : extern "C" void P2SymBuild_DetermineType (void);
1121 :
1122 : /*
1123 : PushType -
1124 : */
1125 :
1126 : extern "C" void P2SymBuild_PushType (void);
1127 :
1128 : /*
1129 : PopType -
1130 : */
1131 :
1132 : extern "C" void P2SymBuild_PopType (void);
1133 :
1134 : /*
1135 : PushRememberConstant -
1136 : */
1137 :
1138 : extern "C" void P2SymBuild_PushRememberConstant (void);
1139 :
1140 : /*
1141 : PopRememberConstant -
1142 : */
1143 :
1144 : extern "C" void P2SymBuild_PopRememberConstant (void);
1145 :
1146 : /*
1147 : RememberConstant -
1148 : */
1149 :
1150 : extern "C" void P2SymBuild_RememberConstant (unsigned int sym);
1151 : static void stop (void);
1152 :
1153 : /*
1154 : propageteTokenPosition - if laterTokPos is unknown then return knownTokPos.
1155 : else return laterTokPos.
1156 : */
1157 :
1158 : static unsigned int propageteTokenPosition (unsigned int knownTokPos, unsigned int laterTokPos);
1159 :
1160 : /*
1161 : PushBlock - push the block variables to the block stack.
1162 : */
1163 :
1164 : static void PushBlock (unsigned int tokno);
1165 :
1166 : /*
1167 : PopBlock - pop the block variables from the block stack.
1168 : */
1169 :
1170 : static void PopBlock (void);
1171 :
1172 : /*
1173 : BuildFormalParameterSection - Builds a Formal Parameter in a procedure.
1174 :
1175 : The Stack:
1176 :
1177 : Entry and Exit
1178 :
1179 : Ptr -> <- Ptr
1180 : +------------+
1181 : | ParamTotal |
1182 : |------------|
1183 : | TypeSym |
1184 : |------------|
1185 : | Array/Nul |
1186 : |------------|
1187 : | NoOfIds |
1188 : |------------|
1189 : | Id 1 |
1190 : |------------|
1191 : . .
1192 : . .
1193 : . .
1194 : |------------|
1195 : | Id n |
1196 : |------------|
1197 : | Var / Nul |
1198 : |------------|
1199 : | ProcSym |
1200 : |------------|
1201 : */
1202 :
1203 : static void BuildFormalParameterSection (SymbolTable_ProcedureKind kind);
1204 :
1205 : /*
1206 : CheckFormalParameterSection - Checks a Formal Parameter in a procedure.
1207 : The stack is unaffected.
1208 :
1209 : The Stack:
1210 :
1211 : Entry and Exit
1212 :
1213 : Ptr ->
1214 : +------------+
1215 : | ParamTotal |
1216 : |------------|
1217 : | TypeSym |
1218 : |------------|
1219 : | Array/Nul |
1220 : |------------|
1221 : | NoOfIds |
1222 : |------------|
1223 : | Id 1 |
1224 : |------------|
1225 : . .
1226 : . .
1227 : . .
1228 : |------------|
1229 : | Id n |
1230 : |------------|
1231 : | Var / Nul |
1232 : |------------|
1233 : | ProcSym |
1234 : |------------|
1235 : */
1236 :
1237 : static void CheckFormalParameterSection (SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind);
1238 :
1239 : /*
1240 : RemoveFPParameters - remove the FPSection parameters from the stack and
1241 : increment the param total with the NoOfIds.
1242 :
1243 : The Stack:
1244 :
1245 : Entry Exit
1246 :
1247 : Ptr ->
1248 : +------------+
1249 : | ParamTotal |
1250 : |------------|
1251 : | TypeSym |
1252 : |------------|
1253 : | Array/Nul |
1254 : |------------|
1255 : | NoOfIds |
1256 : |------------|
1257 : | Id 1 |
1258 : |------------|
1259 : . .
1260 : . .
1261 : . .
1262 : |------------|
1263 : | Id n | <- Ptr
1264 : |------------| +------------+
1265 : | Var / Nul | | ParamTotal |
1266 : |------------| |------------|
1267 : | ProcSym | | ProcSym |
1268 : |------------| |------------|
1269 : */
1270 :
1271 : static void RemoveFPParameters (void);
1272 :
1273 : /*
1274 : ParameterError - create two error strings chained together.
1275 : */
1276 :
1277 : static void ParameterError (const char *FmtHeader_, unsigned int _FmtHeader_high, const char *PrevDesc_, unsigned int _PrevDesc_high, const char *CurDesc_, unsigned int _CurDesc_high, unsigned int ParamNo, unsigned int ProcSym, SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind);
1278 :
1279 : /*
1280 : ParameterMismatch - generate a parameter mismatch error between the current
1281 : declaration at tok and a previous ProcSym declaration.
1282 : NoOfPar is the current number of parameters.
1283 : */
1284 :
1285 : static void ParameterMismatch (unsigned int tok, unsigned int ProcSym, unsigned int NoOfPar, SymbolTable_ProcedureKind prevkind, SymbolTable_ProcedureKind curkind);
1286 :
1287 : /*
1288 : GetComparison - return a simple description from the result of
1289 : a comparison between left and right.
1290 : */
1291 :
1292 : static DynamicStrings_String GetComparison (unsigned int left, unsigned int right);
1293 :
1294 : /*
1295 : ReturnTypeMismatch - generate two errors showing the return type mismatches between
1296 : ProcSym and ReturnType at procedure location tok.
1297 : */
1298 :
1299 : static void ReturnTypeMismatch (unsigned int curtok, unsigned int ProcSym, unsigned int CurRetType, unsigned int curtypetok, SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind, unsigned int PrevRetType);
1300 :
1301 : /*
1302 : CheckOptFunction - checks to see whether the optional return value
1303 : has been set before and if it differs it will
1304 : generate an error message. It will set the
1305 : new value to isopt.
1306 : */
1307 :
1308 : static void CheckOptFunction (unsigned int tok, unsigned int sym, SymbolTable_ProcedureKind kind, bool isopt);
1309 :
1310 : /*
1311 : CheckProcedure - checks to see that the top of stack procedure
1312 : has not been declared as a procedure function.
1313 :
1314 : The Stack:
1315 :
1316 : Entry Exit
1317 :
1318 : Ptr -> <- Ptr
1319 : +------------+ +------------+
1320 : | ProcSym | | ProcSym |
1321 : |------------| |------------|
1322 : */
1323 :
1324 : static void CheckProcedureReturn (unsigned int RetType, unsigned int typetok);
1325 :
1326 : /*
1327 : HandleRecordFieldPragmas -
1328 :
1329 : Entry Exit
1330 : ===== ====
1331 :
1332 : Ptr -> <- Ptr
1333 :
1334 : |-------------| |-------------|
1335 : | Const1 | | Const1 |
1336 : |-------------| |-------------|
1337 : | PragmaName1 | | PragmaName1 |
1338 : |-------------| |-------------|
1339 : */
1340 :
1341 : static void HandleRecordFieldPragmas (unsigned int record, unsigned int field, unsigned int n);
1342 :
1343 : /*
1344 : SaveRememberedConstructor -
1345 : */
1346 :
1347 : static void SaveRememberedConstructor (void);
1348 :
1349 : /*
1350 : GetSeenString - returns a string corresponding to, s.
1351 : */
1352 :
1353 : static DynamicStrings_String GetSeenString (M2Const_constType s);
1354 :
1355 : /*
1356 : SetTypeTo - attempts to set, type, to, s.
1357 : */
1358 :
1359 : static void SetTypeTo (M2Const_constType s);
1360 :
1361 0 : static void stop (void)
1362 : {
1363 0 : }
1364 :
1365 :
1366 : /*
1367 : propageteTokenPosition - if laterTokPos is unknown then return knownTokPos.
1368 : else return laterTokPos.
1369 : */
1370 :
1371 165868 : static unsigned int propageteTokenPosition (unsigned int knownTokPos, unsigned int laterTokPos)
1372 : {
1373 0 : if (laterTokPos == M2LexBuf_UnknownTokenNo)
1374 : {
1375 : return knownTokPos;
1376 : }
1377 : else
1378 : {
1379 49000 : return laterTokPos;
1380 : }
1381 : /* static analysis guarentees a RETURN statement will be used before here. */
1382 : __builtin_unreachable ();
1383 : }
1384 :
1385 :
1386 : /*
1387 : PushBlock - push the block variables to the block stack.
1388 : */
1389 :
1390 82952 : static void PushBlock (unsigned int tokno)
1391 : {
1392 82952 : M2StackWord_PushWord (BlockStack, curStartTok); /* module/implementation/definition/procedure token pos. */
1393 82952 : M2StackWord_PushWord (BlockStack, curBeginTok); /* BEGIN keyword pos. */
1394 82952 : M2StackWord_PushWord (BlockStack, curEndTok); /* END keyword pos. */
1395 82952 : M2StackWord_PushWord (BlockStack, curFinallyTok); /* FINALLY keyword pos. */
1396 82952 : M2StackWord_PushWord (BlockStack, curModuleSym); /* current module. */
1397 82952 : curStartTok = tokno; /* current module. */
1398 82952 : curBeginTok = M2LexBuf_UnknownTokenNo;
1399 82952 : curEndTok = M2LexBuf_UnknownTokenNo;
1400 82952 : curFinallyTok = M2LexBuf_UnknownTokenNo;
1401 82952 : curModuleSym = SymbolTable_NulSym;
1402 82952 : }
1403 :
1404 :
1405 : /*
1406 : PopBlock - pop the block variables from the block stack.
1407 : */
1408 :
1409 82934 : static void PopBlock (void)
1410 : {
1411 82934 : curModuleSym = static_cast<unsigned int> (M2StackWord_PopWord (BlockStack));
1412 82934 : curFinallyTok = static_cast<unsigned int> (M2StackWord_PopWord (BlockStack));
1413 82934 : curEndTok = static_cast<unsigned int> (M2StackWord_PopWord (BlockStack));
1414 82934 : curBeginTok = static_cast<unsigned int> (M2StackWord_PopWord (BlockStack));
1415 82934 : curStartTok = static_cast<unsigned int> (M2StackWord_PopWord (BlockStack));
1416 82934 : }
1417 :
1418 :
1419 : /*
1420 : BuildFormalParameterSection - Builds a Formal Parameter in a procedure.
1421 :
1422 : The Stack:
1423 :
1424 : Entry and Exit
1425 :
1426 : Ptr -> <- Ptr
1427 : +------------+
1428 : | ParamTotal |
1429 : |------------|
1430 : | TypeSym |
1431 : |------------|
1432 : | Array/Nul |
1433 : |------------|
1434 : | NoOfIds |
1435 : |------------|
1436 : | Id 1 |
1437 : |------------|
1438 : . .
1439 : . .
1440 : . .
1441 : |------------|
1442 : | Id n |
1443 : |------------|
1444 : | Var / Nul |
1445 : |------------|
1446 : | ProcSym |
1447 : |------------|
1448 : */
1449 :
1450 8350554 : static void BuildFormalParameterSection (SymbolTable_ProcedureKind kind)
1451 : {
1452 8350554 : NameKey_Name ParamName;
1453 8350554 : NameKey_Name Var;
1454 8350554 : NameKey_Name Array;
1455 8350554 : unsigned int tok;
1456 8350554 : unsigned int pi;
1457 8350554 : unsigned int TypeTok;
1458 8350554 : unsigned int ParamTotal;
1459 8350554 : unsigned int TypeSym;
1460 8350554 : unsigned int UnBoundedSym;
1461 8350554 : unsigned int NoOfIds;
1462 8350554 : unsigned int ProcSym;
1463 8350554 : unsigned int i;
1464 8350554 : unsigned int ndim;
1465 :
1466 8350554 : M2Quads_PopT (&ParamTotal);
1467 8350554 : M2Quads_PopTtok (&TypeSym, &TypeTok);
1468 8350554 : M2Quads_PopTF (&Array, &ndim);
1469 16701108 : M2Debug_Assert ((Array == M2Reserved_ArrayTok) || (Array == M2Reserved_NulTok));
1470 8350554 : M2Quads_PopT (&NoOfIds);
1471 8350554 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfIds+2));
1472 8350554 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
1473 8350554 : Var = static_cast<NameKey_Name> (M2Quads_OperandT (NoOfIds+1));
1474 8350554 : tok = static_cast<unsigned int> (M2Quads_OperandTok (NoOfIds+2));
1475 16701108 : M2Debug_Assert ((Var == M2Reserved_VarTok) || (Var == M2Reserved_NulTok));
1476 : /* Restore popped elements. */
1477 8350554 : M2Quads_PushT (NoOfIds);
1478 8350554 : M2Quads_PushTF (Array, ndim);
1479 8350554 : M2Quads_PushTtok (TypeSym, TypeTok);
1480 8350554 : M2Quads_PushT (ParamTotal);
1481 8350554 : if (Array == M2Reserved_ArrayTok)
1482 : {
1483 1016066 : UnBoundedSym = SymbolTable_MakeUnbounded (tok, TypeSym, ndim);
1484 1016066 : TypeSym = UnBoundedSym;
1485 : }
1486 8350554 : i = 1;
1487 : /* +4 to skip over the top restored elements. */
1488 8350554 : pi = NoOfIds+4; /* Stack index referencing stacked parameter i. */
1489 18793413 : while (i <= NoOfIds) /* Stack index referencing stacked parameter i. */
1490 : {
1491 10442859 : if (((M2Comp_CompilingDefinitionModule ()) && ! M2Options_PedanticParamNames) && (((SymbolTable_GetMainModule ()) == (SymbolTable_GetCurrentModule ())) || ((SymbolTable_IsHiddenTypeDeclared (SymbolTable_GetCurrentModule ())) && M2Options_ExtendedOpaque)))
1492 : {
1493 : /* We will see the parameters in the implementation module. */
1494 : ParamName = NameKey_NulName;
1495 : }
1496 : else
1497 : {
1498 10437441 : ParamName = static_cast<NameKey_Name> (M2Quads_OperandT (pi));
1499 : }
1500 10442859 : tok = static_cast<unsigned int> (M2Quads_OperandTok (pi));
1501 10442859 : if (Var == M2Reserved_VarTok)
1502 : {
1503 : /* avoid dangling else. */
1504 : /* VAR parameter. */
1505 955222 : if (! (SymbolTable_PutVarParam (tok, ProcSym, kind, ParamTotal+i, ParamName, TypeSym, Array == M2Reserved_ArrayTok, TypeTok)))
1506 : {
1507 0 : M2Error_InternalError ((const char *) "problems adding a VarParameter - wrong param number?", 52);
1508 : }
1509 : }
1510 : else
1511 : {
1512 : /* Non VAR parameter. */
1513 9487637 : if (! (SymbolTable_PutParam (tok, ProcSym, kind, ParamTotal+i, ParamName, TypeSym, Array == M2Reserved_ArrayTok, TypeTok)))
1514 : {
1515 0 : M2Error_InternalError ((const char *) "problems adding a Parameter - wrong param number?", 49);
1516 : }
1517 : }
1518 : /*
1519 : IF kind = ProperProcedure
1520 : THEN
1521 : PutDeclared (OperandTok (pi), GetParameterShadowVar (GetNthParam (ProcSym, kind, ParamTotal + i)))
1522 : END ;
1523 : */
1524 10442859 : i += 1;
1525 10442859 : pi -= 1;
1526 : }
1527 8350554 : }
1528 :
1529 :
1530 : /*
1531 : CheckFormalParameterSection - Checks a Formal Parameter in a procedure.
1532 : The stack is unaffected.
1533 :
1534 : The Stack:
1535 :
1536 : Entry and Exit
1537 :
1538 : Ptr ->
1539 : +------------+
1540 : | ParamTotal |
1541 : |------------|
1542 : | TypeSym |
1543 : |------------|
1544 : | Array/Nul |
1545 : |------------|
1546 : | NoOfIds |
1547 : |------------|
1548 : | Id 1 |
1549 : |------------|
1550 : . .
1551 : . .
1552 : . .
1553 : |------------|
1554 : | Id n |
1555 : |------------|
1556 : | Var / Nul |
1557 : |------------|
1558 : | ProcSym |
1559 : |------------|
1560 : */
1561 :
1562 1978004 : static void CheckFormalParameterSection (SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind)
1563 : {
1564 1978004 : NameKey_Name Array;
1565 1978004 : NameKey_Name Var;
1566 1978004 : bool isVarParam;
1567 1978004 : bool Unbounded;
1568 1978004 : unsigned int ParamI;
1569 1978004 : unsigned int ParamIType;
1570 1978004 : unsigned int ParamTotal;
1571 1978004 : unsigned int TypeTok;
1572 1978004 : unsigned int TypeSym;
1573 1978004 : unsigned int NoOfIds;
1574 1978004 : unsigned int ProcSym;
1575 1978004 : unsigned int pi;
1576 1978004 : unsigned int i;
1577 1978004 : unsigned int ndim;
1578 :
1579 1978004 : M2Quads_PopT (&ParamTotal);
1580 1978004 : M2Quads_PopTtok (&TypeSym, &TypeTok);
1581 1978004 : M2Quads_PopTF (&Array, &ndim);
1582 3956008 : M2Debug_Assert ((Array == M2Reserved_ArrayTok) || (Array == M2Reserved_NulTok));
1583 1978004 : M2Quads_PopT (&NoOfIds);
1584 1978004 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfIds+2));
1585 1978004 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
1586 1978004 : Var = static_cast<NameKey_Name> (M2Quads_OperandT (NoOfIds+1));
1587 3956008 : M2Debug_Assert ((Var == NameKey_NulName) || (Var == M2Reserved_VarTok));
1588 1978004 : isVarParam = Var != NameKey_NulName;
1589 : /* Restore popped elements. */
1590 1978004 : M2Quads_PushT (NoOfIds);
1591 1978004 : M2Quads_PushTF (Array, ndim);
1592 1978004 : M2Quads_PushTtok (TypeSym, TypeTok);
1593 1978004 : M2Quads_PushT (ParamTotal);
1594 3956008 : M2Debug_Assert ((Var == M2Reserved_VarTok) || (Var == M2Reserved_NulTok));
1595 1978004 : Unbounded = Array == M2Reserved_ArrayTok; /* ARRAY OF Type, parameter. */
1596 1978004 : i = 1;
1597 : /* +4 to skip over the top restored elements. */
1598 1978004 : pi = NoOfIds+4; /* Stack index referencing stacked parameter i. */
1599 : /* If there are an incorrect number of parameters specified then this
1600 : will be detcted by EndBuildFormalParameters. */
1601 4375206 : while (i <= NoOfIds)
1602 : {
1603 2397202 : if ((ParamTotal+i) <= (SymbolTable_NoOfParam (ProcSym, prevkind)))
1604 : {
1605 : /* WarnStringAt (InitString ('parampos?'), OperandTok (pi)) ; */
1606 2397196 : if (Unbounded && (! (SymbolTable_IsUnboundedParam (ProcSym, prevkind, ParamTotal+i))))
1607 : {
1608 0 : ParameterError ((const char *) "declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 99, (const char *) "the parameter {%3EHa} was not declared as an ARRAY OF type", 58, (const char *) "the parameter {%3EVa} was declared as an ARRAY OF type", 54, ParamTotal+i, ProcSym, curkind, prevkind);
1609 : }
1610 2397196 : else if (! Unbounded && (SymbolTable_IsUnboundedParam (ProcSym, prevkind, ParamTotal+i)))
1611 : {
1612 : /* avoid dangling else. */
1613 6 : ParameterError ((const char *) "declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 99, (const char *) "the parameter {%3EHa} was declared as an ARRAY OF type", 54, (const char *) "the parameter {%3EVa} was not declared as an ARRAY OF type", 58, ParamTotal+i, ProcSym, curkind, prevkind);
1614 : }
1615 2397196 : if (Unbounded)
1616 : {
1617 285012 : if ((SymbolTable_GetDimension (SymbolTable_GetNthParam (ProcSym, prevkind, ParamTotal+1))) != ndim)
1618 : {
1619 0 : ParameterError ((const char *) "declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 99, (const char *) "the dynamic array parameter {%3EHa} was declared with a different of dimensions", 79, (const char *) "the dynamic array parameter {%3EVa} was declared with a different of dimensions", 79, ParamTotal+i, ProcSym, curkind, prevkind);
1620 : }
1621 : }
1622 2397196 : if (isVarParam && (! (SymbolTable_IsVarParam (ProcSym, prevkind, ParamTotal+i))))
1623 : {
1624 : /* Expecting non VAR parameter. */
1625 6 : ParameterError ((const char *) "declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 99, (const char *) "{%3EHa} was not declared as a {%kVAR} parameter", 47, (const char *) "{%3EVa} was declared as a {%kVAR} parameter", 43, ParamTotal+i, ProcSym, curkind, prevkind);
1626 : }
1627 2397190 : else if (! isVarParam && (SymbolTable_IsVarParam (ProcSym, prevkind, ParamTotal+i)))
1628 : {
1629 : /* avoid dangling else. */
1630 : /* Expecting VAR pamarater. */
1631 6 : ParameterError ((const char *) "declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 99, (const char *) "{%3EHa} was declared as a {%kVAR} parameter", 43, (const char *) "{%3EVa} was not declared as a {%kVAR} parameter", 47, ParamTotal+i, ProcSym, curkind, prevkind);
1632 : }
1633 2397196 : ParamI = SymbolTable_GetNthParam (ProcSym, prevkind, ParamTotal+i);
1634 2397196 : if (M2Options_PedanticParamNames)
1635 : {
1636 42948 : if ((SymbolTable_GetSymName (ParamI)) != (M2Quads_OperandT (pi)))
1637 : {
1638 : /* Different parameter names. */
1639 30 : ParameterError ((const char *) "procedure {%%1a} in the %s differs from the %s, {%%2N} parameter name is inconsistent, %s", 89, (const char *) "named as {%3EVa}", 16, (const char *) "named as {%3EVa}", 16, ParamTotal+i, ProcSym, curkind, prevkind);
1640 : }
1641 : }
1642 2397196 : if (Unbounded)
1643 : {
1644 : /* GetType(ParamI) yields an UnboundedSym or a PartialUnboundedSym,
1645 : depending whether it has been resolved.. */
1646 285012 : ParamIType = SymbolTable_GetType (SymbolTable_GetType (ParamI));
1647 : }
1648 : else
1649 : {
1650 2112184 : ParamIType = SymbolTable_GetType (ParamI);
1651 : }
1652 2397196 : if (((((SymbolTable_SkipType (ParamIType)) != (SymbolTable_SkipType (TypeSym))) || (M2Options_PedanticParamNames && (ParamIType != TypeSym))) && (! (SymbolTable_IsUnknown (SymbolTable_SkipType (TypeSym))))) && (! (SymbolTable_IsUnknown (SymbolTable_SkipType (ParamIType)))))
1653 : {
1654 : /* Different parameter types. */
1655 18 : ParameterError ((const char *) "declaration in the %s differs from the %s, {%%2N} parameter is inconsistent, %s", 79, (const char *) "the parameter {%3EHa} was declared with a different type", 56, (const char *) "the parameter {%3EVa} was declared with a different type", 56, ParamTotal+i, ProcSym, curkind, prevkind);
1656 : }
1657 : }
1658 2397202 : i += 1;
1659 2397202 : pi -= 1;
1660 : }
1661 1978004 : }
1662 :
1663 :
1664 : /*
1665 : RemoveFPParameters - remove the FPSection parameters from the stack and
1666 : increment the param total with the NoOfIds.
1667 :
1668 : The Stack:
1669 :
1670 : Entry Exit
1671 :
1672 : Ptr ->
1673 : +------------+
1674 : | ParamTotal |
1675 : |------------|
1676 : | TypeSym |
1677 : |------------|
1678 : | Array/Nul |
1679 : |------------|
1680 : | NoOfIds |
1681 : |------------|
1682 : | Id 1 |
1683 : |------------|
1684 : . .
1685 : . .
1686 : . .
1687 : |------------|
1688 : | Id n | <- Ptr
1689 : |------------| +------------+
1690 : | Var / Nul | | ParamTotal |
1691 : |------------| |------------|
1692 : | ProcSym | | ProcSym |
1693 : |------------| |------------|
1694 : */
1695 :
1696 8350554 : static void RemoveFPParameters (void)
1697 : {
1698 8350554 : unsigned int ParamTotal;
1699 8350554 : unsigned int Array;
1700 8350554 : unsigned int TypeSym;
1701 8350554 : unsigned int NoOfIds;
1702 8350554 : unsigned int ProcSym;
1703 :
1704 8350554 : M2Quads_PopT (&ParamTotal);
1705 8350554 : M2Quads_PopT (&TypeSym);
1706 8350554 : M2Quads_PopT (&Array);
1707 16701108 : M2Debug_Assert ((Array == M2Reserved_ArrayTok) || (Array == M2Reserved_NulTok));
1708 8350554 : M2Quads_PopT (&NoOfIds);
1709 8350554 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (NoOfIds+2));
1710 8350554 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
1711 8350554 : M2Quads_PopN (NoOfIds+1); /* +1 for the Var/Nul. */
1712 8350554 : M2Quads_PushT (ParamTotal+NoOfIds); /* +1 for the Var/Nul. */
1713 8350554 : M2Quads_Annotate ((const char *) "%1d||running total of no. of parameters", 39);
1714 8350554 : M2Debug_Assert (SymbolTable_IsProcedure (M2Quads_OperandT (2)));
1715 8350554 : }
1716 :
1717 :
1718 : /*
1719 : ParameterError - create two error strings chained together.
1720 : */
1721 :
1722 66 : static void ParameterError (const char *FmtHeader_, unsigned int _FmtHeader_high, const char *PrevDesc_, unsigned int _PrevDesc_high, const char *CurDesc_, unsigned int _CurDesc_high, unsigned int ParamNo, unsigned int ProcSym, SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind)
1723 : {
1724 66 : unsigned int PrevParam;
1725 66 : unsigned int CurParam;
1726 66 : DynamicStrings_String CurStr;
1727 66 : DynamicStrings_String PrevStr;
1728 66 : DynamicStrings_String Msg;
1729 66 : DynamicStrings_String CurKindStr;
1730 66 : DynamicStrings_String PrevKindStr;
1731 66 : char FmtHeader[_FmtHeader_high+1];
1732 66 : char PrevDesc[_PrevDesc_high+1];
1733 66 : char CurDesc[_CurDesc_high+1];
1734 :
1735 : /* make a local copy of each unbounded array. */
1736 66 : memcpy (FmtHeader, FmtHeader_, _FmtHeader_high+1);
1737 66 : memcpy (PrevDesc, PrevDesc_, _PrevDesc_high+1);
1738 66 : memcpy (CurDesc, CurDesc_, _CurDesc_high+1);
1739 :
1740 132 : CurParam = SymbolTable_GetNthParam (ProcSym, curkind, ParamNo);
1741 66 : CurKindStr = SymbolTable_GetProcedureKindDesc (curkind);
1742 66 : PrevKindStr = SymbolTable_GetProcedureKindDesc (prevkind);
1743 66 : PrevParam = SymbolTable_GetNthParam (ProcSym, prevkind, ParamNo);
1744 66 : PrevStr = DynamicStrings_InitString ((const char *) PrevDesc, _PrevDesc_high);
1745 66 : CurStr = DynamicStrings_InitString ((const char *) CurDesc, _CurDesc_high);
1746 66 : Msg = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) FmtHeader, _FmtHeader_high)), (const unsigned char *) &CurKindStr, (sizeof (CurKindStr)-1), (const unsigned char *) &PrevKindStr, (sizeof (PrevKindStr)-1), (const unsigned char *) &PrevStr, (sizeof (PrevStr)-1));
1747 66 : M2MetaError_MetaErrorString3 (Msg, ProcSym, ParamNo, PrevParam);
1748 66 : Msg = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) FmtHeader, _FmtHeader_high)), (const unsigned char *) &CurKindStr, (sizeof (CurKindStr)-1), (const unsigned char *) &PrevKindStr, (sizeof (PrevKindStr)-1), (const unsigned char *) &CurStr, (sizeof (CurStr)-1));
1749 66 : M2MetaError_MetaErrorString3 (Msg, ProcSym, ParamNo, CurParam);
1750 66 : }
1751 :
1752 :
1753 : /*
1754 : ParameterMismatch - generate a parameter mismatch error between the current
1755 : declaration at tok and a previous ProcSym declaration.
1756 : NoOfPar is the current number of parameters.
1757 : */
1758 :
1759 18 : static void ParameterMismatch (unsigned int tok, unsigned int ProcSym, unsigned int NoOfPar, SymbolTable_ProcedureKind prevkind, SymbolTable_ProcedureKind curkind)
1760 : {
1761 18 : DynamicStrings_String MsgCurrent;
1762 18 : DynamicStrings_String MsgPrev;
1763 18 : DynamicStrings_String CompCur;
1764 18 : DynamicStrings_String CompPrev;
1765 18 : DynamicStrings_String CurDesc;
1766 18 : DynamicStrings_String PrevDesc;
1767 :
1768 18 : CurDesc = SymbolTable_GetProcedureKindDesc (curkind);
1769 18 : PrevDesc = SymbolTable_GetProcedureKindDesc (prevkind);
1770 18 : CompPrev = GetComparison (SymbolTable_NoOfParam (ProcSym, prevkind), NoOfPar);
1771 18 : CompCur = GetComparison (NoOfPar, SymbolTable_NoOfParam (ProcSym, prevkind));
1772 18 : MsgCurrent = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the %s for {%%1ad} has %s parameters than the %s", 48)), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1), (const unsigned char *) &CompCur, (sizeof (CompCur)-1), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1));
1773 18 : MsgPrev = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the %s for {%%1ad} has %s parameters than the %s", 48)), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1), (const unsigned char *) &CompPrev, (sizeof (CompPrev)-1), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1));
1774 18 : M2MetaError_MetaErrorStringT1 (SymbolTable_GetProcedureDeclaredTok (ProcSym, prevkind), MsgPrev, ProcSym);
1775 18 : M2MetaError_MetaErrorStringT1 (tok, MsgCurrent, ProcSym);
1776 18 : CurDesc = DynamicStrings_KillString (CurDesc);
1777 18 : PrevDesc = DynamicStrings_KillString (PrevDesc);
1778 18 : CompCur = DynamicStrings_KillString (CompCur);
1779 18 : CompPrev = DynamicStrings_KillString (CompPrev);
1780 18 : }
1781 :
1782 :
1783 : /*
1784 : GetComparison - return a simple description from the result of
1785 : a comparison between left and right.
1786 : */
1787 :
1788 36 : static DynamicStrings_String GetComparison (unsigned int left, unsigned int right)
1789 : {
1790 36 : if (left < right)
1791 : {
1792 18 : return DynamicStrings_InitString ((const char *) "fewer", 5);
1793 : }
1794 18 : else if (left > right)
1795 : {
1796 : /* avoid dangling else. */
1797 18 : return DynamicStrings_InitString ((const char *) "more", 4);
1798 : }
1799 : else
1800 : {
1801 : /* avoid dangling else. */
1802 0 : return DynamicStrings_InitString ((const char *) "same", 4);
1803 : }
1804 : /* static analysis guarentees a RETURN statement will be used before here. */
1805 : __builtin_unreachable ();
1806 : }
1807 :
1808 :
1809 : /*
1810 : ReturnTypeMismatch - generate two errors showing the return type mismatches between
1811 : ProcSym and ReturnType at procedure location tok.
1812 : */
1813 :
1814 6 : static void ReturnTypeMismatch (unsigned int curtok, unsigned int ProcSym, unsigned int CurRetType, unsigned int curtypetok, SymbolTable_ProcedureKind curkind, SymbolTable_ProcedureKind prevkind, unsigned int PrevRetType)
1815 : {
1816 6 : unsigned int prevtok;
1817 6 : DynamicStrings_String CurDesc;
1818 6 : DynamicStrings_String PrevDesc;
1819 6 : DynamicStrings_String MsgCurrent;
1820 6 : DynamicStrings_String MsgPrev;
1821 :
1822 6 : CurDesc = SymbolTable_GetProcedureKindDesc (curkind);
1823 6 : PrevDesc = SymbolTable_GetProcedureKindDesc (prevkind);
1824 6 : prevtok = SymbolTable_GetProcedureDeclaredTok (ProcSym, prevkind);
1825 6 : if (CurRetType == SymbolTable_NulSym)
1826 : {
1827 6 : MsgCurrent = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s", 100)), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1));
1828 6 : MsgPrev = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s", 100)), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1));
1829 6 : prevtok = SymbolTable_GetReturnTypeTok (ProcSym, prevkind);
1830 : }
1831 0 : else if (PrevRetType == SymbolTable_NulSym)
1832 : {
1833 : /* avoid dangling else. */
1834 0 : MsgCurrent = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s", 100)), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1));
1835 0 : MsgPrev = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s", 100)), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1));
1836 0 : curtok = curtypetok;
1837 : }
1838 : else
1839 : {
1840 : /* avoid dangling else. */
1841 0 : MsgCurrent = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the return type for {%%1ad} specified in the %s differs in the %s", 65)), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1));
1842 0 : MsgPrev = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the return type for {%%1ad} specified in the %s differs in the %s", 65)), (const unsigned char *) &CurDesc, (sizeof (CurDesc)-1), (const unsigned char *) &PrevDesc, (sizeof (PrevDesc)-1));
1843 0 : curtok = curtypetok;
1844 0 : prevtok = SymbolTable_GetReturnTypeTok (ProcSym, prevkind);
1845 : }
1846 6 : M2MetaError_MetaErrorStringT1 (curtok, MsgCurrent, ProcSym);
1847 6 : M2MetaError_MetaErrorStringT1 (prevtok, MsgPrev, ProcSym);
1848 6 : }
1849 :
1850 :
1851 : /*
1852 : CheckOptFunction - checks to see whether the optional return value
1853 : has been set before and if it differs it will
1854 : generate an error message. It will set the
1855 : new value to isopt.
1856 : */
1857 :
1858 3141715 : static void CheckOptFunction (unsigned int tok, unsigned int sym, SymbolTable_ProcedureKind kind, bool isopt)
1859 : {
1860 3141715 : SymbolTable_ProcedureKind other;
1861 :
1862 3141715 : if ((SymbolTable_GetType (sym)) != SymbolTable_NulSym)
1863 : {
1864 12566860 : for (other=SymbolTable_ProperProcedure; other<=SymbolTable_DefProcedure; other= static_cast<SymbolTable_ProcedureKind>(static_cast<int>(other+1)))
1865 : {
1866 : /* Procedure sym has been declared as a function. */
1867 9425145 : if ((kind != other) && (SymbolTable_GetProcedureParametersDefined (sym, other)))
1868 : {
1869 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
1870 853752 : if ((SymbolTable_IsReturnOptional (sym, kind)) && ! isopt)
1871 : {
1872 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "procedure {%1Ea} is not declared with an optional return type here", 66, sym);
1873 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetReturnTypeTok (sym, kind), (const char *) "previously procedure {%1Ea} was declared with an optional return type", 69, sym);
1874 : }
1875 853752 : else if ((! (SymbolTable_IsReturnOptional (sym, kind))) && isopt)
1876 : {
1877 : /* avoid dangling else. */
1878 0 : M2MetaError_MetaErrorT1 (tok, (const char *) "procedure {%1Ea} is declared with an optional return type here", 62, sym);
1879 0 : M2MetaError_MetaErrorT1 (SymbolTable_GetReturnTypeTok (sym, kind), (const char *) "previously procedure {%1Ea} was declared without an optional return type", 72, sym);
1880 : }
1881 : }
1882 : }
1883 : }
1884 3141715 : SymbolTable_SetReturnOptional (sym, kind, isopt);
1885 3141715 : }
1886 :
1887 :
1888 : /*
1889 : CheckProcedure - checks to see that the top of stack procedure
1890 : has not been declared as a procedure function.
1891 :
1892 : The Stack:
1893 :
1894 : Entry Exit
1895 :
1896 : Ptr -> <- Ptr
1897 : +------------+ +------------+
1898 : | ProcSym | | ProcSym |
1899 : |------------| |------------|
1900 : */
1901 :
1902 4859698 : static void CheckProcedureReturn (unsigned int RetType, unsigned int typetok)
1903 : {
1904 4859698 : SymbolTable_ProcedureKind curkind;
1905 4859698 : SymbolTable_ProcedureKind kind;
1906 4859698 : unsigned int tok;
1907 4859698 : unsigned int PrevRetType;
1908 4859698 : unsigned int ProcSym;
1909 :
1910 4859698 : M2Quads_PopTtok (&ProcSym, &tok);
1911 4859698 : M2Quads_PushTtok (ProcSym, tok);
1912 4859698 : M2Quads_Annotate ((const char *) "%1s(%1d)||procedure start symbol", 32);
1913 4859698 : if (SymbolTable_IsProcedure (ProcSym))
1914 : {
1915 4815160 : curkind = SymbolTable_GetProcedureKind (ProcSym, tok);
1916 24075800 : for (kind=SymbolTable_ProperProcedure; kind<=SymbolTable_DefProcedure; kind= static_cast<SymbolTable_ProcedureKind>(static_cast<int>(kind+1)))
1917 : {
1918 : /* Check against any previously declared kinds. */
1919 14445480 : if ((kind != curkind) && (SymbolTable_GetProcedureParametersDefined (ProcSym, kind)))
1920 : {
1921 1229030 : PrevRetType = SymbolTable_GetType (ProcSym);
1922 1229030 : if (PrevRetType != RetType)
1923 : {
1924 6 : ReturnTypeMismatch (tok, ProcSym, RetType, typetok, curkind, kind, PrevRetType);
1925 : }
1926 : }
1927 : }
1928 4815160 : SymbolTable_PutFunction (tok, ProcSym, curkind, RetType);
1929 : }
1930 4859698 : }
1931 :
1932 :
1933 : /*
1934 : HandleRecordFieldPragmas -
1935 :
1936 : Entry Exit
1937 : ===== ====
1938 :
1939 : Ptr -> <- Ptr
1940 :
1941 : |-------------| |-------------|
1942 : | Const1 | | Const1 |
1943 : |-------------| |-------------|
1944 : | PragmaName1 | | PragmaName1 |
1945 : |-------------| |-------------|
1946 : */
1947 :
1948 343866 : static void HandleRecordFieldPragmas (unsigned int record, unsigned int field, unsigned int n)
1949 : {
1950 343866 : bool seenAlignment;
1951 343866 : unsigned int defaultAlignment;
1952 343866 : unsigned int sym;
1953 343866 : unsigned int i;
1954 343866 : NameKey_Name name;
1955 343866 : DynamicStrings_String s;
1956 :
1957 343866 : seenAlignment = false;
1958 343866 : defaultAlignment = SymbolTable_GetDefaultRecordFieldAlignment (record);
1959 343866 : i = 1;
1960 687744 : while (i <= n)
1961 : {
1962 12 : name = static_cast<NameKey_Name> (M2Quads_OperandT (i*2));
1963 12 : sym = static_cast<unsigned int> (M2Quads_OperandT ((i*2)-1));
1964 12 : if (name == (NameKey_MakeKey ((const char *) "unused", 6)))
1965 : {
1966 0 : if (sym == SymbolTable_NulSym)
1967 : {
1968 0 : SymbolTable_PutUnused (field);
1969 : }
1970 : else
1971 : {
1972 0 : M2Error_WriteFormat0 ((const char *) "not expecting pragma 'unused' to contain an expression", 54);
1973 : }
1974 : }
1975 12 : else if (name == (NameKey_MakeKey ((const char *) "bytealignment", 13)))
1976 : {
1977 : /* avoid dangling else. */
1978 12 : if (sym == SymbolTable_NulSym)
1979 : {
1980 0 : M2Error_WriteFormat0 ((const char *) "expecting an expression with the pragma 'bytealignment'", 55);
1981 : }
1982 : else
1983 : {
1984 12 : SymbolTable_PutAlignment (field, sym);
1985 12 : seenAlignment = true;
1986 : }
1987 : }
1988 : else
1989 : {
1990 : /* avoid dangling else. */
1991 0 : s = DynamicStrings_InitString ((const char *) "cannot use pragma '", 19);
1992 0 : s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (name))));
1993 0 : s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "' on record field {%1ad}", 24)));
1994 0 : M2MetaError_MetaErrorString1 (s, field);
1995 : }
1996 12 : i += 1;
1997 : }
1998 343866 : if (! seenAlignment && (defaultAlignment != SymbolTable_NulSym))
1999 : {
2000 108 : SymbolTable_PutAlignment (field, defaultAlignment);
2001 : }
2002 343866 : }
2003 :
2004 :
2005 : /*
2006 : SaveRememberedConstructor -
2007 : */
2008 :
2009 0 : static void SaveRememberedConstructor (void)
2010 : {
2011 0 : }
2012 :
2013 :
2014 : /*
2015 : GetSeenString - returns a string corresponding to, s.
2016 : */
2017 :
2018 0 : static DynamicStrings_String GetSeenString (M2Const_constType s)
2019 : {
2020 0 : switch (s)
2021 : {
2022 0 : case M2Const_unknown:
2023 0 : return DynamicStrings_InitString ((const char *) "unknown", 7);
2024 0 : break;
2025 :
2026 0 : case M2Const_set:
2027 0 : return DynamicStrings_InitString ((const char *) "SET", 3);
2028 0 : break;
2029 :
2030 0 : case M2Const_str:
2031 0 : return DynamicStrings_InitString ((const char *) "string", 6);
2032 0 : break;
2033 :
2034 0 : case M2Const_constructor:
2035 0 : return DynamicStrings_InitString ((const char *) "constructor", 11);
2036 0 : break;
2037 :
2038 0 : case M2Const_array:
2039 0 : return DynamicStrings_InitString ((const char *) "ARRAY", 5);
2040 0 : break;
2041 :
2042 0 : case M2Const_cast:
2043 0 : return DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (SymbolTable_GetSymName (castType)));
2044 0 : break;
2045 :
2046 0 : case M2Const_boolean:
2047 0 : return DynamicStrings_InitString ((const char *) "BOOLEAN", 7);
2048 0 : break;
2049 :
2050 0 : case M2Const_ztype:
2051 0 : return DynamicStrings_InitString ((const char *) "Z type", 6);
2052 0 : break;
2053 :
2054 0 : case M2Const_rtype:
2055 0 : return DynamicStrings_InitString ((const char *) "R type", 6);
2056 0 : break;
2057 :
2058 0 : case M2Const_ctype:
2059 0 : return DynamicStrings_InitString ((const char *) "C type", 6);
2060 0 : break;
2061 :
2062 0 : case M2Const_procedure:
2063 0 : return DynamicStrings_InitString ((const char *) "PROCEDURE", 9);
2064 0 : break;
2065 :
2066 :
2067 0 : default:
2068 0 : M2Error_InternalError ((const char *) "unexpected value of type", 24);
2069 : break;
2070 : }
2071 : return static_cast<DynamicStrings_String> (NULL);
2072 : /* static analysis guarentees a RETURN statement will be used before here. */
2073 : __builtin_unreachable ();
2074 : }
2075 :
2076 :
2077 : /*
2078 : SetTypeTo - attempts to set, type, to, s.
2079 : */
2080 :
2081 87383 : static void SetTypeTo (M2Const_constType s)
2082 : {
2083 87383 : DynamicStrings_String s1;
2084 87383 : DynamicStrings_String s2;
2085 87383 : DynamicStrings_String s3;
2086 :
2087 87383 : if (type == M2Const_unknown)
2088 : {
2089 86829 : type = s;
2090 : }
2091 : /* leave it alone */
2092 554 : else if ((type == M2Const_constructor) && (s != M2Const_str))
2093 : {
2094 : /* avoid dangling else. */
2095 320 : type = s;
2096 : }
2097 234 : else if ((s == M2Const_constructor) && ((type == M2Const_array) || (type == M2Const_set)))
2098 : {
2099 : /* avoid dangling else. */
2100 : }
2101 222 : else if (type != s)
2102 : {
2103 : /* avoid dangling else. */
2104 0 : s1 = GetSeenString (type);
2105 0 : s2 = GetSeenString (s);
2106 0 : s3 = FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "cannot create a %s constant together with a %s constant", 55), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1));
2107 0 : M2Error_ErrorStringAt (s3, M2LexBuf_GetTokenNo ());
2108 0 : s1 = DynamicStrings_KillString (s1);
2109 0 : s2 = DynamicStrings_KillString (s2);
2110 : }
2111 87383 : }
2112 :
2113 :
2114 : /*
2115 : BlockStart - tokno is the module/procedure/implementation/definition token
2116 : */
2117 :
2118 82952 : extern "C" void P2SymBuild_BlockStart (unsigned int tokno)
2119 : {
2120 82952 : PushBlock (tokno);
2121 82952 : }
2122 :
2123 :
2124 : /*
2125 : BlockEnd - declare module ctor/init/fini/dep procedures.
2126 : */
2127 :
2128 82934 : extern "C" void P2SymBuild_BlockEnd (unsigned int tokno)
2129 : {
2130 82934 : curBeginTok = propageteTokenPosition (curStartTok, curBeginTok);
2131 82934 : curFinallyTok = propageteTokenPosition (tokno, curFinallyTok);
2132 82934 : M2Debug_Assert (curModuleSym != SymbolTable_NulSym);
2133 82934 : SymbolTable_MakeModuleCtor (curStartTok, curBeginTok, curFinallyTok, curModuleSym);
2134 82934 : PopBlock ();
2135 82934 : }
2136 :
2137 :
2138 : /*
2139 : BlockBegin - assign curBeginTok to tokno.
2140 : */
2141 :
2142 43040 : extern "C" void P2SymBuild_BlockBegin (unsigned int tokno)
2143 : {
2144 43040 : curBeginTok = tokno;
2145 43040 : }
2146 :
2147 :
2148 : /*
2149 : BlockFinally - assign curFinallyTok to tokno.
2150 : */
2151 :
2152 5960 : extern "C" void P2SymBuild_BlockFinally (unsigned int tokno)
2153 : {
2154 5960 : curFinallyTok = tokno;
2155 5960 : }
2156 :
2157 161264 : extern "C" void P2SymBuild_P2StartBuildDefModule (void)
2158 : {
2159 161264 : NameKey_Name name;
2160 161264 : unsigned int ModuleSym;
2161 161264 : unsigned int tokno;
2162 :
2163 : /*
2164 : StartBuildDefinitionModule - Creates a definition module and starts
2165 : a new scope.
2166 :
2167 : he Stack is expected:
2168 :
2169 : Entry Exit
2170 :
2171 : Ptr -> <- Ptr
2172 : +------------+ +-----------+
2173 : | NameStart | | NameStart |
2174 : |------------| |-----------|
2175 :
2176 : */
2177 161264 : M2Quads_PopTtok (&name, &tokno);
2178 161264 : ModuleSym = M2Batch_MakeDefinitionSource (tokno, name);
2179 161264 : curModuleSym = ModuleSym;
2180 161264 : SymbolTable_SetCurrentModule (ModuleSym);
2181 161264 : SymbolTable_SetFileModule (ModuleSym);
2182 161264 : SymbolTable_StartScope (ModuleSym);
2183 161264 : M2Debug_Assert (SymbolTable_IsDefImp (ModuleSym));
2184 161264 : M2Debug_Assert (M2Comp_CompilingDefinitionModule ());
2185 161264 : M2Quads_PushT (name);
2186 161264 : M2Quads_Annotate ((const char *) "%1n||definition module name", 27);
2187 161264 : M2Error_EnterDefinitionScope (name);
2188 161264 : }
2189 :
2190 161264 : extern "C" void P2SymBuild_P2EndBuildDefModule (void)
2191 : {
2192 161264 : NameKey_Name NameStart;
2193 161264 : NameKey_Name NameEnd;
2194 :
2195 : /*
2196 : EndBuildDefinitionModule - Destroys the definition module scope and
2197 : checks for correct name.
2198 :
2199 : The Stack is expected:
2200 :
2201 : Entry Exit
2202 :
2203 : Ptr ->
2204 : +------------+ +-----------+
2205 : | NameEnd | | |
2206 : |------------| |-----------|
2207 : | NameStart | | | <- Ptr
2208 : |------------| |-----------|
2209 : */
2210 161264 : M2Debug_Assert (M2Comp_CompilingDefinitionModule ());
2211 161264 : SymbolTable_CheckForUndeclaredExports (SymbolTable_GetCurrentModule ());
2212 161264 : SymbolTable_EndScope ();
2213 161264 : M2Quads_PopT (&NameStart);
2214 161264 : M2Quads_PopT (&NameEnd);
2215 161264 : if (Debugging)
2216 : {
2217 : M2Printf_printf0 ((const char *) "pass 2: ", 8);
2218 : SymbolTable_DisplayTrees (SymbolTable_GetCurrentModule ());
2219 : }
2220 161264 : if (NameStart != NameEnd)
2221 : {
2222 0 : M2Error_WriteFormat2 ((const char *) "inconsistent definition module name, module began as (%a) and ended with (%a)", 77, (const unsigned char *) &NameStart, (sizeof (NameStart)-1), (const unsigned char *) &NameEnd, (sizeof (NameEnd)-1));
2223 : }
2224 161264 : M2Error_LeaveErrorScope ();
2225 161264 : }
2226 :
2227 70791 : extern "C" void P2SymBuild_P2StartBuildImplementationModule (void)
2228 : {
2229 70791 : NameKey_Name name;
2230 70791 : unsigned int ModuleSym;
2231 70791 : unsigned int tokno;
2232 :
2233 : /*
2234 : StartBuildImplementationModule - Creates an implementation module and starts
2235 : a new scope.
2236 :
2237 : The Stack is expected:
2238 :
2239 : Entry Exit
2240 :
2241 : Ptr -> <- Ptr
2242 : +------------+ +-----------+
2243 : | NameStart | | NameStart |
2244 : |------------| |-----------|
2245 :
2246 : */
2247 70791 : M2Quads_PopTtok (&name, &tokno);
2248 70791 : ModuleSym = M2Batch_MakeImplementationSource (tokno, name);
2249 70791 : curModuleSym = ModuleSym;
2250 70791 : SymbolTable_SetCurrentModule (ModuleSym);
2251 70791 : SymbolTable_SetFileModule (ModuleSym);
2252 70791 : SymbolTable_StartScope (ModuleSym);
2253 70791 : M2Debug_Assert (SymbolTable_IsDefImp (ModuleSym));
2254 70791 : M2Debug_Assert (M2Comp_CompilingImplementationModule ());
2255 70791 : M2Quads_PushT (name);
2256 70791 : M2Quads_Annotate ((const char *) "%1n||implementation module name", 31);
2257 70791 : M2Error_EnterImplementationScope (name);
2258 70791 : }
2259 :
2260 70785 : extern "C" void P2SymBuild_P2EndBuildImplementationModule (void)
2261 : {
2262 70785 : NameKey_Name NameStart;
2263 70785 : NameKey_Name NameEnd;
2264 :
2265 : /*
2266 : EndBuildImplementationModule - Destroys the implementation module scope and
2267 : checks for correct name.
2268 :
2269 : The Stack is expected:
2270 :
2271 : Entry Exit
2272 :
2273 : Ptr ->
2274 : +------------+ +-----------+
2275 : | NameEnd | | |
2276 : |------------| |-----------|
2277 : | NameStart | | | <- Ptr
2278 : |------------| |-----------|
2279 : */
2280 70785 : M2Debug_Assert (M2Comp_CompilingImplementationModule ());
2281 70785 : SymbolTable_CheckForUnImplementedExports ();
2282 70785 : SymbolTable_EndScope ();
2283 70785 : M2Quads_PopT (&NameStart);
2284 70785 : M2Quads_PopT (&NameEnd);
2285 70785 : if (NameStart != NameEnd)
2286 : {
2287 0 : M2Error_WriteFormat1 ((const char *) "inconsistent implementation module name %a", 42, (const unsigned char *) &NameStart, (sizeof (NameStart)-1));
2288 : }
2289 70785 : M2Error_LeaveErrorScope ();
2290 70785 : }
2291 :
2292 11733 : extern "C" void P2SymBuild_P2StartBuildProgramModule (void)
2293 : {
2294 11733 : NameKey_Name name;
2295 11733 : unsigned int ModuleSym;
2296 11733 : unsigned int tokno;
2297 :
2298 : /*
2299 : StartBuildProgramModule - Creates a program module and starts
2300 : a new scope.
2301 :
2302 : The Stack is expected:
2303 :
2304 : Entry Exit
2305 :
2306 : Ptr -> <- Ptr
2307 : +------------+ +-----------+
2308 : | NameStart | | NameStart |
2309 : |------------| |-----------|
2310 :
2311 : */
2312 11733 : M2Quads_PopTtok (&name, &tokno);
2313 11733 : ModuleSym = M2Batch_MakeProgramSource (tokno, name);
2314 11733 : curModuleSym = ModuleSym;
2315 11733 : SymbolTable_SetCurrentModule (ModuleSym);
2316 11733 : SymbolTable_SetFileModule (ModuleSym);
2317 11733 : SymbolTable_StartScope (ModuleSym);
2318 11733 : M2Debug_Assert (M2Comp_CompilingProgramModule ());
2319 11733 : M2Debug_Assert (! (SymbolTable_IsDefImp (ModuleSym)));
2320 11733 : M2Quads_PushT (name);
2321 11733 : M2Quads_Annotate ((const char *) "%1n||program module name", 24);
2322 11733 : M2Error_EnterProgramScope (name);
2323 11733 : }
2324 :
2325 11721 : extern "C" void P2SymBuild_P2EndBuildProgramModule (void)
2326 : {
2327 11721 : NameKey_Name NameStart;
2328 11721 : NameKey_Name NameEnd;
2329 :
2330 : /*
2331 : EndBuildProgramModule - Destroys the program module scope and
2332 : checks for correct name.
2333 :
2334 : The Stack is expected:
2335 :
2336 : Entry Exit
2337 :
2338 : Ptr ->
2339 : +------------+ +-----------+
2340 : | NameEnd | | |
2341 : |------------| |-----------|
2342 : | NameStart | | | <- Ptr
2343 : |------------| |-----------|
2344 : */
2345 11721 : M2Debug_Assert (M2Comp_CompilingProgramModule ());
2346 11721 : SymbolTable_CheckForUndeclaredExports (SymbolTable_GetCurrentModule ()); /* Not really allowed exports here though! */
2347 11721 : SymbolTable_EndScope (); /* Not really allowed exports here though! */
2348 11721 : M2Quads_PopT (&NameStart);
2349 11721 : M2Quads_PopT (&NameEnd);
2350 11721 : if (Debugging)
2351 : {
2352 : M2Printf_printf0 ((const char *) "pass 2: ", 8);
2353 : SymbolTable_DisplayTrees (SymbolTable_GetCurrentModule ());
2354 : }
2355 11721 : if (NameStart != NameEnd)
2356 : {
2357 0 : M2Error_WriteFormat2 ((const char *) "inconsistent program module name %a does not match %a", 53, (const unsigned char *) &NameStart, (sizeof (NameStart)-1), (const unsigned char *) &NameEnd, (sizeof (NameEnd)-1));
2358 : }
2359 11721 : M2Error_LeaveErrorScope ();
2360 11721 : }
2361 :
2362 :
2363 : /*
2364 : StartBuildInnerModule - Creates an Inner module and starts
2365 : a new scope.
2366 :
2367 : The Stack is expected:
2368 :
2369 : Entry Exit
2370 :
2371 : Ptr -> <- Ptr
2372 : +------------+ +-----------+
2373 : | NameStart | | NameStart |
2374 : |------------| |-----------|
2375 :
2376 : */
2377 :
2378 428 : extern "C" void P2SymBuild_StartBuildInnerModule (void)
2379 : {
2380 428 : NameKey_Name name;
2381 428 : unsigned int tok;
2382 428 : unsigned int ModuleSym;
2383 :
2384 428 : M2Quads_PopTtok (&name, &tok);
2385 428 : ModuleSym = SymbolTable_GetDeclareSym (tok, name);
2386 428 : curModuleSym = ModuleSym;
2387 428 : SymbolTable_StartScope (ModuleSym);
2388 428 : M2Debug_Assert (! (SymbolTable_IsDefImp (ModuleSym)));
2389 428 : M2Quads_PushTtok (name, tok);
2390 428 : M2Quads_Annotate ((const char *) "%1n||inner module name", 22);
2391 428 : M2Error_EnterModuleScope (name);
2392 428 : }
2393 :
2394 :
2395 : /*
2396 : EndBuildInnerModule - Destroys the Inner module scope and
2397 : checks for correct name.
2398 :
2399 : The Stack is expected:
2400 :
2401 : Entry Exit
2402 :
2403 : Ptr ->
2404 : +------------+ +-----------+
2405 : | NameEnd | | |
2406 : |------------| |-----------|
2407 : | NameStart | | | <- Ptr
2408 : |------------| |-----------|
2409 : */
2410 :
2411 428 : extern "C" void P2SymBuild_EndBuildInnerModule (void)
2412 : {
2413 428 : NameKey_Name NameStart;
2414 428 : NameKey_Name NameEnd;
2415 :
2416 428 : SymbolTable_CheckForUndeclaredExports (SymbolTable_GetCurrentModule ());
2417 428 : SymbolTable_EndScope ();
2418 428 : M2Quads_PopT (&NameStart);
2419 428 : M2Quads_PopT (&NameEnd);
2420 428 : if (NameStart != NameEnd)
2421 : {
2422 0 : M2Error_WriteFormat2 ((const char *) "inconsistent inner module name %a does not match %a", 51, (const unsigned char *) &NameStart, (sizeof (NameStart)-1), (const unsigned char *) &NameEnd, (sizeof (NameEnd)-1));
2423 : }
2424 428 : M2Error_LeaveErrorScope ();
2425 428 : }
2426 :
2427 :
2428 : /*
2429 : BuildImportOuterModule - Builds imported identifiers into an outer module
2430 : from a definition module.
2431 :
2432 : The Stack is expected:
2433 :
2434 : Entry OR Entry
2435 :
2436 : Ptr -> Ptr ->
2437 : +------------+ +-----------+
2438 : | # | | # |
2439 : |------------| |-----------|
2440 : | Id1 | | Id1 |
2441 : |------------| |-----------|
2442 : . . . .
2443 : . . . .
2444 : . . . .
2445 : |------------| |-----------|
2446 : | Id# | | Id# |
2447 : |------------| |-----------|
2448 : | ImportTok | | Ident |
2449 : |------------| |-----------|
2450 :
2451 : IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
2452 :
2453 :
2454 : Exit
2455 :
2456 : All above stack discarded
2457 : */
2458 :
2459 400413 : extern "C" void P2SymBuild_BuildImportOuterModule (void)
2460 : {
2461 400413 : unsigned int Sym;
2462 400413 : unsigned int ModSym;
2463 400413 : unsigned int i;
2464 400413 : unsigned int n;
2465 :
2466 400413 : M2Quads_PopT (&n); /* n = # of the Ident List */
2467 400413 : if ((M2Quads_OperandT (n+1)) != M2Reserved_ImportTok)
2468 : {
2469 : /* Ident List contains list of objects imported from ModSym */
2470 351308 : ModSym = M2Batch_LookupModule (M2Quads_OperandTok (n+1), M2Quads_OperandT (n+1));
2471 351308 : i = 1;
2472 1550594 : while (i <= n)
2473 : {
2474 847978 : Sym = SymbolTable_GetExported (M2Quads_OperandTok (i), ModSym, M2Quads_OperandT (i));
2475 847978 : SymbolTable_CheckForEnumerationInCurrentModule (Sym);
2476 847978 : i += 1;
2477 : }
2478 : }
2479 400413 : M2Quads_PopN (n+1); /* clear stack */
2480 400413 : }
2481 :
2482 :
2483 : /*
2484 : BuildExportOuterModule - Builds exported identifiers from an outer module
2485 : to the outside world of library modules.
2486 :
2487 : The Stack is expected:
2488 :
2489 : Entry OR Entry
2490 :
2491 : Ptr -> Ptr ->
2492 : +------------+ +--------------+
2493 : | # | | # |
2494 : |------------| |--------------|
2495 : | Id1 | | Id1 |
2496 : |------------| |--------------|
2497 : . . . .
2498 : . . . .
2499 : . . . .
2500 : |------------| |--------------|
2501 : | Id# | | Id# |
2502 : |------------| |--------------|
2503 : | ExportTok | | QualifiedTok |
2504 : |------------| |--------------|
2505 :
2506 : EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
2507 :
2508 : Error Condition
2509 :
2510 :
2511 : Exit
2512 :
2513 : All above stack discarded
2514 : */
2515 :
2516 85312 : extern "C" void P2SymBuild_BuildExportOuterModule (void)
2517 : {
2518 85312 : unsigned int n;
2519 :
2520 85312 : M2Quads_PopT (&n); /* n = # of the Ident List */
2521 85312 : M2Quads_PopN (n+1); /* n = # of the Ident List */
2522 85312 : }
2523 :
2524 :
2525 : /*
2526 : BuildImportInnerModule - Builds imported identifiers into an inner module
2527 : from the last level of module.
2528 :
2529 : The Stack is expected:
2530 :
2531 : Entry OR Entry
2532 :
2533 : Ptr -> Ptr ->
2534 : +------------+ +-----------+
2535 : | # | | # |
2536 : |------------| |-----------|
2537 : | Id1 | | Id1 |
2538 : |------------| |-----------|
2539 : . . . .
2540 : . . . .
2541 : . . . .
2542 : |------------| |-----------|
2543 : | Id# | | Id# |
2544 : |------------| |-----------|
2545 : | ImportTok | | Ident |
2546 : |------------| |-----------|
2547 :
2548 : IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
2549 :
2550 : Exit
2551 :
2552 : All above stack discarded
2553 : */
2554 :
2555 230 : extern "C" void P2SymBuild_BuildImportInnerModule (void)
2556 : {
2557 230 : unsigned int Sym;
2558 230 : unsigned int ModSym;
2559 230 : unsigned int n;
2560 230 : unsigned int i;
2561 :
2562 230 : M2Quads_PopT (&n); /* i = # of the Ident List */
2563 230 : if ((M2Quads_OperandT (n+1)) == M2Reserved_ImportTok)
2564 : {
2565 : /* Ident List contains list of objects */
2566 : i = 1;
2567 334 : while (i <= n)
2568 : {
2569 170 : Sym = SymbolTable_GetFromOuterModule (M2Quads_OperandTok (i), M2Quads_OperandT (i));
2570 170 : SymbolTable_CheckForEnumerationInCurrentModule (Sym);
2571 170 : i += 1;
2572 : }
2573 : }
2574 : else
2575 : {
2576 : /* Ident List contains list of objects from ModSym */
2577 66 : ModSym = M2Batch_LookupOuterModule (M2Quads_OperandTok (n+1), M2Quads_OperandT (n+1));
2578 66 : i = 1;
2579 198 : while (i <= n)
2580 : {
2581 66 : Sym = SymbolTable_GetExported (M2Quads_OperandTok (i), ModSym, M2Quads_OperandT (i));
2582 66 : SymbolTable_CheckForEnumerationInCurrentModule (Sym);
2583 66 : i += 1;
2584 : }
2585 : }
2586 230 : M2Quads_PopN (n+1); /* Clear Stack */
2587 230 : }
2588 :
2589 :
2590 : /*
2591 : BuildExportInnerModule - Builds exported identifiers from an inner module
2592 : to the next layer module.
2593 :
2594 : The Stack is expected:
2595 :
2596 : Entry OR Entry
2597 :
2598 : Ptr -> Ptr ->
2599 : +------------+ +--------------+
2600 : | # | | # |
2601 : |------------| |--------------|
2602 : | Id1 | | Id1 |
2603 : |------------| |--------------|
2604 : . . . .
2605 : . . . .
2606 : . . . .
2607 : |------------| |--------------|
2608 : | Id# | | Id# |
2609 : |------------| |--------------|
2610 : | ExportTok | | QualifiedTok |
2611 : |------------| |--------------|
2612 :
2613 : EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
2614 :
2615 :
2616 : Exit
2617 :
2618 : All above stack discarded
2619 : */
2620 :
2621 282 : extern "C" void P2SymBuild_BuildExportInnerModule (void)
2622 : {
2623 282 : unsigned int n;
2624 :
2625 282 : M2Quads_PopT (&n);
2626 282 : M2Quads_PopN (n+1); /* clear stack */
2627 282 : }
2628 :
2629 :
2630 : /*
2631 : BuildNumber - Converts a number into a symbol.
2632 :
2633 :
2634 : Stack
2635 :
2636 : Entry Exit
2637 :
2638 : Ptr -> <- Ptr
2639 : +------------+ +-------------------+
2640 : | Name | tok | | Sym | Type | tok |
2641 : |------------+ |-------------------|
2642 : */
2643 :
2644 832305 : extern "C" void P2SymBuild_BuildNumber (void)
2645 : {
2646 832305 : NameKey_Name name;
2647 832305 : unsigned int Sym;
2648 832305 : unsigned int tok;
2649 :
2650 832305 : M2Quads_PopTtok (&name, &tok);
2651 832305 : Sym = SymbolTable_MakeConstLit (tok, name, SymbolTable_NulSym);
2652 832305 : M2Quads_PushTFtok (Sym, SymbolTable_GetType (Sym), tok);
2653 832305 : M2Quads_Annotate ((const char *) "%1s(%1d)||constant number", 25);
2654 832305 : }
2655 :
2656 :
2657 : /*
2658 : BuildString - Converts a string into a symbol.
2659 :
2660 :
2661 : Stack
2662 :
2663 : Entry Exit
2664 :
2665 : Ptr -> <- Ptr
2666 : +-------------+ +--------------------+
2667 : | Name | | tok| | Sym | NulSym | tok |
2668 : |-------------+ |--------------------|
2669 : */
2670 :
2671 158383 : extern "C" void P2SymBuild_BuildString (void)
2672 : {
2673 158383 : NameKey_Name name;
2674 158383 : unsigned int Sym;
2675 158383 : unsigned int tok;
2676 :
2677 158383 : M2Quads_PopTtok (&name, &tok);
2678 : /* slice off the leading and trailing quotes */
2679 158383 : if (name == 1140)
2680 : {
2681 158383 : stop ();
2682 : }
2683 158383 : Sym = SymbolTable_MakeConstString (tok, NameKey_makekey (DynamicStrings_string (DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (name))), 1, -1)))));
2684 158383 : M2Quads_PushTFtok (Sym, static_cast<unsigned int> (SymbolTable_NulSym), tok);
2685 158383 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||constant string", 29);
2686 158383 : }
2687 :
2688 :
2689 : /*
2690 : BuildConst - builds a constant.
2691 : Stack
2692 :
2693 : Entry Exit
2694 :
2695 : Ptr ->
2696 : +------------+
2697 : | Name |
2698 : |------------+ <- Ptr
2699 : */
2700 :
2701 292014 : extern "C" void P2SymBuild_BuildConst (void)
2702 : {
2703 292014 : NameKey_Name name;
2704 292014 : unsigned int sym;
2705 292014 : unsigned int tok;
2706 :
2707 292014 : M2Quads_PopTtok (&name, &tok);
2708 292014 : sym = SymbolTable_MakeConstVar (tok, name);
2709 292014 : M2Quads_PushTtok (sym, tok);
2710 292014 : P2SymBuild_RememberConstant (sym);
2711 292014 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||remembered constant", 33);
2712 292014 : }
2713 :
2714 :
2715 : /*
2716 : StartBuildEnumeration - Builds an Enumeration type Type.
2717 :
2718 :
2719 : Stack
2720 :
2721 : Entry Exit
2722 :
2723 : Ptr ->
2724 : +------------+
2725 : | # |
2726 : |------------|
2727 : | en 1 |
2728 : |------------|
2729 : | en 2 |
2730 : |------------|
2731 : . .
2732 : . .
2733 : . . <- Ptr
2734 : |------------| +------------+
2735 : | en # | | Type |
2736 : |------------| |------------|
2737 : | Name | | Name |
2738 : |------------| |------------|
2739 : */
2740 :
2741 34139 : extern "C" void P2SymBuild_StartBuildEnumeration (void)
2742 : {
2743 34139 : unsigned int n;
2744 34139 : unsigned int Type;
2745 34139 : unsigned int tok;
2746 :
2747 34139 : M2Quads_PopT (&n); /* n := # */
2748 : /* name is in OperandT(n+1) but we dont need it here. */
2749 34139 : tok = static_cast<unsigned int> (M2Quads_OperandTok (n+1));
2750 34139 : FifoQueue_GetEnumerationFromFifoQueue (&Type);
2751 34139 : SymbolTable_CheckForExportedImplementation (Type); /* May be an exported hidden type */
2752 34139 : M2Quads_PopN (n); /* May be an exported hidden type */
2753 34139 : M2Quads_PushTtok (Type, tok);
2754 34139 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||enumerated type", 29);
2755 34139 : }
2756 :
2757 :
2758 : /*
2759 : BuildSubrange - Builds a Subrange type Symbol, the base type can also be
2760 : supplied if known.
2761 :
2762 : Stack
2763 :
2764 : Entry Exit
2765 :
2766 :
2767 : <- Ptr
2768 : +------------+
2769 : Ptr -> | Type |
2770 : +------------+ |------------|
2771 : | Name | | Name |
2772 : |------------| |------------|
2773 : */
2774 :
2775 101862 : extern "C" void P2SymBuild_BuildSubrange (unsigned int tok, unsigned int Base)
2776 : {
2777 101862 : NameKey_Name name;
2778 101862 : unsigned int Type;
2779 :
2780 101862 : M2Quads_PopT (&name);
2781 101862 : Type = SymbolTable_MakeSubrange (tok, name);
2782 101862 : FifoQueue_PutSubrangeIntoFifoQueue (Type); /* Store Subrange away so that we can fill in */
2783 : /* its bounds during pass 3. */
2784 101862 : FifoQueue_PutSubrangeIntoFifoQueue (Base); /* store Base type of subrange away as well. */
2785 101862 : SymbolTable_CheckForExportedImplementation (Type); /* May be an exported hidden type */
2786 101862 : M2Quads_PushTtok (name, tok); /* May be an exported hidden type */
2787 101862 : M2Quads_Annotate ((const char *) "%1n|%3d||subrange name|token no", 31);
2788 101862 : M2Quads_PushTtok (Type, tok);
2789 101862 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||subrange type|token no", 36);
2790 101862 : }
2791 :
2792 :
2793 : /*
2794 : BuildAligned - builds an alignment constant symbol which is placed onto
2795 : the stack. It expects the ident ALIGNED to be on the
2796 : stack.
2797 :
2798 : Stack
2799 :
2800 : Entry Exit
2801 :
2802 :
2803 : Ptr -> <- Ptr
2804 : +---------------+ +-----------------+
2805 : | bytealignment | | AlignmentConst |
2806 : +---------------+ |-----------------|
2807 : */
2808 :
2809 72 : extern "C" void P2SymBuild_BuildAligned (void)
2810 : {
2811 72 : unsigned int tok;
2812 72 : NameKey_Name name;
2813 72 : unsigned int align;
2814 :
2815 72 : M2Quads_PopTtok (&name, &tok);
2816 72 : if (name == (NameKey_MakeKey ((const char *) "bytealignment", 13)))
2817 : {
2818 72 : align = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
2819 72 : SymbolTable_PutConst (align, M2Base_ZType);
2820 72 : FifoQueue_PutConstIntoFifoQueue (align); /* Store align away so that we can fill in its */
2821 72 : M2Quads_PushT (align); /* value during pass 3. */
2822 72 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||bytealignment constant generated from <* *>|token no", 66); /* value during pass 3. */
2823 72 : M2Quads_PushTtok (name, tok);
2824 : }
2825 : else
2826 : {
2827 0 : M2Error_WriteFormat1 ((const char *) "expecting bytealignment identifier, rather than %a", 50, (const unsigned char *) &name, (sizeof (name)-1));
2828 0 : M2Quads_PushT (static_cast<unsigned int> (SymbolTable_NulSym));
2829 : }
2830 72 : M2Quads_Annotate ((const char *) "%1n(%1d)||bytealignment constant generated from <* *>", 53);
2831 72 : }
2832 :
2833 :
2834 : /*
2835 : BuildVarAlignment - the AlignmentConst is either a temporary or NulSym.
2836 : A type may only have one alignment value and
2837 : error checking is performed.
2838 :
2839 : Stack
2840 :
2841 : Entry Exit
2842 :
2843 :
2844 : Ptr ->
2845 : +-----------------+
2846 : | AlignmentConst | <- Ptr
2847 : |-----------------| +------------------+
2848 : | Type | | Type | TypeName |
2849 : |-----------------| |------------------|
2850 : */
2851 :
2852 1294393 : extern "C" void P2SymBuild_BuildVarAlignment (void)
2853 : {
2854 1294393 : unsigned int tokno;
2855 1294393 : NameKey_Name alignment;
2856 1294393 : NameKey_Name newname;
2857 1294393 : unsigned int new_;
2858 1294393 : unsigned int type;
2859 1294393 : unsigned int align;
2860 1294393 : DynamicStrings_String s;
2861 :
2862 1294393 : M2Quads_PopT (&alignment);
2863 1294393 : if (alignment == (NameKey_MakeKey ((const char *) "bytealignment", 13)))
2864 : {
2865 42 : M2Quads_PopT (&align);
2866 42 : M2Quads_PopTtok (&type, &tokno);
2867 42 : if (((((SymbolTable_IsRecord (type)) || (SymbolTable_IsRecordField (type))) || (SymbolTable_IsType (type))) || (SymbolTable_IsArray (type))) || (SymbolTable_IsPointer (type)))
2868 : {
2869 42 : stop ();
2870 42 : if (SymbolTable_IsNameAnonymous (type))
2871 : {
2872 30 : SymbolTable_PutAlignment (type, align);
2873 30 : M2Quads_PushTFtok (type, SymbolTable_GetSymName (type), tokno);
2874 30 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||aligned type|aligned type name|token no", 57);
2875 : }
2876 : else
2877 : {
2878 : /* create a pseudonym */
2879 12 : s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_$A%d", 5)), (const unsigned char *) &alignTypeNo, (sizeof (alignTypeNo)-1));
2880 12 : alignTypeNo += 1;
2881 12 : newname = NameKey_makekey (DynamicStrings_string (s));
2882 12 : if (SymbolTable_IsPointer (type))
2883 : {
2884 0 : new_ = SymbolTable_MakePointer (tokno, newname);
2885 : }
2886 : else
2887 : {
2888 12 : new_ = SymbolTable_MakeType (tokno, newname);
2889 : }
2890 12 : s = DynamicStrings_KillString (s);
2891 12 : SymbolTable_PutType (new_, type);
2892 12 : SymbolTable_PutAlignment (new_, align);
2893 12 : M2Quads_PushTFtok (new_, SymbolTable_GetSymName (new_), tokno);
2894 12 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||aligned type|aligned type name", 48);
2895 : }
2896 : }
2897 : else
2898 : {
2899 0 : M2MetaError_MetaError1 ((const char *) "not allowed to add an alignment attribute to type {%1ad}", 56, type);
2900 0 : M2Quads_PushTFtok (type, SymbolTable_GetSymName (type), tokno);
2901 0 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||error aligned type|error aligned type name", 60);
2902 : }
2903 : }
2904 1294351 : else if (alignment != NameKey_NulName)
2905 : {
2906 : /* avoid dangling else. */
2907 0 : M2Error_WriteFormat1 ((const char *) "unknown variable alignment attribute, %a", 40, (const unsigned char *) &alignment, (sizeof (alignment)-1));
2908 : }
2909 1294393 : }
2910 :
2911 :
2912 : /*
2913 : BuildTypeAlignment - the AlignmentConst is either a temporary or NulSym.
2914 : In the case of NulSym it is popped from the stack
2915 : and the procedure returns. Otherwise the temporary
2916 : is popped and recorded as the alignment value for this
2917 : type. A type may only have one alignment value and
2918 : error checking is performed.
2919 :
2920 : Stack
2921 :
2922 : Entry Exit
2923 :
2924 :
2925 : Ptr ->
2926 : +-----------------+
2927 : | AlignmentConst |
2928 : |-----------------|
2929 : | Type | Empty
2930 : |-----------------|
2931 : */
2932 :
2933 117244 : extern "C" void P2SymBuild_BuildTypeAlignment (void)
2934 : {
2935 117244 : NameKey_Name alignment;
2936 117244 : unsigned int type;
2937 117244 : unsigned int align;
2938 :
2939 117244 : M2Quads_PopT (&alignment);
2940 117244 : if (alignment == (NameKey_MakeKey ((const char *) "bytealignment", 13)))
2941 : {
2942 : /* avoid dangling else. */
2943 30 : M2Quads_PopT (&align);
2944 30 : M2Quads_PopT (&type);
2945 30 : if (align != SymbolTable_NulSym)
2946 : {
2947 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
2948 30 : if ((((((SymbolTable_IsRecord (type)) || (SymbolTable_IsRecordField (type))) || (SymbolTable_IsType (type))) || (SymbolTable_IsArray (type))) || (SymbolTable_IsPointer (type))) || (SymbolTable_IsSubrange (type)))
2949 : {
2950 30 : SymbolTable_PutAlignment (type, align);
2951 : }
2952 : else
2953 : {
2954 0 : M2MetaError_MetaError1 ((const char *) "not allowed to add an alignment attribute to type {%1ad}", 56, type);
2955 : }
2956 : }
2957 : }
2958 117214 : else if (alignment != NameKey_NulName)
2959 : {
2960 : /* avoid dangling else. */
2961 0 : M2Error_WriteFormat1 ((const char *) "unknown type alignment attribute, %a", 36, (const unsigned char *) &alignment, (sizeof (alignment)-1));
2962 : }
2963 : else
2964 : {
2965 : /* avoid dangling else. */
2966 117214 : M2Quads_PopT (&type);
2967 : }
2968 117244 : }
2969 :
2970 36 : extern "C" void P2SymBuild_P2BuildDefaultFieldAlignment (void)
2971 : {
2972 36 : unsigned int tok;
2973 36 : NameKey_Name alignment;
2974 36 : unsigned int align;
2975 :
2976 : /*
2977 : BuildDefaultFieldAlignment -
2978 :
2979 : The Stack:
2980 :
2981 : Entry Exit
2982 : ===== ====
2983 :
2984 :
2985 : Ptr ->
2986 : +-----------+
2987 : | Alignment |
2988 : |-----------| +-----------+
2989 : | RecordSym | | RecordSym |
2990 : |-----------| |-----------|
2991 : | Name | | Name |
2992 : |-----------| |-----------|
2993 :
2994 : */
2995 36 : M2Quads_PopTtok (&alignment, &tok);
2996 36 : align = SymbolTable_MakeTemporary (tok, SymbolTable_ImmediateValue);
2997 36 : SymbolTable_PutConst (align, M2Base_ZType);
2998 36 : FifoQueue_PutConstIntoFifoQueue (align); /* store align away ready for pass 3 */
2999 36 : SymbolTable_PutDefaultRecordFieldAlignment (M2Quads_OperandT (1), align); /* store align away ready for pass 3 */
3000 36 : }
3001 :
3002 :
3003 : /*
3004 : BuildPragmaConst - pushes a constant to the stack and stores it away into the
3005 : const fifo queue ready for pass 3.
3006 : */
3007 :
3008 12 : extern "C" void P2SymBuild_BuildPragmaConst (void)
3009 : {
3010 12 : unsigned int value;
3011 :
3012 12 : value = SymbolTable_MakeTemporary (M2LexBuf_GetTokenNo (), SymbolTable_ImmediateValue);
3013 12 : SymbolTable_PutConst (value, M2Base_ZType);
3014 12 : FifoQueue_PutConstIntoFifoQueue (value); /* Store value away so that we can fill it in */
3015 12 : M2Quads_PushT (value); /* during pass 3. */
3016 12 : M2Quads_Annotate ((const char *) "%1s(%1d)||pragma constant", 25); /* during pass 3. */
3017 12 : }
3018 :
3019 :
3020 : /*
3021 : BuildVariable - Builds variables listed in an IdentList with a Type.
3022 :
3023 : Stack
3024 :
3025 : Entry Exit
3026 :
3027 : Ptr ->
3028 : +------------+ +------------+
3029 : | Type | Name| | |
3030 : |------------| |------------|
3031 : | # | | |
3032 : |------------| |------------|
3033 : | Ident 1 | | |
3034 : |------------| |------------|
3035 : | Ident 2 | | |
3036 : |------------| |------------|
3037 : . . . .
3038 : . . . .
3039 : . . . .
3040 : |------------| |------------|
3041 : | Ident # | | | <- Ptr
3042 : |------------| |------------|
3043 :
3044 : Empty
3045 : */
3046 :
3047 1175478 : extern "C" void P2SymBuild_BuildVariable (void)
3048 : {
3049 1175478 : NameKey_Name name;
3050 1175478 : unsigned int tok;
3051 1175478 : unsigned int typetok;
3052 1175478 : unsigned int AtAddress;
3053 1175478 : unsigned int Type;
3054 1175478 : unsigned int Var;
3055 1175478 : unsigned int i;
3056 1175478 : unsigned int n;
3057 :
3058 1175478 : M2Quads_PopTFtok (&Type, &name, &typetok);
3059 1175478 : M2Quads_PopT (&n);
3060 1175478 : i = 1;
3061 4045882 : while (i <= n)
3062 : {
3063 1694938 : tok = static_cast<unsigned int> (M2Quads_OperandTok ((n+1)-i));
3064 1694938 : M2Students_CheckVariableAgainstKeyword (tok, M2Quads_OperandT ((n+1)-i));
3065 1694938 : Var = SymbolTable_MakeVar (tok, M2Quads_OperandT ((n+1)-i));
3066 1694938 : AtAddress = static_cast<unsigned int> (M2Quads_OperandA ((n+1)-i));
3067 1694938 : if (AtAddress != SymbolTable_NulSym)
3068 : {
3069 54 : SymbolTable_PutVariableAtAddress (Var, SymbolTable_NulSym);
3070 54 : SymbolTable_PutMode (Var, SymbolTable_LeftValue);
3071 : }
3072 1694938 : SymbolTable_PutVarTok (Var, Type, typetok);
3073 1694926 : if (tok != M2LexBuf_UnknownTokenNo)
3074 : {
3075 1694926 : SymbolTable_PutDeclared (tok, Var);
3076 1694926 : SymbolTable_PutVarDeclTok (Var, tok);
3077 : }
3078 1694926 : i += 1;
3079 : }
3080 1175466 : M2Quads_PopN (n);
3081 1175466 : }
3082 :
3083 :
3084 : /*
3085 : BuildType - Builds a Type.
3086 :
3087 :
3088 : Stack
3089 :
3090 : Entry Exit
3091 :
3092 : Ptr ->
3093 : +------------+
3094 : | Type | <- Ptr
3095 : |------------| +---------------+
3096 : | Name | | Type | Name |
3097 : |------------| |---------------|
3098 :
3099 : Empty
3100 : */
3101 :
3102 2016338 : extern "C" void P2SymBuild_BuildType (void)
3103 : {
3104 2016338 : bool isunknown;
3105 2016338 : NameKey_Name n1;
3106 2016338 : NameKey_Name n2;
3107 2016338 : unsigned int Sym;
3108 2016338 : unsigned int Type;
3109 2016338 : NameKey_Name name;
3110 2016338 : unsigned int nametokno;
3111 2016338 : unsigned int typetokno;
3112 :
3113 : /*
3114 : Two cases
3115 :
3116 : - the type name the same as Name, or the name is nul. - do nothing.
3117 : - when type with a name that is different to Name. In which case
3118 : we create a new type.
3119 : */
3120 2016338 : M2Quads_PopTtok (&Type, &typetokno);
3121 2016338 : M2Quads_PopTtok (&name, &nametokno);
3122 2016338 : if (Debugging)
3123 : {
3124 : n1 = SymbolTable_GetSymName (SymbolTable_GetCurrentModule ());
3125 : M2Printf_printf2 ((const char *) "inside module %a declaring type name %a\\n", 41, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &name, (sizeof (name)-1));
3126 : if (! (SymbolTable_IsUnknown (Type)))
3127 : {
3128 : n1 = SymbolTable_GetSymName (SymbolTable_GetScope (Type));
3129 : n2 = SymbolTable_GetSymName (Type);
3130 : M2Printf_printf2 ((const char *) "type was created inside scope %a as name %a\\n", 45, (const unsigned char *) &n1, (sizeof (n1)-1), (const unsigned char *) &n2, (sizeof (n2)-1));
3131 : }
3132 : }
3133 2016338 : if (name == NameKey_NulName)
3134 : {
3135 : /* WriteString('Blank name type') ; WriteLn ; */
3136 1743168 : M2Quads_PushTFtok (Type, name, typetokno);
3137 1743168 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||type|type name|token no", 41);
3138 : }
3139 273170 : else if (SymbolTable_IsError (Type))
3140 : {
3141 : /* avoid dangling else. */
3142 0 : M2Quads_PushTFtok (Type, name, typetokno);
3143 0 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||error type|error type name|token no", 53);
3144 : }
3145 273170 : else if ((SymbolTable_GetSymName (Type)) == name)
3146 : {
3147 : /* avoid dangling else. */
3148 252616 : isunknown = SymbolTable_IsUnknown (Type);
3149 252616 : if (isunknown || (! (SymbolTable_IsDeclaredIn (SymbolTable_GetCurrentScope (), Type))))
3150 : {
3151 1574 : Sym = SymbolTable_MakeType (typetokno, name);
3152 1574 : if (! (SymbolTable_IsError (Sym)))
3153 : {
3154 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
3155 1568 : if (Sym == Type)
3156 : {
3157 0 : if (isunknown)
3158 : {
3159 : /* --fixme-- spellcheck. */
3160 0 : M2MetaError_MetaError2 ((const char *) "attempting to declare a type {%1ad} to a type which is itself and also unknown {%2ad}", 85, Sym, Type);
3161 : }
3162 : else
3163 : {
3164 0 : M2MetaError_MetaError1 ((const char *) "attempting to declare a type {%1ad} as itself", 45, Sym);
3165 : }
3166 : }
3167 : else
3168 : {
3169 1568 : SymbolTable_PutType (Sym, Type);
3170 1568 : SymbolTable_CheckForExportedImplementation (Sym); /* May be an exported hidden type */
3171 : /* if Type is an enumerated type then add its contents to the pseudo scope */
3172 1568 : SymbolTable_CheckForEnumerationInCurrentModule (Type);
3173 : }
3174 : }
3175 1574 : M2Quads_PushTFtok (Sym, name, typetokno);
3176 1574 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||type|type name|token no", 41);
3177 : }
3178 : else
3179 : {
3180 251042 : M2Quads_PushTFtok (Type, name, typetokno);
3181 251042 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||type|type name|token no", 41);
3182 : }
3183 : }
3184 : else
3185 : {
3186 : /* avoid dangling else. */
3187 : /* example TYPE a = CARDINAL */
3188 20554 : Sym = SymbolTable_MakeType (nametokno, name);
3189 20554 : SymbolTable_PutType (Sym, Type);
3190 20554 : SymbolTable_CheckForExportedImplementation (Sym); /* May be an exported hidden type */
3191 20554 : M2Quads_PushTFtok (Sym, name, nametokno); /* May be an exported hidden type */
3192 20554 : M2Quads_Annotate ((const char *) "%1s(%1d)|%2n|%3d||type|type name|token no", 41);
3193 20554 : if (Debugging)
3194 : {
3195 : M2MetaError_MetaErrorT1 (nametokno, (const char *) "type pos {%1Wa}", 15, Sym);
3196 : }
3197 : }
3198 2016338 : }
3199 :
3200 :
3201 : /*
3202 : StartBuildFormalParameters - Initialises the quadruple stack for
3203 : Formal Parameters.
3204 :
3205 : The Stack:
3206 :
3207 : Entry Exit
3208 :
3209 : <- Ptr
3210 : +------------+
3211 : Empty | 0 |
3212 : |------------|
3213 : */
3214 :
3215 5157170 : extern "C" void P2SymBuild_StartBuildFormalParameters (void)
3216 : {
3217 5157170 : M2Quads_PushT (static_cast<unsigned int> (0));
3218 5157170 : M2Quads_Annotate ((const char *) "%1d||running total of no. of parameters", 39);
3219 5157170 : }
3220 :
3221 :
3222 : /*
3223 : EndBuildFormalParameters - Resets the quadruple stack after building
3224 : Formal Parameters.
3225 :
3226 : The Stack:
3227 :
3228 : Entry Exit
3229 :
3230 : Ptr ->
3231 : +------------+
3232 : | NoOfParam | <- Ptr
3233 : |------------| +------------+
3234 : | ProcSym | | ProcSym |
3235 : |------------| |------------|
3236 : */
3237 :
3238 5157170 : extern "C" void P2SymBuild_EndBuildFormalParameters (void)
3239 : {
3240 5157170 : SymbolTable_ProcedureKind kind;
3241 5157170 : SymbolTable_ProcedureKind curkind;
3242 5157170 : unsigned int tok;
3243 5157170 : unsigned int NoOfPar;
3244 5157170 : unsigned int ProcSym;
3245 :
3246 5157170 : M2Quads_PopT (&NoOfPar);
3247 5157170 : M2Quads_PopTtok (&ProcSym, &tok);
3248 5157170 : M2Quads_PushTtok (ProcSym, tok);
3249 5157170 : M2Quads_Annotate ((const char *) "%1s(%1d)||procedure start symbol", 32);
3250 5157170 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
3251 5157170 : curkind = SymbolTable_GetProcedureKind (ProcSym, tok);
3252 25785850 : for (kind=SymbolTable_ProperProcedure; kind<=SymbolTable_DefProcedure; kind= static_cast<SymbolTable_ProcedureKind>(static_cast<int>(kind+1)))
3253 : {
3254 15471510 : if (((SymbolTable_GetProcedureParametersDefined (ProcSym, kind)) && (curkind != kind)) && ((SymbolTable_NoOfParam (ProcSym, kind)) != NoOfPar))
3255 : {
3256 18 : ParameterMismatch (tok, ProcSym, NoOfPar, kind, curkind);
3257 : }
3258 : }
3259 : /* All parameter seen so set procedure defined. */
3260 5157170 : SymbolTable_PutProcedureParametersDefined (ProcSym, curkind);
3261 5157170 : M2Debug_Assert (SymbolTable_IsProcedure (M2Quads_OperandT (1)));
3262 5157170 : }
3263 :
3264 :
3265 : /*
3266 : BuildProcedureHeading - Builds a procedure heading for the definition
3267 : module procedures.
3268 :
3269 : Operation only performed if compiling a
3270 : definition module.
3271 :
3272 : The Stack:
3273 :
3274 : Entry Exit
3275 :
3276 : Ptr ->
3277 : +------------+
3278 : | ProcSym |
3279 : |------------|
3280 : | NameStart |
3281 : |------------|
3282 : Empty
3283 :
3284 : */
3285 :
3286 5157170 : extern "C" void P2SymBuild_BuildProcedureHeading (void)
3287 : {
3288 5157170 : unsigned int tok;
3289 5157170 : unsigned int ProcSym;
3290 5157170 : NameKey_Name NameStart;
3291 :
3292 5157170 : ProcSym = static_cast<unsigned int> (M2Quads_OperandT (1));
3293 5157170 : tok = static_cast<unsigned int> (M2Quads_OperandTok (1));
3294 5157170 : SymbolTable_PutProcedureParametersDefined (ProcSym, SymbolTable_GetProcedureKind (ProcSym, tok));
3295 5157170 : if (M2Comp_CompilingDefinitionModule ())
3296 : {
3297 3273313 : M2Quads_PopT (&ProcSym);
3298 3273313 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
3299 3273313 : M2Quads_PopT (&NameStart);
3300 3273313 : SymbolTable_EndScope ();
3301 : }
3302 5157170 : }
3303 :
3304 :
3305 : /*
3306 : BuildFunction - Builds a procedures return type.
3307 : Procedure becomes a function.
3308 :
3309 : The Stack:
3310 :
3311 : Entry Exit
3312 :
3313 : Ptr ->
3314 : +------------+
3315 : | TypeSym | <- Ptr
3316 : |------------| +------------+
3317 : | ProcSym | | ProcSym |
3318 : |------------| |------------|
3319 : */
3320 :
3321 3007905 : extern "C" void P2SymBuild_BuildFunction (void)
3322 : {
3323 3007905 : unsigned int tok;
3324 3007905 : unsigned int ProcSym;
3325 3007905 : unsigned int typetok;
3326 3007905 : unsigned int RetType;
3327 :
3328 3007905 : M2Quads_PopTtok (&RetType, &typetok);
3329 3007905 : M2Quads_PopTtok (&ProcSym, &tok);
3330 3007905 : M2Quads_PushTtok (ProcSym, tok);
3331 3007905 : SymbolTable_PutFunction (typetok, ProcSym, SymbolTable_GetProcedureKind (ProcSym, tok), RetType);
3332 3007905 : CheckOptFunction (tok, ProcSym, SymbolTable_GetProcedureKind (ProcSym, tok), false);
3333 3007905 : CheckProcedureReturn (RetType, typetok);
3334 3007905 : }
3335 :
3336 :
3337 : /*
3338 : BuildOptFunction - Builds a procedures optional return type.
3339 : Procedure becomes a function and the user
3340 : can either call it as a function or a procedure.
3341 :
3342 : The Stack:
3343 :
3344 : Entry Exit
3345 :
3346 : Ptr ->
3347 : +------------+
3348 : | TypeSym | <- Ptr
3349 : |------------| +------------+
3350 : | ProcSym | | ProcSym |
3351 : |------------| |------------|
3352 : */
3353 :
3354 133810 : extern "C" void P2SymBuild_BuildOptFunction (void)
3355 : {
3356 133810 : unsigned int typetok;
3357 133810 : unsigned int tok;
3358 133810 : unsigned int RetType;
3359 133810 : unsigned int ProcSym;
3360 :
3361 133810 : M2Quads_PopTtok (&RetType, &typetok);
3362 133810 : M2Quads_PopTtok (&ProcSym, &tok);
3363 133810 : SymbolTable_PutOptFunction (typetok, ProcSym, SymbolTable_GetProcedureKind (ProcSym, tok), RetType);
3364 133810 : CheckOptFunction (tok, ProcSym, SymbolTable_GetProcedureKind (ProcSym, tok), true);
3365 133810 : M2Quads_PushTtok (ProcSym, tok);
3366 133810 : }
3367 :
3368 :
3369 : /*
3370 : BuildFPSection - Builds a Formal Parameter in a procedure.
3371 :
3372 : The Stack:
3373 :
3374 : Entry Exit
3375 :
3376 : Ptr ->
3377 : +------------+
3378 : | ParamTotal |
3379 : |------------|
3380 : | TypeSym |
3381 : |------------|
3382 : | Array/Nul |
3383 : |------------|
3384 : | NoOfIds |
3385 : |------------|
3386 : | Id 1 |
3387 : |------------|
3388 : . .
3389 : . .
3390 : . .
3391 : |------------|
3392 : | Id n | <- Ptr
3393 : |------------| +------------+
3394 : | Var / Nul | | ParamTotal |
3395 : |------------| |------------|
3396 : | ProcSym | | ProcSym |
3397 : |------------| |------------|
3398 : */
3399 :
3400 8350554 : extern "C" void P2SymBuild_BuildFPSection (void)
3401 : {
3402 8350554 : SymbolTable_ProcedureKind kind;
3403 8350554 : SymbolTable_ProcedureKind curkind;
3404 8350554 : unsigned int tok;
3405 8350554 : unsigned int top;
3406 8350554 : unsigned int ProcSym;
3407 8350554 : unsigned int ParamTotal;
3408 :
3409 8350554 : top = M2Quads_Top ();
3410 8350554 : M2Quads_PopT (&ParamTotal);
3411 8350554 : ProcSym = (unsigned int ) (M2Quads_OperandT ((3+((unsigned int ) (M2Quads_OperandT (3))))+2));
3412 8350554 : tok = (unsigned int ) (M2Quads_OperandTok ((3+((unsigned int ) (M2Quads_OperandT (3))))+2));
3413 : /* Debug (tok, ProcSym, 'foo') ; */
3414 8350554 : curkind = SymbolTable_GetProcedureKind (ProcSym, tok);
3415 8350554 : M2Quads_PushT (ParamTotal);
3416 8350554 : M2Quads_Annotate ((const char *) "%1d||running total of no. of parameters", 39);
3417 16701108 : M2Debug_Assert ((SymbolTable_IsProcedure (ProcSym)) || (SymbolTable_IsProcType (ProcSym)));
3418 8350554 : M2Debug_Assert (top == (M2Quads_Top ()));
3419 8350554 : ProcSym = (unsigned int ) (M2Quads_OperandT (((3+((unsigned int ) (M2Quads_OperandT (3+1))))+2)+1));
3420 16701108 : M2Debug_Assert ((SymbolTable_IsProcedure (ProcSym)) || (SymbolTable_IsProcType (ProcSym)));
3421 8350554 : if (! (SymbolTable_GetProcedureParametersDefined (ProcSym, curkind)))
3422 : {
3423 8350554 : BuildFormalParameterSection (curkind);
3424 : }
3425 33402216 : for (kind=SymbolTable_ProperProcedure; kind<=SymbolTable_DefProcedure; kind= static_cast<SymbolTable_ProcedureKind>(static_cast<int>(kind+1)))
3426 : {
3427 : /* Check against any previous declaration. */
3428 25051662 : if ((kind != curkind) && (SymbolTable_GetProcedureParametersDefined (ProcSym, kind)))
3429 : {
3430 1978004 : M2Debug_Assert (top == (M2Quads_Top ()));
3431 1978004 : CheckFormalParameterSection (curkind, kind);
3432 1978004 : M2Debug_Assert (top == (M2Quads_Top ()));
3433 : }
3434 25051662 : ProcSym = (unsigned int ) (M2Quads_OperandT (((3+((unsigned int ) (M2Quads_OperandT (3+1))))+2)+1));
3435 50103324 : M2Debug_Assert ((SymbolTable_IsProcedure (ProcSym)) || (SymbolTable_IsProcType (ProcSym)));
3436 : }
3437 8350554 : RemoveFPParameters ();
3438 8350554 : M2Debug_Assert (SymbolTable_IsProcedure (M2Quads_OperandT (2)));
3439 8350554 : }
3440 :
3441 :
3442 : /*
3443 : BuildVarArgs - indicates that the ProcSym takes varargs
3444 : after ParamTotal.
3445 : <- Ptr
3446 : +------------+ +------------+
3447 : | ParamTotal | | ParamTotal |
3448 : |------------| |------------|
3449 : | ProcSym | | ProcSym |
3450 : |------------| |------------|
3451 :
3452 : */
3453 :
3454 11332 : extern "C" void P2SymBuild_BuildVarArgs (void)
3455 : {
3456 11332 : SymbolTable_ProcedureKind kind;
3457 11332 : unsigned int tok;
3458 11332 : unsigned int ProcSym;
3459 11332 : unsigned int ParamTotal;
3460 :
3461 11332 : M2Quads_PopT (&ParamTotal);
3462 11332 : M2Quads_PopTtok (&ProcSym, &tok);
3463 11332 : kind = SymbolTable_GetProcedureKind (ProcSym, tok);
3464 11332 : if (SymbolTable_UsesOptArg (ProcSym, kind))
3465 : {
3466 0 : M2Error_WriteFormat0 ((const char *) "procedure can use either a single optional argument or a single vararg section ... at the end of the formal parameter list", 122);
3467 : }
3468 11332 : if (SymbolTable_UsesVarArgs (ProcSym))
3469 : {
3470 0 : M2Error_WriteFormat0 ((const char *) "procedure can only have one vararg section ... at the end of the formal parameter list", 86);
3471 : }
3472 11332 : SymbolTable_PutUseVarArgs (ProcSym);
3473 11332 : if (SymbolTable_IsDefImp (SymbolTable_GetCurrentModule ()))
3474 : {
3475 : /* avoid dangling else. */
3476 11332 : if (! (SymbolTable_IsDefinitionForC (SymbolTable_GetCurrentModule ())))
3477 : {
3478 0 : M2Error_WriteFormat0 ((const char *) "the definition module must be declared as DEFINITION MODULE FOR \"C\" if varargs are to be used", 93);
3479 : }
3480 : }
3481 : else
3482 : {
3483 0 : M2Error_WriteFormat0 ((const char *) "varargs can only be used in the module declared as DEFINITION MODULE FOR \"C\"", 76);
3484 : }
3485 11332 : M2Quads_PushTtok (ProcSym, tok);
3486 11332 : M2Quads_PushT (ParamTotal);
3487 11332 : }
3488 :
3489 :
3490 : /*
3491 : BuildFormalVarArgs - indicates that the procedure type takes varargs.
3492 :
3493 : <- Ptr
3494 : +------------+ +------------+
3495 : | ProcSym | | ProcSym |
3496 : |------------| |------------|
3497 :
3498 : */
3499 :
3500 0 : extern "C" void P2SymBuild_BuildFormalVarArgs (void)
3501 : {
3502 0 : unsigned int ProcSym;
3503 :
3504 0 : M2Quads_PopT (&ProcSym);
3505 0 : if (SymbolTable_UsesVarArgs (ProcSym))
3506 : {
3507 0 : M2Error_WriteFormat0 ((const char *) "procedure type can only have one vararg section ... at the end of the formal parameter list", 91);
3508 : }
3509 0 : SymbolTable_PutUseVarArgs (ProcSym);
3510 0 : if (SymbolTable_IsDefImp (SymbolTable_GetCurrentModule ()))
3511 : {
3512 : /* avoid dangling else. */
3513 0 : if (! (SymbolTable_IsDefinitionForC (SymbolTable_GetCurrentModule ())))
3514 : {
3515 0 : M2Error_WriteFormat0 ((const char *) "the definition module must be declared as DEFINITION MODULE FOR \"C\" if varargs are to be used", 93);
3516 : }
3517 : }
3518 : else
3519 : {
3520 0 : M2Error_WriteFormat0 ((const char *) "varargs can only be used in the module declared as DEFINITION MODULE FOR \"C\"", 76);
3521 : }
3522 0 : M2Quads_PushT (ProcSym);
3523 0 : }
3524 :
3525 :
3526 : /*
3527 : BuildOptArg - indicates that the ProcSym takes a single optarg
3528 : after ParamTotal.
3529 :
3530 : <- Ptr
3531 : +------------+ +------------+
3532 : | ParamTotal | | ParamTotal |
3533 : |------------| |------------|
3534 : | ProcSym | | ProcSym |
3535 : |------------| |------------|
3536 : */
3537 :
3538 17618 : extern "C" void P2SymBuild_BuildOptArg (void)
3539 : {
3540 17618 : SymbolTable_ProcedureKind kind;
3541 17618 : unsigned int tok;
3542 17618 : unsigned int ProcSym;
3543 17618 : unsigned int ParamTotal;
3544 :
3545 17618 : M2Quads_PopT (&ParamTotal);
3546 17618 : M2Quads_PopTtok (&ProcSym, &tok);
3547 17618 : kind = SymbolTable_GetProcedureKind (ProcSym, tok);
3548 17618 : if (SymbolTable_UsesVarArgs (ProcSym))
3549 : {
3550 0 : M2Error_WriteFormat0 ((const char *) "procedure can not use an optional argument after a vararg ...", 61);
3551 : }
3552 17618 : SymbolTable_PutUseOptArg (ProcSym, kind);
3553 17618 : M2Quads_PushTtok (ProcSym, tok);
3554 17618 : M2Quads_PushT (ParamTotal);
3555 17618 : }
3556 :
3557 :
3558 : /*
3559 : StartBuildProcedure - Builds a Procedure.
3560 :
3561 : The Stack:
3562 :
3563 : Entry Exit
3564 :
3565 : <- Ptr
3566 : +------------+
3567 : Ptr -> | ProcSym |
3568 : +------------+ |------------|
3569 : | Name | | Name |
3570 : |------------| |------------|
3571 : */
3572 :
3573 5157170 : extern "C" void P2SymBuild_StartBuildProcedure (void)
3574 : {
3575 5157170 : NameKey_Name name;
3576 5157170 : unsigned int ProcSym;
3577 5157170 : unsigned int tokno;
3578 :
3579 5157170 : M2Quads_PopTtok (&name, &tokno);
3580 5157170 : M2Quads_PushTtok (name, tokno); /* name saved for the EndBuildProcedure name check */
3581 5157170 : M2Quads_Annotate ((const char *) "%1n|(%1d)||procedure name saved by StartBuildProcedure", 54); /* name saved for the EndBuildProcedure name check */
3582 5157170 : ProcSym = SymbolTable_GetDeclareSym (tokno, name);
3583 5157170 : if (SymbolTable_IsUnknown (ProcSym))
3584 : {
3585 : /* May have been compiled in the definition or implementation module.
3586 : Note we always see an implementation module before its corresponding
3587 : definition module. */
3588 0 : ProcSym = SymbolTable_MakeProcedure (tokno, name);
3589 : }
3590 5157170 : else if (SymbolTable_IsProcedure (ProcSym))
3591 : {
3592 : /* avoid dangling else. */
3593 5157170 : SymbolTable_PutDeclared (tokno, ProcSym);
3594 : }
3595 : else
3596 : {
3597 : /* avoid dangling else. */
3598 0 : M2Error_ErrorStringAt2 (FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "procedure name (%a) has been declared as another object elsewhere", 65)), (const unsigned char *) &name, (sizeof (name)-1)), tokno, SymbolTable_GetDeclaredMod (ProcSym));
3599 : }
3600 5157170 : if (M2Comp_CompilingDefinitionModule ())
3601 : {
3602 3273313 : SymbolTable_PutExportUnImplemented (tokno, ProcSym); /* Defined but not yet implemented */
3603 : }
3604 : else
3605 : {
3606 1883857 : SymbolTable_CheckForExportedImplementation (ProcSym); /* May be exported procedure */
3607 : }
3608 5157170 : M2Quads_PushTtok (ProcSym, tokno);
3609 5157170 : M2Quads_Annotate ((const char *) "%1s(%1d)||procedure start symbol", 32);
3610 5157170 : SymbolTable_StartScope (ProcSym);
3611 5157170 : M2Error_EnterProcedureScope (name);
3612 5157170 : }
3613 :
3614 :
3615 : /*
3616 : EndBuildProcedure - Ends building a Procedure.
3617 : It checks the start procedure name matches the end
3618 : procedure name.
3619 :
3620 : The Stack:
3621 :
3622 : (Procedure Not Defined in definition module)
3623 :
3624 : Entry Exit
3625 :
3626 : Ptr ->
3627 : +------------+
3628 : | NameEnd |
3629 : |------------|
3630 : | ProcSym |
3631 : |------------|
3632 : | NameStart |
3633 : |------------|
3634 : Empty
3635 : */
3636 :
3637 1883809 : extern "C" void P2SymBuild_EndBuildProcedure (void)
3638 : {
3639 1883809 : NameKey_Name NameEnd;
3640 1883809 : NameKey_Name NameStart;
3641 1883809 : unsigned int tok;
3642 1883809 : unsigned int ProcSym;
3643 1883809 : SymbolTable_ProcedureKind kind;
3644 :
3645 1883809 : M2Quads_PopT (&NameEnd);
3646 1883809 : M2Quads_PopTtok (&ProcSym, &tok);
3647 1883809 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
3648 1883809 : kind = SymbolTable_GetProcedureKind (ProcSym, tok);
3649 1883809 : M2Quads_PopT (&NameStart);
3650 1883809 : if (NameEnd != NameStart)
3651 : {
3652 0 : M2Error_WriteFormat2 ((const char *) "end procedure name does not match beginning %a name %a", 54, (const unsigned char *) &NameStart, (sizeof (NameStart)-1), (const unsigned char *) &NameEnd, (sizeof (NameEnd)-1));
3653 : }
3654 1883809 : SymbolTable_PutProcedureParameterHeapVars (ProcSym);
3655 1883809 : SymbolTable_PutProcedureDefined (ProcSym, kind);
3656 1883809 : SymbolTable_EndScope ();
3657 1883809 : M2Error_LeaveErrorScope ();
3658 1883809 : }
3659 :
3660 :
3661 : /*
3662 : EndBuildForward - ends building a forward procedure.
3663 : */
3664 :
3665 48 : extern "C" void P2SymBuild_EndBuildForward (void)
3666 : {
3667 48 : M2Quads_PopN (2);
3668 48 : SymbolTable_EndScope ();
3669 48 : M2Error_LeaveErrorScope ();
3670 48 : }
3671 :
3672 :
3673 : /*
3674 : BuildNoReturnAttribute - provide an interface to the symbol table module.
3675 : */
3676 :
3677 468876 : extern "C" void P2SymBuild_BuildNoReturnAttribute (void)
3678 : {
3679 468876 : SymbolTable_ProcedureKind kind;
3680 468876 : unsigned int ProcSym;
3681 468876 : unsigned int tok;
3682 :
3683 468876 : M2Quads_PopTtok (&ProcSym, &tok);
3684 468876 : M2Quads_PushTtok (ProcSym, tok);
3685 468876 : kind = SymbolTable_GetProcedureKind (ProcSym, tok);
3686 468876 : M2Debug_Assert (SymbolTable_IsProcedure (ProcSym));
3687 468876 : SymbolTable_PutProcedureNoReturn (ProcSym, kind, true);
3688 468876 : }
3689 :
3690 :
3691 : /*
3692 : CheckProcedure - checks to see that the top of stack procedure
3693 : has not been declared as a procedure function.
3694 :
3695 : The Stack:
3696 :
3697 : Entry Exit
3698 :
3699 : Ptr -> <- Ptr
3700 : +------------+ +------------+
3701 : | ProcSym | | ProcSym |
3702 : |------------| |------------|
3703 : */
3704 :
3705 1851793 : extern "C" void P2SymBuild_CheckProcedure (void)
3706 : {
3707 1851793 : CheckProcedureReturn (SymbolTable_NulSym, M2LexBuf_UnknownTokenNo);
3708 1851793 : }
3709 :
3710 :
3711 : /*
3712 : BuildPointerType - builds a pointer type.
3713 : The Stack:
3714 :
3715 : Entry Exit
3716 : ===== ====
3717 :
3718 :
3719 : Ptr -> <- Ptr
3720 : +------------+ +-------------+
3721 : | Type | | PointerType |
3722 : |------------| |-------------|
3723 : | Name | | Name |
3724 : |------------| |-------------|
3725 : */
3726 :
3727 100907 : extern "C" void P2SymBuild_BuildPointerType (unsigned int pointerpos)
3728 : {
3729 100907 : unsigned int combined;
3730 100907 : unsigned int namepos;
3731 100907 : unsigned int typepos;
3732 100907 : NameKey_Name name;
3733 100907 : unsigned int Type;
3734 100907 : unsigned int PtrToType;
3735 :
3736 100907 : M2Quads_PopTtok (&Type, &typepos);
3737 100907 : M2Quads_PopTtok (&name, &namepos);
3738 100907 : name = SymbolTable_CheckAnonymous (name);
3739 100907 : combined = M2LexBuf_MakeVirtual2Tok (pointerpos, typepos);
3740 100907 : PtrToType = SymbolTable_MakePointer (combined, name);
3741 100907 : SymbolTable_PutPointer (PtrToType, Type);
3742 100907 : SymbolTable_CheckForExportedImplementation (PtrToType); /* May be an exported hidden type */
3743 100907 : M2Quads_PushTtok (name, namepos); /* May be an exported hidden type */
3744 100907 : M2Quads_Annotate ((const char *) "%1n|%3d||pointer type name", 26);
3745 100907 : M2Quads_PushTtok (PtrToType, combined);
3746 100907 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||pointer type", 26);
3747 100907 : }
3748 :
3749 :
3750 : /*
3751 : BuildSetType - builds a set type.
3752 : The Stack:
3753 :
3754 : Entry Exit
3755 : ===== ====
3756 :
3757 :
3758 : Ptr -> <- Ptr
3759 : +------------+ +-------------+
3760 : | Type | | SetType |
3761 : |------------| |-------------|
3762 : | Name | | Name |
3763 : |------------| |-------------|
3764 : */
3765 :
3766 4742 : extern "C" void P2SymBuild_BuildSetType (unsigned int setpos, bool ispacked)
3767 : {
3768 4742 : unsigned int combined;
3769 4742 : unsigned int namepos;
3770 4742 : unsigned int typepos;
3771 4742 : NameKey_Name name;
3772 4742 : unsigned int Type;
3773 4742 : unsigned int SetType;
3774 :
3775 4742 : M2Quads_PopTtok (&Type, &typepos);
3776 4742 : M2Quads_PopTtok (&name, &namepos);
3777 4742 : combined = M2LexBuf_MakeVirtual2Tok (setpos, typepos);
3778 4742 : SetType = SymbolTable_MakeSet (combined, name);
3779 4742 : SymbolTable_CheckForExportedImplementation (SetType); /* May be an exported hidden type */
3780 4742 : SymbolTable_PutSet (SetType, Type, ispacked); /* May be an exported hidden type */
3781 4742 : M2Quads_PushTtok (name, namepos);
3782 4742 : M2Quads_Annotate ((const char *) "%1n||set type name", 18);
3783 4742 : M2Quads_PushTtok (SetType, combined);
3784 4742 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||set type|token no", 31);
3785 4742 : }
3786 :
3787 :
3788 : /*
3789 : BuildRecord - Builds a record type.
3790 : The Stack:
3791 :
3792 : Entry Exit
3793 : ===== ====
3794 :
3795 :
3796 : <- Ptr
3797 : +-----------+
3798 : Ptr -> | RecordSym |
3799 : +------------------+ |-----------|
3800 : | Name | | Name |
3801 : |------------------| |-----------|
3802 : */
3803 :
3804 71491 : extern "C" void P2SymBuild_BuildRecord (void)
3805 : {
3806 71491 : unsigned int tokno;
3807 71491 : NameKey_Name name;
3808 71491 : unsigned int RecordType;
3809 :
3810 71491 : name = static_cast<NameKey_Name> (M2Quads_OperandT (1));
3811 71491 : name = SymbolTable_CheckAnonymous (name);
3812 71491 : tokno = static_cast<unsigned int> (M2Quads_OperandTok (1));
3813 71491 : RecordType = SymbolTable_MakeRecord (tokno, name);
3814 71491 : SymbolTable_CheckForExportedImplementation (RecordType); /* May be an exported hidden type */
3815 71491 : M2Quads_PushT (RecordType);
3816 : /* ; WriteKey(name) ; WriteString(' RECORD made') ; WriteLn */
3817 71491 : M2Quads_Annotate ((const char *) "%1s(%1d)||record type", 21);
3818 71491 : }
3819 :
3820 :
3821 : /*
3822 : BuildFieldRecord - Builds a field into a record sym.
3823 : The Stack:
3824 :
3825 :
3826 : Entry Exit
3827 : ===== ====
3828 :
3829 : Ptr ->
3830 : +-------------+
3831 : | NoOfPragmas |
3832 : |-------------|
3833 : | Const1 |
3834 : |-------------|
3835 : | PragmaName1 |
3836 : |-------------|
3837 : | Type | Name |
3838 : |-------------|
3839 : | n |
3840 : |-------------|
3841 : | Id 1 |
3842 : |-------------|
3843 : . .
3844 : . .
3845 : . .
3846 : |-------------|
3847 : | Id n | <- Ptr
3848 : |-------------| +-------------+
3849 : | RecordSym | | RecordSym |
3850 : |-------------| |-------------|
3851 : | RecordName | | RecordName |
3852 : |-------------| |-------------|
3853 : */
3854 :
3855 298946 : extern "C" void P2SymBuild_BuildFieldRecord (void)
3856 : {
3857 298946 : NameKey_Name n1;
3858 298946 : unsigned int tok;
3859 298946 : unsigned int fsym;
3860 298946 : unsigned int Field;
3861 298946 : unsigned int Varient;
3862 298946 : unsigned int Parent;
3863 298946 : unsigned int Type;
3864 298946 : unsigned int NoOfPragmas;
3865 298946 : unsigned int NoOfFields;
3866 298946 : unsigned int Record;
3867 298946 : unsigned int i;
3868 :
3869 298946 : M2Quads_PopT (&NoOfPragmas);
3870 298946 : Type = static_cast<unsigned int> (M2Quads_OperandT ((NoOfPragmas*2)+1));
3871 : /* name := OperandF(NoOfPragmas*2+1) ; */
3872 298946 : NoOfFields = static_cast<unsigned int> (M2Quads_OperandT ((NoOfPragmas*2)+2));
3873 298946 : Record = static_cast<unsigned int> (M2Quads_OperandT (((NoOfPragmas*2)+NoOfFields)+3));
3874 298946 : if (SymbolTable_IsRecord (Record))
3875 : {
3876 : Parent = Record;
3877 : Varient = SymbolTable_NulSym;
3878 : }
3879 : else
3880 : {
3881 : /* Record maybe FieldVarient */
3882 6000 : Parent = SymbolTable_GetRecord (SymbolTable_GetParent (Record));
3883 5994 : M2Debug_Assert (SymbolTable_IsFieldVarient (Record));
3884 5994 : Varient = static_cast<unsigned int> (M2Quads_OperandT (((NoOfPragmas*2)+NoOfFields)+4));
3885 5994 : M2Debug_Assert (SymbolTable_IsVarient (Varient));
3886 5994 : SymbolTable_PutFieldVarient (Record, Varient);
3887 5994 : if (Debugging)
3888 : {
3889 : n1 = SymbolTable_GetSymName (Record);
3890 : StrIO_WriteString ((const char *) "Record ", 7);
3891 : NameKey_WriteKey (n1);
3892 : StrIO_WriteString ((const char *) " has varient ", 13);
3893 : n1 = SymbolTable_GetSymName (Varient);
3894 : NameKey_WriteKey (n1);
3895 : StrIO_WriteLn ();
3896 : }
3897 : }
3898 298940 : Field = SymbolTable_NulSym;
3899 298940 : i = 1;
3900 642812 : while (i <= NoOfFields)
3901 : {
3902 343872 : if (Debugging)
3903 : {
3904 : n1 = SymbolTable_GetSymName (Record);
3905 : StrIO_WriteString ((const char *) "Record ", 7);
3906 : NameKey_WriteKey (n1);
3907 : StrIO_WriteString ((const char *) " ", 2);
3908 : NameKey_WriteKey (M2Quads_OperandT ((((NoOfPragmas*2)+NoOfFields)+3)-i));
3909 : StrIO_WriteString ((const char *) " is a Field with type ", 22);
3910 : NameKey_WriteKey (SymbolTable_GetSymName (Type));
3911 : StrIO_WriteLn ();
3912 : }
3913 343872 : fsym = SymbolTable_GetLocalSym (Parent, M2Quads_OperandT ((((NoOfPragmas*2)+NoOfFields)+3)-i));
3914 343872 : if (fsym == SymbolTable_NulSym)
3915 : {
3916 343866 : Field = SymbolTable_PutFieldRecord (Record, M2Quads_OperandT ((((NoOfPragmas*2)+NoOfFields)+3)-i), Type, Varient);
3917 343866 : HandleRecordFieldPragmas (Record, Field, NoOfPragmas);
3918 : }
3919 : else
3920 : {
3921 6 : M2MetaError_MetaErrors2 ((const char *) "record field {%1ad} has already been declared inside a {%2Ddv} {%2a}", 68, (const char *) "attempting to declare a duplicate record field", 46, fsym, Parent);
3922 : }
3923 : /* adjust the location of declaration to the one on the stack (rather than GetTokenNo). */
3924 343872 : tok = static_cast<unsigned int> (M2Quads_OperandTok ((((NoOfPragmas*2)+NoOfFields)+3)-i));
3925 343872 : if ((tok != M2LexBuf_UnknownTokenNo) && (Field != SymbolTable_NulSym))
3926 : {
3927 343866 : SymbolTable_PutDeclared (tok, Field);
3928 : }
3929 343872 : i += 1;
3930 : }
3931 298940 : M2Quads_PopN (((NoOfPragmas*2)+NoOfFields)+3);
3932 298940 : M2Quads_PushT (Record);
3933 298940 : if (SymbolTable_IsRecord (Record))
3934 : {
3935 292946 : M2Quads_Annotate ((const char *) "%1s(%1d)||record type", 21);
3936 : }
3937 : else
3938 : {
3939 5994 : M2Debug_Assert (SymbolTable_IsFieldVarient (Record));
3940 5994 : M2Quads_Annotate ((const char *) "%1s(%1d)||varient field type", 28);
3941 : }
3942 298940 : }
3943 :
3944 :
3945 : /*
3946 : StartBuildVarient - Builds a varient symbol on top of a record sym.
3947 : The Stack:
3948 :
3949 :
3950 : Entry Exit
3951 : ===== ====
3952 :
3953 : <- Ptr
3954 : +-------------+
3955 : Ptr -> | VarientSym |
3956 : +-------------+ |-------------|
3957 : | RecordSym | | RecordSym |
3958 : |-------------| |-------------|
3959 : | RecordName | | RecordName |
3960 : |-------------| |-------------|
3961 : */
3962 :
3963 2988 : extern "C" void P2SymBuild_StartBuildVarient (void)
3964 : {
3965 2988 : unsigned int tokno;
3966 2988 : unsigned int RecordSym;
3967 2988 : unsigned int Sym;
3968 :
3969 2988 : RecordSym = static_cast<unsigned int> (M2Quads_OperandT (1));
3970 2988 : tokno = static_cast<unsigned int> (M2Quads_OperandTok (1));
3971 2988 : Sym = SymbolTable_MakeVarient (tokno, RecordSym);
3972 2988 : M2Quads_PushT (Sym);
3973 2988 : M2Quads_Annotate ((const char *) "%1s(%1d)||varient type", 22);
3974 2988 : }
3975 :
3976 :
3977 : /*
3978 : EndBuildVarient - Removes the varient symbol from the stack.
3979 : The Stack:
3980 :
3981 : Entry Exit
3982 : ===== ====
3983 :
3984 : Ptr ->
3985 : +-------------+
3986 : | VarientSym | <- Ptr
3987 : |-------------| +-------------+
3988 : | RecordSym | | RecordSym |
3989 : |-------------| |-------------|
3990 : | RecordName | | RecordName |
3991 : |-------------| |-------------|
3992 : */
3993 :
3994 2988 : extern "C" void P2SymBuild_EndBuildVarient (void)
3995 : {
3996 2988 : unsigned int Sym;
3997 :
3998 2988 : M2Quads_PopT (&Sym);
3999 2988 : }
4000 :
4001 :
4002 : /*
4003 : BuildVarientSelector - Builds a field into a record sym.
4004 : The Stack:
4005 :
4006 :
4007 : Entry Exit
4008 : ===== ====
4009 :
4010 : Ptr ->
4011 : +-------------+
4012 : | Type |
4013 : |-------------|
4014 : | Tag | <- Ptr
4015 : |-------------| +-------------+
4016 : | RecordSym | | RecordSym |
4017 : |-------------| |-------------|
4018 : */
4019 :
4020 2988 : extern "C" void P2SymBuild_BuildVarientSelector (void)
4021 : {
4022 2988 : unsigned int tagtok;
4023 2988 : NameKey_Name tag;
4024 2988 : unsigned int Field;
4025 2988 : unsigned int Type;
4026 2988 : unsigned int Varient;
4027 2988 : unsigned int VarField;
4028 2988 : unsigned int Record;
4029 :
4030 2988 : M2Quads_PopT (&Type);
4031 2988 : M2Quads_PopTtok (&tag, &tagtok);
4032 2988 : Record = static_cast<unsigned int> (M2Quads_OperandT (1));
4033 2988 : if (SymbolTable_IsRecord (Record))
4034 : {
4035 0 : Varient = SymbolTable_NulSym;
4036 0 : M2Error_InternalError ((const char *) "not expecting a record symbol", 29);
4037 : }
4038 2988 : else if (SymbolTable_IsVarient (Record))
4039 : {
4040 : /* avoid dangling else. */
4041 2988 : Varient = Record;
4042 2988 : VarField = SymbolTable_GetParent (Varient);
4043 2988 : if ((Type == SymbolTable_NulSym) && (tag == NameKey_NulName))
4044 : {
4045 0 : M2MetaError_MetaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, Record);
4046 : }
4047 2988 : else if (Type == SymbolTable_NulSym)
4048 : {
4049 : /* avoid dangling else. */
4050 12 : SymbolTable_PutVarientTag (Varient, SymbolTable_RequestSym (tagtok, tag));
4051 : }
4052 : else
4053 : {
4054 : /* avoid dangling else. */
4055 2976 : Field = SymbolTable_PutFieldRecord (VarField, tag, Type, Varient);
4056 2976 : SymbolTable_PutVarientTag (Varient, Field);
4057 2976 : if (Debugging)
4058 : {
4059 : StrIO_WriteString ((const char *) "varient field ", 14);
4060 : NameKey_WriteKey (SymbolTable_GetSymName (VarField));
4061 : StrIO_WriteString ((const char *) "varient ", 8);
4062 : NameKey_WriteKey (SymbolTable_GetSymName (Varient));
4063 : StrIO_WriteLn ();
4064 : }
4065 : }
4066 : }
4067 : else
4068 : {
4069 : /* avoid dangling else. */
4070 : /* Record maybe FieldVarient */
4071 0 : M2Debug_Assert (SymbolTable_IsFieldVarient (Record));
4072 0 : Varient = static_cast<unsigned int> (M2Quads_OperandT (1+2));
4073 0 : M2Debug_Assert (SymbolTable_IsVarient (Varient));
4074 0 : SymbolTable_PutFieldVarient (Record, Varient);
4075 0 : if (Debugging)
4076 : {
4077 : StrIO_WriteString ((const char *) "record ", 7);
4078 : NameKey_WriteKey (SymbolTable_GetSymName (Record));
4079 : StrIO_WriteString ((const char *) "varient ", 8);
4080 : NameKey_WriteKey (SymbolTable_GetSymName (Varient));
4081 : StrIO_WriteLn ();
4082 : }
4083 0 : if ((Type == SymbolTable_NulSym) && (tag == NameKey_NulName))
4084 : {
4085 0 : M2MetaError_MetaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, Record);
4086 : }
4087 0 : else if (Type == SymbolTable_NulSym)
4088 : {
4089 : /* avoid dangling else. */
4090 0 : SymbolTable_PutVarientTag (Varient, SymbolTable_RequestSym (tagtok, tag));
4091 : }
4092 : else
4093 : {
4094 : /* avoid dangling else. */
4095 0 : Field = SymbolTable_PutFieldRecord (Record, tag, Type, Varient);
4096 0 : SymbolTable_PutVarientTag (Varient, Field);
4097 0 : if (Debugging)
4098 : {
4099 : StrIO_WriteString ((const char *) "record ", 7);
4100 : NameKey_WriteKey (SymbolTable_GetSymName (Record));
4101 : StrIO_WriteString ((const char *) "varient ", 8);
4102 : NameKey_WriteKey (SymbolTable_GetSymName (Varient));
4103 : StrIO_WriteLn ();
4104 : }
4105 : }
4106 : }
4107 2988 : }
4108 :
4109 :
4110 : /*
4111 : StartBuildVarientFieldRecord - Builds a varient field into a varient sym.
4112 : The Stack:
4113 :
4114 :
4115 : Entry Exit
4116 : ===== ====
4117 :
4118 : <- Ptr
4119 : +-------------+
4120 : Ptr -> | VarientField|
4121 : +-------------+ |-------------|
4122 : | VarientSym | | VarientSym |
4123 : |-------------| |-------------|
4124 : */
4125 :
4126 6090 : extern "C" void P2SymBuild_StartBuildVarientFieldRecord (void)
4127 : {
4128 6090 : unsigned int VarientSym;
4129 6090 : unsigned int FieldSym;
4130 :
4131 6090 : VarientSym = static_cast<unsigned int> (M2Quads_OperandT (1));
4132 6090 : FieldSym = SymbolTable_MakeFieldVarient (SymbolTable_CheckAnonymous (NameKey_NulName), VarientSym);
4133 6090 : M2Quads_Annotate ((const char *) "%1s(%1d)||varient sym", 21);
4134 6090 : M2Quads_PushT (FieldSym);
4135 6090 : M2Quads_Annotate ((const char *) "%1s(%1d)||varient field type", 28);
4136 6090 : M2Debug_Assert (SymbolTable_IsFieldVarient (FieldSym));
4137 6090 : SymbolTable_PutFieldVarient (FieldSym, VarientSym);
4138 6090 : M2Quads_AddVarientFieldToList (FieldSym);
4139 6090 : }
4140 :
4141 :
4142 : /*
4143 : EndBuildVarientFieldRecord - Removes a varient field from the stack.
4144 : The Stack:
4145 :
4146 :
4147 : Entry Exit
4148 : ===== ====
4149 :
4150 : Ptr ->
4151 : +-------------+
4152 : | VarientField| <- Ptr
4153 : |-------------| +-------------+
4154 : | VarientSym | | VarientSym |
4155 : |-------------| |-------------|
4156 : */
4157 :
4158 6090 : extern "C" void P2SymBuild_EndBuildVarientFieldRecord (void)
4159 : {
4160 6090 : unsigned int FieldSym;
4161 :
4162 6090 : M2Quads_PopT (&FieldSym);
4163 6090 : }
4164 :
4165 :
4166 : /*
4167 : BuildNulName - Pushes a NulName onto the top of the stack.
4168 : The Stack:
4169 :
4170 :
4171 : Entry Exit
4172 :
4173 : <- Ptr
4174 : Empty +------------+
4175 : | NulName |
4176 : |------------|
4177 : */
4178 :
4179 1780221 : extern "C" void P2SymBuild_BuildNulName (void)
4180 : {
4181 1780221 : M2Quads_PushTtok (static_cast<unsigned int> (NameKey_NulName), M2LexBuf_GetTokenNo ());
4182 1780221 : M2Quads_Annotate ((const char *) "%1n|%3d||NulName|token no", 25);
4183 1780221 : }
4184 :
4185 :
4186 : /*
4187 : BuildTypeEnd - Pops the type Type and Name.
4188 : The Stack:
4189 :
4190 :
4191 : Entry Exit
4192 :
4193 :
4194 : Ptr ->
4195 : +-------------+
4196 : | Type | Name | Empty
4197 : |-------------|
4198 : */
4199 :
4200 147343 : extern "C" void P2SymBuild_BuildTypeEnd (void)
4201 : {
4202 147343 : unsigned int Type;
4203 147343 : NameKey_Name name;
4204 :
4205 147343 : M2Quads_PopTF (&Type, &name);
4206 147343 : }
4207 :
4208 :
4209 : /*
4210 : StartBuildArray - Builds an array type.
4211 : The Stack:
4212 :
4213 : Entry Exit
4214 : ===== ====
4215 :
4216 : <- Ptr
4217 : +-----------+
4218 : Ptr -> | ArraySym |
4219 : +------------+ |-----------|
4220 : | Name | | Name |
4221 : |------------| |-----------|
4222 : */
4223 :
4224 100122 : extern "C" void P2SymBuild_StartBuildArray (void)
4225 : {
4226 100122 : unsigned int tok;
4227 100122 : NameKey_Name name;
4228 100122 : unsigned int ArrayType;
4229 :
4230 100122 : name = static_cast<NameKey_Name> (M2Quads_OperandT (1));
4231 100122 : tok = static_cast<unsigned int> (M2Quads_OperandTok (1));
4232 100122 : ArrayType = SymbolTable_MakeArray (tok, name);
4233 100122 : SymbolTable_CheckForExportedImplementation (ArrayType); /* May be an exported hidden type */
4234 100122 : M2Quads_PushTtok (ArrayType, tok); /* May be an exported hidden type */
4235 : /* ; WriteKey(Name) ; WriteString(' ARRAY made') ; WriteLn */
4236 100122 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||array type|token no", 33);
4237 100122 : }
4238 :
4239 :
4240 : /*
4241 : EndBuildArray - Builds an array type.
4242 : The Stack:
4243 :
4244 : Entry Exit
4245 : ===== ====
4246 :
4247 : Ptr ->
4248 : +------------+
4249 : | TypeSym | <- Ptr
4250 : |------------| +------------+
4251 : | ArraySym | | ArraySym |
4252 : |------------| |------------|
4253 : | Name | | Name |
4254 : |------------| |------------|
4255 : */
4256 :
4257 100122 : extern "C" void P2SymBuild_EndBuildArray (void)
4258 : {
4259 100122 : unsigned int typetok;
4260 100122 : unsigned int arraytok;
4261 100122 : unsigned int combinedtok;
4262 100122 : unsigned int TypeSym;
4263 100122 : unsigned int ArraySym;
4264 :
4265 100122 : M2Quads_PopTtok (&TypeSym, &typetok);
4266 100122 : M2Quads_PopTtok (&ArraySym, &arraytok);
4267 100122 : M2Debug_Assert (SymbolTable_IsArray (ArraySym));
4268 100122 : combinedtok = M2LexBuf_MakeVirtual2Tok (arraytok, typetok);
4269 100122 : SymbolTable_PutArray (ArraySym, TypeSym);
4270 100122 : SymbolTable_PutDeclared (combinedtok, ArraySym);
4271 100122 : M2Quads_PushTtok (ArraySym, combinedtok);
4272 100122 : M2Quads_Annotate ((const char *) "%1s(%1d)||array type", 20);
4273 100122 : }
4274 :
4275 :
4276 : /*
4277 : BuildFieldArray - Builds a field into an array sym.
4278 : The Stack:
4279 :
4280 :
4281 : Entry Exit
4282 : ===== ====
4283 :
4284 : Ptr ->
4285 : +-------------+
4286 : | Type | Name | <- Ptr
4287 : |-------------| +-------------+
4288 : | ArraySym | | ArraySym |
4289 : |-------------| |-------------|
4290 : | ArrayName | | ArrayName |
4291 : |-------------| |-------------|
4292 : */
4293 :
4294 100122 : extern "C" void P2SymBuild_BuildFieldArray (void)
4295 : {
4296 100122 : unsigned int typetok;
4297 100122 : unsigned int arraytok;
4298 100122 : unsigned int Subscript;
4299 100122 : unsigned int Type;
4300 100122 : unsigned int Array;
4301 100122 : NameKey_Name name;
4302 :
4303 100122 : M2Quads_PopTFtok (&Type, &name, &typetok);
4304 100122 : M2Quads_PopTtok (&Array, &arraytok);
4305 100122 : M2Debug_Assert (SymbolTable_IsArray (Array));
4306 100122 : Subscript = SymbolTable_MakeSubscript ();
4307 : /*
4308 : We cannot Assert(IsSubrange(Type)) as the subrange type might be
4309 : declared later on in the file.
4310 : We also note it could be an ordinal type or enumerated type.
4311 : Therefore we must save this information and deal with the
4312 : different cases in M2GCCDeclare.mod and M2GenGCC.mod.
4313 : However this works to our advantage as it preserves the
4314 : actual declaration as specified by the source file.
4315 : */
4316 100122 : SymbolTable_PutSubscript (Subscript, Type);
4317 100122 : SymbolTable_PutArraySubscript (Array, Subscript);
4318 100122 : M2Quads_PushTtok (Array, arraytok);
4319 : /* ; WriteString('Field Placed in Array') ; WriteLn */
4320 100122 : M2Quads_Annotate ((const char *) "%1s(%1d)||array type", 20);
4321 100122 : }
4322 :
4323 :
4324 : /*
4325 : BuildArrayComma - converts ARRAY [..], [..] OF into ARRAY [..] OF ARRAY [..]
4326 :
4327 :
4328 : Ptr -> <- Ptr
4329 : +-------------+ +-------------+
4330 : | ArraySym1 | | ArraySym2 |
4331 : |-------------| |-------------|
4332 : | ArrayName | | ArrayName |
4333 : |-------------| |-------------|
4334 : */
4335 :
4336 138 : extern "C" void P2SymBuild_BuildArrayComma (void)
4337 : {
4338 138 : unsigned int Nothing;
4339 138 : unsigned int ArraySym1;
4340 138 : unsigned int ArraySym2;
4341 :
4342 138 : M2Quads_PushT (static_cast<unsigned int> (NameKey_NulName));
4343 138 : P2SymBuild_StartBuildArray ();
4344 138 : M2Quads_PopT (&ArraySym2);
4345 138 : M2Quads_PopT (&Nothing);
4346 138 : M2Quads_PushT (ArraySym2);
4347 138 : P2SymBuild_EndBuildArray ();
4348 138 : M2Quads_PopT (&ArraySym1);
4349 138 : M2Quads_PushT (ArraySym2);
4350 138 : M2Quads_Annotate ((const char *) "%1s(%1d)||array type comma", 26);
4351 138 : }
4352 :
4353 :
4354 : /*
4355 : BuildProcedureType - builds a procedure type symbol.
4356 : The Stack:
4357 :
4358 :
4359 : <- Ptr
4360 : +-------------+
4361 : Ptr -> | ProcTypeSym |
4362 : +-------------+ |-------------|
4363 : | Name | | Name |
4364 : |-------------| |-------------|
4365 : */
4366 :
4367 59322 : extern "C" void P2SymBuild_BuildProcedureType (void)
4368 : {
4369 59322 : unsigned int tok;
4370 59322 : NameKey_Name name;
4371 59322 : unsigned int ProcTypeSym;
4372 :
4373 59322 : name = static_cast<NameKey_Name> (M2Quads_OperandT (1));
4374 59322 : tok = static_cast<unsigned int> (M2Quads_OperandTok (1));
4375 59322 : ProcTypeSym = SymbolTable_MakeProcType (tok, name);
4376 59322 : SymbolTable_CheckForExportedImplementation (ProcTypeSym); /* May be an exported hidden type */
4377 59322 : M2Quads_Annotate ((const char *) "%1n||procedure type name", 24); /* May be an exported hidden type */
4378 59322 : M2Quads_PushTtok (ProcTypeSym, tok);
4379 59322 : M2Quads_Annotate ((const char *) "%1s(%1d)|%3d||proc type|token no", 32);
4380 59322 : }
4381 :
4382 :
4383 : /*
4384 : BuildFormalType - Builds a Formal Parameter in a procedure type.
4385 :
4386 : The Stack:
4387 :
4388 : Entry Exit
4389 :
4390 : Ptr ->
4391 : +------------+
4392 : | TypeSym |
4393 : |------------|
4394 : | Array/Nul |
4395 : |------------|
4396 : | Var / Nul | <- Ptr
4397 : |------------| +--------------+
4398 : | ProcTypeSym| | ProcTypeSym |
4399 : |------------| |--------------|
4400 : */
4401 :
4402 83676 : extern "C" void P2SymBuild_BuildFormalType (void)
4403 : {
4404 83676 : unsigned int tok;
4405 83676 : NameKey_Name Array;
4406 83676 : NameKey_Name Var;
4407 83676 : unsigned int TypeSym;
4408 83676 : unsigned int UnboundedSym;
4409 83676 : unsigned int ProcTypeSym;
4410 :
4411 83676 : M2Quads_PopT (&TypeSym);
4412 83676 : M2Quads_PopT (&Array);
4413 83676 : M2Quads_PopT (&Var);
4414 83676 : M2Quads_PopT (&ProcTypeSym);
4415 83676 : tok = M2LexBuf_GetTokenNo ();
4416 167352 : M2Debug_Assert ((Array == M2Reserved_ArrayTok) || (Array == M2Reserved_NulTok));
4417 83676 : M2Debug_Assert (SymbolTable_IsProcType (ProcTypeSym));
4418 167352 : M2Debug_Assert ((Var == M2Reserved_VarTok) || (Var == M2Reserved_NulTok));
4419 83676 : if (Array == M2Reserved_ArrayTok)
4420 : {
4421 388 : UnboundedSym = SymbolTable_MakeUnbounded (tok, TypeSym, 1);
4422 388 : TypeSym = UnboundedSym;
4423 : }
4424 83676 : if (Var == M2Reserved_VarTok)
4425 : {
4426 : /* VAR parameter */
4427 6498 : SymbolTable_PutProcTypeVarParam (tok, ProcTypeSym, TypeSym, SymbolTable_IsUnbounded (TypeSym));
4428 : }
4429 : else
4430 : {
4431 : /* Non VAR parameter */
4432 77178 : SymbolTable_PutProcTypeParam (tok, ProcTypeSym, TypeSym, SymbolTable_IsUnbounded (TypeSym));
4433 : }
4434 83676 : M2Quads_PushT (ProcTypeSym);
4435 83676 : M2Quads_Annotate ((const char *) "%1s(%1d)||proc type", 19);
4436 83676 : }
4437 :
4438 :
4439 : /*
4440 : SeenUnknown - sets the operand type to unknown.
4441 : */
4442 :
4443 25502982 : extern "C" void P2SymBuild_SeenUnknown (void)
4444 : {
4445 25502982 : type = M2Const_unknown;
4446 25502982 : }
4447 :
4448 :
4449 : /*
4450 : SeenCast - sets the operand type to cast.
4451 : */
4452 :
4453 0 : extern "C" void P2SymBuild_SeenCast (unsigned int sym)
4454 : {
4455 0 : type = M2Const_cast;
4456 0 : castType = sym;
4457 0 : M2Debug_Assert (SymbolTable_IsAModula2Type (sym));
4458 0 : }
4459 :
4460 :
4461 : /*
4462 : SeenSet - sets the operand type to set.
4463 : */
4464 :
4465 362 : extern "C" void P2SymBuild_SeenSet (void)
4466 : {
4467 362 : SetTypeTo (M2Const_set);
4468 362 : SaveRememberedConstructor ();
4469 362 : }
4470 :
4471 :
4472 : /*
4473 : SeenConstructor - sets the operand type to constructor.
4474 : */
4475 :
4476 36470 : extern "C" void P2SymBuild_SeenConstructor (void)
4477 : {
4478 36470 : SetTypeTo (M2Const_constructor);
4479 36470 : SaveRememberedConstructor ();
4480 36470 : }
4481 :
4482 :
4483 : /*
4484 : SeenArray - sets the operand type to array.
4485 : */
4486 :
4487 30 : extern "C" void P2SymBuild_SeenArray (void)
4488 : {
4489 30 : SetTypeTo (M2Const_array);
4490 30 : }
4491 :
4492 :
4493 : /*
4494 : SeenString - sets the operand type to string.
4495 : */
4496 :
4497 50521 : extern "C" void P2SymBuild_SeenString (void)
4498 : {
4499 50521 : SetTypeTo (M2Const_str);
4500 50521 : }
4501 :
4502 :
4503 : /*
4504 : SeenBoolean - sets the operand type to a BOOLEAN.
4505 : */
4506 :
4507 0 : extern "C" void P2SymBuild_SeenBoolean (void)
4508 : {
4509 0 : type = M2Const_boolean;
4510 0 : }
4511 :
4512 :
4513 : /*
4514 : SeenZType - sets the operand type to a Z type.
4515 : */
4516 :
4517 0 : extern "C" void P2SymBuild_SeenZType (void)
4518 : {
4519 0 : type = M2Const_ztype;
4520 0 : }
4521 :
4522 :
4523 : /*
4524 : SeenRType - sets the operand type to a R type.
4525 : */
4526 :
4527 0 : extern "C" void P2SymBuild_SeenRType (void)
4528 : {
4529 0 : type = M2Const_rtype;
4530 0 : }
4531 :
4532 :
4533 : /*
4534 : SeenCType - sets the operand type to a C type.
4535 : */
4536 :
4537 0 : extern "C" void P2SymBuild_SeenCType (void)
4538 : {
4539 0 : type = M2Const_ctype;
4540 0 : }
4541 :
4542 :
4543 : /*
4544 : DetermineType - assigns the top of stack symbol with the type of
4545 : constant expression, if known.
4546 : */
4547 :
4548 292014 : extern "C" void P2SymBuild_DetermineType (void)
4549 : {
4550 292014 : unsigned int Sym;
4551 :
4552 292014 : Sym = static_cast<unsigned int> (M2Quads_OperandT (1));
4553 292014 : switch (type)
4554 : {
4555 12 : case M2Const_set:
4556 12 : SymbolTable_PutConstSet (Sym);
4557 12 : break;
4558 :
4559 1140 : case M2Const_str:
4560 1140 : SymbolTable_PutConstStringKnown (M2LexBuf_GetTokenNo (), Sym, NameKey_MakeKey ((const char *) "", 0), false, false);
4561 1140 : break;
4562 :
4563 4422 : case M2Const_array:
4564 4422 : case M2Const_constructor:
4565 4422 : SymbolTable_PutConstructor (Sym);
4566 4422 : break;
4567 :
4568 0 : case M2Const_cast:
4569 0 : SymbolTable_PutConst (Sym, castType);
4570 0 : break;
4571 :
4572 : case M2Const_unknown:
4573 : break;
4574 :
4575 :
4576 : default:
4577 : break;
4578 : }
4579 292014 : }
4580 :
4581 :
4582 : /*
4583 : PushType -
4584 : */
4585 :
4586 23593008 : extern "C" void P2SymBuild_PushType (void)
4587 : {
4588 23593008 : M2StackWord_PushWord (TypeStack, static_cast<unsigned int> (type));
4589 23593008 : }
4590 :
4591 :
4592 : /*
4593 : PopType -
4594 : */
4595 :
4596 23593008 : extern "C" void P2SymBuild_PopType (void)
4597 : {
4598 23593008 : type = static_cast<M2Const_constType> (M2StackWord_PopWord (TypeStack));
4599 23593008 : }
4600 :
4601 :
4602 : /*
4603 : PushRememberConstant -
4604 : */
4605 :
4606 29382 : extern "C" void P2SymBuild_PushRememberConstant (void)
4607 : {
4608 29382 : M2StackWord_PushWord (RememberStack, RememberedConstant);
4609 29382 : P2SymBuild_RememberConstant (SymbolTable_NulSym);
4610 29382 : }
4611 :
4612 :
4613 : /*
4614 : PopRememberConstant -
4615 : */
4616 :
4617 29382 : extern "C" void P2SymBuild_PopRememberConstant (void)
4618 : {
4619 29382 : RememberedConstant = static_cast<unsigned int> (M2StackWord_PopWord (RememberStack));
4620 29382 : }
4621 :
4622 :
4623 : /*
4624 : RememberConstant -
4625 : */
4626 :
4627 321396 : extern "C" void P2SymBuild_RememberConstant (unsigned int sym)
4628 : {
4629 321396 : RememberedConstant = sym;
4630 321396 : }
4631 :
4632 14952 : extern "C" void _M2_P2SymBuild_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
4633 : {
4634 14952 : alignTypeNo = 0;
4635 14952 : TypeStack = M2StackWord_InitStackWord ();
4636 14952 : RememberStack = M2StackWord_InitStackWord ();
4637 14952 : BlockStack = M2StackWord_InitStackWord ();
4638 14952 : castType = SymbolTable_NulSym;
4639 14952 : }
4640 :
4641 0 : extern "C" void _M2_P2SymBuild_fini (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
4642 : {
4643 0 : }
|
