File : s-bbcpsp-spe.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . B B . C P U _ S P E C I F I C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2002 Universidad Politecnica de Madrid --
10 -- Copyright (C) 2003-2005 The European Space Agency --
11 -- Copyright (C) 2003-2015, AdaCore --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 3, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. --
19 -- --
20 -- --
21 -- --
22 -- --
23 -- --
24 -- You should have received a copy of the GNU General Public License and --
25 -- a copy of the GCC Runtime Library Exception along with this program; --
26 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
27 -- <http://www.gnu.org/licenses/>. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31
32 -- --
33 ------------------------------------------------------------------------------
34
35 -- This package implements PowerPC architecture specific support for the GNAT
36 -- Ravenscar run time.
37
38 with System.BB.Interrupts;
39 with System.Machine_Code;
40
41 package body System.BB.CPU_Specific is
42
43 type Exception_Handler_Array is array (Vector_Id) of Address;
44
45 procedure GNAT_Error_Handler (Trap : Vector_Id);
46
47 Exception_Handlers : Exception_Handler_Array :=
48 (others => GNAT_Error_Handler'Address);
49 pragma Export (C, Exception_Handlers, "__gnat_powerpc_exception_handlers");
50
51 -------------------------------
52 -- Finish_Initialize_Context --
53 -------------------------------
54
55 procedure Finish_Initialize_Context
56 (Buffer : not null access Context_Buffer)
57 is
58 use System.Machine_Code;
59 use Interfaces;
60
61 Spefpscr : Unsigned_32;
62
63 begin
64 -- Copy the current value of SPEFPSCR
65 Asm ("mfspr %0, 512",
66 Outputs => Unsigned_32'Asm_Output ("=r", Spefpscr),
67 Volatile => True);
68 Buffer.SPEFPSCR := Spefpscr;
69 end Finish_Initialize_Context;
70
71 --------------------
72 -- Initialize_CPU --
73 --------------------
74
75 procedure Initialize_CPU is
76 use System.Machine_Code;
77 use Interfaces;
78
79 Addr : Address;
80 -- Interrupt vector table prefix
81
82 DIE : constant Unsigned_32 := 16#0400_0000#;
83 -- Decrementer interrupt enable
84
85 begin
86 -- Set TCR
87
88 Asm ("mtspr 340, %0",
89 Inputs => Unsigned_32'Asm_Input ("r", DIE),
90 Volatile => True);
91
92 -- Set IVPR
93
94 Asm ("lis %0,handler_0@h",
95 Outputs => Address'Asm_Output ("=r", Addr),
96 Volatile => True);
97 Asm ("mtspr 63, %0",
98 Inputs => Address'Asm_Input ("r", Addr),
99 Volatile => True);
100
101 -- Set IVOR10 (decrementer)
102
103 Asm ("li %0,handler_10@l",
104 Outputs => Address'Asm_Output ("=r", Addr),
105 Volatile => True);
106 Asm ("mtspr 410, %0",
107 Inputs => Address'Asm_Input ("r", Addr),
108 Volatile => True);
109
110 -- Set IVOR4 (External interrupt)
111
112 Asm ("li %0,handler_4@l",
113 Outputs => Address'Asm_Output ("=r", Addr),
114 Volatile => True);
115 Asm ("mtspr 404, %0",
116 Inputs => Address'Asm_Input ("r", Addr),
117 Volatile => True);
118
119 -- Set IVOR33 (spe data interrupt)
120
121 Asm ("li %0,handler_33@l",
122 Outputs => Address'Asm_Output ("=r", Addr),
123 Volatile => True);
124 Asm ("mtspr 529, %0",
125 Inputs => Address'Asm_Input ("r", Addr),
126 Volatile => True);
127
128 end Initialize_CPU;
129
130 ---------------------
131 -- Install_Handler --
132 ---------------------
133
134 procedure Install_Exception_Handler
135 (Service_Routine : System.Address;
136 Vector : Vector_Id)
137 is
138 begin
139 Exception_Handlers (Vector) := Service_Routine;
140 end Install_Exception_Handler;
141
142 ------------------------
143 -- GNAT_Error_Handler --
144 ------------------------
145
146 procedure GNAT_Error_Handler (Trap : Vector_Id) is
147 begin
148 case Trap is
149 when Floatting_Point_Data_Excp =>
150 raise Constraint_Error with "floating point exception";
151 when others =>
152 raise Program_Error with "unhandled trap";
153 end case;
154 end GNAT_Error_Handler;
155
156 ----------------------------
157 -- Install_Error_Handlers --
158 ----------------------------
159
160 procedure Install_Error_Handlers is
161 begin
162 Install_Exception_Handler (GNAT_Error_Handler'Address,
163 Floatting_Point_Data_Excp);
164 end Install_Error_Handlers;
165 end System.BB.CPU_Specific;