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

   1 (* SeqFile.mod implement the ISO SeqFile 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 SeqFile ;
  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                    ResetProc ;
  40
  41 FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
  42 FROM FIO IMPORT File ;
  43 FROM errno IMPORT geterrno ;
  44 FROM IOConsts IMPORT ReadResults ;
  45 FROM ChanConsts IMPORT readFlag, writeFlag ;
  46
  47 IMPORT FIO, SYSTEM, RTio, errno, ErrnoCategory ;
  48
  49
  50 VAR
  51    dev: ChanDev ;
  52    did: DeviceId ;
  53
  54
  55 PROCEDURE look (d: DeviceTablePtr;
  56                 VAR ch: CHAR; VAR r: ReadResults) ;
  57 BEGIN
  58    doLook(dev, d, ch, r)
  59 END look ;
  60
  61
  62 PROCEDURE skip (d: DeviceTablePtr) ;
  63 BEGIN
  64    doSkip(dev, d)
  65 END skip ;
  66
  67
  68 PROCEDURE skiplook (d: DeviceTablePtr;
  69                     VAR ch: CHAR; VAR r: ReadResults) ;
  70 BEGIN
  71    doSkipLook(dev, d, ch, r)
  72 END skiplook ;
  73
  74
  75 PROCEDURE lnwrite (d: DeviceTablePtr) ;
  76 BEGIN
  77    doWriteLn(dev, d)
  78 END lnwrite ;
  79
  80
  81 PROCEDURE textread (d: DeviceTablePtr;
  82                     to: SYSTEM.ADDRESS;
  83                     maxChars: CARDINAL;
  84                     VAR charsRead: CARDINAL) ;
  85 BEGIN
  86    doReadText(dev, d, to, maxChars, charsRead)
  87 END textread ;
  88
  89
  90 PROCEDURE textwrite (d: DeviceTablePtr;
  91                      from: SYSTEM.ADDRESS;
  92                      charsToWrite: CARDINAL);
  93 BEGIN
  94    doWriteText(dev, d, from, charsToWrite)
  95 END textwrite ;
  96
  97
  98 PROCEDURE rawread (d: DeviceTablePtr;
  99                    to: SYSTEM.ADDRESS;
 100                    maxLocs: CARDINAL;
 101                    VAR locsRead: CARDINAL) ;
 102 BEGIN
 103    doReadLocs(dev, d, to, maxLocs, locsRead)
 104 END rawread ;
 105
 106
 107 PROCEDURE rawwrite (d: DeviceTablePtr;
 108                     from: SYSTEM.ADDRESS;
 109                     locsToWrite: CARDINAL) ;
 110 BEGIN
 111    doWriteLocs(dev, d, from, locsToWrite)
 112 END rawwrite ;
 113
 114
 115 PROCEDURE getname (d: DeviceTablePtr;
 116                    VAR a: ARRAY OF CHAR) ;
 117 BEGIN
 118    FIO.GetFileName(RTio.GetFile(d^.cid), a)
 119 END getname ;
 120
 121
 122 PROCEDURE flush (d: DeviceTablePtr) ;
 123 BEGIN
 124    FIO.FlushBuffer(RTio.GetFile(d^.cid))
 125 END flush ;
 126
 127
 128 (*
 129    checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
 130                     file.
 131 *)
 132
 133 PROCEDURE checkOpenErrno (file: FIO.File; VAR e: INTEGER; VAR res: OpenResults) ;
 134 BEGIN
 135    IF FIO.IsNoError(file)
 136    THEN
 137       e := 0 ;
 138    ELSE
 139       e := errno.geterrno()
 140    END ;
 141    res := ErrnoCategory.GetOpenResults(e)
 142 END checkOpenErrno ;
 143
 144
 145 (*
 146    newCid - returns a ChanId which represents the opened file, name.
 147             res is set appropriately on return.
 148 *)
 149
 150 PROCEDURE newCid (fname: ARRAY OF CHAR;
 151                   f: FlagSet;
 152                   VAR res: OpenResults;
 153                   toRead, toAppend: BOOLEAN;
 154                   whichreset: ResetProc) : ChanId ;
 155 VAR
 156    c   : RTio.ChanId ;
 157    file: FIO.File ;
 158    e   : INTEGER ;
 159    p   : DeviceTablePtr ;
 160 BEGIN
 161    IF toAppend
 162    THEN
 163       file := FIO.OpenForRandom (fname, NOT toRead, NOT FIO.Exists (fname))
 164    ELSIF toRead
 165    THEN
 166       file := FIO.OpenToRead (fname)
 167    ELSE
 168       file := FIO.OpenToWrite (fname)
 169    END ;
 170    checkOpenErrno (file, e, res) ;
 171
 172    IF FIO.IsNoError (file)
 173    THEN
 174       MakeChan (did, c) ;
 175       RTio.SetFile (c, file) ;
 176       p := DeviceTablePtrValue (c, did) ;
 177       WITH p^ DO
 178          flags := f ;
 179          errNum := e ;
 180          doLook := look ;
 181          doSkip := skip ;
 182          doSkipLook := skiplook ;
 183          doLnWrite := lnwrite ;
 184          doTextRead := textread ;
 185          doTextWrite := textwrite ;
 186          doRawRead := rawread ;
 187          doRawWrite := rawwrite ;
 188          doGetName := getname ;
 189          doReset := whichreset ;
 190          doFlush := flush ;
 191          doFree := handlefree
 192       END ;
 193       RETURN( c )
 194    ELSE
 195       RETURN( IOChan.InvalidChan () )
 196    END
 197 END newCid ;
 198
 199
 200 (*
 201    Attempts to obtain and open a channel connected to a stored rewindable
 202    file of the given name.  The write flag is implied; without the raw
 203    flag, text is implied.  If successful, assigns to cid the identity of
 204    the opened channel, assigns the value opened to res, and selects
 205    output mode, with the write position at the start of the file (i.e.
 206    the file is of zero length).  If a channel cannot be opened as required,
 207    the value of res indicates the reason, and cid identifies the
 208    invalid channel.
 209 *)
 210
 211 PROCEDURE OpenWrite (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
 212                      VAR res: OpenResults) ;
 213 BEGIN
 214    INCL(flags, ChanConsts.writeFlag) ;
 215    IF NOT (ChanConsts.rawFlag IN flags)
 216    THEN
 217       INCL(flags, ChanConsts.textFlag)
 218    END ;
 219    cid := newCid(name, flags, res, FALSE, FALSE, resetWrite)
 220 END OpenWrite ;
 221
 222
 223 (*
 224    Attempts to obtain and open a channel connected to a stored rewindable
 225    file of the given name.  The read and old flags are implied; without
 226    the raw flag, text is implied.  If successful, assigns to cid the
 227    identity of the opened channel, assigns the value opened to res, and
 228    selects input mode, with the read position corresponding to the start
 229    of the file.  If a channel cannot be opened as required, the value of
 230    res indicates the reason, and cid identifies the invalid channel.
 231 *)
 232
 233 PROCEDURE OpenRead (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
 234                     VAR res: OpenResults) ;
 235 BEGIN
 236    flags := flags + ChanConsts.read + ChanConsts.old ;
 237    IF NOT (ChanConsts.rawFlag IN flags)
 238    THEN
 239       INCL(flags, ChanConsts.textFlag)
 240    END ;
 241    cid := newCid(name, flags, res, TRUE, FALSE, resetRead)
 242 END OpenRead ;
 243
 244
 245 (*
 246    OpenAppend - attempts to obtain and open a channel connected
 247                 to a stored rewindable file of the given name.
 248                 The write and old flags are implied; without
 249                 the raw flag, text is implied.  If successful,
 250                 assigns to cid the identity of the opened channel,
 251                 assigns the value opened to res, and selects output
 252                 mode, with the write position corresponding to the
 253                 length of the file.  If a channel cannot be opened
 254                 as required, the value of res indicates the reason,
 255                 and cid identifies the invalid channel.
 256 *)
 257
 258 PROCEDURE OpenAppend (VAR cid: ChanId; name: ARRAY OF CHAR;
 259                       flags: FlagSet; VAR res: OpenResults) ;
 260 BEGIN
 261    flags := flags + ChanConsts.write + ChanConsts.old ;
 262    IF NOT (ChanConsts.rawFlag IN flags)
 263    THEN
 264       INCL (flags, ChanConsts.textFlag)
 265    END ;
 266    cid := newCid (name, flags, res, FALSE, TRUE, resetAppend) ;
 267    IF IsSeqFile(cid)
 268    THEN
 269       FIO.SetPositionFromEnd (RTio.GetFile (cid), 0) ;
 270       checkErrno (dev, RTio.GetDevicePtr (cid))
 271    END
 272 END OpenAppend ;
 273
 274
 275 (*
 276    resetAppend - ensures that +write and -read and seeks to
 277                  the end of the file.
 278 *)
 279
 280 PROCEDURE resetAppend (d: DeviceTablePtr) ;
 281 VAR
 282    f: FIO.File ;
 283 BEGIN
 284    WITH d^ DO
 285       flags := flags + write - read ;
 286       FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
 287    END ;
 288    checkErrno(dev, d)
 289 END resetAppend ;
 290
 291
 292 (*
 293    resetRead -
 294 *)
 295
 296 PROCEDURE resetRead (d: DeviceTablePtr) ;
 297 BEGIN
 298    Reread(d^.cid)
 299 END resetRead ;
 300
 301
 302 (*
 303    resetWrite -
 304 *)
 305
 306 PROCEDURE resetWrite (d: DeviceTablePtr) ;
 307 BEGIN
 308    Rewrite(d^.cid)
 309 END resetWrite ;
 310
 311
 312 (*
 313    IsSeqFile - tests if the channel identified by cid is open to a
 314                rewindable sequential file.
 315 *)
 316
 317 PROCEDURE IsSeqFile (cid: ChanId) : BOOLEAN ;
 318 BEGIN
 319    RETURN( (cid # NIL) AND (IOChan.InvalidChan() # cid) AND
 320            (IsDevice(cid, did)) AND
 321            ((ChanConsts.readFlag IN IOChan.CurrentFlags(cid)) OR
 322             (ChanConsts.writeFlag IN IOChan.CurrentFlags(cid))) )
 323 END IsSeqFile ;
 324
 325
 326 (*
 327    Reread - if the channel identified by cid is not open
 328             to a rewindable sequential file, the exception
 329             wrongDevice is raised; otherwise attempts to set
 330             the read position to the start of the file, and
 331             to select input mode.  If the operation cannot
 332             be performed (perhaps because of insufficient
 333             permissions) neither input mode nor output
 334             mode is selected.
 335 *)
 336
 337 PROCEDURE Reread (cid: ChanId) ;
 338 VAR
 339    d: DeviceTablePtr ;
 340 BEGIN
 341    IF IsSeqFile(cid)
 342    THEN
 343       d := DeviceTablePtrValue(cid, did) ;
 344       WITH d^ DO
 345          EXCL(flags, writeFlag) ;
 346          IF readFlag IN flags
 347          THEN
 348             FIO.SetPositionFromBeginning(RTio.GetFile(cid), 0) ;
 349             checkErrno(dev, d)
 350          ELSE
 351             EXCL(flags, readFlag)
 352          END
 353       END
 354    ELSE
 355       RAISEdevException(cid, did, IOChan.wrongDevice,
 356                         'SeqFile.' + __FUNCTION__ +
 357                         ': channel is not a sequential file')
 358    END
 359 END Reread ;
 360
 361
 362 (*
 363    Rewrite - if the channel identified by cid is not open to a
 364              rewindable sequential file, the exception wrongDevice
 365              is raised; otherwise, attempts to truncate the
 366              file to zero length, and to select output mode.
 367              If the operation cannot be performed (perhaps
 368              because of insufficient permissions) neither input
 369              mode nor output mode is selected.
 370 *)
 371
 372 PROCEDURE Rewrite (cid: ChanId) ;
 373 VAR
 374    d: DeviceTablePtr ;
 375 BEGIN
 376    IF IsSeqFile(cid)
 377    THEN
 378       d := DeviceTablePtrValue(cid, did) ;
 379       WITH d^ DO
 380          EXCL(flags, readFlag) ;
 381          IF writeFlag IN flags
 382          THEN
 383             FIO.SetPositionFromBeginning(RTio.GetFile(cid), 0) ;
 384             checkErrno(dev, d)
 385          ELSE
 386             EXCL(flags, writeFlag)
 387          END
 388       END
 389    ELSE
 390       RAISEdevException(cid, did, IOChan.wrongDevice,
 391                         'SeqFile.' + __FUNCTION__ +
 392                         ': channel is not a sequential file')
 393    END
 394 END Rewrite ;
 395
 396
 397 (*
 398    handlefree -
 399 *)
 400
 401 PROCEDURE handlefree (d: DeviceTablePtr) ;
 402 VAR
 403    f: File ;
 404 BEGIN
 405    WITH d^ DO
 406       doFlush(d) ;
 407       checkErrno(dev, d) ;
 408       f := RTio.GetFile(RTio.ChanId(cid)) ;
 409       IF FIO.IsNoError(f)
 410       THEN
 411          FIO.Close(f) ;
 412       END ;
 413       checkErrno(dev, d)
 414    END
 415 END handlefree ;
 416
 417
 418 (*
 419    Close - if the channel identified by cid is not open to a sequential
 420            stream, the exception wrongDevice is raised; otherwise
 421            closes the channel, and assigns the value identifying
 422            the invalid channel to cid.
 423 *)
 424
 425 PROCEDURE Close (VAR cid: ChanId) ;
 426 BEGIN
 427    IF IsSeqFile(cid)
 428    THEN
 429       UnMakeChan(did, cid) ;
 430       cid := IOChan.InvalidChan()
 431    ELSE
 432       RAISEdevException(cid, did, IOChan.wrongDevice,
 433                         'SeqFile.' + __FUNCTION__ +
 434                         ': channel is not a sequential file')
 435    END
 436 END Close ;
 437
 438
 439 (*
 440    Init -
 441 *)
 442
 443 PROCEDURE Init ;
 444 VAR
 445    gen: GenDevIF ;
 446 BEGIN
 447    AllocateDeviceId(did) ;
 448    gen := InitGenDevIF(did, doreadchar, dounreadchar,
 449                        dogeterrno, dorbytes, dowbytes,
 450                        dowriteln,
 451                        iseof, iseoln, iserror) ;
 452    dev := InitChanDev(streamfile, did, gen)
 453 END Init ;
 454
 455
 456 BEGIN
 457    Init
 458 END SeqFile.