Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/CodeGen/x86/x86MLTreeExtComp.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/x86/x86MLTreeExtComp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1003 - (view) (download)

1 : george 717 functor X86MLTreeExtComp
2 : george 909 ( structure T : MLTREE where Extension = X86_SMLNJMLTreeExt
3 :     structure I : X86INSTR where T = T
4 : george 984 structure TS : MLTREE_STREAM
5 :     where T = T
6 :     structure CFG : CONTROL_FLOW_GRAPH
7 :     where I=I
8 :     and P = TS.S.P
9 : george 717 ) : MLTREE_EXTENSION_COMP =
10 :     struct
11 :     structure T = T
12 :     structure I = I
13 :     structure C = I.C
14 : george 889 structure CB = CellsBasis
15 : blume 773 structure Ext = X86_SMLNJMLTreeExt
16 : george 909 structure CFG = CFG
17 : george 984 structure TS = TS
18 : george 909 structure X86CompInstrExt =
19 :     X86CompInstrExt
20 :     (structure I=I
21 : george 984 structure TS = TS
22 : george 909 structure CFG = CFG)
23 : leunga 775
24 : george 717 type reducer =
25 : george 984 (I.instruction,C.cellset,I.operand,I.addressing_mode,CFG.cfg) TS.reducer
26 : george 717
27 : leunga 731 val fast_fp = MLRiscControl.getFlag "x86-fast-fp"
28 :    
29 : george 717 fun unimplemented _ = MLRiscErrorMsg.impossible "X86MLTreeExtComp"
30 :    
31 : blume 773 val compileSext = X86CompInstrExt.compileSext
32 : george 717 val compileRext = unimplemented
33 :     val compileCCext = unimplemented
34 : george 984 fun compileFext (TS.REDUCER{reduceFexp, emit, ...}:reducer) = let
35 : george 889 fun comp{e=(64, fexp), fd:CB.cell, an:T.an list} = let
36 : george 717 fun trig(f, foper) =
37 : george 1003 (reduceFexp f; emit(I.funary foper, an))
38 : george 717 in
39 :     case fexp
40 :     of Ext.FSINE f => trig(f, I.FSIN)
41 :     | Ext.FCOSINE f => trig(f, I.FCOS)
42 :     | Ext.FTANGENT f =>
43 : leunga 731 (trig(f, I.FPTAN);
44 : george 1003 emit(I.fstpl(I.ST(C.ST 0)), [])
45 : leunga 731 )
46 : george 717 end
47 :     | comp _ = MLRiscErrorMsg.impossible "compileFext"
48 : leunga 731
49 : george 889 fun fastComp{e=(64, fexp), fd:CB.cell, an:T.an list} =
50 :     let fun Freg f = let val fx = CB.registerNum f
51 : leunga 744 in if fx >= 8 andalso fx < 32 (* hardwired! *)
52 :     then I.FDirect f else I.FPR f
53 :     end
54 : leunga 731 val (unOp, f) =
55 :     case fexp of
56 :     Ext.FSINE f => (I.FSIN, f)
57 :     | Ext.FCOSINE f => (I.FCOS, f)
58 :     | Ext.FTANGENT f => (I.FPTAN, f)
59 : george 1003 in emit(I.funop{fsize=I.FP64,
60 : leunga 731 unOp=unOp,src=Freg(reduceFexp f),dst=Freg fd}, an)
61 :     end
62 :     | fastComp _ = MLRiscErrorMsg.impossible "compileFext"
63 :    
64 :     in if !fast_fp then fastComp else comp
65 : george 717 end
66 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0