\ file I/O Ext. \ Copyright (C) 2000 Alex Malyshev (alexript@mail.ru) \ This is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License \ as published by the Free Software Foundation; either version 2 \ of the License, or (at your option) any later version. \ This program 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 General Public License for more details. \ You should have received a copy of the GNU General Public License \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. uses StartUp uses Ext.const uses Ext.var uses Strings.tmp_str CONSTS FIO_Buffer_Size 256 FIO_FileName_Size 256 ; CREATE FIO_Buffer FIO_Buffer_Size ALLOT CREATE FIO_FileName FIO_FileName_Size ALLOT CREATE FIO_Char_Buffer 0 C, ALIGN : checked ABORT" File Access Error. " ; : put_to_FIO_Buffer { hFile -- u2 wior } FIO_Buffer FIO_Buffer_Size hFile read-file ; : type_FIO_Buffer ( u2 -- ) FIO_Buffer SWAP TYPE ; : read-char ( file -- char ) FIO_Char_Buffer 1 ROT READ-FILE checked IF FIO_Char_Buffer C@ ELSE -1 THEN ; : fgetc { hFile -- c u2 } FIO_Char_Buffer 1 hFile read-file DROP FIO_Char_Buffer @ SWAP ; : fputc ( c hFile -- wior ) emit-file ; : fget64chars ( hFile -- u2 wior ) FIO_Buffer 64 rot read-file ; : fput64chars { hFile -- wior } FIO_Buffer 64 hFile write-file ; : cat-file ( w2 -- ) BEGIN DUP put_to_FIO_Buffer ( -- hFile filesize wior ) 0= WHILE dup 0= IF 2DROP EXIT ELSE type_FIO_Buffer THEN REPEAT DROP ; : isFileReaded ( c-addr c-u -- c-addr c-u flag ) 2DUP file-status 0= IF 1 <> IF TRUE ELSE FALSE THEN ELSE FALSE THEN ; : .file ( c-addr c-u -- ) isFileReaded IF r/o open-file ( -- w2 wior ) 0= IF DUP cat-file ( w2 -- ) THEN close-file DROP THEN ; : LinkStrings { subf_c-addr subf_c-u sube_c-addr sube_c-u -- str_size } subf_c-addr FIO_FileName subf_c-u CMOVE sube_c-addr FIO_FileName subf_c-u + sube_c-u CMOVE subf_c-u sube_c-u + ; : absfilename ( dirname_c-addr dirname_c-u filename_c-addr filename_c-u -- realname_c-addr realname_c-u ) LinkStrings FIO_FileName SWAP ; : AddBackSlash ( addr u -- naddr nu ) ts! ts@ 2DUP + [CHAR] / <> IF S" /" absfilename THEN ;
Make your own free website on Tripod.com