OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [loop_optimization9.adb] - Blame information for rev 696

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 696 jeremybenn
-- { dg-do compile }
2
-- { dg-options "-gnatws -O3" }
3
-- { dg-options "-gnatws -O3 -msse" { target i?86-*-* x86_64-*-* } }
4
 
5
with System.Soft_Links;
6
 
7
package body Loop_Optimization9 is
8
 
9
   package SSL renames System.Soft_Links;
10
 
11
   First_Temp_File_Name : constant String := "GNAT-TEMP-000000.TMP";
12
 
13
   Current_Temp_File_Name : String := First_Temp_File_Name;
14
 
15
   Temp_File_Name_Last_Digit : constant Positive :=
16
                                 First_Temp_File_Name'Last - 4;
17
 
18
   function Argument_String_To_List
19
     (Arg_String : String) return Argument_List_Access
20
   is
21
      Max_Args : constant Integer := Arg_String'Length;
22
      New_Argv : Argument_List (1 .. Max_Args);
23
      New_Argc : Natural := 0;
24
      Idx      : Integer;
25
 
26
   begin
27
      Idx := Arg_String'First;
28
 
29
      loop
30
         exit when Idx > Arg_String'Last;
31
 
32
         declare
33
            Quoted  : Boolean := False;
34
            Backqd  : Boolean := False;
35
            Old_Idx : Integer;
36
 
37
         begin
38
            Old_Idx := Idx;
39
 
40
            loop
41
               --  An unquoted space is the end of an argument
42
 
43
               if not (Backqd or Quoted)
44
                 and then Arg_String (Idx) = ' '
45
               then
46
                  exit;
47
 
48
               --  Start of a quoted string
49
 
50
               elsif not (Backqd or Quoted)
51
                 and then Arg_String (Idx) = '"'
52
               then
53
                  Quoted := True;
54
 
55
               --  End of a quoted string and end of an argument
56
 
57
               elsif (Quoted and not Backqd)
58
                 and then Arg_String (Idx) = '"'
59
               then
60
                  Idx := Idx + 1;
61
                  exit;
62
 
63
               --  Following character is backquoted
64
 
65
               elsif Arg_String (Idx) = '\' then
66
                  Backqd := True;
67
 
68
               --  Turn off backquoting after advancing one character
69
 
70
               elsif Backqd then
71
                  Backqd := False;
72
 
73
               end if;
74
 
75
               Idx := Idx + 1;
76
               exit when Idx > Arg_String'Last;
77
            end loop;
78
 
79
            --  Found an argument
80
 
81
            New_Argc := New_Argc + 1;
82
            New_Argv (New_Argc) :=
83
              new String'(Arg_String (Old_Idx .. Idx - 1));
84
         end;
85
      end loop;
86
 
87
      return new Argument_List'(New_Argv (1 .. New_Argc));
88
   end Argument_String_To_List;
89
 
90
   procedure Create_Temp_File_Internal
91
     (FD        : out File_Descriptor;
92
      Name      : out String_Access)
93
   is
94
      Pos      : Positive;
95
   begin
96
      File_Loop : loop
97
         Locked : begin
98
            Pos := Temp_File_Name_Last_Digit;
99
 
100
            Digit_Loop :
101
            loop
102
               case Current_Temp_File_Name (Pos) is
103
                  when '0' .. '8' =>
104
                     Current_Temp_File_Name (Pos) :=
105
                       Character'Succ (Current_Temp_File_Name (Pos));
106
                     exit Digit_Loop;
107
 
108
                  when '9' =>
109
                     Current_Temp_File_Name (Pos) := '0';
110
                     Pos := Pos - 1;
111
 
112
                  when others =>
113
 
114
                     SSL.Unlock_Task.all;
115
                     FD := 0;
116
                     Name := null;
117
                     exit File_Loop;
118
               end case;
119
            end loop Digit_Loop;
120
         end Locked;
121
      end loop File_Loop;
122
   end Create_Temp_File_Internal;
123
 
124
end Loop_Optimization9;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.