gcc/m2/gm2-libs-iso/StreamFile.mod

   1 (* StreamFile.mod implement the ISO StreamFile specification.
   2
   3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   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)
  11 any later version.
  12
  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.
  17
  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.
  21
  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/>.  *)
  26
  27 IMPLEMENTATION MODULE StreamFile ;
  28
  29 FROM RTgen IMPORT ChanDev, DeviceType,
  30                   InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
  31                   doReadText, doWriteText, doReadLocs, doWriteLocs,
  32                   checkErrno ;
  33
  34 FROM RTfio IMPORT doreadchar, dounreadchar, dogeterrno, dorbytes,
  35                   dowbytes, dowriteln, iseof, iseoln, iserror ;
  36
  37 FROM IOLink IMPORT DeviceId, DeviceTablePtr, IsDevice, MakeChan, UnMakeChan,
  38                    DeviceTablePtrValue, RAISEdevException, AllocateDeviceId ;
  39
  40 FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
  41 FROM FIO IMPORT File ;
  42 FROM errno IMPORT geterrno ;
  43 FROM IOConsts IMPORT ReadResults ;
  44
  45 IMPORT FIO, SYSTEM, RTio, errno, ErrnoCategory ;
  46
  47
  48 VAR
  49    dev: ChanDev ;
  50    did: DeviceId ;
  51
  52
  53 PROCEDURE look (d: DeviceTablePtr;
  54                 VAR ch: CHAR; VAR r: ReadResults) ;
  55 BEGIN
  56    doLook(dev, d, ch, r)
  57 END look ;
  58
  59
  60 PROCEDURE skip (d: DeviceTablePtr) ;
  61 BEGIN
  62    doSkip(dev, d)
  63 END skip ;
  64
  65
  66 PROCEDURE skiplook (d: DeviceTablePtr;
  67                     VAR ch: CHAR; VAR r: ReadResults) ;
  68 BEGIN
  69    doSkipLook(dev, d, ch, r)
  70 END skiplook ;
  71
  72
  73 PROCEDURE lnwrite (d: DeviceTablePtr) ;
  74 BEGIN
  75    doWriteLn(dev, d)
  76 END lnwrite ;
  77
  78
  79 PROCEDURE textread (d: DeviceTablePtr;
  80                     to: SYSTEM.ADDRESS;
  81                     maxChars: CARDINAL;
  82                     VAR charsRead: CARDINAL) ;
  83 BEGIN
  84    doReadText(dev, d, to, maxChars, charsRead)
  85 END textread ;
  86
  87
  88 PROCEDURE textwrite (d: DeviceTablePtr;
  89                      from: SYSTEM.ADDRESS;
  90                      charsToWrite: CARDINAL);
  91 BEGIN
  92    doWriteText(dev, d, from, charsToWrite)
  93 END textwrite ;
  94
  95
  96 PROCEDURE rawread (d: DeviceTablePtr;
  97                    to: SYSTEM.ADDRESS;
  98                    maxLocs: CARDINAL;
  99                    VAR locsRead: CARDINAL) ;
 100 BEGIN
 101    doReadLocs(dev, d, to, maxLocs, locsRead)
 102 END rawread ;
 103
 104
 105 PROCEDURE rawwrite (d: DeviceTablePtr;
 106                     from: SYSTEM.ADDRESS;
 107                     locsToWrite: CARDINAL) ;
 108 BEGIN
 109    doWriteLocs(dev, d, from, locsToWrite)
 110 END rawwrite ;
 111
 112
 113 PROCEDURE getname (d: DeviceTablePtr;
 114                    VAR a: ARRAY OF CHAR) ;
 115 BEGIN
 116    FIO.GetFileName(RTio.GetFile(d^.cid), a)
 117 END getname ;
 118
 119
 120 PROCEDURE flush (d: DeviceTablePtr) ;
 121 BEGIN
 122    FIO.FlushBuffer(RTio.GetFile(d^.cid))
 123 END flush ;
 124
 125
 126 (*
 127    checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
 128                     file.
 129 *)
 130
 131 PROCEDURE checkOpenErrno (file: FIO.File; VAR e: INTEGER; VAR res: OpenResults) ;
 132 BEGIN
 133    IF FIO.IsNoError(file)
 134    THEN
 135       e := 0 ;
 136    ELSE
 137       e := errno.geterrno()
 138    END ;
 139    res := ErrnoCategory.GetOpenResults(e)
 140 END checkOpenErrno ;
 141
 142
 143 (*
 144    newCid - returns a ChanId which represents the opened file, name.
 145             res is set appropriately on return.
 146 *)
 147
 148 PROCEDURE newCid (fname: ARRAY OF CHAR;
 149                   f: FlagSet;
 150                   VAR res: OpenResults) : ChanId ;
 151 VAR
 152    c   : RTio.ChanId ;
 153    file: FIO.File ;
 154    e   : INTEGER ;
 155    p   : DeviceTablePtr ;
 156 BEGIN
 157    IF ChanConsts.readFlag IN f
 158    THEN
 159       file := FIO.OpenToRead(fname)
 160    ELSE
 161       file := FIO.OpenToWrite(fname)
 162    END ;
 163    checkOpenErrno(file, e, res) ;
 164
 165    IF FIO.IsNoError(file)
 166    THEN
 167       MakeChan(did, c) ;
 168       RTio.SetFile(c, file) ;
 169       p := DeviceTablePtrValue(c, did) ;
 170       WITH p^ DO
 171          flags := f ;
 172          errNum := e ;
 173          doLook := look ;
 174          doSkip := skip ;
 175          doSkipLook := skiplook ;
 176          doLnWrite := lnwrite ;
 177          doTextRead := textread ;
 178          doTextWrite := textwrite ;
 179          doRawRead := rawread ;
 180          doRawWrite := rawwrite ;
 181          doGetName := getname ;
 182          (* doReset := reset ; *)
 183          doFlush := flush ;
 184          doFree := handlefree
 185       END ;
 186       RETURN( c )
 187    ELSE
 188       RETURN( IOChan.InvalidChan() )
 189    END
 190 END newCid ;
 191
 192
 193 (*
 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.
 202 *)
 203
 204 PROCEDURE Open (VAR cid: ChanId; name: ARRAY OF CHAR;
 205                 flags: FlagSet; VAR res: OpenResults) ;
 206 BEGIN
 207    IF NOT (ChanConsts.rawFlag IN flags)
 208    THEN
 209       INCL(flags, ChanConsts.textFlag)
 210    END ;
 211    cid := newCid(name, flags, res)
 212 END Open ;
 213
 214
 215 (*
 216    IsStreamFile - tests if the channel identified by cid is
 217                   open to a sequential stream.
 218 *)
 219
 220 PROCEDURE IsStreamFile (cid: ChanId) : BOOLEAN ;
 221 BEGIN
 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))) )
 226 END IsStreamFile ;
 227
 228
 229 (*
 230    handlefree -
 231 *)
 232
 233 PROCEDURE handlefree (d: DeviceTablePtr) ;
 234 VAR
 235    f: File ;
 236 BEGIN
 237    WITH d^ DO
 238       doFlush(d) ;
 239       checkErrno(dev, d) ;
 240       f := RTio.GetFile(RTio.ChanId(cid)) ;
 241       IF FIO.IsNoError(f)
 242       THEN
 243          FIO.Close(f) ;
 244       END ;
 245       checkErrno(dev, d)
 246    END
 247 END handlefree ;
 248
 249
 250 (*
 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.
 255 *)
 256
 257 PROCEDURE Close (VAR cid: ChanId) ;
 258 BEGIN
 259    IF IsStreamFile(cid)
 260    THEN
 261       UnMakeChan(did, cid) ;
 262       cid := IOChan.InvalidChan()
 263    ELSE
 264       RAISEdevException(cid, did, IOChan.wrongDevice,
 265                         'StreamFile.' + __FUNCTION__ +
 266                         ': channel is not a sequential file')
 267    END
 268 END Close ;
 269
 270
 271 (*
 272    Init -
 273 *)
 274
 275 PROCEDURE Init ;
 276 VAR
 277    gen: GenDevIF ;
 278 BEGIN
 279    AllocateDeviceId(did) ;
 280    gen := InitGenDevIF(did, doreadchar, dounreadchar,
 281                        dogeterrno, dorbytes, dowbytes,
 282                        dowriteln,
 283                        iseof, iseoln, iserror) ;
 284    dev := InitChanDev(streamfile, did, gen)
 285 END Init ;
 286
 287
 288 BEGIN
 289    Init
 290 END StreamFile.