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