MachCode.lhs 104 KB
Newer Older
1
%
2
% (c) The AQUA Project, Glasgow University, 1996-1998
3 4 5 6 7 8 9 10 11
%
\section[MachCode]{Generating machine code}

This is a big module, but, if you pay attention to
(a) the sectioning, (b) the type signatures, and
(c) the \tr{#if blah_TARGET_ARCH} things, the
structure should not be too overwhelming.

\begin{code}
12
module MachCode ( stmt2Instrs, InstrBlock ) where
13

14 15 16 17 18
#include "HsVersions.h"
#include "nativeGen/NCG.h"

import MachMisc		-- may differ per-platform
import MachRegs
19 20
import OrdList		( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
			  snocOL, consOL, concatOL )
21
import AbsCUtils	( magicIdPrimRep )
sof's avatar
sof committed
22
import CallConv		( CallConv )
23
import CLabel		( isAsmTemp, CLabel, pprCLabel_asm, labelDynamic )
24 25
import Maybes		( maybeToBool, expectJust )
import PrimRep		( isFloatingRep, PrimRep(..) )
26
import PrimOp		( PrimOp(..) )
sof's avatar
sof committed
27
import CallConv		( cCallConv )
28
import Stix		( getNatLabelNCG, StixTree(..),
29
			  StixReg(..), CodeSegment(..), 
30
                          pprStixTree, ppStixReg,
31 32
                          NatM, thenNat, returnNat, mapNat, 
                          mapAndUnzipNat, mapAccumLNat,
33
                          getDeltaNat, setDeltaNat
34
			)
35
import Outputable
36
import CmdLineOpts	( opt_Static )
37

38 39
infixr 3 `bind`

40 41 42 43 44 45 46 47 48 49 50 51 52
\end{code}

@InstrBlock@s are the insn sequences generated by the insn selectors.
They are really trees of insns to facilitate fast appending, where a
left-to-right traversal (pre-order?) yields the insns in the correct
order.

\begin{code}

type InstrBlock = OrdList Instr

x `bind` f = f x

53 54 55 56 57
\end{code}

Code extractor for an entire stix tree---stix statement level.

\begin{code}
58
stmt2Instrs :: StixTree {- a stix statement -} -> NatM InstrBlock
59 60

stmt2Instrs stmt = case stmt of
61 62
    StComment s    -> returnNat (unitOL (COMMENT s))
    StSegment seg  -> returnNat (unitOL (SEGMENT seg))
63

64 65 66 67
    StFunBegin lab -> returnNat (unitOL (IF_ARCH_alpha(FUNBEGIN lab,
                                                       LABEL lab)))
    StFunEnd lab   -> IF_ARCH_alpha(returnNat (unitOL (FUNEND lab)),
                                    returnNat nilOL)
68

69
    StLabel lab	   -> returnNat (unitOL (LABEL lab))
70

71 72 73 74 75 76
    StJump arg		   -> genJump (derefDLL arg)
    StCondJump lab arg	   -> genCondJump lab (derefDLL arg)

    -- A call returning void, ie one done for its side-effects
    StCall fn cconv VoidRep args -> genCCall fn
                                             cconv VoidRep (map derefDLL args)
77 78

    StAssign pk dst src
79 80
      | isFloatingRep pk -> assignFltCode pk (derefDLL dst) (derefDLL src)
      | otherwise	 -> assignIntCode pk (derefDLL dst) (derefDLL src)
81 82 83 84 85

    StFallThrough lbl
	-- When falling through on the Alpha, we still have to load pv
	-- with the address of the next routine, so that it can load gp.
      -> IF_ARCH_alpha(returnInstr (LDA pv (AddrImm (ImmCLbl lbl)))
86
	,returnNat nilOL)
87 88

    StData kind args
89 90 91
      -> mapAndUnzipNat getData args `thenNat` \ (codes, imms) ->
	 returnNat (DATA (primRepToSize kind) imms  
                    `consOL`  concatOL codes)
92
      where
93
	getData :: StixTree -> NatM (InstrBlock, Imm)
94

95 96
	getData (StInt i)        = returnNat (nilOL, ImmInteger i)
	getData (StDouble d)     = returnNat (nilOL, ImmDouble d)
97
	getData (StFloat d)      = returnNat (nilOL, ImmFloat d)
98 99
	getData (StCLbl l)       = returnNat (nilOL, ImmCLbl l)
	getData (StString s)     =
100 101 102 103
	    getNatLabelNCG 	    	    `thenNat` \ lbl ->
	    returnNat (toOL [LABEL lbl,
			     ASCII True (_UNPK_ s)],
                       ImmCLbl lbl)
104 105
	-- the linker can handle simple arithmetic...
	getData (StIndex rep (StCLbl lbl) (StInt off)) =
106 107
		returnNat (nilOL, 
                           ImmIndex lbl (fromInteger (off * sizeOf rep)))
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130

-- Walk a Stix tree, and insert dereferences to CLabels which are marked
-- as labelDynamic.  stmt2Instrs calls derefDLL selectively, because
-- not all such CLabel occurrences need this dereferencing -- SRTs don't
-- for one.
derefDLL :: StixTree -> StixTree
derefDLL tree
   | opt_Static   -- short out the entire deal if not doing DLLs
   = tree
   | otherwise
   = qq tree
     where
        qq t
           = case t of
                StCLbl lbl -> if   labelDynamic lbl
                              then StInd PtrRep (StCLbl lbl)
                              else t
                -- all the rest are boring
                StIndex pk base offset -> StIndex pk (qq base) (qq offset)
                StPrim pk args         -> StPrim pk (map qq args)
                StInd pk addr          -> StInd pk (qq addr)
                StCall who cc pk args  -> StCall who cc pk (map qq args)
                StInt    _             -> t
131
                StFloat  _             -> t
132 133 134 135 136 137
                StDouble _             -> t
                StString _             -> t
                StReg    _             -> t
                StScratchWord _        -> t
                _                      -> pprPanic "derefDLL: unhandled case" 
                                                   (pprStixTree t)
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
\end{code}

%************************************************************************
%*									*
\subsection{General things for putting together code sequences}
%*									*
%************************************************************************

\begin{code}
mangleIndexTree :: StixTree -> StixTree

mangleIndexTree (StIndex pk base (StInt i))
  = StPrim IntAddOp [base, off]
  where
    off = StInt (i * sizeOf pk)

mangleIndexTree (StIndex pk base off)
155 156 157 158 159 160
  = StPrim IntAddOp [
       base,
       let s = shift pk
       in  ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
           if s == 0 then off else StPrim SllOp [off, StInt s]
      ]
161
  where
sof's avatar
sof committed
162
    shift DoubleRep 	= 3::Integer
163
    shift CharRep       = 0::Integer
164 165 166 167 168 169
    shift _ 	       	= IF_ARCH_alpha(3,2)
\end{code}

\begin{code}
maybeImm :: StixTree -> Maybe Imm

170 171 172 173
maybeImm (StCLbl l)       
   = Just (ImmCLbl l)
maybeImm (StIndex rep (StCLbl l) (StInt off)) 
   = Just (ImmIndex l (fromInteger (off * sizeOf rep)))
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
maybeImm (StInt i)
  | i >= toInteger minInt && i <= toInteger maxInt
  = Just (ImmInt (fromInteger i))
  | otherwise
  = Just (ImmInteger i)

maybeImm _ = Nothing
\end{code}

%************************************************************************
%*									*
\subsection{The @Register@ type}
%*									*
%************************************************************************

@Register@s passed up the tree.  If the stix code forces the register
to live in a pre-decided machine register, it comes out as @Fixed@;
otherwise, it comes out as @Any@, and the parent can decide which
register to put it in.

\begin{code}
data Register
  = Fixed   PrimRep Reg InstrBlock
  | Any	    PrimRep (Reg -> InstrBlock)

registerCode :: Register -> Reg -> InstrBlock
registerCode (Fixed _ _ code) reg = code
registerCode (Any _ code) reg = code reg

203 204 205
registerCodeF (Fixed _ _ code) = code
registerCodeF (Any _ _)        = pprPanic "registerCodeF" empty

206 207 208
registerCodeA (Any _ code)  = code
registerCodeA (Fixed _ _ _) = pprPanic "registerCodeA" empty

209 210
registerName :: Register -> Reg -> Reg
registerName (Fixed _ reg _) _ = reg
211 212 213 214
registerName (Any _ _)   reg   = reg

registerNameF (Fixed _ reg _) = reg
registerNameF (Any _ _)       = pprPanic "registerNameF" empty
215 216 217 218 219

registerRep :: Register -> PrimRep
registerRep (Fixed pk _ _) = pk
registerRep (Any   pk _) = pk

220 221 222 223 224 225 226 227 228
{-# INLINE registerCode  #-}
{-# INLINE registerCodeF #-}
{-# INLINE registerName  #-}
{-# INLINE registerNameF #-}
{-# INLINE registerRep   #-}
{-# INLINE isFixed       #-}
{-# INLINE isAny         #-}

isFixed, isAny :: Register -> Bool
229 230
isFixed (Fixed _ _ _) = True
isFixed (Any _ _)     = False
231

232
isAny = not . isFixed
233 234 235 236
\end{code}

Generate code to get a subtree into a @Register@:
\begin{code}
237
getRegister :: StixTree -> NatM Register
238 239 240

getRegister (StReg (StixMagicId stgreg))
  = case (magicIdRegMaybe stgreg) of
241
      Just reg -> returnNat (Fixed (magicIdPrimRep stgreg) reg nilOL)
242
                  -- cannae be Nothing
243 244

getRegister (StReg (StixTemp u pk))
245
  = returnNat (Fixed pk (mkVReg u pk) nilOL)
246 247 248

getRegister tree@(StIndex _ _ _) = getRegister (mangleIndexTree tree)

sof's avatar
sof committed
249
getRegister (StCall fn cconv kind args)
250 251
  = genCCall fn cconv kind args   	    `thenNat` \ call ->
    returnNat (Fixed kind reg call)
252 253
  where
    reg = if isFloatingRep kind
254
	  then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0,)))
255 256 257
	  else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0,)))

getRegister (StString s)
258
  = getNatLabelNCG 	    	    `thenNat` \ lbl ->
259 260 261
    let
	imm_lbl = ImmCLbl lbl

262
	code dst = toOL [
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
	    SEGMENT DataSegment,
	    LABEL lbl,
	    ASCII True (_UNPK_ s),
	    SEGMENT TextSegment,
#if alpha_TARGET_ARCH
	    LDA dst (AddrImm imm_lbl)
#endif
#if i386_TARGET_ARCH
	    MOV L (OpImm imm_lbl) (OpReg dst)
#endif
#if sparc_TARGET_ARCH
	    SETHI (HI imm_lbl) dst,
	    OR False dst (RIImm (LO imm_lbl)) dst
#endif
	    ]
    in
279
    returnNat (Any PtrRep code)
280 281 282 283 284 285 286 287



-- end of machine-"independent" bit; here we go on the rest...

#if alpha_TARGET_ARCH

getRegister (StDouble d)
288 289
  = getNatLabelNCG 	    	    `thenNat` \ lbl ->
    getNewRegNCG PtrRep    	    `thenNat` \ tmp ->
290 291 292
    let code dst = mkSeqInstrs [
    	    SEGMENT DataSegment,
	    LABEL lbl,
sof's avatar
sof committed
293
	    DATA TF [ImmLab (rational d)],
294 295 296 297
	    SEGMENT TextSegment,
	    LDA tmp (AddrImm (ImmCLbl lbl)),
	    LD TF dst (AddrReg tmp)]
    in
298
    	returnNat (Any DoubleRep code)
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319

getRegister (StPrim primop [x]) -- unary PrimOps
  = case primop of
      IntNegOp -> trivialUCode (NEG Q False) x

      NotOp    -> trivialUCode NOT x

      FloatNegOp  -> trivialUFCode FloatRep  (FNEG TF) x
      DoubleNegOp -> trivialUFCode DoubleRep (FNEG TF) x

      OrdOp -> coerceIntCode IntRep x
      ChrOp -> chrCode x

      Float2IntOp  -> coerceFP2Int    x
      Int2FloatOp  -> coerceInt2FP pr x
      Double2IntOp -> coerceFP2Int    x
      Int2DoubleOp -> coerceInt2FP pr x

      Double2FloatOp -> coerceFltCode x
      Float2DoubleOp -> coerceFltCode x

sof's avatar
sof committed
320
      other_op -> getRegister (StCall fn cCallConv DoubleRep [x])
321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351
	where
	  fn = case other_op of
		 FloatExpOp    -> SLIT("exp")
		 FloatLogOp    -> SLIT("log")
		 FloatSqrtOp   -> SLIT("sqrt")
		 FloatSinOp    -> SLIT("sin")
		 FloatCosOp    -> SLIT("cos")
		 FloatTanOp    -> SLIT("tan")
		 FloatAsinOp   -> SLIT("asin")
		 FloatAcosOp   -> SLIT("acos")
		 FloatAtanOp   -> SLIT("atan")
		 FloatSinhOp   -> SLIT("sinh")
		 FloatCoshOp   -> SLIT("cosh")
		 FloatTanhOp   -> SLIT("tanh")
		 DoubleExpOp   -> SLIT("exp")
		 DoubleLogOp   -> SLIT("log")
		 DoubleSqrtOp  -> SLIT("sqrt")
		 DoubleSinOp   -> SLIT("sin")
		 DoubleCosOp   -> SLIT("cos")
		 DoubleTanOp   -> SLIT("tan")
		 DoubleAsinOp  -> SLIT("asin")
		 DoubleAcosOp  -> SLIT("acos")
		 DoubleAtanOp  -> SLIT("atan")
		 DoubleSinhOp  -> SLIT("sinh")
		 DoubleCoshOp  -> SLIT("cosh")
		 DoubleTanhOp  -> SLIT("tanh")
  where
    pr = panic "MachCode.getRegister: no primrep needed for Alpha"

getRegister (StPrim primop [x, y]) -- dyadic PrimOps
  = case primop of
352
      CharGtOp -> trivialCode (CMP LTT) y x
353
      CharGeOp -> trivialCode (CMP LE) y x
354
      CharEqOp -> trivialCode (CMP EQQ) x y
355
      CharNeOp -> int_NE_code x y
356
      CharLtOp -> trivialCode (CMP LTT) x y
357 358
      CharLeOp -> trivialCode (CMP LE) x y

359
      IntGtOp  -> trivialCode (CMP LTT) y x
360
      IntGeOp  -> trivialCode (CMP LE) y x
361
      IntEqOp  -> trivialCode (CMP EQQ) x y
362
      IntNeOp  -> int_NE_code x y
363
      IntLtOp  -> trivialCode (CMP LTT) x y
364 365 366 367
      IntLeOp  -> trivialCode (CMP LE) x y

      WordGtOp -> trivialCode (CMP ULT) y x
      WordGeOp -> trivialCode (CMP ULE) x y
368
      WordEqOp -> trivialCode (CMP EQQ)  x y
369 370 371 372 373 374
      WordNeOp -> int_NE_code x y
      WordLtOp -> trivialCode (CMP ULT) x y
      WordLeOp -> trivialCode (CMP ULE) x y

      AddrGtOp -> trivialCode (CMP ULT) y x
      AddrGeOp -> trivialCode (CMP ULE) y x
375
      AddrEqOp -> trivialCode (CMP EQQ)  x y
376 377 378 379
      AddrNeOp -> int_NE_code x y
      AddrLtOp -> trivialCode (CMP ULT) x y
      AddrLeOp -> trivialCode (CMP ULE) x y

380 381 382 383 384
      FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
      FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
      FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
      FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
      FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
385 386
      FloatLeOp -> cmpF_code (FCMP TF LE) NE x y

387 388 389 390 391
      DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
      DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
      DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
      DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
      DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
392 393 394 395 396 397 398 399
      DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y

      IntAddOp  -> trivialCode (ADD Q False) x y
      IntSubOp  -> trivialCode (SUB Q False) x y
      IntMulOp  -> trivialCode (MUL Q False) x y
      IntQuotOp -> trivialCode (DIV Q False) x y
      IntRemOp  -> trivialCode (REM Q False) x y

400 401 402
      WordQuotOp -> trivialCode (DIV Q True) x y
      WordRemOp  -> trivialCode (REM Q True) x y

403 404 405 406 407 408 409 410 411 412 413 414
      FloatAddOp -> trivialFCode  FloatRep (FADD TF) x y
      FloatSubOp -> trivialFCode  FloatRep (FSUB TF) x y
      FloatMulOp -> trivialFCode  FloatRep (FMUL TF) x y
      FloatDivOp -> trivialFCode  FloatRep (FDIV TF) x y

      DoubleAddOp -> trivialFCode  DoubleRep (FADD TF) x y
      DoubleSubOp -> trivialFCode  DoubleRep (FSUB TF) x y
      DoubleMulOp -> trivialFCode  DoubleRep (FMUL TF) x y
      DoubleDivOp -> trivialFCode  DoubleRep (FDIV TF) x y

      AndOp  -> trivialCode AND x y
      OrOp   -> trivialCode OR  x y
415
      XorOp  -> trivialCode XOR x y
416 417 418
      SllOp  -> trivialCode SLL x y
      SrlOp  -> trivialCode SRL x y

sof's avatar
sof committed
419
      ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
sof's avatar
sof committed
420
      ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
sof's avatar
sof committed
421
      ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
422

sof's avatar
sof committed
423 424
      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
425 426 427 428 429 430 431 432 433
  where
    {- ------------------------------------------------------------
	Some bizarre special code for getting condition codes into
	registers.  Integer non-equality is a test for equality
	followed by an XOR with 1.  (Integer comparisons always set
	the result register to 0 or 1.)  Floating point comparisons of
	any kind leave the result in a floating point register, so we
	need to wrangle an integer register out of things.
    -}
434
    int_NE_code :: StixTree -> StixTree -> NatM Register
435 436

    int_NE_code x y
437 438
      = trivialCode (CMP EQQ) x y	`thenNat` \ register ->
	getNewRegNCG IntRep		`thenNat` \ tmp ->
439 440 441 442 443
	let
	    code = registerCode register tmp
	    src  = registerName register tmp
	    code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
	in
444
	returnNat (Any IntRep code__2)
445 446 447 448 449 450 451 452

    {- ------------------------------------------------------------
	Comments for int_NE_code also apply to cmpF_code
    -}
    cmpF_code
	:: (Reg -> Reg -> Reg -> Instr)
	-> Cond
	-> StixTree -> StixTree
453
	-> NatM Register
454 455

    cmpF_code instr cond x y
456 457 458
      = trivialFCode pr instr x y	`thenNat` \ register ->
	getNewRegNCG DoubleRep		`thenNat` \ tmp ->
	getNatLabelNCG			`thenNat` \ lbl ->
459 460 461 462 463
	let
	    code = registerCode register tmp
	    result  = registerName register tmp

	    code__2 dst = code . mkSeqInstrs [
464 465 466
		OR zeroh (RIImm (ImmInt 1)) dst,
		BF cond  result (ImmCLbl lbl),
		OR zeroh (RIReg zeroh) dst,
467 468
		LABEL lbl]
	in
469
	returnNat (Any IntRep code__2)
470 471 472 473 474
      where
	pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
      ------------------------------------------------------------

getRegister (StInd pk mem)
475
  = getAmode mem    	    	    `thenNat` \ amode ->
476 477 478 479 480 481
    let
    	code = amodeCode amode
    	src   = amodeAddr amode
    	size = primRepToSize pk
    	code__2 dst = code . mkSeqInstr (LD size dst src)
    in
482
    returnNat (Any pk code__2)
483 484 485 486

getRegister (StInt i)
  | fits8Bits i
  = let
487
    	code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
488
    in
489
    returnNat (Any IntRep code)
490 491 492 493
  | otherwise
  = let
    	code dst = mkSeqInstr (LDI Q dst src)
    in
494
    returnNat (Any IntRep code)
495 496 497 498 499 500 501 502
  where
    src = ImmInt (fromInteger i)

getRegister leaf
  | maybeToBool imm
  = let
    	code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
    in
503
    returnNat (Any PtrRep code)
504 505 506 507 508 509 510 511 512
  where
    imm = maybeImm leaf
    imm__2 = case imm of Just x -> x

#endif {- alpha_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH

getRegister (StDouble d)
513 514 515

  | d == 0.0
  = let code dst = unitOL (GLDZ dst)
516
    in  returnNat (Any DoubleRep code)
517 518 519

  | d == 1.0
  = let code dst = unitOL (GLD1 dst)
520
    in  returnNat (Any DoubleRep code)
521 522 523 524

  | otherwise
  = getNatLabelNCG 	    	    `thenNat` \ lbl ->
    let code dst = toOL [
525 526
    	    SEGMENT DataSegment,
	    LABEL lbl,
527
	    DATA DF [ImmDouble d],
528
	    SEGMENT TextSegment,
529
	    GLD DF (ImmAddr (ImmCLbl lbl) 0) dst
530 531
	    ]
    in
532
    returnNat (Any DoubleRep code)
533

534 535
-- Calculate the offset for (i+1) words above the _initial_
-- %esp value by first determining the current offset of it.
536
getRegister (StScratchWord i)
537
   | i >= 0 && i < 6
538 539 540 541 542 543
   = getDeltaNat `thenNat` \ current_stack_offset ->
     let j = i+1   - (current_stack_offset `div` 4)
         code dst
           = unitOL (LEA L (OpAddr (spRel (j+1))) (OpReg dst))
     in 
     returnNat (Any PtrRep code)
544

545 546 547 548 549
getRegister (StPrim primop [x]) -- unary PrimOps
  = case primop of
      IntNegOp  -> trivialUCode (NEGI L) x
      NotOp	-> trivialUCode (NOT L) x

550 551 552 553 554
      FloatNegOp  -> trivialUFCode FloatRep  (GNEG F) x
      DoubleNegOp -> trivialUFCode DoubleRep (GNEG DF) x

      FloatSqrtOp  -> trivialUFCode FloatRep  (GSQRT F) x
      DoubleSqrtOp -> trivialUFCode DoubleRep (GSQRT DF) x
555

556 557 558 559 560 561 562 563 564
      FloatSinOp  -> trivialUFCode FloatRep  (GSIN F) x
      DoubleSinOp -> trivialUFCode DoubleRep (GSIN DF) x

      FloatCosOp  -> trivialUFCode FloatRep  (GCOS F) x
      DoubleCosOp -> trivialUFCode DoubleRep (GCOS DF) x

      FloatTanOp  -> trivialUFCode FloatRep  (GTAN F) x
      DoubleTanOp -> trivialUFCode DoubleRep (GTAN DF) x

565 566
      Double2FloatOp -> trivialUFCode FloatRep  GDTOF x
      Float2DoubleOp -> trivialUFCode DoubleRep GFTOD x
567 568 569 570 571 572 573 574 575 576 577

      OrdOp -> coerceIntCode IntRep x
      ChrOp -> chrCode x

      Float2IntOp  -> coerceFP2Int x
      Int2FloatOp  -> coerceInt2FP FloatRep x
      Double2IntOp -> coerceFP2Int x
      Int2DoubleOp -> coerceInt2FP DoubleRep x

      other_op ->
        let
578 579 580
	    fixed_x = if   is_float_op  -- promote to double
		      then StPrim Float2DoubleOp [x]
		      else x
581
	in
sof's avatar
sof committed
582
	getRegister (StCall fn cCallConv DoubleRep [x])
583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607
       where
	(is_float_op, fn)
	  = case primop of
	      FloatExpOp    -> (True,  SLIT("exp"))
	      FloatLogOp    -> (True,  SLIT("log"))

	      FloatAsinOp   -> (True,  SLIT("asin"))
	      FloatAcosOp   -> (True,  SLIT("acos"))
	      FloatAtanOp   -> (True,  SLIT("atan"))

	      FloatSinhOp   -> (True,  SLIT("sinh"))
	      FloatCoshOp   -> (True,  SLIT("cosh"))
	      FloatTanhOp   -> (True,  SLIT("tanh"))

	      DoubleExpOp   -> (False, SLIT("exp"))
	      DoubleLogOp   -> (False, SLIT("log"))

	      DoubleAsinOp  -> (False, SLIT("asin"))
	      DoubleAcosOp  -> (False, SLIT("acos"))
	      DoubleAtanOp  -> (False, SLIT("atan"))

	      DoubleSinhOp  -> (False, SLIT("sinh"))
	      DoubleCoshOp  -> (False, SLIT("cosh"))
	      DoubleTanhOp  -> (False, SLIT("tanh"))

608 609
              other
                 -> pprPanic "getRegister(x86,unary primop)" 
610
                             (pprStixTree (StPrim primop [x]))
611

612 613
getRegister (StPrim primop [x, y]) -- dyadic PrimOps
  = case primop of
614
      CharGtOp -> condIntReg GTT x y
615
      CharGeOp -> condIntReg GE x y
616
      CharEqOp -> condIntReg EQQ x y
617
      CharNeOp -> condIntReg NE x y
618
      CharLtOp -> condIntReg LTT x y
619 620
      CharLeOp -> condIntReg LE x y

621
      IntGtOp  -> condIntReg GTT x y
622
      IntGeOp  -> condIntReg GE x y
623
      IntEqOp  -> condIntReg EQQ x y
624
      IntNeOp  -> condIntReg NE x y
625
      IntLtOp  -> condIntReg LTT x y
626 627 628 629
      IntLeOp  -> condIntReg LE x y

      WordGtOp -> condIntReg GU  x y
      WordGeOp -> condIntReg GEU x y
630
      WordEqOp -> condIntReg EQQ  x y
631 632 633 634 635 636
      WordNeOp -> condIntReg NE  x y
      WordLtOp -> condIntReg LU  x y
      WordLeOp -> condIntReg LEU x y

      AddrGtOp -> condIntReg GU  x y
      AddrGeOp -> condIntReg GEU x y
637
      AddrEqOp -> condIntReg EQQ  x y
638 639 640 641
      AddrNeOp -> condIntReg NE  x y
      AddrLtOp -> condIntReg LU  x y
      AddrLeOp -> condIntReg LEU x y

642
      FloatGtOp -> condFltReg GTT x y
643
      FloatGeOp -> condFltReg GE x y
644
      FloatEqOp -> condFltReg EQQ x y
645
      FloatNeOp -> condFltReg NE x y
646
      FloatLtOp -> condFltReg LTT x y
647 648
      FloatLeOp -> condFltReg LE x y

649
      DoubleGtOp -> condFltReg GTT x y
650
      DoubleGeOp -> condFltReg GE x y
651
      DoubleEqOp -> condFltReg EQQ x y
652
      DoubleNeOp -> condFltReg NE x y
653
      DoubleLtOp -> condFltReg LTT x y
654 655
      DoubleLeOp -> condFltReg LE x y

656
      IntAddOp  -> add_code  L x y
657 658 659
      IntSubOp  -> sub_code  L x y
      IntQuotOp -> quot_code L x y True{-division-}
      IntRemOp  -> quot_code L x y False{-remainder-}
660
      IntMulOp  -> let op = IMUL L in trivialCode op (Just op) x y
661

662 663 664 665
      FloatAddOp -> trivialFCode  FloatRep  GADD x y
      FloatSubOp -> trivialFCode  FloatRep  GSUB x y
      FloatMulOp -> trivialFCode  FloatRep  GMUL x y
      FloatDivOp -> trivialFCode  FloatRep  GDIV x y
666

667 668 669 670
      DoubleAddOp -> trivialFCode DoubleRep GADD x y
      DoubleSubOp -> trivialFCode DoubleRep GSUB x y
      DoubleMulOp -> trivialFCode DoubleRep GMUL x y
      DoubleDivOp -> trivialFCode DoubleRep GDIV x y
671

672 673 674
      AndOp -> let op = AND L in trivialCode op (Just op) x y
      OrOp  -> let op = OR  L in trivialCode op (Just op) x y
      XorOp -> let op = XOR L in trivialCode op (Just op) x y
675

sof's avatar
sof committed
676 677 678 679 680
	{- Shift ops on x86s have constraints on their source, it
	   either has to be Imm, CL or 1
	    => trivialCode's is not restrictive enough (sigh.)
	-}
	   
681 682
      SllOp  -> shift_code (SHL L) x y {-False-}
      SrlOp  -> shift_code (SHR L) x y {-False-}
683 684 685
      ISllOp -> shift_code (SHL L) x y {-False-}
      ISraOp -> shift_code (SAR L) x y {-False-}
      ISrlOp -> shift_code (SHR L) x y {-False-}
686

687 688
      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
                                           [promote x, promote y])
689
		       where promote x = StPrim Float2DoubleOp [x]
690 691
      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
                                           [x, y])
692 693
      other
         -> pprPanic "getRegister(x86,dyadic primop)" 
694
                     (pprStixTree (StPrim primop [x, y]))
695
  where
696 697

    --------------------
698
    shift_code :: (Imm -> Operand -> Instr)
sof's avatar
sof committed
699 700
	       -> StixTree
	       -> StixTree
701
	       -> NatM Register
702

sof's avatar
sof committed
703 704 705 706
      {- Case1: shift length as immediate -}
      -- Code is the same as the first eq. for trivialCode -- sigh.
    shift_code instr x y{-amount-}
      | maybeToBool imm
707
      = getRegister x	                   `thenNat` \ regx ->
708
        let mkcode dst
709 710 711 712
              = if   isAny regx
                then registerCodeA regx dst  `bind` \ code_x ->
                     code_x `snocOL`
                     instr imm__2 (OpReg dst)
713 714
                else registerCodeF regx      `bind` \ code_x ->
                     registerNameF regx      `bind` \ r_x ->
715 716 717
                     code_x `snocOL`
                     MOV L (OpReg r_x) (OpReg dst) `snocOL`
                     instr imm__2 (OpReg dst)
718
        in
719
        returnNat (Any IntRep mkcode)        
sof's avatar
sof committed
720 721 722 723 724
      where
       imm = maybeImm y
       imm__2 = case imm of Just x -> x

      {- Case2: shift length is complex (non-immediate) -}
725 726 727 728
      -- Since ECX is always used as a spill temporary, we can't
      -- use it here to do non-immediate shifts.  No big deal --
      -- they are only very rare, and we can use an equivalent
      -- test-and-jump sequence which doesn't use ECX.
729
      -- DO NOT REPLACE THIS CODE WITH THE "OBVIOUS" shl/shr/sar CODE, 
730
      -- SINCE IT WILL CAUSE SERIOUS PROBLEMS WITH THE SPILLER
sof's avatar
sof committed
731
    shift_code instr x y{-amount-}
732 733 734 735 736 737 738 739
     = getRegister x   `thenNat` \ register1 ->
       getRegister y   `thenNat` \ register2 ->
       getNatLabelNCG  `thenNat` \ lbl_test3 ->
       getNatLabelNCG  `thenNat` \ lbl_test2 ->
       getNatLabelNCG  `thenNat` \ lbl_test1 ->
       getNatLabelNCG  `thenNat` \ lbl_test0 ->
       getNatLabelNCG  `thenNat` \ lbl_after ->
       getNewRegNCG IntRep   `thenNat` \ tmp ->
740 741 742 743 744 745 746 747
       let code__2 dst
              = let src_val  = registerName register1 dst
                    code_val = registerCode register1 dst
                    src_amt  = registerName register2 tmp
                    code_amt = registerCode register2 tmp
                    r_dst    = OpReg dst
                    r_tmp    = OpReg tmp
                in
748 749 750 751 752
                    code_amt `snocOL`
                    MOV L (OpReg src_amt) r_tmp `appOL`
                    code_val `snocOL`
                    MOV L (OpReg src_val) r_dst `appOL`
                    toOL [
753 754 755 756 757 758
                       COMMENT (_PK_ "begin shift sequence"),
                       MOV L (OpReg src_val) r_dst,
                       MOV L (OpReg src_amt) r_tmp,

                       BT L (ImmInt 4) r_tmp,
                       JXX GEU lbl_test3,
759
                       instr (ImmInt 16) r_dst,
760 761 762 763

                       LABEL lbl_test3,
                       BT L (ImmInt 3) r_tmp,
                       JXX GEU lbl_test2,
764
                       instr (ImmInt 8) r_dst,
765 766 767 768

                       LABEL lbl_test2,
                       BT L (ImmInt 2) r_tmp,
                       JXX GEU lbl_test1,
769
                       instr (ImmInt 4) r_dst,
770 771 772 773

                       LABEL lbl_test1,
                       BT L (ImmInt 1) r_tmp,
                       JXX GEU lbl_test0,
774
                       instr (ImmInt 2) r_dst,
775 776 777 778

                       LABEL lbl_test0,
                       BT L (ImmInt 0) r_tmp,
                       JXX GEU lbl_after,
779
                       instr (ImmInt 1) r_dst,
780 781 782 783 784
                       LABEL lbl_after,
                                           
                       COMMENT (_PK_ "end shift sequence")
                    ]
       in
785
       returnNat (Any IntRep code__2)
786

787
    --------------------
788
    add_code :: Size -> StixTree -> StixTree -> NatM Register
789 790

    add_code sz x (StInt y)
791 792
      = getRegister x		`thenNat` \ register ->
	getNewRegNCG IntRep	`thenNat` \ tmp ->
793 794 795 796
	let
	    code = registerCode register tmp
	    src1 = registerName register tmp
	    src2 = ImmInt (fromInteger y)
797
	    code__2 dst 
798 799 800
               = code `snocOL`
		 LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
                        (OpReg dst)
801
	in
802
	returnNat (Any IntRep code__2)
803

804
    add_code sz x y = trivialCode (ADD sz) (Just (ADD sz)) x y
805 806

    --------------------
807
    sub_code :: Size -> StixTree -> StixTree -> NatM Register
808 809

    sub_code sz x (StInt y)
810 811
      = getRegister x		`thenNat` \ register ->
	getNewRegNCG IntRep	`thenNat` \ tmp ->
812 813 814 815
	let
	    code = registerCode register tmp
	    src1 = registerName register tmp
	    src2 = ImmInt (-(fromInteger y))
816
	    code__2 dst 
817 818 819
               = code `snocOL`
		 LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
                        (OpReg dst)
820
	in
821
	returnNat (Any IntRep code__2)
822

823
    sub_code sz x y = trivialCode (SUB sz) Nothing x y
824 825 826 827 828 829

    --------------------
    quot_code
	:: Size
	-> StixTree -> StixTree
	-> Bool -- True => division, False => remainder operation
830
	-> NatM Register
831 832 833

    -- x must go into eax, edx must be a sign-extension of eax, and y
    -- should go in some other register (or memory), so that we get
834 835 836
    -- edx:eax / reg -> eax (remainder in edx).  Currently we choose
    -- to put y on the C stack, since that avoids tying up yet another
    -- precious register.
837 838

    quot_code sz x y is_division
839 840 841 842
      = getRegister x		`thenNat` \ register1 ->
	getRegister y		`thenNat` \ register2 ->
	getNewRegNCG IntRep	`thenNat` \ tmp ->
        getDeltaNat             `thenNat` \ delta ->
843
	let
844 845 846 847 848 849 850 851 852 853 854 855 856
	    code1   = registerCode register1 tmp
	    src1    = registerName register1 tmp
	    code2   = registerCode register2 tmp
	    src2    = registerName register2 tmp
	    code__2 = code2               `snocOL`      --       src2 := y
                      PUSH L (OpReg src2) `snocOL`      --   -4(%esp) := y
                      DELTA (delta-4)     `appOL`
                      code1               `snocOL`      --       src1 := x
                      MOV L (OpReg src1) (OpReg eax) `snocOL`  -- eax := x
                      CLTD                           `snocOL`
                      IDIV sz (OpAddr (spRel 0))     `snocOL`
                      ADD L (OpImm (ImmInt 4)) (OpReg esp) `snocOL`
                      DELTA delta
857
	in
858
	returnNat (Fixed IntRep (if is_division then eax else edx) code__2)
859 860 861
	-----------------------

getRegister (StInd pk mem)
862
  = getAmode mem    	    	    `thenNat` \ amode ->
863 864
    let
    	code = amodeCode amode
865
    	src  = amodeAddr amode
866
    	size = primRepToSize pk
867 868 869 870 871 872
    	code__2 dst = code `snocOL`
		      if   pk == DoubleRep || pk == FloatRep
		      then GLD size src dst
		      else case size of
                             L -> MOV L    (OpAddr src) (OpReg dst)
                             B -> MOVZxL B (OpAddr src) (OpReg dst)
873
    in
874
    	returnNat (Any pk code__2)
875 876 877 878

getRegister (StInt i)
  = let
    	src = ImmInt (fromInteger i)
879 880 881 882 883
    	code dst 
           | i == 0
           = unitOL (XOR L (OpReg dst) (OpReg dst))
           | otherwise
           = unitOL (MOV L (OpImm src) (OpReg dst))
884
    in
885
    	returnNat (Any IntRep code)
886 887 888

getRegister leaf
  | maybeToBool imm
889
  = let code dst = unitOL (MOV L (OpImm imm__2) (OpReg dst))
890
    in
891
    	returnNat (Any PtrRep code)
892
  | otherwise
893
  = pprPanic "getRegister(x86)" (pprStixTree leaf)
894 895 896 897 898 899 900 901
  where
    imm = maybeImm leaf
    imm__2 = case imm of Just x -> x

#endif {- i386_TARGET_ARCH -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if sparc_TARGET_ARCH

902 903 904 905 906 907 908 909 910 911 912 913 914
getRegister (StFloat d)
  = getNatLabelNCG 	    	    `thenNat` \ lbl ->
    getNewRegNCG PtrRep    	    `thenNat` \ tmp ->
    let code dst = toOL [
    	    SEGMENT DataSegment,
	    LABEL lbl,
	    DATA F [ImmFloat d],
	    SEGMENT TextSegment,
	    SETHI (HI (ImmCLbl lbl)) tmp,
	    LD F (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
    in
    	returnNat (Any FloatRep code)

915
getRegister (StDouble d)
916 917
  = getNatLabelNCG 	    	    `thenNat` \ lbl ->
    getNewRegNCG PtrRep    	    `thenNat` \ tmp ->
918
    let code dst = toOL [
919 920
    	    SEGMENT DataSegment,
	    LABEL lbl,
921
	    DATA DF [ImmDouble d],
922 923
	    SEGMENT TextSegment,
	    SETHI (HI (ImmCLbl lbl)) tmp,
sof's avatar
sof committed
924
	    LD DF (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
925
    in
926
    	returnNat (Any DoubleRep code)
927

928 929 930 931 932 933 934 935 936 937
-- The 6-word scratch area is immediately below the frame pointer.
-- Below that is the spill area.
getRegister (StScratchWord i)
   | i >= 0 && i < 6
   = let j        = i+1
         code dst = unitOL (fpRelEA j dst)
     in 
     returnNat (Any PtrRep code)


938 939
getRegister (StPrim primop [x]) -- unary PrimOps
  = case primop of
940 941
      IntNegOp       -> trivialUCode (SUB False False g0) x
      NotOp          -> trivialUCode (XNOR False g0) x
942

943 944
      FloatNegOp     -> trivialUFCode FloatRep (FNEG F) x
      DoubleNegOp    -> trivialUFCode DoubleRep (FNEG DF) x
945 946 947 948

      Double2FloatOp -> trivialUFCode FloatRep  (FxTOy DF F) x
      Float2DoubleOp -> trivialUFCode DoubleRep (FxTOy F DF) x

949 950
      OrdOp          -> coerceIntCode IntRep x
      ChrOp          -> chrCode x
951

952 953 954 955
      Float2IntOp    -> coerceFP2Int x
      Int2FloatOp    -> coerceInt2FP FloatRep x
      Double2IntOp   -> coerceFP2Int x
      Int2DoubleOp   -> coerceInt2FP DoubleRep x
956 957 958

      other_op ->
        let
959 960 961
           fixed_x = if   is_float_op  -- promote to double
                     then StPrim Float2DoubleOp [x]
                     else x
962
	in
963
	getRegister (StCall fn cCallConv DoubleRep [fixed_x])
964 965 966 967 968
       where
	(is_float_op, fn)
	  = case primop of
	      FloatExpOp    -> (True,  SLIT("exp"))
	      FloatLogOp    -> (True,  SLIT("log"))
sof's avatar
sof committed
969
	      FloatSqrtOp   -> (True,  SLIT("sqrt"))
970 971 972 973 974 975 976 977 978 979 980 981 982 983 984

	      FloatSinOp    -> (True,  SLIT("sin"))
	      FloatCosOp    -> (True,  SLIT("cos"))
	      FloatTanOp    -> (True,  SLIT("tan"))

	      FloatAsinOp   -> (True,  SLIT("asin"))
	      FloatAcosOp   -> (True,  SLIT("acos"))
	      FloatAtanOp   -> (True,  SLIT("atan"))

	      FloatSinhOp   -> (True,  SLIT("sinh"))
	      FloatCoshOp   -> (True,  SLIT("cosh"))
	      FloatTanhOp   -> (True,  SLIT("tanh"))

	      DoubleExpOp   -> (False, SLIT("exp"))
	      DoubleLogOp   -> (False, SLIT("log"))
985
	      DoubleSqrtOp  -> (False, SLIT("sqrt"))
986 987 988 989 990 991 992 993 994 995 996 997

	      DoubleSinOp   -> (False, SLIT("sin"))
	      DoubleCosOp   -> (False, SLIT("cos"))
	      DoubleTanOp   -> (False, SLIT("tan"))

	      DoubleAsinOp  -> (False, SLIT("asin"))
	      DoubleAcosOp  -> (False, SLIT("acos"))
	      DoubleAtanOp  -> (False, SLIT("atan"))

	      DoubleSinhOp  -> (False, SLIT("sinh"))
	      DoubleCoshOp  -> (False, SLIT("cosh"))
	      DoubleTanhOp  -> (False, SLIT("tanh"))
998 999 1000 1001

              other
                 -> pprPanic "getRegister(sparc,monadicprimop)" 
                             (pprStixTree (StPrim primop [x]))
1002 1003 1004

getRegister (StPrim primop [x, y]) -- dyadic PrimOps
  = case primop of
1005
      CharGtOp -> condIntReg GTT x y
1006
      CharGeOp -> condIntReg GE x y
1007
      CharEqOp -> condIntReg EQQ x y
1008
      CharNeOp -> condIntReg NE x y
1009
      CharLtOp -> condIntReg LTT x y
1010 1011
      CharLeOp -> condIntReg LE x y

1012
      IntGtOp  -> condIntReg GTT x y
1013
      IntGeOp  -> condIntReg GE x y
1014
      IntEqOp  -> condIntReg EQQ x y
1015
      IntNeOp  -> condIntReg NE x y
1016
      IntLtOp  -> condIntReg LTT x y
1017 1018 1019 1020
      IntLeOp  -> condIntReg LE x y

      WordGtOp -> condIntReg GU  x y
      WordGeOp -> condIntReg GEU x y
1021
      WordEqOp -> condIntReg EQQ  x y
1022 1023 1024 1025 1026 1027
      WordNeOp -> condIntReg NE  x y
      WordLtOp -> condIntReg LU  x y
      WordLeOp -> condIntReg LEU x y

      AddrGtOp -> condIntReg GU  x y
      AddrGeOp -> condIntReg GEU x y
1028
      AddrEqOp -> condIntReg EQQ  x y
1029 1030 1031 1032
      AddrNeOp -> condIntReg NE  x y
      AddrLtOp -> condIntReg LU  x y
      AddrLeOp -> condIntReg LEU x y

1033
      FloatGtOp -> condFltReg GTT x y
1034
      FloatGeOp -> condFltReg GE x y
1035
      FloatEqOp -> condFltReg EQQ x y
1036
      FloatNeOp -> condFltReg NE x y
1037
      FloatLtOp -> condFltReg LTT x y
1038 1039
      FloatLeOp -> condFltReg LE x y

1040
      DoubleGtOp -> condFltReg GTT x y
1041
      DoubleGeOp -> condFltReg GE x y
1042
      DoubleEqOp -> condFltReg EQQ x y
1043
      DoubleNeOp -> condFltReg NE x y
1044
      DoubleLtOp -> condFltReg LTT x y
1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065
      DoubleLeOp -> condFltReg LE x y

      IntAddOp -> trivialCode (ADD False False) x y
      IntSubOp -> trivialCode (SUB False False) x y

	-- ToDo: teach about V8+ SPARC mul/div instructions
      IntMulOp    -> imul_div SLIT(".umul") x y
      IntQuotOp   -> imul_div SLIT(".div")  x y
      IntRemOp    -> imul_div SLIT(".rem")  x y

      FloatAddOp  -> trivialFCode FloatRep  FADD x y
      FloatSubOp  -> trivialFCode FloatRep  FSUB x y
      FloatMulOp  -> trivialFCode FloatRep  FMUL x y
      FloatDivOp  -> trivialFCode FloatRep  FDIV x y

      DoubleAddOp -> trivialFCode DoubleRep FADD x y
      DoubleSubOp -> trivialFCode DoubleRep FSUB x y
      DoubleMulOp -> trivialFCode DoubleRep FMUL x y
      DoubleDivOp -> trivialFCode DoubleRep FDIV x y

      AndOp -> trivialCode (AND False) x y
1066 1067
      OrOp  -> trivialCode (OR  False) x y
      XorOp -> trivialCode (XOR False) x y
1068 1069 1070
      SllOp -> trivialCode SLL x y
      SrlOp -> trivialCode SRL x y

sof's avatar
sof committed
1071
      ISllOp -> trivialCode SLL x y  --was: panic "SparcGen:isll"
sof's avatar
sof committed
1072
      ISraOp -> trivialCode SRA x y  --was: panic "SparcGen:isra"
sof's avatar
sof committed
1073
      ISrlOp -> trivialCode SRL x y  --was: panic "SparcGen:isrl"
1074

1075 1076
      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
                                           [promote x, promote y])
1077
		       where promote x = StPrim Float2DoubleOp [x]
1078 1079 1080 1081 1082 1083 1084
      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
                                           [x, y])

      other
         -> pprPanic "getRegister(sparc,dyadic primop)" 
                     (pprStixTree (StPrim primop [x, y]))

1085
  where
sof's avatar
sof committed
1086
    imul_div fn x y = getRegister (StCall fn cCallConv IntRep [x, y])
1087 1088

getRegister (StInd pk mem)
1089
  = getAmode mem    	    	    `thenNat` \ amode ->
1090 1091 1092 1093
    let
    	code = amodeCode amode
    	src   = amodeAddr amode
    	size = primRepToSize pk
sewardj's avatar