| 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 | signature AMD64_PSEUDO = |
| 11 | sig |
| 12 | structure CFunction: C_FUNCTION |
| 13 | structure CType: C_TYPE |
| 14 | structure Label: ID |
| 15 | structure RepType: REP_TYPE |
| 16 | structure Runtime: RUNTIME |
| 17 | structure WordSize: WORD_SIZE |
| 18 | structure WordX: WORD_X |
| 19 | sharing CFunction = RepType.CFunction |
| 20 | sharing CType = RepType.CType |
| 21 | sharing WordSize = CType.WordSize = WordX.WordSize |
| 22 | |
| 23 | val tracer : string -> ('a -> 'b) -> |
| 24 | (('a -> 'b) * (unit -> unit)) |
| 25 | val tracerTop : string -> ('a -> 'b) -> |
| 26 | (('a -> 'b) * (unit -> unit)) |
| 27 | |
| 28 | structure Size : |
| 29 | sig |
| 30 | datatype class = INT | FLT |
| 31 | datatype t |
| 32 | = BYTE | WORD | LONG | QUAD |
| 33 | | SNGL | DBLE |
| 34 | val fromBytes : int -> t |
| 35 | val toBytes : t -> int |
| 36 | val fromCType : CType.t -> t vector |
| 37 | val class : t -> class |
| 38 | val eq : t * t -> bool |
| 39 | val lt : t * t -> bool |
| 40 | val toString : t -> string |
| 41 | end |
| 42 | |
| 43 | structure Immediate : |
| 44 | sig |
| 45 | type t |
| 46 | |
| 47 | val word : WordX.t -> t |
| 48 | val int' : int * WordSize.t -> t |
| 49 | val int : int -> t |
| 50 | val zero : t |
| 51 | val label : Label.t -> t |
| 52 | val labelPlusWord : Label.t * WordX.t -> t |
| 53 | val labelPlusInt : Label.t * int -> t |
| 54 | end |
| 55 | |
| 56 | structure Scale : |
| 57 | sig |
| 58 | datatype t = One | Two | Four | Eight |
| 59 | val fromBytes : int -> t |
| 60 | val fromCType : CType.t -> t |
| 61 | end |
| 62 | |
| 63 | structure MemLoc : |
| 64 | sig |
| 65 | structure Class : |
| 66 | sig |
| 67 | type t |
| 68 | val new : {name: string} -> t |
| 69 | val Temp : t |
| 70 | val StaticTemp : t |
| 71 | val CArg : t |
| 72 | val CStack : t |
| 73 | val Code : t |
| 74 | |
| 75 | val eq : t * t -> bool |
| 76 | end |
| 77 | |
| 78 | type t |
| 79 | val layout : t -> Layout.t |
| 80 | |
| 81 | val imm : {base: Immediate.t, |
| 82 | index: Immediate.t, |
| 83 | scale: Scale.t, |
| 84 | size: Size.t, |
| 85 | class: Class.t} -> t |
| 86 | val basic : {base: Immediate.t, |
| 87 | index: t, |
| 88 | scale: Scale.t, |
| 89 | size: Size.t, |
| 90 | class: Class.t} -> t |
| 91 | val simple : {base: t, |
| 92 | index: Immediate.t, |
| 93 | scale: Scale.t, |
| 94 | size: Size.t, |
| 95 | class: Class.t} -> t |
| 96 | val complex : {base: t, |
| 97 | index: t, |
| 98 | scale: Scale.t, |
| 99 | size: Size.t, |
| 100 | class: Class.t} -> t |
| 101 | val shift : {origin: t, |
| 102 | disp: Immediate.t, |
| 103 | scale: Scale.t, |
| 104 | size: Size.t} -> t |
| 105 | |
| 106 | val class : t -> Class.t |
| 107 | val compare : t * t -> order |
| 108 | (* |
| 109 | * Static memory locations |
| 110 | *) |
| 111 | val makeContents : {base: Immediate.t, |
| 112 | size: Size.t, |
| 113 | class: Class.t} -> t |
| 114 | end |
| 115 | |
| 116 | structure ClassSet : SET |
| 117 | sharing type ClassSet.Element.t = MemLoc.Class.t |
| 118 | structure MemLocSet : SET |
| 119 | sharing type MemLocSet.Element.t = MemLoc.t |
| 120 | |
| 121 | structure Operand : |
| 122 | sig |
| 123 | type t |
| 124 | |
| 125 | val layout : t -> Layout.t |
| 126 | val toString : t -> string |
| 127 | |
| 128 | val immediate : Immediate.t -> t |
| 129 | val immediate_word : WordX.t -> t |
| 130 | val immediate_int' : int * WordSize.t -> t |
| 131 | val immediate_int : int -> t |
| 132 | val immediate_zero : t |
| 133 | val immediate_label : Label.t -> t |
| 134 | val deImmediate : t -> Immediate.t option |
| 135 | val label : Label.t -> t |
| 136 | val deLabel : t -> Label.t option |
| 137 | val memloc : MemLoc.t -> t |
| 138 | val memloc_label: Label.t -> t |
| 139 | val deMemloc : t -> MemLoc.t option |
| 140 | |
| 141 | val size : t -> Size.t option |
| 142 | val eq : t * t -> bool |
| 143 | val mayAlias : t * t -> bool |
| 144 | end |
| 145 | |
| 146 | structure Instruction : |
| 147 | sig |
| 148 | (* Integer binary arithmetic(w/o mult & div)/logic instructions. *) |
| 149 | datatype binal |
| 150 | = ADD (* signed/unsigned addition; p. 58 *) |
| 151 | | ADC (* signed/unsigned addition with carry; p. 56 *) |
| 152 | | SUB (* signed/unsigned subtraction; p. 234 *) |
| 153 | | SBB (* signed/unsigned subtraction with borrow; p. 216 *) |
| 154 | | AND (* logical and; p. 60 *) |
| 155 | | OR (* logical or; p. 176 *) |
| 156 | | XOR (* logical xor; p. 243 *) |
| 157 | (* Integer multiplication and division. *) |
| 158 | datatype md |
| 159 | = IMUL (* signed multiplication (one operand form); p. 114 *) |
| 160 | | MUL (* unsigned multiplication; p. 170 *) |
| 161 | | IDIV (* signed division; p. 112 *) |
| 162 | | DIV (* unsigned division; p. 108 *) |
| 163 | | IMOD (* signed modulus; *) |
| 164 | | MOD (* unsigned modulus; *) |
| 165 | (* Integer unary arithmetic/logic instructions. *) |
| 166 | datatype unal |
| 167 | = INC (* increment by 1; p. 117 *) |
| 168 | | DEC (* decrement by 1; p. 106 *) |
| 169 | | NEG (* two's complement negation; p. 172 *) |
| 170 | | NOT (* one's complement negation; p. 175 *) |
| 171 | (* Integer shift/rotate arithmetic/logic instructions. *) |
| 172 | datatype sral |
| 173 | = SAL (* shift arithmetic left; p. 211 *) |
| 174 | | SHL (* shift logical left; p. 211 *) |
| 175 | | SAR (* shift arithmetic right; p. 214 *) |
| 176 | | SHR (* shift logical right; p. 214 *) |
| 177 | | ROL (* rotate left; p. 206 *) |
| 178 | | RCL (* rotate through carry left; p. 197 *) |
| 179 | | ROR (* rotate right; p. 208 *) |
| 180 | | RCR (* rotate through carry right; p. 199 *) |
| 181 | (* Move with extention instructions. *) |
| 182 | datatype movx |
| 183 | = MOVSX (* move with sign extention; p. 167 *) |
| 184 | | MOVZX (* move with zero extention; p. 169 *) |
| 185 | (* Condition test field; p. 340 *) |
| 186 | datatype condition |
| 187 | = O (* overflow *) | NO (* not overflow *) |
| 188 | | B (* below *) | NB (* not below *) |
| 189 | | AE (* above or equal *) | NAE (* not above or equal *) |
| 190 | | C (* carry *) | NC (* not carry *) |
| 191 | | E (* equal *) | NE (* not equal *) |
| 192 | | Z (* zero *) | NZ (* not zero *) |
| 193 | | BE (* below or equal *) | NBE (* not below or equal *) |
| 194 | | A (* above *) | NA (* not above *) |
| 195 | | S (* sign *) | NS (* not sign *) |
| 196 | | P (* parity *) | NP (* not parity *) |
| 197 | | PE (* parity even *) | PO (* parity odd *) |
| 198 | | L (* less than *) |
| 199 | | NL (* not less than *) |
| 200 | | LE (* less than or equal *) |
| 201 | | NLE (* not less than or equal *) |
| 202 | | G (* greater than *) |
| 203 | | NG (* not greater than *) |
| 204 | | GE (* greater than or equal *) |
| 205 | | NGE (* not greater than or equal *) |
| 206 | val condition_negate : condition -> condition |
| 207 | val condition_reverse : condition -> condition |
| 208 | |
| 209 | (* Scalar SSE binary arithmetic instructions. *) |
| 210 | datatype sse_binas |
| 211 | = SSE_ADDS (* addition; p. 7,10 *) |
| 212 | | SSE_SUBS (* subtraction; p. 371,374 *) |
| 213 | | SSE_MULS (* multiplication; p. 201,204 *) |
| 214 | | SSE_DIVS (* division; p. 97,100 *) |
| 215 | | SSE_MAXS (* maximum; p. 128, 130 *) |
| 216 | | SSE_MINS (* minimum; p. 132, 134 *) |
| 217 | (* Scalar SSE unary arithmetic instructions. *) |
| 218 | datatype sse_unas |
| 219 | = SSE_SQRTS (* square root; p. 360,362 *) |
| 220 | (* Packed SSE binary logical instructions (used as scalar). *) |
| 221 | datatype sse_binlp |
| 222 | = SSE_ANDNP (* and-not; p. 17,19 *) |
| 223 | | SSE_ANDP (* and; p. 21,23 *) |
| 224 | | SSE_ORP (* or; p. 206,208 *) |
| 225 | | SSE_XORP (* xor; p. 391,393 *) |
| 226 | |
| 227 | type t |
| 228 | end |
| 229 | |
| 230 | structure PseudoOp : |
| 231 | sig |
| 232 | type t |
| 233 | |
| 234 | val toString : t -> string |
| 235 | |
| 236 | val data : unit -> t |
| 237 | val text : unit -> t |
| 238 | val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t |
| 239 | val byte : Immediate.t list -> t |
| 240 | val word : Immediate.t list -> t |
| 241 | val long : Immediate.t list -> t |
| 242 | val quad : Immediate.t list -> t |
| 243 | end |
| 244 | |
| 245 | structure Assembly : |
| 246 | sig |
| 247 | type t |
| 248 | |
| 249 | val toString : t -> string |
| 250 | |
| 251 | val comment : string -> t |
| 252 | val isComment : t -> bool |
| 253 | val pseudoop : PseudoOp.t -> t |
| 254 | val pseudoop_data : unit -> t |
| 255 | val pseudoop_text : unit -> t |
| 256 | val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t |
| 257 | val pseudoop_byte : Immediate.t list -> t |
| 258 | val pseudoop_global: Label.t -> t |
| 259 | val pseudoop_word : Immediate.t list -> t |
| 260 | val pseudoop_long : Immediate.t list -> t |
| 261 | val pseudoop_quad : Immediate.t list -> t |
| 262 | val label : Label.t -> t |
| 263 | val instruction : Instruction.t -> t |
| 264 | val instruction_nop : unit -> t |
| 265 | val instruction_binal : {oper: Instruction.binal, |
| 266 | src: Operand.t, |
| 267 | dst: Operand.t, |
| 268 | size: Size.t} -> t |
| 269 | val instruction_pmd : {oper: Instruction.md, |
| 270 | src: Operand.t, |
| 271 | dst: Operand.t, |
| 272 | size: Size.t} -> t |
| 273 | val instruction_imul2 : {src: Operand.t, |
| 274 | dst: Operand.t, |
| 275 | size: Size.t} -> t |
| 276 | val instruction_unal : {oper: Instruction.unal, |
| 277 | dst: Operand.t, |
| 278 | size: Size.t} -> t |
| 279 | val instruction_sral : {oper: Instruction.sral, |
| 280 | count: Operand.t, |
| 281 | dst: Operand.t, |
| 282 | size: Size.t} -> t |
| 283 | val instruction_cmp : {src1: Operand.t, |
| 284 | src2: Operand.t, |
| 285 | size: Size.t} -> t |
| 286 | val instruction_test : {src1: Operand.t, |
| 287 | src2: Operand.t, |
| 288 | size: Size.t} -> t |
| 289 | val instruction_setcc : {condition: Instruction.condition, |
| 290 | dst: Operand.t, |
| 291 | size: Size.t} -> t |
| 292 | val instruction_jmp : {target: Operand.t, |
| 293 | absolute: bool} -> t |
| 294 | val instruction_jcc : {condition: Instruction.condition, |
| 295 | target: Operand.t} -> t |
| 296 | val instruction_call : {target: Operand.t, |
| 297 | absolute: bool} -> t |
| 298 | val instruction_ret : {src: Operand.t option} -> t |
| 299 | val instruction_mov : {src: Operand.t, |
| 300 | dst: Operand.t, |
| 301 | size: Size.t} -> t |
| 302 | val instruction_cmovcc : {condition: Instruction.condition, |
| 303 | src: Operand.t, |
| 304 | dst: Operand.t, |
| 305 | size: Size.t} -> t |
| 306 | val instruction_xchg : {src: Operand.t, |
| 307 | dst: Operand.t, |
| 308 | size: Size.t} -> t |
| 309 | val instruction_ppush : {src: Operand.t, |
| 310 | base: Operand.t, |
| 311 | size: Size.t} -> t |
| 312 | val instruction_ppop : {dst: Operand.t, |
| 313 | base: Operand.t, |
| 314 | size: Size.t} -> t |
| 315 | val instruction_movx : {oper: Instruction.movx, |
| 316 | src: Operand.t, |
| 317 | srcsize: Size.t, |
| 318 | dst: Operand.t, |
| 319 | dstsize: Size.t} -> t |
| 320 | val instruction_xvom : {src: Operand.t, |
| 321 | srcsize: Size.t, |
| 322 | dst: Operand.t, |
| 323 | dstsize: Size.t} -> t |
| 324 | val instruction_lea : {src: Operand.t, |
| 325 | dst: Operand.t, |
| 326 | size: Size.t} -> t |
| 327 | val instruction_sse_binas : {oper: Instruction.sse_binas, |
| 328 | src: Operand.t, |
| 329 | dst: Operand.t, |
| 330 | size: Size.t} -> t |
| 331 | val instruction_sse_unas : {oper: Instruction.sse_unas, |
| 332 | src: Operand.t, |
| 333 | dst: Operand.t, |
| 334 | size: Size.t} -> t |
| 335 | val instruction_sse_binlp : {oper: Instruction.sse_binlp, |
| 336 | src: Operand.t, |
| 337 | dst: Operand.t, |
| 338 | size: Size.t} -> t |
| 339 | val instruction_sse_movs : {src: Operand.t, |
| 340 | dst: Operand.t, |
| 341 | size: Size.t} -> t |
| 342 | val instruction_sse_comis : {src1: Operand.t, |
| 343 | src2: Operand.t, |
| 344 | size: Size.t} -> t |
| 345 | val instruction_sse_ucomis : {src1: Operand.t, |
| 346 | src2: Operand.t, |
| 347 | size: Size.t} -> t |
| 348 | val instruction_sse_cvtsfp2sfp : {src: Operand.t, |
| 349 | srcsize: Size.t, |
| 350 | dst: Operand.t, |
| 351 | dstsize: Size.t} -> t |
| 352 | val instruction_sse_cvtsfp2si : {src: Operand.t, |
| 353 | srcsize: Size.t, |
| 354 | dst: Operand.t, |
| 355 | dstsize: Size.t} -> t |
| 356 | val instruction_sse_cvtsi2sfp : {src: Operand.t, |
| 357 | srcsize: Size.t, |
| 358 | dst: Operand.t, |
| 359 | dstsize: Size.t} -> t |
| 360 | val instruction_sse_movd : {src: Operand.t, |
| 361 | srcsize: Size.t, |
| 362 | dst: Operand.t, |
| 363 | dstsize: Size.t} -> t |
| 364 | end |
| 365 | |
| 366 | structure FrameInfo: |
| 367 | sig |
| 368 | datatype t = T of {size: int, |
| 369 | frameLayoutsIndex: int} |
| 370 | end |
| 371 | |
| 372 | structure Entry: |
| 373 | sig |
| 374 | type t |
| 375 | |
| 376 | val cont: {label: Label.t, |
| 377 | live: MemLocSet.t, |
| 378 | frameInfo: FrameInfo.t} -> t |
| 379 | val creturn: {dsts: (Operand.t * Size.t) vector, |
| 380 | frameInfo: FrameInfo.t option, |
| 381 | func: RepType.t CFunction.t, |
| 382 | label: Label.t} -> t |
| 383 | val func: {label: Label.t, |
| 384 | live: MemLocSet.t} -> t |
| 385 | val handler: {frameInfo: FrameInfo.t, |
| 386 | label: Label.t, |
| 387 | live: MemLocSet.t} -> t |
| 388 | val jump: {label: Label.t} -> t |
| 389 | val label: t -> Label.t |
| 390 | end |
| 391 | |
| 392 | structure Transfer : |
| 393 | sig |
| 394 | structure Cases : |
| 395 | sig |
| 396 | type 'a t |
| 397 | |
| 398 | val word : (WordX.t * 'a) list -> 'a t |
| 399 | end |
| 400 | |
| 401 | type t |
| 402 | |
| 403 | val goto : {target: Label.t} -> t |
| 404 | val iff : {condition: Instruction.condition, |
| 405 | truee: Label.t, |
| 406 | falsee: Label.t} -> t |
| 407 | val switch : {test: Operand.t, |
| 408 | cases: Label.t Cases.t, |
| 409 | default: Label.t} -> t |
| 410 | val tail : {target: Label.t, |
| 411 | live: MemLocSet.t} -> t |
| 412 | val nontail : {target: Label.t, |
| 413 | live: MemLocSet.t, |
| 414 | return: Label.t, |
| 415 | handler: Label.t option, |
| 416 | size: int} -> t |
| 417 | val return : {live: MemLocSet.t} -> t |
| 418 | val raisee : {live: MemLocSet.t} -> t |
| 419 | val ccall : {args: (Operand.t * Size.t) list, |
| 420 | frameInfo: FrameInfo.t option, |
| 421 | func: RepType.t CFunction.t, |
| 422 | return: Label.t option} -> t |
| 423 | end |
| 424 | |
| 425 | structure ProfileLabel : |
| 426 | sig |
| 427 | type t |
| 428 | end |
| 429 | |
| 430 | structure Block : |
| 431 | sig |
| 432 | type t' |
| 433 | val mkBlock': {entry: Entry.t option, |
| 434 | statements: Assembly.t list, |
| 435 | transfer: Transfer.t option} -> t' |
| 436 | val mkProfileBlock': {profileLabel: ProfileLabel.t} -> t' |
| 437 | val printBlock' : t' -> unit |
| 438 | |
| 439 | type t |
| 440 | val printBlock : t -> unit |
| 441 | |
| 442 | val compress: t' list -> t list |
| 443 | end |
| 444 | |
| 445 | structure Chunk : |
| 446 | sig |
| 447 | datatype t = T of {data: Assembly.t list, blocks: Block.t list} |
| 448 | |
| 449 | end |
| 450 | end |
| 451 | |
| 452 | functor amd64PseudoCheck(structure S : AMD64) : AMD64_PSEUDO = S |