?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
PR tree-optimization/60902
[official-gcc.git] / gcc / ada / set_targ.adb
blobd6268c82333212c21f0648fc5ee3be7f6c7f11d1
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S E T _ T A R G --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2013-2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Debug; use Debug;
27 with Get_Targ; use Get_Targ;
28 with Opt; use Opt;
29 with Output; use Output;
30
31 with System; use System;
32 with System.OS_Lib; use System.OS_Lib;
33
34 with Unchecked_Conversion;
35
36 package body Set_Targ is
37
38 --------------------------------------------------------
39 -- Data Used to Read/Write Target Dependent Info File --
40 --------------------------------------------------------
41
42 -- Table of string names written to file
43
44 subtype Str is String;
45
46 S_Bits_BE : constant Str := "Bits_BE";
47 S_Bits_Per_Unit : constant Str := "Bits_Per_Unit";
48 S_Bits_Per_Word : constant Str := "Bits_Per_Word";
49 S_Bytes_BE : constant Str := "Bytes_BE";
50 S_Char_Size : constant Str := "Char_Size";
51 S_Double_Float_Alignment : constant Str := "Double_Float_Alignment";
52 S_Double_Scalar_Alignment : constant Str := "Double_Scalar_Alignment";
53 S_Double_Size : constant Str := "Double_Size";
54 S_Float_Size : constant Str := "Float_Size";
55 S_Float_Words_BE : constant Str := "Float_Words_BE";
56 S_Int_Size : constant Str := "Int_Size";
57 S_Long_Double_Size : constant Str := "Long_Double_Size";
58 S_Long_Long_Size : constant Str := "Long_Long_Size";
59 S_Long_Size : constant Str := "Long_Size";
60 S_Maximum_Alignment : constant Str := "Maximum_Alignment";
61 S_Max_Unaligned_Field : constant Str := "Max_Unaligned_Field";
62 S_Pointer_Size : constant Str := "Pointer_Size";
63 S_Short_Enums : constant Str := "Short_Enums";
64 S_Short_Size : constant Str := "Short_Size";
65 S_Strict_Alignment : constant Str := "Strict_Alignment";
66 S_System_Allocator_Alignment : constant Str := "System_Allocator_Alignment";
67 S_Wchar_T_Size : constant Str := "Wchar_T_Size";
68 S_Words_BE : constant Str := "Words_BE";
69
70 -- Table of names
71
72 type AStr is access all String;
73
74 DTN : constant array (Nat range <>) of AStr := (
75 S_Bits_BE 'Unrestricted_Access,
76 S_Bits_Per_Unit 'Unrestricted_Access,
77 S_Bits_Per_Word 'Unrestricted_Access,
78 S_Bytes_BE 'Unrestricted_Access,
79 S_Char_Size 'Unrestricted_Access,
80 S_Double_Float_Alignment 'Unrestricted_Access,
81 S_Double_Scalar_Alignment 'Unrestricted_Access,
82 S_Double_Size 'Unrestricted_Access,
83 S_Float_Size 'Unrestricted_Access,
84 S_Float_Words_BE 'Unrestricted_Access,
85 S_Int_Size 'Unrestricted_Access,
86 S_Long_Double_Size 'Unrestricted_Access,
87 S_Long_Long_Size 'Unrestricted_Access,
88 S_Long_Size 'Unrestricted_Access,
89 S_Maximum_Alignment 'Unrestricted_Access,
90 S_Max_Unaligned_Field 'Unrestricted_Access,
91 S_Pointer_Size 'Unrestricted_Access,
92 S_Short_Enums 'Unrestricted_Access,
93 S_Short_Size 'Unrestricted_Access,
94 S_Strict_Alignment 'Unrestricted_Access,
95 S_System_Allocator_Alignment 'Unrestricted_Access,
96 S_Wchar_T_Size 'Unrestricted_Access,
97 S_Words_BE 'Unrestricted_Access);
98
99 -- Table of corresponding value pointers
100
101 DTV : constant array (Nat range <>) of System.Address := (
102 Bits_BE 'Address,
103 Bits_Per_Unit 'Address,
104 Bits_Per_Word 'Address,
105 Bytes_BE 'Address,
106 Char_Size 'Address,
107 Double_Float_Alignment 'Address,
108 Double_Scalar_Alignment 'Address,
109 Double_Size 'Address,
110 Float_Size 'Address,
111 Float_Words_BE 'Address,
112 Int_Size 'Address,
113 Long_Double_Size 'Address,
114 Long_Long_Size 'Address,
115 Long_Size 'Address,
116 Maximum_Alignment 'Address,
117 Max_Unaligned_Field 'Address,
118 Pointer_Size 'Address,
119 Short_Enums 'Address,
120 Short_Size 'Address,
121 Strict_Alignment 'Address,
122 System_Allocator_Alignment 'Address,
123 Wchar_T_Size 'Address,
124 Words_BE 'Address);
125
126 DTR : array (Nat range DTV'Range) of Boolean := (others => False);
127 -- Table of flags used to validate that all values are present in file
128
129 -----------------------
130 -- Local Subprograms --
131 -----------------------
132
133 procedure Fail (E : String);
134 pragma No_Return (Fail);
135 -- Terminate program with fatal error message passed as parameter
136
137 procedure Register_Float_Type
138 (Name : C_String;
139 Digs : Natural;
140 Complex : Boolean;
141 Count : Natural;
142 Float_Rep : Float_Rep_Kind;
143 Precision : Positive;
144 Size : Positive;
145 Alignment : Natural);
146 pragma Convention (C, Register_Float_Type);
147 -- Call back to allow the back end to register available types. This call
148 -- back makes entries in the FPT_Mode_Table for any floating point types
149 -- reported by the back end. Name is the name of the type as a normal
150 -- format Null-terminated string. Digs is the number of digits, where 0
151 -- means it is not a fpt type (ignored during registration). Complex is
152 -- non-zero if the type has real and imaginary parts (also ignored during
153 -- registration). Count is the number of elements in a vector type (zero =
154 -- not a vector, registration ignores vectors). Float_Rep shows the kind of
155 -- floating-point type, and Precision, Size and Alignment are the precision
156 -- size and alignment in bits.
157 --
158 -- So to summarize, the only types that are actually registered have Digs
159 -- non-zero, Complex zero (false), and Count zero (not a vector).
160
161 ----------
162 -- Fail --
163 ----------
164
165 procedure Fail (E : String) is
166 E_Fatal : constant := 4;
167 -- Code for fatal error
168 begin
169 Write_Str (E);
170 Write_Eol;
171 OS_Exit (E_Fatal);
172 end Fail;
173
174 -------------------------
175 -- Register_Float_Type --
176 -------------------------
177
178 procedure Register_Float_Type
179 (Name : C_String;
180 Digs : Natural;
181 Complex : Boolean;
182 Count : Natural;
183 Float_Rep : Float_Rep_Kind;
184 Precision : Positive;
185 Size : Positive;
186 Alignment : Natural)
187 is
188 T : String (1 .. Name'Length);
189 Last : Natural := 0;
190
191 procedure Dump;
192 -- Dump information given by the back end for the type to register
193
194 ----------
195 -- Dump --
196 ----------
197
198 procedure Dump is
199 begin
200 Write_Str ("type " & T (1 .. Last) & " is ");
201
202 if Count > 0 then
203 Write_Str ("array (1 .. ");
204 Write_Int (Int (Count));
205
206 if Complex then
207 Write_Str (", 1 .. 2");
208 end if;
209
210 Write_Str (") of ");
211
212 elsif Complex then
213 Write_Str ("array (1 .. 2) of ");
214 end if;
215
216 if Digs > 0 then
217 Write_Str ("digits ");
218 Write_Int (Int (Digs));
219 Write_Line (";");
220
221 Write_Str ("pragma Float_Representation (");
222
223 case Float_Rep is
224 when IEEE_Binary =>
225 Write_Str ("IEEE");
226
227 when VAX_Native =>
228 case Digs is
229 when 6 =>
230 Write_Str ("VAXF");
231
232 when 9 =>
233 Write_Str ("VAXD");
234
235 when 15 =>
236 Write_Str ("VAXG");
237
238 when others =>
239 Write_Str ("VAX_");
240 Write_Int (Int (Digs));
241 end case;
242
243 when AAMP => Write_Str ("AAMP");
244 end case;
245
246 Write_Line (", " & T (1 .. Last) & ");");
247
248 else
249 Write_Str ("mod 2**");
250 Write_Int (Int (Precision / Positive'Max (1, Count)));
251 Write_Line (";");
252 end if;
253
254 if Precision = Size then
255 Write_Str ("for " & T (1 .. Last) & "'Size use ");
256 Write_Int (Int (Size));
257 Write_Line (";");
258
259 else
260 Write_Str ("for " & T (1 .. Last) & "'Value_Size use ");
261 Write_Int (Int (Precision));
262 Write_Line (";");
263
264 Write_Str ("for " & T (1 .. Last) & "'Object_Size use ");
265 Write_Int (Int (Size));
266 Write_Line (";");
267 end if;
268
269 Write_Str ("for " & T (1 .. Last) & "'Alignment use ");
270 Write_Int (Int (Alignment / 8));
271 Write_Line (";");
272 Write_Eol;
273 end Dump;
274
275 -- Start of processing for Register_Float_Type
276
277 begin
278 -- Acquire name
279
280 for J in T'Range loop
281 T (J) := Name (Name'First + J - 1);
282
283 if T (J) = ASCII.NUL then
284 Last := J - 1;
285 exit;
286 end if;
287 end loop;
288
289 -- Dump info if debug flag set
290
291 if Debug_Flag_Dot_B then
292 Dump;
293 end if;
294
295 -- Acquire entry if non-vector non-complex fpt type (digits non-zero)
296
297 if Digs > 0 and then not Complex and then Count = 0 then
298 Num_FPT_Modes := Num_FPT_Modes + 1;
299 FPT_Mode_Table (Num_FPT_Modes) :=
300 (NAME => new String'(T (1 .. Last)),
301 DIGS => Digs,
302 FLOAT_REP => Float_Rep,
303 PRECISION => Precision,
304 SIZE => Size,
305 ALIGNMENT => Alignment);
306 end if;
307 end Register_Float_Type;
308
309 -----------------------------------
310 -- Write_Target_Dependent_Values --
311 -----------------------------------
312
313 -- We do this at the System.Os_Lib level, since we have to do the read at
314 -- that level anyway, so it is easier and more consistent to follow the
315 -- same path for the write.
316
317 procedure Write_Target_Dependent_Values is
318 Fdesc : File_Descriptor;
319 OK : Boolean;
320
321 Buffer : String (1 .. 80);
322 Buflen : Natural;
323 -- Buffer used to build line one of file
324
325 type ANat is access all Natural;
326 -- Pointer to Nat or Pos value (it is harmless to treat Pos values and
327 -- Nat values as Natural via Unchecked_Conversion).
328
329 function To_ANat is new Unchecked_Conversion (Address, ANat);
330
331 procedure AddC (C : Character);
332 -- Add one character to buffer
333
334 procedure AddN (N : Natural);
335 -- Add representation of integer N to Buffer, updating Buflen. N
336 -- must be less than 1000, and output is 3 characters with leading
337 -- spaces as needed.
338
339 procedure Write_Line;
340 -- Output contents of Buffer (1 .. Buflen) followed by a New_Line,
341 -- and set Buflen back to zero, ready to write next line.
342
343 ----------
344 -- AddC --
345 ----------
346
347 procedure AddC (C : Character) is
348 begin
349 Buflen := Buflen + 1;
350 Buffer (Buflen) := C;
351 end AddC;
352
353 ----------
354 -- AddN --
355 ----------
356
357 procedure AddN (N : Natural) is
358 begin
359 if N > 999 then
360 raise Program_Error;
361 end if;
362
363 if N > 99 then
364 AddC (Character'Val (48 + N / 100));
365 else
366 AddC (' ');
367 end if;
368
369 if N > 9 then
370 AddC (Character'Val (48 + N / 10 mod 10));
371 else
372 AddC (' ');
373 end if;
374
375 AddC (Character'Val (48 + N mod 10));
376 end AddN;
377
378 ----------------
379 -- Write_Line --
380 ----------------
381
382 procedure Write_Line is
383 begin
384 AddC (ASCII.LF);
385
386 if Buflen /= Write (Fdesc, Buffer'Address, Buflen) then
387 Delete_File (Target_Dependent_Info_Write_Name'Address, OK);
388 Fail ("disk full writing file "
389 & Target_Dependent_Info_Write_Name.all);
390 end if;
391
392 Buflen := 0;
393 end Write_Line;
394
395 -- Start of processing for Write_Target_Dependent_Values
396
397 begin
398 Fdesc :=
399 Create_File (Target_Dependent_Info_Write_Name.all'Address, Text);
400
401 if Fdesc = Invalid_FD then
402 Fail ("cannot create file " & Target_Dependent_Info_Write_Name.all);
403 end if;
404
405 -- Loop through values
406
407 for J in DTN'Range loop
408
409 -- Output name
410
411 Buflen := DTN (J)'Length;
412 Buffer (1 .. Buflen) := DTN (J).all;
413
414 -- Line up values
415
416 while Buflen < 26 loop
417 AddC (' ');
418 end loop;
419
420 AddC (' ');
421 AddC (' ');
422
423 -- Output value and write line
424
425 AddN (To_ANat (DTV (J)).all);
426 Write_Line;
427 end loop;
428
429 -- Blank line to separate sections
430
431 Write_Line;
432
433 -- Write lines for registered FPT types
434
435 for J in 1 .. Num_FPT_Modes loop
436 declare
437 E : FPT_Mode_Entry renames FPT_Mode_Table (J);
438 begin
439 Buflen := E.NAME'Last;
440 Buffer (1 .. Buflen) := E.NAME.all;
441
442 -- Pad out to line up values
443
444 while Buflen < 11 loop
445 AddC (' ');
446 end loop;
447
448 AddC (' ');
449 AddC (' ');
450
451 AddN (E.DIGS);
452 AddC (' ');
453 AddC (' ');
454
455 case E.FLOAT_REP is
456 when IEEE_Binary =>
457 AddC ('I');
458 when VAX_Native =>
459 AddC ('V');
460 when AAMP =>
461 AddC ('A');
462 end case;
463
464 AddC (' ');
465
466 AddN (E.PRECISION);
467 AddC (' ');
468
469 AddN (E.ALIGNMENT);
470 Write_Line;
471 end;
472 end loop;
473
474 -- Close file
475
476 Close (Fdesc, OK);
477
478 if not OK then
479 Fail ("disk full writing file "
480 & Target_Dependent_Info_Write_Name.all);
481 end if;
482 end Write_Target_Dependent_Values;
483
484 -- Package Initialization, set target dependent values. This must be done
485 -- early on, before we start accessing various compiler packages, since
486 -- these values are used all over the place.
487
488 begin
489 -- First step: see if the -gnateT switch is present. As we have noted,
490 -- this has to be done very early, so can not depend on the normal circuit
491 -- for reading switches and setting switches in Opt. The following code
492 -- will set Opt.Target_Dependent_Info_Read_Name if the switch -gnateT=name
493 -- is present in the options string.
494
495 declare
496 type Arg_Array is array (Nat) of Big_String_Ptr;
497 type Arg_Array_Ptr is access Arg_Array;
498 -- Types to access compiler arguments
499
500 save_argc : Nat;
501 pragma Import (C, save_argc);
502 -- Saved value of argc (number of arguments), imported from misc.c
503
504 save_argv : Arg_Array_Ptr;
505 pragma Import (C, save_argv);
506 -- Saved value of argv (argument pointers), imported from misc.c
507
508 gnat_argc : Nat;
509 gnat_argv : Arg_Array_Ptr;
510 pragma Import (C, gnat_argc);
511 pragma Import (C, gnat_argv);
512 -- If save_argv is not set, default to gnat_argc/argv
513
514 argc : Nat;
515 argv : Arg_Array_Ptr;
516
517 function Len_Arg (Arg : Big_String_Ptr) return Nat;
518 -- Determine length of argument Arg (a nul terminated C string).
519
520 -------------
521 -- Len_Arg --
522 -------------
523
524 function Len_Arg (Arg : Big_String_Ptr) return Nat is
525 begin
526 for J in 1 .. Nat'Last loop
527 if Arg (Natural (J)) = ASCII.NUL then
528 return J - 1;
529 end if;
530 end loop;
531
532 raise Program_Error;
533 end Len_Arg;
534
535 begin
536 if save_argv /= null then
537 argv := save_argv;
538 argc := save_argc;
539 else
540 -- Case of a non gcc compiler, e.g. gnat2why or gnat2scil
541 argv := gnat_argv;
542 argc := gnat_argc;
543 end if;
544
545 -- Loop through arguments looking for -gnateT, also look for -gnatd.b
546
547 for Arg in 1 .. argc - 1 loop
548 declare
549 Argv_Ptr : constant Big_String_Ptr := argv (Arg);
550 Argv_Len : constant Nat := Len_Arg (Argv_Ptr);
551
552 begin
553 if Argv_Len > 8
554 and then Argv_Ptr (1 .. 8) = "-gnateT="
555 then
556 Opt.Target_Dependent_Info_Read_Name :=
557 new String'(Argv_Ptr (9 .. Natural (Argv_Len)));
558
559 elsif Argv_Len >= 8
560 and then Argv_Ptr (1 .. 8) = "-gnatd.b"
561 then
562 Debug_Flag_Dot_B := True;
563 end if;
564 end;
565 end loop;
566 end;
567
568 -- If the switch is not set, we get all values from the back end
569
570 if Opt.Target_Dependent_Info_Read_Name = null then
571
572 -- Set values by direct calls to the back end
573
574 Bits_BE := Get_Bits_BE;
575 Bits_Per_Unit := Get_Bits_Per_Unit;
576 Bits_Per_Word := Get_Bits_Per_Word;
577 Bytes_BE := Get_Bytes_BE;
578 Char_Size := Get_Char_Size;
579 Double_Float_Alignment := Get_Double_Float_Alignment;
580 Double_Scalar_Alignment := Get_Double_Scalar_Alignment;
581 Double_Size := Get_Double_Size;
582 Float_Size := Get_Float_Size;
583 Float_Words_BE := Get_Float_Words_BE;
584 Int_Size := Get_Int_Size;
585 Long_Double_Size := Get_Long_Double_Size;
586 Long_Long_Size := Get_Long_Long_Size;
587 Long_Size := Get_Long_Size;
588 Maximum_Alignment := Get_Maximum_Alignment;
589 Max_Unaligned_Field := Get_Max_Unaligned_Field;
590 Pointer_Size := Get_Pointer_Size;
591 Short_Enums := Get_Short_Enums;
592 Short_Size := Get_Short_Size;
593 Strict_Alignment := Get_Strict_Alignment;
594 System_Allocator_Alignment := Get_System_Allocator_Alignment;
595 Wchar_T_Size := Get_Wchar_T_Size;
596 Words_BE := Get_Words_BE;
597
598 -- Register floating-point types from the back end
599
600 Register_Back_End_Types (Register_Float_Type'Access);
601
602 -- Case of reading the target dependent values from file
603
604 -- This is bit more complex than might be expected, because it has to be
605 -- done very early. All kinds of packages depend on these values, and we
606 -- can't wait till the normal processing of reading command line switches
607 -- etc to read the file. We do this at the System.OS_Lib level since it is
608 -- too early to be using Osint directly.
609
610 else
611 Read_Target_Dependent_Values : declare
612 File_Desc : File_Descriptor;
613 N : Natural;
614
615 type ANat is access all Natural;
616 -- Pointer to Nat or Pos value (it is harmless to treat Pos values
617 -- as Nat via Unchecked_Conversion).
618
619 function To_ANat is new Unchecked_Conversion (Address, ANat);
620
621 VP : ANat;
622
623 Buffer : String (1 .. 2000);
624 Buflen : Natural;
625 -- File information and length (2000 easily enough)
626
627 Nam_Buf : String (1 .. 40);
628 Nam_Len : Natural;
629
630 procedure Check_Spaces;
631 -- Checks that we have one or more spaces and skips them
632
633 procedure FailN (S : String);
634 -- Calls Fail adding " name in file xxx", where name is the currently
635 -- gathered name in Nam_Buf, surrounded by quotes, and xxx is the
636 -- name of the file.
637
638 procedure Get_Name;
639 -- Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
640 -- Skip_Spaces to skip any following spaces. Note that the name is
641 -- terminated by a sequence of at least two spaces.
642
643 function Get_Nat return Natural;
644 -- N on entry points to decimal integer, scan out decimal integer
645 -- and return it, leaving N pointing to following space or LF.
646
647 procedure Skip_Spaces;
648 -- Skip past spaces
649
650 ------------------
651 -- Check_Spaces --
652 ------------------
653
654 procedure Check_Spaces is
655 begin
656 if N > Buflen or else Buffer (N) /= ' ' then
657 FailN ("missing space for");
658 end if;
659
660 Skip_Spaces;
661 return;
662 end Check_Spaces;
663
664 -----------
665 -- FailN --
666 -----------
667
668 procedure FailN (S : String) is
669 begin
670 Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file "
671 & Target_Dependent_Info_Read_Name.all);
672 end FailN;
673
674 --------------
675 -- Get_Name --
676 --------------
677
678 procedure Get_Name is
679 begin
680 Nam_Len := 0;
681
682 -- Scan out name and put it in Nam_Buf
683
684 loop
685 if N > Buflen or else Buffer (N) = ASCII.LF then
686 FailN ("incorrectly formatted line for");
687 end if;
688
689 -- Name is terminated by two blanks
690
691 exit when N < Buflen and then Buffer (N .. N + 1) = " ";
692
693 Nam_Len := Nam_Len + 1;
694
695 if Nam_Len > Nam_Buf'Last then
696 Fail ("name too long");
697 end if;
698
699 Nam_Buf (Nam_Len) := Buffer (N);
700 N := N + 1;
701 end loop;
702
703 Check_Spaces;
704 end Get_Name;
705
706 -------------
707 -- Get_Nat --
708 -------------
709
710 function Get_Nat return Natural is
711 Result : Natural := 0;
712
713 begin
714 loop
715 if N > Buflen
716 or else Buffer (N) not in '0' .. '9'
717 or else Result > 999
718 then
719 FailN ("bad value for");
720 end if;
721
722 Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
723 N := N + 1;
724
725 exit when N <= Buflen
726 and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
727 end loop;
728
729 return Result;
730 end Get_Nat;
731
732 -----------------
733 -- Skip_Spaces --
734 -----------------
735
736 procedure Skip_Spaces is
737 begin
738 while N <= Buflen and Buffer (N) = ' ' loop
739 N := N + 1;
740 end loop;
741 end Skip_Spaces;
742
743 -- Start of processing for Read_Target_Dependent_Values
744
745 begin
746 File_Desc := Open_Read (Target_Dependent_Info_Read_Name.all, Text);
747
748 if File_Desc = Invalid_FD then
749 Fail ("cannot read file " & Target_Dependent_Info_Read_Name.all);
750 end if;
751
752 Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
753
754 if Buflen = Buffer'Length then
755 Fail ("file is too long: " & Target_Dependent_Info_Read_Name.all);
756 end if;
757
758 -- Scan through file for properly formatted entries in first section
759
760 N := 1;
761 while N <= Buflen and then Buffer (N) /= ASCII.LF loop
762 Get_Name;
763
764 -- Validate name and get corresponding value pointer
765
766 VP := null;
767
768 for J in DTN'Range loop
769 if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
770 VP := To_ANat (DTV (J));
771 DTR (J) := True;
772 exit;
773 end if;
774 end loop;
775
776 if VP = null then
777 FailN ("unrecognized name");
778 end if;
779
780 -- Scan out value
781
782 VP.all := Get_Nat;
783
784 if N > Buflen or else Buffer (N) /= ASCII.LF then
785 FailN ("misformatted line for");
786 end if;
787
788 N := N + 1; -- skip LF
789 end loop;
790
791 -- Fall through this loop when all lines in first section read.
792 -- Check that values have been supplied for all entries.
793
794 for J in DTR'Range loop
795 if not DTR (J) then
796 Fail ("missing entry for " & DTN (J).all & " in file "
797 & Target_Dependent_Info_Read_Name.all);
798 end if;
799 end loop;
800
801 -- Now acquire FPT entries
802
803 if N >= Buflen then
804 Fail ("missing entries for FPT modes in file "
805 & Target_Dependent_Info_Read_Name.all);
806 end if;
807
808 if Buffer (N) = ASCII.LF then
809 N := N + 1;
810 else
811 Fail ("missing blank line in file "
812 & Target_Dependent_Info_Read_Name.all);
813 end if;
814
815 Num_FPT_Modes := 0;
816 while N <= Buflen loop
817 Get_Name;
818
819 Num_FPT_Modes := Num_FPT_Modes + 1;
820
821 declare
822 E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);
823
824 begin
825 E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
826
827 E.DIGS := Get_Nat;
828 Check_Spaces;
829
830 case Buffer (N) is
831 when 'I' =>
832 E.FLOAT_REP := IEEE_Binary;
833 when 'V' =>
834 E.FLOAT_REP := VAX_Native;
835 when 'A' =>
836 E.FLOAT_REP := AAMP;
837 when others =>
838 FailN ("bad float rep field for");
839 end case;
840
841 N := N + 1;
842 Check_Spaces;
843
844 E.PRECISION := Get_Nat;
845 Check_Spaces;
846
847 E.ALIGNMENT := Get_Nat;
848
849 if Buffer (N) /= ASCII.LF then
850 FailN ("junk at end of line for");
851 end if;
852
853 -- ??? We do not read E.SIZE, see Write_Target_Dependent_Values
854
855 E.SIZE :=
856 (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT;
857
858 N := N + 1;
859 end;
860 end loop;
861 end Read_Target_Dependent_Values;
862 end if;
863 end Set_Targ;
Mirror of the offical gcc git repository hosted at gcc.gnu.org