1 (* StreamFile.mod implement the ISO StreamFile specification.
3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. *)
27 IMPLEMENTATION MODULE StreamFile
;
29 FROM RTgen
IMPORT ChanDev
, DeviceType
,
30 InitChanDev
, doLook
, doSkip
, doSkipLook
, doWriteLn
,
31 doReadText
, doWriteText
, doReadLocs
, doWriteLocs
,
34 FROM RTfio
IMPORT doreadchar
, dounreadchar
, dogeterrno
, dorbytes
,
35 dowbytes
, dowriteln
, iseof
, iseoln
, iserror
;
37 FROM IOLink
IMPORT DeviceId
, DeviceTablePtr
, IsDevice
, MakeChan
, UnMakeChan
,
38 DeviceTablePtrValue
, RAISEdevException
, AllocateDeviceId
;
40 FROM RTgenif
IMPORT GenDevIF
, InitGenDevIF
;
41 FROM FIO
IMPORT File
;
42 FROM errno
IMPORT geterrno
;
43 FROM IOConsts
IMPORT ReadResults
;
45 IMPORT FIO
, SYSTEM
, RTio
, errno
, ErrnoCategory
;
53 PROCEDURE look (d
: DeviceTablePtr
;
54 VAR ch
: CHAR; VAR r
: ReadResults
) ;
60 PROCEDURE skip (d
: DeviceTablePtr
) ;
66 PROCEDURE skiplook (d
: DeviceTablePtr
;
67 VAR ch
: CHAR; VAR r
: ReadResults
) ;
69 doSkipLook(dev
, d
, ch
, r
)
73 PROCEDURE lnwrite (d
: DeviceTablePtr
) ;
79 PROCEDURE textread (d
: DeviceTablePtr
;
82 VAR charsRead
: CARDINAL) ;
84 doReadText(dev
, d
, to
, maxChars
, charsRead
)
88 PROCEDURE textwrite (d
: DeviceTablePtr
;
90 charsToWrite
: CARDINAL);
92 doWriteText(dev
, d
, from
, charsToWrite
)
96 PROCEDURE rawread (d
: DeviceTablePtr
;
99 VAR locsRead
: CARDINAL) ;
101 doReadLocs(dev
, d
, to
, maxLocs
, locsRead
)
105 PROCEDURE rawwrite (d
: DeviceTablePtr
;
106 from
: SYSTEM.ADDRESS
;
107 locsToWrite
: CARDINAL) ;
109 doWriteLocs(dev
, d
, from
, locsToWrite
)
113 PROCEDURE getname (d
: DeviceTablePtr
;
114 VAR a
: ARRAY OF CHAR) ;
116 FIO.
GetFileName(RTio.
GetFile(d^.cid
), a
)
120 PROCEDURE flush (d
: DeviceTablePtr
) ;
122 FIO.
FlushBuffer(RTio.
GetFile(d^.cid
))
127 checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
131 PROCEDURE checkOpenErrno (file
: FIO.File
; VAR e
: INTEGER; VAR res
: OpenResults
) ;
133 IF FIO.
IsNoError(file
)
137 e
:= errno.
geterrno()
139 res
:= ErrnoCategory.
GetOpenResults(e
)
144 newCid - returns a ChanId which represents the opened file, name.
145 res is set appropriately on return.
148 PROCEDURE newCid (fname
: ARRAY OF CHAR;
150 VAR res
: OpenResults
) : ChanId
;
157 IF ChanConsts.readFlag
IN f
159 file
:= FIO.
OpenToRead(fname
)
161 file
:= FIO.
OpenToWrite(fname
)
163 checkOpenErrno(file
, e
, res
) ;
165 IF FIO.
IsNoError(file
)
168 RTio.
SetFile(c
, file
) ;
169 p
:= DeviceTablePtrValue(c
, did
) ;
175 doSkipLook
:= skiplook
;
176 doLnWrite
:= lnwrite
;
177 doTextRead
:= textread
;
178 doTextWrite
:= textwrite
;
179 doRawRead
:= rawread
;
180 doRawWrite
:= rawwrite
;
181 doGetName
:= getname
;
182 (* doReset := reset ; *)
188 RETURN( IOChan.
InvalidChan() )
194 Open - attempts to obtain and open a channel connected to a
195 sequential stream of the given name.
196 The read flag implies old; without the raw flag,
197 text is implied. If successful, assigns to cid
198 the identity of the opened channel, and assigns the
199 value opened to res. If a channel cannot be opened
200 as required, the value of res indicates the reason,
201 and cid identifies the invalid channel.
204 PROCEDURE Open (VAR cid
: ChanId
; name
: ARRAY OF CHAR;
205 flags
: FlagSet
; VAR res
: OpenResults
) ;
207 IF NOT (ChanConsts.rawFlag
IN flags
)
209 INCL(flags
, ChanConsts.textFlag
)
211 cid
:= newCid(name
, flags
, res
)
216 IsStreamFile - tests if the channel identified by cid is
217 open to a sequential stream.
220 PROCEDURE IsStreamFile (cid
: ChanId
) : BOOLEAN ;
222 RETURN( (cid #
NIL) AND (IOChan.
InvalidChan() # cid
) AND
223 (IsDevice(cid
, did
)) AND
224 ((ChanConsts.readFlag
IN IOChan.
CurrentFlags(cid
)) OR
225 (ChanConsts.writeFlag
IN IOChan.
CurrentFlags(cid
))) )
233 PROCEDURE handlefree (d
: DeviceTablePtr
) ;
240 f
:= RTio.
GetFile(RTio.
ChanId(cid
)) ;
251 Close - if the channel identified by cid is not open to a sequential
252 stream, the exception wrongDevice is raised; otherwise
253 closes the channel, and assigns the value identifying
254 the invalid channel to cid.
257 PROCEDURE Close (VAR cid
: ChanId
) ;
261 UnMakeChan(did
, cid
) ;
262 cid
:= IOChan.
InvalidChan()
264 RAISEdevException(cid
, did
, IOChan.wrongDevice
,
265 'StreamFile.' + __FUNCTION__
+
266 ': channel is not a sequential file')
279 AllocateDeviceId(did
) ;
280 gen
:= InitGenDevIF(did
, doreadchar
, dounreadchar
,
281 dogeterrno
, dorbytes
, dowbytes
,
283 iseof
, iseoln
, iserror
) ;
284 dev
:= InitChanDev(streamfile
, did
, gen
)