Patch title: Release 90 bulk changes
Abstract:
File: /graphic/misc/filepool.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"

constant defrac_factor 1 # how many time more disk can we consume in order to help defrac
constant defrac_unit 2^20 # what is the expected allocation unit corresponding to negligable fragmentation


type FilePool
  field (Index Intn Intn) hole # not allocated
  field (Index Intn Intn) bucket # reverse mapping
  field Intn consumed <- 0
  if defrac_factor>1
    field Intn used <- 0
    field Intn current_offset
    field Int current_remain <- 0


if defrac_factor=1
  method fp allocate size -> offset
    arg_rw FilePool fp ; arg Int size ; arg Intn offset
    var Pointer:Intn b :> fp:bucket from size
    if exists:b
      offset := b
      var Intn size2 := fp:bucket key b
      fp:bucket remove b
      fp:hole remove (fp:hole offset)
      if size<size2
        fp:hole insert offset+size size2-size
        fp:bucket insert size2-size offset+size
    else
      offset := fp consumed
      fp consumed += size
   
 
method fp free offset size
  arg_rw FilePool fp ; arg Intn offset ; arg Int size
  var Intn offset2 := offset
  var Intn size2 := size
  var Pointer:Intn s :> fp:hole first offset2+size2
  if exists:s
    var Pointer:Intn b :> fp:bucket first s
    while b<>offset2+size2
      b :> fp:bucket next b
    size2 += s
    fp:hole remove s
    fp:bucket remove b
  var Pointer:Intn s :> fp:hole to offset2
  if not exists:s
    s :> fp:hole last
  else
    s :> fp:hole previous s
  if exists:s and (fp:hole key s)+s=offset2
    offset2 -= s ; size2 += s
    var Pointer:Intn b :> fp:bucket first s
    while b<>offset2
      b :> fp:bucket next b
    fp:hole remove s
    fp:bucket remove b
  if offset2+size2<>fp:consumed
    fp:hole insert offset2 size2
    fp:bucket insert size2 offset2
  else
    fp consumed := offset2
  if defrac_factor>1
    fp used -= size


if defrac_factor>1
  method fp allocate size -> offset
    arg_rw FilePool fp ; arg Int size ; arg Intn offset
    if fp:current_remain<size
      if fp:current_remain>0
        fp free fp:current_offset fp:current_remain
        fp current_remain := 0
      var Pointer:Intn b :> fp:bucket last
      if not exists:b or (fp:bucket key b)<size or (fp:bucket key b)<defrac_unit and fp:consumed<fp:used*defrac_factor
        offset := fp consumed
        fp consumed += size
        fp used += size
        return
      fp current_offset := b
      fp current_remain := fp:bucket key b
      fp:bucket remove b
      fp:hole remove (fp:hole fp:current_offset)
      console "area " fp:current_remain " " fp:used " " fp:consumed eol
      fp used += fp current_remain
    offset := fp current_offset
    fp current_offset += size
    fp current_remain -= size


export FilePool '. allocate' '. free'