Library topsy_hmAlloc
Load seplog_header.
Require Import topsy_hm.
Require Import Bool.
Definition ENTRYSIZE (x:var.v) (tmp:var.v) :=
tmp <-* (x -.> next);
tmp <- (var_e tmp -e var_e x -e int_e 2%Z);
ifte (nat_e 0 >> var_e tmp) thendo
tmp <- nat_e 0
elsedo
skip.
Definition findFree (size:nat) (entry fnd sz stts:var.v) :=
entry <- var_e hmStart;
stts <-* (entry -.> status);
fnd <- int_e 0%Z;
while ((var_e entry =/= null) &&& (var_e fnd =/= int_e 1%Z)) (
stts <-* (entry -.> status);
ENTRYSIZE entry sz;
ifte ((var_e stts == Free) &&& (var_e sz >>= nat_e size)) thendo
(fnd <- int_e 1%Z)
elsedo
(entry <-* (entry -.> next))).
Definition LEFTOVER : nat := 8.
Definition compact' (cptr nptr brk tmp cstts nstts:var.v) :=
while (var_e cptr =/= null) (
nptr <-* (cptr -.> next);
brk <- nat_e 1 ;
cstts <-* (cptr -.> status);
while ((var_e cstts == Free) &&& (var_e nptr =/= null) &&& (var_e brk == nat_e 1)) (
nstts <-* (nptr -.> status);
ifte (var_e nstts =/= Free) thendo (
brk <- nat_e 0
) elsedo (
tmp <-* nptr -.> next;
cptr -.> next *<- var_e tmp ;
nptr <- (var_e tmp)
)
);
cptr <-* (cptr -.> next)
).
Definition compact (cptr nptr stts:var.v) :=
while (var_e cptr =/= null) (
stts <-* (cptr -.> status);
ifte (var_e stts == Free) thendo (
nptr <-* (cptr -.> next);
stts <-* (nptr -.> status);
while (var_e stts == Free) (
stts <-* (nptr -.> next);
(cptr -.> next) *<- var_e stts;
nptr <- var_e stts;
stts <-* (nptr -.> status)))
elsedo
skip;
cptr <-* (cptr -.> next)).
Definition split (entry:var.v) (size:nat) (cptr sz:var.v) :=
ENTRYSIZE entry sz;
ifte (var_e sz >>= (nat_e size +e nat_e LEFTOVER +e nat_e 2)) thendo (
cptr <- var_e entry +e nat_e 2 +e nat_e size;
sz <-* (entry -.> next);
(cptr -.> next) *<- var_e sz;
(cptr -.> status) *<- Free;
(entry -.> next) *<- var_e cptr)
elsedo
skip
;
(entry -.> status) *<- Allocated.
Definition HM_ALLOCFAILED := int_e 0%Z.
Definition HM_ALLOCOK := int_e 1%Z.
Definition hmAlloc (result:var.v) (size: nat) (entry:var.v) (cptr fnd stts nptr sz:var.v) :=
result <- null;
findFree size entry fnd sz stts;
ifte (var_e entry == null) thendo (
cptr <- var_e hmStart;
compact cptr nptr stts;
findFree size entry fnd sz stts
) elsedo
skip
;
ifte (var_e entry == null) thendo (
result <- HM_ALLOCFAILED
) elsedo (
split entry size cptr sz;
result <- var_e entry +e nat_e 2
).
Ltac Resolve_topsy :=
match goal with
| id: Heap_List ?l ?adr ?s1 ?h |-
Heap_List ?l ?adr ?s2 ?h =>
eapply Heap_List_inde_store; apply id
| |- (?s |b= ?b) =>
(
(rewrite <- expr_b_store_update_rewrite; Omega_exprb) ||
Omega_exprb
)
| |- ?P /\ ?Q => split; Resolve_topsy
| |- _ => auto
end.
Definition findFree_specif := forall adr x sizex size,
size > 0 -> adr > 0 ->
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null)) }}
findFree size entry fnd sz stts
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null)) /\
((exists y, exists size'', size'' >= size /\
In_hl l (y,size'',free) adr /\
(s |b= (var_e entry == nat_e y) &&& (nat_e y >> null)))
\/
s |b= var_e entry == null) }}.
Lemma findFree_verif : findFree_specif.
Definition brk := 10.
Hint Unfold brk.
Definition tmp := 11.
Hint Unfold tmp.
Definition cstts := 12.
Hint Unfold cstts.
Definition nstts := 13.
Hint Unfold nstts.
Definition compact'_specif:= forall adr size x sizex,
size > 0 -> adr > 0 ->
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\ (s |b= (var_e hmStart == nat_e adr) &&&
(var_e result == null) &&& (var_e cptr == nat_e adr)) }}
compact' cptr nptr brk tmp cstts nstts
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null)) }}.
Lemma compact'_verif: compact'_specif.
Definition compact_specif:= forall adr size sizex x,
size > 0 -> adr > 0 ->
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null) &&& (var_e cptr == nat_e adr)) }}
compact cptr nptr stts
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null)) }}.
Lemma compact_verif : compact_specif.
Definition split_specif := forall adr size sizex x,
size > 0 -> adr > 0 ->
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= (var_e hmStart == nat_e adr) &&& (var_e result == null)) /\
(exists y, exists size'', size'' >= size /\
In_hl l (y,size'',free) adr /\
(s |b= var_e entry == nat_e y) /\
y > 0 /\ y <> x) }}
split entry size cptr sz
{{ fun s h => exists l, In_hl l (x,sizex,alloc) adr /\
(exists y, y > 0 /\ (s |b= var_e entry == nat_e y) /\
(exists size'', size'' >= size /\
(Heap_List l adr ** Array (y+2) size'') s h /\
In_hl l (y,size'',alloc) adr /\ y <> x)) }}.
Lemma split_verif : split_specif.
Definition hmAlloc_specif := forall adr x sizex size,
adr > 0 -> size > 0 ->
{{ fun s h => exists l, Heap_List l adr s h /\
In_hl l (x,sizex,alloc) adr /\
(s |b= var_e hmStart == nat_e adr) }}
hmAlloc result size entry cptr fnd stts nptr sz
{{ fun s h =>
(exists l, exists y, y > 0 /\ (s |b= var_e result == nat_e (y+2)) /\
exists size'', size'' >= size /\
(Heap_List l adr ** Array (y + 2) size'') s h /\
In_hl l (x,sizex,alloc) adr /\ In_hl l (y,size'',alloc) adr /\
x <> y)
\/
(exists l, (s |b= var_e result == nat_e 0) /\
Heap_List l adr s h /\ In_hl l (x,sizex,alloc) adr) }}.
Lemma hmAlloc_verif: hmAlloc_specif.
Eval_b_hyp H8.
Eval_b_hyp H9.