bug in src/backend/limit-check.fun
Stephen Weeks
sweeks@wasabi.epr.com
Tue, 16 Nov 1999 21:25:36 -0800 (PST)
Today, I found and fixed a bug in limit-check.fun. The bug caused
certain loops to go undetected, and hence allowed the generation of
loops that allocated but had no limit check. Obviously bad :-(
If you want the fix, you should replace limit-check.fun with the file
below and rebuild MLton.
--------------------------------------------------------------------------------
(* Copyright (C) 1997-1999 NEC Research Institute.
* Please see the file LICENSE for license information.
*)
(* Insert limit checks at
* 1. Loop headers
* 2. Continuations
* 3. Handlers
*)
functor LimitCheck(S: LIMIT_CHECK_STRUCTS): LIMIT_CHECK =
struct
open S
open Dec Transfer
fun limitCheck(Program.T{functions, ...}) =
let
val {get = limitCheck, set = setLimitCheck} =
Property.new(Jump.plist, Property.initConst false)
val {get = inBody, set = setInBody, destroy} =
Property.newDest(Jump.plist, Property.initConst false)
fun yes j = setLimitCheck(j, true)
fun jump j = if inBody j then yes j else ()
fun loopExp e =
let val {decs, transfer} = Exp.dest e
in List.foreach(Exp.decs e,
fn Fun{name, body, ...} => (setInBody(name, true)
; loopExp body
; setInBody(name, false))
| HandlerPush h => setLimitCheck(h, true)
| _ => ())
; (case transfer of
Jump{dst, ...} => jump dst
| Case{cases, default, ...} =>
(List.foreach(cases, jump o #2)
; Option.map'(default, jump))
| Call{cont, ...} => (case cont of
SOME c => yes c
| _ => ())
| _ => ())
end
in
List.foreach(functions, loopExp o #body)
; destroy()
; limitCheck
end
end