mirror of
				https://github.com/KevinMidboe/linguist.git
				synced 2025-10-29 17:50:22 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			126 lines
		
	
	
		
			4.8 KiB
		
	
	
	
		
			OCaml
		
	
	
	
	
	
			
		
		
	
	
			126 lines
		
	
	
		
			4.8 KiB
		
	
	
	
		
			OCaml
		
	
	
	
	
	
(***********************************************************************)
 | 
						|
(*                                                                     *)
 | 
						|
(*                                OCaml                                *)
 | 
						|
(*                                                                     *)
 | 
						|
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 | 
						|
(*                                                                     *)
 | 
						|
(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
 | 
						|
(*  en Automatique.  All rights reserved.  This file is distributed    *)
 | 
						|
(*  under the terms of the Q Public License version 1.0.               *)
 | 
						|
(*                                                                     *)
 | 
						|
(***********************************************************************)
 | 
						|
 | 
						|
open Cmm
 | 
						|
open Arch
 | 
						|
open Reg
 | 
						|
open Mach
 | 
						|
 | 
						|
(* Reloading for the AMD64 *)
 | 
						|
 | 
						|
(* Summary of instruction set constraints:
 | 
						|
   "S" means either stack or register, "R" means register only.
 | 
						|
   Operation                    Res     Arg1    Arg2
 | 
						|
     Imove                      R       S
 | 
						|
                             or S       R
 | 
						|
     Iconst_int                 S if 32-bit signed, R otherwise
 | 
						|
     Iconst_float               R
 | 
						|
     Iconst_symbol (not PIC)    S
 | 
						|
     Iconst_symbol (PIC)        R
 | 
						|
     Icall_ind                          R
 | 
						|
     Itailcall_ind                      R
 | 
						|
     Iload                      R       R       R
 | 
						|
     Istore                             R       R
 | 
						|
     Iintop(Icomp)              R       R       S
 | 
						|
                            or  S       S       R
 | 
						|
     Iintop(Imul|Idiv|mod)      R       R       S
 | 
						|
     Iintop(shift)              S       S       R
 | 
						|
     Iintop(others)             R       R       S
 | 
						|
                            or  S       S       R
 | 
						|
     Iintop_imm(Iadd, n)/lea    R       R
 | 
						|
     Iintop_imm(others)         S       S
 | 
						|
     Inegf...Idivf              R       R       S
 | 
						|
     Ifloatofint                R       S
 | 
						|
     Iintoffloat                R       S
 | 
						|
     Ispecific(Ilea)            R       R       R
 | 
						|
     Ispecific(Ifloatarithmem)  R       R       R
 | 
						|
 | 
						|
   Conditional branches:
 | 
						|
     Iinttest                           S       R
 | 
						|
                                    or  R       S
 | 
						|
     Ifloattest                         R       S    (or  S R if swapped test)
 | 
						|
     other tests                        S
 | 
						|
*)
 | 
						|
 | 
						|
let stackp r =
 | 
						|
  match r.loc with
 | 
						|
    Stack _ -> true
 | 
						|
  | _ -> false
 | 
						|
 | 
						|
class reload = object (self)
 | 
						|
 | 
						|
inherit Reloadgen.reload_generic as super
 | 
						|
 | 
						|
method! reload_operation op arg res =
 | 
						|
  match op with
 | 
						|
  | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
 | 
						|
      (* One of the two arguments can reside in the stack, but not both *)
 | 
						|
      if stackp arg.(0) && stackp arg.(1)
 | 
						|
      then ([|arg.(0); self#makereg arg.(1)|], res)
 | 
						|
      else (arg, res)
 | 
						|
  | Iintop_imm(Iadd, _) when arg.(0).loc <> res.(0).loc ->
 | 
						|
      (* This add will be turned into a lea; args and results must be
 | 
						|
         in registers *)
 | 
						|
      super#reload_operation op arg res
 | 
						|
  | Iintop(Idiv | Imod | Ilsl | Ilsr | Iasr)
 | 
						|
  | Iintop_imm(_, _) ->
 | 
						|
      (* The argument(s) and results can be either in register or on stack *)
 | 
						|
      (* Note: Idiv, Imod: arg(0) and res(0) already forced in regs
 | 
						|
               Ilsl, Ilsr, Iasr: arg(1) already forced in regs *)
 | 
						|
      (arg, res)
 | 
						|
  | Iintop(Imul) | Iaddf | Isubf | Imulf | Idivf ->
 | 
						|
      (* First argument (= result) must be in register, second arg
 | 
						|
         can reside in the stack *)
 | 
						|
      if stackp arg.(0)
 | 
						|
      then (let r = self#makereg arg.(0) in ([|r; arg.(1)|], [|r|]))
 | 
						|
      else (arg, res)
 | 
						|
  | Ifloatofint | Iintoffloat ->
 | 
						|
      (* Result must be in register, but argument can be on stack *)
 | 
						|
      (arg, (if stackp res.(0) then [| self#makereg res.(0) |] else res))
 | 
						|
  | Iconst_int n ->
 | 
						|
      if n <= 0x7FFFFFFFn && n >= -0x80000000n
 | 
						|
      then (arg, res)
 | 
						|
      else super#reload_operation op arg res
 | 
						|
  | Iconst_symbol _ ->
 | 
						|
      if !pic_code || !Clflags.dlcode
 | 
						|
      then super#reload_operation op arg res
 | 
						|
      else (arg, res)
 | 
						|
  | _ -> (* Other operations: all args and results in registers *)
 | 
						|
      super#reload_operation op arg res
 | 
						|
 | 
						|
method! reload_test tst arg =
 | 
						|
  match tst with
 | 
						|
    Iinttest cmp ->
 | 
						|
      (* One of the two arguments can reside on stack *)
 | 
						|
      if stackp arg.(0) && stackp arg.(1)
 | 
						|
      then [| self#makereg arg.(0); arg.(1) |]
 | 
						|
      else arg
 | 
						|
  | Ifloattest((Clt|Cle), _) ->
 | 
						|
      (* Cf. emit.mlp: we swap arguments in this case *)
 | 
						|
      (* First argument can be on stack, second must be in register *)
 | 
						|
      if stackp arg.(1)
 | 
						|
      then [| arg.(0); self#makereg arg.(1) |]
 | 
						|
      else arg
 | 
						|
  | Ifloattest((Ceq|Cne|Cgt|Cge), _) ->
 | 
						|
      (* Second argument can be on stack, first must be in register *)
 | 
						|
      if stackp arg.(0)
 | 
						|
      then [| self#makereg arg.(0); arg.(1) |]
 | 
						|
      else arg
 | 
						|
  | _ ->
 | 
						|
      (* The argument(s) can be either in register or on stack *)
 | 
						|
      arg
 | 
						|
 | 
						|
end
 | 
						|
 | 
						|
let fundecl f =
 | 
						|
  (new reload)#fundecl f
 |