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