diff options
author | Xavier Leroy <xavier.leroy@inria.fr> | 2015-04-22 11:55:29 +0200 |
---|---|---|
committer | Xavier Leroy <xavier.leroy@inria.fr> | 2015-04-22 11:55:29 +0200 |
commit | ca4aa822693f4d98de99fd3f13c1523d733e1cb0 (patch) | |
tree | e4f983980a5001792b90ed8f3dbd8fa241e43eb1 | |
parent | c20644efdb39d62a225914636fb4e7816709ad9a (diff) | |
download | compcert-ca4aa822693f4d98de99fd3f13c1523d733e1cb0.tar.gz compcert-ca4aa822693f4d98de99fd3f13c1523d733e1cb0.zip |
Extended asm: more lenient treatment of constraints.
We can ignore alternatives as long as one of the constraints we
handle (r, m, i, n) is there.
-rw-r--r-- | cparser/ExtendedAsm.ml | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/cparser/ExtendedAsm.ml b/cparser/ExtendedAsm.ml index 76e368e1..8751291b 100644 --- a/cparser/ExtendedAsm.ml +++ b/cparser/ExtendedAsm.ml @@ -80,24 +80,29 @@ let is_reg_pair env ty = (* Transform the input operands: - add "&" for inputs of kind "m" - - evaluate constants for inputs of kind "i" *) + - evaluate constants for inputs of kind "i" and "n" *) + +let re_valid_input = Str.regexp "[a-zA-Z]+$" let rec transf_inputs loc env accu pos pos' subst = function | [] -> (List.rev accu, subst) | (lbl, cstr, e) :: inputs -> - match cstr with - | "r" -> + let valid = Str.string_match re_valid_input cstr 0 in + if valid && String.contains cstr 'r' then if is_reg_pair env e.etyp then transf_inputs loc env (e :: accu) (pos + 1) (pos' + 2) (set_label_regpair lbl pos pos' subst) inputs else transf_inputs loc env (e :: accu) (pos + 1) (pos' + 1) (set_label_reg lbl pos pos' subst) inputs - | "m" -> + else + if valid && String.contains cstr 'm' then transf_inputs loc env (eaddrof e :: accu) (pos + 1) (pos' + 1) (set_label_mem lbl pos pos' subst) inputs - | "i" | "n" -> + else + if valid && (String.contains cstr 'i' + || String.contains cstr 'n') then begin let n = match Ceval.integer_expr env e with | Some n -> n @@ -106,32 +111,36 @@ let rec transf_inputs loc env accu pos pos' subst = function 0L in transf_inputs loc env accu (pos + 1) pos' (set_label_const lbl pos n subst) inputs - | _ -> + end else begin error "%aUnsupported feature: asm argument of kind '%s'" formatloc loc cstr; transf_inputs loc env (e :: accu) (pos + 1) (pos' + 1) (set_label_reg lbl pos pos' subst) inputs + end (* Transform the output operands: - outputs of kind "=m" become an input (equal to the address of the output) *) +let re_valid_output = Str.regexp "=[a-zA-Z]+$" + let transf_outputs loc env = function | [] -> (None, [], StringMap.empty, 0, 0) | [(lbl, cstr, e)] -> if not (is_modifiable_lvalue env e) then error "%aError: asm output is not a modifiable l-value" formatloc loc; - begin match cstr with - | "=r" -> + let valid = Str.string_match re_valid_output cstr 0 in + if valid && String.contains cstr 'r' then if is_reg_pair env e.etyp then (Some e, [], set_label_regpair lbl 0 0 StringMap.empty, 1, 2) else (Some e, [], set_label_reg lbl 0 0 StringMap.empty, 1, 1) - | "=m" -> + else + if valid && String.contains cstr 'm' then (None, [eaddrof e], set_label_mem lbl 0 0 StringMap.empty, 1, 1) - | _ -> + else begin error "%aUnsupported feature: asm result of kind '%s'" formatloc loc cstr; (None, [], set_label_reg lbl 0 0 StringMap.empty, 1, 1) @@ -139,6 +148,8 @@ let transf_outputs loc env = function | outputs -> error "%aUnsupported feature: asm statement with 2 or more outputs" formatloc loc; + (* Bind the outputs so that we don't get another error + when substituting the text *) let rec bind_outputs pos subst = function | [] -> (None, [], subst, pos, pos) | (lbl, cstr, e) :: outputs -> |