mlton/codegen/x86-codegen/x86-mlton-basic.fun

   1 (* Copyright (C) 2009 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 x86MLtonBasic (S: X86_MLTON_BASIC_STRUCTS): X86_MLTON_BASIC =
  11 struct
  12
  13   open S
  14   open x86
  15
  16   local
  17      open Machine
  18   in
  19      structure CType = CType
  20      structure Runtime = Runtime
  21   end
  22
  23   (*
  24    * x86.Size.t equivalents
  25    *)
  26   val wordBytes = Bytes.toInt Bytes.inWord32
  27   val wordSize = Size.fromBytes wordBytes
  28   val wordScale = Scale.fromBytes wordBytes
  29   val pointerBytes = Bytes.toInt Bytes.inWord32
  30   val pointerSize = Size.fromBytes pointerBytes
  31
  32   (*
  33    * Memory classes
  34    *)
  35   structure Classes =
  36     struct
  37       local
  38         fun new s = MemLoc.Class.new {name = s}
  39       in
  40         val Heap = new "Heap"
  41         val Stack = new "Stack"
  42         val Locals = new "Locals"
  43         val Globals = new "Globals"
  44
  45         val Temp = MemLoc.Class.Temp
  46         val StaticTemp = MemLoc.Class.StaticTemp
  47         val CStack = MemLoc.Class.CStack
  48         val Code = MemLoc.Class.Code
  49
  50         val CStatic = new "CStatic"
  51         val StaticNonTemp = new "StaticNonTemp"
  52
  53         val GCState = new "GCState"
  54         val GCStateHold = new "GCStateHold"
  55         val GCStateVolatile = new "GCStateVolatile"
  56       end
  57
  58       val allClasses = ref x86.ClassSet.empty
  59       val livenessClasses = ref x86.ClassSet.empty
  60       val holdClasses = ref x86.ClassSet.empty
  61       val volatileClasses = ref x86.ClassSet.empty
  62       val runtimeClasses = ref x86.ClassSet.empty
  63       val heapClasses = ref x86.ClassSet.empty
  64       val cstaticClasses = ref x86.ClassSet.empty
  65
  66       fun initClasses ()
  67         = let
  68             val _ = allClasses :=
  69                     x86.ClassSet.fromList
  70                     (
  71                      Heap::
  72                      Stack::
  73                      Locals::
  74                      Globals::
  75                      Temp::
  76                      StaticTemp::
  77                      CStack::
  78                      Code::
  79                      CStatic::
  80                      StaticNonTemp::
  81                      GCState::
  82                      GCStateHold::
  83                      GCStateVolatile::
  84                      nil)
  85
  86             val _ = livenessClasses :=
  87                     (if !Control.Native.liveStack
  88                        then x86.ClassSet.fromList
  89                             (
  90                              Temp::
  91                              Locals::
  92                              StaticTemp::
  93                              Stack::
  94                              nil)
  95                        else x86.ClassSet.fromList
  96                             (
  97                              Temp::
  98                              Locals::
  99                              StaticTemp::
 100                              nil))
 101
 102             val _ = holdClasses :=
 103                     x86.ClassSet.fromList
 104                     (
 105                      GCStateHold::
 106 (*
 107                      GCStateVolatile::
 108 *)
 109                      nil)
 110
 111             val _ = volatileClasses :=
 112                     x86.ClassSet.fromList
 113                     (
 114                      GCStateVolatile::
 115                      nil)
 116
 117             val _ = runtimeClasses :=
 118                     x86.ClassSet.fromList
 119                     (
 120                      Heap::
 121                      Stack::
 122                      Globals::
 123                      GCState::
 124                      GCStateHold::
 125                      GCStateVolatile::
 126                      nil)
 127
 128             val _ = heapClasses :=
 129                     x86.ClassSet.fromList
 130                     (
 131                      Heap::
 132                      nil)
 133
 134             val _ = cstaticClasses :=
 135                     x86.ClassSet.fromList
 136                     (
 137                      CStatic::
 138                      nil)
 139           in
 140             ()
 141           end
 142     end
 143
 144   val makeContents = x86.MemLoc.makeContents
 145   val c_stackP = Label.fromString "c_stackP"
 146   val c_stackPContents
 147     = makeContents {base = Immediate.label c_stackP,
 148                     size = pointerSize,
 149                     class = Classes.StaticNonTemp}
 150   val c_stackPContentsOperand
 151     = Operand.memloc c_stackPContents
 152   val c_stackPDerefDouble
 153     = MemLoc.simple {base = c_stackPContents,
 154                      index = Immediate.zero,
 155                      scale = wordScale,
 156                      size = Size.DBLE,
 157                      class = Classes.CStack}
 158   val c_stackPDerefDoubleOperand
 159     = Operand.memloc c_stackPDerefDouble
 160   val c_stackPDerefFloat
 161     = MemLoc.simple {base = c_stackPContents,
 162                      index = Immediate.zero,
 163                      scale = wordScale,
 164                      size = Size.SNGL,
 165                      class = Classes.CStack}
 166   val c_stackPDerefFloatOperand
 167     = Operand.memloc c_stackPDerefFloat
 168
 169   (* This is more a pseudo-location. The GOT is special and cannot
 170    * be simply loaded. Similarly, we don't really read the contents.
 171    *)
 172   val globalOffsetTable = Label.fromString "_GLOBAL_OFFSET_TABLE_"
 173   val globalOffsetTableContents
 174     = makeContents {base = Immediate.label globalOffsetTable,
 175                     size = pointerSize,
 176                     class = Classes.StaticNonTemp}
 177
 178   val applyFFTempFun = Label.fromString "applyFFTempFun"
 179   val applyFFTempFunContents
 180     = makeContents {base = Immediate.label applyFFTempFun,
 181                     size = wordSize,
 182                     class = Classes.StaticTemp}
 183   val applyFFTempFunContentsOperand
 184     = Operand.memloc applyFFTempFunContents
 185   val applyFFTempArg = Label.fromString "applyFFTempArg"
 186   val applyFFTempArgContents
 187     = makeContents {base = Immediate.label applyFFTempArg,
 188                     size = wordSize,
 189                     class = Classes.StaticTemp}
 190   val applyFFTempArgContentsOperand
 191     = Operand.memloc applyFFTempArgContents
 192
 193   val realTemp1D = Label.fromString "realTemp1D"
 194   val realTemp1ContentsD
 195     = makeContents {base = Immediate.label realTemp1D,
 196                     size = Size.DBLE,
 197                     class = Classes.StaticTemp}
 198   val realTemp1ContentsOperandD
 199     = Operand.memloc realTemp1ContentsD
 200   val realTemp1S = Label.fromString "realTemp1S"
 201   val realTemp1ContentsS
 202     = makeContents {base = Immediate.label realTemp1S,
 203                     size = Size.SNGL,
 204                     class = Classes.StaticTemp}
 205   val realTemp1ContentsOperandS
 206     = Operand.memloc realTemp1ContentsS
 207   fun realTemp1ContentsOperand floatSize
 208     = case floatSize of
 209         Size.DBLE => realTemp1ContentsOperandD
 210       | Size.SNGL => realTemp1ContentsOperandS
 211       | _ => Error.bug "x86MLtonBasic.realTemp1ContentsOperand: floatSize"
 212
 213   val realTemp2D = Label.fromString "realTemp2D"
 214   val realTemp2ContentsD
 215     = makeContents {base = Immediate.label realTemp2D,
 216                     size = Size.DBLE,
 217                     class = Classes.StaticTemp}
 218   val realTemp2ContentsOperandD
 219     = Operand.memloc realTemp2ContentsD
 220   val realTemp2S = Label.fromString "realTemp2S"
 221   val realTemp2ContentsS
 222     = makeContents {base = Immediate.label realTemp2S,
 223                     size = Size.SNGL,
 224                     class = Classes.StaticTemp}
 225   val realTemp2ContentsOperandS
 226     = Operand.memloc realTemp2ContentsS
 227   fun realTemp2ContentsOperand floatSize
 228     = case floatSize of
 229         Size.DBLE => realTemp2ContentsOperandD
 230       | Size.SNGL => realTemp2ContentsOperandS
 231       | _ => Error.bug "x86MLtonBasic.realTemp2ContentsOperand: floatSize"
 232
 233   val realTemp3D = Label.fromString "realTemp3D"
 234   val realTemp3ContentsD
 235     = makeContents {base = Immediate.label realTemp3D,
 236                     size = Size.DBLE,
 237                     class = Classes.StaticTemp}
 238   val realTemp3ContentsOperandD
 239     = Operand.memloc realTemp3ContentsD
 240   val realTemp3S = Label.fromString "realTemp3S"
 241   val realTemp3ContentsS
 242     = makeContents {base = Immediate.label realTemp3S,
 243                     size = Size.SNGL,
 244                     class = Classes.StaticTemp}
 245   val realTemp3ContentsOperandS
 246     = Operand.memloc realTemp3ContentsS
 247   fun realTemp3ContentsOperand floatSize
 248     = case floatSize of
 249         Size.DBLE => realTemp3ContentsOperandD
 250       | Size.SNGL => realTemp3ContentsOperandS
 251       | _ => Error.bug "x86MLtonBasic.realTemp3ContentsOperand: floatSize"
 252
 253   val fpswTemp = Label.fromString "fpswTemp"
 254   val fpswTempContents
 255     = makeContents {base = Immediate.label fpswTemp,
 256                     size = Size.WORD,
 257                     class = Classes.StaticTemp}
 258   val fpswTempContentsOperand
 259     = Operand.memloc fpswTempContents
 260   val fildTemp = Label.fromString "fildTemp"
 261   val fildTempContents
 262     = makeContents {base = Immediate.label fildTemp,
 263                     size = Size.WORD,
 264                     class = Classes.StaticTemp}
 265   val fildTempContentsOperand
 266     = Operand.memloc fildTempContents
 267
 268   val wordTemp1B = Label.fromString "wordTemp1B"
 269   val wordTemp1ContentsB
 270     = makeContents {base = Immediate.label wordTemp1B,
 271                     size = Size.BYTE,
 272                     class = Classes.StaticTemp}
 273   val wordTemp1ContentsOperandB
 274     = Operand.memloc wordTemp1ContentsB
 275   val wordTemp1W = Label.fromString "wordTemp1W"
 276   val wordTemp1ContentsW
 277     = makeContents {base = Immediate.label wordTemp1W,
 278                     size = Size.WORD,
 279                     class = Classes.StaticTemp}
 280   val wordTemp1ContentsOperandW
 281     = Operand.memloc wordTemp1ContentsW
 282   val wordTemp1L = Label.fromString "wordTemp1L"
 283   val wordTemp1ContentsL
 284     = makeContents {base = Immediate.label wordTemp1L,
 285                     size = Size.LONG,
 286                     class = Classes.StaticTemp}
 287   val wordTemp1ContentsOperandL
 288     = Operand.memloc wordTemp1ContentsL
 289   fun wordTemp1ContentsOperand wordSize
 290     = case wordSize of
 291         Size.BYTE => wordTemp1ContentsOperandB
 292       | Size.WORD => wordTemp1ContentsOperandW
 293       | Size.LONG => wordTemp1ContentsOperandL
 294       | _ => Error.bug "x86MLtonBasic.wordTemp1ContentsOperand: wordSize"
 295
 296   local
 297      fun make prefix =
 298         let
 299            fun make name size = Label.fromString (concat [prefix, name, size])
 300            val r = make "Real"
 301            val w = make "Word"
 302            datatype z = datatype CType.t
 303         in
 304            CType.memo
 305            (fn t =>
 306             case t of
 307                CPointer => Label.fromString (concat [prefix, "CPointer"])
 308              | Int8 => w "8"
 309              | Int16 => w "16"
 310              | Int32 => w "32"
 311              | Int64 => w "64"
 312              | Objptr => Label.fromString (concat [prefix, "Objptr"])
 313              | Real32 => r "32"
 314              | Real64 => r "64"
 315              | Word8 => w "8"
 316              | Word16 => w "16"
 317              | Word32 => w "32"
 318              | Word64 => w "64")
 319         end
 320   in
 321      val local_base = make "local"
 322      val global_base = make "global"
 323   end
 324
 325   val globalObjptrNonRoot_base = Label.fromString "globalObjptrNonRoot"
 326
 327   val gcState_label = Label.fromString "gcState"
 328
 329   structure Field = Runtime.GCField
 330   fun make' (offset: int, size, class) =
 331      let
 332         fun imm () =
 333            Immediate.labelPlusInt
 334            (gcState_label, offset)
 335         fun contents () =
 336            makeContents {base = imm (),
 337                          size = size,
 338                          class = class}
 339         fun operand () = Operand.memloc (contents ())
 340      in
 341         (imm, contents, operand)
 342      end
 343   fun make (f: Field.t, size, class) =
 344      let
 345         fun imm () =
 346            Immediate.labelPlusInt
 347            (gcState_label, Bytes.toInt (Field.offset f))
 348         fun contents () =
 349            makeContents {base = imm (),
 350                          size = size,
 351                          class = class}
 352         fun operand () = Operand.memloc (contents ())
 353      in
 354         (imm, contents, operand)
 355      end
 356
 357   val (_, gcState_exnStackContents,
 358        gcState_exnStackContentsOperand) =
 359      make (Field.ExnStack, wordSize, Classes.GCState)
 360
 361   val (_, gcState_frontierContents,
 362        gcState_frontierContentsOperand) =
 363      make (Field.Frontier, pointerSize, Classes.GCStateHold)
 364
 365   val (_, gcState_stackBottomContents,
 366        gcState_stackBottomContentsOperand) =
 367      make (Field.StackBottom, pointerSize, Classes.GCState)
 368
 369   val (_, gcState_stackTopContents,
 370        gcState_stackTopContentsOperand) =
 371      make (Field.StackTop, pointerSize, Classes.GCStateHold)
 372
 373   local
 374     val stackTopTemp =
 375       Immediate.label (Label.fromString "stackTopTemp")
 376     val stackTopTempContents =
 377       makeContents {base = stackTopTemp,
 378                     size = wordSize,
 379                     class = Classes.StaticTemp}
 380     val stackTopTempContentsOperand =
 381       Operand.memloc (stackTopTempContents)
 382   in
 383     val stackTopTempContents = fn () => stackTopTempContents
 384     val stackTopTempContentsOperand = fn () => stackTopTempContentsOperand
 385   end
 386
 387   fun gcState_stackTopMinusWordDeref () =
 388      MemLoc.simple {base = gcState_stackTopContents (),
 389                     index = Immediate.int ~1,
 390                     scale = wordScale,
 391                     size = pointerSize,
 392                     class = Classes.Stack}
 393   fun gcState_stackTopMinusWordDerefOperand () =
 394      Operand.memloc (gcState_stackTopMinusWordDeref ())
 395
 396   fun stackTopTempMinusWordDeref () =
 397      MemLoc.simple {base = stackTopTempContents (),
 398                     index = Immediate.int ~1,
 399                     scale = wordScale,
 400                     size = pointerSize,
 401                     class = Classes.Stack}
 402   fun stackTopTempMinusWordDerefOperand () =
 403      Operand.memloc (stackTopTempMinusWordDeref ())
 404
 405   fun gcState_offset {offset, ty} =
 406     let
 407       val (_,_,operand) =
 408         make' (offset, Vector.sub(x86.Size.fromCType ty, 0), Classes.GCState)
 409     in
 410       operand ()
 411     end
 412
 413   (* init *)
 414   fun init () = let
 415                   val _ = Classes.initClasses ()
 416                 in
 417                   ()
 418                 end
 419 end