1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                     SYSTEM.MACHINE_STATE_OPERATIONS                      --
6--                                                                          --
7--                                 B o d y                                  --
8--                            (Version for x86)                             --
9--                                                                          --
10--           Copyright (C) 1999-2002 Ada Core Technologies, Inc.            --
11--                                                                          --
12-- GNAT is free software;  you can  redistribute it  and/or modify it under --
13-- terms of the  GNU General Public License as published  by the Free Soft- --
14-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
15-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
16-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
17-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
18-- for  more details.  You should have  received  a copy of the GNU General --
19-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
20-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
21-- MA 02111-1307, USA.                                                      --
22--                                                                          --
23-- As a special exception,  if other files  instantiate  generics from this --
24-- unit, or you link  this unit with other files  to produce an executable, --
25-- this  unit  does not  by itself cause  the resulting  executable  to  be --
26-- covered  by the  GNU  General  Public  License.  This exception does not --
27-- however invalidate  any other reasons why  the executable file  might be --
28-- covered by the  GNU Public License.                                      --
29--                                                                          --
30-- GNAT was originally developed  by the GNAT team at  New York University. --
31-- Extensive contributions were provided by Ada Core Technologies Inc.      --
32--                                                                          --
33------------------------------------------------------------------------------
34
35--  Note: it is very important that this unit not generate any exception
36--  tables of any kind. Otherwise we get a nasty rtsfind recursion problem.
37--  This means no subprograms, including implicitly generated ones.
38
39with Unchecked_Conversion;
40with System.Storage_Elements;
41with System.Machine_Code; use System.Machine_Code;
42with System.Memory;
43
44package body System.Machine_State_Operations is
45
46   use System.Exceptions;
47
48   type Uns8  is mod 2 ** 8;
49   type Uns32 is mod 2 ** 32;
50
51   type Bits5 is mod 2 ** 5;
52   type Bits6 is mod 2 ** 6;
53
54   function To_Address is new Unchecked_Conversion (Uns32, Address);
55
56   type Uns32_Ptr is access all Uns32;
57   function To_Uns32_Ptr is new Unchecked_Conversion (Uns32,   Uns32_Ptr);
58
59   --  Note: the type Uns32 has an alignment of 4. However, in some cases
60   --  values of type Uns32_Ptr will not be aligned (notably in the case
61   --  where we get the immediate field from an instruction). However this
62   --  does not matter in practice, since the x86 does not require that
63   --  operands be aligned.
64
65   ----------------------
66   -- General Approach --
67   ----------------------
68
69   --  For the x86 version of this unit, the Subprogram_Info_Type values
70   --  are simply the starting code address for the subprogram. Popping
71   --  of stack frames works by analyzing the code in the prolog, and
72   --  deriving from this analysis the necessary information for restoring
73   --  the registers, including the return point.
74
75   ---------------------------
76   -- Description of Prolog --
77   ---------------------------
78
79   --  If a frame pointer is present, the prolog looks like
80
81   --     pushl %ebp
82   --     movl  %esp,%ebp
83   --     subl  $nnn,%esp     omitted if nnn = 0
84   --     pushl %edi          omitted if edi not used
85   --     pushl %esi          omitted if esi not used
86   --     pushl %ebx          omitted if ebx not used
87
88   --  If a frame pointer is not present, the prolog looks like
89
90   --     subl  $nnn,%esp     omitted if nnn = 0
91   --     pushl %ebp          omitted if ebp not used
92   --     pushl %edi          omitted if edi not used
93   --     pushl %esi          omitted if esi not used
94   --     pushl %ebx          omitted if ebx not used
95
96   --  Note: any or all of the save over call registers may be used and
97   --  if so, will be saved using pushl as shown above. The order of the
98   --  pushl instructions will be as shown above for gcc generated code,
99   --  but the code in this unit does not assume this.
100
101   -------------------------
102   -- Description of Call --
103   -------------------------
104
105   --  A call looks like:
106
107   --     pushl ...           push parameters
108   --     pushl ...
109   --     call  ...           perform the call
110   --     addl  $nnn,%esp     omitted if no parameters
111
112   --  Note that we are not absolutely guaranteed that the call is always
113   --  followed by an addl operation that readjusts %esp for this particular
114   --  call. There are two reasons for this:
115
116   --    1) The addl can be delayed and combined in the case where more than
117   --       one call appears in sequence. This can be suppressed by using the
118   --       switch -fno-defer-pop and for Ada code, we automatically use
119   --       this switch, but we could still be dealing with C code that was
120   --       compiled without using this switch.
121
122   --    2) Scheduling may result in moving the addl instruction away from
123   --       the call. It is not clear if this actually can happen at the
124   --       current time, but it is certainly conceptually possible.
125
126   --  The addl after the call is important, since we need to be able to
127   --  restore the proper %esp value when we pop the stack. However, we do
128   --  not try to compensate for either of the above effects. As noted above,
129   --  case 1 does not occur for Ada code, and it does not appear in practice
130   --  that case 2 occurs with any significant frequency (we have never seen
131   --  an example so far for gcc generated code).
132
133   --  Furthermore, it is only in the case of -fomit-frame-pointer that we
134   --  really get into trouble from not properly restoring %esp. If we have
135   --  a frame pointer, then the worst that happens is that %esp is slightly
136   --  more depressed than it should be. This could waste a bit of space on
137   --  the stack, and even in some cases cause a storage leak on the stack,
138   --  but it will not affect the functional correctness of the processing.
139
140   ----------------------------------------
141   -- Definitions of Instruction Formats --
142   ----------------------------------------
143
144   type Rcode is (eax, ecx, edx, ebx, esp, ebp, esi, edi);
145   pragma Warnings (Off, Rcode);
146   --  Code indicating which register is referenced in an instruction
147
148   --  The following define the format of a pushl instruction
149
150   Op_pushl : constant Bits5 := 2#01010#;
151
152   type Ins_pushl is record
153      Op  : Bits5 := Op_pushl;
154      Reg : Rcode;
155   end record;
156
157   for Ins_pushl use record
158      Op  at 0 range 3 .. 7;
159      Reg at 0 range 0 .. 2;
160   end record;
161
162   Ins_pushl_ebp : constant Ins_pushl := (Op_pushl, Reg => ebp);
163
164   type Ins_pushl_Ptr is access all Ins_pushl;
165
166   --  For the movl %esp,%ebp instruction, we only need to know the length
167   --  because we simply skip past it when we analyze the prolog.
168
169   Ins_movl_length : constant := 2;
170
171   --  The following define the format of addl/subl esp instructions
172
173   Op_Immed : constant Bits6 := 2#100000#;
174
175   Op2_addl_Immed : constant Bits5 := 2#11100#;
176   pragma Unreferenced (Op2_addl_Immed);
177
178   Op2_subl_Immed : constant Bits5 := 2#11101#;
179
180   type Word_Byte is (Word, Byte);
181   pragma Unreferenced (Byte);
182
183   type Ins_addl_subl_byte is record
184      Op   : Bits6;           -- Set to Op_Immed
185      w    : Word_Byte;       -- Word/Byte flag (set to 1 = byte)
186      s    : Boolean;         -- Sign extension bit (1 = extend)
187      Op2  : Bits5;           -- Secondary opcode
188      Reg  : Rcode;           -- Register
189      Imm8 : Uns8;            -- Immediate operand
190   end record;
191
192   for Ins_addl_subl_byte use record
193      Op   at 0 range 2 .. 7;
194      w    at 0 range 1 .. 1;
195      s    at 0 range 0 .. 0;
196      Op2  at 1 range 3 .. 7;
197      Reg  at 1 range 0 .. 2;
198      Imm8 at 2 range 0 .. 7;
199   end record;
200
201   type Ins_addl_subl_word is record
202      Op    : Bits6;          -- Set to Op_Immed
203      w     : Word_Byte;      -- Word/Byte flag (set to 0 = word)
204      s     : Boolean;        -- Sign extension bit (1 = extend)
205      Op2   : Bits5;          -- Secondary opcode
206      Reg   : Rcode;          -- Register
207      Imm32 : Uns32;          -- Immediate operand
208   end record;
209
210   for Ins_addl_subl_word use record
211      Op    at 0 range 2 .. 7;
212      w     at 0 range 1 .. 1;
213      s     at 0 range 0 .. 0;
214      Op2   at 1 range 3 .. 7;
215      Reg   at 1 range 0 .. 2;
216      Imm32 at 2 range 0 .. 31;
217   end record;
218
219   type Ins_addl_subl_byte_Ptr is access all Ins_addl_subl_byte;
220   type Ins_addl_subl_word_Ptr is access all Ins_addl_subl_word;
221
222   ---------------------
223   -- Prolog Analysis --
224   ---------------------
225
226   --  The analysis of the prolog answers the following questions:
227
228   --    1. Is %ebp used as a frame pointer?
229   --    2. How far is SP depressed (i.e. what is the stack frame size)
230   --    3. Which registers are saved in the prolog, and in what order
231
232   --  The following data structure stores the answers to these questions
233
234   subtype SOC is Rcode range ebx .. edi;
235   --  Possible save over call registers
236
237   SOC_Max : constant := 4;
238   --  Max number of SOC registers that can be pushed
239
240   type SOC_Push_Regs_Type is array (1 .. 4) of Rcode;
241   --  Used to hold the register codes of pushed SOC registers
242
243   type Prolog_Type is record
244
245      Frame_Reg : Boolean;
246      --  This is set to True if %ebp is used as a frame register, and
247      --  False otherwise (in the False case, %ebp may be saved in the
248      --  usual manner along with the other SOC registers).
249
250      Frame_Length : Uns32;
251      --  Amount by which ESP is decremented on entry, includes the effects
252      --  of push's of save over call registers as indicated above, e.g. if
253      --  the prolog of a routine is:
254      --
255      --    pushl %ebp
256      --    movl %esp,%ebp
257      --    subl $424,%esp
258      --    pushl %edi
259      --    pushl %esi
260      --    pushl %ebx
261      --
262      --  Then the value of Frame_Length would be 436 (424 + 3 * 4). A
263      --  precise definition is that it is:
264      --
265      --    %esp on entry   minus   %esp after last SOC push
266      --
267      --  That definition applies both in the frame pointer present and
268      --  the frame pointer absent cases.
269
270      Num_SOC_Push : Integer range 0 .. SOC_Max;
271      --  Number of save over call registers actually saved by pushl
272      --  instructions (other than the initial pushl to save the frame
273      --  pointer if a frame pointer is in use).
274
275      SOC_Push_Regs : SOC_Push_Regs_Type;
276      --  The First Num_SOC_Push entries of this array are used to contain
277      --  the codes for the SOC registers, in the order in which they were
278      --  pushed. Note that this array excludes %ebp if it is used as a frame
279      --  register, since although %ebp is still considered an SOC register
280      --  in this case, it is saved and restored by a separate mechanism.
281      --  Also we will never see %esp represented in this list. Again, it is
282      --  true that %esp is saved over call, but it is restored by a separate
283      --  mechanism.
284
285   end record;
286
287   procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type);
288   --  Given the address of the start of the prolog for a procedure,
289   --  analyze the instructions of the prolog, and set Prolog to contain
290   --  the information obtained from this analysis.
291
292   ----------------------------------
293   -- Machine_State_Representation --
294   ----------------------------------
295
296   --  The type Machine_State is defined in the body of Ada.Exceptions as
297   --  a Storage_Array of length 1 .. Machine_State_Length. But really it
298   --  has structure as defined here. We use the structureless declaration
299   --  in Ada.Exceptions to avoid this unit from being implementation
300   --  dependent. The actual definition of Machine_State is as follows:
301
302   type SOC_Regs_Type is array (SOC) of Uns32;
303
304   type MState is record
305      eip : Uns32;
306      --  The instruction pointer location (which is the return point
307      --  value from the next level down in all cases).
308
309      Regs : SOC_Regs_Type;
310      --  Values of the save over call registers
311   end record;
312
313   for MState use record
314      eip  at 0 range 0 .. 31;
315      Regs at 4 range 0 .. 5 * 32 - 1;
316   end record;
317   --  Note: the routines Enter_Handler, and Set_Machine_State reference
318   --  the fields in this structure non-symbolically.
319
320   type MState_Ptr is access all MState;
321
322   function To_MState_Ptr is
323     new Unchecked_Conversion (Machine_State, MState_Ptr);
324
325   ----------------------------
326   -- Allocate_Machine_State --
327   ----------------------------
328
329   function Allocate_Machine_State return Machine_State is
330      use System.Storage_Elements;
331
332   begin
333      return Machine_State
334        (Memory.Alloc (MState'Max_Size_In_Storage_Elements));
335   end Allocate_Machine_State;
336
337   --------------------
338   -- Analyze_Prolog --
339   --------------------
340
341   procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type) is
342      Ptr : Address;
343      Ppl : Ins_pushl_Ptr;
344      Pas : Ins_addl_subl_byte_Ptr;
345
346      function To_Ins_pushl_Ptr is
347        new Unchecked_Conversion (Address, Ins_pushl_Ptr);
348
349      function To_Ins_addl_subl_byte_Ptr is
350        new Unchecked_Conversion (Address, Ins_addl_subl_byte_Ptr);
351
352      function To_Ins_addl_subl_word_Ptr is
353        new Unchecked_Conversion (Address, Ins_addl_subl_word_Ptr);
354
355   begin
356      Ptr := A;
357      Prolog.Frame_Length := 0;
358
359      if Ptr = Null_Address then
360         Prolog.Num_SOC_Push := 0;
361         Prolog.Frame_Reg := True;
362         return;
363      end if;
364
365      if To_Ins_pushl_Ptr (Ptr).all = Ins_pushl_ebp then
366         Ptr := Ptr + 1 + Ins_movl_length;
367         Prolog.Frame_Reg := True;
368      else
369         Prolog.Frame_Reg := False;
370      end if;
371
372      Pas := To_Ins_addl_subl_byte_Ptr (Ptr);
373
374      if Pas.Op = Op_Immed
375        and then Pas.Op2 = Op2_subl_Immed
376        and then Pas.Reg = esp
377      then
378         if Pas.w = Word then
379            Prolog.Frame_Length := Prolog.Frame_Length +
380                                     To_Ins_addl_subl_word_Ptr (Ptr).Imm32;
381            Ptr := Ptr + 6;
382
383         else
384            Prolog.Frame_Length := Prolog.Frame_Length + Uns32 (Pas.Imm8);
385            Ptr := Ptr + 3;
386
387            --  Note: we ignore sign extension, since a sign extended
388            --  value that was negative would imply a ludicrous frame size.
389         end if;
390      end if;
391
392      --  Now scan push instructions for SOC registers
393
394      Prolog.Num_SOC_Push := 0;
395
396      loop
397         Ppl := To_Ins_pushl_Ptr (Ptr);
398
399         if Ppl.Op = Op_pushl and then Ppl.Reg in SOC then
400            Prolog.Num_SOC_Push := Prolog.Num_SOC_Push + 1;
401            Prolog.SOC_Push_Regs (Prolog.Num_SOC_Push) := Ppl.Reg;
402            Prolog.Frame_Length := Prolog.Frame_Length + 4;
403            Ptr := Ptr + 1;
404
405         else
406            exit;
407         end if;
408      end loop;
409
410   end Analyze_Prolog;
411
412   -------------------
413   -- Enter_Handler --
414   -------------------
415
416   procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
417   begin
418      Asm ("mov %0,%%edx", Inputs => Machine_State'Asm_Input ("r", M));
419      Asm ("mov %0,%%eax", Inputs => Handler_Loc'Asm_Input ("r", Handler));
420
421      Asm ("mov 4(%%edx),%%ebx");    -- M.Regs (ebx)
422      Asm ("mov 12(%%edx),%%ebp");   -- M.Regs (ebp)
423      Asm ("mov 16(%%edx),%%esi");   -- M.Regs (esi)
424      Asm ("mov 20(%%edx),%%edi");   -- M.Regs (edi)
425      Asm ("mov 8(%%edx),%%esp");    -- M.Regs (esp)
426      Asm ("jmp %*%%eax");
427   end Enter_Handler;
428
429   ----------------
430   -- Fetch_Code --
431   ----------------
432
433   function Fetch_Code (Loc : Code_Loc) return Code_Loc is
434   begin
435      return Loc;
436   end Fetch_Code;
437
438   ------------------------
439   -- Free_Machine_State --
440   ------------------------
441
442   procedure Free_Machine_State (M : in out Machine_State) is
443   begin
444      Memory.Free (Address (M));
445      M := Machine_State (Null_Address);
446   end Free_Machine_State;
447
448   ------------------
449   -- Get_Code_Loc --
450   ------------------
451
452   function Get_Code_Loc (M : Machine_State) return Code_Loc is
453
454      Asm_Call_Size : constant := 2;
455      --  Minimum size for a call instruction under ix86. Using the minimum
456      --  size is safe here as the call point computed from the return point
457      --  will always be inside the call instruction.
458
459      MS : constant MState_Ptr := To_MState_Ptr (M);
460
461   begin
462      if MS.eip = 0 then
463         return To_Address (MS.eip);
464      else
465         --  When doing a call the return address is pushed to the stack.
466         --  We want to return the call point address, so we substract
467         --  Asm_Call_Size from the return address. This value is set
468         --  to 5 as an asm call takes 5 bytes on x86 architectures.
469
470         return To_Address (MS.eip - Asm_Call_Size);
471      end if;
472   end Get_Code_Loc;
473
474   --------------------------
475   -- Machine_State_Length --
476   --------------------------
477
478   function Machine_State_Length
479     return System.Storage_Elements.Storage_Offset
480   is
481   begin
482      return MState'Max_Size_In_Storage_Elements;
483   end Machine_State_Length;
484
485   ---------------
486   -- Pop_Frame --
487   ---------------
488
489   procedure Pop_Frame
490     (M    : Machine_State;
491      Info : Subprogram_Info_Type)
492   is
493      MS  : constant MState_Ptr := To_MState_Ptr (M);
494      PL  : Prolog_Type;
495
496      SOC_Ptr : Uns32;
497      --  Pointer to stack location after last SOC push
498
499      Rtn_Ptr : Uns32;
500      --  Pointer to stack location containing return address
501
502   begin
503      Analyze_Prolog (Info, PL);
504
505      --  Case of frame register, use EBP, safer than ESP
506
507      if PL.Frame_Reg then
508         SOC_Ptr := MS.Regs (ebp) - PL.Frame_Length;
509         Rtn_Ptr := MS.Regs (ebp) + 4;
510         MS.Regs (ebp) := To_Uns32_Ptr (MS.Regs (ebp)).all;
511
512      --  No frame pointer, use ESP, and hope we have it exactly right!
513
514      else
515         SOC_Ptr := MS.Regs (esp);
516         Rtn_Ptr := SOC_Ptr + PL.Frame_Length;
517      end if;
518
519      --  Get saved values of SOC registers
520
521      for J in reverse 1 .. PL.Num_SOC_Push loop
522         MS.Regs (PL.SOC_Push_Regs (J)) := To_Uns32_Ptr (SOC_Ptr).all;
523         SOC_Ptr := SOC_Ptr + 4;
524      end loop;
525
526      MS.eip := To_Uns32_Ptr (Rtn_Ptr).all;
527      MS.Regs (esp) := Rtn_Ptr + 4;
528   end Pop_Frame;
529
530   -----------------------
531   -- Set_Machine_State --
532   -----------------------
533
534   procedure Set_Machine_State (M : Machine_State) is
535      N : constant Asm_Output_Operand := No_Output_Operands;
536
537   begin
538      Asm ("mov %0,%%edx", N, Machine_State'Asm_Input ("r", M));
539
540      --  At this stage, we have the following situation (note that we
541      --  are assuming that the -fomit-frame-pointer switch has not been
542      --  used in compiling this procedure.
543
544      --     (value of M)
545      --     return point
546      --     old ebp          <------ current ebp/esp value
547
548      --  The values of registers ebx/esi/edi are unchanged from entry
549      --  so they have the values we want, and %edx points to the parameter
550      --  value M, so we can store these values directly.
551
552      Asm ("mov %%ebx,4(%%edx)");    -- M.Regs (ebx)
553      Asm ("mov %%esi,16(%%edx)");   -- M.Regs (esi)
554      Asm ("mov %%edi,20(%%edx)");   -- M.Regs (edi)
555
556      --  The desired value of ebp is the old value
557
558      Asm ("mov 0(%%ebp),%%eax");
559      Asm ("mov %%eax,12(%%edx)");   -- M.Regs (ebp)
560
561      --  The return point is the desired eip value
562
563      Asm ("mov 4(%%ebp),%%eax");
564      Asm ("mov %%eax,(%%edx)");   -- M.eip
565
566      --  Finally, the desired %esp value is the value at the point of
567      --  call to this routine *before* pushing the parameter value.
568
569      Asm ("lea 12(%%ebp),%%eax");
570      Asm ("mov %%eax,8(%%edx)");   -- M.Regs (esp)
571   end Set_Machine_State;
572
573   ------------------------------
574   -- Set_Signal_Machine_State --
575   ------------------------------
576
577   procedure Set_Signal_Machine_State
578     (M       : Machine_State;
579      Context : System.Address)
580   is
581      pragma Warnings (Off, M);
582      pragma Warnings (Off, Context);
583
584   begin
585      null;
586   end Set_Signal_Machine_State;
587
588end System.Machine_State_Operations;
589