Quelle  Model.thy

(*<*)
(*
 * Copyright 2015, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory Model
imports
  ConcurrentIMPCIMP
  (*
begin

(* From 40e16c534243 by Makarius. Doesn't seem to have a huge impact on run time now (2021-01-07) *)
declare subst_all [simp del] [[simproc del: defined_all]]

(*>*)
section‹A model of a Schism garbage collector \label{sec:gc-model}›

text ‹*This software may be distribu and modified according to the terms of

  following formalises Figures~2.8 (‹
 .9 (load and store but not alloc), and 2.15 (garbage collector) of
 🍋‹"Pizlo201xPhd"›

  additionally need to model TSO memory, the handshakes and
 
 theory Model

 {bold ‹NOTE›}: this model is for TSO
 emph{only}. We elide any details irrelevant for that mmory
 .›st"

  begin by defining the types of the various parts. Our program
  are labelled with strings for read
  of the processes in our system. The safety proof treats an
  (unbounded) number of mutators.

 › del[ del: defined_all]]

type_synonym‹

 'u process_name = mutator 'mut | gc | sys

  ‹

  garbage collection process can be in one of the following phases.

 ›

  gc_phase
 = ph_Idle
 | ph_Init
 | ph_Mark
 | ph_Sweep

  ‹

  garbage collector instructs mutators to perform certain actions,
  blocks until the mutators signal these actions are done. The
  always respond with their work list (a set of
 ). The handshake can be of one of the specified types.

 ›

  hs_type
 = ht_NOOP
 | ht_GetRoots
 | ht_GetWork

 ‹

  track how many \texttt{noop} and \texttt{get\_roots} handshakes
  process has participated in as ghost state. See
 S\ref{sec:gc_handshakes}.

 <-and

  hs_phase
 = hp_Idle ― ‹
 | hp_IdleInit
 | hp_InitMark
 | hp_Mark ― ‹
 | hp_IdleMarkSweep ― ‹done get roots›

 
 hs_step :: "hs_phase ==> hs_phase"
 
 "hs_step ph = (case ph of
 hp_Idle ==> hp_IdleInit
 | hp_IdleInit ==> hp_InitMark
 | hp_InitMark ==> hp_Mark
 | hp_Mark ==> hp_IdleMarkSweep
 | hp_IdleMarkSweep ==> hp_Idle)"

  ‹ by defi the types of the varparts. . Ouprogram

  object consists of a garbage collection mark and two partial
 . Firstly the types:

 ▪
 ▪ @{typ "'ref"} is the abstract type of object references.
 ▪ @{typ "'mut"} is the abstract type of the mutators' names.

  maps:

 ▪ ‹ aan
 references (or @{const "None"} signifying \texttt{NULL} or type
 error).
 ▪ ‹obj_payload› maps a @{typ "'field"} to non-reference
 data. For convenience we similarly allow thhat toto be \textttNULL}.}.

 ›

  gc_mark = bool

  ('field, 'payload, 'ref) object =
 obj_mark :: "gc_mark"
 obj_fields :: "'field ⇀ 'ref"
 obj_payload :: "'field ⇀ 'payload"

 ‹

  TSO store buffers track store actions, rep

 close>

  ('field, 'payload, 'ref) mem_store_action
 = mw_Mark 'ref gc_mark
 | mw_Mutate 'ref 'field "'ref option"
 | mw_Mutate_Payload 'ref 'field "'p
 | mw_fA gc_mark
 c_mark
 | mw_Phase gc_phase

 ‹

  action is a request by a mutator or the garbage collector to the
 .

 ›

  ('field, 'ref) mem_load_action
 = mr_Ref 'ref 'field
 | mr_Payload 'ref 'field
 | mr_Mark 'ref
 | mr_Phase
 | mr_fM
 | mr_fA

  ('field, 'mut, 'payload, 'ref) request_op
 = ro_MFENCE
 | ro_Load "('field, 'ref) mem_load_action"
 | ro_Store "('field, 'payload, 'ref) mem_store_action"
 | ro_Lock
 | ro_Unlock
 | ro_Alloc
 | ro_Free 'ref
 | ro_hs_gc_load_pending 'mut
 | ro_hs_gc_store_type hs_type
 | ro_hs_gc_store_pending 'mut
 | ro_hs_gc_load_W
 | ro_hs_mut_load_pending
 | ro_hs_mut_load_type
 | ro_hs_mut_done "'ref set"

  "LoadfM ≡
  "LoadMark r ≡
  "LoadPayload r f ≡
  "LoadPhase \<| 
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

  "StorefA m ≡ ro_Store (mw_fA m)"
  "StorefM m ≡work list (aset of
  "StoreMark r m ≡ ro_Store (mw_Mark r m)"
  "StorePayload r f pl ≡ ro_Store (mw_Mutate_Payload r f pl)"
  "StorePhase ph ≡ be of one of the sp types.
  "StoreRef r f r' ≡ ro_Store (mw_Mutate r f r')"

  ('field, 'mut,
 = "'mut process_name ×

  ('field, 'payload, 'ref) respesp
 = mv_Bool "bool"
 | mv_Mark "gc_mark option"
 | mv_Payload "'payload option" \<= 
 | mv_Phase "gc_phase"
 | mv_Ref "'ref option"
 | mv_Refs "'ref set"
 |mv_Void
 | mv_hs_type hs_type

 ‹

  following record is the type of all processes's local states. For
  mutators and the garbage collector, consider these to be local
  or registers.

  system's ‹fA›, ‹
 .

 ›

  ('field, 'mut, 'payload, 'ref) local_state =
 ― ‹
 heap :: "'ref ⇀clo>
 ―
  :: "'ut pproc ==>
 mem_lock :: "'mut process_name option"
 ― ‹Handshake state›
 hs_pending :: "'mut ==> bool"
 ― ‹
 ghost_hs_in_sync :: "'mut ==> bool"
 ghost_hs_phase :: "hs_phase"

 ― ‹
 new_ref :: "'ref option"
 roots :: 'reset"
 ghost_honorary_root :: "'ref set"
 payload_value :: "'payload option"
 mutator_data :: "'field ⇀ 'payload"
 mutator_hs_pending :: "boo| hp_IdleMarkSweep \\> ‹

 ―
 field_set :: " hs_step :: :: "hs_phase ==>
 mut :: "'mut"
 muts :: "'mut set"

 "hs_step ph = (case ph of
 fA :: "gc_mark"
 fM :: "gc_mark"
 cas_mark :: "gc_mark option"
 field :: "'field"
 mark :: "gc_mark option"
 phase :: "gc_phase"
 tmp_ref :: "'ref"
 ref :: "'ref option"
 refs :: "'ref set"
 W :: "'ref set"
 ―
 hs_type :: "hs_type"
 ― ‹
 ghost_honorary_grey :: "'ref set"

 ‹

  ('field, 'mut, 'payload, 'ref) gc_com
 = "(('field, 'payload, 'ref) response, location, ('field, 'mut, 'payload, 'ref) request, ('field, 'mut, 'payload, 'ref) local_state) com"
  ('field, 'mut, 'payload, 'ref) gc_loc_comp
 = "(('field, 'payloa hp_IleMa ==>
  ('field, 'mut, 'payload, 'ref) gc_pred
 = "(('field, 'payload, 'ref) response, location, 'mut process_name, ('field,
  ('field, 'mut, 'paylot ‹
 = "(('field, 'payload, 'ref) response, location, 'mut process_name, ('field, 'mut, 'payload, 'ref) request, ('field, 'mut, 'payload, 'ref) local_state) system"

  ('fielypes
java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
  ('field, 'mut, 'payload, 'ref) gc_history
 = "('field, 'mut, 'payload, 'ref) gc_event list"

  ('field, 'mut, 'payload, 'ref) lst_pred
 = "('field, 'mut, 'payload, 'ref) local_state ==> bool"

  ('field, 'mut, 'payload, 'ref) lsts
 = "'mut process_name ==> ('field, 'mut, 'payload, 'ref) local_state"

  ('field, 'mut, 'payload, 'ref) lsts_pred
 = "('field, 'mut, 'payload, 'ref) lsts ==> bool"

 ‹▪

  use one locale per process to define a namespace for definitions
  to these processes. Mutator definitions are parametrised by the
 's identifier ‹m›. We never interpret these locales; we
  use their contents by prefixing identifiers with the locale
 . This might be considered an abuse. The attributes depend on
  scoping somewhat, which is a mixed blessing.

  we have more than one mutator then we need to show that mutators do
  mutually interfere. To that end we define an extra locale that
  these proofs.

 ›

  mut_m = fixes m :: "<^item 
  mut_m' = mut_m + fixes m' :: "'mut" assumes mm'[iff]: "m ≠ m'"
  gc
  sys


 ‹Object marking \label{sec:gc-marking}›

 ‹

  the he mutato and the garbage collector mark references, which
  that a reference is live in the current round of
 . This operation is defined in 🍋
  by the name of the process.

 ›

 
 fixes p :: "'mut process_name"
 

  lock_syn :: "location ==>
 "lock_syn l ≡ ""'field"} to no-refer
  lock_syn (‹{_} lock›)

  unlock_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" where
 "unlock_syn l ≡
  unlock_syn (‹

 
 load_mark_syn :: "location ==>
 \Rightarrow(gc_mark option \Rightarrowgc_mak opti)
 ==> ('field, 'mut, 'payload, 'ref) local_state
 ==> ('field, 'mut, 'payload, 'ref) local_state) ==> ('field, 'mut, 'payload, 'ref) gc_com"
 
 "load_mark_syn l r upd ≡ {l} Request (λs. (p, LoadMark (r s))) (λmv s. { upd ⟨"
  load_mark_syn (‹{_} load'_mark›

  load_fM_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" where
 "load_fM_syn l ≡ {l} Request (λ
  load_fM_syn (‹

 
 load_phase :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com"
 
 "load_phase l ≡ {l} Request (λs. (p, LoadPhase)) (λmv s. { s(phase := ph) |ph. mv = mv_Phase ph })"
  load_phase (‹

 
 store_mark_syn :: "location ==>, 'pay, 'ref) m) mem_st
 
 "store_mark_syn l r fl ≡
  store_mark_syn (‹

 
 add_to_W_syn :: "location ==> (('field, 'mut, | mw_Mutate_Payload ''ref 'field "'paload ooption"
 
 "add_to_W_syn l r ≡
  add_to (‹

 ‹

  r | mw_Phse gc_phase
  wins the \texttt{CAS} race then the reference is marked and
  to the local work list te‹

  means we cannot avoid having the mark store pending in a store
 ; in other words, we cannot have objects atomically transition
  white to grey. The following scheme blackens a white object, and
  reverts it to grey. The @{const "ghost_honorary_grey"} variable
  used to track objects undergoing this transition.

  CIMP provides no support for function calls, we prefix each
 's label with a string from its callsite.

 ›

 
 mark_object_fn :: "location ==>.
 
 "mark_object_fn l =
 {
 {mem_load_action
 {l @ ''_mo_fM''} load_fM ;;
 \<=mr_Refmr_Payload 'ref 'fi
 {l @ ''_mo_phase''}
 {l @ ''_mo_ptest''}
 ―
 {l @ ''_mo_co_lock''}
 '}
 {l @ ''_mo_co_ctest''} IF cas_mark = mark THEN
 {l @ ''_mo_co_mark''} store_mark (the ∘ ref) fM
 FI ;;
 {l @ ''_mo_co_unlock''} unlock ;;
 {l @ ''_mo_co_won''} IF cas_mark = mark THEN
 {l @ ''_mo_co_W''} ro_MFE
 FI
 FI
 FI| ro_Lad "('field, 'ref) mem_"
 FI"

 

 ‹

  worklists (field @{term "W"}) are not subject to TSO. As we later
  (\S\ref{def:valid_W_inv}), these are disjoint and hence
  on these are private to each process, with the sole
  of when the GC requests them from the mutators. We describe
  mechanism next.

 ›

 ‹

 ‹

  garbage collector needs to synchronise with the mutators.
  we do sso bby havingthe GC busy-wwait: itit sets a \open›
  then waits for each to respond.

  system side of the interface collects the responses from the
  into a single worklist, which acts as a proxy for the garbage
 's local worklist during ‹get_roots› and ‹
  carefully model the effect these handshakes have on the processes' | ro_hs_m

  system and mutators track handshake phases using ghost state; see
 S\ref ro_hs_mut_done "'ref setet"

  handshake type and handshake pending bit are not subject to TSO as we expect
  realistic implementation of handshakes would involve synchronisation.

 ›

  hp_step :: "hs_type ==> hs_phase ==> hs_phase" where
 "hp_step ht ≡
 case ht of
 ht_NOOP ==> hs_step
 | ht_GetRoots ==> hs_step
 | ht_GetWork ==> id"

  sys
 

 
 handshake :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 "handshake =
 {
 (λreq s. { (s( hs_type := ht,
 ghost_hs_in_sync := ⟨False⟩,
 ghost_hs_phase := hp_step ht (ghost_hs_phase s) ),
 mv_Void)
  |ht. req = (g(gc, ro_ ht) })
 ⊕
 (λreq s. { (s( hs_pending := (hs_pending s)(m := True) ), mv_Void)
 |m. req = "Sto r m \equivr (m r m)")"
 ⊕ {mr f pl)"
 (λreq s. { (s, mv_Bool (¬hs_pending s m))
 |m. req = (gc, ro_hs_gc_load_pending m) })
 ⊕ {''sys_hs_gc_load_W''\<rbraceabbreviation
 (λreq s. { (s( W := {} ), mv_Refs (W s))
 |_::unit. req = (gc, ro_hs_gc_load_W) })
 ⊕ f r \equiv (mwMuta rf r')
 (λreq s. { (s, mv_Bool (hs_pending s m))
 |m. req = (mutator m, ro_hs_mut_load_pending) })
 ⊕ {
 (λ, 'ref)) requ
 |m. req = (mutator m, ro_hs_mut_load_type) })
 ⊕ {''sys_hs_mut_done''} mut payload, 'r) req"
 (λreq s. { (s( hs_pending := (hs_pending s)(m := False),
 W := W s ∪ W',
 ghost_hs_in_sync := (ghost_hs_in_sync s)(m := True) ),
 mv_Void)
 | W'. eq = (mum, ro_hs_ W') })"

 

 ‹

  mutators' side of the interface. Also updates the ghost state
  the handshake state for @{const "ht_NOOP"} and @{const
 t_GetRoots"} but not @@{cons "ht_Ge"}.

  we could make these subject to TSO, but that would be over specification.

 ›

  mut_m
 

  mark_object_syn :: "location ==>mv
 "{| mvhs_t hs_

  mfence_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 "{ hetypof all pros local states. For

  hs_load_pending_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} hs'_load'_pending'_› [0] 71) where
 "{l} hs_load_pending_ ≡ {l} Request (λ

  hs_load_type_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} hs'_load'_type› [0] 71) where
 "{l} hs_load_type ≡ {l} Request (λs. (mutator m, ro_hs_mut_load_type)) (λmv s. { s( hs_type := ht ) |ht. mv = mv_hs_type ht})"

  hs_noop_done_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 \lbrace} o_h {}))
 (λ_ s. {s( ghost_hs_phase := hs_step (ghost_hs_phase s) )})"

  hs_get_roots_done_syn :: "location ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref set) ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} hs'_get'_roots'_done'_›) where
 "{l} hs_get_roots_done_ wl ≡ {l}>
 (λ_ s. {s( W := {}, ghost_hs_phase := hs_step (ghost_hs_phase s) )})"

  hs_get_work_d :: "location \Rightarrow('field, 'm, 'mut, 'ayload, 'ref) local_state \<ightarrow 
 "{l} hs_get_work_done wl ≡ {l} Request (λs. (mutator m, ro_hs_mut_done (wl s)))
 (λ_ s. {s( W := {} )})"

 
 handshake :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 "handshake =
 {''hs_load_pending''} hs_load_pending_ ;;
 {''hs_pending''} IF mutator_hs_pending
 THEN
 {''hs_mfence''} MFENCE ;;
 {''hs_load_ht''} hs_load_type ;;
 {''hs_noop''} IF hs_type = ⟨ht_NOOP⟩
 THEN
 {''hs_noop_done''} hs_noop_done_
 ELSE {''hs_get_roots''} IF hs_type = ⟨ht_GetRoots⟩―
 THEN
 {''hs_get_roots_refs''} 🍋"'m process_n ==>
 {''hs_get_roots_loop''} WHILE \¬EMPTY refs DO
 {''hs_get_roots_loop_choose_ref''} 🍋ref :∈ Some ` 🍋refs ;;
 {''hs_get_roots_loop''} mark_object ;;
 {''hs_get_roots_loop_done''} 🍋refs := (🍋:: "'mut ==>
 OD ;;
 {''hs_get_roots_done''} hs_get_roots_done_ W
 ELSE {''hs_get_work''} IF hs_type = ⟨ht_GetWork⟩
 THEN
 {''hs_get_work_done''} hs_get_work_done W
 FI FI FI
 FI"

 

  "'ref opt"

  garbage collector's side of the interface.

 ›

  gc
 

  set_hs_type :: "location ==> hs_type ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 "{"

  set_hs_pending :: "location ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'mut) ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 lbrace>l🚫

  load_W :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} load'_W›) where
 "{l} load_W ≡ {l @ ''_load_W''} Request (λs. (gc, ro_hs_gc_load_W))
 (λresp s. {s(W := W') |W'. resp = mv_Refs W'})"

  mfence :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹ : "'fieldset"
 "{l}

 
 handshake_init :: "location ==> "'mset"
 
 "{
 {l @ ''_init_type''}Loc variables used by multiplprocesses›
 {l @ ''_init_muts''} 🍋muts := UNIV ;;
 {l @ ''_init_loop''} WHILE \¬ (EMPTY muts) DO
 {l @ ''_init_loop_choose_mut''} 🍋
 {l cas_mark :: "gc_mark option" 
 {l @ ''_init_loop_done''} 🍋muts := (🍋 field :: "'field"
 OD"

 
 handshake_done :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 
 "{l} handshake_done =
 {
java.lang.NullPointerException
 {l @ ''_done_loop_choose_mut''} 🍋mut :∈
 {
 (λs. (gc, ro_hs_gc_load_pending (mut s)))
 (λmv s. { s( muts := muts s - { mut s |done. mv = mv_Bool done ∧ done } )::"'ref se"
 OD"

 
 handshake_noop :: "loc==>(‹
 
 "{l} handshake_noop =
 {l @ ''_mfence''} MFENCE ;;
 {l} handshake_init ht_NOOP ;;
 {l} handshake_done"

 
 handshake_get_roots :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} handshake'_get'_roots›)
 
 "{= "('fi, 'pa, 're) res, loc ('fie, 'mut, 'pa, 'ref)) rrequ ('fie 'mu, 'pylo 'r) loca) com"java.lang.StringIndexOutOfBoundsException: Index 139 out of bounds for length 139
 {l} handshake_init ht_GetRoots ;;
 {, 'pa, 'ref re loca ('ield, 'mt, 'payloa, 'r) reque, ('feld, 'mut 'payl, 'rf) lloca) loc_"
 {l} load_W"

 
 handshake_get_work :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_}
 
 "{l} handshake_get_work =
 {l}, lo 'mut process_name, (''field, 'mut, ', 'pa 'ref) equest, ('fiel 'mut, 'pay, 'ref)) local) state_pred"
 {l} handshake_done ;;
 {l} load_W"

 


 ‹The system process›

  ‹

  system process models the environment in which the garbage
  and mutators execute. We translate the x86-TSO memory model
  to 🍋‹, 'mu, 'payload, 'ref) request, ('field, 'mut, , 'payload, 'ref) local_state) sysystem"
  a CIMP process. It is a reactive system: it receives requests and
  values, but initiates no communication itself. It can,
 , autonomously commit a store pending in a TSO store buffer.

  memory bus can be locked by atomic compare-and-swap (\texttt{CAS})
  (and others in general). A processor is not blocked
 i.e., it can read from memory) when it holds the lock, or no-one
 .

 ›

 
 not_blocked :: "('field, 'mut, 'payload, 'ref) local_state ==> 'mut process_name ==> bool"
 
 "not_blocked s p = (case mem_lock s of None ==> True | Some p' ==> p = p')"

 ‹

  compute the view a processor has of memory by applying all its
  stores.

 ›

 
 do_store_action :: "('field, 'payload, 'ref) mem_store_action ==>, paylo, 'ref) requ ×
 
 "do_store_action wact =
 (λs. case wact of
 mw_Mark r gc_mark ==> s(heap := (heap s)(r := map_option (λobj. obj(obj_mark := gc_mark)) (heap s r)))
 | mw_Mutate r f new_r ==> s(heap := (heap s)(r := map_option (λobj. obj(obj_fields := (obj_fields obj)(f := new_r) )) (heap s r)))
 | mw_Mutate_Payload r f pl ==> s(heap := (heap s)(r := map_option (λobj. obj(obj_payload := (obj_payload obj)(f := pl) )) (heap s r)))
 | mw_fM gc_mark ==> s(fM := gc_mark)
 | mw_fA gc_mark ==> s(fA := gc_mark)
 | mw_Phase gc_phase ==> s(phase := gc_phase))"

 
 fold_stores :: "('field, 'payload, 'ref) mem_store_action list ==> ('field, 'mut, 'payload, 'ref) local_state ==> ('field, 'mut, 'payload, 'ref) local_state"
 
 "fold_stores ws = fold (λw. (∘) (do_store_action w)) ws id"

 
 processors_view_of_memory :: "'mut process_name ==> ('field, 'mut, 'payload, 'ref) local_state ==> ('field, 'mut, 'payload, 'ref) local_state"
 
 "processors_view_of_memory p s ≡ fold_stores (mem_store_buffers s p) s"

 
 do_load_action :: "('field, 'ref) mem_load_action
 ==> ('field, 'mut, 'payload, 'ref) local_state
 ==> ('field, 'payload, 'ref) response"
 
 "do_load_action ract =
 (λs. case ract of
 mr_Ref r f ==> mv_Ref (Option.bind (heap s r) (λobj. obj_fields obj f))
 | mr_Payload r f ==> mv_Payload (Option.bind (heap s r) (λobj. obj_payload obj f))
 | mr_Mark r ==>
 | mr_Phase \Rightarrow (phase s)
 | mr_fM ==> mv_Mark (Some (fM s))
  mr_fA ==>

 
 sys_load :: "'mut process_name
 ==> ('field, 'ref) mem_load_action
 ==> ('field, 'mut, 'payload, 'ref) local_state
 ==> ('field, 'payload, 'ref) response"
 
 "sys_load p ract = do_load_action ract ∘mu, 'pay, 'ref)) ls

  sys
 

 ‹

 🍋
  the earlier 🍋‹"DBLP:conf/tphol/OwensSS09"› by allowing the TSO lock to be taken by a
  with a non-empty store buffer. We omit their treatment of
 ; these are handled by the local states of the other
 . The system can autonomously take the oldest store in the
  buffer for processor ‹p› and commit it = "('field, 'mut, 'pay, 'paylo, 'ref) lsts 🚫
  ‹p› either holds the lock or no processor does.

 ›

 
 mem_TSO :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 "mem_TSO =
 {''tso_load''} Response (λreq s. { (s, sys_load p mr s)
 |p mr. req = (p, ro_Load mr) ∧ not_blocked s p })
 ⊕ {''tso_store''} Response (λreq s. { (s( mem_store_buffe. This mbe coan ab The attributes depend on
 |p w. req = (p, ro_Store w) })
 ⊕scoping s somewhat, , wh is a mixe blessi.
 |p. req = (p, ro_MFENCE) ∧ mem_store_buffers s p = [] })
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 |p. req = (p, ro_Lock) ∧ mem_lock s = None })
 ⊕
 |p. req = (p, ro_Unlock) ∧ mem_lock s = Some p ∧ mem_store_buffers s p = [] })
 ⊕
 | p w ws. mem_store_buffers s p = w # ws ∧ not_blocked s p ∧ p ≠

 ‹

  track whicreferences are allocat using the domain of @ @{c
 heap"}.

 label{sec:sys_alloc}

  now we assume that the system process magically allocates and
  references.

  also arrange for the object to be marked atomically (see
 S\ref{sec:mut_alloc}) which morally should be done by the mutator. In
  allocation pools enable this kind of atomicity (wrt the sweep
  in the GC described in \S\ref{sec:gc-model-gc}).

  that the \texttt{abort} in 🍋‹‹
  and the mutator can revert to activity outside of
 texttt{Alloc}, avoiding deadlock. We instead signal the r) gc_com" where
  heap explicitly, i.e., the @{const "ro_Alloc"} action cannot fail.

 ›

 
 alloc :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 "alloc = {''alloc''} Response (λreq s.
 if dom (heap s) = UNIV
 then {(s, mv_Ref None) |_::unit. snd req = ro_Alloc }
 else { ( s( heap := (heap s)(r := Some ( obj_mark = fA s, obj_fields = Map.empty, obj_payload = Map.empty )) ), mv_Ref (Some r) )
 |r. r ∉ dom (heap s) ∧ snd req = ro_Alloc })"

 ‹

  are freed by removing them from @{const "heap"}.

 ›

 
 free :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 = { s.
 { (s(heap := (heap s)(r := None)), mv_Void) |r. snd req = ro_Free r })"

 ‹

  top-level system process.

 ›

 
 
 
 "com =
 LOOP DO
 mem_TSO
 ⊕ alloc
 ⊕ free
 ⊕ handshake
 OD"

 


 ‹

 ‹

  mutators need to cooperate with the garbage collector. In
 , when the garbage collector is not idle the mutators use a
 emph{write barrier} (see \S\ref{sec:gc-marking}).

  local state for each mutator tracks a working set of references,
  abstracts from how the process's registers and stack are
  to discover roots.

 ›

  mut_m
 

 ‹

 label{sec:mut_alloc}

  is defined in 🍋‹
  how we abstract it.

 ›

  alloc :: "('field, 'mut, 'payload, 'ref) gc_com" where
 "alloc ≡
 {''alloc''} Request (λs. (mutator m, ro_Alloc))
 (λmv s. { s( roots := roots s ∪ set_option opt_r ) |opt_r. mv = mv_Ref opt_r })"

 ‹r up\<> 

  mutator can always discard any references it holds.

 ›

  discard :: "('field, 'mut, 'payload, 'ref) gc_com" where
 "discard ≡
 {''discard_refs''} LocalOp (λs. { s( roots := roots' ) |roots'. roots' ⊆ roots s })"

 ‹

  and store are defined in 🍋‹‹Figure~2.9› in "Pizlo201xPhd"›.

  a reference can inc the set o of mutato roo.

 ›

  load :: "('field, 'mut, 'payload, 'ref) gc_com" where
 "load ≡
 {
 {location \\Ri> (field,'mut,'payloa 'ref)gccom"
 (λmv s. { s( roots := roots s ∪ set_option r )
 |r. mv = mv_Ref r })"

 ‹λlparr>fM = m\rparr> m. . mv mv_Mark (Some m) }"

 label{sec:write-barriers}

  a reference involves marking both the old and new references,
 .e., both \emph{insertion} and \emph{deletion} barriers are
 . The deletion barrier preserves the \emph{weak tricolour
 }, and the insertion barrier preserves the \emph{strong
  invariant}; see \S\ref{sec:strong-tricolour-invariant} for
  discussion.

  that the the mutator reads the overwritten reference but does not
  it in its roots.

 ›

 
 mut_deref :: "location
 ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref)
 ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'field)
 ==> (('ref option ==> 'ref option) ==> ('field, 'mut, 'payload, 'ref) local_state ==> ('field, 'mut, 'payload, 'ref) local_state) ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_}
 
 "{l} deref r f upd ≡ {l}
 (λmv s. { upd ⟨opt_r'⟩ (s(mut, 'payload, 'ref) gc_c"

 
  not work in local theory mode:

 
 "_mut_fassign" :: "location ==> idt ==> 'ref ==> 'field ==>
 
 <>l> (_update_name q)

 🍋ref := 🍋tmp_ref→🍋field ;;
*)

abbreviation
  store_ref :: "location
              ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref)
              ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'field)
              ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref option)
              ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} store'_ref›)
where
  "{l} store_ref r f r' ≡ {l} Request (λs. (mutato

definition
  store :: "('field, 'mut, 'payload, 'ref) gc_com"
where
  "store =
     ―"store_mark_syn l l r fl \equiv> <lbrace>lrbrace Request (\lambda>s. (p, St (r s) (fl s))) (λgh := {r s} )
     {''store_choose''} LocalOp (λs. { s( tmp_ref := r, field := f, new_ref := r' )
                                     |r f r'. r ∈ roots s ∧ r' ∈ Some ` roots s ∪ {None} }) ;;
     ― ‹Mark the reference we're about to overwrite. Does not update roots.›
     {''deref_del''}
     {
     ― ‹
     {''lop_store_ins''} 🍋ref := 🍋new_ref ;;
     {''store_ins''} mark_object ;;
     {''store_ins''} store_ref tmp_ref field new_ref"

 ‹

  and store payload data.

 ›

  load_payload :: "('field, 'mut, 'payload, 'ref) gc_com" where
 "load_payload ≡
 {''mut_load_payload_choose''} LocalOp (λs. { s( tmp_ref := r, field := f ) |r f. r ∈
 <lbrace'mutator m LoadPayload(t s) (fiel s))
 (λmv s. { s( mutator_data := (mutator_data s)(var := pl) )
 |var pl. mv = mv_Payload pl })"

  store_payload :: "('field, 'mut, 'payload, 'ref) gc_com" where
 "store_payload ≡\rbrace'to'_W\<>)
 {''mut_store_payload_choose''} LocalOp (λs. { s( tmp_ref := r, field := f, payload_value := pl s ) |r f pl. r ∈ roots s }) ;;
 {''mut_store_payload''} Request (λs. (mutator m, StorePayload (tmp_ref s) (field s) (payload_value s)))
 (λmv s. { s( mutator_data := (mutator_data s)(f := pl) )
 |f pl. mv = mv_Payload pl })"

 ‹

  mutator makes a non-deterministic choice amongst its possible
 . For completeness we allow mutators to issue \texttt{MFENCE}
 . We leave \texttt{CAS} (etc) to future work. Neither has
  significant impact on the rest of the development.

 ›
 
  add SKIP before alloc, to th llo wo lis{const"W"}.
  to checking for handshakes in a strongly fair way. A SKIP
  the top level of ‹

  is mut local computation strong enough? only works on mutator data; not roots.
*)

definition
  com :: "('field, 'mut, 'payload, 'ref) gc_com ; in other w,we ca have objects atomical transition
where
  "com =
    LOOP DO
        {, nd
      ⊕ alloc
      ⊕ discard
      ⊕ load
      ⊕
      ⊕ load_payload
      ⊕ store_payload
      ⊕ {''mut_mfence''} MFENCE objects this
      ⊕ handshake
    OD"

end


subsection ‹

text<>

We abstract the primitive actions of the garbage collector thread.

\<close>

abbreviation
  gc_deref :: " 
 ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref)
 ==>, 'ref) loclocal_state \Rightarrow 'fied)
 ==> (('ref option ==> 'ref option) ==> ('field, 'mut, 'payload, 'ref) local_state ==> ('field, 'mut, 'payload, 'ref) local_state) ==> ('field, 'mut, 'payload, 'ref) gc_com"
 
 "gc_deref l r f upd ≡ {l} Request (λs. (gc, LoadRef (r s) (f s)))
 (λmv s. { upd ⟨r'⟩ s |r'. mv = mv_Ref r' })"

 
 gc_load_mark :: "location
 ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref)
 ==> ((gc_mark option \\lbrace>>l@ ''_mo_fM'''\rbrace load_fM;;
 ==> ('field, 'mut, 'payload, 'ref) gc_com"
 
 "gc_lo l r upd \equiv { (r s))) (🚫

 
 "_gc_fassign" :: "location ==> idt ==> 'ref ==> 'field ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} 🍋_ := 🍋_ → _› [0, 0, 0, 70] 71)
 "_gc_massign" :: "location ==> idt ==> 'ref ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} 🍋_ := 🍋_ → flag› [0, 0, 0] 71)
 
 "_gc_fassign" ⇌ gc_deref and
 "_gc_massign" ⇌ gc_load_mark
 
java.lang.NullPointerException
 "{l} 🍋m := 🍋r→flag" => "CONST gc_load_mark l r (_update_name m)"

  gc
 

  store_fA_syn :: "location ==> (('field, 'mut, 'payload, 'ref) local_state ==> gc_mark) ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹mo_co_lock''}
 "{l} store_fA f ≡ {l} Request (λs. (gc, StorefA (f s))) (λ_ s. {s})"

  load_fM_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} load'_fM›) where
 "{l} load_fM ≡ {l} Request (λs. (gc, LoadfM)) (λmv s. { s(fM := m) |m. mv = mv_Mark (Some m) })"

  store_fM_syn :: "location ==>rbrace>store_mark (th 🚫
 "{

  store_phase_syn :: "location ==> gc_phase ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹
 "{l} store_phase ph ≡ {l} Request (λs. (gc, StorePhase ph)) (λ_ s. {s( phase := ph )})"

  mark_object_syn :: "location ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} mark'_object›) where
 "{addto_W (the ∘

  free_syn :: "location ==> (('field, 'mut, 'payload, 'ref) local_state ==> 'ref) ==> ('field, 'mut, 'payload, 'ref) gc_com" (‹{_} free›) where
 "{

 open>

  following CIMP program encodes the garbage collector algorithm
  in Figure~2.15 of 🍋‹"Pizlo201xPhd"›.

 ›

  (in gc)
 com :: "('field, 'mut, 'payload, 'ref) gc_com"
 
 "com =
 LOOP DO
 {''idle_noop''} handshake_noop ;; ―

 {
 {''idle_invert_fM''} 🍋
 {

java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null

 {''idle_phase_init''} store_phase ph_Init ;;

 {open>‹

 {''init_phase_mark''} store_phase ph_Mark ;;
 {''mark_load_fM''} load_fM ;;
 {''mark_store_fA''} store_fA fM ;;

 {''mark_noop''} handshake_noop ;; ―

 {''mark_loop_get_roots''} handshak

 {''mark_loop''}
java.lang.NullPointerException
 {''mark_loop_choose_ref''}›
 {''mark_loop_fields''} 🍋field_set := UNIV ;;
java.lang.NullPointerException
 {''mark_loop_mark_choose_field''} 🍋field :∈setsa\openp🚫
 {
 {''mark_loop''} mark_object ;;
 {
 OD ;;
 \<lbrace' - \<acutetmp_ref
 OD ;;
 {''mark_loop_get_work''} handshake_get_work
 OD ;;

 ― ‹sweep›

 {''mark_end''} store_phase ph_Sweep ;;
 {''sweep_load_fM''} load_fM ;;
 {''sweep_refs''} 🍋
 {''sweep_loop''} WHILE \¬EMPTY refs DO
 {''sweep_loop_choose_ref''} 🍋tmp_ref :∈ 🍋refs ;;
 {''sweep_loop_load_mark''} 🍋mark := 🍋tmp_ref→flag ;;
 {''sweep_loop_check''}carefully model the effe these handshakeshave o the proc' TS buffe.
 {''sweep_loop_free''} free tmp_ref
 FI ;;
 {''sweep_loop_ref_done''} 🍋refs := (🍋refs - {🍋tmp_ref})
 OD ;;
 {''sweep_idle''} store_phase ph_Idle
 OD"

 

 
 gc_coms :: "'mut process_name ==>mutator track han phases using g s; see
 
 "gc_coms (mutator m) = mut_m.com m"
  "gc_coms gc = gc.com"
  "gc_coms sys = sys.com"
(*<*)

end
(*>*)