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 984 - (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 :     signature X86COMP_INSTR_EXT = sig
8 :     structure I : X86INSTR
9 : george 984 structure TS : MLTREE_STREAM
10 :     where T = I.T
11 :     structure CFG : CONTROL_FLOW_GRAPH
12 :     where I = I
13 :     and P = TS.S.P
14 : george 562
15 :     type reducer =
16 : george 984 (I.instruction, I.C.cellset, I.operand, I.addressing_mode, CFG.cfg) TS.reducer
17 : george 562
18 :     val compileSext :
19 : george 600 reducer
20 : george 909 -> {stm: (I.T.stm, I.T.rexp, I.T.fexp, I.T.ccexp) X86InstrExt.sext,
21 :     an: I.T.an list}
22 : george 600 -> unit
23 : george 562 end
24 :    
25 :    
26 : george 984
27 :    
28 : george 909 functor X86CompInstrExt
29 :     (structure I : X86INSTR
30 : george 984 structure TS : MLTREE_STREAM
31 :     where T = I.T
32 :     structure CFG : CONTROL_FLOW_GRAPH
33 :     where P = TS.S.P
34 :     and I = I
35 :     ) : X86COMP_INSTR_EXT =
36 : george 562 struct
37 : george 909 structure CFG = CFG
38 : george 984 structure T = TS.T
39 : george 562 structure I = I
40 :     structure C = I.C
41 :     structure X = X86InstrExt
42 : george 984 structure TS = TS
43 : george 562
44 : george 600 type stm = (T.stm, T.rexp, T.fexp, T.ccexp) X.sext
45 : george 562
46 :     type reducer =
47 : george 984 (I.instruction, I.C.cellset, I.operand, I.addressing_mode, CFG.cfg) TS.reducer
48 : george 562
49 :     val esp = C.esp
50 :     val espOpnd = I.Direct(esp)
51 :    
52 :     fun error msg = MLRiscErrorMsg.error("X86CompInstrExt", msg)
53 :    
54 :     val stackArea = I.Region.stack
55 :    
56 :     fun compileSext reducer {stm: stm, an:T.an list} = let
57 : george 984 val TS.REDUCER{operand, emit, reduceFexp, instrStream, reduceOperand,
58 : leunga 815 ...} = reducer
59 : george 984 val TS.S.STREAM{emit=emitI, ...} = instrStream
60 : george 600 fun fstp(sz, fstpInstr, fexp) =
61 :     (case fexp
62 :     of T.FREG(sz', f) =>
63 :     if sz <> sz' then error "fstp: sz"
64 :     else emitI(fstpInstr(I.FDirect f))
65 :     | _ => error "fstp: fexp"
66 :     (*esac*))
67 : george 562 in
68 :     case stm
69 :     of X.PUSHL(rexp) => emit(I.PUSHL(operand rexp), an)
70 : george 600 | X.POP(rexp) => emit(I.POP(operand rexp), an)
71 : george 562
72 : george 600 | X.FSTPS(fexp) => fstp(32, I.FSTPS, fexp)
73 :     | X.FSTPL(fexp) => fstp(64, I.FSTPL, fexp)
74 :     | X.FSTPT(fexp) => fstp(80, I.FSTPT, fexp)
75 : george 562
76 : george 600 | X.LEAVE => emit(I.LEAVE, an)
77 :     | X.RET(rexp) => emit(I.RET(SOME(operand rexp)), an)
78 : leunga 797 | X.LOCK_CMPXCHGL(src, dst) =>
79 : leunga 815 (* src must in a register *)
80 :     emit(I.CMPXCHG{lock=true,sz=I.I32,
81 :     src=I.Direct(reduceOperand(operand src)),
82 :     dst=operand dst},an)
83 : george 562 end
84 :     end

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