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

Port memory spaces changes to latest prototype compiler.

Location:
Deliverables/D2.3/8051-memoryspaces-branch/src/clight
Files:
1 added
6 edited

Legend:

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

    r453 r460  
    77
    88(** ** Types *)
     9
     10type memory_space = Any | Data | IData | PData | XData | Code
    911
    1012(** Clight types are similar to those of C.  They include numeric types,
     
    6264  | Tint of intsize*signedness                  (**r integer types *)
    6365  | Tfloat of floatsize                         (**r floating-point types *)
    64   | Tpointer of ctype                           (**r pointer types ([*ty]) *)
    65   | Tarray of ctype*int                         (**r array types ([ty[len]]) *)
     66  | Tpointer of memory_space * ctype            (**r pointer types ([*ty]) *)
     67  | Tarray of memory_space * ctype*int          (**r array types ([ty[len]]) *)
    6668  | Tfunction of ctype list*ctype               (**r function types *)
    6769  | Tstruct of ident*(ident*ctype) list
     
    201203  prog_funct: (ident * fundef) list ;
    202204  prog_main: ident option;
    203   prog_vars: ((ident * init_data list) * ctype) list
     205  prog_vars: (((ident * init_data list) * memory_space) * ctype) list
    204206}
  • Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightAnnotator.ml

    r453 r460  
    254254let cost_decl cost_id =
    255255  let init = [Clight.Init_int32 0] in
    256   ((cost_id, init), int_typ)
     256  (((cost_id, init), Clight.Any), int_typ)
    257257
    258258(* This is the definition of the increment cost function. *)
  • 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}
  • Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightInterpret.ml

    r453 r460  
    3434  | Tfloat _            -> assert false (* Not supported *)
    3535  | Tpointer _          -> Mem.ptr_size
    36   | Tarray (t,s)        -> s*(sizeof t)                   
     36  | Tarray (_,t,s)      -> s*(sizeof t)                   
    3737  | Tfunction (_,_)     -> assert false (* Not supported *)
    3838  | Tstruct (_,lst)     ->
     
    5656  | Tfloat _            -> assert false (* Not supported *)
    5757  | Tpointer _          -> Mem.mq_of_ptr
    58   | Tarray (c,s)        -> Mem.mq_of_ptr
     58  | Tarray (_,c,s)      -> Mem.mq_of_ptr
    5959  | Tfunction (_,_)     -> assert false (* Not supported *)
    6060  | Tstruct (_,_)       -> Mem.mq_of_ptr
     
    187187  | _ -> false
    188188let is_pointer_type = function
    189   | Tpointer _ | Tarray (_,_) | Tstruct (_,_)
     189  | Tpointer _ | Tarray _ | Tstruct (_,_)
    190190  | Tunion (_,_) | Tcomp_ptr _ -> true
    191191  | _ -> false
     
    203203  (* Cast float*)
    204204  | (v,_,Tfloat _)                              -> assert false(*Not supported*)
    205   (* Cast pointeur *)
    206   | (v,Tarray(_,_),Tpointer _)                  -> v
    207   | (v,Tpointer _,Tarray(_,_))                  -> v
     205  (* Cast pointeur FIXME: ignores memory spaces *)
     206  | (v,Tarray _,Tpointer _)                     -> v
     207  | (v,Tpointer _,Tarray _)                     -> v
    208208  | (v,Tpointer _,Tpointer _)                   -> v
    209   | (v,Tarray (_,_),Tarray(_,_))                -> v
     209  | (v,Tarray _,Tarray _)                       -> v
    210210  (*Struct and pointer to struct FIXME: is it correct ?*)
    211   | (v,Tstruct(a,b),Tpointer (Tstruct(c,d))) when a=c && b=d -> v
    212   | (v,Tpointer (Tstruct(a,b)),Tstruct(c,d)) when a=c && b=d -> v
     211  | (v,Tstruct(a,b),Tpointer (_,Tstruct(c,d))) when a=c && b=d -> v
     212  | (v,Tpointer (_,Tstruct(a,b)),Tstruct(c,d)) when a=c && b=d -> v
    213213  (*Union and pointer to union FIXME: is it correct ?*)
    214   | (v,Tunion(a,b),Tpointer (Tunion(c,d))) when a=c && b=d -> v
    215   | (v,Tpointer (Tunion(a,b)),Tunion(c,d)) when a=c && b=d -> v
     214  | (v,Tunion(a,b),Tpointer (_,Tunion(c,d))) when a=c && b=d -> v
     215  | (v,Tpointer (_,Tunion(a,b)),Tunion(c,d)) when a=c && b=d -> v
    216216  (* error *)
    217217  | (e,_,_)                                     ->
     
    226226
    227227let get_subtype = function
    228   | Tarray(t,_) -> t
    229   | Tpointer t -> t
     228  | Tarray(_,t,_) -> t
     229  | Tpointer (_,t) -> t
    230230  | _ -> assert false (*Misuse of get_subtype*)
    231231
     
    481481
    482482let is_struct = function
    483   | Tarray (_,_) | Tunion (_,_) | Tstruct (_,_) -> true
     483  | Tarray _ | Tunion (_,_) | Tstruct (_,_) -> true
    484484  | _ -> false
    485485
     
    641641  | Init_addrof (_,_)   -> assert false (*FIXME what is this ?*)
    642642
    643 let alloc_datas m ((_,lst),ty) =
     643(* FIXME: ignores memory space *)
     644let alloc_datas m (((_,lst),_),ty) =
    644645  let store_data (m,ptr) = function (*FIXME signed ?*)
    645646    | Init_int8  i -> (Mem.store m Memory.MQ_int8signed ptr (Value.of_int i)
     
    661662    Valtbl.add f (Value.of_int (-i-1)) fct;
    662663    (g,f)
     664  (* FIXME: ignores memory space *)
    663665  and alloc_var (m,g) v =
    664666    let (m',ptr) = alloc_datas m v in
     
    666668        let (m2,ptr2) = Mem.alloc m' (Mem.ptr_size) in
    667669        let m3 = Mem.store m2 Mem.mq_of_ptr ptr2 ptr in
    668         Hashtbl.add g (fst (fst v)) ptr2;(m3,g)
     670        Hashtbl.add g (fst (fst (fst v))) ptr2;(m3,g)
    669671      else
    670         ( (Hashtbl.add g (fst (fst v)) ptr);(m',g) )
     672        ( (Hashtbl.add g (fst (fst (fst v))) ptr);(m',g) )
    671673  in let (m,g) =
    672674    List.fold_left alloc_var (Mem.empty,Hashtbl.create 13) prog.prog_vars
  • Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightPrinter.ml

    r453 r460  
    1919open AST
    2020open Clight
     21
     22let name_space = function
     23  | Any -> ""
     24  | Data -> "__data "
     25  | IData -> "__idata "
     26  | PData -> "__pdata "
     27  | XData -> "__xdata "
     28  | Code -> "__code "
     29
    2130
    2231let name_unop = function
     
    7887  if String.length id > 0 && id.[0] = '*' then "(" ^ id ^ ")" else id
    7988
    80 let rec name_cdecl id ty =
     89(* Use Any for the space when nothing should appear. *)
     90
     91let rec name_cdecl sp id ty =
     92  let ssp = name_space sp in
    8193  match ty with
    8294  | Tvoid ->
    83       "void" ^ name_optid id
     95      ssp ^ "void" ^ name_optid id
    8496  | Tint(sz, sg) ->
    85       name_inttype sz sg ^ name_optid id
     97      ssp ^ name_inttype sz sg ^ name_optid id
    8698  | Tfloat sz ->
    87       name_floattype sz ^ name_optid id
    88   | Tpointer t ->
    89       name_cdecl ("*" ^ id) t
    90   | Tarray(t, n) ->
     99      ssp ^ name_floattype sz ^ name_optid id
     100  | Tpointer (sp',t) ->
     101      name_cdecl sp' ("* " ^ ssp ^ id) t
     102  | Tarray(sp', t, n) ->
     103      if sp <> sp' then eprintf "Array %s has wrong memory space.\n%!" id;
    91104      name_cdecl
     105        sp'
    92106        (sprintf "%s[%ld]" (parenthesize_if_pointer id) (Int32.of_int n))
    93107        t
    94108  | Tfunction(args, res) ->
    95109      let b = Buffer.create 20 in
     110      Buffer.add_string b ssp;
    96111      if id = ""
    97112      then Buffer.add_string b "(*)"
     
    106121          | t1::tl ->
    107122              if not first then Buffer.add_string b ", ";
    108               Buffer.add_string b (name_cdecl "" t1);
     123              Buffer.add_string b (name_cdecl Any "" t1);
    109124              add_args false tl in
    110125          add_args true args
    111126      end;
    112127      Buffer.add_char b ')';
    113       name_cdecl (Buffer.contents b) res
     128      name_cdecl Any (Buffer.contents b) res
    114129  | Tstruct(name, fld) ->
    115       name ^ name_optid id
     130      ssp ^ name ^ name_optid id
    116131  | Tunion(name, fld) ->
    117       name ^ name_optid id
     132      ssp ^ name ^ name_optid id
    118133  | Tcomp_ptr name ->
    119       name ^ " *" ^ id
     134      ssp ^ name ^ " *" ^ id
    120135
    121136(* Type *)
    122137
    123 let name_type ty = name_cdecl "" ty
     138let name_type ty = name_cdecl Any "" ty
    124139
    125140(* Expressions *)
     
    322337      | (id, ty) :: rem ->
    323338          if not first then Buffer.add_string b ", ";
    324           Buffer.add_string b (name_cdecl id ty);
     339          Buffer.add_string b (name_cdecl Any id ty);
    325340          add_params false rem in
    326341      add_params true params
     
    331346let print_function p id f =
    332347  fprintf p "%s@ "
    333             (name_cdecl (name_function_parameters id f.fn_params)
     348            (name_cdecl Any
     349                        (name_function_parameters id f.fn_params)
    334350                        f.fn_return);
    335351  fprintf p "@[<v 2>{@ ";
    336352  List.iter
    337353    (fun ((id, ty)) ->
    338       fprintf p "%s;@ " (name_cdecl id ty))
     354      fprintf p "%s;@ " (name_cdecl Any id ty))
    339355    f.fn_vars;
    340356  print_stmt p f.fn_body;
     
    345361  | External(_, args, res) ->
    346362      fprintf p "extern %s;@ @ "
    347                 (name_cdecl id (Tfunction(args, res)))
     363                (name_cdecl Any id (Tfunction(args, res)))
    348364  | Internal f ->
    349365      print_function p id f
     
    393409let re_string_literal = Str.regexp "__stringlit_[0-9]+"
    394410
    395 let print_globvar p (((id, init), ty)) =
     411let print_globvar p ((((id, init), sp), ty)) =
    396412  match init with
    397413  | [] ->
    398414      fprintf p "extern %s;@ @ "
    399               (name_cdecl id ty)
     415              (name_cdecl sp id ty)
    400416  | [Init_space _] ->
    401417      fprintf p "%s;@ @ "
    402               (name_cdecl id ty)
     418              (name_cdecl sp id ty)
    403419  | [init] ->
    404420      fprintf p "@[<hov 2>%s = %a;@]@ @ "
    405               (name_cdecl id ty) print_init1 init
     421              (name_cdecl sp id ty) print_init1 init
    406422  | _ ->
    407423      fprintf p "@[<hov 2>%s = "
    408               (name_cdecl id ty);
     424              (name_cdecl sp id ty);
    409425      if Str.string_match re_string_literal id 0
    410426      && List.for_all (function Init_int8 _ -> true | _ -> false) init
     
    424440  | Tint(sz, sg) -> ()
    425441  | Tfloat sz -> ()
    426   | Tpointer t -> collect_type t
    427   | Tarray(t, n) -> collect_type t
     442  | Tpointer (_,t) -> collect_type t
     443  | Tarray(_, t, n) -> collect_type t
    428444  | Tfunction(args, res) -> collect_type_list args; collect_type res
    429445  | Tstruct(id, fld) -> register_struct_union id fld; collect_fields fld
     
    512528  | [] -> ()
    513529  | (id, ty)::rem ->
    514       fprintf p "@ %s;" (name_cdecl id ty);
     530      fprintf p "@ %s;" (name_cdecl Any id ty);
    515531      print_fields rem in
    516532  print_fields fld;
  • Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightToCminor.ml

    r453 r460  
    2626  | Tvoid       -> Type_void
    2727  | Tfloat _    -> Type_ret Sig_float (*Not supported*)
    28   | Tpointer _ | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_) -> Type_ret Sig_ptr
     28  | Tpointer _ | Tarray _ | Tstruct (_,_) | Tunion (_,_) -> Type_ret Sig_ptr
    2929  | _           -> Type_ret Sig_int
    3030
     
    3333      Sig_float (*Not supported but needed for external function from library*)
    3434  | Tvoid       -> assert false
    35   | Tpointer _ | Tstruct (_,_) | Tunion (_,_) | Tarray(_,_) -> Sig_ptr
     35  | Tpointer _ | Tstruct (_,_) | Tunion (_,_) | Tarray _ -> Sig_ptr
    3636  | _           -> Sig_int
    3737
     
    4646  | Tint (I32,Signed)   -> Memory.MQ_int32
    4747  | Tint (I32,Unsigned) -> assert false (*FIXME why not int32unsigned exists ?*)
    48   | Tpointer _ | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_) -> ptr_mq
     48  | Tpointer _ | Tarray _ | Tstruct (_,_) | Tunion (_,_) -> ptr_mq
    4949  | Tcomp_ptr _         -> assert false (*FIXME what is this ? *)               
    5050
     
    7676  | Tint (I32,_)                -> 4
    7777  | Tpointer _                  -> ptr_size     
    78   | Tarray (c,s)                -> s*(size_of_ctype c)
     78  | Tarray (_,c,s)                -> s*(size_of_ctype c)
    7979  | Tstruct (_,lst)             ->
    8080      List.fold_left
     
    8888  | Tcomp_ptr _                 -> assert false (*FIXME what is this ?*)
    8989
    90 let translate_global_vars ((id,lst),_) = (id,init_to_data lst)
     90let translate_global_vars (((id,lst),_),_) = (id,init_to_data lst)
    9191
    9292let translate_unop t = function
     
    110110  | (Tint(_,_),Tint(_,_))       -> Op2 (Op_add,e1,e2)
    111111  | (Tfloat _,Tfloat _)         -> assert false (*Not supported*)
    112   | (Tpointer t,Tint(_,_))      ->
     112  | (Tpointer (_,t),Tint(_,_))      ->
    113113      Op2 (Op_addp,e1, Op2 (Op_mul,e2,Cst (Cst_int (size_of_ctype t))))
    114   | (Tint(_,_),Tpointer t)      ->
     114  | (Tint(_,_),Tpointer (_,t))      ->
    115115      Op2 (Op_addp,Op2 (Op_mul,e1,Cst (Cst_int (size_of_ctype t))),e2)
    116   | (Tarray (t,_),Tint(_,_))    ->
     116  | (Tarray (_,t,_),Tint(_,_))    ->
    117117      Op2 (Op_addp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
    118   | (Tint(_,_),Tarray(t,_))     ->
     118  | (Tint(_,_),Tarray(_,t,_))     ->
    119119      Op2 (Op_addp,e2,Op2 (Op_mul,e1,(Cst (Cst_int (size_of_ctype t)))))
    120120  | _                           -> assert false (*Type error*)
     
    123123  | (Tint(_,_),Tint(_,_))       -> Op2 (Op_sub,e1,e2)
    124124  | (Tfloat _,Tfloat _)         -> assert false (*Not supported*)
    125   | (Tpointer t,Tint(_,_))      ->
     125  | (Tpointer (_,t),Tint(_,_))      ->
    126126      Op2 (Op_subp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
    127   | (Tint(_,_),Tpointer t)      ->
     127  | (Tint(_,_),Tpointer (_,t))      ->
    128128      Op2 (Op_subp,Op2 (Op_mul,e1,(Cst (Cst_int (size_of_ctype t)))),e2)
    129   | (Tarray (t,_),Tint(_,_))    ->
     129  | (Tarray (_,t,_),Tint(_,_))    ->
    130130      Op2 (Op_subp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
    131   | (Tint(_,_),Tarray(t,_))     ->
     131  | (Tint(_,_),Tarray(_,t,_))     ->
    132132      Op2 (Op_subp,e2,Op2 (Op_mul,e1,(Cst (Cst_int (size_of_ctype t)))))
    133133  | _                           -> assert false (*Type error*)
     
    177177
    178178let is_struct = function
    179   | Tarray(_,_) | Tstruct (_,_) | Tunion(_,_) -> true
     179  | Tarray _ | Tstruct (_,_) | Tunion(_,_) -> true
    180180  | _ -> false
    181181
    182182let is_ptr_to_struct = function
    183   | Tpointer t when is_struct t -> true
     183  | Tpointer (_,t) when is_struct t -> true
    184184  | _ -> false 
    185185
     
    450450
    451451let is_struct = function
    452   | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_) -> true
     452  | Tarray _ | Tstruct (_,_) | Tunion (_,_) -> true
    453453  | _ -> false
    454454
     
    519519
    520520let translate p =
    521   let globals = List.map (fun p -> (fst (fst p),snd p) ) p.prog_vars in
     521  let globals = List.map (fun p -> (fst (fst (fst p)),snd p) ) p.prog_vars in
    522522  let p =
    523523    {Cminor.vars   = List.map translate_global_vars p.prog_vars;
Note: See TracChangeset for help on using the changeset viewer.