mlton/codegen/amd64-codegen/amd64-codegen.fun

   1 (* Copyright (C) 2009-2010,2014 Matthew Fluet.
   2  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 functor amd64Codegen (S: AMD64_CODEGEN_STRUCTS): AMD64_CODEGEN =
  11 struct
  12   open S
  13
  14   structure amd64 = amd64 (open Machine
  15                        structure RepType = Type)
  16   structure amd64Pseudo = amd64PseudoCheck (structure S = amd64)
  17
  18   structure amd64MLtonBasic
  19     = amd64MLtonBasic (structure amd64 = amd64Pseudo
  20                      structure Machine = Machine)
  21
  22   structure amd64Liveness
  23     = amd64Liveness (structure amd64 = amd64
  24                    structure amd64MLtonBasic = amd64MLtonBasic)
  25
  26   structure amd64JumpInfo
  27     = amd64JumpInfo (structure amd64 = amd64)
  28
  29   structure amd64LoopInfo
  30     = amd64LoopInfo (structure amd64 = amd64)
  31
  32   structure amd64EntryTransfer
  33     = amd64EntryTransfer (structure amd64 = amd64)
  34
  35   structure amd64MLton
  36     = amd64MLton (structure amd64MLtonBasic = amd64MLtonBasic
  37                 structure amd64Liveness = amd64Liveness)
  38
  39   val implementsPrim = amd64MLton.implementsPrim
  40
  41   structure amd64Translate
  42     = amd64Translate (structure amd64 = amd64
  43                     structure amd64MLton = amd64MLton
  44                     structure amd64Liveness = amd64Liveness)
  45
  46   structure amd64Simplify
  47     = amd64Simplify (structure amd64 = amd64
  48                    structure amd64Liveness = amd64Liveness
  49                    structure amd64JumpInfo = amd64JumpInfo
  50                    structure amd64EntryTransfer = amd64EntryTransfer)
  51
  52   structure amd64GenerateTransfers
  53     = amd64GenerateTransfers (structure amd64 = amd64
  54                             structure amd64MLton = amd64MLton
  55                             structure amd64Liveness = amd64Liveness
  56                             structure amd64JumpInfo = amd64JumpInfo
  57                             structure amd64LoopInfo = amd64LoopInfo
  58                             structure amd64EntryTransfer = amd64EntryTransfer)
  59
  60   structure amd64AllocateRegisters
  61     = amd64AllocateRegisters (structure amd64 = amd64
  62                             structure amd64MLton = amd64MLton)
  63
  64   open amd64
  65   fun output {program as Machine.Program.T {chunks, frameLayouts, handlesSignals,
  66                                             main, ...},
  67               outputC: unit -> {file: File.t,
  68                                 print: string -> unit,
  69                                 done: unit -> unit},
  70               outputS: unit -> {file: File.t,
  71                                 print: string -> unit,
  72                                 done: unit -> unit}}: unit
  73     = let
  74          val reserveRsp =
  75             (* There is no sigaltstack on cygwin, we need to reserve %rsp to
  76              * hold the C stack pointer.  We only need to do this in programs
  77              * that handle signals.
  78              *)
  79             handlesSignals andalso let open Control.Target in !os = Cygwin end
  80
  81         val makeC = outputC
  82         val makeS = outputS
  83
  84         val Machine.Program.T {profileInfo, ...} = program
  85         val profileInfo =
  86            case profileInfo of
  87               NONE => Machine.ProfileInfo.empty
  88             | SOME pi => pi
  89         val {newProfileLabel, delProfileLabel, getProfileInfo} =
  90           Machine.ProfileInfo.modify profileInfo
  91
  92         (* C specific *)
  93         fun outputC ()
  94           = let
  95               local
  96                 val Machine.Program.T
  97                     {chunks,
  98                      frameLayouts,
  99                      frameOffsets,
 100                      handlesSignals,
 101                      main,
 102                      maxFrameSize,
 103                      objectTypes,
 104                      reals,
 105                      vectors, ...} =
 106                   program
 107               in
 108                 val program =
 109                   Machine.Program.T
 110                   {chunks = chunks,
 111                    frameLayouts = frameLayouts,
 112                    frameOffsets = frameOffsets,
 113                    handlesSignals = handlesSignals,
 114                    main = main,
 115                    maxFrameSize = maxFrameSize,
 116                    objectTypes = objectTypes,
 117                    profileInfo = SOME (getProfileInfo ()),
 118                    reals = reals,
 119                    vectors = vectors}
 120               end
 121               val {print, done, ...} = makeC ()
 122               val additionalMainArgs =
 123                  let
 124                     val mainLabel = Label.toString (#label main)
 125                     (* Drop the leading _, because gcc will add it. *)
 126                     val mainLabel =
 127                        if !Control.labelsHaveExtra_
 128                           then String.dropPrefix (mainLabel, 1)
 129                        else mainLabel
 130                  in
 131                     [mainLabel]
 132                  end
 133               fun declareLocals () =
 134                  List.foreach
 135                  (CType.all,
 136                   fn t =>
 137                   let
 138                      val m =
 139                         List.fold
 140                         (chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) =>
 141                          Int.max (max, regMax t))
 142                      val m = m + 1
 143                   in
 144                      print (concat ["PRIVATE ", CType.toString t,
 145                                     " local", CType.toString t,
 146                                     "[", Int.toString m, "];\n"])
 147                   end)
 148               fun rest () =
 149                  declareLocals ()
 150             in
 151               CCodegen.outputDeclarations
 152               {additionalMainArgs = additionalMainArgs,
 153                includes = ["amd64-main.h"],
 154                print = print,
 155                program = program,
 156                rest = rest}
 157               ; done ()
 158             end
 159
 160         val outputC = Control.trace (Control.Pass, "outputC") outputC
 161
 162         (* Assembly specific *)
 163
 164         val _ = amd64MLtonBasic.init ()
 165
 166         fun outputJumpToSML print =
 167            let
 168               val win64 = case !Control.Target.os of
 169                              MLton.Platform.OS.Cygwin => true
 170                            | MLton.Platform.OS.MinGW => true
 171                            | _ => false
 172               val jumpToSML = amd64.Label.fromString "MLton_jumpToSML"
 173               val returnToC = amd64.Label.fromString "Thread_returnToC"
 174               val {frontierReg, stackTopReg} =
 175                  {frontierReg = amd64.Register.r12,
 176                   stackTopReg = amd64.Register.rbp}
 177               val asm =
 178                  [
 179                   amd64.Assembly.pseudoop_text (),
 180                   amd64.Assembly.pseudoop_p2align
 181                   (amd64.Immediate.int 4, NONE, NONE),
 182                   amd64.Assembly.pseudoop_global jumpToSML,
 183                   amd64.Assembly.pseudoop_hidden jumpToSML,
 184                   amd64.Assembly.label jumpToSML,
 185                   amd64.Assembly.instruction_binal
 186                   {oper = amd64.Instruction.SUB,
 187                    src = amd64.Operand.immediate_int 72,
 188                    dst = amd64.Operand.register amd64.Register.rsp,
 189                    size = amd64.Size.QUAD},
 190                   amd64.Assembly.instruction_mov
 191                   {src = amd64.Operand.register amd64.Register.rbp,
 192                    dst = (amd64.Operand.address o amd64.Address.T)
 193                          {disp = SOME (amd64.Immediate.int 64),
 194                           base = SOME amd64.Register.rsp,
 195                           index= NONE, scale = NONE},
 196                    size = amd64.Size.QUAD},
 197                   amd64.Assembly.instruction_mov
 198                   {src = amd64.Operand.register amd64.Register.rbx,
 199                    dst = (amd64.Operand.address o amd64.Address.T)
 200                          {disp = SOME (amd64.Immediate.int 56),
 201                           base = SOME amd64.Register.rsp,
 202                           index= NONE, scale = NONE},
 203                    size = amd64.Size.QUAD},
 204                   amd64.Assembly.instruction_mov
 205                   {src = amd64.Operand.register amd64.Register.r12,
 206                    dst = (amd64.Operand.address o amd64.Address.T)
 207                          {disp = SOME (amd64.Immediate.int 48),
 208                           base = SOME amd64.Register.rsp,
 209                           index= NONE, scale = NONE},
 210                    size = amd64.Size.QUAD},
 211                   amd64.Assembly.instruction_mov
 212                   {src = amd64.Operand.register amd64.Register.r13,
 213                    dst = (amd64.Operand.address o amd64.Address.T)
 214                          {disp = SOME (amd64.Immediate.int 40),
 215                           base = SOME amd64.Register.rsp,
 216                           index= NONE, scale = NONE},
 217                    size = amd64.Size.QUAD},
 218                   amd64.Assembly.instruction_mov
 219                   {src = amd64.Operand.register amd64.Register.r14,
 220                    dst = (amd64.Operand.address o amd64.Address.T)
 221                          {disp = SOME (amd64.Immediate.int 32),
 222                           base = SOME amd64.Register.rsp,
 223                           index= NONE, scale = NONE},
 224                    size = amd64.Size.QUAD},
 225                   amd64.Assembly.instruction_mov
 226                   {src = amd64.Operand.register amd64.Register.r15,
 227                    dst = (amd64.Operand.address o amd64.Address.T)
 228                          {disp = SOME (amd64.Immediate.int 24),
 229                           base = SOME amd64.Register.rsp,
 230                           index= NONE, scale = NONE},
 231                    size = amd64.Size.QUAD},
 232                   amd64.Assembly.instruction_mov
 233                   {src = (amd64.Operand.address o amd64.Address.T)
 234                          {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP),
 235                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 236                    dst = amd64.Operand.register amd64.Register.rbx,
 237                    size = amd64.Size.QUAD},
 238                   amd64.Assembly.instruction_mov
 239                   {src = amd64.Operand.register amd64.Register.rbx,
 240                    dst = (amd64.Operand.address o amd64.Address.T)
 241                          {disp = SOME (amd64.Immediate.int 16),
 242                           base = SOME amd64.Register.rsp,
 243                           index = NONE, scale = NONE},
 244                    size = amd64.Size.QUAD},
 245                   amd64.Assembly.instruction_mov
 246                   {src = amd64.Operand.register amd64.Register.rsp,
 247                    dst = (amd64.Operand.address o amd64.Address.T)
 248                          {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP),
 249                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 250                    size = amd64.Size.QUAD},
 251                   amd64.Assembly.instruction_mov
 252                   {src = (amd64.Operand.address o amd64.Address.T)
 253                          {disp = (SOME o amd64.Immediate.labelPlusInt)
 254                                  (amd64MLton.gcState_label,
 255                                   Bytes.toInt
 256                                   (Machine.Runtime.GCField.offset
 257                                    Machine.Runtime.GCField.StackTop)),
 258                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 259                    dst = amd64.Operand.register stackTopReg,
 260                    size = amd64.Size.QUAD},
 261                   amd64.Assembly.instruction_mov
 262                   {src = (amd64.Operand.address o amd64.Address.T)
 263                          {disp = (SOME o amd64.Immediate.labelPlusInt)
 264                                  (amd64MLton.gcState_label,
 265                                   Bytes.toInt
 266                                   (Machine.Runtime.GCField.offset
 267                                    Machine.Runtime.GCField.Frontier)),
 268                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 269                    dst = amd64.Operand.register frontierReg,
 270                    size = amd64.Size.QUAD},
 271                   amd64.Assembly.instruction_jmp
 272                   {target = amd64.Operand.register
 273                             (if win64 then amd64.Register.rcx
 274                                       else amd64.Register.rdi),
 275                    absolute = true},
 276                   amd64.Assembly.pseudoop_p2align
 277                   (amd64.Immediate.int 4, NONE, NONE),
 278                   amd64.Assembly.pseudoop_global returnToC,
 279                   amd64.Assembly.pseudoop_hidden returnToC,
 280                   amd64.Assembly.label returnToC,
 281                   amd64.Assembly.instruction_mov
 282                   {src = (amd64.Operand.address o amd64.Address.T)
 283                          {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP),
 284                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 285                    dst = amd64.Operand.register amd64.Register.rsp,
 286                    size = amd64.Size.QUAD},
 287                   amd64.Assembly.instruction_mov
 288                   {src = (amd64.Operand.address o amd64.Address.T)
 289                          {disp = SOME (amd64.Immediate.int 16),
 290                           base = SOME amd64.Register.rsp,
 291                           index = NONE, scale = NONE},
 292                    dst = amd64.Operand.register amd64.Register.rbx,
 293                    size = amd64.Size.QUAD},
 294                   amd64.Assembly.instruction_mov
 295                   {src = amd64.Operand.register amd64.Register.rbx,
 296                    dst = (amd64.Operand.address o amd64.Address.T)
 297                          {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP),
 298                           base = SOME amd64.Register.rip, index = NONE, scale = NONE},
 299                    size = amd64.Size.QUAD},
 300                   amd64.Assembly.instruction_mov
 301                   {src = (amd64.Operand.address o amd64.Address.T)
 302                          {disp = SOME (amd64.Immediate.int 24),
 303                           base = SOME amd64.Register.rsp,
 304                           index = NONE, scale = NONE},
 305                    dst = amd64.Operand.register amd64.Register.r15,
 306                    size = amd64.Size.QUAD},
 307                   amd64.Assembly.instruction_mov
 308                   {src = (amd64.Operand.address o amd64.Address.T)
 309                          {disp = SOME (amd64.Immediate.int 32),
 310                           base = SOME amd64.Register.rsp,
 311                           index = NONE, scale = NONE},
 312                    dst = amd64.Operand.register amd64.Register.r14,
 313                    size = amd64.Size.QUAD},
 314                   amd64.Assembly.instruction_mov
 315                   {src = (amd64.Operand.address o amd64.Address.T)
 316                          {disp = SOME (amd64.Immediate.int 40),
 317                           base = SOME amd64.Register.rsp,
 318                           index = NONE, scale = NONE},
 319                    dst = amd64.Operand.register amd64.Register.r13,
 320                    size = amd64.Size.QUAD},
 321                   amd64.Assembly.instruction_mov
 322                   {src = (amd64.Operand.address o amd64.Address.T)
 323                          {disp = SOME (amd64.Immediate.int 48),
 324                           base = SOME amd64.Register.rsp,
 325                           index = NONE, scale = NONE},
 326                    dst = amd64.Operand.register amd64.Register.r12,
 327                    size = amd64.Size.QUAD},
 328                   amd64.Assembly.instruction_mov
 329                   {src = (amd64.Operand.address o amd64.Address.T)
 330                          {disp = SOME (amd64.Immediate.int 56),
 331                           base = SOME amd64.Register.rsp,
 332                           index = NONE, scale = NONE},
 333                    dst = amd64.Operand.register amd64.Register.rbx,
 334                    size = amd64.Size.QUAD},
 335                   amd64.Assembly.instruction_mov
 336                   {src = (amd64.Operand.address o amd64.Address.T)
 337                          {disp = SOME (amd64.Immediate.int 64),
 338                           base = SOME amd64.Register.rsp,
 339                           index = NONE, scale = NONE},
 340                    dst = amd64.Operand.register amd64.Register.rbp,
 341                    size = amd64.Size.QUAD},
 342                   amd64.Assembly.instruction_binal
 343                   {oper = amd64.Instruction.ADD,
 344                    src = amd64.Operand.immediate_int 72,
 345                    dst = amd64.Operand.register amd64.Register.rsp,
 346                    size = amd64.Size.QUAD},
 347                   amd64.Assembly.instruction_ret {src = NONE}
 348                   ]
 349            in
 350               List.foreach
 351               (asm,
 352                fn asm => (Layout.print(Assembly.layout asm, print);
 353                           print "\n"))
 354            end
 355
 356         val liveInfo = amd64Liveness.LiveInfo.newLiveInfo ()
 357         val jumpInfo = amd64JumpInfo.newJumpInfo ()
 358
 359         fun frameInfoToAMD64 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) =
 360            amd64.FrameInfo.T
 361            {frameLayoutsIndex = frameLayoutsIndex,
 362             size = Bytes.toInt (#size (Vector.sub (frameLayouts,
 363                                                    frameLayoutsIndex)))}
 364
 365         fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...},
 366                          print)
 367           = let
 368               val isMain
 369                 = Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel)
 370
 371               val ()
 372                 = if isMain
 373                      then outputJumpToSML print
 374                      else ()
 375
 376               val {chunk}
 377                 = amd64Translate.translateChunk
 378                   {chunk = chunk,
 379                    frameInfoToAMD64 = frameInfoToAMD64,
 380                    liveInfo = liveInfo}
 381
 382               val chunk : amd64.Chunk.t
 383                 = amd64Simplify.simplify
 384                   {chunk = chunk,
 385                    (* don't perform optimizations on
 386                     * the main function (initGlobals)
 387                     *)
 388                    optimize = if isMain
 389                                 then 0
 390                                 else !Control.Native.optimize,
 391                    delProfileLabel = delProfileLabel,
 392                    liveInfo = liveInfo,
 393                    jumpInfo = jumpInfo}
 394
 395               val unallocated_assembly : amd64.Assembly.t list list
 396                 = (amd64GenerateTransfers.generateTransfers
 397                    {chunk = chunk,
 398                     optimize = !Control.Native.optimize,
 399                     newProfileLabel = newProfileLabel,
 400                     liveInfo = liveInfo,
 401                     jumpInfo = jumpInfo,
 402                     reserveRsp = reserveRsp})
 403
 404               val allocated_assembly : Assembly.t list list
 405                 = amd64AllocateRegisters.allocateRegisters
 406                   {assembly = unallocated_assembly,
 407                    (* don't calculate liveness info
 408                     * on the main function (initGlobals)
 409                     *)
 410                    liveness = not isMain}
 411
 412               val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label)
 413               val _ = amd64.Immediate.clearAll ()
 414               val _ = amd64.MemLoc.clearAll ()
 415             in
 416               List.fold
 417               (allocated_assembly,
 418                if isMain then 30 else 0,
 419                fn (block, n)
 420                 => List.fold
 421                    (block,
 422                     n,
 423                     fn (asm, n)
 424                      => (Layout.print (Assembly.layout asm, print);
 425                          print "\n";
 426                          n + 1)))
 427             end
 428
 429         fun outputAssembly ()
 430           = let
 431               val split = !Control.Native.split
 432               fun loop chunks
 433                 = let
 434                     val {print, done, ...} = makeS()
 435                     fun loop' (chunks, size)
 436                       = case chunks
 437                           of [] => done ()
 438                            | chunk::chunks
 439                            => if (case split
 440                                     of NONE => false
 441                                      | SOME maxSize => size > maxSize)
 442                                 then (done (); loop (chunk::chunks))
 443                                 else loop'(chunks,
 444                                            size + outputChunk (chunk, print))
 445                   in
 446                     loop' (chunks, 0)
 447                   end
 448             in
 449               loop chunks
 450               ; amd64Translate.translateChunk_totals ()
 451               ; amd64Simplify.simplify_totals ()
 452               ; amd64GenerateTransfers.generateTransfers_totals ()
 453               ; amd64AllocateRegisters.allocateRegisters_totals ()
 454             end
 455
 456         val outputAssembly =
 457            Control.trace (Control.Pass, "outputAssembly") outputAssembly
 458       in
 459         outputAssembly()
 460         ; outputC()
 461       end
 462 end