mlton/codegen/x86-codegen/x86-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 x86Codegen (S: X86_CODEGEN_STRUCTS): X86_CODEGEN =
  11 struct
  12   open S
  13
  14   structure x86 = x86 (open Machine
  15                        structure RepType = Type)
  16   structure x86Pseudo = x86PseudoCheck (structure S = x86)
  17
  18   structure x86MLtonBasic
  19     = x86MLtonBasic (structure x86 = x86Pseudo
  20                      structure Machine = Machine)
  21
  22   structure x86Liveness
  23     = x86Liveness (structure x86 = x86
  24                    structure x86MLtonBasic = x86MLtonBasic)
  25
  26   structure x86JumpInfo
  27     = x86JumpInfo (structure x86 = x86)
  28
  29   structure x86LoopInfo
  30     = x86LoopInfo (structure x86 = x86)
  31
  32   structure x86EntryTransfer
  33     = x86EntryTransfer (structure x86 = x86)
  34
  35   structure x86MLton
  36     = x86MLton (structure x86MLtonBasic = x86MLtonBasic
  37                 structure x86Liveness = x86Liveness)
  38
  39   val implementsPrim = x86MLton.implementsPrim
  40
  41   structure x86Translate
  42     = x86Translate (structure x86 = x86
  43                     structure x86MLton = x86MLton
  44                     structure x86Liveness = x86Liveness)
  45
  46   structure x86Simplify
  47     = x86Simplify (structure x86 = x86
  48                    structure x86Liveness = x86Liveness
  49                    structure x86JumpInfo = x86JumpInfo
  50                    structure x86EntryTransfer = x86EntryTransfer)
  51
  52   structure x86GenerateTransfers
  53     = x86GenerateTransfers (structure x86 = x86
  54                             structure x86MLton = x86MLton
  55                             structure x86Liveness = x86Liveness
  56                             structure x86JumpInfo = x86JumpInfo
  57                             structure x86LoopInfo = x86LoopInfo
  58                             structure x86EntryTransfer = x86EntryTransfer)
  59
  60   structure x86AllocateRegisters
  61     = x86AllocateRegisters (structure x86 = x86
  62                             structure x86MLton = x86MLton)
  63
  64   open x86
  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 reserveEsp =
  75             (* There is no sigaltstack on cygwin, we need to reserve %esp 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 (picMungeLabel, picBase) = x86AllocateRegisters.picRelative ()
  82
  83         val makeC = outputC
  84         val makeS = outputS
  85
  86         val Machine.Program.T {profileInfo, ...} = program
  87         val profileInfo =
  88            case profileInfo of
  89               NONE => Machine.ProfileInfo.empty
  90             | SOME pi => pi
  91         val {newProfileLabel, delProfileLabel, getProfileInfo} =
  92           Machine.ProfileInfo.modify profileInfo
  93
  94         (* C specific *)
  95         fun outputC ()
  96           = let
  97               local
  98                 val Machine.Program.T
  99                     {chunks,
 100                      frameLayouts,
 101                      frameOffsets,
 102                      handlesSignals,
 103                      main,
 104                      maxFrameSize,
 105                      objectTypes,
 106                      reals,
 107                      vectors, ...} =
 108                   program
 109               in
 110                 val program =
 111                   Machine.Program.T
 112                   {chunks = chunks,
 113                    frameLayouts = frameLayouts,
 114                    frameOffsets = frameOffsets,
 115                    handlesSignals = handlesSignals,
 116                    main = main,
 117                    maxFrameSize = maxFrameSize,
 118                    objectTypes = objectTypes,
 119                    profileInfo = SOME (getProfileInfo ()),
 120                    reals = reals,
 121                    vectors = vectors}
 122               end
 123               val {print, done, ...} = makeC ()
 124               val additionalMainArgs =
 125                  let
 126                     val mainLabel = Label.toString (#label main)
 127                     (* Drop the leading _, because gcc will add it. *)
 128                     val mainLabel =
 129                        if !Control.labelsHaveExtra_
 130                           then String.dropPrefix (mainLabel, 1)
 131                        else mainLabel
 132                  in
 133                     [mainLabel]
 134                  end
 135               fun declareLocals () =
 136                  List.foreach
 137                  (CType.all,
 138                   fn t =>
 139                   let
 140                      val m =
 141                         List.fold
 142                         (chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) =>
 143                          Int.max (max, regMax t))
 144                      val m = m + 1
 145                   in
 146                      print (concat ["PRIVATE ", CType.toString t,
 147                                     " local", CType.toString t,
 148                                     "[", Int.toString m, "];\n"])
 149                   end)
 150               fun rest () =
 151                  declareLocals ()
 152             in
 153               CCodegen.outputDeclarations
 154               {additionalMainArgs = additionalMainArgs,
 155                includes = ["x86-main.h"],
 156                print = print,
 157                program = program,
 158                rest = rest}
 159               ; done ()
 160             end
 161
 162         val outputC = Control.trace (Control.Pass, "outputC") outputC
 163
 164         (* Assembly specific *)
 165
 166         val _ = x86MLtonBasic.init ()
 167
 168         fun outputJumpToSML print =
 169            let
 170               val jumpToSML = x86.Label.fromString "MLton_jumpToSML"
 171               val findEIP   = x86.Label.fromString "MLton_findEIP"
 172               val returnToC = x86.Label.fromString "Thread_returnToC"
 173               val c_stackP  = picMungeLabel x86MLton.c_stackP
 174               val gcState   = picMungeLabel x86MLton.gcState_label
 175               val {frontierReg, stackTopReg} =
 176                  if reserveEsp
 177                     then {frontierReg = x86.Register.edi,
 178                           stackTopReg = x86.Register.ebp}
 179                     else {frontierReg = x86.Register.esp,
 180                           stackTopReg = x86.Register.ebp}
 181               val prefixJumpToSML = [
 182                   x86.Assembly.pseudoop_text (),
 183                   x86.Assembly.pseudoop_p2align
 184                   (x86.Immediate.int 4, NONE, NONE),
 185                   x86.Assembly.pseudoop_global jumpToSML,
 186                   x86.Assembly.pseudoop_hidden jumpToSML,
 187                   x86.Assembly.label jumpToSML,
 188                   x86.Assembly.instruction_binal
 189                   {oper = x86.Instruction.SUB,
 190                    src = x86.Operand.immediate_int 28,
 191                    dst = x86.Operand.register x86.Register.esp,
 192                    size = x86.Size.LONG},
 193                   x86.Assembly.instruction_mov
 194                   {src = (x86.Operand.address o x86.Address.T)
 195                          {disp = SOME (x86.Immediate.int 32),
 196                           base = SOME x86.Register.esp,
 197                           index= NONE, scale = NONE},
 198                    dst = x86.Operand.register x86.Register.eax,
 199                    size = x86.Size.LONG},
 200                   x86.Assembly.instruction_mov
 201                   {src = x86.Operand.register x86.Register.ebp,
 202                    dst = (x86.Operand.address o x86.Address.T)
 203                          {disp = SOME (x86.Immediate.int 24),
 204                           base = SOME x86.Register.esp,
 205                           index= NONE, scale = NONE},
 206                    size = x86.Size.LONG},
 207                   x86.Assembly.instruction_mov
 208                   {src = x86.Operand.register x86.Register.ebx,
 209                    dst = (x86.Operand.address o x86.Address.T)
 210                          {disp = SOME (x86.Immediate.int 20),
 211                           base = SOME x86.Register.esp,
 212                           index= NONE, scale = NONE},
 213                    size = x86.Size.LONG},
 214                   x86.Assembly.instruction_mov
 215                   {src = x86.Operand.register x86.Register.edi,
 216                    dst = (x86.Operand.address o x86.Address.T)
 217                          {disp = SOME (x86.Immediate.int 16),
 218                           base = SOME x86.Register.esp,
 219                           index= NONE, scale = NONE},
 220                    size = x86.Size.LONG},
 221                   x86.Assembly.instruction_mov
 222                   {src = x86.Operand.register x86.Register.esi,
 223                    dst = (x86.Operand.address o x86.Address.T)
 224                          {disp = SOME (x86.Immediate.int 12),
 225                           base = SOME x86.Register.esp,
 226                           index = NONE, scale = NONE},
 227                    size = x86.Size.LONG}
 228                   ]
 229               (* This is only included if PIC *)
 230               val loadGOT = [
 231                   x86.Assembly.instruction_call
 232                   {target = x86.Operand.label findEIP,
 233                    absolute = false},
 234                   x86.Assembly.instruction_binal
 235                   {oper = x86.Instruction.ADD,
 236                    src = x86.Operand.immediate_label x86MLton.globalOffsetTable,
 237                    dst = x86.Operand.register x86.Register.ebx,
 238                    size = x86.Size.LONG}
 239                   ]
 240               val suffixJumpToSML = [
 241                   x86.Assembly.instruction_mov
 242                   {src = (x86.Operand.address o x86.Address.T)
 243                          {disp = SOME (x86.Immediate.label c_stackP),
 244                           base = picBase, index = NONE, scale = NONE},
 245                    dst = x86.Operand.register x86.Register.ebp,
 246                    size = x86.Size.LONG},
 247                   x86.Assembly.instruction_mov
 248                   {src = x86.Operand.register x86.Register.ebp,
 249                    dst = (x86.Operand.address o x86.Address.T)
 250                          {disp = SOME (x86.Immediate.int 8),
 251                           base = SOME x86.Register.esp,
 252                           index = NONE, scale = NONE},
 253                    size = x86.Size.LONG},
 254                   x86.Assembly.instruction_mov
 255                   {src = x86.Operand.register x86.Register.esp,
 256                    dst = (x86.Operand.address o x86.Address.T)
 257                          {disp = SOME (x86.Immediate.label c_stackP),
 258                           base = picBase, index = NONE, scale = NONE},
 259                    size = x86.Size.LONG},
 260                   x86.Assembly.instruction_mov
 261                   {src = (x86.Operand.address o x86.Address.T)
 262                          {disp = (SOME o x86.Immediate.labelPlusInt)
 263                                  (gcState,
 264                                   Bytes.toInt
 265                                   (Machine.Runtime.GCField.offset
 266                                    Machine.Runtime.GCField.StackTop)),
 267                           base = picBase, index = NONE, scale = NONE},
 268                    dst = x86.Operand.register stackTopReg,
 269                    size = x86.Size.LONG},
 270                   x86.Assembly.instruction_mov
 271                   {src = (x86.Operand.address o x86.Address.T)
 272                          {disp = (SOME o x86.Immediate.labelPlusInt)
 273                                  (gcState,
 274                                   Bytes.toInt
 275                                   (Machine.Runtime.GCField.offset
 276                                    Machine.Runtime.GCField.Frontier)),
 277                           base = picBase, index = NONE, scale = NONE},
 278                    dst = x86.Operand.register frontierReg,
 279                    size = x86.Size.LONG},
 280                   x86.Assembly.instruction_jmp
 281                   {target = x86.Operand.register x86.Register.eax,
 282                    absolute = true}
 283                   ]
 284               val bodyReturnToC = [
 285                   x86.Assembly.pseudoop_p2align
 286                   (x86.Immediate.int 4, NONE, NONE),
 287                   x86.Assembly.pseudoop_global returnToC,
 288                   x86.Assembly.pseudoop_hidden returnToC,
 289                   x86.Assembly.label returnToC,
 290                   x86.Assembly.instruction_mov
 291                   {src = (x86.Operand.address o x86.Address.T)
 292                          {disp = SOME (x86.Immediate.label c_stackP),
 293                           base = picBase, index = NONE, scale = NONE},
 294                    dst = x86.Operand.register x86.Register.esp,
 295                    size = x86.Size.LONG},
 296                   x86.Assembly.instruction_mov
 297                   {src = (x86.Operand.address o x86.Address.T)
 298                          {disp = SOME (x86.Immediate.int 8),
 299                           base = SOME x86.Register.esp,
 300                           index = NONE, scale = NONE},
 301                    dst = x86.Operand.register x86.Register.ebp,
 302                    size = x86.Size.LONG},
 303                   x86.Assembly.instruction_mov
 304                   {src = x86.Operand.register x86.Register.ebp,
 305                    dst = (x86.Operand.address o x86.Address.T)
 306                          {disp = SOME (x86.Immediate.label c_stackP),
 307                           base = picBase, index = NONE, scale = NONE},
 308                    size = x86.Size.LONG},
 309                   x86.Assembly.instruction_mov
 310                   {src = (x86.Operand.address o x86.Address.T)
 311                          {disp = SOME (x86.Immediate.int 12),
 312                           base = SOME x86.Register.esp,
 313                           index = NONE, scale = NONE},
 314                    dst = x86.Operand.register x86.Register.esi,
 315                    size = x86.Size.LONG},
 316                   x86.Assembly.instruction_mov
 317                   {src = (x86.Operand.address o x86.Address.T)
 318                          {disp = SOME (x86.Immediate.int 16),
 319                           base = SOME x86.Register.esp,
 320                           index = NONE, scale = NONE},
 321                    dst = x86.Operand.register x86.Register.edi,
 322                    size = x86.Size.LONG},
 323                   x86.Assembly.instruction_mov
 324                   {src = (x86.Operand.address o x86.Address.T)
 325                          {disp = SOME (x86.Immediate.int 20),
 326                           base = SOME x86.Register.esp,
 327                           index = NONE, scale = NONE},
 328                    dst = x86.Operand.register x86.Register.ebx,
 329                    size = x86.Size.LONG},
 330                   x86.Assembly.instruction_mov
 331                   {src = (x86.Operand.address o x86.Address.T)
 332                          {disp = SOME (x86.Immediate.int 24),
 333                           base = SOME x86.Register.esp,
 334                           index = NONE, scale = NONE},
 335                    dst = x86.Operand.register x86.Register.ebp,
 336                    size = x86.Size.LONG},
 337                   x86.Assembly.instruction_binal
 338                   {oper = x86.Instruction.ADD,
 339                    src = x86.Operand.immediate_int 28,
 340                    dst = x86.Operand.register x86.Register.esp,
 341                    size = x86.Size.LONG},
 342                   x86.Assembly.instruction_ret {src = NONE}
 343                   ]
 344               (* This is only included if PIC *)
 345               val bodyFindEIP = [
 346                   x86.Assembly.pseudoop_p2align
 347                   (x86.Immediate.int 4, NONE, NONE),
 348                   x86.Assembly.pseudoop_global findEIP,
 349                   x86.Assembly.pseudoop_hidden findEIP,
 350                   x86.Assembly.label findEIP,
 351                   x86.Assembly.instruction_mov
 352                   {src = (x86.Operand.address o x86.Address.T)
 353                          {base = SOME x86.Register.esp,
 354                           disp = NONE, index = NONE, scale = NONE},
 355                    dst = x86.Operand.register x86.Register.ebx,
 356                    size = x86.Size.LONG},
 357                   x86.Assembly.instruction_ret {src = NONE}
 358                   ]
 359
 360               val asm =
 361                  List.concat
 362                  (if picBase <> NONE
 363                   then [prefixJumpToSML, loadGOT, suffixJumpToSML,
 364                         bodyReturnToC, bodyFindEIP]
 365                   else [prefixJumpToSML, suffixJumpToSML,
 366                         bodyReturnToC])
 367            in
 368               List.foreach
 369               (asm,
 370                fn asm => (Layout.print(Assembly.layout asm, print);
 371                           print "\n"))
 372            end
 373
 374         val liveInfo = x86Liveness.LiveInfo.newLiveInfo ()
 375         val jumpInfo = x86JumpInfo.newJumpInfo ()
 376
 377         fun frameInfoToX86 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) =
 378            x86.FrameInfo.T
 379            {frameLayoutsIndex = frameLayoutsIndex,
 380             size = Bytes.toInt (#size (Vector.sub (frameLayouts,
 381                                                    frameLayoutsIndex)))}
 382
 383         fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...},
 384                          print)
 385           = let
 386               val isMain
 387                 = Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel)
 388
 389               val ()
 390                 = if isMain
 391                      then outputJumpToSML print
 392                      else ()
 393
 394               val {chunk}
 395                 = x86Translate.translateChunk
 396                   {chunk = chunk,
 397                    frameInfoToX86 = frameInfoToX86,
 398                    liveInfo = liveInfo}
 399
 400               val chunk : x86.Chunk.t
 401                 = x86Simplify.simplify
 402                   {chunk = chunk,
 403                    (* don't perform optimizations on
 404                     * the main function (initGlobals)
 405                     *)
 406                    optimize = if isMain
 407                                 then 0
 408                                 else !Control.Native.optimize,
 409                    delProfileLabel = delProfileLabel,
 410                    liveInfo = liveInfo,
 411                    jumpInfo = jumpInfo}
 412
 413               val unallocated_assembly : x86.Assembly.t list list
 414                 = (x86GenerateTransfers.generateTransfers
 415                    {chunk = chunk,
 416                     optimize = !Control.Native.optimize,
 417                     newProfileLabel = newProfileLabel,
 418                     liveInfo = liveInfo,
 419                     jumpInfo = jumpInfo,
 420                     reserveEsp = reserveEsp,
 421                     picUsesEbx = picBase <> NONE})
 422
 423               val allocated_assembly : Assembly.t list list
 424                 = x86AllocateRegisters.allocateRegisters
 425                   {assembly = unallocated_assembly,
 426                    (* don't calculate liveness info
 427                     * on the main function (initGlobals)
 428                     *)
 429                    liveness = not isMain}
 430
 431               val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label)
 432               val _ = x86.Immediate.clearAll ()
 433               val _ = x86.MemLoc.clearAll ()
 434             in
 435               List.fold
 436               (allocated_assembly,
 437                if isMain then 30 else 0,
 438                fn (block, n)
 439                 => List.fold
 440                    (block,
 441                     n,
 442                     fn (asm, n)
 443                      => (Layout.print (Assembly.layout asm, print);
 444                          print "\n";
 445                          n + 1)))
 446             end
 447
 448         fun outputAssembly ()
 449           = let
 450               val split = !Control.Native.split
 451               fun loop chunks
 452                 = let
 453                     val {print, done, ...} = makeS()
 454                     fun loop' (chunks, size)
 455                       = case chunks
 456                           of [] => done ()
 457                            | chunk::chunks
 458                            => if (case split
 459                                     of NONE => false
 460                                      | SOME maxSize => size > maxSize)
 461                                 then (done (); loop (chunk::chunks))
 462                                 else loop'(chunks,
 463                                            size + outputChunk (chunk, print))
 464                   in
 465                     loop' (chunks, 0)
 466                   end
 467             in
 468               loop chunks
 469               ; x86Translate.translateChunk_totals ()
 470               ; x86Simplify.simplify_totals ()
 471               ; x86GenerateTransfers.generateTransfers_totals ()
 472               ; x86AllocateRegisters.allocateRegisters_totals ()
 473             end
 474
 475         val outputAssembly =
 476            Control.trace (Control.Pass, "outputAssembly") outputAssembly
 477       in
 478         outputAssembly()
 479         ; outputC()
 480       end
 481 end