Library topsy_hmAlloc_old

Load seplog_header.
Require Import topsy_hm_old.

Open Local Scope Z_scope.

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;

(while ((var_e entry =/= null) &&& (var_e fnd =/= int_e 1)) (
  stts <-* (entry -.> status);
  (ENTRYSIZE entry sz);
  (ifte ((var_e stts == Free) &&& (var_e sz >>= nat_e size)) thendo
    (fnd <- int_e 1)
    elsedo
    (entry <-* (entry -.> next)))
)).

Definition LEFTOVER : nat := 8%nat.

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%nat)) thendo (
  cptr <- var_e entry +e nat_e 2%nat +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) (*(adr: loc)*) (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%nat
)).

Close Local Scope Z_scope.

Definition hmAlloc_specif1 := forall result adr sizex x size entry cptr fnd stts nptr sz,
  (var.set (hmStart::result::entry::cptr::fnd::stts::nptr::sz::nil)) ->
  adr > 0 -> sizex > 0 -> size > 0 ->

  {{fun s h => exists l,
        Heap_List l adr 0 s h /\
        In (x,sizex,Allocated) l /\
        eval (var_e hmStart) s = eval (nat_e adr) s }}
  
  hmAlloc result size entry cptr fnd stts nptr sz
  
  {{ fun s h =>
    (exists l, exists y, y > 0 /\ eval (var_e result) s = Z_of_nat (y+2) /\
      (exists size'', size'' >= size /\
      (Heap_List l adr 0 ** Array (y + 2) size'') s h /\
      In (x,sizex,Allocated) l /\
      In (y,size'',Allocated) l /\
      x <> y))

    \/

    (exists l, eval (var_e result) s = 0%Z /\ Heap_List l adr 0 s h /\ In (x,sizex,Allocated) l) }}.

Definition findFree_specif1 := forall adr entry fnd sz stts size sizex x result,
    size > 0 ->
    sizex > 0 ->
    adr > 0 ->
    var.set (hmStart::entry::fnd::sz::stts::result::nil) ->

    {{fun s h =>exists l, Heap_List l adr 0 s h /\
    In (x,sizex,Allocated) l /\
    eval (var_e hmStart) s = eval (nat_e adr) s /\
    eval (var_e result) s = eval null s }}

    findFree size entry fnd sz stts

    {{fun s h => exists l,
    Heap_List l adr 0 s h /\
    In (x,sizex,Allocated) l /\
    eval (var_e hmStart) s = eval (nat_e adr) s /\
    eval (var_e result) s = eval null s /\
    (
    (exists finded_free_block, exists size'', size'' >= size /\
     In (finded_free_block,size'',Free) l /\
     eval (var_e entry) s = (Z_of_nat finded_free_block) /\
     finded_free_block > 0)
    \/
    (eval (var_e entry) s = eval null s)
    )}}.

Definition compact_specif1:= forall adr cptr nptr stts size sizex x result entry,
    size > 0 ->
    sizex > 0 ->
    adr > 0 ->
    var.set (hmStart::entry::cptr::nptr::stts::result::nil) ->

    {{fun s h =>exists l, Heap_List l adr 0 s h /\
        In (x,sizex,Allocated) l /\
        eval (var_e hmStart) s = eval (nat_e adr) s /\
        eval (var_e result) s = eval null s /\
        eval (var_e cptr) s = eval (nat_e adr) s
    }}
        
        compact cptr nptr stts
        
    {{fun s h => exists l, Heap_List l adr 0 s h /\
        In (x,sizex,Allocated) l /\
        eval (var_e hmStart) s = eval (nat_e adr) s /\
        eval (var_e result) s = eval null s
    }}.

Definition split_specif1 := forall adr cptr sz size sizex x result entry,
    size > 0 ->
    sizex > 0 ->
    adr > 0 ->
    var.set (hmStart::entry::cptr::sz::result::nil) ->

{{fun s h => exists l,
    Heap_List l adr 0 s h /\
    In (x,sizex,Allocated) l /\
    eval (var_e hmStart) s = eval (nat_e adr) s /\
    eval (var_e result) s = eval null s /\
    (exists finded_free_block, exists size'', size'' >= size /\
     In (finded_free_block,size'',Free) l /\
     eval (var_e entry) s = (Z_of_nat finded_free_block) /\
     finded_free_block > 0 /\
     finded_free_block <> x) }}

   split entry size cptr sz

{{fun s h => exists l,
    In (x,sizex,Allocated) l /\
    (exists y, y > 0 /\ eval (var_e entry) s = Z_of_nat (y) /\
      (exists size'', size'' >= size /\
       (Heap_List l adr 0 ** Array (y+2) size'') s h /\
       In (y,size'',Allocated) l /\ y <> x))}}.

Lemma findFree_verif1 : findFree_specif1.

































Eval_b_hyp_clean.












Lemma compact_verif1 : compact_specif1.


















































Lemma split_verif1 : split_specif1.




































Lemma hmAlloc_verif1: hmAlloc_specif1.