Patch title: Release 94 bulk changes
Abstract:
File: /pliant/storage/ground/filesystem.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/util/pml/body.pli"
module "/pliant/language/stream/openmode.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/multi.pli"
module "/pliant/language/schedule/threads_engine.pli"
module "/pliant/storage/ground/control.pli"


type StorageStreamDriver
  field Link:StorageControl control
  field Str fiber
  # read
  field Link:Stream rd_support
  field CBool rd_inside_dump
  field CBool rd_selected
  field Int rd_level rd_remain
  field CBool rd_atend
  # write
  field Str wr_user
  field Int wr_level
  field Int wr_state wr_remain wr_more_start wr_more_stop
  field CBool wr_crash

StreamDriver maybe StorageStreamDriver


method drv read buf mini maxi -> red
  arg_rw StorageStreamDriver drv ; arg Address buf ; arg Int mini maxi red
  red := 0
  if drv:rd_atend
    return
  part read
    if red>=mini or drv:rd_atend
      return
    if drv:rd_inside_dump and not drv:rd_support:atend
      drv:rd_support read_available (var Address adr) (var Int step) maxi-red
      memory_copy adr (buf translate Byte red) step
      red += step
      restart read
    if drv:rd_inside_dump
      drv rd_inside_dump := false
      drv rd_selected := false
      var Pointer:StorageFiber f :> drv:control:fiber first drv:fiber
      if not exists:f or f:dump_offset=undefined
        drv rd_atend := true
        return
      drv:rd_support open drv:control:path+"log" in+safe
      drv:rd_support configure "seek "+(string f:dump_offset-drv:control:discard_offset)
      # console "seek " f:dump_offset-drv:control:discard_offset eol
      drv rd_level := 0
    while drv:rd_level=0
      var CBool selected
      # (drv:rd_support query "seek") parse (var Intn pos)
      drv:rd_support rewind_open
      if (drv:rd_support itag "fiber" (var Str name))
        # console "fiber " name " at " (string (cast pos Int) "radix 16") eol
        selected := name=drv:fiber
      eif (drv:rd_support itag "f")
        # console "f " (shunt drv:rd_selected "yes" "no") " at " (string (cast pos Int) "radix 16") eol
        selected := drv rd_selected
      else
        # console "unknown at " (string (cast pos Int) "radix 16") eol
        selected := false
      if selected
        drv:rd_support rewind_close
        if not drv:rd_support:ibody_begin
          drv rd_atend := true
          return
        drv rd_level := 1 ; drv rd_remain := 0
        drv rd_selected := true
      else
        drv:rd_support rewind
        drv:rd_support rewind_close
        if drv:rd_support:iskip=failure
          drv rd_atend := true
          return
        drv rd_selected := false
    if drv:rd_remain>0
      drv:rd_support read_available (var Address adr) (var Int step) (min maxi-red drv:rd_remain)
      memory_copy adr (buf translate Byte red) step
      red += step
      drv rd_remain -= step
      restart read
    if (drv:rd_support ipick open)
      drv rd_level += 1
    if (drv:rd_support ipick close)
      drv rd_level -= 1
    if drv:rd_level<>0
      var Int size := drv:rd_support isize
      if size=undefined
        drv rd_atend := true
        return
      drv rd_remain := size
      restart read
    else
      drv:rd_support iraw close
      restart read


method drv write buf mini maxi -> written
  arg_rw StorageStreamDriver drv ; arg Address buf ; arg Int mini maxi written
  var Link:StorageControl c :> drv control
  if drv:wr_crash
    return 0
  if drv:wr_level=undefined
    if (c fiber_modify_begin drv:fiber drv:wr_user)=failure
      drv wr_crash := true
      return 0
    drv wr_level := 0
    drv wr_state := 0
  written := 0
  while written<maxi
    if drv:wr_state=0
      var uInt8 b := buf map uInt8 written
      if b=11000101b
        drv wr_level += 1
      eif b=11000100b
        drv wr_level -= 1
      if (pml_size (buf translate Byte written) maxi-written drv:wr_remain drv:wr_more_start drv:wr_more_stop)
        if drv:wr_remain=undefined
          return 0
        drv wr_state := 2
      else
        written := maxi
        drv wr_state := 1
    eif drv:wr_state=1
      if (pml_size_update (buf translate Byte written) maxi-written drv:wr_remain drv:wr_more_start drv:wr_more_stop)
        if drv:wr_remain=undefined
          return 0
        drv wr_state := 2
      else
        written := maxi
        drv wr_state := 1
    else
      check drv:wr_state=2
      var Int step := min maxi-written drv:wr_remain
      written += step
      drv wr_remain -= step
      if drv:wr_remain=0
        drv wr_state := 0
  c:stream raw_write buf maxi
  if drv:wr_state=0 and drv:wr_level=0
    c fiber_modify_end
    drv wr_level := undefined


method drv query command stream answer -> status
  arg_rw StorageStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status
  status := failure "not implemented"


method drv configure command stream -> status
  arg_rw StorageStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status
  status := failure "not implemented"


type StorageFileSystem
  void

FileSystem maybe StorageFileSystem

method fs configure filename options command -> status
  arg_rw StorageFileSystem fs ; arg Str filename options command ; arg ExtendedStatus status
  status := failure "unsupported command"


method fs open name options flags stream support -> status
  arg_rw StorageFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  if not (name parse "/" any:(var Str site) "/" any:(var Str category) "/" any:(var Str object) "/" any:(var Str fiber))
    return failure:"incorrect name"
  var Link:StorageControl c :> storage_control site category object
  part find_fiber
    c:sem rd_request
    var Pointer:StorageFiber f :> c:fiber first fiber
    c:sem rd_release
    if not exists:f
      if { var Str typename := options option "type" Str ; typename<>"" }
        status := c fiber_create fiber typename
        if status=success
          restart find_fiber
        else
          return (failure "failed to create '"+fiber+"' fiber ("+status:message+")")
      else
        return (failure "there is no '"+fiber+"' fiber")
  var Link:StorageStreamDriver drv :> new StorageStreamDriver
  drv control :> c
  drv fiber := fiber
  if (flags .and. append)=append
    drv wr_user := options option "user" Str current_thread_header:user
    drv wr_level := undefined
    drv wr_crash := false
  eif (flags .and. in+out)=in
    drv rd_support :> new Stream
    drv:rd_support open drv:control:path+"dump_"+fiber in+safe
    drv rd_inside_dump := true
    drv rd_atend := false
  else
    return failure:"unsupported open mode"
  stream stream_driver :> drv
  status := success


gvar StorageFileSystem storage_file_system
pliant_multi_file_system mount "storage:" "" storage_file_system