CVS: sml-dist/src/compiler/CodeGen/cpscompile check-gc.sml,NONE,1.1 invokegc.sig,1.9,1.10 invokegc.sml,1.23,1.24
Allen Leung <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/CodeGen/cpscompile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32259/src/compiler/CodeGen/cpscompile
Modified Files:
invokegc.sig invokegc.sml
Added Files:
check-gc.sml
Log Message:
GC protocol checking phase added.
--- NEW FILE: check-gc.sml ---
(*
* This module checks that no other values aside from
* the standard GC calling convention registers, can be live across
* a call GC instruction. Call GC blocks and instructions are assumed
* to be marked with the special CALLGC annotation.
*)
signature CHECK_GC =
sig
structure CFG : CONTROL_FLOW_GRAPH
val checkGC : CFG.cfg -> CFG.cfg
end
functor CheckGCFn(
structure Asm : INSTRUCTION_EMITTER
structure CFG : CONTROL_FLOW_GRAPH
where I = Asm.I
and P = Asm.S.P
structure InsnProps : INSN_PROPERTIES
where I = CFG.I
structure CpsRegs : CPSREGS
val gcParamRegs : CpsRegs.T.rexp list
) : CHECK_GC =
struct
structure CFG = CFG
structure L = Liveness(CFG)
structure I = CFG.I
structure C = I.C
structure G = Graph
structure H = IntHashTable
structure CB = CellsBasis
structure CS = CB.CellSet
structure T = CpsRegs.T
(* List of cells which are gc roots *and* dedicated registers *)
val gc_roots =
CB.SortedCells.uniq(
List.foldr (fn (T.REG(_,r),S) => r::S |
(_, S) => S)
(CpsRegs.dedicatedR @ CpsRegs.dedicatedF) gcParamRegs)
(* def/use for integer and floating point registers *)
val defUseR = InsnProps.defUse CB.GP
val defUseF = InsnProps.defUse CB.FP
(* Flag for debugging this phase *)
val debug_check_gc = MLRiscControl.mkFlag
("debug-check-gc", "Check GC debugging")
val check_gc = MLRiscControl.mkFlag
("check-gc", "Turn on GC checking")
(* Dump a block of instructions *)
fun showBlock (CFG.BLOCK{insns, ...}) =
let val Asm.S.STREAM{emit, ...} =
AsmStream.withStream TextIO.stdOut Asm.makeStream []
in app emit (rev (!insns))
end
(* Dump one instruction *)
fun showInstr instr =
let val Asm.S.STREAM{emit, ...} =
AsmStream.withStream TextIO.stdOut Asm.makeStream []
in emit instr
end
(*
* Checks gc
*)
fun checkIt(cfg as G.GRAPH graph) =
let
(* DefUse for one instruction *)
fun defUse i =
let val (d1,u1) = defUseR i
val (d2,u2) = defUseF i
in
(d1@d2, u1@u2)
end
(* Cellset -> list *)
val getCell = CS.toCellList
(* Compute liveness for all register kinds *)
val {liveIn, liveOut} =
L.liveness { defUse=defUseR, getCell=getCell } cfg
(* Pretty-print a list of cells *)
fun cellsToString S = CS.toString(List.foldr CS.add CS.empty S)
(* Check if an instruction is a call GC instruction *)
fun isCallGC i =
let val (_, a) = InsnProps.getAnnotations i
in #contains MLRiscAnnotations.CALLGC a
end
(* Check a call gc instruction *)
fun checkCallGC (instr, liveOut, liveIn, block) =
let val () = if !debug_check_gc then
(print ("live in="^cellsToString(liveIn)^"\n");
showInstr(instr);
print ("live out="^cellsToString(liveOut)^"\n"))
else ()
val liveAcross = CB.SortedCells.difference(liveOut, gc_roots)
in if not(CB.SortedCells.isEmpty liveAcross) then
(print("_______________________________________\n");
print("WARNING: error in GC protocol:\n");
print ("gc roots+dedicated="^cellsToString(gc_roots)^"\n");
print ("live in="^cellsToString(liveIn)^"\n");
showInstr(instr);
print ("live out="^cellsToString(liveOut)^"\n");
print ("In block:\n");
showBlock(block);
print("_______________________________________\n");
ErrorMsg.impossible("CheckGC.gc protocol error")
)
else ()
end
(* Scan a GC block backwards and look for CALL GC instructions *)
fun scanBlock (b,block as CFG.BLOCK{insns, ...}) =
let val live = H.lookup liveOut b
fun scan(live, []) = ()
| scan(live, i::is) =
let
val live' = L.liveStep defUse (i, live)
in
if isCallGC i then checkCallGC(i, live, live',block) else ();
scan(live', is)
end
val () = if !debug_check_gc then
(print("Liveout="^cellsToString(live)^"\n");
showBlock(block))
else ()
in
scan(live, !insns)
end
(*
* GC blocks are marked with the special annotation CALLGC.
*)
fun isGCBlock(b,CFG.BLOCK{annotations, ...}) =
#contains MLRiscAnnotations.CALLGC (!annotations)
(*
* Check GC blocks
*)
fun checkBlock (b,b') =
if isGCBlock(b,b') then scanBlock(b,b') else ()
in
(* Locate and check all blocks in the flowgraph *)
#forall_nodes graph checkBlock
end
(* Main entry point *)
fun checkGC cfg =
(if !check_gc then checkIt cfg else (); cfg)
end
Index: invokegc.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/CodeGen/cpscompile/invokegc.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** invokegc.sig 21 Nov 2001 19:00:07 -0000 1.9
--- invokegc.sig 4 May 2005 15:51:20 -0000 1.10
***************
*** 26,29 ****
--- 26,32 ----
type stream = (TS.T.stm, TS.T.mlrisc list, CFG.cfg) TS.stream
+ (* List of registers which are used as the root of the GC *)
+ val gcParamRegs : TS.T.rexp list
+
(* initialize the state before compiling a module *)
val init : unit -> unit
Index: invokegc.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/CodeGen/cpscompile/invokegc.sml,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** invokegc.sml 28 Aug 2003 21:58:56 -0000 1.23
--- invokegc.sml 4 May 2005 15:51:20 -0000 1.24
***************
*** 45,48 ****
--- 45,52 ----
val addrTy = C.addressWidth
+ val ZERO_FREQ = #create MLRiscAnnotations.EXECUTION_FREQ 0
+ val CALLGC = #create MLRiscAnnotations.CALLGC ()
+ val NO_OPTIMIZATION = #create MLRiscAnnotations.NO_OPTIMIZATION ()
+
(* The following datatype is used to encapsulates
* all the information needed to generate code to invoke gc.
***************
*** 108,128 ****
val def = case C.exhausted of NONE => use
| SOME cc => T.CCR cc::use
in
! T.ANNOTATION(
! T.CALL{
! funct=
! T.LOAD(32,
! T.ADD(addrTy,C.frameptr vfp, LI MS.startgcOffset),
! R.stack),
! targets=[], defs=def, uses=use, region=R.stack,
! pops=0},
! #create MLRiscAnnotations.COMMENT "call gc")
end
- val ZERO_FREQ = #create MLRiscAnnotations.EXECUTION_FREQ 0
-
- val CALLGC = #create MLRiscAnnotations.CALLGC ()
- val NO_OPTIMIZATION = #create MLRiscAnnotations.NO_OPTIMIZATION ()
-
(*
* record descriptors
--- 112,129 ----
val def = case C.exhausted of NONE => use
| SOME cc => T.CCR cc::use
+ val call =
+ T.CALL{
+ funct=T.LOAD(32,
+ T.ADD(addrTy,C.frameptr vfp, LI MS.startgcOffset),
+ R.stack),
+ targets=[], defs=def, uses=use, region=R.stack,
+ pops=0}
+
+ (* mark it with a CALLGC annotation *)
+ val call = T.ANNOTATION(call, CALLGC)
in
! T.ANNOTATION(call, #create MLRiscAnnotations.COMMENT "call gc")
end
(*
* record descriptors
-------------------------------------------------------
This SF.Net email is sponsored by: NEC IT Guy Games.
Get your fingers limbered up and give it your best shot. 4 great events, 4
opportunities to win big! Highest score wins.NEC IT Guy Games. Play to
win an NEC 61 plasma display. Visit http://www.necitguy.com/?r=20