files.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 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 Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
abstract class $FILES
abstract class $FILES is
-- This is the generic file/channel abstraction used for connecting
-- the program to external objects for import/export of data. This is
-- intended to include such things as ordinary files, pipes, standard
-- channels, etc. It is not intended to cover real device drivers!
--
-- The general concept is that a file contains data which may be
-- imported (eg the standard input channel) or exported or (possibly)
-- both (ie updating is possible).
--
-- The whole object may be imported at once using the appropriate
-- implementation version, or written to at the current position. No
-- positioning or seeking is embodied in this abstraction (see, however,
-- $FILE_CURSORS).
--
-- NOTE File deletion is a facility provided by a DIRECTORY class object!
-- Version 1.2 Feb 01. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 6 May 96 kh Original adapted from Sather 1.0
-- 5 Apr 97 kh Modified for portability, etc
-- 28 Feb 01 kh Added my_name for error reporting.
my_name : STR ;
open_for_read(name : STR) : SAME ;
open_for_write(name : STR) : SAME ;
open_at_end(name : STR) : SAME ;
open_for_update(name : STR) : SAME ;
open_at_end_for_update(name : STR) : SAME ;
-- These five different forms of object creation as opening indicate the
-- kinds of operation which it may be desired to perform on the file.
-- It is an error in all cases if the named file does not exist! Note that
-- if repositioning is desired then an associated file cursor must be used!
create_for_write(name : STR) : SAME ;
create_for_update(name : STR) : SAME ;
create_temp : SAME ;
-- These three file creation variants force creation of a new empty file
-- with the given name (or a dynamically allocated temporary name) for the
-- indicated purpose. By its very nature a temporary file is created for
-- update -- and is automatically deleted on closing. Where file access
-- control of any kind is in force then the current user default permissions
-- are given to the file/channel. These may be changed using the associated
-- FILE_PROPS object operations.
is_open : BOOL ;
-- This predicate returns true if and only if the file has not been closed.
size : CARD ;
-- This routine returns the current size of the file as the number of
-- objects contained. If the contents have been written and not flushed then
-- the value returned may not reflect the actual contents of the file when
-- flushed and closed.
position : CARD ;
-- This routine returns the current position of a notional file cursor
-- providing that the file is open, otherwise CARD::nil.
writable : BOOL ;
-- This predicate returns true if and only if the file has not been
-- closed and is writable.
readable : BOOL ;
-- This predicate returns true if and only if the file has not been
-- closed and is readable.
update : BOOL ;
-- This predicate returns true if and only if the file has not been
-- closed and is open for update.
close ;
-- This operation closes the connection to the external file and
-- invalidates this object for file access.
error : BOOL ;
error_message : STR ;
clear ;
-- These three entities relate to the possible errors which may be
-- indicated by the underlying operating system when performing file-related
-- operations. The error component returns false if no error occurred
-- since the initial object creation attempt or immediately after using
-- clear_error. Otherwise any problem occurring sets error to true when
-- the application of error_message yields a system dependent string which
-- may be useful in reporting the error.
end ; -- $FILES
partial class FILE{KIND} < $FILES
partial class FILE{KIND} < $FILES is
-- This partial class implements the generic file attributes and ops
-- appropriate to all kinds of file. It makes use of the facilities of the
-- underlying operating system contained in the class RUNTIME.
-- Version 1.3 Nov 2000. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 6 May 96 kh Original from the Sather 1.0
-- 5 Apr 97 kh Modified for portability
-- 26 Oct 98 kh Added pre/post conditions.
-- 14 Nov 00 kh Added position feature.
private attr fyle : REFERENCE ;
readonly attr my_name : STR ;
private attr priv_readable : BOOL ;
private attr priv_writable : BOOL ;
private attr priv_append : BOOL ;
private attr priv_update : BOOL ;
-- These properties are needed for checking during input/output.
open_for_read(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.readable)
is
-- This routine opens an existing file for reading only. If the name
-- is a FILE_PATH then an error will only occur if the file is missing or
-- the program does not have permission to open it. Otherwise the error
-- may indicate that the name is not valid. Should an error occur then
-- the object returned is void.
mode : FILE_MODES ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Read_Text
else
mode := FILE_MODES::Read_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::open(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := true ;
me.priv_writable := false ;
me.priv_append := false ;
me.priv_update := false ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
open_for_write(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.writable)
is
-- This routine opens an existing file for writing. The file will be
-- truncated on opening. If the name is a FILE_PATH then an error will only
-- occur if the file is missing or the program does not have permission
-- to open it. Otherwise the error may indicate that the name is not
-- valid.
mode : FILE_MODES ;
if ~FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Write_Text
else
mode := FILE_MODES::Write_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::open(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := false ;
me.priv_writable := true ;
me.priv_append := false ;
me.priv_update := false ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
open_at_end(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.writable)
is
-- This routine opens an existing file with the given name for writing
-- from the end only. If the name is a FILE_PATH then an error will only
-- occur if the file is missing or the program does not have permission
-- to open it. Otherwise the error may indicate that the name is not
-- valid.
mode : FILE_MODES ;
if ~FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Append_Text
else
mode := FILE_MODES::Append_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::open(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := false ;
me.priv_writable := true ;
me.priv_append := true ;
me.priv_update := false ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
open_for_update(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.readable
and result.writable)
is
-- This routine opens an existing file at the beginning for update.
-- If the name is a FILE_PATH then an error will only occur if the file is
-- missing or the program does not have permission to open it. Otherwise
-- the error may indicate that the name is not valid.
mode : FILE_MODES ;
if ~FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Update_Text
else
mode := FILE_MODES::Update_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::open(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := true ;
me.priv_writable := true ;
me.priv_append := false ;
me.priv_update := true ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
open_at_end_for_update(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.readable
and result.writable)
is
-- This routine opens an existing file at the end for update. If the
-- name is a FILE_PATH then an error will only occur if the file is missing
-- or the program does not have permission to open it. Otherwise the error
-- may indicate that the name is not valid.
mode : FILE_MODES ;
if ~FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::App_Upd_Text
else
mode := FILE_MODES::App_Upd_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::open(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := true ;
me.priv_writable := true ;
me.priv_append := true ;
me.priv_update := true ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
create_for_write(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.writable)
is
-- This routine creates a new file object representing the external file
-- with the given name for writing only. If the name is a valid FILE_PATH
-- then an error will only occur if the file is present or the program does
-- not have permission to create it. Otherwise the error may indicate that
-- the name is not valid.
mode : FILE_MODES ;
if FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Write_Text
else
mode := FILE_MODES::Write_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::create_file(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := false ;
me.priv_writable := true ;
me.priv_append := false ;
me.priv_update := false ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
create_for_update(name : STR) : SAME
pre (name.size > 0)
post void(result) -- either already exists or no access!
or (~void(result.fyle)
and result.readable
and result.writable)
is
-- This routine creates a file object representing the external file
-- with the given namefor reading and writing. If the name is a valid
-- FILE_PATH then an error will only occur if the file already exists or
-- the program does not have permission to create it. Otherwise the error
-- may indicate that the name is not valid.
mode : FILE_MODES ;
if FILE_SYS::exists(name) then
return void
end ;
me : SAME := new ;
typecase me
when TEXT_FILE then
mode := FILE_MODES::Create_Upd_Text
else
mode := FILE_MODES::Create_Upd_Binary
end ;
loc_fyle : REFERENCE := FILE_SYS::create_file(name,mode) ;
if void(loc_fyle) then
return void
else
me.priv_readable := true ;
me.priv_writable := true ;
me.priv_append := false ;
me.priv_update := true ;
me.fyle := loc_fyle ;
me.my_name := name ;
return me
end
end ;
create_temp : SAME
pre true
post void(result) -- either doesn't exist or no access!
or (~void(result.fyle)
and result.readable
and result.writable)
is
-- This routine creates a file object which is 'unnamed' as a temporary
-- object for use in the current program for both writing and reading.
me : SAME := new ;
me.priv_readable := true ;
me.priv_writable := true ;
me.priv_append := false ;
me.priv_update := true ;
me.fyle := FILE_SYS::create_tempfile ;
me.my_name := STR::create + LIBCHARS::default.Asterisk.char ;
return me
end ;
is_open : BOOL
pre ~void(self)
post true
is
-- This predicate returns true if and only if the file has not been closed.
return ~void(fyle)
end ;
position : CARD
pre ~void(self) and is_open
post true
is
-- This routine returns the current position in the file - provided
-- that it is open!
return FILE_SYS::position(fyle)
end ;
readable : BOOL
pre ~void(self)
post true
is
-- This predicate returns true if and only if the file has not been closed and is readable.
return ~void(fyle)
and priv_readable
end ;
writable : BOOL
pre ~void(self)
post true
is
-- This predicate returns true if and only if the file has not been closed and is writable.
return ~void(fyle)
and priv_writable
end ;
append : BOOL
pre ~void(self)
post true
is
-- This predicate returns true if and only if the file has not been closed and is open for appending.
return ~void(fyle) and priv_append
end ;
update : BOOL
pre ~void(self)
post true
is
-- This predicate returns true if and only if the file has not been closed and is open for updating.
return ~void(fyle) and priv_update
end ;
size : CARD
pre ~void(self) and ~void(fyle)
post true -- or an exception has been raised.
is
-- This routine returns the current size of the file in octets. If
-- the contents have been written and not flushed then the value returned
-- may not reflect the actual contents of the file when flushed and closed.
-- If the attempt to obtain the size is not accepted by the underlying file
-- system then an exception is raised for external handling.
res : CARD ;
if FILE_SYS::size(fyle,out res) then
return res
else
SYS_ERROR::create.file_error(self,self) ;
return void -- to keep compiler happy
end
end ;
error : BOOL is
-- This predicate returns true if and only if self is void (!) or a file
-- operation has resulted in an error and has not been cleared, otherwise
-- false!
return void(fyle) or FILE_SYS::error(fyle)
end ;
error_message : STR
pre ~void(self) and ~void(fyle)
post true
is
-- This routine returns the operating system dependent message
-- for the most recent uncleared error condition.
return FILE_SYS::error_msg(fyle)
end ;
clear
pre ~void(self) and ~void(fyle)
post ~error
is
-- This routine clears any error condition in relation to this file.
FILE_SYS::clearerr(fyle)
end ;
close
pre ~void(self) and ~void(fyle)
post void(fyle)
is
-- This routine closes the file, having flushed any buffers and
-- makes this object invalid as a file object.
FILE_SYS::close(fyle) ;
priv_readable := false ;
priv_writable := false ;
fyle := void
end ;
flush
pre ~void(self) and ~void(fyle)
post true
is
-- This routine ensures that any buffering of the operating system
-- channels is emptied.
FILE_SYS::flush(fyle)
end ;
end ; -- FILE{KIND}
class STD_CHANS
class STD_CHANS is
-- This class comprises the three standard program import/export
-- channels -- stdin, stdout, stderr in C parlance.
--
-- Although in Sather terms it does not derive from the $FILES abstract
-- class, it bears a similar relationship to the program, being used
-- to specify operations employed in the three subordinate classes -- IN,
-- OUT and ERR!
-- Version 1.1 Apr 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 6 May 96 kh Original adapted from Sather 1.1
-- 5 Apr 97 kh Modified for portability
readonly attr chan : REFERENCE ; -- The channel identifier
private attr chan_id : SYS_CHANS ;
attr read_line_mark : BOOL ; -- for use by the IN class.
private stdin_macro : REFERENCE is
builtin FILE_STDIN
end ;
private stdout_macro : REFERENCE is
builtin FILE_STDOUT
end ;
private stderr_macro : REFERENCE is
builtin FILE_STDERR
end ;
-- The above three built-in implementations are required to provide for
-- the implementation-dependent manner in which operating systems and their
-- built-in libraries refer to the three standard program channels.
stdin : SAME is
-- This routine creates a new object for the standard input channel.
me : SAME := new ;
me.chan_id := SYS_CHANS::In_Chan ;
me.chan := stdin_macro ;
me.read_line_mark := false ;
return me
end ;
stdout : SAME is
-- This routine creates a new object for the standard output channel.
me : SAME := new ;
me.chan_id := SYS_CHANS::Out_Chan ;
me.chan := stdout_macro ;
return me
end ;
stderr : SAME is
-- This routine creates a new object for the standard error channel.
me : SAME := new ;
me.chan_id := SYS_CHANS::Err_Chan ;
me.chan := stderr_macro ;
return me
end ;
private append(item : STR) is
-- This routine handles both the FSTR and STR cases below
loop
if ~FILE_SYS::putchar(item.aelt!,chan) then -- really fatal!!!!!
SYS_ERROR::create.error(self,SYS_EXCEPT::Access_Error,item)
end
end
end ;
plus(item : FSTR) is
-- This routine appends the given item to the current channel.
-- Note the special handling of the void string at the beginning!
if void(item) then -- nothing to do!
return
end ;
append(item.str)
end ;
plus(item : CHAR,lib : LIBCHARS) is
-- This routine appends the given item (taken to be in the given
-- repertoire and encoding) to the current channel.
loc_code : CHAR_CODE := item.code(lib) ;
loop
if ~FILE_SYS::putchar(loc_code.octet!,chan) then
SYS_ERROR::create.error(self,SYS_EXCEPT::Access_Error,STR::create(lib) + item)
end
end
end ;
plus(item : CHAR) is
-- This routine appends the given item (taken to be in the given
-- repertoire and encoding) to the current channel.
loc_code : CHAR_CODE := item.code(LIBCHARS::default) ;
loop
if ~FILE_SYS::putchar(loc_code.octet!,chan) then
SYS_ERROR::create.error(self,SYS_EXCEPT::Access_Error,
STR::create + item)
end
end
end ;
plus(item : STR) is
-- This routine appends the given item to the current channel.
-- Note the special handling of the void string at the beginning!
if void(item) then -- nothing to do!
return
end ;
append(item)
end ;
flush is
-- This routine ensures that any buffering of the operating system
-- channels is emptied -- out for stdout and stderr and emptying for
-- stdin.
direction : FLUSH_CMDS ;
if chan_id = SYS_CHANS::In_Chan then
if read_line_mark then -- nothing to do!
return
end ;
direction := FLUSH_CMDS::In_Buffer
else
direction := FLUSH_CMDS::Out_Buffer
end ;
FILE_SYS::flush(chan,direction)
end ;
end ; -- STD_CHAN
class PIPE < $FILES
class PIPE < $FILES is
-- This is the implementation of a virtual file which may be read, appended to by several threads or programs at the same time.
-- Version 1.1 Nov 2000. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 6 May 96 kh Original adapted from Sather 1.0
-- 17 Nov 00 kh Removed impossible feature import!
include BIN_FILE
--position ->,
--size ->,
cursor ->,
buffer -> ;
get : OCTET
pre is_open
post true
is
-- This routine retrieves a single octet from the pipe. If reading
-- failed then error will be true. It should always be checked in practice.
res : OCTET ;
if FILE_SYS::getchar(out res, fyle) then
return res
else
return OCTET::null
end
end ;
get(cnt : CARD) : BINSTR
pre is_open
post ~void(result) or error
is
-- This routine retrieves a single octet from the pipe. If reading
-- failed then error will be true and the returned string void.
loc_res : FBINSTR := FBINSTR::create(cnt) ;
loc_size : CARD := cnt ;
if FILE_SYS::file_read(loc_res,cnt,inout loc_size,fyle) then
return loc_res.binstr
else
return void
end
end ;
end ; -- PIPE