/pliant/language/stream/native.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/stream/" 
 17  module "ring.pli" 
 18  module "/pliant/language/os/socket.pli" 
 19  if os_api="linux" 
 20    module "/pliant/language/os/linux64.pli" 
 21   
 22   
 23  constant getdents_buffer_size 4096 
 24  constant readlink_buffer_size 256 
 25  constant wait_minimal_delay 0.01 
 26  constant wait_maximal_delay 15 
 27   
 28   
 29 
 
 30  # os native stream driver 
 31   
 32  type NativeFileSystem 
 33    void 
 34  FileSystem maybe NativeFileSystem 
 35   
 36  type NativeStreamDriver 
 37    field Int handle 
 38    field Float timeout 
 39  StreamDriver maybe NativeStreamDriver 
 40   
 41   
 42  if os_api="win32" 
 43    constant os_datetime_origin (datetime 1601 1 1 0 0 0 0) 
 44   
 45  function valid filename options -> v 
 46    arg Str filename options ; arg CBool v 
 47    if (filename search character:-1)<>(-1) 
 48      return false 
 49    if os_api="linux" or os_api="posix" 
 50      if (filename search "/../" -1)<>(-1) and not (options option "backward_allowed") 
 51        return false 
 52    else 
 53      if ((replace filename "\" "/") search "/../" -1)<>(-1) and not (options option "backward_allowed") 
 54        return false 
 55    if pliant_debugging_level>=and (filename search "//" -1)<>(-1) 
 56      return false 
 57    := true 
 58   
 59   
 60  method fs query filename options flags info -> status 
 61    arg_rw NativeFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw FileInfo info ; arg ExtendedStatus status 
 62    if not (valid filename options) 
 63      return failure 
 64    if (flags .and. level_flags)>=extended 
 65      info:options += " os_name "+string:filename 
 66    if os_api="linux" or os_api="posix" 
 67      if os_api="linux" 
 68        var Int err := os_stat64 filename (var os_stat64 stat) 
 69      else 
 70        var Int err := os_stat filename (var os_stat stat) 
 71      if err<>0 
 72        if (flags .and. deadlinks)=0 
 73          return failure 
 74        if os_api="linux" 
 75          if (os_lstat64 filename stat)<>0 
 76            return failure 
 77        else 
 78          if (os_lstat filename stat)<>0 
 79            return failure 
 80        if (flags .and. level_flags)>=extended 
 81          info options += " deadlink" 
 82      info size := stat st_size 
 83      info:datetime seconds := os_datetime_origin:seconds stat:st_mtime 
 84      if (os_S_ISDIR stat:st_mode) and (filename:len=or filename:(filename:len-1)<>"/") 
 85        info:name resize info:name:len+1 
 86        info:name info:name:len-:= "/":0 
 87      if (flags .and. level_flags)>=extended 
 88        info options += " mode "+('convert to string' stat:st_mode) 
 89        info options += " uid "+('convert to string' stat:st_uid) 
 90        info options += " gid "+('convert to string' stat:st_gid) 
 91        (var DateTime dt) seconds := os_datetime_origin:seconds+stat:st_atime 
 92        dt split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction) 
 93        info options += " read_datetime "+string:year+"/"+(right string:month "0")+"/"+(right string:day "0")+" "+(right string:hour "0")+":"+(right string:minute "0")+":"+(right string:second "0") 
 94        if os_api="linux" 
 95          info options += " filesystem_device "+('convert to string' stat:st_dev) 
 96          if stat:st_rdev<>0 
 97            info options += " device "+('convert to string' stat:st_rdev) 
 98        var Address buffer2 := memory_allocate readlink_buffer_size null 
 99        var Int size2 := os_readlink filename buffer2 readlink_buffer_size 
 100        if size2>=0 
 101          var Str link ; link set buffer2 size2 false 
 102          info options += " link "+string:link 
 103        memory_free buffer2 
 104      status := success 
 105    eif os_api="win32" 
 106      var Str wname := replace filename "/" "\" 
 107      if filename:len>1 and (filename filename:len-1)="/":0 
 108        if not (filename:len>2 and (filename filename:len-2)=":":0) 
 109          wname := wname 0 wname:len-1 
 110      var Int handle := os_FindFirstFile wname (var os_FIND_DATA data) 
 111      if handle=os_INVALID_HANDLE_VALUE 
 112        return failure 
 113      if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECTORY)<>0 and (filename:len=0 or filename:(filename:len-1)<>"/") 
 114        info name += "/" 
 115      info size := data nFileSizeLow 
 116      info:datetime seconds := os_datetime_origin:seconds + data:ftLastWriteTime:dwLowDateTime*(100*0.1^9)+data:ftLastWriteTime:dwHighDateTime*(100*0.1^9*2.0^32) 
 117      os_FindClose handle 
 118      status := success 
 119      if filename:len>0 and (filename filename:len-1)="/" and (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECTORY)=0 
 120        status := failure 
 121    eif os_api="os2" 
 122      var Str oname := replace filename "/" "\" 
 123      if filename:len>1 and (filename filename:len-1)="/":0 
 124        if not (filename:len>2 and (filename filename:len-2)=":":0) 
 125          oname := oname 0 oname:len-1 
 126      var Int handle := 1 ; var Int count := 1 
 127      var Int err := os_DosFindFirst oname handle FILE_DIRECTORY addressof:(var FILEFINDBUF3 data) FILEFINDBUF3:size count FIL_STANDARD 
 128      if err<>0 or count=0 
 129        return failure 
 130      if (data:attrFile .and. FILE_DIRECTORY)<>0 and (filename:len=0 or filename:(filename:len-1)<>"/") 
 131        info name += "/" 
 132      info size := data cbFile 
 133      var FDATE d := data fdateLastWrite ; var FTIME t := data ftimeLastWrite 
 134      info:datetime := datetime 1980+d:year d:month d:day t:hours t:minutes t:twosecs*2 0 
 135      os_DosFindClose handle 
 136      status := success 
 137      if filename:len>0 and (filename filename:len-1)="/" and (data:attrFile .and. FILE_DIRECTORY)=0 
 138        status := failure 
 139    else 
 140      error "file_query is not implemented under "+os_api 
 141      status := failure 
 142   
 143   
 144  if os_api="linux" 
 145    function set_ext2_flags filename flags_on flags_off -> status 
 146      arg Str filename ; arg uInt flags_on flags_off ; arg Status status 
 147      status := failure 
 148      stream_lock_handle 
 149      var Int := os_open filename os_O_RDONLY 0 
 150      stream_unlock_handle h 
 151      if h>=0 
 152        if (os_ioctl 80046601h addressof:(var uInt flags))=0 
 153          flags := (flags .and. .not. flags_off) .or. flags_on 
 154          if (os_ioctl 40046602h addressof:(var uInt flags))=0 
 155            status := success 
 156        os_close h 
 157   
 158  method fs configure filename options command -> status 
 159    arg_rw NativeFileSystem fs ; arg Str filename options command ; arg ExtendedStatus status 
 160    if not (valid filename options) 
 161      return failure 
 162    if os_api="linux" or os_api="posix" 
 163      status := success 
 164      var CBool some := false 
 165      if (command option "mkdir") 
 166        some := true 
 167        var Int mode := options option "directory_mode" Int 
 168        if mode=undefined 
 169          mode := os_default_directory_mode 
 170        if (os_mkdir filename mode)<>0 
 171          status := failure 
 172      if { var Str link := command option "link" Str ; link<>"" } 
 173        some := true 
 174        var Str target := shunt filename:len<>and filename:(filename:len-1)="/" (filename filename:len-1) filename 
 175        if (os_symlink link target)<>0 
 176          if not (command option "force"or (os_unlink target)<>or (os_symlink link target)<>0 
 177            status := failure 
 178      if { var DateTime dt := command option "datetime" DateTime ; dt=defined } 
 179        some := true 
 180        var os_utimbuf buf 
 181        buf modtime := cast dt:seconds-os_datetime_origin:seconds uInt32 
 182        buf actime := buf modtime 
 183        if (os_utime filename buf)<>0 
 184          status := failure 
 185      var Int uid := command option "uid" Int 
 186      var Int gid := command option "gid" Int 
 187      if uid=defined or gid=defined 
 188        some := true 
 189        if (os_lchown filename (shunt uid=defined uid -1) (shunt gid=defined gid -1))<>0 
 190          status := failure 
 191      if { var Int mode := command option "mode" Int ; mode=defined } 
 192        some := true 
 193        if (os_chmod filename mode)<>0 
 194          status := failure 
 195      if { var Str clone := command option "clone" Str ; clone<>"" } 
 196        some := true 
 197        if (os_link filename clone)<>0 
 198          if not (command option "force"or (os_unlink clone)<>or (os_link filename clone)<>0 
 199            status := failure 
 200      if { var Str target := command option "move" Str ; target<>"" } 
 201        some := true 
 202        if (os_rename filename target)<>0 
 203          if not (command option "force"or (os_unlink target)<>or (os_rename filename target)<>0 
 204            status := failure 
 205      if (command option "delete") 
 206        some := true 
 207        if true 
 208          if os_unlink:filename<>0 
 209            status := failure 
 210        else 
 211          var Str namez := filename 
 212          if namez:len>1 and (namez namez:len-1)="/" 
 213            namez := namez 0 namez:len-1 
 214          if (os_unlink namez)<>0 
 215            status := failure 
 216      if (command option "rmdir") 
 217        some := true 
 218        if (os_rmdir filename)<>0 
 219          status := failure 
 220      if (command option "flush") 
 221        some := true 
 222        stream_lock_handle 
 223        var Int fd := os_open filename os_O_RDONLY 0 
 224        stream_unlock_handle fd 
 225        if fd<0 
 226          status := failure 
 227        else 
 228          if os_fsync:fd<>0 
 229            status := failure 
 230          os_close fd 
 231      if os_api="linux" and (command option "sync") 
 232        some := true 
 233        if (set_ext2_flags filename 8 0)=failure 
 234          status := failure 
 235      if os_api="linux" and (command option "async") 
 236        some := true 
 237        if (set_ext2_flags filename 0 8)=failure 
 238          status := failure 
 239      if os_api="linux" and (command option "dirsync") 
 240        some := true 
 241        if (set_ext2_flags filename 10000h 0)=failure 
 242          status := failure 
 243      if os_api="linux" and (command option "nodirsync") 
 244        some := true 
 245        if (set_ext2_flags filename 0 10000h)=failure 
 246          status := failure 
 247      if os_api="linux" and (command option "journal") 
 248        some := true 
 249        if (set_ext2_flags filename 4000h 0)=failure 
 250          status := failure 
 251      if os_api="linux" and (command option "nojournal") 
 252        some := true 
 253        if (set_ext2_flags filename 0 4000h)=failure 
 254          status := failure 
 255      if not some 
 256        status := failure 
 257    eif os_api="win32" 
 258      var Str namez := replace filename "/" "\" 
 259      if namez:len>1 and (namez namez:len-1)="\" 
 260        namez := namez 0 namez:len-1 
 261      status := success 
 262      var CBool some := false 
 263      if command="mkdir" 
 264        some := true 
 265        if not (os_CreateDirectory namez null) 
 266          status := failure 
 267      if command="delete" 
 268        some := true 
 269        if not (os_DeleteFile namez) 
 270          status := failure 
 271      if command="rmdir" 
 272        some := true 
 273        if not (os_RemoveDirectory namez) 
 274          status := failure 
 275      if not some 
 276        status := failure 
 277    eif os_api="os2" 
 278      var Str namez := replace filename "/" "\" 
 279      if namez:len>1 and (namez namez:len-1)="\" 
 280        namez := namez 0 namez:len-1 
 281      status := success 
 282      var CBool some := false 
 283      if command="mkdir" 
 284        some := true 
 285        if (os_DosCreateDir namez null)<>0 
 286          status := failure 
 287      if command="delete" 
 288        some := true 
 289        if (os_DosDelete namez)<>0 
 290          status := failure 
 291      if command="rmdir" 
 292        some := true 
 293        if (os_DosDeleteDir namez)<>0 
 294          status := failure 
 295      if not some 
 296        status := failure 
 297    else 
 298      status := failure 
 299   
 300   
 301  method fs list path options flags files -> supported_flags 
 302    oarg_rw NativeFileSystem fs ; arg Str path options ; arg Int flags supported_flags ; arg_rw List files 
 303    supported_flags := extended 
 304    if not (valid path options) or path:len=or (path path:len-1 1)<>"/" 
 305      return 
 306    if os_api="linux" 
 307      stream_lock_handle 
 308      var Int fd := os_open path os_O_RDONLY+os_O_LARGEFILE 0 
 309      stream_unlock_handle fd 
 310      if fd<0 
 311        return 
 312      var Address buffer := memory_allocate getdents_buffer_size null 
 313      while { var Int size := os_getdents fd buffer getdents_buffer_size ; size>0 } 
 314        var Int offset := 0 
 315        while offset<size 
 316          var Pointer:os_dirent de :> (buffer translate Byte offset) map os_dirent 
 317          (var CStr cname) characters := addressof de:d_name 
 318          var Str filename := cname 
 319          if filename<>"." and filename<>".." 
 320            var Link:FileInfo info :> new FileInfo 
 321            info name := path+filename 
 322            info size := undefined 
 323            info datetime := undefined 
 324            info options := "" 
 325            info status := fs query path+filename options flags info 
 326            files append addressof:info 
 327          offset += de:d_reclen 
 328      memory_free buffer 
 329      os_close fd 
 330    eif os_api="posix" 
 331      # stream_lock_handle 
 332      var Address fd := os_opendir path 
 333      # stream_unlock_handle fd 
 334      if fd=null 
 335        return 
 336      while { var Pointer:os_dirent de :> os_readdir fd ; addressof:de<>null } 
 337        (var CStr cname) characters := addressof de:d_name 
 338        var Str filename := cname 
 339        if filename<>"." and filename<>".." 
 340          var Link:FileInfo info :> new FileInfo 
 341          info name := path+filename 
 342          info size := undefined 
 343          info datetime := undefined 
 344          info options := "" 
 345          info status := fs query path+filename options flags info 
 346          files append addressof:info 
 347      os_closedir fd 
 348    eif os_api="win32" 
 349      var Str wname := (replace path "/" "\")+"*.*" 
 350      var Int handle := os_FindFirstFile wname (var os_FIND_DATA data) 
 351      var CBool more := handle<>os_INVALID_HANDLE_VALUE 
 352      while more 
 353        (var CStr cname) characters := addressof data:cFileName 
 354        var Str filename := cname 
 355        if filename<>"." and filename<>".." 
 356          var Link:FileInfo info :> new FileInfo 
 357          info name := path+filename 
 358          if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECTORY)<>0 and (info:name:len=0 or info:name:(info:name:len-1)<>"/") 
 359            info name += "/" 
 360          info size := data nFileSizeLow 
 361          info:datetime seconds := os_datetime_origin:seconds + data:ftLastWriteTime:dwLowDateTime*(100*0.1^9)+data:ftLastWriteTime:dwHighDateTime*(100*0.1^9*2.0^32) 
 362          info status := success 
 363          files append addressof:info 
 364        more := os_FindNextFile handle data 
 365      os_FindClose handle 
 366    eif os_api="os2" 
 367      var Str oname := (replace path "/" "\")+"*.*" 
 368      var Int size := 4096 ; var Address buf := memory_allocate size null 
 369      var Int handle := 1 ; var Int count := size 
 370      var Int err := os_DosFindFirst oname handle FILE_DIRECTORY buf size count FIL_STANDARD 
 371      while err=0 and count<>0 
 372        var Pointer:FILEFINDBUF3 data :> buf map FILEFINDBUF3 
 373        for (var Int i) 0 count-1 
 374          (var Str filename) set (memory_allocate data:cchName addressof:filename) data:cchName true 
 375          memory_copy (addressof data:achName) filename:characters data:cchName 
 376          if filename<>"." and filename<>".." 
 377            var Link:FileInfo info :> new FileInfo 
 378            info name:= path+filename 
 379            if (data:attrFile .and. FILE_DIRECTORY)<>0 and (filename:len=0 or filename:(filename:len-1)<>"/") 
 380              info name += "/" 
 381            info size := data cbFile 
 382            var FDATE d := data fdateLastWrite ; var FTIME t := data ftimeLastWrite 
 383            info:datetime := datetime 1980+d:year d:month d:day t:hours t:minutes t:twosecs*2 0 
 384            info status := success 
 385            files append addressof:info 
 386          data :> (addressof:data translate Byte data:oNextEntryOffset) map FILEFINDBUF3 
 387        err := os_DosFindNext handle buf size count 
 388      memory_free buf 
 389      os_DosFindClose handle 
 390    else 
 391      error "file_list is not implemented under "+os_api 
 392   
 393   
 394  method fs open name options flags stream support -> status 
 395    arg_rw NativeFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 396    if not (valid name options) 
 397      return failure 
 398    if os_api="linux" or os_api="posix" 
 399      var Int access 
 400      if (flags .and. append)=append 
 401        access := os_O_RDWR+os_O_CREAT+os_O_APPEND 
 402      eif (flags .and. in_out)=in 
 403        access := os_O_RDONLY 
 404      eif (flags .and. in_out)=out 
 405        access := os_O_RDWR+os_O_CREAT+os_O_TRUNC 
 406      else 
 407        check (flags .and. in_out)=in_out 
 408        access := os_O_RDWR+os_O_CREAT 
 409      if (options option "timeout" Float)=defined 
 410        access += os_O_NONBLOCK 
 411      if os_api="linux" 
 412        access += os_O_LARGEFILE 
 413      var Int mode := options option "file_mode" Int 
 414      if mode=undefined 
 415        mode := os_default_file_mode 
 416      stream_lock_handle 
 417      var Int handle := os_open name access mode 
 418      stream_unlock_handle handle 
 419    eif os_api="win32" 
 420      var uInt access := (shunt (flags .and. in)<>0 os_GENERIC_READ 0) .or. (shunt (flags .and. out)<>0 os_GENERIC_WRITE 0) 
 421      var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE_WRITE 
 422      var uInt creation := shunt ((flags .and. in_out)=in_out or (flags .and. append)<>0) os_OPEN_ALWAYS (flags .and. out)<>0 os_CREATE_ALWAYS os_OPEN_EXISTING 
 423      var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. (shunt (flags .and. seekmuch)<>0 os_FILE_FLAG_RANDOM_ACCESS os_FILE_FLAG_SEQUENTIAL_SCAN) 
 424      if (options option "win32_device") 
 425        share := 0 ; creation := os_OPEN_EXISTING ; wflags := 0 
 426      var Int handle := os_CreateFile name access share null creation wflags null 
 427      if (flags .and. append)<>0 
 428        var uInt lpDistanceToMoveHigh := 0 
 429        os_SetFilePointer handle 0 lpDistanceToMoveHigh os_FILE_END 
 430    eif os_api="os2" 
 431      var Int openflags openmode action handle 
 432      if (flags .and. in_out)=in 
 433        openflags := OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_IF_EXISTS 
 434        openmode := OPEN_ACCESS_READONLY+OPEN_SHARE_DENYWRITE 
 435      eif (flags .and. in_out)=out 
 436        openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REPLACE_IF_EXISTS 
 437        openmode := OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYREADWRITE 
 438      else 
 439        check (flags .and. in_out)=in_out 
 440        openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_OPEN_IF_EXISTS 
 441        openmode := OPEN_ACCESS_READWRITE+OPEN_SHARE_DENYREADWRITE 
 442      if (flags .and. nocache)<>0 
 443        openmode := openmode + OPEN_FLAGS_NO_CACHE 
 444      openmode := openmode + OPEN_FLAGS_SEQUENTIAL 
 445      var Int try_count := 1 ; var Int err := ERROR_TOO_MANY_OPEN_FILES 
 446      var Str os2name := replace name "/" "\" 
 447      while try_count>=0 and err=ERROR_TOO_MANY_OPEN_FILES 
 448        err := os_DosOpen os2name handle action 0 FILE_NORMAL openflags openmode null 
 449        if err<>0 
 450          handle := -1 
 451        if err=ERROR_TOO_MANY_OPEN_FILES 
 452          var Int add := 5 ; var Int nb 
 453          os_DosSetRelMaxFH add nb 
 454        try_count := try_count-1 
 455      if (flags .and. append)<>0 
 456        os_DosSetFilePtr handle 0 FILE_END (var uInt drop) 
 457    else 
 458      error "not implemented under "+os_api 
 459      var Int handle := 0 
 460    if handle>=0 
 461      var Pointer:NativeStreamDriver nd :> new NativeStreamDriver 
 462      nd handle := handle 
 463      nd timeout := options option "timeout" Float 
 464      stream stream_driver :> nd 
 465      stream stream_handle := handle 
 466      status := success 
 467    else 
 468      status := failure 
 469   
 470   
 471  method nd read buf mini maxi -> red 
 472    arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int mini maxi red 
 473    if os_api="linux" or os_api="posix" 
 474      red := os_read nd:handle buf maxi 
 475      if red=(-os_EAGAIN) and nd:timeout=defined 
 476        var DateTime dt := datetime ; var Int lap := 0 ; var Float delay := wait_minimal_delay 
 477        while red=(-os_EAGAIN) and (lap=or datetime:seconds-dt:seconds<nd:timeout) 
 478          sleep delay 
 479          lap += 1 
 480          if delay<nd:timeout/and delay<wait_maximal_delay 
 481            delay *= 2 
 482          red := os_read nd:handle buf mini 
 483      red := max red 0 
 484    eif os_api="win32" 
 485      if not (os_ReadFile nd:handle buf maxi red null) 
 486        red := 0 
 487    eif os_api="os2" 
 488      if (os_DosRead nd:handle buf maxi red)<>0 
 489        red := 0 
 490    else 
 491      error "not implemented under "+os_api 
 492      red := 0 
 493   
 494  method nd write buf mini maxi -> written 
 495    arg_rw NativeStreamDriver nd ; arg Address buf ; arg Int mini maxi written 
 496    if os_api="linux" or os_api="posix" 
 497      written := os_write nd:handle buf maxi 
 498      if written=(-os_EAGAIN) and nd:timeout=defined 
 499        var DateTime dt := datetime ; var Int lap := 0 ; var Float delay := wait_minimal_delay 
 500        while written=(-os_EAGAIN) and (lap=or datetime:seconds-dt:seconds<nd:timeout) 
 501          sleep delay 
 502          lap += 1 
 503          if delay<nd:timeout/and delay<wait_maximal_delay 
 504            delay *= 2 
 505          written := os_write nd:handle buf mini 
 506      written := max written 0 
 507    eif os_api="win32" 
 508      if not (os_WriteFile nd:handle buf maxi written null) 
 509        written := 0 
 510    eif os_api="os2" 
 511      if (os_DosWrite nd:handle buf maxi written)<>0 
 512        written := 0 
 513    else 
 514      error "not implemented under "+os_api 
 515      written := 0 
 516   
 517  method nd flush level -> status 
 518    arg_rw NativeStreamDriver nd ; arg Int level ; arg Status status 
 519    if level=end 
 520      return success 
 521    if os_api="linux" or os_api="posix" 
 522      if level<sync 
 523        status := success 
 524      else 
 525        status := shunt (os_fsync nd:handle)=0 success failure 
 526    eif os_api="win32" 
 527      status := success 
 528    eif os_api="os2" 
 529      if level<sync 
 530        status := success 
 531      else 
 532        status := shunt (os_DosResetBuffer nd:handle)=0 success failure 
 533    else 
 534      error "not implemented under "+os_api 
 535      status := failure 
 536   
 537  method nd close -> status 
 538    arg_rw NativeStreamDriver nd ; arg ExtendedStatus status 
 539    if os_api="linux" or os_api="posix" 
 540      status := shunt (os_close nd:handle)=0 success failure 
 541    eif os_api="win32" 
 542      status := shunt (os_CloseHandle nd:handle) success failure 
 543    eif os_api="os2" 
 544      status := shunt (os_DosClose nd:handle)=0 success failure 
 545    else 
 546      error "not implemented under "+os_api 
 547      status := failure 
 548   
 549  method nd query command stream answer -> status 
 550    oarg_rw NativeStreamDriver nd ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status 
 551    if os_api="linux" and command="seek" 
 552      status := shunt (os_llseek nd:handle 0 0 addressof:(var uInt64 result) os_SEEK_CUR)=0 success failure 
 553      answer := string (cast result Intn)+((cast stream:stream_read_cur Int).-.(cast stream:stream_read_stop Int))+((cast stream:stream_write_cur Int).-.(cast stream:stream_write_buf Int)) 
 554    eif os_api="posix" and command="seek" 
 555      var Int pos := os_lseek nd:handle 0 os_SEEK_CUR 
 556      status := shunt pos>=0 success failure 
 557      answer := string pos+((cast stream:stream_read_cur Int).-.(cast stream:stream_read_stop Int))+((cast stream:stream_write_cur Int).-.(cast stream:stream_write_buf Int)) 
 558    eif os_api="win32" and command="seek" 
 559      var Int pos := os_SetFilePointer nd:handle 0 (null map uInt) os_FILE_CURRENT 
 560      status := shunt pos>=0 success failure 
 561      answer := string pos+((cast stream:stream_read_cur Int).-.(cast stream:stream_read_stop Int))+((cast stream:stream_write_cur Int).-.(cast stream:stream_write_buf Int)) 
 562    else 
 563      status := failure 
 564   
 565  method nd configure command stream -> status 
 566    arg_rw NativeStreamDriver nd ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 567    if os_api="linux" and (command parse word:"seek" (var Intn pos)) 
 568      if (stream:stream_flags .and. out)<>0 
 569        stream flush anytime 
 570      stream stream_read_cur := stream stream_read_stop 
 571      var uInt high := cast pos\(cast Intn)^32 uInt 
 572      var uInt low := cast pos%(cast Intn)^32 uInt 
 573      check high*(cast Intn)^32+low=pos 
 574      status := shunt (os_llseek nd:handle high low addressof:(var uInt64 result) os_SEEK_SET)=0 success failure 
 575    eif os_api="posix" and (command parse word:"seek" (var Int pos)) 
 576      if (stream:stream_flags .and. out)<>0 
 577        stream flush anytime 
 578      stream stream_read_cur := stream stream_read_stop 
 579      status := shunt (os_lseek nd:handle pos os_SEEK_SET)>=0 success failure 
 580    eif os_api="win32" and (command parse word:"seek" (var Int pos)) 
 581      if (stream:stream_flags .and. out)<>0 
 582        stream flush anytime 
 583      stream stream_read_cur := stream stream_read_stop 
 584      status := shunt (os_SetFilePointer nd:handle (cast pos uInt) (null map uInt) os_FILE_BEGIN)<>(-1) success failure 
 585    if os_api="linux" and command="journal" 
 586      status := failure 
 587      if (os_ioctl nd:handle 80046601h addressof:(var uInt flags))=0 
 588        flags := flags .or. 4000h 
 589        if (os_ioctl nd:handle 40046602h addressof:(var uInt flags))=0 
 590          status := success 
 591    else 
 592      status=failure 
 593   
 594   
 595  export NativeFileSystem