]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/m2/gm2-compiler/M2Options.mod
OpenMP: Fix omp_get_device_from_uid, minor cleanup
[thirdparty/gcc.git] / gcc / m2 / gm2-compiler / M2Options.mod
1 (* M2Options.mod initializes the user options.
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 M2Options ;
23
24
25 IMPORT CmdArgs ;
26 FROM SArgs IMPORT GetArg, Narg ;
27 FROM M2Search IMPORT SetDefExtension, SetModExtension ;
28 FROM PathName IMPORT DumpPathName, AddInclude ;
29 FROM M2Printf IMPORT printf0, printf1, fprintf1 ;
30 FROM FIO IMPORT StdErr ;
31 FROM libc IMPORT exit, printf ;
32 FROM Debug IMPORT Halt ;
33 FROM gcctypes IMPORT location_t ;
34 FROM m2configure IMPORT FullPathCPP, TargetIEEEQuadDefault ;
35 FROM M2Error IMPORT InternalError ;
36 FROM FormatStrings IMPORT Sprintf1 ;
37 FROM m2misc IMPORT cerror ;
38
39 FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
40 InitStringCharStar, ConCatChar, ConCat, KillString,
41 Dup, string, char, Index,
42 PushAllocation, PopAllocationExemption,
43 InitStringDB, InitStringCharStarDB,
44 InitStringCharDB, MultDB, DupDB, SliceDB ;
45
46 (*
47 #define InitString(X) InitStringDB(X, __FILE__, __LINE__)
48 #define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__)
49 #define InitStringChar(X) InitStringCharDB(X, __FILE__, __LINE__)
50 #define Mult(X,Y) MultDB(X, Y, __FILE__, __LINE__)
51 #define Dup(X) DupDB(X, __FILE__, __LINE__)
52 #define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__)
53 *)
54
55 CONST
56 Debugging = FALSE ;
57 DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
58
59 VAR
60 DumpDeclFilename,
61 DumpQuadFilename,
62 DumpGimpleFilename,
63 M2Dump,
64 M2DumpFilter,
65 M2Prefix,
66 M2PathName,
67 Barg,
68 MFarg,
69 MTFlag,
70 MQFlag,
71 DepTarget,
72 CmdLineObj,
73 SaveTempsDir,
74 DumpDir,
75 GenModuleListFilename,
76 UselistFilename,
77 RuntimeModuleOverride,
78 CppArgs : String ;
79 DebugFunctionLineNumbers,
80 DebugTraceQuad, (* -fm2-debug-trace=quad. *)
81 DebugTraceLine, (* -fm2-debug-trace=line. *)
82 DebugTraceToken, (* -fm2-debug-trace=token. *)
83 DebugTraceTree, (* -fm2-debug-trace=tree. (not yet implemented). *)
84 DumpDecl, (* -fm2-dump=decl. *)
85 DumpGimple, (* -fm2-dump=gimple. *)
86 DumpQuad, (* -fq, -fm2-dump=quad dump quadruples. *)
87 MFlag,
88 MMFlag,
89 MPFlag,
90 MDFlag,
91 MMDFlag,
92 IBMLongDouble,
93 IEEELongDouble,
94 UselistFlag,
95 CC1Quiet,
96 SeenSources : BOOLEAN ;
97 ForcedLocationValue : location_t ;
98
99
100 (* String garbage collection debugging routines.
101
102 (*
103 doDSdbEnter -
104 *)
105
106 PROCEDURE doDSdbEnter ;
107 BEGIN
108 PushAllocation
109 END doDSdbEnter ;
110
111
112 (*
113 doDSdbExit -
114 *)
115
116 PROCEDURE doDSdbExit (s: String) ;
117 BEGIN
118 s := PopAllocationExemption (TRUE, s)
119 END doDSdbExit ;
120
121
122 (*
123 DSdbEnter -
124 *)
125
126 PROCEDURE DSdbEnter ;
127 BEGIN
128 END DSdbEnter ;
129
130
131 (*
132 DSdbExit -
133 *)
134
135 PROCEDURE DSdbExit (s: String) ;
136 BEGIN
137 END DSdbExit ;
138 *)
139
140 (*
141 #define DSdbEnter doDSdbEnter
142 #define DSdbExit doDSdbExit
143 *)
144
145
146 (*
147 SetM2Prefix - assign arg to M2Prefix.
148 *)
149
150 PROCEDURE SetM2Prefix (arg: ADDRESS) ;
151 BEGIN
152 M2Prefix := KillString (M2Prefix) ;
153 M2Prefix := InitStringCharStar (arg)
154 END SetM2Prefix ;
155
156
157 (*
158 GetM2Prefix - return M2Prefix as a C string.
159 *)
160
161 PROCEDURE GetM2Prefix () : ADDRESS ;
162 BEGIN
163 RETURN string (M2Prefix)
164 END GetM2Prefix ;
165
166
167 (*
168 SetM2PathName - assign arg to M2PathName.
169 *)
170
171 PROCEDURE SetM2PathName (arg: ADDRESS) ;
172 BEGIN
173 M2PathName := KillString (M2PathName) ;
174 M2PathName := InitStringCharStar (arg) ;
175 (* fprintf1 (StdErr, "M2PathName = %s\n", M2PathName) *)
176 END SetM2PathName ;
177
178
179 (*
180 GetM2PathName - return M2PathName as a C string.
181 *)
182
183 PROCEDURE GetM2PathName () : ADDRESS ;
184 BEGIN
185 RETURN string (M2PathName)
186 END GetM2PathName ;
187
188
189 (*
190 SetB - assigns Barg to arg.
191 *)
192
193 PROCEDURE SetB (arg: ADDRESS) ;
194 BEGIN
195 Barg := KillString (Barg) ;
196 Barg := InitStringCharStar (arg)
197 END SetB ;
198
199
200 (*
201 GetB - returns Barg value as a C string or NIL if it was never set.
202 *)
203
204 PROCEDURE GetB () : ADDRESS ;
205 BEGIN
206 RETURN string (Barg)
207 END GetB ;
208
209
210 (*
211 SetM - set the MFlag.
212 *)
213
214 PROCEDURE SetM (value: BOOLEAN) ;
215 BEGIN
216 MFlag := value
217 END SetM ;
218
219
220 (*
221 GetM - set the MFlag.
222 *)
223
224 PROCEDURE GetM () : BOOLEAN ;
225 BEGIN
226 RETURN MFlag
227 END GetM ;
228
229
230 (*
231 SetMM - set the MMFlag.
232 *)
233
234 PROCEDURE SetMM (value: BOOLEAN) ;
235 BEGIN
236 MMFlag := value
237 END SetMM ;
238
239
240 (*
241 GetMM - set the MMFlag.
242 *)
243
244 PROCEDURE GetMM () : BOOLEAN ;
245 BEGIN
246 RETURN MMFlag
247 END GetMM ;
248
249
250 (*
251 SetMD - set the MDFlag to value.
252 *)
253
254 PROCEDURE SetMD (value: BOOLEAN) ;
255 BEGIN
256 MDFlag := value
257 END SetMD ;
258
259
260 (*
261 GetMD - return the MDFlag.
262 *)
263
264 PROCEDURE GetMD () : BOOLEAN ;
265 BEGIN
266 RETURN MDFlag
267 END GetMD ;
268
269
270 (*
271 SetMMD - set the MMDFlag to value.
272 *)
273
274 PROCEDURE SetMMD (value: BOOLEAN) ;
275 BEGIN
276 MMDFlag := value
277 END SetMMD ;
278
279
280 (*
281 GetMMD - return the MMDFlag.
282 *)
283
284 PROCEDURE GetMMD () : BOOLEAN ;
285 BEGIN
286 RETURN MMDFlag
287 END GetMMD ;
288
289
290 (*
291 SetMF - assigns MFarg to the filename from arg.
292 *)
293
294 PROCEDURE SetMF (arg: ADDRESS) ;
295 BEGIN
296 MFarg := KillString (MFarg) ;
297 MFarg := InitStringCharStar (arg)
298 END SetMF ;
299
300
301 (*
302 GetMF - returns MFarg or NIL if never set.
303 *)
304
305 PROCEDURE GetMF () : ADDRESS ;
306 BEGIN
307 RETURN string (MFarg)
308 END GetMF ;
309
310
311 (*
312 SetMP - set the MPflag to value.
313 *)
314
315 PROCEDURE SetMP (value: BOOLEAN) ;
316 BEGIN
317 MPFlag := value
318 END SetMP ;
319
320
321 (*
322 GetMP - get the MPflag.
323 *)
324
325 PROCEDURE GetMP () : BOOLEAN ;
326 BEGIN
327 RETURN MPFlag
328 END GetMP ;
329
330
331 (*
332 errors1 -
333 *)
334
335 PROCEDURE errors1 (format: ARRAY OF CHAR; arg: String) ;
336 VAR
337 message: String ;
338 cstr : ADDRESS ;
339 BEGIN
340 message := Sprintf1 (InitString (format), arg) ;
341 cstr := string (message) ;
342 cerror (cstr) ;
343 exit (1)
344 END errors1 ;
345
346
347 (*
348 AddWord - concats a word to sentence inserting a space if necessary.
349 sentence is returned. sentence will be created if it is NIL.
350 *)
351
352 PROCEDURE AddWord (sentence, word: String) : String ;
353 BEGIN
354 IF word # NIL
355 THEN
356 IF sentence = NIL
357 THEN
358 sentence := Dup (word)
359 ELSE
360 sentence := ConCatChar (sentence, ' ') ;
361 sentence := ConCat (sentence, word)
362 END
363 END ;
364 RETURN sentence
365 END AddWord ;
366
367
368 (*
369 QuoteTarget - quote the '$' character.
370 *)
371
372 PROCEDURE QuoteTarget (target: String) : String ;
373 VAR
374 quoted: String ;
375 i, n : CARDINAL ;
376 BEGIN
377 quoted := InitString ('') ;
378 i := 0 ;
379 n := Length (target) ;
380 WHILE i < n DO
381 CASE char (target, i) OF
382
383 '$': quoted := ConCat (quoted, Mark (InitString ('$$')))
384
385 ELSE
386 quoted := ConCatChar (quoted, char (target, i))
387 END ;
388 INC (i)
389 END ;
390 RETURN quoted
391 END QuoteTarget ;
392
393
394 (*
395 SetMQ - adds a quoted target arg to the DepTarget sentence.
396 *)
397
398 PROCEDURE SetMQ (arg: ADDRESS) ;
399 BEGIN
400 DepTarget := AddWord (DepTarget, QuoteTarget (InitStringCharStar (arg))) ;
401 MQFlag := AddWord (MQFlag, Mark (InitString ('-MQ'))) ;
402 MQFlag := AddWord (MQFlag, Mark (InitStringCharStar (arg)))
403 END SetMQ ;
404
405
406 (*
407 GetMQ - returns a C string containing all the -MQ arg values.
408 *)
409
410 PROCEDURE GetMQ () : ADDRESS ;
411 BEGIN
412 RETURN string (MQFlag)
413 END GetMQ ;
414
415
416 (*
417 SetMT - adds a target arg to the DepTarget sentence.
418 *)
419
420 PROCEDURE SetMT (arg: ADDRESS) ;
421 BEGIN
422 DepTarget := AddWord (DepTarget, InitStringCharStar (arg)) ;
423 MTFlag := AddWord (MTFlag, Mark (InitString ('-MT'))) ;
424 MTFlag := AddWord (MTFlag, Mark (InitStringCharStar (arg)))
425 END SetMT ;
426
427
428 (*
429 GetMT - returns a C string containing all the -MT arg values.
430 *)
431
432 PROCEDURE GetMT () : ADDRESS ;
433 BEGIN
434 RETURN string (MTFlag)
435 END GetMT ;
436
437
438 (*
439 GetDepTarget - returns the DepTarget as a C string.
440 *)
441
442 PROCEDURE GetDepTarget () : ADDRESS ;
443 BEGIN
444 RETURN string (DepTarget)
445 END GetDepTarget ;
446
447
448 (*
449 SetObj - assigns CmdLineObj to the filename from arg.
450 *)
451
452 PROCEDURE SetObj (arg: ADDRESS) ;
453 BEGIN
454 CmdLineObj := KillString (CmdLineObj) ;
455 CmdLineObj := InitStringCharStar (arg)
456 END SetObj ;
457
458
459 (*
460 GetObj - returns CmdLineObj filename as a c-string or NIL if it was never set.
461 *)
462
463 PROCEDURE GetObj () : ADDRESS ;
464 BEGIN
465 RETURN string (CmdLineObj)
466 END GetObj ;
467
468
469 (*
470 CppCommandLine - returns the Cpp command line and all arguments.
471 NIL is returned if the -fcpp is absent.
472 *)
473
474 PROCEDURE CppCommandLine () : String ;
475 VAR
476 s: String ;
477 BEGIN
478 IF CPreProcessor
479 THEN
480 s := InitStringCharStar (FullPathCPP ()) ;
481 s := ConCat (ConCatChar (s, ' '), CppArgs) ;
482 IF CC1Quiet
483 THEN
484 s := ConCat (ConCatChar (s, ' '), Mark (InitString ('-quiet')))
485 END ;
486 RETURN s
487 ELSE
488 RETURN NIL
489 END
490 END CppCommandLine ;
491
492
493 (*
494 CppArg - sets the option and arg in the cpp command line.
495 *)
496
497 PROCEDURE CppArg (opt, arg: ADDRESS; joined: BOOLEAN) ;
498 VAR
499 s: String ;
500 BEGIN
501 s := InitStringCharStar(opt) ;
502 IF EqualArray(s, '-fcpp-begin') OR EqualArray(s, '-fcpp-end')
503 THEN
504 (* do nothing *)
505 ELSE
506 IF NOT EqualArray(CppArgs, '')
507 THEN
508 CppArgs := ConCatChar(CppArgs, ' ')
509 END ;
510 CppArgs := ConCat(CppArgs, Mark(s)) ;
511 IF arg#NIL
512 THEN
513 s := InitStringCharStar(arg) ;
514 IF NOT joined
515 THEN
516 CppArgs := ConCatChar(CppArgs, ' ')
517 END ;
518 CppArgs := ConCat(CppArgs, s)
519 END
520 END
521 END CppArg ;
522
523
524 (*
525 CppRemember - remember a string, s, as a cpp related argument.
526 The string, s, is not garbage collected.
527 *)
528
529 PROCEDURE CppRemember (s: String) ;
530 BEGIN
531 IF (CppArgs=NIL) OR EqualArray (CppArgs, '')
532 THEN
533 CppArgs := Dup (s)
534 ELSE
535 CppArgs := ConCatChar (CppArgs, ' ') ;
536 CppArgs := ConCat (CppArgs, s)
537 END
538 END CppRemember ;
539
540
541 (*
542 FinaliseOptions - once all options have been parsed we set any inferred
543 values.
544 *)
545
546 PROCEDURE FinaliseOptions ;
547 BEGIN
548 (* currently only one value, this could be make an option in the future *)
549 VariantValueChecking := Iso
550 END FinaliseOptions ;
551
552
553 (*
554 SetWholeProgram - sets the WholeProgram flag (-fwhole-program).
555 *)
556
557 PROCEDURE SetWholeProgram (value: BOOLEAN) ;
558 BEGIN
559 WholeProgram := value
560 END SetWholeProgram ;
561
562
563 (*
564 SetReturnCheck -
565 *)
566
567 PROCEDURE SetReturnCheck (value: BOOLEAN) : BOOLEAN ;
568 BEGIN
569 ReturnChecking := value ;
570 RETURN TRUE
571 END SetReturnCheck ;
572
573
574 (*
575 SetNilCheck -
576 *)
577
578 PROCEDURE SetNilCheck (value: BOOLEAN) : BOOLEAN ;
579 BEGIN
580 NilChecking := value ;
581 RETURN TRUE
582 END SetNilCheck ;
583
584
585 (*
586 SetCaseCheck - set else case checking to, value.
587 *)
588
589 PROCEDURE SetCaseCheck (value: BOOLEAN) : BOOLEAN ;
590 BEGIN
591 CaseElseChecking := value ;
592 RETURN TRUE
593 END SetCaseCheck ;
594
595
596 (*
597 SetCheckAll - set all runtime checking to, value.
598 *)
599
600 PROCEDURE SetCheckAll (value: BOOLEAN) : BOOLEAN ;
601 BEGIN
602 NilChecking := value ;
603 WholeDivChecking := value ;
604 IndexChecking := value ;
605 RangeChecking := value ;
606 ReturnChecking := value ;
607 NilChecking := value ;
608 CaseElseChecking := value ;
609 FloatValueChecking := value ;
610 WholeValueChecking := value ;
611 RETURN TRUE
612 END SetCheckAll ;
613
614
615 (*
616 SetAutoInit - -fauto-init turns on automatic initialization of pointers to NIL.
617 TRUE is returned.
618 *)
619
620 PROCEDURE SetAutoInit (value: BOOLEAN) ;
621 BEGIN
622 AutoInit := value ;
623 RETURN TRUE
624 END SetAutoInit ;
625
626
627 (*
628 SetUnusedVariableChecking - assigns the UnusedVariableChecking to value.
629 *)
630
631 PROCEDURE SetUnusedVariableChecking (value: BOOLEAN) ;
632 BEGIN
633 UnusedVariableChecking := value
634 END SetUnusedVariableChecking ;
635
636
637 (*
638 SetUnusedParameterChecking - assigns the UnusedParameterChecking to value.
639 *)
640
641 PROCEDURE SetUnusedParameterChecking (value: BOOLEAN) ;
642 BEGIN
643 UnusedParameterChecking := value
644 END SetUnusedParameterChecking ;
645
646
647 (*
648 SetStrictTypeChecking - assigns the StrictTypeChecking flag to value.
649 *)
650
651 PROCEDURE SetStrictTypeChecking (value: BOOLEAN) ;
652 BEGIN
653 StrictTypeChecking := value
654 END SetStrictTypeChecking ;
655
656
657 (*
658 SetVerboseUnbounded - sets the VerboseUnbounded flag to, value.
659 *)
660
661 PROCEDURE SetVerboseUnbounded (value: BOOLEAN) : BOOLEAN ;
662 BEGIN
663 VerboseUnbounded := value ;
664 RETURN TRUE
665 END SetVerboseUnbounded ;
666
667
668 (*
669 SetQuiet - sets the quiet flag to, value.
670 *)
671
672 PROCEDURE SetQuiet (value: BOOLEAN) : BOOLEAN ;
673 BEGIN
674 Quiet := value ;
675 RETURN TRUE
676 END SetQuiet ;
677
678
679 (*
680 SetCpp - enables the source to be preprocessed and enables the
681 recognition of C preprocessor line directives.
682 *)
683
684 PROCEDURE SetCpp (value: BOOLEAN) : BOOLEAN ;
685 BEGIN
686 CPreProcessor := value ;
687 LineDirectives := value ;
688 RETURN TRUE
689 END SetCpp ;
690
691
692 (*
693 GetCpp - returns TRUE if the C preprocessor was used.
694 *)
695
696 PROCEDURE GetCpp () : BOOLEAN ;
697 BEGIN
698 RETURN CPreProcessor
699 END GetCpp ;
700
701
702 (*
703 GetLineDirectives - returns TRUE if line directives are allowed.
704 *)
705
706 PROCEDURE GetLineDirectives () : BOOLEAN ;
707 BEGIN
708 RETURN LineDirectives
709 END GetLineDirectives ;
710
711
712 (*
713 SetPPOnly - set the PPonly (preprocess only) to value.
714 *)
715
716 PROCEDURE SetPPOnly (value: BOOLEAN) ;
717 BEGIN
718 PPonly := value
719 END SetPPOnly ;
720
721 (*
722 GetPPOnly - get the PPonly (preprocess only).
723 *)
724
725 PROCEDURE GetPPOnly () : BOOLEAN ;
726 BEGIN
727 RETURN PPonly
728 END GetPPOnly ;
729
730
731 (*
732 Setc - set the cflag (compile only flag -c) to value.
733 *)
734
735 PROCEDURE Setc (value: BOOLEAN) ;
736 BEGIN
737 cflag := value
738 END Setc ;
739
740
741 (*
742 Getc - get the cflag (compile only flag -c).
743 *)
744
745 PROCEDURE Getc () : BOOLEAN ;
746 BEGIN
747 RETURN cflag
748 END Getc ;
749
750
751 (*
752 SetUselist - set the uselist flag to value and remember the filename.
753 *)
754
755 PROCEDURE SetUselist (value: BOOLEAN; filename: ADDRESS) ;
756 BEGIN
757 UselistFlag := value ;
758 UselistFilename := KillString (UselistFilename) ;
759 IF filename # NIL
760 THEN
761 UselistFilename := InitStringCharStar (filename)
762 END
763 END SetUselist ;
764
765
766 (*
767 GetUselist - return the uselist flag.
768 *)
769
770 PROCEDURE GetUselist () : BOOLEAN ;
771 BEGIN
772 RETURN UselistFlag
773 END GetUselist ;
774
775
776 (*
777 GetUselistFilename - return the uselist filename as a String.
778 *)
779
780 PROCEDURE GetUselistFilename () : String ;
781 BEGIN
782 RETURN UselistFilename
783 END GetUselistFilename ;
784
785
786 (*
787 SetM2g - set GenerateStatementNote to value and return value.
788 Corresponds to the -fm2-g flag.
789 *)
790
791 PROCEDURE SetM2g (value: BOOLEAN) : BOOLEAN ;
792 BEGIN
793 GenerateStatementNote := value ;
794 RETURN GenerateStatementNote
795 END SetM2g ;
796
797
798 (*
799 GetM2g - returns TRUE if the -fm2-g flags was used.
800 *)
801
802 PROCEDURE GetM2g () : BOOLEAN ;
803 BEGIN
804 RETURN GenerateStatementNote
805 END GetM2g ;
806
807
808 (*
809 SetLowerCaseKeywords - set the lower case keyword flag and return the result.
810 *)
811
812 PROCEDURE SetLowerCaseKeywords (value: BOOLEAN) : BOOLEAN ;
813 BEGIN
814 LowerCaseKeywords := value ;
815 RETURN LowerCaseKeywords
816 END SetLowerCaseKeywords ;
817
818
819 (*
820 SetVerbose - set the Verbose flag to, value. It returns TRUE.
821 *)
822
823 PROCEDURE SetVerbose (value: BOOLEAN) : BOOLEAN ;
824 BEGIN
825 Verbose := value ;
826 RETURN( TRUE )
827 END SetVerbose ;
828
829
830 (*
831 SetMakeall -
832
833 PROCEDURE SetMakeall (value: BOOLEAN) : BOOLEAN ;
834 BEGIN
835 (* value is unused *)
836 RETURN( TRUE )
837 END SetMakeall ;
838 *)
839
840
841 (*
842 SetMakeall0 -
843
844 PROCEDURE SetMakeall0 (value: BOOLEAN) : BOOLEAN ;
845 BEGIN
846 (* value is unused *)
847 RETURN( TRUE )
848 END SetMakeall0 ;
849 *)
850
851
852 (*
853 SetIncludePath -
854
855 PROCEDURE SetIncludePath (arg: ADDRESS) : BOOLEAN ;
856 BEGIN
857 RETURN( TRUE )
858 END SetIncludePath ;
859 *)
860
861
862 (*
863 SetUnboundedByReference -
864 *)
865
866 PROCEDURE SetUnboundedByReference (value: BOOLEAN) : BOOLEAN ;
867 BEGIN
868 UnboundedByReference := value ;
869 RETURN( TRUE )
870 END SetUnboundedByReference ;
871
872
873 (*
874 (*
875 SetDebugging - sets the debugging flag to, v.
876 *)
877
878 PROCEDURE SetDebugging (value: BOOLEAN) ;
879 BEGIN
880 GenerateDebugging := value
881 END SetDebugging ;
882
883
884 (*
885 SetProfiling - dummy procedure, as profiling is implemented in the gcc backend.
886 *)
887
888 PROCEDURE SetProfiling (value: BOOLEAN) ;
889 BEGIN
890 (* nothing to do *)
891 END SetProfiling ;
892 *)
893
894
895 (*
896 SetISO -
897 *)
898
899 PROCEDURE SetISO (value: BOOLEAN) ;
900 BEGIN
901 Iso := value ;
902 Pim := NOT value ;
903 Pim2 := NOT value ;
904 (* Pim4 is the default, leave it alone since the DIV and MOD rules are the
905 same as ISO. *)
906 END SetISO ;
907
908
909 (*
910 SetPIM -
911 *)
912
913 PROCEDURE SetPIM (value: BOOLEAN) ;
914 BEGIN
915 Pim := value ;
916 Iso := NOT value
917 END SetPIM ;
918
919
920 (*
921 SetPIM2 -
922 *)
923
924 PROCEDURE SetPIM2 (value: BOOLEAN) ;
925 BEGIN
926 Pim := value ;
927 Pim2 := value ;
928 Iso := NOT value ;
929 IF value
930 THEN
931 (* Pim4 is the default, turn it off. *)
932 Pim4 := FALSE
933 END
934 END SetPIM2 ;
935
936
937 (*
938 SetPIM3 -
939 *)
940
941 PROCEDURE SetPIM3 (value: BOOLEAN) ;
942 BEGIN
943 Pim := value ;
944 Pim3 := value ;
945 Iso := NOT value ;
946 IF value
947 THEN
948 (* Pim4 is the default, turn it off. *)
949 Pim4 := FALSE
950 END
951 END SetPIM3 ;
952
953
954 (*
955 SetPIM4 -
956 *)
957
958 PROCEDURE SetPIM4 (value: BOOLEAN) ;
959 BEGIN
960 Pim := value ;
961 Pim4 := value ;
962 Iso := NOT value
963 END SetPIM4 ;
964
965
966 (*
967 SetPositiveModFloor - sets the positive mod floor option.
968 *)
969
970 PROCEDURE SetPositiveModFloor (value: BOOLEAN) ;
971 BEGIN
972 PositiveModFloorDiv := value
973 END SetPositiveModFloor ;
974
975
976 (*
977 SetWholeDiv - sets the whole division flag.
978 *)
979
980 PROCEDURE SetWholeDiv (value: BOOLEAN) ;
981 BEGIN
982 WholeDivChecking := value
983 END SetWholeDiv ;
984
985
986 (*
987 SetIndex - sets the runtime array index checking flag.
988 *)
989
990 PROCEDURE SetIndex (value: BOOLEAN) ;
991 BEGIN
992 IndexChecking := value
993 END SetIndex ;
994
995
996 (*
997 SetRange - sets the runtime range checking flag.
998 *)
999
1000 PROCEDURE SetRange (value: BOOLEAN) ;
1001 BEGIN
1002 RangeChecking := value
1003 END SetRange ;
1004
1005
1006 (*
1007 SetExceptions - sets the enable runtime exceptions flag.
1008 *)
1009
1010 PROCEDURE SetExceptions (value: BOOLEAN) ;
1011 BEGIN
1012 Exceptions := value
1013 END SetExceptions ;
1014
1015
1016 (*
1017 SetStyle -
1018 *)
1019
1020 PROCEDURE SetStyle (value: BOOLEAN) ;
1021 BEGIN
1022 StyleChecking := value
1023 END SetStyle ;
1024
1025
1026 (*
1027 SetPedantic -
1028 *)
1029
1030 PROCEDURE SetPedantic (value: BOOLEAN) ;
1031 BEGIN
1032 Pedantic := value
1033 END SetPedantic ;
1034
1035
1036 (*
1037 SetPedanticParamNames - sets the pedantic parameter name flag.
1038 *)
1039
1040 PROCEDURE SetPedanticParamNames (value: BOOLEAN) ;
1041 BEGIN
1042 PedanticParamNames := value
1043 END SetPedanticParamNames ;
1044
1045
1046 (*
1047 SetPedanticCast - sets the pedantic cast flag.
1048 *)
1049
1050 PROCEDURE SetPedanticCast (value: BOOLEAN) ;
1051 BEGIN
1052 PedanticCast := value
1053 END SetPedanticCast ;
1054
1055
1056 (*
1057 SetExtendedOpaque - sets the ExtendedOpaque flag.
1058 *)
1059
1060 PROCEDURE SetExtendedOpaque (value: BOOLEAN) ;
1061 BEGIN
1062 ExtendedOpaque := value
1063 END SetExtendedOpaque ;
1064
1065
1066 (*
1067 SetXCode - sets the xcode flag.
1068 *)
1069
1070 PROCEDURE SetXCode (value: BOOLEAN) ;
1071 BEGIN
1072 Xcode := value
1073 END SetXCode ;
1074
1075
1076 (*
1077 SetSwig -
1078 *)
1079
1080 PROCEDURE SetSwig (value: BOOLEAN) ;
1081 BEGIN
1082 GenerateSwig := value
1083 END SetSwig ;
1084
1085
1086 (*
1087 SetQuadDebugging - display the quadruples (internal debugging).
1088 *)
1089
1090 PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
1091 BEGIN
1092 DumpQuad := value ;
1093 DumpQuadFilename := KillString (DumpQuadFilename) ;
1094 DumpQuadFilename := InitString ('-')
1095 END SetQuadDebugging ;
1096
1097
1098 (*
1099 SetCompilerDebugging - turn on internal compiler debugging.
1100 *)
1101
1102 PROCEDURE SetCompilerDebugging (value: BOOLEAN) ;
1103 BEGIN
1104 CompilerDebugging := value
1105 END SetCompilerDebugging ;
1106
1107
1108 (*
1109 SetM2DebugTraceFilter - set internal debug flags. The flags should be
1110 specified as a comma separated list. The full
1111 list allowed is quad,line,token,all.
1112 *)
1113
1114 PROCEDURE SetM2DebugTraceFilter (value: BOOLEAN; filter: ADDRESS) ;
1115 VAR
1116 word,
1117 full : String ;
1118 start,
1119 i : INTEGER ;
1120 BEGIN
1121 full := InitStringCharStar (filter) ;
1122 start := 0 ;
1123 REPEAT
1124 i := Index (full, ',', start) ;
1125 IF i = -1
1126 THEN
1127 word := Slice (full, start, 0)
1128 ELSE
1129 word := Slice (full, start, i)
1130 END ;
1131 SetM2DebugTrace (word, value) ;
1132 word := KillString (word) ;
1133 start := i+1 ;
1134 UNTIL i = -1 ;
1135 full := KillString (full) ;
1136 END SetM2DebugTraceFilter ;
1137
1138
1139 (*
1140 SetM2DebugTrace -
1141 *)
1142
1143 PROCEDURE SetM2DebugTrace (word: String; value: BOOLEAN) ;
1144 BEGIN
1145 IF EqualArray (word, 'all')
1146 THEN
1147 (* DebugTraceTree := value ; *)
1148 DebugTraceQuad := value ;
1149 DebugTraceToken := value ;
1150 DebugTraceLine := value
1151 ELSIF EqualArray (word, 'quad')
1152 THEN
1153 DebugTraceQuad := value
1154 ELSIF EqualArray (word, 'token')
1155 THEN
1156 DebugTraceToken := value
1157 ELSIF EqualArray (word, 'line')
1158 THEN
1159 DebugTraceLine := value
1160 ELSE
1161 errors1 ("unrecognized filter %s seen in -fm2-debug-trace= option\n", word)
1162 END
1163 END SetM2DebugTrace ;
1164
1165
1166 (*
1167 SetDebugFunctionLineNumbers - set DebugFunctionLineNumbers.
1168 *)
1169
1170 PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
1171 BEGIN
1172 DebugFunctionLineNumbers := value
1173 END SetDebugFunctionLineNumbers ;
1174
1175
1176 (*
1177 GetDebugTraceQuad - return DebugTraceQuad.
1178 *)
1179
1180 PROCEDURE GetDebugTraceQuad () : BOOLEAN ;
1181 BEGIN
1182 RETURN DebugTraceQuad
1183 END GetDebugTraceQuad ;
1184
1185
1186 (*
1187 GetDebugTraceTree - return DebugTraceTree.
1188 *)
1189
1190 PROCEDURE GetDebugTraceTree () : BOOLEAN ;
1191 BEGIN
1192 RETURN DebugTraceTree
1193 END GetDebugTraceTree ;
1194
1195
1196 (*
1197 GetDebugTraceToken - return DebugTraceToken.
1198 *)
1199
1200 PROCEDURE GetDebugTraceToken () : BOOLEAN ;
1201 BEGIN
1202 RETURN DebugTraceToken
1203 END GetDebugTraceToken ;
1204
1205
1206 (*
1207 GetDebugTraceLine - return DebugTraceLine.
1208 *)
1209
1210 PROCEDURE GetDebugTraceLine () : BOOLEAN ;
1211 BEGIN
1212 RETURN DebugTraceLine
1213 END GetDebugTraceLine ;
1214
1215
1216 (*
1217 GetDebugFunctionLineNumbers - return DebugFunctionLineNumbers.
1218 *)
1219
1220 PROCEDURE GetDebugFunctionLineNumbers () : BOOLEAN ;
1221 BEGIN
1222 RETURN DebugFunctionLineNumbers
1223 END GetDebugFunctionLineNumbers ;
1224
1225
1226 (*
1227 SetSources -
1228 *)
1229
1230 PROCEDURE SetSources (value: BOOLEAN) ;
1231 BEGIN
1232 Quiet := NOT value ;
1233 SeenSources := value
1234 END SetSources ;
1235
1236
1237 (*
1238 SetDumpSystemExports -
1239 *)
1240
1241 PROCEDURE SetDumpSystemExports (value: BOOLEAN) ;
1242 BEGIN
1243 DumpSystemExports := value
1244 END SetDumpSystemExports ;
1245
1246
1247 (*
1248 SetSearchPath -
1249 *)
1250
1251 PROCEDURE SetSearchPath (arg: ADDRESS) ;
1252 VAR
1253 s: String ;
1254 BEGIN
1255 s := InitStringCharStar (arg) ;
1256 AddInclude (M2PathName, s) ;
1257 IF Debugging
1258 THEN
1259 DumpPathName ("path name entries: ")
1260 END ;
1261 s := KillString (s)
1262 END SetSearchPath ;
1263
1264
1265 (*
1266 setdefextension - set the source file definition module extension to arg.
1267 This should include the . and by default it is set to .def.
1268 *)
1269
1270 PROCEDURE setdefextension (arg: ADDRESS) ;
1271 VAR
1272 s: String ;
1273 BEGIN
1274 s := InitStringCharStar (arg) ;
1275 SetDefExtension (s) ;
1276 s := KillString (s)
1277 END setdefextension ;
1278
1279
1280 (*
1281 setmodextension - set the source file module extension to arg.
1282 This should include the . and by default it is set to .mod.
1283 *)
1284
1285 PROCEDURE setmodextension (arg: ADDRESS) ;
1286 VAR
1287 s: String ;
1288 BEGIN
1289 s := InitStringCharStar (arg) ;
1290 SetModExtension (s) ;
1291 s := KillString (s)
1292 END setmodextension ;
1293
1294
1295 (*
1296 SetOptimizing -
1297 *)
1298
1299 PROCEDURE SetOptimizing (value: CARDINAL) ;
1300 BEGIN
1301 IF value>0
1302 THEN
1303 Optimizing := TRUE ;
1304 OptimizeBasicBlock := TRUE ;
1305 OptimizeUncalledProcedures := TRUE ;
1306 OptimizeCommonSubExpressions := TRUE
1307 ELSE
1308 Optimizing := FALSE ;
1309 OptimizeBasicBlock := FALSE ;
1310 OptimizeUncalledProcedures := FALSE ;
1311 OptimizeCommonSubExpressions := FALSE
1312 END
1313 END SetOptimizing ;
1314
1315
1316 (*
1317 SetForcedLocation - sets the location for the lifetime of this compile to, location.
1318 This is primarily an internal debugging switch.
1319 *)
1320
1321 PROCEDURE SetForcedLocation (location: location_t) ;
1322 BEGIN
1323 ForcedLocation := TRUE ;
1324 ForcedLocationValue := location
1325 END SetForcedLocation ;
1326
1327
1328 (*
1329 SetCC1Quiet - sets the cc1quiet flag to, value.
1330 *)
1331
1332 PROCEDURE SetCC1Quiet (value: BOOLEAN) ;
1333 BEGIN
1334 CC1Quiet := value
1335 END SetCC1Quiet ;
1336
1337
1338 (*
1339 SetStatistics - turn on/off generate of compile time statistics.
1340 *)
1341
1342 PROCEDURE SetStatistics (on: BOOLEAN) ;
1343 BEGIN
1344 Statistics := on
1345 END SetStatistics ;
1346
1347
1348 (*
1349 OverrideLocation - possibly override the location value, depending upon
1350 whether the -flocation= option was used.
1351 *)
1352
1353 PROCEDURE OverrideLocation (location: location_t) : location_t ;
1354 BEGIN
1355 IF ForcedLocation
1356 THEN
1357 RETURN( ForcedLocationValue )
1358 ELSE
1359 RETURN( location )
1360 END
1361 END OverrideLocation ;
1362
1363
1364 (*
1365 SetGenerateStatementNote - turn on generation of nops if necessary
1366 to generate pedalogical single stepping.
1367 *)
1368
1369 PROCEDURE SetGenerateStatementNote (value: BOOLEAN) ;
1370 BEGIN
1371 GenerateStatementNote := value
1372 END SetGenerateStatementNote ;
1373
1374
1375 (*
1376 GetISO - return TRUE if -fiso was present on the command line.
1377 *)
1378
1379 PROCEDURE GetISO () : BOOLEAN ;
1380 BEGIN
1381 RETURN Iso
1382 END GetISO ;
1383
1384
1385 (*
1386 GetPIM - return TRUE if -fpim was present on the command line.
1387 *)
1388
1389 PROCEDURE GetPIM () : BOOLEAN ;
1390 BEGIN
1391 RETURN Pim
1392 END GetPIM ;
1393
1394
1395 (*
1396 GetPIM2 - return TRUE if -fpim2 was present on the command line.
1397 *)
1398
1399 PROCEDURE GetPIM2 () : BOOLEAN ;
1400 BEGIN
1401 RETURN Pim2
1402 END GetPIM2 ;
1403
1404
1405 (*
1406 GetPIM3 - return TRUE if -fpim3 was present on the command line.
1407 *)
1408
1409 PROCEDURE GetPIM3 () : BOOLEAN ;
1410 BEGIN
1411 RETURN Pim3
1412 END GetPIM3 ;
1413
1414
1415 (*
1416 GetPIM4 - return TRUE if -fpim4 was present on the command line.
1417 *)
1418
1419 PROCEDURE GetPIM4 () : BOOLEAN ;
1420 BEGIN
1421 RETURN Pim4
1422 END GetPIM4 ;
1423
1424
1425 (*
1426 GetPositiveModFloor - return TRUE if -fpositive-mod-floor was present
1427 on the command line.
1428 *)
1429
1430 PROCEDURE GetPositiveModFloor () : BOOLEAN ;
1431 BEGIN
1432 RETURN PositiveModFloorDiv
1433 END GetPositiveModFloor ;
1434
1435
1436 (*
1437 GetFloatValueCheck - return TRUE if -ffloatvalue was present on the
1438 command line.
1439 *)
1440
1441 PROCEDURE GetFloatValueCheck () : BOOLEAN ;
1442 BEGIN
1443 RETURN FloatValueChecking
1444 END GetFloatValueCheck ;
1445
1446
1447 (*
1448 SetFloatValueCheck - set depending upon the -ffloatvalue.
1449 *)
1450
1451 PROCEDURE SetFloatValueCheck (value: BOOLEAN) ;
1452 BEGIN
1453 FloatValueChecking := value
1454 END SetFloatValueCheck ;
1455
1456
1457 (*
1458 GetWholeValueCheck - return TRUE if -fwholevalue was present on the
1459 command line.
1460 *)
1461
1462 PROCEDURE GetWholeValueCheck () : BOOLEAN ;
1463 BEGIN
1464 RETURN WholeValueChecking
1465 END GetWholeValueCheck ;
1466
1467
1468 (*
1469 SetWholeValueCheck - set depending upon the -fwholevalue.
1470 *)
1471
1472 PROCEDURE SetWholeValueCheck (value: BOOLEAN) ;
1473 BEGIN
1474 WholeValueChecking := value
1475 END SetWholeValueCheck ;
1476
1477
1478 (*
1479 SetWall - set all warnings to, value.
1480 *)
1481
1482 PROCEDURE SetWall (value: BOOLEAN) ;
1483 BEGIN
1484 UnusedVariableChecking := value ;
1485 UnusedParameterChecking := value ;
1486 UninitVariableChecking := value ;
1487 PedanticCast := value ;
1488 PedanticParamNames := value ;
1489 StyleChecking := value ;
1490 CaseEnumChecking := value
1491 END SetWall ;
1492
1493
1494 (*
1495 SetSaveTemps - turn on/off -save-temps.
1496 *)
1497
1498 PROCEDURE SetSaveTemps (value: BOOLEAN) ;
1499 BEGIN
1500 SaveTemps := value
1501 END SetSaveTemps ;
1502
1503
1504 (*
1505 SetSaveTempsDir - turn on/off -save-temps and specify the directory.
1506 *)
1507
1508 PROCEDURE SetSaveTempsDir (arg: ADDRESS) ;
1509 BEGIN
1510 SaveTempsDir := InitStringCharStar (arg) ;
1511 SaveTemps := TRUE
1512 END SetSaveTempsDir ;
1513
1514
1515 (*
1516 GetSaveTempsDir - return SaveTempsDir or NIL if -save-temps was not used.
1517 *)
1518
1519 PROCEDURE GetSaveTempsDir () : String ;
1520 BEGIN
1521 RETURN SaveTempsDir
1522 END GetSaveTempsDir ;
1523
1524
1525 (*
1526 SetDumpDir - Set the dump dir.
1527 *)
1528
1529 PROCEDURE SetDumpDir (arg: ADDRESS) ;
1530 BEGIN
1531 DumpDir := InitStringCharStar (arg)
1532 END SetDumpDir ;
1533
1534
1535 (*
1536 GetDumpDir - return DumpDir or NIL.
1537 *)
1538
1539 PROCEDURE GetDumpDir () : String ;
1540 BEGIN
1541 RETURN DumpDir
1542 END GetDumpDir ;
1543
1544 (*
1545 SetScaffoldDynamic - set the -fscaffold-dynamic flag.
1546 *)
1547
1548 PROCEDURE SetScaffoldDynamic (value: BOOLEAN) ;
1549 BEGIN
1550 ScaffoldDynamic := value ;
1551 IF ScaffoldDynamic
1552 THEN
1553 ScaffoldStatic := FALSE
1554 END
1555 END SetScaffoldDynamic ;
1556
1557
1558 (*
1559 SetScaffoldStatic - set the -fscaffold-static flag.
1560 *)
1561
1562 PROCEDURE SetScaffoldStatic (value: BOOLEAN) ;
1563 BEGIN
1564 ScaffoldStatic := value ;
1565 IF ScaffoldStatic
1566 THEN
1567 ScaffoldDynamic := FALSE
1568 END
1569 END SetScaffoldStatic ;
1570
1571
1572 (*
1573 GetScaffoldDynamic - get the -fscaffold-dynamic flag.
1574 *)
1575
1576 PROCEDURE GetScaffoldDynamic () : BOOLEAN ;
1577 BEGIN
1578 RETURN ScaffoldDynamic
1579 END GetScaffoldDynamic ;
1580
1581
1582 (*
1583 GetScaffoldStatic - get the -fscaffold-static flag.
1584 *)
1585
1586 PROCEDURE GetScaffoldStatic () : BOOLEAN ;
1587 BEGIN
1588 RETURN ScaffoldStatic
1589 END GetScaffoldStatic ;
1590
1591
1592 (*
1593 SetScaffoldMain - set the -fscaffold-main flag.
1594 *)
1595
1596 PROCEDURE SetScaffoldMain (value: BOOLEAN) ;
1597 BEGIN
1598 ScaffoldMain := value
1599 END SetScaffoldMain ;
1600
1601
1602 (*
1603 SetRuntimeModuleOverride - set the override sequence used for module
1604 initialization and finialization.
1605 *)
1606
1607 PROCEDURE SetRuntimeModuleOverride (override: ADDRESS) ;
1608 BEGIN
1609 RuntimeModuleOverride := KillString (RuntimeModuleOverride) ;
1610 RuntimeModuleOverride := InitStringCharStar (override)
1611 END SetRuntimeModuleOverride ;
1612
1613
1614 (*
1615 GetRuntimeModuleOverride - return a string containing any user override
1616 or the default module initialization override
1617 sequence.
1618 *)
1619
1620 PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
1621 BEGIN
1622 RETURN string (RuntimeModuleOverride)
1623 END GetRuntimeModuleOverride ;
1624
1625
1626 (*
1627 SetGenModuleList - set the GenModuleList flag to true and pass
1628 set GenModuleListFilename to filename.
1629 *)
1630
1631 PROCEDURE SetGenModuleList (value: BOOLEAN; filename: ADDRESS) ;
1632 BEGIN
1633 GenModuleListFilename := KillString (GenModuleListFilename) ;
1634 IF filename # NIL
1635 THEN
1636 GenModuleListFilename := InitStringCharStar (filename)
1637 END ;
1638 GenModuleList := value
1639 END SetGenModuleList ;
1640
1641
1642 (*
1643 GetGenModuleFilename - returns the filename set by SetGenModuleList.
1644 *)
1645
1646 PROCEDURE GetGenModuleFilename () : String ;
1647 BEGIN
1648 RETURN GenModuleListFilename
1649 END GetGenModuleFilename ;
1650
1651
1652 (*
1653 SetShared - sets the SharedFlag to value.
1654 *)
1655
1656 PROCEDURE SetShared (value: BOOLEAN) ;
1657 BEGIN
1658 SharedFlag := value
1659 END SetShared ;
1660
1661
1662 (*
1663 SetUninitVariableChecking - sets the UninitVariableChecking and
1664 UninitVariableConditionalChecking flags to value
1665 depending upon arg string. The arg string
1666 can be: "all", "known,cond", "cond,known", "known"
1667 or "cond".
1668 *)
1669
1670 PROCEDURE SetUninitVariableChecking (value: BOOLEAN; arg: ADDRESS) : INTEGER ;
1671 VAR
1672 s: String ;
1673 BEGIN
1674 IF Debugging
1675 THEN
1676 IF value
1677 THEN
1678 printf ("SetUninitVariableChecking (TRUE, %s)\n", arg)
1679 ELSE
1680 printf ("SetUninitVariableChecking (FALSE, %s)\n", arg)
1681 END
1682 END ;
1683 s := InitStringCharStar (arg) ;
1684 IF EqualArray (s, "all") OR
1685 EqualArray (s, "known,cond") OR
1686 EqualArray (s, "cond,known")
1687 THEN
1688 UninitVariableChecking := value ;
1689 UninitVariableConditionalChecking := value ;
1690 s := KillString (s) ;
1691 RETURN 1
1692 ELSIF EqualArray (s, "known")
1693 THEN
1694 UninitVariableChecking := value ;
1695 s := KillString (s) ;
1696 RETURN 1
1697 ELSIF EqualArray (s, "cond")
1698 THEN
1699 UninitVariableConditionalChecking := value ;
1700 s := KillString (s) ;
1701 RETURN 1
1702 ELSE
1703 s := KillString (s) ;
1704 RETURN 0
1705 END
1706 END SetUninitVariableChecking ;
1707
1708
1709 (*
1710 SetCaseEnumChecking - sets the CaseEnumChecking to value.
1711 *)
1712
1713 PROCEDURE SetCaseEnumChecking (value: BOOLEAN) ;
1714 BEGIN
1715 CaseEnumChecking := value
1716 END SetCaseEnumChecking ;
1717
1718
1719 (*
1720 SetDebugBuiltins - sets the DebugBuiltins to value.
1721 *)
1722
1723 PROCEDURE SetDebugBuiltins (value: BOOLEAN) ;
1724 BEGIN
1725 DebugBuiltins := value
1726 END SetDebugBuiltins ;
1727
1728
1729 (*
1730 SetIBMLongDouble - enable/disable LONGREAL to map onto the
1731 IBM long double 128 bit data type.
1732 (Only available on the ppc).
1733 *)
1734
1735 PROCEDURE SetIBMLongDouble (value: BOOLEAN) ;
1736 BEGIN
1737 IBMLongDouble := value ;
1738 IF value
1739 THEN
1740 IEEELongDouble := FALSE
1741 END
1742 END SetIBMLongDouble ;
1743
1744
1745 (*
1746 GetIBMLongDouble - return the value of IBMLongDouble.
1747 *)
1748
1749 PROCEDURE GetIBMLongDouble () : BOOLEAN ;
1750 BEGIN
1751 RETURN IBMLongDouble
1752 END GetIBMLongDouble ;
1753
1754
1755 (*
1756 SetIEEELongDouble - enable/disable LONGREAL to map onto the
1757 IEEE long double 128 bit data type.
1758 (Only available on the ppc).
1759 *)
1760
1761 PROCEDURE SetIEEELongDouble (value: BOOLEAN) ;
1762 BEGIN
1763 IEEELongDouble := value ;
1764 IF value
1765 THEN
1766 IBMLongDouble := FALSE
1767 END
1768 END SetIEEELongDouble ;
1769
1770
1771 (*
1772 GetIEEELongDouble - return the value of IEEELongDouble.
1773 *)
1774
1775 PROCEDURE GetIEEELongDouble () : BOOLEAN ;
1776 BEGIN
1777 RETURN IEEELongDouble
1778 END GetIEEELongDouble ;
1779
1780
1781 (*
1782 InitializeLongDoubleFlags - initialize the long double related flags
1783 with default values given during gcc configure.
1784 *)
1785
1786 PROCEDURE InitializeLongDoubleFlags ;
1787 BEGIN
1788 IBMLongDouble := FALSE ;
1789 IEEELongDouble := FALSE ;
1790 CASE TargetIEEEQuadDefault () OF
1791
1792 -1: |
1793 0: IBMLongDouble := TRUE |
1794 1: IEEELongDouble := TRUE
1795
1796 ELSE
1797 InternalError ('unexpected value returned from TargetIEEEQuadDefault ()')
1798 END
1799 END InitializeLongDoubleFlags ;
1800
1801
1802 (*
1803 GetDumpDeclFilename - returns the DumpDeclFilename.
1804 *)
1805
1806 PROCEDURE GetDumpDeclFilename () : String ;
1807 BEGIN
1808 RETURN DumpDeclFilename
1809 END GetDumpDeclFilename ;
1810
1811
1812 (*
1813 SetDumpDeclFilename -
1814 *)
1815
1816 PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
1817 BEGIN
1818 DumpDecl := value ;
1819 DumpDeclFilename := KillString (DumpDeclFilename) ;
1820 IF filename # NIL
1821 THEN
1822 DumpDeclFilename := InitStringCharStar (filename)
1823 END
1824 END SetDumpDeclFilename ;
1825
1826
1827 (*
1828 GetDumpQuadFilename - returns the DumpQuadFilename.
1829 *)
1830
1831 PROCEDURE GetDumpQuadFilename () : String ;
1832 BEGIN
1833 RETURN DumpQuadFilename
1834 END GetDumpQuadFilename ;
1835
1836
1837 (*
1838 SetDumpQuadFilename -
1839 *)
1840
1841 PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
1842 BEGIN
1843 DumpQuad := value ;
1844 DumpQuadFilename := KillString (DumpQuadFilename) ;
1845 IF filename # NIL
1846 THEN
1847 DumpQuadFilename := InitStringCharStar (filename)
1848 END
1849 END SetDumpQuadFilename ;
1850
1851
1852 (*
1853 GetDumpGimpleFilename - returns the DumpGimpleFilename.
1854 *)
1855
1856 PROCEDURE GetDumpGimpleFilename () : String ;
1857 BEGIN
1858 RETURN DumpGimpleFilename
1859 END GetDumpGimpleFilename ;
1860
1861
1862 (*
1863 SetDumpGimpleFilename - set DumpGimpleFilename to filename.
1864 *)
1865
1866 PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
1867 BEGIN
1868 DumpGimple := value ;
1869 DumpGimpleFilename := KillString (DumpGimpleFilename) ;
1870 IF value AND (filename # NIL)
1871 THEN
1872 DumpGimpleFilename := InitStringCharStar (filename)
1873 END
1874 END SetDumpGimpleFilename ;
1875
1876
1877 (*
1878 SetM2DumpFilter - sets the filter to a comma separated list of procedures
1879 and modules. Not to be confused with SetM2Dump below
1880 which enables the class of data structures to be dumped.
1881 *)
1882
1883 PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ;
1884 BEGIN
1885 M2DumpFilter := KillString (M2DumpFilter) ;
1886 IF value AND (filter # NIL)
1887 THEN
1888 M2DumpFilter := InitStringCharStar (filter)
1889 END
1890 END SetM2DumpFilter ;
1891
1892
1893 (*
1894 GetM2DumpFilter - returns the dump filter.
1895 *)
1896
1897 PROCEDURE GetM2DumpFilter () : ADDRESS ;
1898 BEGIN
1899 IF M2DumpFilter = NIL
1900 THEN
1901 RETURN NIL
1902 ELSE
1903 RETURN string (M2DumpFilter)
1904 END
1905 END GetM2DumpFilter ;
1906
1907
1908 (*
1909 MatchDump - enable/disable dump using value. It returns TRUE if dump
1910 is valid.
1911 *)
1912
1913 PROCEDURE MatchDump (dump: String; value: BOOLEAN) : BOOLEAN ;
1914 BEGIN
1915 IF EqualArray (dump, 'all')
1916 THEN
1917 DumpDecl := value ;
1918 DumpQuad := value ;
1919 DumpGimple := value ;
1920 RETURN TRUE
1921 ELSIF EqualArray (dump, 'decl')
1922 THEN
1923 DumpDecl := value ;
1924 RETURN TRUE
1925 ELSIF EqualArray (dump, 'gimple')
1926 THEN
1927 DumpGimple := value ;
1928 RETURN TRUE
1929 ELSIF EqualArray (dump, 'quad')
1930 THEN
1931 DumpQuad := value ;
1932 RETURN TRUE
1933 END ;
1934 RETURN FALSE
1935 END MatchDump ;
1936
1937
1938 (*
1939 SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all.
1940 It returns TRUE if the comma separated list is valid.
1941 *)
1942
1943 PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) : BOOLEAN ;
1944 VAR
1945 result: BOOLEAN ;
1946 dump : String ;
1947 start,
1948 i : INTEGER ;
1949 BEGIN
1950 IF filter = NIL
1951 THEN
1952 RETURN FALSE
1953 END ;
1954 IF M2Dump # NIL
1955 THEN
1956 M2Dump := KillString (M2Dump)
1957 END ;
1958 M2Dump := InitStringCharStar (filter) ;
1959 start := 0 ;
1960 REPEAT
1961 i := Index (M2Dump, ',', start) ;
1962 IF i = -1
1963 THEN
1964 dump := Slice (M2Dump, start, 0)
1965 ELSE
1966 dump := Slice (M2Dump, start, i)
1967 END ;
1968 result := MatchDump (dump, value) ;
1969 dump := KillString (dump) ;
1970 IF NOT result
1971 THEN
1972 RETURN FALSE
1973 END ;
1974 start := i+1 ;
1975 UNTIL i = -1 ;
1976 RETURN TRUE
1977 END SetM2Dump ;
1978
1979
1980 (*
1981 GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump.
1982 *)
1983
1984 PROCEDURE GetDumpGimple () : BOOLEAN ;
1985 BEGIN
1986 RETURN DumpGimple
1987 END GetDumpGimple ;
1988
1989
1990 (*
1991 GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump.
1992 *)
1993
1994 PROCEDURE GetDumpQuad () : BOOLEAN ;
1995 BEGIN
1996 RETURN DumpQuad
1997 END GetDumpQuad ;
1998
1999
2000 (*
2001 GetDumpDecl - return TRUE if the dump decl flag is set from SetM2Dump.
2002 *)
2003
2004 PROCEDURE GetDumpDecl () : BOOLEAN ;
2005 BEGIN
2006 RETURN DumpDecl
2007 END GetDumpDecl ;
2008
2009
2010 (*
2011 GetDumpLangGimple - return TRUE if the gimple flag is set from SetM2Dump.
2012 *)
2013
2014 PROCEDURE GetDumpGimple () : BOOLEAN ;
2015 BEGIN
2016 RETURN DumpGimple
2017 END GetDumpGimple ;
2018
2019
2020 BEGIN
2021 cflag := FALSE ; (* -c. *)
2022 RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ;
2023 CppArgs := InitString ('') ;
2024 Pim := TRUE ;
2025 Pim2 := FALSE ;
2026 Pim3 := FALSE ;
2027 Pim4 := TRUE ;
2028 PositiveModFloorDiv := FALSE ;
2029 Iso := FALSE ;
2030 SeenSources := FALSE ;
2031 Statistics := FALSE ;
2032 StyleChecking := FALSE ;
2033 CompilerDebugging := FALSE ;
2034 GenerateDebugging := FALSE ;
2035 Optimizing := FALSE ;
2036 Pedantic := FALSE ;
2037 Verbose := FALSE ;
2038 Quiet := TRUE ;
2039 CC1Quiet := TRUE ;
2040 Profiling := FALSE ;
2041 DumpQuad := FALSE ;
2042 OptimizeBasicBlock := FALSE ;
2043 OptimizeUncalledProcedures := FALSE ;
2044 OptimizeCommonSubExpressions := FALSE ;
2045 NilChecking := FALSE ;
2046 WholeDivChecking := FALSE ;
2047 WholeValueChecking := FALSE ;
2048 FloatValueChecking := FALSE ;
2049 IndexChecking := FALSE ;
2050 RangeChecking := FALSE ;
2051 ReturnChecking := FALSE ;
2052 CaseElseChecking := FALSE ;
2053 CPreProcessor := FALSE ;
2054 LineDirectives := TRUE ;
2055 ExtendedOpaque := FALSE ;
2056 UnboundedByReference := FALSE ;
2057 VerboseUnbounded := FALSE ;
2058 PedanticParamNames := FALSE ;
2059 PedanticCast := FALSE ;
2060 Xcode := FALSE ;
2061 DumpSystemExports := FALSE ;
2062 GenerateSwig := FALSE ;
2063 Exceptions := TRUE ;
2064 DebugBuiltins := FALSE ;
2065 ForcedLocation := FALSE ;
2066 WholeProgram := FALSE ;
2067 DebugTraceQuad := FALSE ;
2068 DebugTraceTree := FALSE ;
2069 DebugTraceLine := FALSE ;
2070 DebugTraceToken := FALSE ;
2071 DebugFunctionLineNumbers := FALSE ;
2072 GenerateStatementNote := FALSE ;
2073 LowerCaseKeywords := FALSE ;
2074 UnusedVariableChecking := FALSE ;
2075 UnusedParameterChecking := FALSE ;
2076 StrictTypeChecking := TRUE ;
2077 AutoInit := FALSE ;
2078 SaveTemps := FALSE ;
2079 ScaffoldDynamic := TRUE ;
2080 ScaffoldStatic := FALSE ;
2081 ScaffoldMain := FALSE ;
2082 UselistFilename := NIL ;
2083 GenModuleList := FALSE ;
2084 GenModuleListFilename := NIL ;
2085 SharedFlag := FALSE ;
2086 Barg := NIL ;
2087 MDFlag := FALSE ;
2088 MMDFlag := FALSE ;
2089 DepTarget := NIL ;
2090 MPFlag := FALSE ;
2091 SaveTempsDir := NIL ;
2092 DumpDir := NIL ;
2093 UninitVariableChecking := FALSE ;
2094 UninitVariableConditionalChecking := FALSE ;
2095 CaseEnumChecking := FALSE ;
2096 MFlag := FALSE ;
2097 MMFlag := FALSE ;
2098 MFarg := NIL ;
2099 MTFlag := NIL ;
2100 MQFlag := NIL ;
2101 InitializeLongDoubleFlags ;
2102 M2Prefix := InitString ('') ;
2103 M2PathName := InitString ('') ;
2104 DumpQuadFilename := NIL ;
2105 DumpGimpleFilename := NIL ;
2106 DumpDeclFilename := NIL ;
2107 DumpDecl := FALSE ;
2108 DumpQuad := FALSE ;
2109 DumpGimple := FALSE ;
2110 M2Dump := NIL ;
2111 M2DumpFilter := NIL
2112 END M2Options.