Copyright (C) 1994, Digital Equipment Corp.
File: TryFinStmt.m3
MODULE TryFinStmt;
IMPORT M3ID, CG, Token, Scanner, Stmt, StmtRep, Marker, Target;
IMPORT Runtime, Procedure, ProcBody, M3RT, Scope, Fmt, Host, Module;
FROM Stmt IMPORT Outcome;
TYPE
P = Stmt.T OBJECT
body : Stmt.T;
finally : Stmt.T;
forigin : INTEGER;
viaProc : BOOLEAN;
scope : Scope.T;
handler : HandlerProc;
OVERRIDES
check := Check;
compile := Compile;
outcomes := GetOutcome;
END;
TYPE
HandlerProc = ProcBody.T OBJECT
self: P;
OVERRIDES
gen_decl := EmitDecl;
gen_body := EmitBody;
END;
VAR
last_name : INTEGER := 0;
next_uid : INTEGER := 0;
PROCEDURE Parse (body: Stmt.T; ): Stmt.T =
TYPE TK = Token.T;
VAR p := NEW (P);
BEGIN
StmtRep.Init (p);
p.body := body;
Scanner.Match (TK.tFINALLY);
p.forigin := Scanner.offset;
IF Target.Has_stack_walker THEN
p.viaProc := FALSE;
p.scope := NIL;
p.finally := Stmt.Parse ();
ELSE
p.handler := NEW (HandlerProc, self := p);
ProcBody.Push (p.handler);
p.scope := Scope.PushNew (TRUE, M3ID.NoID);
p.finally := Stmt.Parse ();
Scope.PopNew ();
ProcBody.Pop ();
END;
Scanner.Match (TK.tEND);
RETURN p;
END Parse;
PROCEDURE Check (p: P; VAR cs: Stmt.CheckState) =
VAR zz: Scope.T; oc: Stmt.Outcomes; name: INTEGER;
BEGIN
Marker.PushFinally (CG.No_label, CG.No_label, NIL);
Stmt.TypeCheck (p.body, cs);
Marker.Pop ();
IF Target.Has_stack_walker THEN
Stmt.TypeCheck (p.finally, cs);
ELSE
oc := Stmt.GetOutcome (p.finally);
IF (Stmt.Outcome.Exits IN oc) OR (Stmt.Outcome.Returns IN oc) THEN
p.viaProc := FALSE;
Stmt.TypeCheck (p.finally, cs);
ELSE
p.viaProc := TRUE;
name := p.forigin MOD 10000;
p.handler.name := Module.Prefix (NIL) & "_LINE_" & Fmt.Int (name);
IF (name = last_name) THEN
INC (next_uid);
p.handler.name := p.handler.name & "_" & Fmt.Int (next_uid);
ELSE
last_name := name;
next_uid := 0;
END;
zz := Scope.Push (p.scope);
Scope.TypeCheck (p.scope, cs);
Stmt.TypeCheck (p.finally, cs);
Scope.Pop (zz);
END;
END;
END Check;
PROCEDURE Compile (p: P): Stmt.Outcomes =
BEGIN
IF Target.Has_stack_walker THEN RETURN Compile1 (p);
ELSIF p.viaProc THEN RETURN Compile2 (p);
ELSE RETURN Compile3 (p);
END;
END Compile;
PROCEDURE Compile1 (p: P): Stmt.Outcomes =
VAR
oc, xc, o: Stmt.Outcomes;
l: CG.Label;
info: CG.Var;
proc: Procedure.T;
BEGIN
(* declare and initialize the info record *)
info := CG.Declare_local (M3ID.NoID, M3RT.EI_SIZE, Target.Address.align,
CG.Type.Struct, 0, in_memory := TRUE,
up_level := FALSE, f := CG.Never);
CG.Load_nil ();
CG.Store_addr (info, M3RT.EI_exception);
(* compile the body *)
l := CG.Next_label (2);
CG.Set_label (l, barrier := TRUE);
Marker.PushFinally (l, l+1, info);
Marker.SaveFrame ();
oc := Stmt.Compile (p.body);
Marker.Pop ();
CG.Set_label (l+1, barrier := TRUE);
(* compile the handler *)
Scanner.offset := p.forigin;
CG.Gen_location (p.forigin);
xc := Stmt.Compile (p.finally);
(* generate the bizzare end-tests *)
IF (Outcome.Returns IN oc) THEN
l := CG.Next_label ();
CG.Load_int (info, M3RT.EI_exception);
CG.Load_intt (Marker.Return_exception);
CG.If_ne (l, CG.Type.Int, CG.Always);
Marker.EmitReturn (NIL, fromFinally := TRUE);
CG.Set_label (l);
END;
IF (Outcome.Exits IN oc) THEN
l := CG.Next_label ();
CG.Load_int (info, M3RT.EI_exception);
CG.Load_intt (Marker.Exit_exception);
CG.If_ne (l, CG.Type.Int, CG.Always);
Marker.EmitExit ();
CG.Set_label (l);
END;
(* resume the exception *)
proc := Runtime.LookUpProc (Runtime.Hook.ResumeRaise);
l := CG.Next_label ();
CG.Load_addr (info, M3RT.EI_exception);
CG.Load_nil ();
CG.If_eq (l, CG.Type.Addr, CG.Always);
Procedure.StartCall (proc);
CG.Load_addr_of (info, 0, Target.Address.align);
CG.Pop_param (CG.Type.Addr);
EVAL Procedure.EmitCall (proc);
CG.Set_label (l);
o := Stmt.Outcomes {};
IF Outcome.FallThrough IN xc THEN o := oc END;
IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
RETURN o;
END Compile1;
PROCEDURE Compile2 (p: P): Stmt.Outcomes =
VAR
oc, xc, o: Stmt.Outcomes;
l: CG.Label;
frame: CG.Var;
BEGIN
<*ASSERT p.viaProc*>
(* declare and initialize the info record *)
frame := CG.Declare_local (M3ID.NoID, M3RT.EF2_SIZE, Target.Address.align,
CG.Type.Struct, 0, in_memory := TRUE,
up_level := FALSE, f := CG.Never);
CG.Load_procedure (p.handler.cg_proc);
CG.Store_addr (frame, M3RT.EF2_handler);
CG.Load_static_link (p.handler.cg_proc);
CG.Store_addr (frame, M3RT.EF2_frame);
(* compile the body *)
l := CG.Next_label (2);
CG.Set_label (l, barrier := TRUE);
Marker.PushFrame (frame, M3RT.HandlerClass.FinallyProc);
Marker.PushFinallyProc (l, l+1, frame, p.handler.cg_proc, p.handler.level);
oc := Stmt.Compile (p.body);
Marker.Pop ();
IF (Outcome.FallThrough IN oc) THEN
Marker.PopFrame (frame);
CG.Start_call_direct (p.handler.cg_proc, p.handler.level, CG.Type.Void);
CG.Call_direct (p.handler.cg_proc, CG.Type.Void);
END;
CG.Set_label (l+1, barrier := TRUE);
Scanner.offset := p.forigin;
CG.Gen_location (p.forigin);
IF (Host.inline_nested_procs) THEN
CG.Begin_procedure (p.handler.cg_proc);
xc := Stmt.Compile (p.finally);
CG.Exit_proc (CG.Type.Void);
CG.End_procedure (p.handler.cg_proc);
ELSE
CG.Note_procedure_origin (p.handler.cg_proc);
xc := Stmt.GetOutcome (p.finally);
END;
o := Stmt.Outcomes {};
IF Outcome.FallThrough IN xc THEN o := oc END;
IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
RETURN o;
END Compile2;
PROCEDURE EmitDecl (x: HandlerProc) =
VAR p := x.self; par: CG.Proc := NIL;
BEGIN
IF (p.viaProc) THEN
IF (x.parent # NIL) THEN par := x.parent.cg_proc; END;
x.cg_proc := CG.Declare_procedure (M3ID.Add (x.name), 0, CG.Type.Void,
x.level, Target.DefaultCall,
exported := FALSE, parent := par);
END;
END EmitDecl;
PROCEDURE EmitBody (x: HandlerProc) =
VAR p := x.self;
BEGIN
IF (p.viaProc) AND (NOT Host.inline_nested_procs) THEN
Scanner.offset := p.forigin;
CG.Gen_location (p.forigin);
CG.Begin_procedure (x.cg_proc);
EVAL Stmt.Compile (p.finally);
CG.Exit_proc (CG.Type.Void);
CG.End_procedure (x.cg_proc);
END;
END EmitBody;
PROCEDURE Compile3 (p: P): Stmt.Outcomes =
VAR
oc, xc, o: Stmt.Outcomes;
l, xx: CG.Label;
frame: CG.Var;
returnSeen, exitSeen: BOOLEAN;
proc: Procedure.T;
BEGIN
<* ASSERT NOT p.viaProc *>
(* declare and initialize the info record *)
frame := CG.Declare_local (M3ID.NoID, M3RT.EF1_SIZE, M3RT.EF1_ALIGN,
CG.Type.Struct, 0, in_memory := TRUE,
up_level := FALSE, f := CG.Never);
CG.Load_nil ();
CG.Store_addr (frame, M3RT.EF1_exception);
l := CG.Next_label (3);
CG.Set_label (l, barrier := TRUE);
Marker.PushFrame (frame, M3RT.HandlerClass.Finally);
Marker.CaptureState (frame, l+1);
(* compile the body *)
Marker.PushFinally (l, l+1, frame);
oc := Stmt.Compile (p.body);
Marker.PopFinally (returnSeen, exitSeen);
IF (Outcome.FallThrough IN oc) THEN
Marker.PopFrame (frame);
END;
CG.Set_label (l+1, barrier := TRUE);
(* compile the handler *)
Scanner.offset := p.forigin;
CG.Gen_location (p.forigin);
xc := Stmt.Compile (p.finally);
IF (Outcome.FallThrough IN xc) THEN
(* generate the bizzare end-tests *)
(* exceptional outcome? *)
CG.Load_addr (frame, M3RT.EF1_exception);
CG.Load_nil ();
CG.If_eq (l+2, CG.Type.Addr, CG.Always);
IF (exitSeen) THEN
xx := CG.Next_label ();
CG.Load_int (frame, M3RT.EF1_exception);
CG.Load_intt (Marker.Exit_exception);
CG.If_ne (xx, CG.Type.Int, CG.Always);
Marker.EmitExit ();
CG.Set_label (xx);
END;
IF (returnSeen) THEN
xx := CG.Next_label ();
CG.Load_int (frame, M3RT.EF1_exception);
CG.Load_intt (Marker.Return_exception);
CG.If_ne (xx, CG.Type.Int, CG.Always);
Marker.EmitReturn (NIL, fromFinally := TRUE);
CG.Set_label (xx);
END;
(* ELSE, a real exception is being raised => resume it *)
proc := Runtime.LookUpProc (Runtime.Hook.ResumeRaise);
Procedure.StartCall (proc);
CG.Load_addr_of (frame, M3RT.EF1_exception, Target.Address.align);
CG.Pop_param (CG.Type.Addr);
EVAL Procedure.EmitCall (proc);
CG.Set_label (l+2, barrier := TRUE);
END;
o := Stmt.Outcomes {};
IF Outcome.FallThrough IN xc THEN o := oc END;
IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
RETURN o;
END Compile3;
PROCEDURE GetOutcome (p: P): Stmt.Outcomes =
VAR oc, xc, o: Stmt.Outcomes;
BEGIN
oc := Stmt.GetOutcome (p.body);
xc := Stmt.GetOutcome (p.finally);
o := Stmt.Outcomes {};
IF Outcome.FallThrough IN xc THEN o := oc END;
IF Outcome.Exits IN xc THEN o := o + Stmt.Outcomes {Outcome.Exits} END;
IF Outcome.Returns IN xc THEN o := o + Stmt.Outcomes {Outcome.Returns} END;
RETURN o;
END GetOutcome;
BEGIN
END TryFinStmt.