Ignore:
Timestamp:
Jan 19, 2011, 6:23:27 PM (9 years ago)
Author:
campbell
Message:

Port memory spaces changes to latest prototype compiler.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightFromC.ml

    r453 r460  
    2020  | Tfloat F64 -> 8
    2121  | Tpointer _ -> 4
    22   | Tarray (t',n) -> alignof t'
     22  | Tarray (_,t',n) -> alignof t'
    2323  | Tfunction (_,_) -> 1
    2424  | Tstruct (_,fld) -> alignof_fields fld
     
    4343    | Tfloat F64 -> 8
    4444    | Tpointer _ -> 4
    45     | Tarray (t',n) -> sizeof t' * max 1 n
     45    | Tarray (_,t',n) -> sizeof t' * max 1 n
    4646    | Tfunction (_,_) -> 1
    4747    | Tstruct (_,fld) -> align (max 1 (sizeof_struct fld 0)) (alignof t)
     
    103103      (env, (C.Storage_static,
    104104             Env.fresh_ident name,
    105              C.TPtr(C.TInt(C.IChar,[C.AConst]),[]),
     105             C.TPtr(C.Any,C.TInt(C.IChar,[C.AConst]),[]),
    106106             None));
    107107    !define_stringlit_hook id;
     
    110110
    111111let typeStringLiteral s =
    112   Tarray(Tint(I8, Unsigned), String.length s + 1)
     112  Tarray(Code, Tint(I8, Unsigned), String.length s + 1)
    113113
    114114let global_for_string s id =
     
    120120  add_char '\000';
    121121  for i = String.length s - 1 downto 0 do add_char s.[i] done;
    122   ((id, !init), typeStringLiteral s)
     122  (((id, !init), Code), typeStringLiteral s)
    123123
    124124let globals_for_strings globs =
     
    144144      | [] -> []
    145145      | Tfloat(_)::tl -> Tfloat(F64)::(types_of_types tl)
    146       | _::tl -> Tpointer(Tvoid)::(types_of_types tl) in
     146      | _::tl -> Tpointer(Any,Tvoid)::(types_of_types tl) in
    147147    let stub_type = Tfunction (types_of_types targs, tres) in
    148148    Hashtbl.add stub_function_table stub_name stub_type;
     
    194194      F64
    195195
     196let convertSpace = function
     197  | C.Any -> Any
     198  | C.Data -> Data
     199  | C.IData -> IData
     200  | C.PData -> PData
     201  | C.XData -> XData
     202  | C.Code -> Code
     203
    196204let convertTyp env t =
    197205
     
    203211    | C.TFloat(fk, a) ->
    204212        Tfloat(convertFkind fk)
    205     | C.TPtr(C.TStruct(id, _), _) when List.mem id seen ->
     213    | C.TPtr(_,C.TStruct(id, _), _) when List.mem id seen ->
    206214        Tcomp_ptr("struct " ^ id.name)
    207     | C.TPtr(C.TUnion(id, _), _) when List.mem id seen ->
     215    | C.TPtr(_,C.TUnion(id, _), _) when List.mem id seen ->
    208216        Tcomp_ptr("union " ^ id.name)
    209     | C.TPtr(ty, a) ->
    210         Tpointer(convertTyp seen ty)
    211     | C.TArray(ty, None, a) ->
     217    | C.TPtr(sp,ty, a) ->
     218        Tpointer(convertSpace sp, convertTyp seen ty)
     219    | C.TArray(sp, ty, None, a) ->
    212220        (* Cparser verified that the type ty[] occurs only in
    213221           contexts that are safe for Clight, so just treat as ty[0]. *)
    214222        (* warning "array type of unspecified size"; *)
    215         Tarray(convertTyp seen ty, 0)
    216     | C.TArray(ty, Some sz, a) ->
    217         Tarray(convertTyp seen ty, convertInt sz )
     223        Tarray(convertSpace sp, convertTyp seen ty, 0)
     224    | C.TArray(sp, ty, Some sz, a) ->
     225        Tarray(convertSpace sp, convertTyp seen ty, convertInt sz )
    218226    | C.TFun(tres, targs, va, a) ->
    219227        if va then unsupported "variadic function type";
     
    299307      let ty1 =
    300308        match typeof e1' with
    301         | Tpointer t -> t
     309        | Tpointer (_,t) -> t
    302310        | _ -> error ("wrong type for ->" ^ id ^ " access"); Tvoid in
    303311      Expr(Efield(Expr(Ederef(convertExpr env e1), ty1),
     
    316324  | C.EBinop(C.Oindex, e1, e2, _) ->
    317325      Expr(Ederef(Expr(Ebinop(Oadd, convertExpr env e1, convertExpr env e2),
    318                        Tpointer ty)), ty)
     326                       convertTyp env e1.etyp)), ty)
    319327  | C.EBinop(C.Ologand, e1, e2, _) ->
    320328      Expr(Eandbool(convertExpr env e1, convertExpr env e2), ty)
     
    355363  match Cutil.unroll env ty with
    356364  | TFun(res, args, vararg, attr) -> Some(res, vararg)
    357   | TPtr(ty', attr) -> projFunType env ty'
     365  | TPtr(_, ty', attr) -> projFunType env ty'
    358366  | _ -> None
    359367
     
    401409  | Tfloat F64 -> ("float64", ty)
    402410  | Tpointer _ | Tarray _ | Tfunction _ | Tcomp_ptr _ ->
    403       ("pointer", Tpointer Tvoid)
     411      ("pointer", Tpointer (Any, Tvoid)) (* XXX: what is the pointer is to a different space? *)
    404412  | _ ->
    405413      unsupported "operation on volatile struct or union"; ("", Tvoid)
     
    408416  let (suffix, ty') = volatile_fun_suffix_type ty in
    409417  Expr(Evar( ("__builtin_volatile_read_" ^ suffix)),
    410        Tfunction((Tpointer Tvoid)::[], ty'))
     418       Tfunction((Tpointer (Any,Tvoid))::[], ty'))
    411419
    412420let volatile_write_fun ty =
    413421  let (suffix, ty') = volatile_fun_suffix_type ty in
    414422  Expr(Evar( ("__builtin_volatile_write_" ^ suffix)),
    415        Tfunction((Tpointer Tvoid)::(ty'::[]), Tvoid))
     423       Tfunction((Tpointer (Any,Tvoid))::(ty'::[]), Tvoid))
    416424
    417425(* Toplevel expression, argument of an Sdo *)
     
    433441          Scall(Some lhs',
    434442                volatile_read_fun (typeof rhs'),
    435                 [ Expr (Eaddrof rhs', Tpointer (typeof rhs')) ])
     443                [ Expr (Eaddrof rhs', Tpointer (Any (* XXX ? *), typeof rhs')) ])
    436444      | true, false ->                  (* volatile write *)
    437445          Scall(None,
    438446                volatile_write_fun (typeof lhs'),
    439                 [ Expr(Eaddrof lhs', Tpointer (typeof lhs')); rhs' ])
     447                [ Expr(Eaddrof lhs', Tpointer (Any (* XXX ? *), typeof lhs')); rhs' ])
    440448      | false, false ->                 (* regular assignment *)
    441449          Sassign(convertExpr env lhs, convertExpr env rhs)
     
    664672      let ty_elt =
    665673        match Cutil.unroll env ty with
    666         | C.TArray(t, _, _) -> t
     674        | C.TArray(_, t, _, _) -> t
    667675        | _ -> error "array type expected in initializer"; C.TVoid [] in
    668676      List.iter (cvtInit ty_elt) il
     
    691699(** Global variable *)
    692700
    693 let convertGlobvar env (sto, id, ty, optinit as decl) =
     701let convertGlobvar env space (sto, id, ty, optinit as decl) =
    694702  let id' =  id.name in
    695703  let ty' = convertTyp env ty in
     
    702710  Hashtbl.add decl_atom id' (env, decl);
    703711  !define_variable_hook id' decl;
    704   ((id', init'), ty')
     712  (((id', init'), convertSpace space), ty')
    705713
    706714(** Convert a list of global declarations.
     
    715723      updateLoc g.gloc;
    716724      match g.gdesc with
    717       | C.Gdecl((sto, id, ty, optinit) as d) ->
     725      | C.Gdecl(space, ((sto, id, ty, optinit) as d)) ->
    718726          (* Prototyped functions become external declarations.
    719727             Variadic functions are skipped.
     
    728736              convertGlobdecls env funs vars gl'
    729737          | _ ->
    730               convertGlobdecls env funs (convertGlobvar env d :: vars) gl'
     738              convertGlobdecls env funs (convertGlobvar env space d :: vars) gl'
    731739          end
    732740      | C.Gfundef fd ->
     
    770778        updateLoc g.gloc;
    771779        match g.gdesc with
    772         | C.Gdecl(sto, id, ty, None) ->
     780        | C.Gdecl(_, (sto, id, ty, None)) ->
    773781            if IdentSet.mem id defs
    774782            then clean defs accu gl
    775783            else clean (IdentSet.add id defs) (g :: accu) gl
    776         | C.Gdecl(_, id, ty, _) ->
     784        | C.Gdecl(_, (_, id, ty, _)) ->
    777785            if IdentSet.mem id defs then
    778786              error ("multiple definitions of " ^ id.name);
     
    818826  if List.mem C.AConst a then true else
    819827  match Cutil.unroll env t with
    820   | C.TArray(t', _, _) -> type_is_readonly env t'
     828  | C.TArray(_, t', _, _) -> type_is_readonly env t'
    821829  | _ -> false
    822830
     
    856864  typedefs = [
    857865    (* keeps GCC-specific headers happy, harmless for others *)
    858     "__builtin_va_list", C.TPtr(C.TVoid [], [])
     866    "__builtin_va_list", C.TPtr(C.Any, C.TVoid [], [])
    859867  ];
    860868  functions = [
    861869    (* The volatile read/volatile write functions *)
    862870    "__builtin_volatile_read_int8unsigned",
    863         (TInt(IUChar, []), [TPtr(TVoid [], [])], false);
     871        (TInt(IUChar, []), [TPtr(C.Any, TVoid [], [])], false);
    864872    "__builtin_volatile_read_int8signed",
    865         (TInt(ISChar, []), [TPtr(TVoid [], [])], false);
     873        (TInt(ISChar, []), [TPtr(C.Any, TVoid [], [])], false);
    866874    "__builtin_volatile_read_int16unsigned",
    867         (TInt(IUShort, []), [TPtr(TVoid [], [])], false);
     875        (TInt(IUShort, []), [TPtr(C.Any, TVoid [], [])], false);
    868876    "__builtin_volatile_read_int16signed",
    869         (TInt(IShort, []), [TPtr(TVoid [], [])], false);
     877        (TInt(IShort, []), [TPtr(C.Any, TVoid [], [])], false);
    870878    "__builtin_volatile_read_int32",
    871         (TInt(IInt, []), [TPtr(TVoid [], [])], false);
     879        (TInt(IInt, []), [TPtr(C.Any, TVoid [], [])], false);
    872880    "__builtin_volatile_read_float32",
    873         (TFloat(FFloat, []), [TPtr(TVoid [], [])], false);
     881        (TFloat(FFloat, []), [TPtr(C.Any, TVoid [], [])], false);
    874882    "__builtin_volatile_read_float64",
    875          (TFloat(FDouble, []), [TPtr(TVoid [], [])], false);
     883         (TFloat(FDouble, []), [TPtr(C.Any, TVoid [], [])], false);
    876884    "__builtin_volatile_read_pointer",
    877          (TPtr(TVoid [], []), [TPtr(TVoid [], [])], false);
     885         (TPtr(C.Any, TVoid [], []), [TPtr(C.Any, TVoid [], [])], false);
    878886    "__builtin_volatile_write_int8unsigned",
    879         (TVoid [], [TPtr(TVoid [], []); TInt(IUChar, [])], false);
     887        (TVoid [], [TPtr(C.Any, TVoid [], []); TInt(IUChar, [])], false);
    880888    "__builtin_volatile_write_int8signed",
    881         (TVoid [], [TPtr(TVoid [], []); TInt(ISChar, [])], false);
     889        (TVoid [], [TPtr(C.Any, TVoid [], []); TInt(ISChar, [])], false);
    882890    "__builtin_volatile_write_int16unsigned",
    883         (TVoid [], [TPtr(TVoid [], []); TInt(IUShort, [])], false);
     891        (TVoid [], [TPtr(C.Any, TVoid [], []); TInt(IUShort, [])], false);
    884892    "__builtin_volatile_write_int16signed",
    885         (TVoid [], [TPtr(TVoid [], []); TInt(IShort, [])], false);
     893        (TVoid [], [TPtr(C.Any, TVoid [], []); TInt(IShort, [])], false);
    886894    "__builtin_volatile_write_int32",
    887         (TVoid [], [TPtr(TVoid [], []); TInt(IInt, [])], false);
     895        (TVoid [], [TPtr(C.Any, TVoid [], []); TInt(IInt, [])], false);
    888896    "__builtin_volatile_write_float32",
    889         (TVoid [], [TPtr(TVoid [], []); TFloat(FFloat, [])], false);
     897        (TVoid [], [TPtr(C.Any, TVoid [], []); TFloat(FFloat, [])], false);
    890898    "__builtin_volatile_write_float64",
    891          (TVoid [], [TPtr(TVoid [], []); TFloat(FDouble, [])], false);
     899         (TVoid [], [TPtr(C.Any, TVoid [], []); TFloat(FDouble, [])], false);
    892900    "__builtin_volatile_write_pointer",
    893          (TVoid [], [TPtr(TVoid [], []); TPtr(TVoid [], [])], false)
     901         (TVoid [], [TPtr(C.Any, TVoid [], []); TPtr(C.Any, TVoid [], [])], false)
    894902  ]
    895903}
Note: See TracChangeset for help on using the changeset viewer.