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/branches/idlbasis-devel/src/MLRISC/Tools/MDL/mdl-gen-delay.sml
ViewVC logotype

Annotation of /sml/branches/idlbasis-devel/src/MLRISC/Tools/MDL/mdl-gen-delay.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 848 - (view) (download)

1 : leunga 744 (*
2 :     * Generate the <arch>DelaySlots functor.
3 :     * This structure contains information about delay slot filling
4 :     *)
5 :    
6 :     functor MDGenDelaySlots(Comp : MDL_COMPILE) : MDL_GEN_MODULE =
7 :     struct
8 :    
9 :     structure Comp = Comp
10 :     structure Ast = Comp.Ast
11 :     structure Env = Comp.Env
12 :    
13 :     open Ast Comp.Util
14 :    
15 :     fun delay DELAY_NONE = ID "D_NONE"
16 :     | delay DELAY_ERROR = ID "D_ERROR"
17 :     | delay DELAY_ALWAYS = ID "D_ALWAYS"
18 :     | delay DELAY_TAKEN = ID "D_TAKEN"
19 :     | delay DELAY_NONTAKEN = ID "D_FALLTHRU"
20 :     | delay(DELAY_IF(BRANCHforwards,x,y)) =
21 :     IFexp(ID "backward",delay y,delay x)
22 :     | delay(DELAY_IF(BRANCHbackwards,x,y)) =
23 :     IFexp(ID "backward",delay x,delay y)
24 :     and flag FLAGoff = BOOLexp false
25 :     | flag FLAGon = BOOLexp true
26 :     | flag(FLAGid(id,true,e)) = ANDALSO(ID id,e)
27 :     | flag(FLAGid(id,false,e)) = ANDALSO(APP("not",ID id),e)
28 :     fun delaySlotEntry(nop,n,nOn,nOff) =
29 :     RECORDexp[ ("nop",nop), ("n",n), ("nOn",nOn), ("nOff",nOff) ]
30 :     val defaultDelaySlot =
31 :     delaySlotEntry(TRUE,FALSE,delay DELAY_ERROR,delay DELAY_NONE)
32 :    
33 :     fun gen md =
34 :     let (* Name of the functor and its signature *)
35 :     val strName = Comp.strname md "DelaySlots"
36 :     val sigName = "DELAY_SLOT_PROPERTIES"
37 :    
38 :     (* The instruction set *)
39 :     val instructions = Comp.instructions md
40 :    
41 :     (* The environment *)
42 :     val env = Env.empty
43 :    
44 :     (* Arguments to the functor *)
45 :     val args =
46 :     ["structure I : "^Comp.strname md "INSTR",
47 :     "structure P : INSN_PROPERTIES",
48 :     " where I = I"
49 :     ]
50 :    
51 :     fun mkFun(name,args,x,body,default) =
52 :     FUNdecl[FUNbind(name,
53 :     [CLAUSE([RECORDpat(map (fn x => (x,IDpat x)) args, NONE, false)],
54 :     LETexp([FUNdecl
55 :     [FUNbind(name,[CLAUSE([IDpat x],
56 :     NONE,
57 :     CASEexp(ID x,
58 :     body @
59 :     [CLAUSE([WILDpat],NONE,default)]
60 :     ))])]],
61 :     [APPexp(ID name,ID x)]))
62 :     ])]
63 :    
64 :     (* Function to extract the properties about delay slot *)
65 :     val delaySlot =
66 :     let fun mkPat cons = Env.consToPat {prefix="I",cons=cons}
67 :     fun g [] = []
68 :     | g(CONSbind{delayslot=(_,DELAY_NONE),
69 :     nop=FLAGoff,nullified=FLAGoff, ...}::cbs) =
70 :     g cbs
71 :     | g((c as CONSbind{id,delayslot=(d1,d2),
72 :     nop,nullified,...})::cbs) =
73 :     CLAUSE([mkPat c],
74 :     NONE,
75 :     delaySlotEntry(flag nop, flag nullified,
76 :     delay d1,delay d2))::g cbs
77 :     in mkFun("delaySlot",["instr","backward"],"instr",g instructions,
78 :     defaultDelaySlot)
79 :     end
80 :    
81 :     (* Function to enable/disable a delay slot *)
82 :     val enableDelaySlot = DUMMYfun "enableDelaySlot"
83 :    
84 :     (* Function to check whether two delay slots have conflicts *)
85 :     val conflict = DUMMYfun "conflict"
86 :    
87 :     (* Function to check a instruction is a delay slot candidate *)
88 :     val delaySlotCandidate =
89 :     let fun g [] = []
90 :     | g(CONSbind{delaycand=NONE, ...}::cbs) = g cbs
91 :     | g((c as CONSbind{delaycand=SOME e, ...})::cbs) =
92 :     CLAUSE([Env.consToPat {prefix="I",cons=c}],NONE,e)::g cbs
93 :     in mkFun("delaySlotCandidate",
94 :     ["jmp","delaySlot"],"delaySlot",g instructions,TRUE)
95 :     end
96 :    
97 :     (* Function to set the target of a branch *)
98 :     val setTarget = DUMMYfun "setTarget"
99 :    
100 :     (* The functor *)
101 :     val strBody =
102 :     [$ ["structure I = I",
103 :     "datatype delay_slot = D_NONE | D_ERROR | D_ALWAYS | D_TAKEN | D_FALLTHRU ",
104 :     ""
105 :     ],
106 :     ERRORfun strName,
107 :     delaySlot,
108 :     enableDelaySlot,
109 :     conflict,
110 :     delaySlotCandidate,
111 :     setTarget
112 :     ]
113 :    
114 :     in Comp.codegen md "backpatch/DelaySlots"
115 :     [Comp.mkFct md "DelaySlots" args sigName strBody
116 :     ]
117 :     end
118 :     end

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