root/trunk/thune/files.c

/*============================================================================
    Urlan Interpreter
    Copyright (C) 2005-2007  Karl Robillard

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
===========================================================================*/


#include <assert.h>
#include "os.h"
#include "urlan.h"
#include "urlan_atoms.h"
#include "internal.h"
#include "bignum.h"


extern int  ur_fileModified( const char* path, UCell* res );
extern int  ur_isDir( const char* path );
extern void ur_readDir( UThread*, const char* filename, UCell* res );

extern void uc_system_run( UThread*, UCell* );
extern void uc_changeDir( UThread*, UCell* );
extern void uc_whatDir( UThread*, UCell* );
extern void uc_makeDir( UThread*, UCell* );
extern void uc_file_info( UThread*, UCell* );
extern void uc_rename( UThread*, UCell* );
extern void uc_delete( UThread*, UCell* );
extern void uc_getenv( UThread*, UCell* );


/*
  Returns pointer to port device.
  Throws error if port is invalid.
*/
static UPortDevice* _devicePtr( UThread* ut, UCell* portCell )
{
    UArray* arr = &((UrlanEnv*) ut->env)->devices;
    int devID = portCell->port.deviceId;

    if( (devID > -1) && (devID < arr->used) )
    {
        return ((UPortDevice**) arr->ptr.v)[ devID ];
    }

    ur_throwErr( UR_ERR_SCRIPT, "Invalid port" );
    return 0;
}


/*
  (url [options] -- port)

  The UPortDevice open method must return the following:
     1  Port opened successfully.
     0  Url not handled; try other devices.
    -1  Url handled, but error occured.
*/
UR_CALL( uc_open )
{
    UArray* arr = &((UrlanEnv*) ut->env)->devices;
    UPortDevice** it  = (UPortDevice**) arr->ptr.v;
    UPortDevice** end = it + arr->used;

    while( it != end )
    {
        if( 0 != (*it)->open( *it, ut, tos ) )
            return;
        ++it;
    }

    ur_throwErr( UR_ERR_INTERNAL, "No valid port device found" );
}


// (port -- )
UR_CALL( uc_close )
{
    if( ur_is(tos, UT_PORT) )
    {
        UPortDevice* dev = _devicePtr( ut, tos );
        if( dev )
            dev->close( ut, tos );   // Device close must drop TOS.
    }
}


// (file -- logic)
UR_CALL( uc_existsQ )
{
    const char* cp;
    int logic = 0;

    UR_CALL_UNUSED_TH

    cp = ur_cstring( ut, tos );
    if( cp )
    {
        if( ur_isDir( cp ) > -1 )
            logic = 1;

        ur_initType(tos, UT_LOGIC);
        ur_logic(tos) = logic;
    }
}


// (file -- int)
UR_CALL( uc_sizeQ )
{
    const char* cp;
    int64_t size;

    UR_CALL_UNUSED_TH

    cp = ur_cstring( ut, tos );
    if( cp )
    {
        size = ur_fileSize( cp );
        if( size < 0 )
        {
            ur_setNone(tos);
        }
        else if( size > INT32_MAX )
        {
            ur_initType(tos, UT_BIGNUM);
            bignum_setl(tos, size);
        }
        else
        {
            ur_initType(tos, UT_INT);
            ur_int(tos) = (int) size;
        }
    }
}


// (file -- logic)
UR_CALL( uc_dirQ )
{
    const char* cp;
    int status;

    UR_CALL_UNUSED_TH

    cp = ur_cstring( ut, tos );
    if( cp )
    {
        status = ur_isDir( cp );
        if( status < 0 )
            status = 0;

        ur_initType(tos, UT_LOGIC);
        ur_logic(tos) = status;
    }
}


// (file -- time)
UR_CALL( uc_modifiedQ )
{
    const char* cp;
    int status;

    UR_CALL_UNUSED_TH

    cp = ur_cstring( ut, tos );
    if( cp )
    {
        status = ur_fileModified( cp, tos );
        if( status < 0 )
        {
            ur_setNone(tos);
        }
    }
}


#if 0
/*
   Returns zero if no newlines are found.
*/
static const char* findNewline( const char* it, const char* end )
{
    while( it != end )
    {
        if( *it == '\n' )
            return it;
        ++it;
    }
    return 0;
}


#define LINEBUF_SIZE        (1024 * 4)

static void _readLines( const char* fn, OBlock* blk )
{
    //orError( "read /lines not implemented" );

    FileHandle fp;
    int n;
    int len;
    int totalRead;
    int seen;
    int offset;
    char* buffer;
    const char* npos;
    const char* pos;
    const char* end;


    fp = fileOpen( fn, FILE_READ );
    if( ! fp )
    {
        orErrorT( OR_ERROR_ACCESS, "cannot open file %s", fn );
        return;
    }

    buffer = memAlloc( LINEBUF_SIZE );
    totalRead = seen = offset = 0;

    do
    {
        n = fileRead( fp, buffer, LINEBUF_SIZE );
        if( n < 1 )
            break;

        offset += n;

        pos = buffer;
        end = buffer + n;

        while( 1 )
        {
            npos = findNewline( pos, end );
            if( ! npos )
            {
                seen += end - pos;
                break;
            }
            else if( seen > totalRead )
            {
                UString* str;
                int n2;

                seen += npos - pos;
                len = seen - totalRead;

                str = ur_makeString( len + OR_CTERM_LEN );
                orAppendString( blk, str - orSTRINGS );

                // Would be good to avoid seek/read just to pick up end of buffer.
                fileSeek( fp, totalRead );
                n2 = fileRead( fp, str->ptr.c, len );
                fileSeek( fp, offset );

                str->used = n2;
                totalRead += n2 + 1;
                seen = totalRead;
                pos = npos + 1;
            }
            else
            {
                len = npos - pos;
                orAppendString( blk, orMakeCString( pos, len ) );
                totalRead += len + 1;
                seen = totalRead;
                pos = npos + 1;
            }
        }
    }
    while( n == LINEBUF_SIZE );

    if( seen > totalRead )
    {
        cprint( "FIXME: read/lines excess %d\n", seen - totalRead );
        //len = seen - totalRead;
        //orAppendString( blk, orMakeCString( buffer + n - len, len ) );
    }

    fileClose( fp );
    memFree( buffer );
}
#endif


/*
  (port data [len] -- port data)
  (file [len] -- string)
*/
UR_CALL( uc_read )
{
    const char* fn;
    int part = 0;

    if( ur_is(tos, UT_INT) )
    {
        part = ur_int(tos);
        UR_S_DROP;
        tos = UR_TOS;
    }

    if( ur_is(ur_s_prev(tos), UT_PORT) )
    {
        UPortDevice* dev = _devicePtr( ut, ur_s_prev(tos) );
        if( dev )
            dev->read( ut, tos, part );
        return;
    }

    fn = ur_cstring( ut, tos );
    if( fn )
    {
        int err;

        err = ur_isDir( fn );
        if( err < 0 )
            goto error;

        if( err )
        {
            ur_readDir( ut, fn, tos );
        }
        else
        {
#if 0
            if( orRefineSet(REF_READ_LINES) )
            {
                OBlock* blk;

                if( orRefineSet(REF_READ_BINARY) )
                {
                    orError( "cannot use /binary with /lines" );
                    return;
                }

                blk = orMakeBlock(0);
                orRefPush( OT_BLOCK, orBlockN(blk) );
                _readLines( fn, blk );
                orRefPop( 1 );
                orResultBLOCK( blk - orBLOCKS );
            }
            else
#endif
            {
                FileHandle fp;
                UIndex binN;
                UString* buf;
                int n;
                int size;
                int skip = 0;

#if 0
                if( orRefineSet(REF_READ_SKIP) )
                {
                    UCell* rval = REF_READ_LENGTH;
                    skip = orNumberToInt( rval );
                }
#endif
                if( part )
                {
                    size = part;
                }
                else
                {
                    size = ur_fileSize( fn );
                    if( size < 0 )
                    {
error:
                        ur_throwErr( UR_ERR_ACCESS,
                                     "cannot query file %s", fn );
                        return;
                    }
                }

                binN = ur_makeBinary( size /*+ OR_CTERM_LEN*/, &buf );

                fp = fileOpen( fn, FILE_READ_BINARY );
                        //orRefineSet(REF_READ_BINARY) ?
                        //       FILE_READ_BINARY : FILE_READ );
                if( fp )
                {
                    if( skip )
                    {
                        n = fileSeek( fp, skip );
                        if( n == -1 )
                        {
                            fileClose( fp );
                            ur_throwErr( UR_ERR_ACCESS,
                                         "skip failed on %s", fn);
                            return;
                        }
                    }

                    n = fileRead( fp, buf->ptr.v, size );
                    err = fileError(fp);
                    fileClose( fp );

                    if( err )
                    {
                        ur_throwErr( UR_ERR_ACCESS,
                                     "read failed on %s", fn );
                        return;
                    }

                    buf->used = n;

                    ur_initType( tos, UT_STRING );
                    //orRefineSet(REF_READ_BINARY) ? UT_BINARY : UT_STRING
                    ur_setSeries( tos, binN, 0 );
                }
                else
                {
                    ur_throwErr( UR_ERR_ACCESS,
                                 "cannot open file %s", fn );
                }
            }
        }
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE, "read expected string!/port!" );
    }
}


/*
  (port data -- port)
*/
UR_CALL( uc_write )
{
    UCell* pc;

    pc = ur_s_prev(tos);

#if 0
    if( a1->type == UT_FILE )
    {
        FileHandle fp;
        FileMode mode;
        UCell* a2;
        UString* file;

        a2 = a1 + 1;
        file = ur_bin(a1);
        ur_termCStr( file );

        if( orRefineSet(REF_APPEND) )
        {
            if( orIs(a2, OT_BINARY) || orRefineSet(REF_BINARY) )
                mode = FILE_APPEND_BINARY;
            else
                mode = FILE_APPEND; 
        }
        else
        {
            if( orIs(a2, OT_BINARY) || orRefineSet(REF_BINARY) )
                mode = FILE_WRITE_BINARY;
            else
                mode = FILE_WRITE; 
        }

        fp = fileOpen( file->ptr.c, mode );
        if( fp )
        {
            UString* data = 0;

            if( orIs(a2, OT_OBJECT) )
            {
                data = ur_makeString(0);
                orForm( data, a2 );
            }
            else if( orIs(a2, OT_STRING) || orIs(a2, OT_BINARY) )
            {
                data = ur_bin(a2);
            }

            if( data )
            {
                int n;

                n = fileWrite( fp, data->ptr.c, data->used );
                fileClose( fp );

                if( n != data->used )
                {
                    orErrorT( OR_ERROR_ACCESS,
                              "Only wrote %d bytes to %s", n, file->ptr.c );
                    return;
                }
            }
            else
            {
                fileClose( fp );
            }

            orResultUNSET;
            return;
        }
        orErrorT( OR_ERROR_ACCESS, "Cannot open %s", file->ptr.c );
    }
    else
#endif
    if( ur_is(pc, UT_PORT) )
    {
        UPortDevice* dev = _devicePtr( ut, pc );
        if( dev )
            dev->write( ut, tos );
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE, "write expected port!" );
    }
}


// (port position -- port)
UR_CALL( uc_seek )
{
    UCell* pc = ur_s_prev(tos);
    if( ur_is(pc, UT_PORT) )
    {
        UPortDevice* dev = _devicePtr( ut, pc );
        if( dev )
            dev->seek( ut, tos );
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE, "seek expected port!" );
    }
}


#define IS_SLASH(c)  (((c) == '/') || ((c) == '\\'))

static char* upDir( char* start, char* it )
{
    char* oit = it;
    if( it != start )
    {
        if( IS_SLASH(*it) )
            --it;
        while( it != start )
        {
            if( IS_SLASH(*it) )
            {
                if( it != oit )
                    ++it;
                break;
            }
            --it;
        }
    }
    return it;
}


/*
  (path -- absolute)
*/
UR_CALL( uc_fullPath )
{
    uint8_t* cpA;
    uint8_t* cpB;

    if( ur_stringSlice(ut, tos, &cpA, &cpB) )
    {
#ifdef _WIN32
        if( ((cpB - cpA) > 1) && (cpA[1] == ':') )
            return;
#endif
        if( (*cpA != '/') && (*cpA != '\\') )
        {
            uc_whatDir( ut, tos );
            UR_S_NIP;

            if( cpA != cpB )
            {
                UString* str;
                char* dst;
                int len;

                str = ur_bin( tos );
                ur_arrayReserve( str, 1, str->used + (cpB - cpA) );
                dst = str->ptr.c + str->used;

#define INC_A   ++cpA; if(cpA == cpB) break;

                while( cpA != cpB )
                {
                    if( *cpA == '.' )
                    {
                        len = cpB - cpA;
                        if( len > 1 )
                        {
                            if( IS_SLASH(cpA[1]) )
                            {
                                cpA += 2;
                                continue;
                            }
                            else if( (len > 2) &&
                                     (cpA[1] == '.') &&
                                     IS_SLASH(cpA[2]) )
                            {
                                cpA += 3;
                                dst = upDir( str->ptr.c, dst - 1 );
                                continue;
                            }
                        }
                    }
                    else if( IS_SLASH(*cpA) )
                    {
                        if( IS_SLASH(dst[-1]) )
                        {
                            ++cpA;
                            continue;
                        }
                    }
                    *dst++ = *cpA++;
                }

                str->used = dst - str->ptr.c;
            }
        }
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE, "full-path expected string!" );
    }
}


/*--------------------------------------------------------------------------*/


#ifdef UR_CONFIG_BZIP2
#include <bzlib.h>


// (string -- binary) 
UR_CALL( uc_compress )
{
    uint8_t* cpA;
    uint8_t* cpB;
    UString* bin;
    UIndex binN;
    int ret;
    unsigned int len;
    unsigned int blen;

    if( ur_binaryMem( ut, tos, &cpA, &cpB ) )
    {
        if( cpA )
        {
            len = cpB - cpA;
            blen = len + (len / 99) + 600;

            binN = ur_makeBinary( blen /*+ 4*/, &bin );

            if( len > 0 )
            {
                ret = BZ2_bzBuffToBuffCompress( bin->ptr.c /*+ 4*/, &blen,
                                                (char*) cpA, len,
                                                3, 0, 0 );
                if( ret == BZ_OUTBUFF_FULL )
                {
                    ur_arrayFree( bin );
                    ur_throwErr( UR_ERR_ACCESS, "compress buffer full" );
                    return;
                }
                bin->used = blen;
            }

            ur_initType( tos, UT_BINARY );
            ur_setSeries( tos, binN, 0 );
        }
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE,
                     "compress expected string!/binary!/vector!" );
    }
}


/**
   Decompress data into intialized array.

   \return  Non-zero if successful.
*/
int ur_decompress( const void* data, int len, UArray* arr )
{
#define BUF_LOW     32
    bz_stream strm;
    int ok;

    strm.bzalloc = 0;
    strm.bzfree  = 0;
    strm.opaque  = 0;

    ok = BZ2_bzDecompressInit( &strm, 0, 0 );
    if( ok != BZ_OK )
    {
        //fprintf( stderr, "BZ2_bzDecompressInit failure (%d)", ok );
        return 0;
    }

    strm.next_in  = (char*) data;
    strm.avail_in = len;

    ur_arrayReserve( arr, 1, (len < BUF_LOW) ? BUF_LOW : len );
    strm.next_out  = arr->ptr.c;
    strm.avail_out = arr->avail;

    do
    {
        if( strm.avail_out < BUF_LOW )
        {
            ur_arrayReserve( arr, 1, arr->avail + (2 * BUF_LOW) );
            strm.next_out  = arr->ptr.c + strm.total_out_lo32;
            strm.avail_out = arr->avail - strm.total_out_lo32;
        }

        ok = BZ2_bzDecompress( &strm );
        arr->used = strm.total_out_lo32;
    }
    while( ok == BZ_OK );

    BZ2_bzDecompressEnd( &strm );

    return (ok == BZ_STREAM_END) ? 1 : 0;
}


// (binary -- string)
UR_CALL( uc_decompress )
{
    UIndex strN;
    UString* str;
    uint8_t* cpA;
    uint8_t* cpB;

    if( ! ur_binarySlice( ut, tos, &cpA, &cpB ) )
    {
        ur_throwErr( UR_ERR_DATATYPE, "decompress expected binary!" );
        return;
    }
    if( cpA == 0 )
        return;

    strN = ur_makeBinary( 0, &str );

    if( ur_decompress( cpA, cpB - cpA, str ) )
    {
        ur_initString( tos, strN, 0 );
    }
    else
    {
        ur_throwErr( UR_ERR_INTERNAL, "decompress failure" );
    }
}
#endif


/*--------------------------------------------------------------------------*/


/*
  CRC-16 Checksum - DDCMP and IBM Bisync

  x^16 + x^15 + x^2 + 1
*/

#define CRC16_POLYNOMIAL    0xa001
#define CRC16_INITIAL       0

uint16_t checksum_crc16( uint8_t* data, int byteCount )
{
    uint16_t crc, bit;
    int i;

    crc = CRC16_INITIAL;
    while( byteCount-- > 0 )
    {
        for( i = 1; i <= 0x80; i <<= 1 )
        {
            bit = ((*data) & i) ? 0x8000 : 0;
            if( crc & 1 )
                bit ^= 0x8000;
            crc >>= 1;
            if( bit )
                crc ^= CRC16_POLYNOMIAL;
        }
        ++data;
    }
    return crc;
}


#define SHA1HANDSOFF    1
#include <support/sha1.c>


// (binary type -- int)
UR_CALL( uc_checksum )
{
    UCell* res;
    uint8_t* cpA;
    uint8_t* cpB;

    if( ! ur_isAWord( tos ) )
        goto typeErr;

    UR_S_DROP;
    res = UR_TOS;

    if( ur_binaryMem( ut, res, &cpA, &cpB ) )
    {
        switch( ur_atom(tos) )
        {
            case UR_ATOM_CRC16:
                ur_initType(res, UT_INT);
                ur_int(res) = checksum_crc16( (uint8_t*) cpA, cpB - cpA );
                return;

            case UR_ATOM_SHA1:
            {
                SHA1_CTX context;
                UIndex binN;
                UBinary* bin;

                binN = ur_makeBinary( 20, &bin );
                bin->used = 20;

                SHA1_Init( &context );
                SHA1_Update( &context, (uint8_t*) cpA, cpB - cpA );
                SHA1_Final( &context, bin->ptr.b );

                ur_initType(res, UT_BINARY);
                ur_setSeries(res, binN, 0);
            }
                return;
        }
        goto typeErr;
    }
    else
    {
        ur_throwErr( UR_ERR_DATATYPE, "checksum expected string!/binary!" );
        return;
    }

typeErr:

    ur_throwErr( UR_ERR_DATATYPE, "checksum expected type 'crc16 or 'sha1" );
}


/*--------------------------------------------------------------------------*/


#ifdef _WIN32
#define ur_winHandle(cell)  (cell)->slist.ptr
#include <windows.h>
#if _MSC_VER < 1300
#define INVALID_SET_FILE_POINTER    ((DWORD)-1)
#endif
#else
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <unistd.h>
#include <errno.h>
#include <string.h>
#endif


#define FV_FD   0    


/*
  (url [options] -- port)
  ('std fd -- port)
*/
int _fileOpen( UPortDevice* dev, UThread* ut, UCell* tos )
{
#ifdef _WIN32
    static DWORD _stdWinDevice[3] = {
        STD_INPUT_HANDLE, STD_OUTPUT_HANDLE, STD_ERROR_HANDLE
    };
    HANDLE fh;
#else
    int fd;
#endif
    const char* path;
    UBlock* optBlk = 0;


    if( ur_is(tos, UT_INT) )
    {
        // Standard I/O
        // 0,1,2 - stdin, stdout, stderr
        int n = ur_int(tos);

        tos = ur_s_prev(tos);
        if( ur_is(tos, UT_WORD) && ur_atom(tos) == UR_ATOM_STD )
        {
            if( n < 0 || n > 2 )
                return -1;
#ifdef _WIN32
            fh = GetStdHandle( _stdWinDevice[ n ] );
            if( fh == INVALID_HANDLE_VALUE )
            {
                ur_throwErr( UR_ERR_ACCESS, "GetStdHandle error %d",
                             GetLastError() );
                return -1;
            }
#else
            fd = n;
#endif
            UR_S_DROP;
            goto make_port;
        }
        return 0;
    }
    else if( ur_is(tos, UT_BLOCK) )
    {
        optBlk = ur_block(tos);
        tos = ur_s_prev(tos);
    }

    path = ur_cstring( ut, tos );
    if( path )
    {
#ifdef _WIN32
        DWORD access = GENERIC_READ | GENERIC_WRITE;
        DWORD create = OPEN_ALWAYS;
        int append = 0;

        if( optBlk )
        {
            // Scan options block.
            UCell* it;
            UCell* end;

            UR_ITER_BLOCK( it, end, optBlk, ur_s_next(tos) );
            while( it != end )
            {
                if( ur_is(it, UT_WORD) )
                {
                    switch( ur_atom(it) )
                    {
                        //case UR_ATOM_BINARY:

                        case UR_ATOM_READ:
                            access = GENERIC_READ;
                            create = OPEN_EXISTING;
                            break;

                        case UR_ATOM_WRITE:
                            access = GENERIC_WRITE;
                            create = CREATE_ALWAYS;
                            break;

                        case UR_ATOM_APPEND:
                            create = OPEN_ALWAYS;
                            append = 1;
                            break;
                    }
                }
                ++it;
            }
            UR_S_DROP;
        }

        if( ! ur_userAllows( ut, "Open file \"%s\"", path ) )
        {
            ur_throwErr( UR_ERR_ACCESS, "User denied open" );
            return -1;
        }

        fh = CreateFile( path, access, FILE_SHARE_READ, NULL,
                         create, FILE_ATTRIBUTE_NORMAL, NULL );
        if( fh == INVALID_HANDLE_VALUE )
        {
            ur_throwErr( UR_ERR_ACCESS, "CreateFile error %d",
                         GetLastError() );
            return -1;
        }

        if( append )
        {
            if( SetFilePointer( fh, 0, NULL, FILE_END ) ==
                INVALID_SET_FILE_POINTER )
            {
                ur_throwErr( UR_ERR_ACCESS, "SetFilePointer error %d",
                             GetLastError() );
                CloseHandle( fh );
                return -1;
            }
        }

make_port:
        {
        UCell* val = ur_makePort( ut, dev, tos ); 
        if( val )
        {
            ur_initType(val, UT_INT);   // FV_FD
            ur_int(val) = 1;
            ur_winHandle(val) = fh;
        }
        }
        return 1;
#else
        int flags = O_CREAT|O_RDWR;
        int append = 0;

        if( optBlk )
        {
            // Scan options block.
            UCell* it;
            UCell* end;

            UR_ITER_BLOCK( it, end, optBlk, ur_s_next(tos) );
            while( it != end )
            {
                if( ur_is(it, UT_WORD) )
                {
                    switch( ur_atom(it) )
                    {
                        //case UR_ATOM_BINARY:

                        case UR_ATOM_READ:
                            flags = O_RDONLY;
                            break;

                        case UR_ATOM_WRITE:
                            flags = O_CREAT|O_WRONLY|O_TRUNC;
                            break;

                        case UR_ATOM_APPEND:
                            flags &= ~O_TRUNC;
                            append = 1;
                            break;
                    }
                }
                ++it;
            }
            UR_S_DROP;
        }

        if( ! ur_userAllows( ut, "Open file \"%s\"", path ) )
        {
            ur_throwErr( UR_ERR_ACCESS, "User denied open" );
            return -1;
        }

        fd = open( path, flags, S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH );
        if( fd == -1 )
        {
            ur_throwErr( UR_ERR_ACCESS, strerror( errno ) );
            return -1;
        }

        if( append )
        {
            if( lseek( fd, 0, SEEK_END ) == -1 )
            {
                ur_throwErr( UR_ERR_ACCESS, strerror( errno ) );
                close( fd );
                return -1;
            }
        }

make_port:
        {
        UCell* val = ur_makePort( ut, dev, tos ); 
        if( val )
        {
            ur_initType(val, UT_INT);   // FV_FD
            ur_int(val) = fd;
        }
        }
        return 1;
#endif
    }

    return 0;
}


// (port -- )
UR_CALL( _fileClose )
{
    UBlock* blk;
    UCell* val;

    blk = ur_blockPtr( tos->port.valBlk );
    val = blk->ptr.cells + FV_FD;

    if( ur_is(val, UT_INT) )
    {
#ifdef _WIN32
        HANDLE fh = ur_winHandle(val);

        ur_setNone( val );

        if( ! CloseHandle( fh ) )
        {
            ur_throwErr( UR_ERR_ACCESS, "CloseHandle error %d",
                         GetLastError() );
            return;
        }
#else
        int fd = ur_int(val);

        ur_setNone( val );

        if( close( fd ) == -1 )
        {
            ur_throwErr( UR_ERR_ACCESS, strerror( errno ) );
            return;
        }
#endif
    }

    UR_S_DROP;
}


#define READ_BUF_SIZE   1024


// (port buf -- port buf)
void _fileRead( UThread* ut, UCell* tos, int part )
{
    UBlock* blk;
    UCell* val;
    UCell* pc = ur_s_prev(tos);

    blk = ur_blockPtr( pc->port.valBlk );
    val = blk->ptr.cells + FV_FD;

    if( ur_is(val, UT_INT) )
    {
        UBinary* bin;
        char* buf;
#ifdef _WIN32
        DWORD len;
        DWORD count;
#else
        size_t len;
        ssize_t count;
#endif


        len = part ? part : READ_BUF_SIZE;

        if( ur_is(tos, UT_BINARY) || ur_is(tos, UT_STRING) )
        {
            bin = ur_bin(tos);