gcc/ada/5omastop.adb

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