Skip to content

Commit

Permalink
[PAUSED, SLOW] Rework command to use a GADT
Browse files Browse the repository at this point in the history 
Previously the command module used an unsafe procedure: Send command and
then send arguments. Using ADTs we can encode the arguments along with
the command and, with GADTs, we can also specify the return value.
Additionaly it is stated only that GADTs are benificial to performance
as they allow the compiler to know more about code paths.
Implementing GADTs proved to be relatively easy, we now have separated
commands for external use and interal use. The former exposes the
functionality and the latter represents the actual commands sent.

Unfortunately this change resulted (without further investigation) in a
considerable slowdown of about 4x. Cause is unknown at this time and it
was tested without flambda (not enough RAM for compilation). This
approach would be extremely beneficial for simplicity of use but this
performance loss is inacceptable.

This commit furthermore represents the last commit for the time being as
the new semester at university started. I will most likely continue in august.
  • Loading branch information
@Willenbrink
Willenbrink committed Apr 20, 2020
1 parent 0aa6545 commit bb6f6c2
Show file tree
Hide file tree
Showing 4 changed files with 185 additions and 154 deletions.
169 changes: 113 additions & 56 deletions lib/command.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,53 +48,65 @@ let rec addr_of_reg = function
| LISAR -> addr_of_reg MCSR + 0x08
| LISAR2 -> addr_of_reg LISAR + 0x02 (* Added here because we do not want addition to work on registers. *)

type command =
| Wakeup
| Standby
| Sleep
| Reg_read
| Reg_write
| Burst_read_trigger (* TODO can be hidden as it only occurs directly before Burst_read_start*)
| Burst_read_start
| Burst_write
| Burst_end
| Load_image
| Load_image_area
| Load_image_end
| Display_area
| Query_info
| Display_area_buffer (* TODO sample code states: Currently only one buffer. *)
| VCOM

(* TODO we could in theory also encode the parameters of the command
* to prevent invalid read/writes.
*)
type _ command =
| Wakeup : unit command
| Standby : unit command
| Sleep : unit command
| Reg_read : register -> int command
| Reg_write : register * int -> unit command
| Burst_read : int * int -> int list command
| Burst_write : int * int list -> unit command
| Load_image : int * (int * int * int * int) option * ((int -> unit) -> unit) -> unit command
(* TODO sample code states: Currently only one buffer. *)
| Display_area : int * (int * int * int * int) option * int option -> unit command
| VCOM_read : int command
| VCOM_write : int -> unit command
| Query_info : unit command

type command_internal =
| Wakeup'
| Standby'
| Sleep'
| Reg_read'
| Reg_write'
| Burst_read_trigger' (* TODO can be hidden as it only occurs directly before Burst_read_start*)
| Burst_read_start'
| Burst_write'
| Burst_end'
| Load_image'
| Load_image_area'
| Load_image_end'
| Display_area'
| Display_area_buffer'
| VCOM'
| Query_info'

let int_of_cmd = function
| Wakeup -> 0x1
| Standby -> 0x2
| Sleep -> 0x3
| Reg_read -> 0x10
| Reg_write -> 0x11
| Wakeup' -> 0x1
| Standby' -> 0x2
| Sleep' -> 0x3
| Reg_read' -> 0x10
| Reg_write' -> 0x11
(* TODO Strange note in the datasheet regarding:
* Burst_read_trigger, burst_write, load_image, load_image_area
* "For these commands, the parameters are unnecessary when bit 0 of I80CPCR is false."
* How many bytes will be read/written when this is not set? Until the bus is closed?
*)
| Burst_read_trigger -> 0x12
| Burst_read_start -> 0x13
| Burst_write -> 0x14
| Burst_end -> 0x15
| Load_image -> 0x20
| Load_image_area -> 0x21
| Load_image_end -> 0x22
| Display_area -> 0x34 (* TODO DPY? *)
| Query_info -> 0x302
| Display_area_buffer -> 0x37
| VCOM -> 0x39
| Burst_read_trigger' -> 0x12
| Burst_read_start' -> 0x13
| Burst_write' -> 0x14
| Burst_end' -> 0x15
| Load_image' -> 0x20
| Load_image_area' -> 0x21
| Load_image_end' -> 0x22
| Display_area' -> 0x34
| Display_area_buffer' -> 0x37
| VCOM' -> 0x39
| Query_info' -> 0x302

(* TODO annotate types: 8/16/32 bits *)
(* TODO investigate whether we can transmit more than 2 bytes at once *)

(* TODO rename *)
let write_cmd cmd =
Bus.(
open_bus ();
Expand All @@ -111,11 +123,15 @@ let write_data (data : int list) =
close_bus ();
)

let write_data_array send_f =
let write_cmd_args cmd args =
write_cmd cmd;
write_data args

let write_data_array array_iter =
Bus.(
open_bus ();
send 0x0000;
send_f send;
array_iter send;
close_bus ()
)

Expand All @@ -138,22 +154,63 @@ let read_datum () =
| x::[] -> x
| _ -> failwith "Error: read_data 1 returns list with length != 1"

let write_cmd_args cmd args =
write_cmd cmd;
write_data args
(* Could in theory write/read more than 16 bit according to the datasheet.
* We don't use this functionality and instead write to multiple registers (LISAR/LISAR2)
*)
let write_reg reg value =
write_cmd_args Reg_write [addr_of_reg reg; value]

let read_reg reg =
write_cmd_args Reg_read [addr_of_reg reg];
read_datum ()

let get_vcom () =
write_cmd_args VCOM [0];
read_datum ()
let split_32 value =
assert (value land 0x7FFFFFFF00000000 == 0);
(value land 0xFFFF, (value lsr 16) land 0xFFFF)

let set_vcom vcom =
write_cmd_args VCOM [1; vcom]
let write_cmd : type a. a command -> a = function
| Query_info -> write_cmd Query_info'
| Wakeup | Standby | Sleep as cmd ->
ignore cmd;
failwith "Undefined"
| Reg_read reg ->
write_cmd_args Reg_read' [addr_of_reg reg];
read_datum ()
| Reg_write (reg, value) ->
write_cmd_args Reg_write' [addr_of_reg reg; value]
| Burst_read (address, amount) ->
let (addrH,addrL) = split_32 address in
let (amountH,amountL) = split_32 amount in
write_cmd_args Burst_read_trigger' [addrH;addrL;amountH;amountL];
write_cmd Burst_read_start';
let ret : int list = read_data amount in
write_cmd Burst_end';
ret
| Burst_write (address, data) ->
let (addrH,addrL) = split_32 address in
let (amountH,amountL) = split_32 (List.length data) in
write_cmd_args Burst_write' ([addrH;addrL;amountH;amountL] @ data)
| Load_image (info,area,array_iter) ->
begin
match area with
| None ->
write_cmd_args Load_image' [info]
| Some (x,y,w,h) ->
write_cmd_args Load_image_area' [info;x;y;w;h]
end;
write_data_array array_iter;
write_cmd Load_image_end'
| Display_area (mode,area,address) ->
let x,y,w,h = match area with
| Some area -> area
| None -> (0,0,800,600) (* TODO hardcoded! *)
in
begin
match address with
| None ->
write_cmd_args Display_area' [x;y;w;h;mode]
| Some address ->
let (addrH,addrL) = split_32 address in
write_cmd_args Display_area_buffer' [x;y;w;h;mode;addrH;addrL]
end
| VCOM_write value ->
write_cmd_args VCOM' [1;value]
| VCOM_read ->
write_cmd_args VCOM' [0];
read_datum ()

(* TODO move: Could in theory write/read more than 16 bit according to the datasheet.
* We don't use this functionality and instead write to multiple registers (LISAR/LISAR2)
*)
55 changes: 20 additions & 35 deletions lib/command.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,50 +21,35 @@ type register =
| LISAR
| LISAR2 (* Added here because we do not want addition to work on registers. *)

type command =
| Wakeup
| Standby
| Sleep
| Reg_read
| Reg_write
| Burst_read_trigger (* TODO can be hidden as it only occurs directly before Burst_read_start*)
| Burst_read_start
| Burst_write
| Burst_end
| Load_image
| Load_image_area
| Load_image_end
| Display_area
| Query_info
| Display_area_buffer (* TODO sample code states: Currently only one buffer. *)
| VCOM

val write_cmd : command -> unit
type _ command =
| Wakeup : unit command
| Standby : unit command
| Sleep : unit command
| Reg_read : register -> int command
| Reg_write : register * int -> unit command
(* TODO rework to also accept 32 bit values *)
| Burst_read : int * int -> int list command
(** [Burst_read address amount] reads from the from the memory location of the IT8951 specified by [address]. The read data is [amount] long. *)
| Burst_write : int * int list -> unit command
(** [Burst_write address data] writes [data] to the memory location of the IT8951 specified by [address]. The first element of [data] is written to the address, the second to the next higer etc. *)
| Load_image : int * (int * int * int * int) option * ((int -> unit) -> unit) -> unit command
| Display_area : int * (int * int * int * int) option * int option -> unit command
(** [Display_area mode area address] displays the image stored in memory on the screen. The waveform (i.e. speed/clarity of update) is chosen via [mode]. The area displayed is [area], if specified, otherwise the whole screen is updated. [address] is used to specify which location of the memory is loaded. TODO currently untested *)
| VCOM_read : int command
| VCOM_write : int -> unit command
| Query_info : unit command

val write_cmd : 'a command -> 'a
(** [write_cmd cmd] sends a command [cmd] to the IT8951. *)

val write_data : int list -> unit
(** [write_data data] sends all elements of [data], starting at the first element, to the IT8951. *)

val write_data_array : ((int -> unit) -> unit) -> unit
(** TODO [write_data_array send_fun] passes the Bus.send function to send_fun. send_fun should then use Bus.send to send all the data contained within the array. Will be redesigned. *)
(** [write_data_array array_iter] passes the Bus.send function to array_iter. array_iter should then iterate over all the values of the array and use Bus.send to send all the data contained within the array. This function will perhaps be redesigned. TODO *)

val read_data : int -> int list
(** [read_data amount] returns a list of values of length [amount] it read from the bus. *)

val read_datum : unit -> int
(** [read_datum ()] returns a single read value. It only wraps read_data so the caller can use the datum without matching. *)

val write_cmd_args : command -> int list -> unit
(** TODO write a command together with argument list. Will be reworked. *)

val write_reg : register -> int -> unit
(** [write_reg reg val] writes the 16 rightmost bits of [val] to the register [reg]. *)

val read_reg : register -> int
(** [read_reg reg] returns the 16 rightmost bits of the register [reg]. *)

val get_vcom : unit -> int
(** TODO VCOM? [get_vcom ()] returns the current voltage applied to the VCOM. *)

val set_vcom : int -> unit
(** [set_vcom val] sets the VCOM voltage to [val]. *)
Loading

0 comments on commit bb6f6c2

Please sign in to comment.