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