MachMisc.lhs 19.5 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
%
% (c) The AQUA Project, Glasgow University, 1993-1996
%
\section[MachMisc]{Description of various machine-specific things}

\begin{code}
#include "HsVersions.h"
#include "nativeGen/NCG.h"

module MachMisc (

	fixedHdrSizeInWords, varHdrSizeInWords,
	charLikeSize, intLikeSize, mutHS, dataHS,
	sizeOf, primRepToSize,

	eXTRA_STK_ARGS_HERE,

	volatileSaves, volatileRestores,

	storageMgrInfo, smCAFlist, smOldLim, smOldMutables,
	smStablePtrTable,

	targetMaxDouble, targetMaxInt, targetMinDouble, targetMinInt,

	underscorePrefix,
	fmtAsmLbl,
	cvtLitLit,
	exactLog2,

	Instr(..),  IF_ARCH_i386(Operand(..) COMMA,)
	Cond(..),
	Size(..)
	
#if alpha_TARGET_ARCH
	, RI(..)
#endif
#if i386_TARGET_ARCH
#endif
#if sparc_TARGET_ARCH
	, RI(..), riZero
#endif
    ) where

44
45
46
IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(AbsCLoop)		( fixedHdrSizeInWords, varHdrSizeInWords ) -- paranoia
IMPORT_DELOOPER(NcgLoop)		( underscorePrefix, fmtAsmLbl ) -- paranoia
47
IMPORT_1_3(Char(isDigit))
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

import AbsCSyn		( MagicId(..) ) 
import AbsCUtils	( magicIdPrimRep )
import CmdLineOpts	( opt_SccProfilingOn )
import Literal		( mkMachInt, Literal(..) )
import MachRegs		( stgReg, callerSaves, RegLoc(..),
			  Imm(..), Reg(..), Addr
			)
import OrdList		( OrdList )
import PrimRep		( PrimRep(..) )
import SMRep		( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
import Stix		( StixTree(..), StixReg(..), sStLitLbl,
			  CodeSegment
			)
import Util		( panic )
\end{code}

\begin{code}
underscorePrefix :: Bool   -- leading underscore on labels?

underscorePrefix
  = IF_ARCH_alpha(False
    ,{-else-} IF_ARCH_i386(
	IF_OS_linuxaout(True
	, IF_OS_freebsd(True
sof's avatar
sof committed
73
	, IF_OS_cygwin32(True
74
75
	, IF_OS_bsdi(True
	, {-otherwise-} False)))
sof's avatar
sof committed
76
        )
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
     ,{-else-}IF_ARCH_sparc(
	IF_OS_sunos4(True, {-otherwise-} False)
     ,)))

---------------------------
fmtAsmLbl :: String -> String  -- for formatting labels

fmtAsmLbl s
  =  IF_ARCH_alpha(
     {- The alpha assembler likes temporary labels to look like $L123
	instead of L123.  (Don't toss the L, because then Lf28
	turns into $f28.)
     -}
     '$' : s
     ,{-otherwise-}
     s
     )

---------------------------
cvtLitLit :: String -> String

98
99
100
101
--
-- Rather than relying on guessing, use FILE_SIZE to compute the
-- _iob offsets.
--
102
103
104
105
cvtLitLit "stdin"  = IF_ARCH_alpha("_iob+0" {-probably OK...-}
		    ,IF_ARCH_i386("_IO_stdin_"
		    ,IF_ARCH_sparc("__iob+0x0"{-probably OK...-}
		    ,)))
106
107
108
109
110
111
112
113
114
115

cvtLitLit "stdout" = IF_ARCH_alpha("_iob+"++show (``FILE_SIZE''::Int)
		    ,IF_ARCH_i386("_IO_stdout_"
		    ,IF_ARCH_sparc("__iob+"++show (``FILE_SIZE''::Int)
		    ,)))
cvtLitLit "stderr" = IF_ARCH_alpha("_iob+"++show (2*(``FILE_SIZE''::Int))
		    ,IF_ARCH_i386("_IO_stderr_"
		    ,IF_ARCH_sparc("__iob+"++show (2*(``FILE_SIZE''::Int))
		    ,)))
{-
116
117
cvtLitLit "stdout" = IF_ARCH_alpha("_iob+56"{-dodgy *at best*...-}
		    ,IF_ARCH_i386("_IO_stdout_"
118
		    ,IF_ARCH_sparc("__iob+0x10"{-dodgy *at best*...-}
119
120
121
		    ,)))
cvtLitLit "stderr" = IF_ARCH_alpha("_iob+112"{-dodgy *at best*...-}
		    ,IF_ARCH_i386("_IO_stderr_"
122
		    ,IF_ARCH_sparc("__iob+0x20"{-dodgy *at best*...-}
123
		    ,)))
124
-}
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
cvtLitLit s
  | isHex s   = s
  | otherwise = error ("Native code generator can't handle ``" ++ s ++ "''")
  where
    isHex ('0':'x':xs) = all isHexDigit xs
    isHex _ = False
    -- Now, where have I seen this before?
    isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f'
\end{code}

% ----------------------------------------------------------------

We (allegedly) put the first six C-call arguments in registers;
where do we start putting the rest of them?
\begin{code}
eXTRA_STK_ARGS_HERE :: Int
eXTRA_STK_ARGS_HERE
  = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,???)))
\end{code}

% ----------------------------------------------------------------

@fixedHdrSizeInWords@ and @varHdrSizeInWords@: these are not dependent
on target architecture.
\begin{code}
fixedHdrSizeInWords :: Int

fixedHdrSizeInWords
  = 1{-info ptr-} + profFHS + parFHS + tickyFHS
    -- obviously, we aren't taking non-sequential too seriously yet
  where
    profFHS  = if opt_SccProfilingOn then 1 else 0
    parFHS   = {-if PAR or GRAN then 1 else-} 0
    tickyFHS = {-if ticky ... then 1 else-} 0

varHdrSizeInWords :: SMRep -> Int{-in words-}

varHdrSizeInWords sm
  = case sm of
    StaticRep _ _	   -> 0
    SpecialisedRep _ _ _ _ -> 0
    GenericRep _ _ _	   -> 0
    BigTupleRep _	   -> 1
    MuTupleRep _	   -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
    DataRep _		   -> 1
    DynamicRep		   -> 2
    BlackHoleRep	   -> 0
    PhantomRep		   -> panic "MachMisc.varHdrSizeInWords:phantom"
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Static closure sizes:
\begin{code}
charLikeSize, intLikeSize :: Int

charLikeSize = blahLikeSize CharLikeRep
intLikeSize  = blahLikeSize IntLikeRep

blahLikeSize blah
  = fromInteger (sizeOf PtrRep)
  * (fixedHdrSizeInWords + varHdrSizeInWords blahLikeRep + 1)
  where
    blahLikeRep = SpecialisedRep blah 0 1 SMNormalForm

--------
mutHS, dataHS :: StixTree

mutHS  = blah_hs (MuTupleRep 0)
dataHS = blah_hs (DataRep 0)

blah_hs blah
  = StInt (toInteger words)
  where
    words = fixedHdrSizeInWords + varHdrSizeInWords blah
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Size of a @PrimRep@, in bytes.

\begin{code}
sizeOf :: PrimRep -> Integer{-in bytes-}
    -- the result is an Integer only because it's more convenient

sizeOf pr = case (primRepToSize pr) of
  IF_ARCH_alpha({B -> 1; BU -> 1; {-W -> 2; WU -> 2; L -> 4; SF -> 4;-} _ -> 8},)
  IF_ARCH_sparc({B -> 1; BU -> 1; {-HW -> 2; HWU -> 2;-} W -> 4; {-D -> 8;-} F -> 4; DF -> 8},)
  IF_ARCH_i386( {B -> 1; {-S -> 2;-} L -> 4; F -> 4; DF -> 8 },)
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Now the volatile saves and restores.  We add the basic guys to the
list of ``user'' registers provided.  Note that there are more basic
registers on the restore list, because some are reloaded from
constants.

(@volatileRestores@ used only for wrapper-hungry PrimOps.)

\begin{code}
volatileSaves, volatileRestores :: [MagicId] -> [StixTree]

save_cands    = [BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg]
restore_cands = save_cands ++ [StkStubReg,StdUpdRetVecReg]

volatileSaves vols
  = map save ((filter callerSaves) (save_cands ++ vols))
  where
    save x = StAssign (magicIdPrimRep x) loc reg
      where
	reg = StReg (StixMagicId x)
	loc = case stgReg x of
		Save loc -> loc
		Always _ -> panic "volatileSaves"

volatileRestores vols
  = map restore ((filter callerSaves) (restore_cands ++ vols))
  where
    restore x = StAssign (magicIdPrimRep x) reg loc
      where
	reg = StReg (StixMagicId x)
	loc = case stgReg x of
		Save loc -> loc
		Always _ -> panic "volatileRestores"
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Obviously slightly weedy
(Note that the floating point values aren't terribly important.)
ToDo: Fix!(JSM)
\begin{code}
targetMinDouble = MachDouble (-1.7976931348623157e+308)
targetMaxDouble = MachDouble (1.7976931348623157e+308)
targetMinInt = mkMachInt (-2147483647)
targetMaxInt = mkMachInt 2147483647
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Storage manager nonsense.  Note that the indices are dependent on
the definition of the smInfo structure in SMinterface.lh

\begin{code}
storageMgrInfo, smCAFlist, smOldMutables, smOldLim :: StixTree

storageMgrInfo   = sStLitLbl SLIT("StorageMgrInfo")
smCAFlist        = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_CAFLIST))
smOldMutables    = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDMUTABLES))
smOldLim         = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDLIM))
smStablePtrTable = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_STABLEPOINTERTABLE))
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

This algorithm for determining the $\log_2$ of exact powers of 2 comes
from GCC.  It requires bit manipulation primitives, and we use GHC
extensions.  Tough.

\begin{code}
w2i x = word2Int# x
i2w x = int2Word# x
i2w_s x = (x::Int#)

exactLog2 :: Integer -> Maybe Integer
exactLog2 x
  = if (x <= 0 || x >= 2147483648) then
       Nothing
    else
       case (fromInteger x) of { I# x# ->
       if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
	  Nothing
       else
	  Just (toInteger (I# (pow2 x#)))
       }
  where
    shiftr x y = shiftRA# x y

    pow2 x# | x# ==# 1# = 0#
            | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#))
\end{code}

% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

\begin{code}
data Cond
#if alpha_TARGET_ARCH
  = ALWAYS	-- For BI (same as BR)
314
  | EQQ		-- For CMP and BI (NB: "EQ" is a 1.3 Prelude name)
315
  | GE		-- For BI only
316
  | GTT		-- For BI only (NB: "GT" is a 1.3 Prelude name)
317
  | LE		-- For CMP and BI
318
  | LTT		-- For CMP and BI (NB: "LT" is a 1.3 Prelude name)
319
320
321
322
323
324
325
  | NE		-- For BI only
  | NEVER	-- For BI (null instruction)
  | ULE		-- For CMP only
  | ULT		-- For CMP only
#endif
#if i386_TARGET_ARCH
  = ALWAYS	-- What's really used? ToDo
326
  | EQQ
327
328
  | GE
  | GEU
329
  | GTT
330
331
332
  | GU
  | LE
  | LEU
333
  | LTT
334
335
336
337
338
339
340
  | LU
  | NE
  | NEG
  | POS
#endif
#if sparc_TARGET_ARCH
  = ALWAYS	-- What's really used? ToDo
341
  | EQQ
342
343
  | GE
  | GEU
344
  | GTT
345
346
347
  | GU
  | LE
  | LEU
348
  | LTT
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
  | LU
  | NE
  | NEG
  | NEVER
  | POS
  | VC
  | VS
#endif
\end{code}

\begin{code}
data Size
#if alpha_TARGET_ARCH
    = B	    -- byte
    | BU
--  | W	    -- word (2 bytes): UNUSED
--  | WU    -- : UNUSED
--  | L	    -- longword (4 bytes): UNUSED
    | Q	    -- quadword (8 bytes)
--  | FF    -- VAX F-style floating pt: UNUSED
--  | GF    -- VAX G-style floating pt: UNUSED
--  | DF    -- VAX D-style floating pt: UNUSED
--  | SF    -- IEEE single-precision floating pt: UNUSED
    | TF    -- IEEE double-precision floating pt
#endif
#if i386_TARGET_ARCH
    = B	    -- byte (lower)
--  | HB    -- higher byte **UNUSED**
--  | S	    -- : UNUSED
    | L
    | F	    -- IEEE single-precision floating pt
    | DF    -- IEEE single-precision floating pt
#endif
#if sparc_TARGET_ARCH
    = B     -- byte (signed)
    | BU    -- byte (unsigned)
--  | HW    -- halfword, 2 bytes (signed): UNUSED
--  | HWU   -- halfword, 2 bytes (unsigned): UNUSED
    | W	    -- word, 4 bytes
--  | D	    -- doubleword, 8 bytes: UNUSED
    | F	    -- IEEE single-precision floating pt
    | DF    -- IEEE single-precision floating pt
#endif

primRepToSize :: PrimRep -> Size

primRepToSize PtrRep	    = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize CodePtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize DataPtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize RetRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize CostCentreRep = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize CharRep	    = IF_ARCH_alpha( BU, IF_ARCH_i386( L, IF_ARCH_sparc( BU,)))
primRepToSize IntRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize WordRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize AddrRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize FloatRep	    = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc( F ,)))
primRepToSize DoubleRep	    = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,)))
primRepToSize ArrayRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize ByteArrayRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
primRepToSize StablePtrRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
409
primRepToSize ForeignObjRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
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
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
\end{code}

%************************************************************************
%*									*
\subsection{Machine's assembly language}
%*									*
%************************************************************************

We have a few common ``instructions'' (nearly all the pseudo-ops) but
mostly all of @Instr@ is machine-specific.

\begin{code}
data Instr
  = COMMENT FAST_STRING		-- comment pseudo-op
  | SEGMENT CodeSegment		-- {data,text} segment pseudo-op
  | LABEL   CLabel		-- global label pseudo-op
  | ASCII   Bool		-- True <=> needs backslash conversion
	    String		-- the literal string
  | DATA    Size
	    [Imm]
\end{code}

\begin{code}
#if alpha_TARGET_ARCH

-- data Instr continues...

-- Loads and stores.

	      |	LD	      Size Reg Addr -- size, dst, src
	      | LDA	      Reg Addr	    -- dst, src
	      | LDAH	      Reg Addr	    -- dst, src
	      | LDGP	      Reg Addr	    -- dst, src
	      | LDI	      Size Reg Imm  -- size, dst, src
	      | ST	      Size Reg Addr -- size, src, dst

-- Int Arithmetic.

	      | CLR	      Reg		    -- dst
	      | ABS	      Size RI Reg	    -- size, src, dst
	      | NEG	      Size Bool RI Reg	    -- size, overflow, src, dst
	      | ADD	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
	      | SADD	      Size Size Reg RI Reg  -- size, scale, src, src, dst
	      | SUB	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
	      | SSUB	      Size Size Reg RI Reg  -- size, scale, src, src, dst
	      | MUL	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
	      | DIV	      Size Bool Reg RI Reg  -- size, unsigned, src, src, dst
	      | REM	      Size Bool Reg RI Reg  -- size, unsigned, src, src, dst

-- Simple bit-twiddling.

	      | NOT	      RI Reg
	      | AND	      Reg RI Reg
	      | ANDNOT	      Reg RI Reg
	      | OR	      Reg RI Reg
	      | ORNOT	      Reg RI Reg
	      | XOR	      Reg RI Reg
	      | XORNOT	      Reg RI Reg
	      | SLL	      Reg RI Reg
	      | SRL	      Reg RI Reg
	      | SRA	      Reg RI Reg

	      | ZAP	      Reg RI Reg
	      | ZAPNOT	      Reg RI Reg

	      | NOP

-- Comparison

	      | CMP	      Cond Reg RI Reg

-- Float Arithmetic.

	      | FCLR	      Reg
	      | FABS	      Reg Reg
	      | FNEG	      Size Reg Reg
	      | FADD	      Size Reg Reg Reg
	      | FDIV	      Size Reg Reg Reg
	      | FMUL	      Size Reg Reg Reg
	      | FSUB	      Size Reg Reg Reg
	      | CVTxy	      Size Size Reg Reg
	      | FCMP	      Size Cond Reg Reg Reg
	      | FMOV	      Reg Reg

-- Jumping around.

	      | BI	      Cond Reg Imm
	      | BF	      Cond Reg Imm
	      | BR	      Imm
	      | JMP	      Reg Addr Int
	      | BSR	      Imm Int
	      | JSR	      Reg Addr Int

-- Alpha-specific pseudo-ops.

	      | FUNBEGIN CLabel
	      | FUNEND CLabel

data RI
  = RIReg Reg
  | RIImm Imm

#endif {- alpha_TARGET_ARCH -}
\end{code}

\begin{code}
#if i386_TARGET_ARCH

-- data Instr continues...

-- Moves.

	      |	MOV	      Size Operand Operand
	      | MOVZX	      Size Operand Operand -- size is the size of operand 2
	      | MOVSX	      Size Operand Operand -- size is the size of operand 2

-- Load effective address (also a very useful three-operand add instruction :-)

	      | LEA           Size Operand Operand

-- Int Arithmetic.

	      | ADD	      Size Operand Operand
	      | SUB	      Size Operand Operand

-- Multiplication (signed and unsigned), Division (signed and unsigned),
-- result in %eax, %edx.

	      | IMUL	      Size Operand Operand
	      | IDIV	      Size Operand

-- Simple bit-twiddling.

	      | AND	      Size Operand Operand
	      | OR	      Size Operand Operand
	      | XOR	      Size Operand Operand
	      | NOT	      Size Operand
	      | NEGI	      Size Operand -- NEG instruction (name clash with Cond)
	      | SHL	      Size Operand Operand -- 1st operand must be an Imm
	      | SAR	      Size Operand Operand -- 1st operand must be an Imm
	      | SHR	      Size Operand Operand -- 1st operand must be an Imm
	      | NOP

-- Float Arithmetic. -- ToDo for 386

-- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
-- right up until we spit them out.

	      | SAHF	      -- stores ah into flags
    	      | FABS
	      | FADD	      Size Operand -- src
	      | FADDP
	      | FIADD	      Size Addr -- src
    	      | FCHS
    	      | FCOM	      Size Operand -- src
    	      | FCOS
	      | FDIV	      Size Operand -- src
	      | FDIVP
	      | FIDIV	      Size Addr -- src
	      | FDIVR	      Size Operand -- src
	      | FDIVRP
	      | FIDIVR	      Size Addr -- src
    	      | FICOM	      Size Addr -- src
    	      | FILD	      Size Addr Reg -- src, dst
    	      | FIST	      Size Addr -- dst
    	      | FLD	      Size Operand -- src
    	      | FLD1
    	      | FLDZ
    	      | FMUL	      Size Operand -- src
    	      | FMULP
    	      | FIMUL	      Size Addr -- src
    	      | FRNDINT
    	      | FSIN
    	      | FSQRT
    	      | FST	      Size Operand -- dst
    	      | FSTP	      Size Operand -- dst
	      | FSUB	      Size Operand -- src
	      | FSUBP
	      | FISUB	      Size Addr -- src
	      | FSUBR	      Size Operand -- src
	      | FSUBRP
	      | FISUBR	      Size Addr -- src
	      | FTST
    	      | FCOMP	      Size Operand -- src
    	      | FUCOMPP
	      | FXCH
	      | FNSTSW
	      | FNOP

-- Comparison

	      | TEST          Size Operand Operand
	      | CMP           Size Operand Operand
	      | SETCC         Cond Operand

-- Stack Operations.

	      | PUSH          Size Operand
	      | POP           Size Operand

-- Jumping around.

	      | JMP	      Operand -- target
	      | JXX	      Cond CLabel -- target
	      | CALL	      Imm

-- Other things.

	      | CLTD -- sign extend %eax into %edx:%eax

data Operand
  = OpReg  Reg	-- register
  | OpImm  Imm	-- immediate value
  | OpAddr Addr	-- memory reference

#endif {- i386_TARGET_ARCH -}
\end{code}

\begin{code}
#if sparc_TARGET_ARCH

-- data Instr continues...

-- Loads and stores.

	      | LD	      Size Addr Reg -- size, src, dst
	      | ST	      Size Reg Addr -- size, src, dst

-- Int Arithmetic.

	      | ADD	      Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
	      | SUB	      Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst

-- Simple bit-twiddling.

	      | AND	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | ANDN	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | OR	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | ORN	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | XOR	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | XNOR	      Bool Reg RI Reg -- cc?, src1, src2, dst
	      | SLL	      Reg RI Reg -- src1, src2, dst
	      | SRL	      Reg RI Reg -- src1, src2, dst
	      | SRA	      Reg RI Reg -- src1, src2, dst
	      | SETHI	      Imm Reg -- src, dst
	      | NOP	      -- Really SETHI 0, %g0, but worth an alias

-- Float Arithmetic.

-- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single instructions
-- right up until we spit them out.

    	      | FABS	      Size Reg Reg -- src dst
	      | FADD	      Size Reg Reg Reg -- src1, src2, dst
    	      | FCMP	      Bool Size Reg Reg -- exception?, src1, src2, dst
	      | FDIV	      Size Reg Reg Reg -- src1, src2, dst
    	      | FMOV	      Size Reg Reg -- src, dst
	      | FMUL	      Size Reg Reg Reg -- src1, src2, dst
    	      | FNEG	      Size Reg Reg -- src, dst
    	      | FSQRT	      Size Reg Reg -- src, dst
	      | FSUB	      Size Reg Reg Reg -- src1, src2, dst
    	      | FxTOy	      Size Size Reg Reg -- src, dst

-- Jumping around.

	      | BI	      Cond Bool Imm -- cond, annul?, target
    	      | BF  	      Cond Bool Imm -- cond, annul?, target

	      | JMP	      Addr -- target
	      | CALL	      Imm Int Bool -- target, args, terminal

data RI = RIReg Reg
	| RIImm Imm

riZero :: RI -> Bool

riZero (RIImm (ImmInt 0))	    = True
riZero (RIImm (ImmInteger 0))	    = True
riZero (RIReg (FixedReg ILIT(0)))   = True
riZero _			    = False

#endif {- sparc_TARGET_ARCH -}
\end{code}