Patch title: Release 81 bulk changes
Abstract:
File: /pliant/language/stream/native.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 

scope "/pliant/language/stream/"
module "ring.pli"
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 

scope "/pliant/language/stream/"
module "ring.pli"
module "/pliant/language/os/socket.pli"


constant getdents_buffer_size 4096
constant readlink_buffer_size 256


constant getdents_buffer_size 4096
constant readlink_buffer_size 256
constant wait_minimal_delay 0.01
constant wait_maximal_delay 15



type NativeStreamDriver
  field Int handle



type NativeStreamDriver
  field Int handle
  field Float timeout
StreamDriver maybe NativeStreamDriver



method fs open name options flags stream support -> status
  arg_rw NativeFileSystem fs ; arg Str name options ; arg In
  if not (valid name options)
    return failure
  if os_api="linux" or os_api="posix"
    var Int access
    if (flags .and. append)=append
      access := os_O_RDWR+os_O_CREAT+os_O_APPEND
    eif (flags .and. in_out)=in
      access := os_O_RDONLY
    eif (flags .and. in_out)=out
      access := os_O_RDWR+os_O_CREAT+os_O_TRUNC
    else
      check (flags .and. in_out)=in_out
      access := os_O_RDWR+os_O_CREAT
StreamDriver maybe NativeStreamDriver



method fs open name options flags stream support -> status
  arg_rw NativeFileSystem fs ; arg Str name options ; arg In
  if not (valid name options)
    return failure
  if os_api="linux" or os_api="posix"
    var Int access
    if (flags .and. append)=append
      access := os_O_RDWR+os_O_CREAT+os_O_APPEND
    eif (flags .and. in_out)=in
      access := os_O_RDONLY
    eif (flags .and. in_out)=out
      access := os_O_RDWR+os_O_CREAT+os_O_TRUNC
    else
      check (flags .and. in_out)=in_out
      access := os_O_RDWR+os_O_CREAT
    if (options option "timeout" Float)=defined
      access += os_O_NONBLOCK
    var Int mode := options option "file_mode" Int
    if mode=undefined
      mode := os_default_file_mode
    stream_lock_handle
    var Int handle := os_open name access mode
    stream_unlock_handle handle
  eif os_api="win32"
    var uInt access := (shunt (flags .and. in)<>0 os_GENERIC
    var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE
    var uInt creation := shunt ((flags .and. in_out)=in_out 
    var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. (shunt 
    var Int handle := os_CreateFile name access share null c
    if (flags .and. append)<>0
      var uInt lpDistanceToMoveHigh := 0
      os_SetFilePointer handle 0 lpDistanceToMoveHigh os_FIL
  eif os_api="os2"
    var Int openflags openmode action handle
    if (flags .and. in_out)=in
      openflags := OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_
      openmode := OPEN_ACCESS_READONLY+OPEN_SHARE_DENYWRITE
    eif (flags .and. in_out)=out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REP
      openmode := OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYREADW
    else
      check (flags .and. in_out)=in_out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_OPE
      openmode := OPEN_ACCESS_READWRITE+OPEN_SHARE_DENYREADW
    if (flags .and. nocache)<>0
      openmode := openmode + OPEN_FLAGS_NO_CACHE
    openmode := openmode + OPEN_FLAGS_SEQUENTIAL
    var Int try_count := 1 ; var Int err := ERROR_TOO_MANY_O
    var Str os2name := replace name "/" "\"
    while try_count>=0 and err=ERROR_TOO_MANY_OPEN_FILES
      err := os_DosOpen os2name handle action 0 FILE_NORMAL 
      if err<>0
        handle := -1
      if err=ERROR_TOO_MANY_OPEN_FILES
        var Int add := 5 ; var Int nb
        os_DosSetRelMaxFH add nb
      try_count := try_count-1
    if (flags .and. append)<>0
      os_DosSetFilePtr handle 0 FILE_END (var uInt drop)
  else
    error "not implemented under "+os_api
    var Int handle := 0
  if handle>=0
    var Pointer:NativeStreamDriver nd :> new NativeStreamDri
    nd handle := handle
    var Int mode := options option "file_mode" Int
    if mode=undefined
      mode := os_default_file_mode
    stream_lock_handle
    var Int handle := os_open name access mode
    stream_unlock_handle handle
  eif os_api="win32"
    var uInt access := (shunt (flags .and. in)<>0 os_GENERIC
    var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE
    var uInt creation := shunt ((flags .and. in_out)=in_out 
    var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. (shunt 
    var Int handle := os_CreateFile name access share null c
    if (flags .and. append)<>0
      var uInt lpDistanceToMoveHigh := 0
      os_SetFilePointer handle 0 lpDistanceToMoveHigh os_FIL
  eif os_api="os2"
    var Int openflags openmode action handle
    if (flags .and. in_out)=in
      openflags := OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_
      openmode := OPEN_ACCESS_READONLY+OPEN_SHARE_DENYWRITE
    eif (flags .and. in_out)=out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REP
      openmode := OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYREADW
    else
      check (flags .and. in_out)=in_out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_OPE
      openmode := OPEN_ACCESS_READWRITE+OPEN_SHARE_DENYREADW
    if (flags .and. nocache)<>0
      openmode := openmode + OPEN_FLAGS_NO_CACHE
    openmode := openmode + OPEN_FLAGS_SEQUENTIAL
    var Int try_count := 1 ; var Int err := ERROR_TOO_MANY_O
    var Str os2name := replace name "/" "\"
    while try_count>=0 and err=ERROR_TOO_MANY_OPEN_FILES
      err := os_DosOpen os2name handle action 0 FILE_NORMAL 
      if err<>0
        handle := -1
      if err=ERROR_TOO_MANY_OPEN_FILES
        var Int add := 5 ; var Int nb
        os_DosSetRelMaxFH add nb
      try_count := try_count-1
    if (flags .and. append)<>0
      os_DosSetFilePtr handle 0 FILE_END (var uInt drop)
  else
    error "not implemented under "+os_api
    var Int handle := 0
  if handle>=0
    var Pointer:NativeStreamDriver nd :> new NativeStreamDri
    nd handle := handle
    nd timeout := options option "timeout" Float
    stream stream_driver :> nd
    stream stream_handle := handle
    status := success
  else
    status := failure


method nd read buf mini maxi -> red
  arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int m
  if os_api="linux" or os_api="posix"
    stream stream_driver :> nd
    stream stream_handle := handle
    status := success
  else
    status := failure


method nd read buf mini maxi -> red
  arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int m
  if os_api="linux" or os_api="posix"
    red := max (os_read nd:handle buf maxi) 0
    red := os_read nd:handle buf maxi
    if red=(-os_EAGAIN) and nd:timeout=defined
      var DateTime dt := datetime ; var Int lap := 0 ; var Float delay := wait_minimal_delay
      while red=(-os_EAGAIN) and (lap=0 or datetime:seconds-dt:seconds<nd:timeout)
        sleep delay
        lap += 1
        if delay<nd:timeout/8 and delay<wait_maximal_delay
          delay *= 2
        red := os_read nd:handle buf mini
    red := max red 0
  eif os_api="win32"
    if not (os_ReadFile nd:handle buf maxi red null)
      red := 0
  eif os_api="os2"
    if (os_DosRead nd:handle buf maxi red)<>0
      red := 0
  else
    error "not implemented under "+os_api
    red := 0

method nd write buf mini maxi -> written
  arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int m
  if os_api="linux" or os_api="posix"
  eif os_api="win32"
    if not (os_ReadFile nd:handle buf maxi red null)
      red := 0
  eif os_api="os2"
    if (os_DosRead nd:handle buf maxi red)<>0
      red := 0
  else
    error "not implemented under "+os_api
    red := 0

method nd write buf mini maxi -> written
  arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int m
  if os_api="linux" or os_api="posix"
    written := max (os_write nd:handle buf maxi) 0
    written := os_write nd:handle buf maxi
    if written=(-os_EAGAIN) and nd:timeout=defined
      var DateTime dt := datetime ; var Int lap := 0 ; var Float delay := wait_minimal_delay
      while written=(-os_EAGAIN) and (lap=0 or datetime:seconds-dt:seconds<nd:timeout)
        sleep delay
        lap += 1
        if delay<nd:timeout/8 and delay<wait_maximal_delay
          delay *= 2
        written := os_write nd:handle buf mini
    written := max written 0
  eif os_api="win32"
    if not (os_WriteFile nd:handle buf maxi written null)
      written := 0
  eif os_api="os2"
    if (os_DosWrite nd:handle buf maxi written)<>0
      written := 0
  else
    error "not implemented under "+os_api
    written := 0


export NativeFileSystem
  eif os_api="win32"
    if not (os_WriteFile nd:handle buf maxi written null)
      written := 0
  eif os_api="os2"
    if (os_DosWrite nd:handle buf maxi written)<>0
      written := 0
  else
    error "not implemented under "+os_api
    written := 0


export NativeFileSystem