Skip to content
Snippets Groups Projects
Commit c6dc421f authored by xleroy's avatar xleroy
Browse files

Propagation des erreurs 

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@129 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
parent a543aeaf
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
cil.patch/cabs2cil.ml.patch
+ 94
− 20
View file @ c6dc421f
*** ../cil_orig/src/frontc/cabs2cil.ml 2006-05-21 06:14:15.000000000 +0200 *** ../cil_orig/src/frontc/cabs2cil.ml 2006-05-21 06:14:15.000000000 +0200
--- ../cil/src/frontc/cabs2cil.ml 2006-09-11 18:01:47.323285775 +0200 --- ../cil/src/frontc/cabs2cil.ml 2006-10-23 11:38:43.278308131 +0200
*************** ***************
*** 1,3 **** *** 1,3 ****
--- 1,9 ---- --- 1,11 ----
+ (* MODIF: allow E.Error to propagate *)
+
+ (* MODIF: for pointer comparison, avoid systematic cast to unsigned int *) + (* MODIF: for pointer comparison, avoid systematic cast to unsigned int *)
+ +
+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *) + (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
...@@ -27,7 +29,7 @@ ...@@ -27,7 +29,7 @@
(* We can just copy it because there is nothing to share here. (* We can just copy it because there is nothing to share here.
* Except maybe for the ref cell in Goto but it is Ok to share * Except maybe for the ref cell in Goto but it is Ok to share
* that, I think *) * that, I think *)
--- 822,837 ---- --- 824,839 ----
(fun s -> (fun s ->
if s.labels != [] then if s.labels != [] then
raise (Failure "cannot duplicate: has labels"); raise (Failure "cannot duplicate: has labels");
...@@ -46,7 +48,7 @@ ...@@ -46,7 +48,7 @@
* that, I think *) * that, I think *)
*************** ***************
*** 838,843 **** *** 838,843 ****
--- 847,853 ---- --- 849,855 ----
let canDrop (c: chunk) = let canDrop (c: chunk) =
List.for_all canDropStatement c.stmts List.for_all canDropStatement c.stmts
...@@ -56,7 +58,7 @@ ...@@ -56,7 +58,7 @@
let loop = mkStmt (Loop (c2block body, !currentLoc, None, None)) in let loop = mkStmt (Loop (c2block body, !currentLoc, None, None)) in
*************** ***************
*** 845,850 **** *** 845,850 ****
--- 855,887 ---- --- 857,889 ----
postins = []; postins = [];
cases = body.cases; cases = body.cases;
} }
...@@ -92,7 +94,7 @@ ...@@ -92,7 +94,7 @@
{ stmts = [ mkStmt (Break l) ]; { stmts = [ mkStmt (Break l) ];
*************** ***************
*** 959,964 **** *** 959,964 ****
--- 996,1002 ---- --- 998,1004 ----
(************ Labels ***********) (************ Labels ***********)
...@@ -102,7 +104,7 @@ ...@@ -102,7 +104,7 @@
* marker in a list saying what kinds of loop it is. When we see a continue * marker in a list saying what kinds of loop it is. When we see a continue
*************** ***************
*** 971,980 **** *** 971,980 ****
--- 1009,1037 ---- --- 1011,1039 ----
let startLoop iswhile = let startLoop iswhile =
continues := (if iswhile then While else NotWhile (ref "")) :: !continues continues := (if iswhile then While else NotWhile (ref "")) :: !continues
...@@ -134,7 +136,7 @@ ...@@ -134,7 +136,7 @@
[] -> E.s (error "continue not in a loop") [] -> E.s (error "continue not in a loop")
*************** ***************
*** 990,995 **** *** 990,995 ****
--- 1047,1053 ---- --- 1049,1055 ----
[] -> E.s (error "labContinue not in a loop") [] -> E.s (error "labContinue not in a loop")
| While :: rest -> c | While :: rest -> c
| NotWhile lr :: rest -> if !lr = "" then c else consLabel !lr c !currentLoc false | NotWhile lr :: rest -> if !lr = "" then c else consLabel !lr c !currentLoc false
...@@ -155,7 +157,7 @@ ...@@ -155,7 +157,7 @@
in in
match bop with match bop with
--- 4199,4207 ---- --- 4201,4209 ----
| _ -> E.s (error "%a operator on a non-integer type" d_binop bop) | _ -> E.s (error "%a operator on a non-integer type" d_binop bop)
in in
let pointerComparison e1 t1 e2 t2 = let pointerComparison e1 t1 e2 t2 =
...@@ -181,7 +183,7 @@ ...@@ -181,7 +183,7 @@
| _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType))) | _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType)))
--- 4250,4263 ---- --- 4252,4265 ----
| (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 -> | (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 ->
ignore (warnOpt "Comparison of pointer and non-pointer"); ignore (warnOpt "Comparison of pointer and non-pointer");
...@@ -198,7 +200,7 @@ ...@@ -198,7 +200,7 @@
*************** ***************
*** 5465,5473 **** *** 5465,5473 ****
--- 5521,5534 ---- --- 5523,5536 ----
* then the switch falls through. *) * then the switch falls through. *)
blockFallsThrough b || blockCanBreak b blockFallsThrough b || blockCanBreak b
end end
...@@ -222,7 +224,7 @@ ...@@ -222,7 +224,7 @@
(* switches and loops catch any breaks in their bodies *) (* switches and loops catch any breaks in their bodies *)
false false
| Block b -> blockCanBreak b | Block b -> blockCanBreak b
--- 5573,5579 ---- --- 5575,5581 ----
| Break _ -> true | Break _ -> true
| If (_, b1, b2, _) -> | If (_, b1, b2, _) ->
blockCanBreak b1 || blockCanBreak b2 blockCanBreak b1 || blockCanBreak b2
...@@ -232,7 +234,7 @@ ...@@ -232,7 +234,7 @@
| Block b -> blockCanBreak b | Block b -> blockCanBreak b
*************** ***************
*** 5522,5527 **** *** 5522,5527 ****
--- 5583,5589 ---- --- 5585,5591 ----
List.exists stmtCanBreak b.bstmts List.exists stmtCanBreak b.bstmts
in in
if blockFallsThrough !currentFunctionFDEC.sbody then begin if blockFallsThrough !currentFunctionFDEC.sbody then begin
...@@ -241,8 +243,21 @@ ...@@ -241,8 +243,21 @@
match unrollType !currentReturnType with match unrollType !currentReturnType with
TVoid _ -> None TVoid _ -> None
*************** ***************
*** 5537,5542 **** *** 5537,5549 ****
--- 5599,5605 ---- !currentFunctionFDEC.sbody.bstmts <-
!currentFunctionFDEC.sbody.bstmts
@ [mkStmt (Return(retval, endloc))]
end;
(* ignore (E.log "The env after finishing the body of %s:\n%t\n"
n docEnv); *)
cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
empty
! with e -> begin
ignore (E.log "error in collectFunction %s: %s\n"
n (Printexc.to_string e));
cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
--- 5601,5615 ----
!currentFunctionFDEC.sbody.bstmts <- !currentFunctionFDEC.sbody.bstmts <-
!currentFunctionFDEC.sbody.bstmts !currentFunctionFDEC.sbody.bstmts
@ [mkStmt (Return(retval, endloc))] @ [mkStmt (Return(retval, endloc))]
...@@ -250,9 +265,68 @@ ...@@ -250,9 +265,68 @@
end; end;
(* ignore (E.log "The env after finishing the body of %s:\n%t\n" (* ignore (E.log "The env after finishing the body of %s:\n%t\n"
n docEnv); *)
cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
empty
! with E.Error as e -> raise e
! | e -> begin
ignore (E.log "error in collectFunction %s: %s\n"
n (Printexc.to_string e));
cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
***************
*** 5596,5609 ****
* local context *)
addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
cabsPushGlobal (GType (ti, !currentLoc))
! with e -> begin
ignore (E.log "Error on A.TYPEDEF (%s)\n"
(Printexc.to_string e));
cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
end
in
List.iter createTypedef nl
! with e -> begin
ignore (E.log "Error on A.TYPEDEF (%s)\n"
(Printexc.to_string e));
let fstname =
--- 5662,5677 ----
* local context *)
addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
cabsPushGlobal (GType (ti, !currentLoc))
! with E.Error as e -> raise e
! | e -> begin
ignore (E.log "Error on A.TYPEDEF (%s)\n"
(Printexc.to_string e));
cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
end
in
List.iter createTypedef nl
! with E.Error as e -> raise e
! | e -> begin
ignore (E.log "Error on A.TYPEDEF (%s)\n"
(Printexc.to_string e));
let fstname =
***************
*** 5650,5656 ****
| _ ->
ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
! with e -> begin
ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
(Printexc.to_string e));
cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
--- 5718,5725 ----
| _ ->
ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
! with E.Error as e -> raise e
! | e -> begin
ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
(Printexc.to_string e));
cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
*************** ***************
*** 5738,5743 **** *** 5738,5743 ****
--- 5801,5807 ---- --- 5807,5813 ----
doCondition false e st' sf' doCondition false e st' sf'
| A.WHILE(e,s,loc) -> | A.WHILE(e,s,loc) ->
...@@ -262,7 +336,7 @@ ...@@ -262,7 +336,7 @@
exitLoop (); exitLoop ();
*************** ***************
*** 5746,5753 **** *** 5746,5753 ****
--- 5810,5836 ---- --- 5816,5842 ----
loopChunk ((doCondition false e skipChunk loopChunk ((doCondition false e skipChunk
(breakChunk loc')) (breakChunk loc'))
@@ s') @@ s')
...@@ -300,7 +374,7 @@ ...@@ -300,7 +374,7 @@
let loc' = convLoc loc in let loc' = convLoc loc in
currentLoc := loc'; currentLoc := loc';
enterScope (); (* Just in case we have a declaration *) enterScope (); (* Just in case we have a declaration *)
--- 5840,5866 ---- --- 5846,5872 ----
in in
exitLoop (); exitLoop ();
loopChunk (s' @@ s'') loopChunk (s' @@ s'')
...@@ -330,7 +404,7 @@ ...@@ -330,7 +404,7 @@
enterScope (); (* Just in case we have a declaration *) enterScope (); (* Just in case we have a declaration *)
*************** ***************
*** 5784,5789 **** *** 5784,5789 ****
--- 5886,5920 ---- --- 5892,5926 ----
exitScope (); exitScope ();
res res
end end
...@@ -368,7 +442,7 @@ ...@@ -368,7 +442,7 @@
currentLoc := loc'; currentLoc := loc';
*************** ***************
*** 5792,5798 **** *** 5792,5798 ****
--- 5923,5932 ---- --- 5929,5938 ----
| A.CONTINUE loc -> | A.CONTINUE loc ->
let loc' = convLoc loc in let loc' = convLoc loc in
currentLoc := loc'; currentLoc := loc';
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment