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/MLRISC/x86/instructions/x86comp-instr-ext.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/x86/instructions/x86comp-instr-ext.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 562 - (view) (download)

1 : george 562 (* x86comp-instr-ext.sml
2 :     *
3 :     * COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
4 :     *
5 :     * emit code for extensions to the x86 instruction set.
6 :     *)
7 :    
8 :     signature X86COMP_INSTR_EXT = sig
9 :     structure T : MLTREE
10 :     structure I : X86INSTR
11 :    
12 :     type reducer =
13 :     (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer
14 :    
15 :     val compileSext :
16 :     reducer -> {stm: (T.rexp, T.fexp) X86InstrExt.sext, an: T.an list} -> unit
17 :     end
18 :    
19 :    
20 :     functor X86CompInstrExt
21 :     (structure T : MLTREE
22 :     structure I : X86INSTR
23 :     sharing T.LabelExp = I.LabelExp) : X86COMP_INSTR_EXT =
24 :     struct
25 :     structure T = T
26 :     structure I = I
27 :     structure C = I.C
28 :     structure X = X86InstrExt
29 :    
30 :     type stm = (T.rexp, T.fexp) X.sext
31 :    
32 :     type reducer =
33 :     (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer
34 :    
35 :     val esp = C.esp
36 :     val espOpnd = I.Direct(esp)
37 :    
38 :     fun error msg = MLRiscErrorMsg.error("X86CompInstrExt", msg)
39 :    
40 :     val stackArea = I.Region.stack
41 :    
42 :     fun compileSext reducer {stm: stm, an:T.an list} = let
43 :     val T.REDUCER{operand, emit, reduceFexp, instrStream, ...} = reducer
44 :     val T.Stream.STREAM{emit=emitI, ...} = instrStream
45 :     in
46 :     case stm
47 :     of X.PUSHL(rexp) => emit(I.PUSHL(operand rexp), an)
48 :     | X.PUSHf{sz, fexp} => let
49 :     fun inRange f = let
50 :     val {high, low} = C.cellRange C.FP
51 :     in low <= f andalso f <= high
52 :     end
53 :    
54 :     fun alloc(size) =
55 :     emitI(I.BINARY{binOp=I.SUBL, src=I.Immed size, dst=espOpnd});
56 :    
57 :     fun copyf(f, fld, fstp, size) =
58 :     (emitI(fld(I.FDirect f));
59 :     alloc(size);
60 :     emitI(I.BINARY{binOp=I.ADDL, src=I.Immed size, dst=espOpnd});
61 :     emit(fstp(I.Displace{base=esp, disp=I.Immed(0), mem=stackArea}), an))
62 :     in
63 :     case fexp
64 :     of T.FREG(_, f) =>
65 :     if inRange(f) then error "compileSext: FREG: inRange"
66 :     else (case sz
67 :     of X.single => copyf(f, I.FLDS, I.FSTPS, 4)
68 :     | X.double => copyf(f, I.FLDL, I.FSTPL, 8)
69 :     | X.extended => error "compileSext: FREG: sz=80"
70 :     (*esac*))
71 :     | _ => let
72 :     val f = reduceFexp(fexp)
73 :     fun pushf(size, fstp) =
74 :     (alloc(size);
75 :     emit(fstp(I.Displace{base=esp, disp=I.Immed(0), mem=stackArea}), an))
76 :     in
77 :     case sz
78 :     of X.single => pushf(4, I.FSTPS)
79 :     | X.double => pushf(8, I.FSTPL)
80 :     | X.extended => error "compileSext: fexp: sz=80"
81 :     end
82 :     (*esac*)
83 :     end
84 :     end
85 :     end

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