Patch title: Release 87 bulk changes
Abstract:
File: /pliant/language/data/cache.pli
Key:
    Removed line
    Added line
   
module "/pliant/install/ring2.pli"
module "/pliant/language/context/memory.pli"


module "/pliant/install/ring2.pli"
module "/pliant/language/context/memory.pli"


function cache_cleanup
  check cache_class_timeout=0
  sem request
  for (var Int c) cache_class_timeout+1 class_count-1
    var Link:CachePrototype obj :> (addressof lru:c:first) m
    while exists:obj
      var Pointer:CachePrototype next :> (addressof obj:list
      if ((addressof:obj translate Int -2) map Int)=2
        obj:list remove obj:list_node
        obj flags := (obj:flags .and. .not. flag_class_bits)
        obj:list append obj:list_node
      obj :> next
  sem release


function cache_open id type obj -> newone
  arg Str id ; arg Type type ; arg_w Link:CachePrototype obj
  part fetch
    cache_shrink
    sem request
    obj :> (cache first id) map CachePrototype
    if exists:obj
      if (obj:flags .and. flag_drop)=0
        var Pointer:List_ l :> obj list
        l remove obj:list_node
        l append obj:list_node
      newone := false
    else
      obj :> (entry_new type) map CachePrototype
      obj id := id
      obj flags := flag_init+cache_class_standard
      cache insert id true addressof:obj
      obj:list append obj:list_node
      newone := true
    sem release
    if not newone
      while (obj:flags .and. flag_init+flag_drop)<>0
        os_yield
      if (obj:flags .and. flag_dropped)<>0
        restart fetch


function cache_delete id
  arg Str id
  sem request
  var Link:CachePrototype obj :> (cache first id) map CacheP
function cache_open id type obj -> newone
  arg Str id ; arg Type type ; arg_w Link:CachePrototype obj
  part fetch
    cache_shrink
    sem request
    obj :> (cache first id) map CachePrototype
    if exists:obj
      if (obj:flags .and. flag_drop)=0
        var Pointer:List_ l :> obj list
        l remove obj:list_node
        l append obj:list_node
      newone := false
    else
      obj :> (entry_new type) map CachePrototype
      obj id := id
      obj flags := flag_init+cache_class_standard
      cache insert id true addressof:obj
      obj:list append obj:list_node
      newone := true
    sem release
    if not newone
      while (obj:flags .and. flag_init+flag_drop)<>0
        os_yield
      if (obj:flags .and. flag_dropped)<>0
        restart fetch


function cache_delete id
  arg Str id
  sem request
  var Link:CachePrototype obj :> (cache first id) map CacheP
  if exists:obj and (obj:flags .and. flag_drop)<>0
  if exists:obj and (obj:flags .and. flag_drop)=0
    cache remove id addressof:obj
    obj:list remove obj:list_node
    obj flags := flag_dropped
  sem release
  if exists:obj
    while (obj:flags .and. flag_init+flag_drop)<>0
      os_yield
  


    cache remove id addressof:obj
    obj:list remove obj:list_node
    obj flags := flag_dropped
  sem release
  if exists:obj
    while (obj:flags .and. flag_init+flag_drop)<>0
      os_yield