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 600 - (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 : george 600 reducer
17 :     -> {stm: (T.stm, T.rexp, T.fexp, T.ccexp) X86InstrExt.sext,
18 :     an: T.an list}
19 :     -> unit
20 : george 562 end
21 :    
22 :    
23 :     functor X86CompInstrExt
24 :     (structure T : MLTREE
25 :     structure I : X86INSTR
26 :     sharing T.LabelExp = I.LabelExp) : X86COMP_INSTR_EXT =
27 :     struct
28 :     structure T = T
29 :     structure I = I
30 :     structure C = I.C
31 :     structure X = X86InstrExt
32 :    
33 : george 600 type stm = (T.stm, T.rexp, T.fexp, T.ccexp) X.sext
34 : george 562
35 :     type reducer =
36 :     (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer
37 :    
38 :     val esp = C.esp
39 :     val espOpnd = I.Direct(esp)
40 :    
41 :     fun error msg = MLRiscErrorMsg.error("X86CompInstrExt", msg)
42 :    
43 :     val stackArea = I.Region.stack
44 :    
45 :     fun compileSext reducer {stm: stm, an:T.an list} = let
46 :     val T.REDUCER{operand, emit, reduceFexp, instrStream, ...} = reducer
47 :     val T.Stream.STREAM{emit=emitI, ...} = instrStream
48 : george 600 fun fstp(sz, fstpInstr, fexp) =
49 :     (case fexp
50 :     of T.FREG(sz', f) =>
51 :     if sz <> sz' then error "fstp: sz"
52 :     else emitI(fstpInstr(I.FDirect f))
53 :     | _ => error "fstp: fexp"
54 :     (*esac*))
55 : george 562 in
56 :     case stm
57 :     of X.PUSHL(rexp) => emit(I.PUSHL(operand rexp), an)
58 : george 600 | X.POP(rexp) => emit(I.POP(operand rexp), an)
59 : george 562
60 : george 600 | X.FSTPS(fexp) => fstp(32, I.FSTPS, fexp)
61 :     | X.FSTPL(fexp) => fstp(64, I.FSTPL, fexp)
62 :     | X.FSTPT(fexp) => fstp(80, I.FSTPT, fexp)
63 : george 562
64 : george 600 | X.LEAVE => emit(I.LEAVE, an)
65 :     | X.RET(rexp) => emit(I.RET(SOME(operand rexp)), an)
66 : george 562 end
67 :     end

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