]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/m2/gm2-compiler/P1SymBuild.mod
projects / thirdparty / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Update copyright years.
[thirdparty/gcc.git] / gcc / m2 / gm2-compiler / P1SymBuild.mod
1 (* P1SymBuild.mod pass 1 symbol creation.
2
3 Copyright (C) 2001-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
5
6 This file is part of GNU Modula-2.
7
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
12
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Modula-2; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. *)
21
22 IMPLEMENTATION MODULE P1SymBuild ;
23
24
25 FROM ASCII IMPORT nul ;
26 FROM NameKey IMPORT Name, WriteKey, MakeKey, KeyToCharStar, NulName ;
27 FROM M2Debug IMPORT Assert, WriteDebug ;
28 FROM M2LexBuf IMPORT GetFileName, GetTokenNo, UnknownTokenNo ;
29 FROM M2MetaError IMPORT MetaErrorString2, MetaError0, MetaError1, MetaError2, MetaErrorT1, MetaErrorT2 ;
30 FROM DynamicStrings IMPORT String, Slice, InitString, KillString, EqualCharStar, RIndex, Mark, ConCat ;
31 FROM M2Printf IMPORT printf0, printf1, printf2 ;
32 FROM M2Options IMPORT Iso ;
33
34 FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
35 NulTok, VarTok, ArrayTok, BuiltinTok, InlineTok ;
36
37 FROM FifoQueue IMPORT PutEnumerationIntoFifoQueue ;
38 FROM P0SymBuild IMPORT EnterBlock, LeaveBlock ;
39
40 FROM SymbolTable IMPORT NulSym,
41 ModeOfAddr,
42 AppendModuleOnImportStatement,
43 AppendModuleImportStatement,
44 MakeImportStatement, MakeImport,
45
46 StartScope, EndScope, PseudoScope,
47 GetScope, GetCurrentScope,
48 IsDeclaredIn,
49 SetCurrentModule, SetFileModule,
50 MakeInnerModule,
51 MakeEnumeration, MakeSubrange,
52 MakeVar, MakeType, PutType,
53 MakeHiddenType,
54 PutMode,
55 PutFieldEnumeration, PutSubrange, PutVar,
56 IsDefImp, IsModule, IsInnerModule, IsType,
57 GetCurrentModule,
58 AddSymToModuleScope,
59 AddNameToImportList,
60 GetSym, RequestSym, IsUnknown, RenameSym,
61 GetFromOuterModule,
62 GetExported, IsExported,
63 GetLocalSym,
64 PutImported, PutIncludedByDefinition,
65 PutExported, PutExportQualified, PutExportUnQualified,
66 TryMoveUndeclaredSymToInnerModule,
67 PutDefinitionForC,
68 IsDefinitionForC,
69 PutDoesNeedExportList, PutDoesNotNeedExportList,
70 DoesNotNeedExportList,
71 MakeProcedure,
72 PutFunction, PutParam, PutVarParam,
73 GetNthParam,
74 IsProcedure, IsConstString,
75 MakePointer, PutPointer,
76 MakeRecord, PutFieldRecord,
77 MakeArray,
78 MakeSubscript, PutSubscript,
79 PutArray, GetType, IsArray,
80 IsProcType, MakeProcType,
81 PutProcTypeVarParam, PutProcTypeParam,
82 PutProcedureBuiltin, PutProcedureInline,
83 GetSymName,
84 ResolveImports, PutDeclared,
85 MakeError, MakeErrorS,
86 DisplayTrees ;
87
88 FROM M2Batch IMPORT MakeDefinitionSource,
89 MakeImplementationSource,
90 MakeProgramSource,
91 LookupModule, LookupOuterModule ;
92
93 FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, OperandT, PopN, OperandTok,
94 PopTtok, PushTtok, PushTFtok, PopTFtok ;
95
96 FROM M2Comp IMPORT CompilingDefinitionModule,
97 CompilingImplementationModule,
98 CompilingProgramModule ;
99
100 CONST
101 Debugging = FALSE ;
102
103 VAR
104 importStatementCount: CARDINAL ;
105
106
107 (*
108 CheckFileName - checks to see that the module name matches the file name.
109 *)
110
111 (*
112 PROCEDURE CheckFileName (tok: CARDINAL; name: Name; ModuleType: ARRAY OF CHAR) ;
113 VAR
114 ext,
115 basename: INTEGER ;
116 s,
117 FileName: String ;
118 BEGIN
119 FileName := GetFileName() ;
120 basename := RIndex(FileName, '/', 0) ;
121 IF basename=-1
122 THEN
123 basename := 0
124 END ;
125 ext := RIndex(FileName, '.', 0) ;
126 IF ext=-1
127 THEN
128 ext := 0
129 END ;
130 FileName := Slice(FileName, basename, ext) ;
131 IF EqualCharStar(FileName, KeyToCharStar(name))
132 THEN
133 FileName := KillString(FileName)
134 ELSE
135 s := ConCat (InitString (ModuleType),
136 Mark (InitString (" module name {%1Ea} is inconsistant with the filename {%F{%2a}}"))) ;
137 MetaErrorString2 (s, MakeError (tok, name), MakeErrorS (tok, FileName))
138 END
139 END CheckFileName ;
140 *)
141
142
143 (*
144 StartBuildDefinitionModule - Creates a definition module and starts
145 a new scope.
146
147 he Stack is expected:
148
149 Entry Exit
150
151 Ptr ->
152 +------------+
153 | NameStart | <- Ptr
154 |------------| +------------+
155 | NulName/"C"| | NameStart |
156 |------------| |------------|
157 *)
158
159 PROCEDURE P1StartBuildDefinitionModule ;
160 VAR
161 name : Name ;
162 language,
163 ModuleSym: CARDINAL ;
164 BEGIN
165 importStatementCount := 0 ;
166 PopT(name) ;
167 (* CheckFileName(name, 'definition') ; *)
168 ModuleSym := MakeDefinitionSource(GetTokenNo(), name) ;
169 PutDoesNotNeedExportList(ModuleSym) ;
170 SetCurrentModule(ModuleSym) ;
171 SetFileModule(ModuleSym) ;
172 StartScope(ModuleSym) ;
173 Assert(IsDefImp(ModuleSym)) ;
174 Assert(CompilingDefinitionModule()) ;
175 PopT(language) ;
176 IF (language#NulSym) AND IsConstString(language)
177 THEN
178 IF GetSymName(language)=MakeKey('C')
179 THEN
180 PutDefinitionForC(ModuleSym)
181 ELSIF GetSymName(language)=NulName
182 THEN
183 MetaError0 ('{%E}currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}')
184 ELSE
185 MetaError1 ('unknown definition module language {%1Ea}, currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}', language)
186 END
187 END ;
188 PushT(name) ;
189 EnterBlock(name)
190 END P1StartBuildDefinitionModule ;
191
192
193 (*
194 EndBuildDefinitionModule - Destroys the definition module scope and
195 checks for correct name.
196
197 The Stack is expected:
198
199 Entry Exit
200
201 Ptr ->
202 +------------+ +-----------+
203 | NameEnd | | |
204 |------------| |-----------|
205 | NameStart | | | <- Ptr
206 |------------| |-----------|
207 *)
208
209 PROCEDURE P1EndBuildDefinitionModule ;
210 VAR
211 start : CARDINAL ;
212 NameStart,
213 NameEnd : Name ;
214 BEGIN
215 Assert(CompilingDefinitionModule()) ;
216 EndScope ;
217 PopTtok(NameStart, start) ;
218 PopT(NameEnd) ;
219 IF Debugging
220 THEN
221 printf0('pass 1: ') ;
222 DisplayTrees(GetCurrentModule())
223 END ;
224 IF NameStart#NameEnd
225 THEN
226 MetaError1 ('inconsistant definition module name {%1Wa}', MakeError (start, NameStart))
227 END ;
228 LeaveBlock
229 END P1EndBuildDefinitionModule ;
230
231
232 (*
233 StartBuildImplementationModule - Creates an implementation module and starts
234 a new scope.
235
236 The Stack is expected:
237
238 Entry Exit
239
240 Ptr -> <- Ptr
241 +------------+ +-----------+
242 | NameStart | | NameStart |
243 |------------| |-----------|
244
245 *)
246
247 PROCEDURE P1StartBuildImplementationModule ;
248 VAR
249 tok : CARDINAL ;
250 name : Name ;
251 ModuleSym: CARDINAL ;
252 BEGIN
253 importStatementCount := 0 ;
254 PopTtok (name, tok) ;
255 (* CheckFileName(name, 'implementation') ; *)
256 ModuleSym := MakeImplementationSource (tok, name) ;
257 SetCurrentModule (ModuleSym) ;
258 SetFileModule (ModuleSym) ;
259 StartScope (ModuleSym) ;
260 IF NOT IsDefImp (ModuleSym)
261 THEN
262 MetaError1 ('cannot find corresponding definition module for {%1Ea}', ModuleSym)
263 END ;
264 Assert (CompilingImplementationModule()) ;
265 PushTtok (name, tok) ;
266 EnterBlock (name)
267 END P1StartBuildImplementationModule ;
268
269
270 (*
271 EndBuildImplementationModule - Destroys the implementation module scope and
272 checks for correct name.
273
274 The Stack is expected:
275
276 Entry Exit
277
278 Ptr ->
279 +------------+ +-----------+
280 | NameEnd | | |
281 |------------| |-----------|
282 | NameStart | | | <- Ptr
283 |------------| |-----------|
284 *)
285
286 PROCEDURE P1EndBuildImplementationModule ;
287 VAR
288 start, end: CARDINAL ;
289 NameStart,
290 NameEnd : Name ;
291 BEGIN
292 ResolveImports ;
293 Assert(CompilingImplementationModule()) ;
294 EndScope ;
295 PopTtok(NameStart, start) ;
296 PopTtok(NameEnd, end) ;
297 IF NameStart#NameEnd
298 THEN
299 MetaErrorT1 (end,
300 'inconsistant implementation module name {%1Wa}', MakeError (start, NameStart))
301 END ;
302 LeaveBlock
303 END P1EndBuildImplementationModule ;
304
305
306 (*
307 StartBuildProgramModule - Creates a program module and starts
308 a new scope.
309
310 The Stack is expected:
311
312 Entry Exit
313
314 Ptr -> <- Ptr
315 +------------+ +-----------+
316 | NameStart | | NameStart |
317 |------------| |-----------|
318
319 *)
320
321 PROCEDURE P1StartBuildProgramModule ;
322 VAR
323 tok : CARDINAL ;
324 name : Name ;
325 ModuleSym: CARDINAL ;
326 BEGIN
327 importStatementCount := 0 ;
328 PopTtok(name, tok) ;
329 (* CheckFileName(name, 'main') ; *)
330 ModuleSym := MakeProgramSource(tok, name) ;
331 SetCurrentModule(ModuleSym) ;
332 SetFileModule(ModuleSym) ;
333 StartScope(ModuleSym) ;
334 IF (NOT CompilingProgramModule()) OR IsDefImp(ModuleSym)
335 THEN
336 MetaErrorT1 (tok,
337 'module {%1Ea} has a corresponding DEFINITION MODULE but no IMPLEMENTATION keyword in the main module', ModuleSym)
338 END ;
339 PushTtok(name, tok) ;
340 EnterBlock(name)
341 END P1StartBuildProgramModule ;
342
343
344 (*
345 EndBuildProgramModule - Destroys the program module scope and
346 checks for correct name.
347
348 The Stack is expected:
349
350 Entry Exit
351
352 Ptr ->
353 +------------+ +-----------+
354 | NameEnd | | |
355 |------------| |-----------|
356 | NameStart | | | <- Ptr
357 |------------| |-----------|
358 *)
359
360 PROCEDURE P1EndBuildProgramModule ;
361 VAR
362 start,
363 end : CARDINAL ;
364 NameStart,
365 NameEnd : Name ;
366 BEGIN
367 ResolveImports ;
368 Assert(CompilingProgramModule()) ;
369 EndScope ;
370 PopTtok(NameStart, start) ;
371 PopTtok(NameEnd, end) ;
372 IF Debugging
373 THEN
374 printf0('pass 1: ') ;
375 DisplayTrees(GetCurrentModule())
376 END ;
377 IF NameStart#NameEnd
378 THEN
379 MetaErrorT1 (end,
380 'inconsistant program module name {%1Wa}', MakeError (start, NameStart))
381 END ;
382 LeaveBlock
383 END P1EndBuildProgramModule ;
384
385
386 (*
387 StartBuildInnerModule - Creates an Inner module and starts
388 a new scope.
389
390 The Stack is expected:
391
392 Entry Exit
393
394 Ptr -> <- Ptr
395 +------------+ +-----------+
396 | NameStart | | NameStart |
397 |------------| |-----------|
398
399 *)
400
401 PROCEDURE StartBuildInnerModule ;
402 VAR
403 tok : CARDINAL ;
404 name : Name ;
405 ModuleSym: CARDINAL ;
406 BEGIN
407 PopTtok(name, tok) ;
408 ModuleSym := GetSym(name) ;
409 Assert(ModuleSym#NulSym) ;
410 StartScope(ModuleSym) ;
411 Assert(NOT IsDefImp(ModuleSym)) ;
412 PushTtok(name, tok) ;
413 EnterBlock(name)
414 END StartBuildInnerModule ;
415
416
417 (*
418 EndBuildInnerModule - Destroys the Inner module scope and
419 checks for correct name.
420
421 The Stack is expected:
422
423 Entry Exit
424
425 Ptr ->
426 +------------+ +-----------+
427 | NameEnd | | |
428 |------------| |-----------|
429 | NameStart | | | <- Ptr
430 |------------| |-----------|
431 *)
432
433 PROCEDURE EndBuildInnerModule ;
434 VAR
435 start, end: CARDINAL ;
436 NameStart,
437 NameEnd : Name ;
438 BEGIN
439 EndScope ;
440 PopTtok(NameStart, start) ;
441 PopTtok(NameEnd, end) ;
442 IF NameStart#NameEnd
443 THEN
444 MetaErrorT1 (end,
445 'inconsistant inner module name {%1Wa}', MakeError (start, NameStart))
446 END ;
447 LeaveBlock
448 END EndBuildInnerModule ;
449
450
451 (*
452 BuildImportOuterModule - Builds imported identifiers into an outer module
453 from a definition module.
454
455 The Stack is expected:
456
457 Entry OR Entry
458
459 Ptr -> Ptr ->
460 +------------+ +-----------+
461 | # | | # |
462 |------------| |-----------|
463 | Id1 | | Id1 |
464 |------------| |-----------|
465 . . . .
466 . . . .
467 . . . .
468 |------------| |-----------|
469 | Id# | | Id# |
470 |------------| |-----------|
471 | ImportTok | | Ident |
472 |------------| |-----------|
473
474 IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
475
476
477 Exit
478
479 All above stack discarded
480 *)
481
482 PROCEDURE BuildImportOuterModule (definition: BOOLEAN) ;
483 VAR
484 Sym, ModSym,
485 i, n : CARDINAL ;
486 BEGIN
487 PopT(n) ; (* n = # of the Ident List *)
488 IF OperandT(n+1)=ImportTok
489 THEN
490 (* Ident list contains Module Names *)
491 i := 1 ;
492 WHILE i<=n DO
493 ModSym := LookupModule(OperandTok(n+1-i),
494 OperandT(n+1-i)) ;
495 PutImported(ModSym) ;
496 IF definition
497 THEN
498 PutIncludedByDefinition(ModSym)
499 END ;
500 INC(i)
501 END
502 ELSE
503 (* Ident List contains list of objects *)
504 ModSym := LookupModule(OperandTok(n+1),
505 OperandT(n+1)) ;
506 i := 1 ;
507 WHILE i<=n DO
508 (*
509 WriteString('Importing ') ; WriteKey(Operand(j)) ; WriteString(' from ') ; WriteKey(GetSymName(ModSym)) ; WriteLn ;
510 *)
511 Sym := GetExported (OperandTok (n+1-i),
512 ModSym, OperandT (n+1-i)) ;
513 PutImported (Sym) ;
514 INC (i)
515 END
516 END ;
517 PopN (n+1) (* clear stack *)
518 END BuildImportOuterModule ;
519
520
521 (*
522 BuildExportOuterModule - Builds exported identifiers from an outer module
523 to the outside world of library modules.
524
525 The Stack is expected:
526
527 Entry OR Entry
528
529 Ptr -> Ptr ->
530 +------------+ +--------------+
531 | # | | # |
532 |------------| |--------------|
533 | Id1 | | Id1 |
534 |------------| |--------------|
535 . . . .
536 . . . .
537 . . . .
538 |------------| |--------------|
539 | Id# | | Id# |
540 |------------| |--------------|
541 | ExportTok | | QualifiedTok |
542 |------------| |--------------|
543
544 EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
545
546 Error Condition
547
548
549 Exit
550
551 All above stack discarded
552 *)
553
554 PROCEDURE BuildExportOuterModule ;
555 VAR
556 i, n: CARDINAL ;
557 BEGIN
558 PopT (n) ; (* n = # of the Ident List *)
559 IF (OperandT(n+1)=QualifiedTok) AND CompilingDefinitionModule()
560 THEN
561 PutDoesNeedExportList(GetCurrentModule()) ;
562 (* Ident List contains list of export qualified objects *)
563 i := 1 ;
564 WHILE i<=n DO
565 PutExportQualified (OperandTok (i), OperandT (i)) ;
566 INC (i)
567 END
568 ELSIF (OperandT(n+1)=UnQualifiedTok) AND CompilingDefinitionModule()
569 THEN
570 PutDoesNeedExportList(GetCurrentModule()) ;
571 (* Ident List contains list of export unqualified objects *)
572 i := 1 ;
573 WHILE i<=n DO
574 PutExportUnQualified (OperandTok (i), OperandT(i)) ;
575 INC (i)
576 END
577 ELSIF CompilingDefinitionModule()
578 THEN
579 MetaError0 ('the {%EkEXPORT} must be either {%kQUALIFIED} or {%kUNQUALIFIED} in a definition module')
580 ELSE
581 MetaError0 ('{%E}only allowed inter module exports in a definition module')
582 END ;
583 PopN (n+1) (* clear stack *)
584 END BuildExportOuterModule ;
585
586
587 (*
588 CheckExplicitExported - checks to see whether we are compiling
589 a definition module and whether the ident
590 is implicitly export qualified or unqualified.
591
592
593 The Stack is expected:
594
595 Entry Exit
596
597 Ptr -> Ptr ->
598 +------------+ +-----------+
599 | Identname | | Identname |
600 |------------| |-----------|
601
602 *)
603
604 PROCEDURE CheckExplicitExported ;
605 BEGIN
606 IF CompilingDefinitionModule() AND DoesNotNeedExportList(GetCurrentModule())
607 THEN
608 (* printf1('exporting identifier %a\n', OperandT(1)) ; *)
609 PutExportQualified (OperandTok (1), OperandT(1))
610 END
611 END CheckExplicitExported ;
612
613
614 (*
615 BuildImportInnerModule - Builds imported identifiers into an inner module
616 from the last level of module.
617
618 The Stack is expected:
619
620 Entry OR Entry
621
622 Ptr -> Ptr ->
623 +------------+ +-----------+
624 | # | | # |
625 |------------| |-----------|
626 | Id1 | | Id1 |
627 |------------| |-----------|
628 . . . .
629 . . . .
630 . . . .
631 |------------| |-----------|
632 | Id# | | Id# |
633 |------------| |-----------|
634 | ImportTok | | Ident |
635 |------------| |-----------|
636
637 IMPORT Id1, .. Id# ; FROM Ident IMPORT Id1 .. Id# ;
638
639 Exit
640
641 All above stack discarded
642 *)
643
644 PROCEDURE BuildImportInnerModule ;
645 VAR
646 Sym, ModSym,
647 i, n : CARDINAL ;
648 BEGIN
649 PopT (n) ; (* n = # of the Ident List *)
650 IF OperandT (n+1) = ImportTok
651 THEN
652 (* Ident List contains list of objects *)
653 i := 1 ;
654 WHILE i<=n DO
655 AddNameToImportList (OperandT (i)) ;
656 INC (i)
657 END
658 ELSE
659 (* Ident List contains list of objects *)
660 ModSym := LookupOuterModule (OperandTok(n+1),
661 OperandT(n+1)) ;
662 i := 1 ;
663 WHILE i<=n DO
664 Sym := GetExported (OperandTok (n+1-i), ModSym, OperandT (n+1-i)) ;
665 PutImported (Sym) ;
666 INC (i)
667 END
668 END ;
669 PopN (n+1) (* clear stack *)
670 END BuildImportInnerModule ;
671
672
673 (*
674 BuildExportInnerModule - Builds exported identifiers from an inner module
675 to the next layer module.
676
677 The Stack is expected:
678
679 Entry OR Entry
680
681 Ptr -> Ptr ->
682 +------------+ +--------------+
683 | # | | # |
684 |------------| |--------------|
685 | Id1 | | Id1 |
686 |------------| |--------------|
687 . . . .
688 . . . .
689 . . . .
690 |------------| |--------------|
691 | Id# | | Id# |
692 |------------| |--------------|
693 | ExportTok | | QualifiedTok |
694 |------------| |--------------|
695
696 EXPORT Id1, .. Id# ; EXPORT QUALIFIED Id1 .. Id# ;
697
698
699 Exit
700
701
702 All above stack discarded
703 *)
704
705 PROCEDURE BuildExportInnerModule ;
706 VAR
707 tok : CARDINAL ;
708 PrevMod,
709 Sym,
710 i, n : CARDINAL ;
711 BEGIN
712 PopT (n) ; (* n = # of the Ident List *)
713 IF OperandT (n+1) = ExportTok
714 THEN
715 (* Ident List contains list of objects *)
716 i := 1 ;
717 PrevMod := GetScope (GetCurrentScope ()) ;
718 WHILE i<=n DO
719 tok := OperandTok (i) ;
720 IF (PrevMod#NulSym) AND (IsModule(PrevMod) OR IsDefImp(PrevMod))
721 THEN
722 Sym := GetLocalSym (PrevMod, OperandT(i)) ;
723 IF Sym=NulSym
724 THEN
725 Sym := TryMoveUndeclaredSymToInnerModule (PrevMod, GetCurrentScope (), OperandT (i)) ;
726 IF Sym=NulSym
727 THEN
728 Sym := RequestSym (tok, OperandT(i)) ;
729 PutExported (Sym)
730 END
731 ELSE
732 (* use Sym which has already been created in outer scope *)
733 AddSymToModuleScope (GetCurrentScope (), Sym)
734 END
735 ELSE
736 Sym := RequestSym (tok, OperandT(i)) ;
737 PutExported (Sym)
738 END ;
739 INC (i)
740 END
741 ELSE
742 MetaError0 ('{%EkQUALIFIED} not allowed in an inner module')
743 END ;
744 PopN(n+1) (* clear stack *)
745 END BuildExportInnerModule ;
746
747
748 (*
749 StartBuildEnumeration - Builds an Enumeration type Type.
750
751
752 Stack
753
754 Entry Exit
755
756 Ptr ->
757 +------------+
758 | # |
759 |------------|
760 | en 1 |
761 |------------|
762 | en 2 |
763 |------------|
764 . .
765 . .
766 . . <- Ptr
767 |------------| +------------+
768 | en # | | Type |
769 |------------| |------------|
770 | Name | | Name |
771 |------------| |------------|
772 *)
773
774 PROCEDURE StartBuildEnumeration ;
775 VAR
776 name : Name ;
777 n, i,
778 Type : CARDINAL ;
779 tokno: CARDINAL ;
780 BEGIN
781 PopT(n) ; (* No := # *)
782 name := OperandT(n+1) ;
783 tokno := OperandTok(n+1) ;
784 Type := MakeEnumeration(tokno, name) ;
785 i := 1 ;
786 WHILE i<=n DO
787 PutFieldEnumeration(OperandTok(n-i+1), Type, OperandT(n-i+1)) ;
788 INC(i)
789 END ;
790 PutEnumerationIntoFifoQueue(Type) ; (* store enumeration away for pass 2 *)
791 PopN(n+1) ;
792 PushTtok(name, tokno) ;
793 PushTtok(Type, tokno)
794 END StartBuildEnumeration ;
795
796
797 (*
798 EndBuildEnumeration - completes the construction of the enumeration type.
799
800
801 Stack
802
803 Entry Exit
804
805 Ptr ->
806 +------------+
807 | Type | <- Ptr
808 |------------| +---------------+
809 | Name | | Type | Name |
810 |------------| |---------------|
811
812 Empty
813 *)
814
815 PROCEDURE EndBuildEnumeration ;
816 VAR
817 tokno : CARDINAL ;
818 Sym,
819 Type : CARDINAL ;
820 n1, n2,
821 name : Name ;
822 BEGIN
823 (*
824 Two cases
825
826 - the type name the same as Name, or the name is nul. - do nothing.
827 - when type with a name that is different to Name. In which case
828 we create a new type.
829 *)
830 PopTtok(Type, tokno) ;
831 PopT(name) ;
832
833 IF Debugging
834 THEN
835 n1 := GetSymName(GetCurrentModule()) ;
836 printf2('inside module %a declaring type name %a\n',
837 n1, name) ;
838 IF (NOT IsUnknown(Type))
839 THEN
840 n1 := GetSymName(GetScope(Type)) ;
841 n2 := GetSymName(Type) ;
842 printf2('type was created inside scope %a as name %a\n',
843 n1, n2)
844 END
845 END ;
846 IF (name=NulName) OR (GetSymName(Type)=name)
847 THEN
848 (*
849 Typically the declaration that causes this case is:
850
851 VAR
852 a: (blue, green, red) ;
853 ^
854 |
855 +---- type has no name.
856
857 in which case the constructed from StartBuildEnumeration is complete
858 *)
859 PushTFtok(Type, name, tokno)
860 ELSE
861 (* in this case we are seeing:
862
863 TYPE
864 name = (blue, green, red)
865
866 so we construct the type name and define it to have the previously
867 created enumeration type
868 *)
869 Sym := MakeType(tokno, name) ;
870 PutType(Sym, Type) ;
871 PushTFtok(Sym, name, tokno)
872 END
873 END EndBuildEnumeration ;
874
875
876 (*
877 BuildHiddenType - Builds a Hidden Type.
878
879
880 Stack
881
882 Entry Exit
883
884 Ptr ->
885 +------------+
886 | Name | <- Ptr
887 |------------| Empty
888 *)
889
890 PROCEDURE BuildHiddenType ;
891 VAR
892 name : Name ;
893 tokno: CARDINAL ;
894 BEGIN
895 PopTtok (name, tokno) ;
896 (* WriteString('Hidden type encountered: ') ; *)
897 (* WriteKey(Name) ; WriteLn ; *)
898 Assert (MakeHiddenType (tokno, name) # NulSym)
899 END BuildHiddenType ;
900
901
902 (*
903 StartBuildProcedure - Builds a Procedure.
904
905 The Stack:
906
907 Entry Exit
908
909 Ptr -> <- Ptr
910 +------------+ +------------+
911 | Name | | ProcSym |
912 |------------| |------------|
913 | inlinetok | | |
914 | or | | |
915 | builtintok | | |
916 | or name or | | Name |
917 | NulTok | | |
918 |------------| |------------|
919 *)
920
921 PROCEDURE StartBuildProcedure ;
922 VAR
923 tokno : CARDINAL ;
924 builtin,
925 name : Name ;
926 ProcSym : CARDINAL ;
927 BEGIN
928 PopTtok (name, tokno) ;
929 PopT (builtin) ; (* was this procedure defined as a builtin? *)
930 PushTtok (name, tokno) ; (* Name saved for the EndBuildProcedure name check *)
931 ProcSym := RequestSym (tokno, name) ;
932 IF IsUnknown (ProcSym)
933 THEN
934 (*
935 May have been compiled in DEF or IMP module, remember that IMP maybe
936 compiled before corresponding DEF module.
937 *)
938 ProcSym := MakeProcedure (tokno, name)
939 ELSIF IsProcedure (ProcSym)
940 THEN
941 (* declared in the other module, we record declaration here as well *)
942 PutDeclared (tokno, ProcSym)
943 ELSE
944 MetaError1 ('expecting a procedure name and symbol {%1Ea} has been declared as a {%1d}', ProcSym) ;
945 PushT (ProcSym) ;
946 RETURN
947 END ;
948 IF builtin#NulTok
949 THEN
950 IF builtin=BuiltinTok
951 THEN
952 PutProcedureBuiltin (ProcSym, name)
953 ELSIF builtin=InlineTok
954 THEN
955 PutProcedureInline (ProcSym)
956 ELSE
957 PutProcedureBuiltin (ProcSym, builtin)
958 END
959 END ;
960 PushT (ProcSym) ;
961 StartScope (ProcSym) ;
962 IF NOT CompilingDefinitionModule ()
963 THEN
964 EnterBlock (name)
965 END
966 END StartBuildProcedure ;
967
968
969 (*
970 EndBuildProcedure - Ends building a Procedure.
971 It checks the start procedure name matches the end
972 procedure name.
973
974 The Stack:
975
976 (Procedure Not Defined in definition module)
977
978 Entry Exit
979
980 Ptr ->
981 +------------+
982 | NameEnd |
983 |------------|
984 | ProcSym |
985 |------------|
986 | NameStart |
987 |------------|
988 Empty
989 *)
990
991 PROCEDURE EndBuildProcedure ;
992 VAR
993 start, end: CARDINAL ;
994 ProcSym : CARDINAL ;
995 NameEnd,
996 NameStart : Name ;
997 BEGIN
998 PopTtok(NameEnd, end) ;
999 PopT(ProcSym) ;
1000 PopTtok(NameStart, start) ;
1001 IF NameEnd#NameStart
1002 THEN
1003 IF end # UnknownTokenNo
1004 THEN
1005 MetaErrorT1 (end,
1006 'procedure name at end does not match name at beginning {%1EDa}', ProcSym)
1007 ELSIF start # UnknownTokenNo
1008 THEN
1009 MetaErrorT2 (start,
1010 'procedure name at end {%1EDa} does not match name at beginning {%2a}',
1011 MakeError (end, NameEnd), ProcSym)
1012 ELSE
1013 MetaError1 ('procedure name at end does not match name at beginning {%1EDa}', ProcSym)
1014 END
1015 END ;
1016 EndScope ;
1017 Assert (NOT CompilingDefinitionModule()) ;
1018 LeaveBlock
1019 END EndBuildProcedure ;
1020
1021
1022 (*
1023 BuildProcedureHeading - Builds a procedure heading for the definition
1024 module procedures.
1025
1026 Operation only performed if compiling a
1027 definition module.
1028
1029 The Stack:
1030
1031 Entry Exit
1032
1033 Ptr ->
1034 +------------+
1035 | ProcSym |
1036 |------------|
1037 | NameStart |
1038 |------------|
1039 Empty
1040
1041 *)
1042
1043 PROCEDURE BuildProcedureHeading ;
1044 VAR
1045 ProcSym : CARDINAL ;
1046 NameStart: Name ;
1047 BEGIN
1048 IF CompilingDefinitionModule()
1049 THEN
1050 PopT(ProcSym) ;
1051 PopT(NameStart) ;
1052 EndScope
1053 END
1054 END BuildProcedureHeading ;
1055
1056
1057 (*
1058 BuildNulName - Pushes a NulName onto the top of the stack.
1059 The Stack:
1060
1061
1062 Entry Exit
1063
1064 <- Ptr
1065 Empty +------------+
1066 | NulName |
1067 |------------|
1068 *)
1069
1070 PROCEDURE BuildNulName ;
1071 BEGIN
1072 PushT(NulName)
1073 END BuildNulName ;
1074
1075
1076 (*
1077 BuildTypeEnd - Pops the type Type and Name.
1078 The Stack:
1079
1080
1081 Entry Exit
1082
1083
1084 Ptr ->
1085 +-------------+
1086 | Type | Name | Empty
1087 |-------------|
1088 *)
1089
1090 PROCEDURE BuildTypeEnd ;
1091 VAR
1092 Type: CARDINAL ;
1093 name: Name ;
1094 BEGIN
1095 PopTF (Type, name)
1096 END BuildTypeEnd ;
1097
1098
1099 (*
1100 BuildImportStatement - create a new import statement in the current module.
1101 It ignores local modules.
1102
1103 The quadruple stack is not used.
1104 *)
1105
1106 PROCEDURE BuildImportStatement (tok: CARDINAL) ;
1107 VAR
1108 scope: CARDINAL ;
1109 BEGIN
1110 scope := GetCurrentScope () ;
1111 IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
1112 THEN
1113 IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
1114 THEN
1115 MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope)
1116 ELSE
1117 INC (importStatementCount) ;
1118 AppendModuleImportStatement (scope, MakeImportStatement (tok, importStatementCount))
1119 END
1120 END
1121 END BuildImportStatement ;
1122
1123
1124 (*
1125 AddImportToImportStatement - the top of stack is expected to be a module name.
1126 This is looked up from the module universe and
1127 wrapped in an import symbol and placed into the
1128 current import statement.
1129
1130 The quadruple stack is unchanged.
1131
1132 Entry Exit
1133
1134
1135 Ptr -> <- Ptr
1136 +---------------------+ +---------------------+
1137 | ImportedModuleName | | ImportedModuleName |
1138 |---------------------| |---------------------|
1139 *)
1140
1141 PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
1142 VAR
1143 scope: CARDINAL ;
1144 BEGIN
1145 scope := GetCurrentScope () ;
1146 IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
1147 THEN
1148 IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
1149 THEN
1150 MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope) ;
1151 ELSE
1152 AppendModuleOnImportStatement (scope, MakeImport (OperandTok (1),
1153 LookupModule (OperandTok (1), OperandT (1)),
1154 importStatementCount, qualified))
1155 END
1156 END
1157 END AddImportToImportStatement ;
1158
1159
1160 END P1SymBuild.
Mirror of https://gcc.gnu.org/git/gcc.git