MODULE IO EXPORTS IO, IO_impl, IOBuffer_priv; (***************************************************************************) (* Copyright (C) Olivetti 1989 *) (* All Rights reserved *) (* *) (* Use and copy of this software and preparation of derivative works based *) (* upon this software are permitted to any person, provided this same *) (* copyright notice and the following Olivetti warranty disclaimer are *) (* included in any copy of the software or any modification thereof or *) (* derivative work therefrom made by any person. *) (* *) (* This software is made available AS IS and Olivetti disclaims all *) (* warranties with respect to this software, whether expressed or implied *) (* under any law, including all implied warranties of merchantibility and *) (* fitness for any purpose. In no event shall Olivetti be liable for any *) (* damages whatsoever resulting from loss of use, data or profits or *) (* otherwise arising out of or in connection with the use or performance *) (* of this software. *) (***************************************************************************) IMPORT Text; IMPORT CharType; (* See the interface 'IO_impl' for descriptions of the terms 'stream class' and 'stream bed' plus some other preliminary information. This module provides stream class independent stream operations on buffered streams. It aims to handle as much of the complexity of buffer management as possible, allowing the stream class specific fill and flush functions to be simple. Streams are mapped or unmapped as described in the 'IO' interface. Two types of mapped streams are supported - block aligned and non aligned. (unmapped streams are always non aligned). A block aligned stream does extra work so that the class specific fill and flush functions can make the following assumptions: a) fill - the class specific fill function is only ever called at a block boundary b) flush - the class specific flush function is usually called at a block boundary. If it is not it is guaranteed that the flush is of at most the number of characters required to fill the current block. Block aligned streams are important when the stream bed prefers block alignment. e.g. some disc file systems work more efficiently if you read and write integral numbers of blocks whenever possible. *) (* Now a description of the stream buffer management. There are several pointers into the stream buffer: 'currentP': Points to the current position in the buffer. A put inserts a character into the buffer at 'currentP' then increments 'currentP'. A get extracts the character at 'currentP' and then increments 'currentP'. HighWaterP(s), 'highWaterP': 'HighWaterP(s)' is 'MAX(currentP, highWaterP)' and it points to the first undefined character in the buffer. It would be possible to ensure that 'highWaterP' always points at the first undefined character in the buffer but it would be extra overhead in the single character put routines. So we compromise. All the stream operations apart from the speed critical single character put and get routines (and operations which do not use or affect the buffer) ensure that: highWaterP = HighWaterP(s); before they do any work. 'HighWaterP(s)' points at the first character in the buffer which has not been read in by a fill or inserted by a put. If the buffer is full it will point just beyond the end of the buffer. The area between the start of the buffer and 'HighWaterP(s)' can be thought of as a "window" onto the stream bed. This window maps a series of bytes starting at 'bufferOffset' in the stream bed ('bufferOffset' is one of several stream bed offsets maintained by the stream; more on these later). The area between the start of the buffer and 'HighWaterP(s)' will be referred to as the window area of the buffer. Note that if characters have been put into the buffer the window does not reflect the actual contents of the stream bed until a flush is done and the stream class implementation updates the stream bed. The window just reflects what the stream bed should contain if it was directly updated by put operations, with no buffer intervening. A buffer which contains characters which have been put but not yet flushed is "dirty"; a buffer which does not need flushing is "clean". The area between 'currentP' and 'HighWaterP(s)' contains buffered characters which can be read by get operations. When 'currentP' is equal to 'HighWaterP(s)' the buffer is said to be exhausted. If a get operation occurs when the buffer is exhausted the 'FillBuffer' routine must be called to flush the buffer (if dirty) and refill it. Putting characters into the buffer may cause 'HighWaterP(s)' to increase; note that 'currentP' is always less than or equal to 'HighWaterP(s)' by definition. Notice that putting a character when 'currentP' equals 'HighWaterP(s)' water mark increases 'HighWaterP(s)' and the window onto the stream bed; this is as you would expect. EndP(s, buffer size): The function 'EndP(s, buffer size)' returns the offset of the first non writable character in the buffer i.e. put operations must not put characters into the buffer at positions greater than or equal to 'EndP(s, buffer size)'. If 'currentP' is equal to 'EndP(s, buffer size)' the buffer is said to be full. If a put operation finds that the buffer is full it must call the 'FlushBuffer' routine to flush the buffer (if dirty) and reset the buffer pointers. Normally 'EndP(s, buffer size)' points just beyond the end of the buffer i.e. it is equal to 'buffer size'. The exception to this rule occurs if the stream is block aligned and 'bufferOffset' is not on a block boundary. In this case 'EndP(s, buffer size)' points just after the character which maps the last byte in the block straddling 'bufferOffset'. Thus when the buffer fills (i.e. 'currentP = EndP(s, buffer size)') and a flush is done the buffer offset will move back on to a block boundary. 'dirtyStartP', 'dirtyEndP': 'dirtyStartP' points at the first dirty character in the buffer. A dirty character is one inserted into the buffer by a put operation but not yet flushed. 'dirtyEndP' points just beyond the last dirty character in the buffer. 'dirtyEndP' is not always up to date - the fast put operations do not update it - but other routines take care to make sure it is accurate before using it. Note that there may be clean "holes" between 'dirtyStartP' and 'dirtyEndP' if a lot of seeking has been going on. No attempt is made to avoid flushing these holes. If 'dirtyStartP' is not less than 'dirtyEndP' the values of both pointers are meaningless and may not even point into the buffer. 'putEndP', 'getEndP': These pointers provide limits for putting and getting. The fast put and get routines just check if there is enough space between 'currentP' and 'putEndP' or 'getEndP' to put/get what they need. If there is the operation can be done quickly via the buffer. If there is not enough space slower routines are called to do some checking and possibly flush or fill the buffer. The pointers are notionally equal to 'EndP(s, buffer size)' and 'HighWaterP(s)' respectively. In practice one or both of them may be disabled i.e. set to zero. Disabling 'putEndP', for example, forces the fast put routines to call slower routines which do more checking. These pointers are used together with the status flags 'Putting' and 'Getting'. For example, after a get operation 'getEndP = HighWaterP(s)' and the 'Getting' flag is set, while 'putEndP = 0' and 'Putting' is unset. Subsequent gets will be handled by the fast get routines (assuming the buffer is not exhausted). If a put is done, however, the fast put routine will see no space between 'currentP' and 'putEndP' and will be forced to call a slower routine. This routine will do some initialization (e.g. checking that the stream is writable, setting 'dirtyLowP') before setting the 'Putting' flag and (usually) setting 'putEndP' to be 'EndP(s, buffer size)'. Note that line buffered streams and unbuffered streams keep 'putEndP' at zero all the time so that they they can do extra flushing. This approach means that a series of sequential puts or gets can go quickly, with minimal checking. Switching between puts and gets is a little more costly but is also much less common. Usually either 'Putting' is set or 'Getting' is set. Sometimes both are unset (and both 'putEndP' and 'getEndP' are zero). When this happens the buffer is said to be disabled. When the buffer is disabled it is impossible to do a fast put or get routine without causing a call to a slower, checked routine. The buffer is disabled in the following cases 1) The stream is uninitialized (the language ensures that when an object is created its buffer is disabled and it is marked as uninitialized). Disabling the buffer ensures that noone can use an uninitialized stream. 2) The stream has just been initialized but no puts or gets have been done. This is a startup condition - the 'Putting' or 'Getting' flag is only set after one put or get has been done. 3) A seek, flush or truncate has been done. This is similar to case 2 - after one of these operations we don't know if we are putting or getting. 4) The stream is disabled; disabling the stream is done so that someone else can have uninterrupted access to the stream buffer. This facility is used to implement even faster sequential put and get operations on top of streams. 5) The stream is errant. In this case the stream must not be used until the error is dealt with; disabling the buffer ensures that no put or get operation can be done on the stream. 6) The stream is closed. Disabling the buffer ensures that puts or gets to a closed stream result in an immediate error. In addition 'putEndP' is always zero if 1) The stream is unbuffered 2) The stream is line buffered This is because both these streams require extra flushing (an unbuffered stream must be flushed after every put operation, a line buffered stream whenever a newline is put). Rather than slow down the fast put routines with checks for these special cases we force the slow put routines to be called whenever a put is done to one of these streams. So the normal case stays fast and the slow case gets slower. *) (* The stream also maintains pointers into the stream bed. These are: 'bufferOffset': This is the offset of the start of the window area of the buffer into the stream bed. i.e. the zeroth character in the window (if any) maps the character at 'bufferOffset' in the stream bed. 'realOffset': This is the current stream bed position (or perhaps, to be pedantic, the current position as known by the stream class implementation). It is initially zero. A flush sets 'realOffset' to be 'bufferOffset' plus the number of chars written. A read sets 'realOffset' to be 'bufferOffset' plus the number of chars read. 'seekOffset': Seeks outside the buffer are done lazily. If a seek is done and its destination is inside the buffer it is handled by resetting the 'currentP' pointer. If the destination is outside the buffer 'seekOffset' is set to be the destination of the seek and the 'SeekPending' flag is set. In both cases the buffer is disabled. The 'seekOffset' field is only valid when the 'SeekPending' flag is set. 'length': This is either 'UnknownLength' (for unmapped streams) or it is the stream bed length. This is not always equal to the stream length - there may be unflushed characters in the buffer which will extend the stream bed when they are written. Note, however, that if the buffer is clean the stream bed length and the stream length are the same. *) (* Here is a summary of stream invariants. The phrase "significant operation" is used for an operation which changes the stream state i.e. a put operation, get operation, seek, flush or truncate. One nasty wrinkle: the unget operation is not considered significant because although it changes the stream state it does not change it in an important way. The phrase "if the last significant operation was a blah" does not include the case where "blah" raised a stream error. 1) The buffer size is always at least 1. The buffer size is not always NUMBER(s.buffer^) - sometimes user supplied buffers are filled or flushed directly. We use "buffer size" to mean the current buffer size. buffer size >= 1 2) If the stream is block aligned the buffer size is an integral number of blocks. blockSize = 0 OR buffer size MOD blockSize = 0 3) The buffer pointer invariants are best described by the following expressions: 0 <= HighWaterP(s) <= EndP(s, buffer size) 0 <= currentP <= EndP(s, buffer size); HighWaterP(s) = MAX(currentP, highWaterP) 1 <= EndP(s, buffer size) <= buffer size 4) The end of buffer pointer points just after the last usable character in the buffer. Either a) the stream is block aligned but 'bufferOffset' is not on a block boundary so 'EndP(s, buffer size)' points just after the last character in the remainder of the block OR b) the stream is properly aligned (or does not require alignment) in which case 'EndP(s, buffer size)' points at the character just beyond the end of the buffer. So: blockSize # 0 AND bufferOffset MOD blockSize # 0 AND EndP(s, buffer size) = blockSize - bufferOffset MOD blockSize OR blockSize = 0 OR bufferOffset MOD blockSize = 0 AND EndP(s, buffer size) = buffer size 5) The area between the start of the buffer and 'HighWaterP(s)' is a window on the area in the stream bed starting at 'bufferOffset'. This idea has already been explained in some detail. Note that the character at the high water mark is not included in the area so if the high water mark is 0 there is no window. 6) The 'Putting' flag is set if the current operation is or the last significant operation was a put. putting => in put operation OR after put operation 7) The 'Getting' flag is set if the current operation is or the last significant operation was a get. 'Putting' and 'Getting' cannot both be set. getting => in get operation OR after get operation getting => NOT putting putting => NOT getting 8) After a seek neither 'Putting' or 'Getting' is set. If the seek is outside the buffer 'SeekPending' is set and 'seekOffset' is set to the stream destination. Thus the apparent stream position i.e. the stream position at which the next put or get operation will take place is either 'bufferOffset' plus the number of characters before 'currentP' in the buffer or, if a seek is pending, 'seekOffset'. after seek => NOT (putting OR getting) IF seek is pending THEN apparent position is seekOffset ELSE apparent position is bufferOffset + currentP END; 9) If the buffer is disabled the buffer pointers are set so that any fast put or get operation will immediately force a call to a slower, checked routine. The buffer is disabled when the stream is first initialized, after a seek, flush or truncate, or if the stream is uninitialized, disabled, errant or closed. buffer disabled <=> stream newly initialized OR after seek OR after flush OR after truncate OR stream not initialized OR stream is disabled OR stream is errant OR stream is closed buffer disabled => getEndP = putEndP = 0 AND NOT (getting OR putting) 10) Fast puts are disabled if the buffer is disabled (see 9), if the last significant operation was a get or if the stream requires extra checks on put operations. If fast puts are enabled the 'Putting' flag is set. fast puts disabled <=> buffer is disabled OR after get OR stream is unbuffered OR stream is line buffered IF fast puts disabled THEN putEndP = 0 ELSE putEndP = EndP(s, buffer size) END; fast puts enabled => putting 11) Fast gets are disabled if the buffer is disabled (see 9) or if the last significant operation was a put. If fast gets are enabled the 'Getting' flag is set. fast gets disabled <=> buffer is disabled OR after put IF fast gets disabled THEN getEndP = 0 ELSE getEndP = HighWaterP(s) END; fast gets enabled => getting 12) The 'ungetP' pointer is set to 'currentP' in order to disallow an unget at that position. Ungets are only allowed when 'Getting' is set so: getting AND currentP # ungetP => unget allowed 13) The stream length is the maximum of the 'length' field and a quantity called the next sequential position. The next sequential position is 'bufferOffset' plus the the number of characters in the window region of the buffer. The 'length' field, if not 'UnknownLength', reflects the actual length of the stream bed which may be less than the stream length because of unflushed characters in the buffer. If 'length' is 'UnknownLength' the stream is not a mapped stream and its length is not known (and is usually meaningless e.g. what is the length of a stream from a keyboard?). next sequential position is bufferOffset + HighWaterP(s) stream length is MAX(next sequential position, length) 'UnknownLength' is largest possible cardinal hence MAX(next sequential position, UnknownLength) = UnknownLength 14) The offsets into the stream bed are always less than or equal to the 'length' field. Note 'seekOffset' is only valid if 'SeekPending' is set. The reason why 'seekOffset' is less than or equal to 'length' is rather subtle; if 'length' is less than the stream length, making it possible to seek beyond 'length', a seek to say 'length + 1' must be within the buffer so 'SeekPending' will never get set. 0 <= bufferOffset <= realOffset <= length IF seek is pending THEN 0 <= seekOffset <= length END; *) TYPE (* Flags which describe the status of a stream *) Status = { Uninitialized, (* stream has not yet been opened and initialized *) Putting, (* last operation was a put *) Getting, (* last operation was a get *) SeekPending, (* seek pending; destination in 'seekOffset' *) GotEndOfStream, (* last get operation hit end of stream *) Disabled, (* stream disabled; someone else is using the buffer *) Errant, (* stream error has occured *) Closed (* stream is closed *) }; StatusSet = SET OF Status; CONST EmptyStatus = StatusSet{}; InitialStatus = StatusSet{Status.Uninitialized}; Unusable = StatusSet{Status.Disabled, Status.Uninitialized, Status.Errant, Status.Closed}; (* If any of these status bits is set the stream is unusable (and the buffer must be disabled *) SlowProperties = PropertySet{Property.Unbuffered, Property.LineBuffered}; EXCEPTION Fatal; (* Internal exception - cannot be caught *) REVEAL Stream = Methods BRANDED OBJECT buffer: REF ARRAY OF CHAR := NIL; (* Stream buffer *) currentP, getEndP, putEndP: CARDINAL := 0; (* Offsets into buffer *) dirtyStartP := LAST(CARDINAL); (* Start and end of *) dirtyEndP: CARDINAL := 0; (* Dirty region of buffer *) highWaterP: CARDINAL := 0; (* High water mark *) ungetP := 0; (* Offset of last unget *) status := InitialStatus; (* Stream status *) properties := NoProperties; (* Stream properties *) fault := Fault.None; (* Last error *) bufferOffset: CARDINAL := 0; (* Offset of start of buffer into stream bed *) seekOffset: CARDINAL := 0; (* Seek destination *) realOffset: CARDINAL := 0; (* Actual stream bed offset *) length: CARDINAL := UnknownLength; (* Length of stream bed *) blockSize: CARDINAL := 0; (* Block size *) name := "(no name)"; (* Name of stream *) OVERRIDES implFlush := DefaultImplFlush; implFill := DefaultImplFill; implSeek := DefaultImplSeek; implTruncate := DefaultImplTruncate; implClose := DefaultImplClose; implDescribeError := DefaultImplDescribeError; implRecover := DefaultImplRecover; END; (* Maintaining buffer invariants *) <*INLINE*> PROCEDURE HighWaterP(s: Stream): CARDINAL RAISES {}= BEGIN RETURN MAX(s.currentP, s.highWaterP); END HighWaterP; <*INLINE*> PROCEDURE EndP(s: Stream; bufferSize: CARDINAL): CARDINAL RAISES {}= (* End of buffer or end of current block *) BEGIN IF s.blockSize # 0 THEN WITH offset = s.bufferOffset MOD s.blockSize DO IF offset # 0 THEN RETURN s.blockSize - offset END; END; END; RETURN bufferSize; END EndP; <*INLINE*> PROCEDURE DirtyEndP(s: Stream): CARDINAL RAISES {}= (* Should only be called when 'Putting' set *) BEGIN RETURN MAX(s.currentP, s.dirtyEndP); END DirtyEndP; <*INLINE*> PROCEDURE DirtyStartP(s: Stream): CARDINAL RAISES {}= (* Should only be called when 'Putting' set *) BEGIN RETURN MIN(s.currentP, s.dirtyStartP); END DirtyStartP; <*INLINE*> PROCEDURE DisableBuffer(s: Stream) RAISES {}= (* Disables the buffer by setting 'getEndP' and 'putEndP' to zero. Also unsets transient status flags and the 'ungetP' pointer. *) BEGIN IF Status.Putting IN s.status THEN s.dirtyEndP := DirtyEndP(s) END; s.status := s.status - StatusSet{Status.Putting, Status.Getting}; s.putEndP := 0; s.getEndP := 0; s.ungetP := 0; END DisableBuffer; <*INLINE*> PROCEDURE CleanBuffer(s: Stream) RAISES {}= (* Mark buffer as clean *) BEGIN s.dirtyStartP := LAST(CARDINAL); s.dirtyEndP := 0; END CleanBuffer; <*INLINE*> PROCEDURE InternalTell(s: Stream): CARDINAL RAISES {} = (* Returns current position *) BEGIN IF Status.SeekPending IN s.status THEN RETURN s.seekOffset; ELSE RETURN s.bufferOffset + s.currentP; END; END InternalTell; <*INLINE*> PROCEDURE InternalLength(s: Stream): CARDINAL RAISES {}= (* Stream length *) BEGIN RETURN MAX(s.length, s.bufferOffset + s.highWaterP); END InternalLength; (* Raising exceptions for errors and end of stream *) PROCEDURE RaiseError(s: Stream; fault: Fault) RAISES {Error} = (* Set appropriate flags in stream then raise a stream error *) BEGIN (* Only raise a new error if the stream is not already errant *) IF NOT Status.Errant IN s.status THEN (* First we disable the buffer *) DisableBuffer(s); (* Then we mark the stream as errant and we set the 'fault' field *) s.status := s.status + StatusSet{Status.Errant}; s.fault := fault; IF fault IN ImplFaults THEN (* The buffer pointers are meaningless; if the error occured while we were dealing with a buffer other than the stream buffer they may also be misleading. We get rid of them *) s.currentP := 0; s.highWaterP := 0; CleanBuffer(s); END; END; RAISE Error(s); END RaiseError; PROCEDURE NotUsable(s: Stream) RAISES {Error}= (* The stream is uninitialized, errant or closed; raise appropriate error *) VAR fault: Fault; BEGIN IF Status.Uninitialized IN s.status THEN fault := Fault.NotInitialized; ELSIF Status.Disabled IN s.status THEN s.status := s.status - StatusSet{Status.Disabled}; fault := Fault.Disabled; ELSE (* stream is errant or closed; we ignore errant case - if 's' is errant 'RaiseError' will just reraise the error anyway *) fault := Fault.Closed; END; RaiseError(s, fault); END NotUsable; <*INLINE*> PROCEDURE EnsureIsValid( s: Stream; property := Property.Readable; fault: Fault := Fault.None) RAISES {Error}= (* Check 's' is usable and has the given property; set up 'highWaterP' *) BEGIN IF s.status * Unusable # EmptyStatus THEN NotUsable(s) END; IF fault # Fault.None AND NOT property IN s.properties THEN RaiseError(s, fault); END; s.highWaterP := HighWaterP(s); END EnsureIsValid; <*INLINE*> PROCEDURE RealSeek(s: Stream; offset: INTEGER) RAISES {Error} = (* If a seek is pending, calls the class specific seek routine to take care of it *) BEGIN IF s.realOffset # offset AND NOT s.implSeek(offset) THEN RaiseError(s, Fault.Seek); END; END RealSeek; (* Putting chars and flushing the buffer *) PROCEDURE FlushBuffer( s: Stream; READONLY buffer: ARRAY OF CHAR) RAISES {Error} = (* Flush the given buffer (if it is dirty) using the streams 'implFlush' method. The buffer is not necessarily the stream buffer ('PutN' can flush its argument array direct, thus avoiding needless copying). As a consequence the function 'EndP', which depends on the stream buffer size must not be used. The stream must be checked for validity before 'FlushBuffer' is called. 's' must be usable and, if the buffer is dirty, it must be writable. 'highWaterP' must be set to the high water mark. After the flush the buffer is always clean and 's.length' is both the stream and the stream bed length. The buffer is empty unless there are still unread characters after 'currentP' (note that this implies there is space for further put operations as well). Any pending seek takes effect when 'FlushBuffer' is called. If a seek is pending the buffer will be both clean and empty after the flush and 'bufferOffset' will be set to 'seekOffset'. *) BEGIN (* Buffer streams are a special case. A flush is a meaningless operation because the buffer is the stream bed. Note that there cannot be a pending seek on a buffer stream - a seek outside the range of the buffer would be caught by 'Seek' *) IF Property.IsBuffer IN s.properties THEN CleanBuffer(s); s.length := MAX(s.length, s.highWaterP); RETURN; END; WITH dirty = s.dirtyEndP - s.dirtyStartP DO (* now do the flush, if the buffer is dirty *) IF dirty > 0 THEN RealSeek(s, s.bufferOffset + s.dirtyStartP); IF s.implFlush(SUBARRAY(buffer, s.dirtyStartP, dirty)) THEN (* update length if we have extended the stream *) s.realOffset := s.bufferOffset + s.dirtyEndP; s.length := MAX(s.length, s.realOffset); CleanBuffer(s); ELSE RaiseError(s, Fault.Write); END; END; END; (* Tidy up - buffer is no longer dirty, pointers may need to be reset *) IF Status.SeekPending IN s.status THEN (* If a seek was pending it can now take effect because the buffer is clean; we just unset the 'SeekPending' bit and set 'bufferOffset'. later code will set the buffer pointers. *) s.status := s.status - StatusSet{Status.SeekPending}; s.bufferOffset := s.seekOffset; ELSIF s.currentP < s.highWaterP THEN (* There are still unread characters in this buffer (and, by implication, space for more puts as well) so we return *) RETURN; ELSE (* move buffer on to next sequential position, later code will set up the buffer pointers *) INC(s.bufferOffset, s.highWaterP); END; (* Reset the buffer pointers. We rely on the caller to set 'getEndP' and 'putEndP' appropriately *) s.currentP := 0; s.highWaterP := 0; s.ungetP := 0; END FlushBuffer; PROCEDURE NoSpaceForPutting( s: Stream; mustBeSpace: BOOLEAN) : BOOLEAN RAISES {Error}= BEGIN EnsureIsValid(s, Property.Writable, Fault.NotWritable); IF Property.AppendOnly IN s.properties AND InternalTell(s) # InternalLength(s) THEN IF mustBeSpace THEN RaiseError(s, Fault.BadAppend) ELSE RETURN TRUE END; END; IF Status.SeekPending IN s.status THEN (* If 'seekPending' is TRUE we don't care about 'full' *) RETURN TRUE; ELSIF s.currentP = EndP(s, NUMBER(s.buffer^)) THEN IF Property.IsBuffer IN s.properties AND mustBeSpace THEN RaiseError(s, Fault.Write); <* NOTREACHED *> ELSE RETURN TRUE; END; ELSE RETURN FALSE; END; END NoSpaceForPutting; <*INLINE*> PROCEDURE MakeRoomForPut(s: Stream) RAISES {Error}= (* A big inline but it's only called twice, in 'SlowPut' and 'SlowPutN'. Does as you would expect - makes sure there is space for a put operation in the buffer, flushing it if necessary. Sets up the 'Putting' flag and 'dirtyStartP' field. *) VAR flush: BOOLEAN; BEGIN IF Status.Putting IN s.status THEN (* The last significant operation was a successful put *) s.highWaterP := HighWaterP(s); s.dirtyEndP := DirtyEndP(s); IF s.putEndP # 0 THEN (* normal stream *) flush := s.currentP = s.putEndP; ELSE (* line buffered or unbuffered stream *) flush := s.currentP = EndP(s, NUMBER(s.buffer^)); END; ELSE (* Last significant operations was not a put; it may just have been some other operation e.g. get or seek, but we could be dealing with an unusable or non writable stream *) flush := NoSpaceForPutting(s, TRUE); (* The following may not always be necessary but who cares *) s.getEndP := 0; s.status := (s.status + StatusSet{Status.Putting}) - StatusSet{Status.Getting}; END; IF flush THEN FlushBuffer(s, s.buffer^) END; s.dirtyStartP := DirtyStartP(s); END MakeRoomForPut; PROCEDURE SlowPut(s: Stream; char: CHAR) RAISES {Error}= (* Called by the single character put routines if it looks like there is serious work to do - either the buffer is obviously full or fast puts are disabled. 'MakeRoomForPut' does most of the work *) BEGIN MakeRoomForPut(s); s.buffer[s.currentP] := char; INC(s.currentP); WITH slowProperties = s.properties * SlowProperties DO IF slowProperties # NoProperties THEN IF Property.Unbuffered IN slowProperties OR char = '\n' THEN s.highWaterP := HighWaterP(s); s.dirtyEndP := DirtyEndP(s); FlushBuffer(s, s.buffer^); END; ELSE s.putEndP := EndP(s, NUMBER(s.buffer^)); END; END; END SlowPut; <*INLINE*> PROCEDURE Put(s: Stream; char: CHAR) RAISES {Error} = (* If there is no space in the stream buffer or fast puts are disabled (i.e. 'endPutP' is zero) calls 'SlowPut' to do the work. Otherwise inserts 'char' into the buffer and increments 'currentP' *) BEGIN WITH currentP = s.currentP DO IF currentP >= s.putEndP THEN SlowPut(s, char); ELSE s.buffer[currentP] := char; INC(currentP); END; END; END Put; (* Getting chars and filling the buffer *) PROCEDURE FillBuffer( s: Stream; VAR buffer: ARRAY OF CHAR) : BOOLEAN RAISES {Error} = (* Fills buffer when it has been exhausted (i.e. 'currentP' is greater than or equal to 'HighWaterP(s)'. Calls 'implFill' to do the real work. The fill is done at 'bufferOffset + highWaterP' rounded to a block boundary if the stream is block aligned. The buffer must not be dirty and there must be no seek pending - use 'FlushAndFillBuffer' if this is not the case. 'buffer' is not necessarily the stream buffer - 'GetN' sometimes fills its buffer directly to avoid copying. As a consequence 'FillBuffer' must not use the 'EndP' procedure, which uses the size of the stream buffer. 'FillBuffer' returns FALSE only if there are no more characters to be read; it 'returns TRUE even if the buffer is only partially filled. 's' must be validated before it is given to 'FillBuffer'; it must be a usable, readable stream and 'highWaterP' must be set to 'HighWaterP(s)'. There must be no seek pending and 'Getting' must be set. After a successful call to 'FillBuffer' (i.e. one that did not raise 'Error' or return FALSE) the following apply: 1) 'currentP < highWaterP <= EndP(s, NUMBER(buffer))' Note there is at least one char available for reading and 'EndP(s, NUMBER(buffer))' points just after the last character in the buffer. 'currentP' is usually zero but may not be if the fill occurs after a seek off a buffer boundary. 2) any pending seek is cleared. 3) if the stream is block aligned then 'bufferOffset' is block aligned 4) if we did not reach the end of stream 'highWaterP = NUMBER(buffer)' 5) if we reached the end of stream '0 < highWaterP < NUMBER(buffer)' (this is the case when the buffer is not completely filled but is not empty either so we still return TRUE). 6) 'endGetP = highWaterP'; 'FillBuffer' is only ever called when the 'Getting' flag is set so this is a reasonable thing to do *) VAR fillPosition, offset: CARDINAL; chars: INTEGER; BEGIN (* Assert: No seek pending and 's.length' is equal to the stream length *) (* Fill position is the end of this buffer *) fillPosition := s.bufferOffset + s.highWaterP; (* Check that we are not at the end of the stream. Note that 'fillPosition' can never be greater than the stream length. *) IF s.length = fillPosition OR Status.GotEndOfStream IN s.status THEN chars := 0; ELSE (* If the stream is block aligned make sure that the fill position is on a block boundary. Note that after the fill has taken place our current position will then be at 'offset' into the buffer. *) IF s.blockSize = 0 THEN offset := 0; ELSE offset := fillPosition MOD s.blockSize; DEC(fillPosition, offset); END; (* Seek to 'fillPosition' then call the 'implFill' procedure. If the length of the stream is known we make sure we don't ask for chars beyond the end of the stream *) RealSeek(s, fillPosition); WITH expected = MIN(NUMBER(buffer), s.length - fillPosition) DO chars := s.implFill(SUBARRAY(buffer, 0, expected)); (* Complain now if the fill failed due to an error or if not enough characters were returned *) IF chars < 0 OR chars > expected OR Property.Mapped IN s.properties AND chars < expected THEN RaiseError(s, Fault.Read); END; END; s.realOffset := fillPosition + chars; (* New offset into stream bed *) s.bufferOffset := fillPosition; (* Reset buffer offset *) s.highWaterP := chars; (* Point to end of read chars *) s.currentP := offset; (* 'offset' described earlier *) (* 'putEndP' left at 0 *) END; (* Always set 'getEndP'. 'ungetP' is set to a value which cannot be equal to 'currentP', even if we are at the end of stream. This is because we are probably being called by a routine which will allow a following 'Unget'; the routines which don't allow it are required to do the work of preventing it *) s.getEndP := s.highWaterP; s.ungetP := LAST(CARDINAL); IF chars = 0 THEN s.status := s.status + StatusSet{Status.GotEndOfStream}; RETURN FALSE; ELSE RETURN TRUE; END; END FillBuffer; <*INLINE*> PROCEDURE FlushAndFillBuffer(s: Stream): BOOLEAN RAISES {Error}= (* Flush the buffer if 's' is dirty then fill. Assumes no seek pending *) BEGIN WITH buffer = s.buffer^ DO IF s.dirtyEndP > s.dirtyStartP THEN FlushBuffer(s, buffer); END; RETURN FillBuffer(s, buffer); END; END FlushAndFillBuffer; PROCEDURE SetGetting(s: Stream) RAISES {Error}= BEGIN EnsureIsValid(s, Property.Readable, Fault.NotReadable); DisableBuffer(s); (* we assume we are not going to hit end of stream; 'FillBuffer' will correct us if we are wrong *) WITH status = s.status DO status := status + StatusSet{Status.Getting}; IF Property.Mapped IN s.properties THEN (* The 'GotEndOfStream' state is not permanent - we could have done a seek or a put. So we unset 'GotEndOfStream' in the knowledge that 'FillBuffer' will reset it if necessary *) status := status - StatusSet{Status.GotEndOfStream}; ELSE (* On unmapped streams 'GotEndOfStream' is permanent *) END; END; s.getEndP := s.highWaterP; END SetGetting; PROCEDURE CheckAndClearSeek(s: Stream) RAISES {Error}= (* Check stream is valid, then clear any pending seek *) BEGIN EnsureIsValid(s, Property.Readable, Fault.NotReadable); FlushBuffer(s, s.buffer^); SetGetting(s); END CheckAndClearSeek; <*INLINE*> PROCEDURE UnreadCharsInBuffer(s: Stream): BOOLEAN RAISES {Error}= (* Checks to see if we can read more characters in this buffer. After a call of 'UnreadCharsInBuffer' (which does not raise 'Error') the 'Getting' flag is always set and there is no seek pending *) CONST GettingOrSeekPending = StatusSet{Status.Getting, Status.SeekPending}; VAR gettingOrSeekPending := s.status * GettingOrSeekPending; BEGIN IF gettingOrSeekPending # EmptyStatus THEN IF gettingOrSeekPending = StatusSet{Status.SeekPending} THEN CheckAndClearSeek(s); RETURN FALSE; END; ELSE SetGetting(s); END; RETURN s.currentP < s.getEndP; END UnreadCharsInBuffer; <*INLINE*> PROCEDURE MakeRoomForGet(s: Stream): BOOLEAN RAISES {Error}= (* Checks for unread characters in the buffer; if that fails refills the buffer *) BEGIN RETURN UnreadCharsInBuffer(s) OR FlushAndFillBuffer(s); END MakeRoomForGet; PROCEDURE MakeRoomForSingleGet(s: Stream) RAISES {Error, EndOfStream}= (* Just a wrapper around 'MakeRoomForGet'; it avoids having too much inlined in 'Get' *) BEGIN IF NOT MakeRoomForGet(s) THEN RAISE EndOfStream(s) END; END MakeRoomForSingleGet; <*INLINE*> PROCEDURE Get(s: Stream): CHAR RAISES {Error, EndOfStream} = (* If the buffer is exhausted call 'MakeRoomForSingleGet' to refill it (a normal return from 'MakeRoomForSingleGet' guarantees that there is at least one character available for reading in the buffer. Saves the character pointed at by 'currentP', increments 'currentP' and then returns the saved character *) VAR char: CHAR; BEGIN WITH currentP = s.currentP DO IF currentP >= s.getEndP THEN MakeRoomForSingleGet(s) END; char := s.buffer[currentP]; INC(currentP); END; RETURN char; END Get; PROCEDURE GetUntil( s: Stream; VAR chars: ARRAY OF CHAR; READONLY terminate := CharType.WhiteSpace; unget := TRUE) : CARDINAL RAISES {Error}= (* Reads characters into 'chars' until 'chars' is full, a terminator is read or end of stream or error is encountered *) VAR pos: CARDINAL := 0; BEGIN IF MakeRoomForGet(s) THEN LOOP FOR i := s.currentP TO s.getEndP - 1 DO VAR char := s.buffer[i]; BEGIN IF char IN terminate THEN IF unget THEN s.currentP := i; s.ungetP := i; ELSE s.currentP := i + 1; END; RETURN pos; ELSIF pos = NUMBER(chars) THEN s.currentP := i; RETURN pos + 1; ELSE chars[pos] := char; INC(pos); END; END; END; s.currentP := s.getEndP; IF NOT FillBuffer(s, s.buffer^) THEN EXIT END; END; END; RETURN pos; END GetUntil; PROCEDURE Skip( s: Stream; READONLY skip := CharType.WhiteSpace; unget := TRUE) : CHAR RAISES {Error, EndOfStream}= (* Skip characters in the 'skip' set *) BEGIN IF MakeRoomForGet(s) THEN LOOP FOR i := s.currentP TO s.highWaterP - 1 DO VAR char := s.buffer[i]; BEGIN IF NOT char IN skip THEN IF unget THEN s.currentP := i; s.ungetP := i; ELSE s.currentP := i + 1; END; RETURN char; END; END; END; s.currentP := s.getEndP; IF NOT FillBuffer(s, s.buffer^) THEN EXIT END; END; END; RAISE EndOfStream(s); END Skip; (* Bulk I/O *) (* The bulk I/O routines sometimes bypass the stream buffer and write/read directly to/from the buffer given to them. *) <*INLINE*> PROCEDURE ModuloBlockSize( s: Stream; n: CARDINAL) : CARDINAL RAISES {} = (* Returns 'n' rounded down to the nearest full block *) BEGIN IF s.blockSize = 0 THEN RETURN n; ELSE RETURN n - n MOD s.blockSize; END; END ModuloBlockSize; <*INLINE*> PROCEDURE PutToBuffer( s: Stream; READONLY chars: ARRAY OF CHAR; count: CARDINAL; VAR n: CARDINAL) RAISES {} = (* Copies 'count' bytes from a position 'n' from the end of 'chars' into the stream buffer; adjusts stream pointers. Then decrements 'n' by 'count'. 'n' must be non zero. *) BEGIN SUBARRAY(s.buffer^, s.currentP, count) := SUBARRAY(chars, NUMBER(chars) - n, count); INC(s.currentP, count); s.highWaterP := HighWaterP(s); DEC(n, count); END PutToBuffer; PROCEDURE InternalPutN( s: Stream; READONLY chars: ARRAY OF CHAR) RAISES {Error} = (* Puts the given array of chars to 's' as quickly as possible. Does some buffer swapping tricks to avoid lots of copying if 'chars' is bigger than the stream buffer. By the time we enter 'InternalPutN' the stream is known to be writable, no seek is pending and, if the stream is append only, we are at the end of the stream. 'highWaterP' is set and 'dirtyStartP = currentP'. There is at least one free slot in the buffer. 'putEndP' is in an undefined state, so we don't use it *) VAR n: CARDINAL := NUMBER(chars); bufferSize := NUMBER(s.buffer^); BEGIN (* Our aim is to have an empty and block aligned (if necessary) buffer so we can switch 'chars' with the stream buffer and flush it directly *) WITH bufferSpace = EndP(s, bufferSize) - s.currentP, isBufferStream = Property.IsBuffer IN s.properties DO IF bufferSpace # bufferSize OR isBufferStream THEN IF bufferSpace > 0 THEN (* Copy as many characters as possible into the buffer. If they all fit we have finished *) PutToBuffer(s, chars, MIN(n, bufferSpace), n); IF n = 0 THEN RETURN END; END; (* The buffer is completely full (note that this implies that 's.currentP >= s.dirtyEndP'). Flushing this buffer will leave the buffer empty and aligned. If we get here and 's' is a buffer stream we are in trouble! *) IF isBufferStream THEN (* overflow *) RaiseError(s, Fault.Write); ELSE s.dirtyEndP := s.currentP; FlushBuffer(s, s.buffer^); END; ELSE (* An empty buffer with 'EndP(s, bufferSize)' pointing just after its last character implies that the buffer is both empty and aligned. We do not come here if we are dealing with a buffer stream because in a buffer stream 'PutToBuffer' is actually updating the stream bed! *) END; END; (* Assert: buffer is aligned and empty; 'n > 0'. If we have a buffer full or more of chars to go we flush as many of them as possible directly from 'chars'. There are two cases: If the stream is not block aligned we flush all that remains of 'chars' and the job is done. If the stream is block aligned we flush an integral number of blocks so there may be a partial block left over *) IF n >= bufferSize THEN (* Flush an integral number of blocks *) WITH nRounded = ModuloBlockSize(s, n) DO (* Our new "buffer" must look full and dirty *) s.currentP := nRounded; s.highWaterP := nRounded; s.dirtyStartP := 0; s.dirtyEndP := nRounded; FlushBuffer(s, SUBARRAY(chars, NUMBER(chars) - n, nRounded)); DEC(n, nRounded); (* Note how many we flushed *) END; END; (* We still may have some characters left but we have less than a buffer full and the buffer must be empty and aligned. So, we just stuff them into the buffer *) IF n > 0 THEN s.dirtyStartP := 0; PutToBuffer(s, chars, n, n); ELSE (* We emptied the buffer with the flush and have not put anything else into it. The buffer is clean. So we unset the 'Putting' flag because we want any following put operation to set the 'dirtyStartP' flag. *) s.status := s.status - StatusSet{Status.Putting}; END; END InternalPutN; PROCEDURE SlowPutN(s: Stream; READONLY chars: ARRAY OF CHAR) RAISES {Error}= (* Handles 'PutN' when the buffer is full or 's.putEndP' is zero. Calls 'MakeRoomForPut' to take care of setting the 'Putting' flag and flushing the buffer if necessary, then calls 'InternalPutN' to do the put *) VAR slowProperties := s.properties * SlowProperties; BEGIN MakeRoomForPut(s); IF slowProperties = NoProperties THEN (* Normal stream *) InternalPutN(s, chars); IF Status.Putting IN s.status THEN s.putEndP := EndP(s, NUMBER(s.buffer^)); END; ELSIF Property.Unbuffered IN slowProperties THEN (* Unbuffered, but there is no need for a flush - 'InternalPutN' only leaves the buffer dirty if the stream was block aligned or there was less than a buffer full of characters left after flushing the initial buffer; neither of these are relevent if the 'bufferSize = 1' *) InternalPutN(s, chars); ELSE (* 's' is line buffered. We find the last newline and make sure that everything up to and including that newline is flushed *) VAR last := LAST(chars); pos := last; BEGIN WHILE pos >= 0 AND chars[pos] # '\n' DO DEC(pos) END; IF 0 <= pos AND pos < last THEN INC(pos); InternalPutN(s, SUBARRAY(chars, 0, pos)); s.dirtyEndP := DirtyEndP(s); FlushBuffer(s, s.buffer^); s.dirtyStartP := DirtyStartP(s); InternalPutN(s, SUBARRAY(chars, pos, NUMBER(chars) - pos)); ELSE InternalPutN(s, chars); IF pos = last THEN s.dirtyEndP := DirtyEndP(s); FlushBuffer(s, s.buffer^); END; END; END; END; END SlowPutN; <*INLINE*> PROCEDURE PutN( s: Stream; READONLY chars: ARRAY OF CHAR) RAISES {Error} = (* Puts the given array of chars to 's' as quickly as possible. Most of the tricky work is done by 'SlowPutN' and InternalPutN'; this procedure just checks for the simple (and hopefully common!) case when there is enough space for 'chars' in the current buffer. Note that if 'chars' is exactly a buffer full and the buffer is empty we still call 'SlowPutN' because the buffer will be clean and 'putEndP' will be zero *) VAR number := NUMBER(chars); BEGIN IF number = 0 THEN RETURN END; WITH currentP = s.currentP DO IF s.putEndP - currentP >= number THEN SUBARRAY(s.buffer^, currentP, number) := chars; INC(currentP, number); ELSE SlowPutN(s, chars); END; END; END PutN; <*INLINE*> PROCEDURE GetFromBuffer( s: Stream; VAR chars: ARRAY OF CHAR; VAR n: CARDINAL) RAISES {} = (* Copies a block of characters from the stream buffer into 'chars'. The number of characters copied is either 'n' or the number of characters in the buffer, whichever is smaller. Adjusts stream pointers and decrements 'n' appropriately. 'n' should be non zero. *) VAR buffered: CARDINAL := s.highWaterP - s.currentP; BEGIN IF buffered > 0 THEN IF buffered > n THEN buffered := n END; SUBARRAY(chars, NUMBER(chars) - n, buffered) := SUBARRAY(s.buffer^, s.currentP, buffered); INC(s.currentP, buffered); DEC(n, buffered); END; END GetFromBuffer; EXCEPTION GetNDone; PROCEDURE InternalGetN( s: Stream; VAR chars: ARRAY OF CHAR; raiseEndOfStream: BOOLEAN) : CARDINAL RAISES {Error, EndOfStream} = (* Tries to fill 'chars' from the given stream as quickly as possible. Returns the number of characters actually read - this is only less than 'NUMBER(chars)' if the end of stream is reached. If 'raiseEndOfStream' is TRUE and the number of characters read is not 'NUMBER(chars)' 'EndOfStream' is raised. If an error occurs 'Error' is raised so the return value is irrelevant. May temporarily swap 'chars' for the stream buffer in order to avoid extra copying. *) VAR number: CARDINAL := NUMBER(chars); n := number; BEGIN TRY (* Our initial aim is to exhaust the buffer so that we can swap 'chars' for the stream buffer. 'UnreadCharsInBuffer' sets 'Getting', gets rid of any pending seek, and lets us know if there are any characters still to be read in the current buffer. If there are we exhaust the buffer using 'GetFromBuffer' *) IF UnreadCharsInBuffer(s) THEN GetFromBuffer(s, chars, n); IF n = 0 THEN RAISE GetNDone END; END; (* We want the buffer clean, empty and exhausted; if it is not in that state already 'FlushBuffer' will do the trick *) IF s.highWaterP > 0 THEN FlushBuffer(s, s.buffer^) END; (* Assert: 'length' field accurate, no seek pending. 'Getting' is set *) (* now all we have to worry about is alignment *) IF s.blockSize # 0 THEN WHILE (s.bufferOffset + s.highWaterP) MOD s.blockSize # 0 DO (* Only execute this loop more than once if we hit end of stream, in which case we will exit via the RAISE statement *) IF NOT FillBuffer(s, s.buffer^) THEN RAISE GetNDone END; GetFromBuffer(s, chars, n); IF n = 0 THEN RAISE GetNDone END; END; END; (* At this point the buffer is exhausted and we are block aligned, if we need to be. If we have more than a buffer full still to get we switch the buffer and read in as much as possible directly (the whole lot if the stream is not aligned, maximum integral number of blocks if it is). Note that if this is an unmapped stream (and therefore not block aligned) we keep on reading direct to 'chars' until we are done, even if there is less than a buffer full to get *) WITH mapped = Property.Mapped IN s.properties DO IF n >= NUMBER(s.buffer^) OR NOT mapped THEN VAR nRounded := ModuloBlockSize(s, n); BEGIN LOOP VAR fill := FillBuffer(s, SUBARRAY(chars, number - n, nRounded)); highWaterP := s.highWaterP; BEGIN (* reset buffer offset and pointers; we skip past the chars we have just read so the buffer should be empty *) s.bufferOffset := s.bufferOffset + highWaterP; s.currentP := 0; s.highWaterP := 0; s.getEndP := 0; IF NOT fill THEN RAISE GetNDone END; DEC(n, highWaterP); IF n = 0 THEN RAISE GetNDone; ELSIF mapped THEN EXIT ELSE (* we try to fill the rest of 'chars' *) DEC(nRounded, highWaterP); END; END; END; (* loop *) END; END; END; (* Get the remaining bytes. We only get here if the stream is mapped and there is less than a buffer full still to get. It is possible that a previous 'FillBuffer' only partially filled the buffer i.e. reached end of stream. We still call 'FillBuffer' again, in order to set the 'GotEndOfStream' flag *) IF n > 0 AND FillBuffer(s, s.buffer^) THEN GetFromBuffer(s, chars, n); END; EXCEPT | GetNDone => END; s.ungetP := s.currentP; (* unget illegal after a 'GetN' *) IF n = 0 OR NOT raiseEndOfStream THEN RETURN number - n; ELSE RAISE EndOfStream(s); END; END InternalGetN; <*INLINE*> PROCEDURE GetN( s: Stream; VAR chars: ARRAY OF CHAR; raisesEndOfStream := FALSE) : CARDINAL RAISES {Error, EndOfStream}= (* Tries to fill 'chars' from the given stream as quickly as possible. Returns the number of characters actually read - this is only less than 'NUMBER(chars)' if the end of stream is reached. If 'raisesEndOfStream' is set 'GetN' will always return 'NUMBER(chars)' or it will raise 'EndOfStream' in the attempt! If an error occurs 'Error' is raised so the return value is irrelevant. This procedure checks for the null case and the simple case where 'chars' can be copied directly from the current stream buffer; 'InternalGetN' does the hard work. *) VAR count: CARDINAL := NUMBER(chars); BEGIN IF count = 0 THEN RETURN 0 END; WITH currentP = s.currentP DO IF s.getEndP - currentP >= count THEN chars := SUBARRAY(s.buffer^, currentP, count); INC(currentP, count); ELSE count := InternalGetN(s, chars, raisesEndOfStream); END; END; RETURN count; END GetN; PROCEDURE GotEndOfStream(s: Stream): BOOLEAN RAISES {Error}= (* Did the last get operation hit the end of stream? *) BEGIN EnsureIsValid(s, Property.Readable, Fault.NotReadable); RETURN Status.GotEndOfStream IN s.status; END GotEndOfStream; (* Random access - telling and seeking *) PROCEDURE Tell(s: Stream): CARDINAL RAISES {Error} = (* User callable procedure - checks stream before returning current position *) BEGIN EnsureIsValid(s); RETURN InternalTell(s); END Tell; PROCEDURE Seek( s: Stream; offset := 0; mode: SeekMode := SeekMode.Beginning) RAISES {Error} = (* Seek to 'offset' from the position given by 'mode'. If the seek destination turns out to be within the current buffer we can just clear any previous pending seek, set the buffer pointers appropriately and we are done. If the seek destination is outside the current buffer we move into seek pending mode - 'seekOffset' gives the destination of the seek, 'SeekPending' is included in 'status' and the buffer is disabled *) VAR seekTo: INTEGER; BEGIN (* Preliminary checks; set 'highWaterP' *) EnsureIsValid(s, Property.Seekable, Fault.NotSeekable); (* Calculate seek destination and see if it is within the stream *) VAR tell := InternalTell(s); length := InternalLength(s); BEGIN CASE mode OF | SeekMode.Beginning => seekTo := offset; | SeekMode.Current => seekTo := tell + offset; | SeekMode.End => IF offset > 0 THEN RaiseError(s, Fault.SeekOutOfRange) END; seekTo := length + offset; END; IF seekTo < 0 OR seekTo > length THEN RaiseError(s, Fault.SeekOutOfRange); ELSIF seekTo = tell THEN RETURN; END; END; (* Disable buffer *) DisableBuffer(s); (* Is destination within the window area of the current buffer? *) WITH offsetInBuffer = seekTo - s.bufferOffset DO IF 0 <= offsetInBuffer AND offsetInBuffer <= s.highWaterP THEN (* Seek within window area of buffer; set 'currentP' and unset 'SeekPending' *) s.status := s.status - StatusSet{Status.SeekPending}; s.currentP := offsetInBuffer; ELSE (* Seek outside the window area of buffer; mark stream as having a seek pending *) s.status := s.status + StatusSet{Status.SeekPending}; s.seekOffset := seekTo; END; END; END Seek; (* Ungetting *) PROCEDURE Unget(s: Stream) RAISES {Error} = (* Ungets the last character. Similar to 'Seek(s, -1, SeekMode.Beginning)' but it is guaranteed not to do any buffer refilling and is only guaranteed to work if the last operation on 's' was a 'Get', 'GetUntil' or 'Skip'. If the last operation raised 'EndOfStream', 'Unget' does nothing *) BEGIN (* Preliminary checks; set 'highWaterP' *) EnsureIsValid(s); (* Check for illegal use of 'Unget' *) IF Status.Getting IN s.status AND s.ungetP # s.currentP THEN (* Now see if we are the end of stream. Whenever 'EndOfStream' is raised the 'GotEndOfStream' flag is set in the status field. This flag is cleared by a subsequent seek or successful get. Thus if we get here and the 'GotEndOfStream' flag is set the last get operation must have raised 'EndOfStream'. *) IF NOT Status.GotEndOfStream IN s.status THEN DEC(s.currentP) END; s.ungetP := s.currentP; (* prevent another unget *) ELSE RaiseError(s, Fault.BadUnget); END; END Unget; PROCEDURE Length(s: Stream): CARDINAL RAISES {Error} = (* Returns the length of 's' or 'UnknownLength' *) BEGIN (* Preliminary checks; set 'highWaterP' *) EnsureIsValid(s); RETURN InternalLength(s); END Length; PROCEDURE Truncate(s: Stream; length: CARDINAL) RAISES {Error}= VAR oldLength := InternalLength(s); BEGIN EnsureIsValid(s); IF NOT Property.Truncatable IN s.properties OR length > oldLength THEN RaiseError(s, Fault.BadTruncate) END; (* if *) DisableBuffer(s); (* Check to see if the buffer gets truncated *) IF s.bufferOffset + s.highWaterP > length THEN (* We are going to lose at least part of our buffer *) VAR newHighWater := MAX(length - s.bufferOffset, 0); BEGIN s.bufferOffset := MIN(s.bufferOffset, length); s.highWaterP := newHighWater; s.currentP := MIN(s.currentP, newHighWater); IF s.dirtyStartP >= newHighWater THEN CleanBuffer(s); ELSE s.dirtyEndP := MIN(s.dirtyEndP, newHighWater); END; END; END; (* Does our seek destination change? *) IF Status.SeekPending IN s.status AND s.seekOffset > length THEN s.seekOffset := length; IF s.seekOffset <= s.bufferOffset + s.highWaterP THEN s.status := s.status - StatusSet{Status.SeekPending}; s.currentP := s.seekOffset - s.bufferOffset; END; END; (* We have truncated the buffer, if it needed to be, now we see if we need to truncate the stream bed *) IF s.length > length THEN IF s.realOffset > length THEN RealSeek(s, length); s.realOffset := length; END; IF s.implTruncate(length) THEN s.length := length; ELSE RaiseError(s, Fault.Truncate); END; END; END Truncate; <*INLINE*> PROCEDURE FlushBufferIfDirty(s: Stream) RAISES {Error}= BEGIN DisableBuffer(s); IF s.dirtyEndP > s.dirtyStartP THEN FlushBuffer(s, s.buffer^); END; END FlushBufferIfDirty; PROCEDURE Flush(s: Stream) RAISES {Error} = (* Forces a flush, if the buffer is dirty *) BEGIN (* Preliminary checks; set 'highWaterP' *) EnsureIsValid(s); FlushBufferIfDirty(s); END Flush; PROCEDURE Properties(s: Stream): PropertySet RAISES {} = (* Properties of 's' *) BEGIN RETURN s.properties; END Properties; PROCEDURE Closed(s: Stream): BOOLEAN RAISES {} = (* Properties of 's' *) BEGIN RETURN Status.Closed IN s.status; END Closed; PROCEDURE WhyErrant(s: Stream): Fault RAISES {} = (* Returns the value of the 'error' field *) BEGIN RETURN s.fault; END WhyErrant; PROCEDURE FaultToText(f: Fault): Text.T RAISES {}= BEGIN CASE f OF | Fault.None => RETURN "no error"; | Fault.NotInitialized => RETURN "operation on uninitialized stream"; | Fault.NotReadable => RETURN "write operation on read only stream"; | Fault.NotWritable => RETURN "read operation on write only stream"; | Fault.NotSeekable => RETURN "seek operation on non seekable stream"; | Fault.SeekOutOfRange => RETURN "seek out of range"; | Fault.BadTruncate => RETURN "illegal truncation"; | Fault.BadAppend => RETURN "write operation not at end of append only stream"; | Fault.BadUnget => RETURN "bad unget"; | Fault.Disabled => RETURN "operation on disabled stream"; | Fault.Closed => RETURN "operation on closed stream"; | Fault.Open => RETURN "open failed"; | Fault.Read => RETURN "read failed"; | Fault.Write => RETURN "write failed"; | Fault.Seek => RETURN "seek failed"; | Fault.Truncate => RETURN "truncate failed"; | Fault.Close => RETURN "close failed"; | Fault.ImplSpecific => RETURN "stream class specific error"; END; END FaultToText; PROCEDURE Name(s: Stream): Text.T RAISES {} = (* Returns the stream name which was provided when the stream was created *) BEGIN RETURN s.name; END Name; PROCEDURE DescribeError(s: Stream): Text.T RAISES {} = (* Returns stream class specific message describing the last error which occured. If no error has occured or the error which occured was one of usage (such as a bad unget) NIL is returned *) BEGIN IF s.fault IN ImplFaults THEN RETURN s.implDescribeError(); ELSE RETURN NIL; END; END DescribeError; EXCEPTION BadRecovery; PROCEDURE ClearError(s: Stream) RAISES {} = BEGIN s.status := s.status - StatusSet{Status.Errant}; s.fault := Fault.None; END ClearError; PROCEDURE Clear(s: Stream): BOOLEAN RAISES {} = (* Recover after an error *) CONST CompletelyUnusable = StatusSet{Status.Closed, Status.Uninitialized}; VAR offset, length: CARDINAL; BEGIN IF s.status * CompletelyUnusable # EmptyStatus OR s.fault IN PermanentFaults THEN RETURN FALSE ELSIF s.fault = Fault.None THEN RETURN TRUE; ELSIF s.fault IN ImplFaults THEN IF s.implRecover(offset, length) THEN IF length # UnknownLength THEN s.length := length END; IF offset > s.length THEN RAISE BadRecovery <* CRASH *>END; IF Property.IsBuffer IN s.properties THEN WITH size = NUMBER(s.buffer^) DO IF offset > size OR s.length > size THEN RAISE BadRecovery <* CRASH *> END; END; s.currentP := offset; s.highWaterP := HighWaterP(s); ELSE s.realOffset := offset; s.bufferOffset := s.realOffset; s.currentP := 0; s.highWaterP := 0; s.status := s.status - StatusSet{Status.SeekPending}; END; ClearError(s); RETURN TRUE; ELSE RETURN FALSE; END; ELSE ClearError(s); RETURN TRUE; END; END Clear; (* The following are the (trivial) default stream class specific methods *) PROCEDURE DefaultImplFlush( s: Stream; READONLY chars: ARRAY OF CHAR) : BOOLEAN RAISES {} = BEGIN RETURN TRUE; END DefaultImplFlush; PROCEDURE DefaultImplFill( s: Stream; VAR chars: ARRAY OF CHAR) : INTEGER RAISES {} = BEGIN RETURN 0; END DefaultImplFill; PROCEDURE DefaultImplSeek(s: Stream; pos: CARDINAL): BOOLEAN RAISES {} = BEGIN RETURN TRUE; END DefaultImplSeek; PROCEDURE DefaultImplTruncate(s: Stream; length: CARDINAL): BOOLEAN RAISES {} = BEGIN RETURN TRUE; END DefaultImplTruncate; PROCEDURE DefaultImplClose(s: Stream): BOOLEAN RAISES {} = BEGIN RETURN TRUE; END DefaultImplClose; PROCEDURE DefaultImplDescribeError(s: Stream): Text.T RAISES {} = BEGIN RETURN NIL; END DefaultImplDescribeError; PROCEDURE DefaultImplRecover( s: Stream; VAR offset, length: CARDINAL) : BOOLEAN RAISES {} = BEGIN RETURN FALSE; END DefaultImplRecover; PROCEDURE Close(s: Stream; quiet: BOOLEAN := TRUE) RAISES {Error} = (* Flushes stream and closes it. Does not flush if the stream is errant and does not close if the stream is already closed or was never successfully opened. In noisy mode an exception is raised at the first error which occurs (so it make take more than one call to close a stream if, for example, the flush fails). In quiet mode the stream is closed if at all possible; any errors are ignored. *) CONST CannotClose = StatusSet{Status.Uninitialized, Status.Disabled}; VAR status := s.status * Unusable; BEGIN IF status * CannotClose # EmptyStatus THEN NotUsable(s) END; s.highWaterP := HighWaterP(s); (* Flush if there is any chance of success. 'FlushBufferIfDirty' disables the buffer; if the stream is unusable it is disabled already. *) IF status = EmptyStatus THEN TRY FlushBufferIfDirty(s); EXCEPT | Error => (* Absorb the error if we are in quiet mode *) IF NOT quiet THEN RAISE Error(s) END; END; END; (* Close the stream if it makes sense to do so (no point in retrying close if we have done it already or if the stream was never opened successfully *) IF NOT (Status.Closed IN status OR s.fault IN PermanentFaults OR s.implClose() OR quiet) THEN RaiseError(s, Fault.Close); END; (* Mark stream as closed and hence unusable. This disables all stream operations which check if a stream is usable before proceeding. Note that the buffer has already been disabled (by flushing the buffer or because the stream was unusable anyway) *) s.status := s.status + StatusSet{Status.Closed}; END Close; (* Operations for user defined streams *) PROCEDURE ValidityCheck(s: Stream) RAISES {Error}= BEGIN EnsureIsValid(s); END ValidityCheck; PROCEDURE RaiseImplSpecificError(s: Stream) RAISES {Error}= BEGIN RaiseError(s, Fault.ImplSpecific); END RaiseImplSpecificError; PROCEDURE BufferSize(s: Stream): CARDINAL RAISES {Error}= BEGIN EnsureIsValid(s); RETURN NUMBER(s.buffer^); END BufferSize; (* Operations for building fast get and put routines on top of streams *) PROCEDURE StreamBuffer(s: Stream): Buffer RAISES {Error}= BEGIN EnsureIsValid(s); RETURN s.buffer; END StreamBuffer; PROCEDURE Disable(s: Stream) RAISES {Error}= BEGIN EnsureIsValid(s); DisableBuffer(s); s.status := s.status + StatusSet{Status.Disabled}; END Disable; <*INLINE*> PROCEDURE Enable(s: Stream) RAISES {}= BEGIN IF NOT Status.Disabled IN s.status THEN RAISE Fatal <* CRASH *> END; s.status := s.status - StatusSet{Status.Disabled}; END Enable; PROCEDURE DisableForGetting( s: Stream; makeSpace: BOOLEAN) : Bounds RAISES {Error}= BEGIN EVAL UnreadCharsInBuffer(s) OR makeSpace AND FlushAndFillBuffer(s); DisableBuffer(s); s.status := s.status + StatusSet{Status.Disabled}; RETURN Bounds{s.currentP, s.highWaterP}; END DisableForGetting; PROCEDURE EnableAfterGet(s: Stream; pos: CARDINAL) RAISES {}= BEGIN IF NOT Status.Disabled IN s.status OR pos < s.currentP OR pos > s.highWaterP THEN RAISE Fatal; <* CRASH *> END; s.status := s.status - StatusSet{Status.Disabled}; s.currentP := pos; END EnableAfterGet; PROCEDURE DisableForPutting( s: Stream; makeSpace: BOOLEAN) : Bounds RAISES {Error}= VAR bounds: Bounds; BEGIN IF s.properties * SlowProperties # NoProperties THEN RAISE Fatal; <* CRASH *> END; WITH noSpace = NoSpaceForPutting(s, makeSpace) DO IF noSpace AND NOT makeSpace THEN bounds := Bounds{s.currentP, s.currentP}; ELSE IF noSpace AND makeSpace THEN FlushBuffer(s, s.buffer^) END; bounds := Bounds{s.currentP, EndP(s, NUMBER(s.buffer^))}; END; END; DisableBuffer(s); s.status := s.status + StatusSet{Status.Disabled}; RETURN bounds; END DisableForPutting; PROCEDURE EnableAfterPut(s: Stream; pos: CARDINAL) RAISES {}= BEGIN IF NOT Status.Disabled IN s.status OR pos < s.currentP OR pos > EndP(s, NUMBER(s.buffer^)) THEN RAISE Fatal; <* CRASH *> END; s.status := s.status - StatusSet{Status.Disabled}; IF pos # s.currentP THEN s.dirtyStartP := DirtyStartP(s); s.currentP := pos; s.dirtyEndP := DirtyEndP(s); END; END EnableAfterPut; PROCEDURE SinglePut(s: Stream; ch: CHAR) RAISES {Error}= BEGIN IF NOT Status.Disabled IN s.status THEN RAISE Fatal; <* CRASH *> END; s.status := s.status - StatusSet{Status.Disabled}; SlowPut(s, ch); DisableBuffer(s); s.status := s.status + StatusSet{Status.Disabled}; END SinglePut; (* Now follow some procedures for the initialisation of streams *) PROCEDURE PropertiesOfOpenMode(mode: OpenMode): PropertySet RAISES {} = (* Some properties are implied by the open mode of the stream; this procedure returns the properties implied by each open mode *) TYPE P = PropertySet; (* Just makes for shorter lines *) BEGIN CASE mode OF | OpenMode.Read => RETURN P{Property.Readable}; | OpenMode.Write => RETURN P{Property.Writable}; | OpenMode.Append => RETURN P{Property.Writable, Property.AppendOnly}; | OpenMode.Update, OpenMode.WriteAndRead => RETURN P{Property.Readable, Property.Writable}; | OpenMode.AppendAndRead => RETURN P{Property.Readable, Property.Writable, Property.AppendOnly} END; END PropertiesOfOpenMode; <*INLINE*> PROCEDURE InitAssert(b: BOOLEAN) RAISES {}= BEGIN IF NOT b THEN RAISE Fatal <* CRASH *> END; END InitAssert; PROCEDURE Init( s: Stream; buffer: REF ARRAY OF CHAR; length: CARDINAL; mode: OpenMode := OpenMode.Update; properties := MappedStreamUsualProperties; name: Text.T := NIL; blockSize: CARDINAL := 0) RAISES {Error}= (* Sets up fields in a stream which need initialization and checks some constraints. If 'buffer' is NIL 'Error' is raised. If any other constraint is violated a checked runtime error occurs. See the 'IO_impl' interface for more details on the constraints *) VAR bufferSize: CARDINAL := 0; BEGIN InitAssert(Status.Uninitialized IN s.status); (* Set up the name; it is useful even if we are going to raise an error *) IF name # NIL THEN s.name := name END; (* If NIL buffer we mark as initialized and immediately raise an error *) IF buffer = NIL THEN s.status := s.status - StatusSet{Status.Uninitialized}; RaiseError(s, Fault.Open); END; (* Set up the buffer *) bufferSize := NUMBER(buffer^); InitAssert(bufferSize > 0); s.buffer := buffer; (* Properties *) InitAssert(properties * DerivedProperties = NoProperties); s.properties := properties + PropertiesOfOpenMode(mode); IF bufferSize = 1 AND Property.Writable IN s.properties THEN s.properties := s.properties + PropertySet{Property.Unbuffered}; END; IF length = UnknownLength THEN InitAssert(mode IN MappedOrUnmappedModes AND blockSize = 0 AND properties * MappedOnlyProperties = NoProperties) ELSE s.properties := s.properties + PropertySet{Property.Mapped}; WITH seekable = Property.Seekable IN properties, truncatable = Property.Truncatable IN properties DO InitAssert(NOT (mode IN TruncateModes AND length # 0) AND NOT (mode IN ReadAndWriteModes AND NOT seekable) AND (blockSize = 0 OR bufferSize MOD blockSize = 0) AND NOT (truncatable AND NOT seekable)); IF truncatable AND NOT mode IN TruncatableModes THEN s.properties := s.properties - PropertySet{Property.Truncatable}; END; END; END; (* Miscellaneous *) s.blockSize := blockSize; s.length := length; (* Buffer streams and append modes need special handling *) IF Property.IsBuffer IN s.properties THEN IF length > bufferSize THEN RAISE Fatal <* CRASH *> END; s.highWaterP := length; IF mode IN AppendModes THEN s.currentP := length END; ELSIF mode IN AppendModes THEN (* On streams which are not buffer streams an append mode means that the buffer will start at 'length' *) s.bufferOffset := length; s.realOffset := length; END; (* Mark as initialized *) s.status := s.status - StatusSet{Status.Uninitialized}; END Init; BEGIN END IO.