source: Deliverables/D2.2/8051/src/common/primitive.ml @ 1491

Last change on this file since 1491 was 818, checked in by ayache, 9 years ago

32 and 16 bits operations support in D2.2/8051

File size: 4.7 KB
Line 
1
2(** These are the functions provided by the runtime system. *)
3
4
5let error_prefix = "Primitives"
6let error s = Error.global_error error_prefix s
7let warning s = Error.warning error_prefix s
8
9
10let print_schar =
11  ("print_schar", "extern void print_schar(signed char);")
12let print_uchar =
13  ("print_uchar", "extern void print_uchar(unsigned char);")
14let print_sshort =
15  ("print_sshort", "extern void print_sshort(signed short);")
16let print_ushort =
17  ("print_ushort", "extern void print_ushort(unsigned short);")
18let print_sint =
19  ("print_sint", "extern void print_sint(signed int);")
20let print_uint =
21  ("print_uint", "extern void print_uint(unsigned int);")
22let scan_int =
23  ("scan_int", "extern int scan_int(void);")
24let alloc =
25  ("alloc", "extern int* alloc(int);")
26let newline =
27  ("newline", "extern void newline(void);")
28let space =
29  ("space", "extern void space(void);") 
30
31let ident = fst
32
33let proto = snd
34
35let primitives_list =
36  [print_schar ; print_uchar ; print_sshort ; print_ushort ;
37   print_sint ; print_uint ; scan_int ; alloc ; newline ; space]
38
39
40let args_byte_size = function
41  | s when s = ident print_schar || s = ident print_uchar -> AST.QInt 1
42  | s when s = ident print_sshort || s = ident print_ushort -> AST.QInt 2
43  | s when s = ident print_sint || s = ident print_uint -> AST.QInt 4
44  | s when s = ident scan_int || s = ident newline || s = ident space ->
45    AST.QInt 0
46  | s when s = ident alloc -> AST.QPtr
47  | s -> error ("unknown primitive " ^ s ^ ".")
48
49
50let primitives =
51  List.fold_left (fun res f -> StringTools.Set.add f res) StringTools.Set.empty
52    (List.map ident primitives_list)
53
54let is_primitive f = StringTools.Set.mem f primitives
55
56
57module Interpret (M : Memory.S) = struct
58
59  type res = V of M.Value.t list | A of M.Value.address
60
61  let print_integer_primitives =
62    List.map ident
63      [print_schar ; print_uchar ; print_sshort ; print_ushort ;
64       print_sint ; print_uint]
65
66  let is_print_integer_primitive f = List.mem f print_integer_primitives
67
68  let print_integer_primitive_funs = function
69    | f when f = ident print_schar ->
70      (IntValue.Int8.cast, IntValue.Int8.to_signed_int_repr)
71    | f when f = ident print_uchar ->
72      (IntValue.Int8.cast, IntValue.Int8.to_unsigned_int_repr)
73    | f when f = ident print_sshort ->
74      (IntValue.Int16.cast, IntValue.Int16.to_signed_int_repr)
75    | f when f = ident print_ushort ->
76      (IntValue.Int16.cast, IntValue.Int16.to_unsigned_int_repr)
77    | f when f = ident print_sint ->
78      (IntValue.Int32.cast, IntValue.Int32.to_signed_int_repr)
79    | f when f = ident print_uint ->
80      (IntValue.Int32.cast, IntValue.Int32.to_unsigned_int_repr)
81    | f -> error ("unknown integer printing primitive " ^ f ^ ".")
82
83  let make_int_value vs = IntValue.Int32.merge (List.map M.Value.to_int_repr vs)
84
85  let print_integer f mem vs =
86    let (cast, to_int_repr) = print_integer_primitive_funs f in
87    let i = make_int_value vs in
88    let i = cast i in
89    let i = to_int_repr i in
90    Printf.printf "%s%!" (IntValue.print_int_repr i) ;
91    (mem, V [])
92
93  let are_ints args =
94    let f res v = res && M.Value.is_int v in
95    List.fold_left f true args
96
97  let res_of_int i =
98    let i = IntValue.Int32.of_int i in
99    let is = IntValue.Int32.break i (4 / M.Value.int_size) in
100    List.map M.Value.of_int_repr is
101
102  let t mem f = function
103    | args when is_print_integer_primitive f && are_ints args ->
104      print_integer f mem args
105    | _ when f = ident scan_int ->
106      Printf.printf ": %!" ;
107      (mem, V (res_of_int (int_of_string (read_line ()))))
108    | args when f = ident alloc && are_ints args ->
109      let size = IntValue.Int32.to_int (make_int_value args) in
110      let (mem, addr) = M.alloc mem size in 
111      (mem, A addr)
112    | _ when f = ident newline ->
113      Printf.printf "\n%!" ;
114      (mem, V [])
115    | _ when f = ident space ->
116      Printf.printf " %!" ;
117      (mem, V [])
118    | _ -> error ("unknown primitive " ^ f ^ " or bad arguments.")
119end
120
121
122let print_signedness = function
123  | AST.Signed -> "s"
124  | AST.Unsigned -> "u"
125
126let print_size = string_of_int
127
128let print_type = function
129  | AST.Sig_int (size, sign) ->
130    "int" ^ (print_size size) ^ (print_signedness sign)
131  | AST.Sig_float (size, sign) ->
132    "float" ^ (print_size size) ^ (print_signedness sign)
133  | AST.Sig_offset -> "offset"
134  | AST.Sig_ptr -> "ptr"
135
136let print_type_return = function
137  | AST.Type_ret t -> print_type t
138  | AST.Type_void -> "void"
139
140let rec print_arg_types = function
141  | [] -> ""
142  | t :: ts -> (print_type t) ^ " -> " ^ (print_arg_types ts)
143
144let print_sig sg =
145  Printf.sprintf "%s%s"
146    (print_arg_types sg.AST.args)
147    (print_type_return sg.AST.res)
148
149let prototypes =
150  let f res s = res ^ "\n" ^ s in
151  (List.fold_left f "" (List.map proto primitives_list)) ^ "\n\n"
Note: See TracBrowser for help on using the repository browser.