Source file store_event.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
type t =
  | Txn_begin of { txn_id : int64 }
  | Txn_commit of
      { txn_id : int64
      ; frames : int
      }
  | Txn_rollback of { txn_id : int64 }
  | Savepoint_begin of
      { txn_id : int64
      ; name : string
      }
  | Savepoint_release of
      { txn_id : int64
      ; name : string
      }
  | Savepoint_rollback of
      { txn_id : int64
      ; name : string
      }
  | Wal_append of
      { txn_id : int64
      ; base_idx : int
      ; count : int
      }
  | Wal_reset of { epoch : int64 }
  | Checkpoint_begin of { target_frames : int }
  | Checkpoint_end of { pages_migrated : int }
  | Page_read of
      { txn_id : int64
      ; tree : int
      ; page : int64
      }
  | Wal_read of
      { txn_id : int64
      ; tree : int
      ; page : int64
      }
  | Page_write of
      { txn_id : int64
      ; tree : int
      ; page : int64
      }
  | Page_alloc of
      { txn_id : int64
      ; tree : int
      ; page : int64
      ; reused : bool
      }
  | Page_free of
      { txn_id : int64
      ; tree : int
      ; page : int64
      }

let label = function
  | Txn_begin _ -> "BEGIN"
  | Txn_commit _ -> "COMMIT"
  | Txn_rollback _ -> "ROLLBACK"
  | Savepoint_begin _ -> "SP_BEGIN"
  | Savepoint_release _ -> "SP_RELEASE"
  | Savepoint_rollback _ -> "SP_ROLLBACK"
  | Wal_append _ -> "WAL_APPEND"
  | Wal_reset _ -> "WAL_RESET"
  | Checkpoint_begin _ -> "CKPT_BEGIN"
  | Checkpoint_end _ -> "CKPT_END"
  | Page_read _ -> "PAGE_READ"
  | Wal_read _ -> "WAL_READ"
  | Page_write _ -> "PAGE_WRITE"
  | Page_alloc _ -> "PAGE_ALLOC"
  | Page_free _ -> "PAGE_FREE"
;;

let txn_id = function
  | Txn_begin { txn_id }
  | Txn_commit { txn_id; _ }
  | Txn_rollback { txn_id }
  | Savepoint_begin { txn_id; _ }
  | Savepoint_release { txn_id; _ }
  | Savepoint_rollback { txn_id; _ }
  | Wal_append { txn_id; _ }
  | Page_read { txn_id; _ }
  | Wal_read { txn_id; _ }
  | Page_write { txn_id; _ }
  | Page_alloc { txn_id; _ }
  | Page_free { txn_id; _ } -> Some txn_id
  | Wal_reset _ | Checkpoint_begin _ | Checkpoint_end _ -> None
;;

let tree_id_of = function
  | Page_read { tree; _ }
  | Wal_read { tree; _ }
  | Page_write { tree; _ }
  | Page_alloc { tree; _ }
  | Page_free { tree; _ } -> Some tree
  | _ -> None
;;

let pp fmt ev =
  let tag = label ev in
  match ev with
  | Txn_begin { txn_id } | Txn_rollback { txn_id } ->
    Format.fprintf fmt "%s txn=%Ld" tag txn_id
  | Txn_commit { txn_id; frames } ->
    Format.fprintf fmt "%s txn=%Ld frames=%d" tag txn_id frames
  | Savepoint_begin { txn_id; name }
  | Savepoint_release { txn_id; name }
  | Savepoint_rollback { txn_id; name } ->
    Format.fprintf fmt "%s txn=%Ld name=%s" tag txn_id name
  | Wal_append { txn_id; base_idx; count } ->
    Format.fprintf fmt "%s txn=%Ld base=%d count=%d" tag txn_id base_idx count
  | Wal_reset { epoch } -> Format.fprintf fmt "%s epoch=%Ld" tag epoch
  | Checkpoint_begin { target_frames } ->
    Format.fprintf fmt "%s target=%d" tag target_frames
  | Checkpoint_end { pages_migrated } ->
    Format.fprintf fmt "%s migrated=%d" tag pages_migrated
  | Page_read { txn_id; tree; page } | Wal_read { txn_id; tree; page } ->
    Format.fprintf fmt "%s txn=%Ld tree=%d page=%Ld" tag txn_id tree page
  | Page_write { txn_id; tree; page } ->
    Format.fprintf fmt "%s txn=%Ld tree=%d page=%Ld" tag txn_id tree page
  | Page_alloc { txn_id; tree; page; reused } ->
    Format.fprintf fmt "%s txn=%Ld tree=%d page=%Ld reused=%b" tag txn_id tree page reused
  | Page_free { txn_id; tree; page } ->
    Format.fprintf fmt "%s txn=%Ld tree=%d page=%Ld" tag txn_id tree page
;;