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

   1 (* RTgen.mod implement a generic device interface used by ISO.
   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 RTgen ;
  28
  29
  30 FROM IOChan IMPORT ChanId, InvalidChan, ChanExceptions ;
  31
  32 FROM IOLink IMPORT DeviceTablePtrValue,
  33                    RAISEdevException ;
  34
  35 IMPORT ChanConsts ;
  36 IMPORT IOConsts ;
  37 IMPORT ErrnoCategory ;
  38 IMPORT RTgen ;
  39
  40 FROM RTgenif IMPORT getDID,
  41                     doReadChar, doUnReadChar, doGetErrno,
  42                     doRBytes, doWBytes, doWrLn,
  43                     isEOF, isError, isEOLN ;
  44
  45 FROM ChanConsts IMPORT FlagSet, readFlag, writeFlag, rawFlag,
  46                        textFlag, read, write, raw, text ;
  47
  48 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  49
  50
  51 TYPE
  52    ChanDev = POINTER TO RECORD
  53                            type : DeviceType ;
  54                            did  : DeviceId ;
  55                            genif: GenDevIF ;
  56                         END ;
  57
  58    deviceExceptions = ARRAY DeviceType OF BOOLEAN ;
  59
  60 VAR
  61    raiseEofInLook,
  62    raiseEofInSkip: deviceExceptions ;
  63
  64
  65 (*
  66    InitChanDev - initialize and return a ChanDev.
  67 *)
  68
  69 PROCEDURE InitChanDev (t: DeviceType; d: DeviceId; g: GenDevIF) : ChanDev ;
  70 VAR
  71    c: ChanDev ;
  72 BEGIN
  73    NEW(c) ;
  74    WITH c^ DO
  75       type := t ;
  76       did := d ;
  77       genif := g
  78    END ;
  79    RETURN( c )
  80 END InitChanDev ;
  81
  82
  83 (*
  84    KillChanDev - deallocates, g.
  85 *)
  86
  87 PROCEDURE KillChanDev (g: GenDevIF) : GenDevIF ;
  88 BEGIN
  89    DISPOSE(g) ;
  90    RETURN( NIL )
  91 END KillChanDev ;
  92
  93
  94 (* internal routine to check whether we have a valid channel *)
  95
  96 PROCEDURE checkValid (g: ChanDev; d: DeviceTablePtr) ;
  97 BEGIN
  98    WITH d^ DO
  99       IF getDID(g^.genif)#did
 100       THEN
 101          RAISEdevException(cid, did, wrongDevice,
 102                            'operation attempted on an invalid channel')
 103       END ;
 104       IF (cid=InvalidChan()) OR (cid=NIL)
 105       THEN
 106          RAISEdevException(cid, did, wrongDevice,
 107                            'operation attempted on an invalid channel')
 108       END ;
 109       IF d#DeviceTablePtrValue(cid, did)
 110       THEN
 111          RAISEdevException(cid, did, wrongDevice,
 112                            'operation attempted on an invalid channel')
 113       END
 114    END
 115 END checkValid ;
 116
 117
 118 (*
 119    checkErrno - checks a number of errno conditions and raises
 120                 appropriate ISO exceptions if they occur.
 121 *)
 122
 123 PROCEDURE checkErrno (g: ChanDev; d: DeviceTablePtr) ;
 124 BEGIN
 125    WITH d^ DO
 126       IF isError(g^.genif, d)
 127       THEN
 128          errNum := doGetErrno(g^.genif, d) ;
 129          IF ErrnoCategory.IsErrnoHard(errNum)
 130          THEN
 131             RAISEdevException(cid, did, notAvailable,
 132                               'unrecoverable (errno)')
 133          ELSIF ErrnoCategory.UnAvailable(errNum)
 134          THEN
 135             RAISEdevException(cid, did, notAvailable,
 136                               'unavailable (errno)')
 137          ELSIF errNum>0
 138          THEN
 139             RAISEdevException(cid, did, notAvailable,
 140                               'recoverable (errno)')
 141          END
 142       END
 143    END
 144 END checkErrno ;
 145
 146
 147 PROCEDURE checkPreRead (g: ChanDev;
 148                         d: DeviceTablePtr;
 149                         raise, raw: BOOLEAN) ;
 150 BEGIN
 151    WITH d^ DO
 152       IF isEOF(g^.genif, d)
 153       THEN
 154          result := IOConsts.endOfInput ;
 155          IF raise
 156          THEN
 157             RAISEdevException(cid, did, skipAtEnd,
 158                               'attempting to read beyond end of file')
 159          END
 160       ELSIF (NOT raw) AND isEOLN(g^.genif, d)
 161       THEN
 162          result := IOConsts.endOfLine
 163       ELSE
 164          result := IOConsts.allRight
 165       END
 166    END
 167 END checkPreRead ;
 168
 169
 170 (*
 171    checkPostRead - checks whether an error occurred and sets
 172                    the result status.  This must only be called
 173                    after a read.
 174 *)
 175
 176 PROCEDURE checkPostRead (g: ChanDev; d: DeviceTablePtr) ;
 177 BEGIN
 178    checkErrno(g, d) ;
 179    setReadResult(g, d)
 180 END checkPostRead ;
 181
 182
 183 (*
 184    setReadResult -
 185 *)
 186
 187 PROCEDURE setReadResult (g: ChanDev; d: DeviceTablePtr) ;
 188 BEGIN
 189    WITH d^ DO
 190       IF isEOF(g^.genif, d)
 191       THEN
 192          result := IOConsts.endOfInput
 193       ELSIF isEOLN(g^.genif, d)
 194       THEN
 195          result := IOConsts.endOfLine
 196       ELSE
 197          result := IOConsts.allRight
 198       END
 199    END
 200 END setReadResult ;
 201
 202
 203 PROCEDURE checkPreWrite (g: ChanDev; d: DeviceTablePtr) ;
 204 BEGIN
 205    (* nothing to do *)
 206 END checkPreWrite ;
 207
 208
 209 PROCEDURE checkPostWrite (g: ChanDev; d: DeviceTablePtr) ;
 210 BEGIN
 211    checkErrno(g, d)
 212 END checkPostWrite ;
 213
 214
 215 (*
 216    checkFlags - checks read/write  raw/text consistancy flags.
 217 *)
 218
 219 PROCEDURE checkFlags (f: FlagSet; d: DeviceTablePtr) ;
 220 BEGIN
 221    WITH d^ DO
 222       IF (readFlag IN f) AND (NOT (readFlag IN flags))
 223       THEN
 224          RAISEdevException(cid, did, wrongDevice,
 225                            'attempting to read from a channel which was configured to write')
 226       END ;
 227       IF (writeFlag IN f) AND (NOT (writeFlag IN flags))
 228       THEN
 229          RAISEdevException(cid, did, wrongDevice,
 230                            'attempting to write to a channel which was configured to read')
 231       END ;
 232       IF (rawFlag IN f) AND (NOT (rawFlag IN flags))
 233       THEN
 234          IF readFlag IN flags
 235          THEN
 236             RAISEdevException(cid, did, notAvailable,
 237                               'attempting to read raw LOCs from a channel which was configured to read text')
 238          ELSE
 239             RAISEdevException(cid, did, notAvailable,
 240                               'attempting to write raw LOCs from a channel which was configured to write text')
 241          END
 242       END
 243    END
 244 END checkFlags ;
 245
 246
 247 (*
 248    RaiseEOFinLook - returns TRUE if the Look procedure
 249                     should raise an exception if it
 250                     sees end of file.
 251 *)
 252
 253 PROCEDURE RaiseEOFinLook (g: ChanDev) : BOOLEAN ;
 254 BEGIN
 255    RETURN( raiseEofInLook[g^.type] )
 256 END RaiseEOFinLook ;
 257
 258
 259 (*
 260    RaiseEOFinSkip - returns TRUE if the Skip procedure
 261                     should raise an exception if it
 262                     sees end of file.
 263 *)
 264
 265 PROCEDURE RaiseEOFinSkip (g: ChanDev) : BOOLEAN ;
 266 BEGIN
 267    RETURN( raiseEofInSkip[g^.type] )
 268 END RaiseEOFinSkip ;
 269
 270
 271 (*
 272    doLook - if there is a character as the next item in
 273             the input stream then it assigns its value
 274             to ch without removing it from the stream;
 275             otherwise the value of ch is not defined.
 276             r and result are set to the value allRight,
 277             endOfLine, or endOfInput.
 278 *)
 279
 280 PROCEDURE doLook (g: ChanDev;
 281                   d: DeviceTablePtr;
 282                   VAR ch: CHAR;
 283                   VAR r: ReadResults) ;
 284 BEGIN
 285    checkValid(g, d) ;
 286    WITH d^ DO
 287       checkErrno(g, d) ;
 288       checkPreRead(g, d, RaiseEOFinLook(g), ChanConsts.rawFlag IN flags) ;
 289       IF (result=IOConsts.allRight) OR (result=IOConsts.notKnown) OR
 290          (result=IOConsts.endOfLine)
 291       THEN
 292          ch := doReadChar(g^.genif, d) ;
 293          setReadResult(g, d) ;
 294          r := result ;
 295          ch := doUnReadChar(g^.genif, d, ch)
 296       END
 297    END
 298 END doLook ;
 299
 300
 301 (*
 302    doSkip -
 303 *)
 304
 305 PROCEDURE doSkip (g: ChanDev;
 306                   d: DeviceTablePtr) ;
 307 VAR
 308    ch: CHAR ;
 309 BEGIN
 310    checkValid(g, d) ;
 311    WITH d^ DO
 312       checkPreRead(g, d, RaiseEOFinSkip(g), ChanConsts.rawFlag IN flags) ;
 313       ch := doReadChar(g^.genif, d) ;
 314       checkPostRead(g, d)
 315    END
 316 END doSkip ;
 317
 318
 319 (*
 320    doSkipLook - read a character, ignore it.  Read another and unread it
 321                 return the new character.
 322 *)
 323
 324 PROCEDURE doSkipLook (g: ChanDev;
 325                       d: DeviceTablePtr;
 326                       VAR ch: CHAR;
 327                       VAR r: ReadResults) ;
 328 BEGIN
 329    doSkip(g, d) ;
 330    doLook(g, d, ch, r)
 331 END doSkipLook ;
 332
 333
 334 PROCEDURE doWriteLn (g: ChanDev;
 335                      d: DeviceTablePtr) ;
 336 BEGIN
 337    checkValid(g, d) ;
 338    WITH d^ DO
 339       checkPreWrite(g, d) ;
 340       IF doWrLn(g^.genif, d)
 341       THEN
 342       END ;
 343       checkPostWrite(g, d)
 344    END
 345 END doWriteLn ;
 346
 347
 348 PROCEDURE doReadText (g: ChanDev;
 349                       d: DeviceTablePtr;
 350                       to: ADDRESS;
 351                       maxChars: CARDINAL;
 352                       VAR charsRead: CARDINAL) ;
 353 VAR
 354    i: CARDINAL ;
 355 BEGIN
 356    checkValid(g, d) ;
 357    checkFlags(read+text, d) ;
 358    IF maxChars>0
 359    THEN
 360       WITH d^ DO
 361          INCL(flags, textFlag) ;
 362          checkPreRead(g, d, FALSE, FALSE) ;
 363          charsRead := 0 ;
 364          REPEAT
 365             IF doRBytes(g^.genif, d, to, maxChars, i)
 366             THEN
 367                INC(charsRead, i) ;
 368                INC(to, i) ;
 369                DEC(maxChars, i)
 370             ELSE
 371                checkErrno(g, d) ;
 372                (* if our target system does not support errno then we *)
 373                RAISEdevException(cid, did, notAvailable,
 374                                  'textread unrecoverable errno')
 375             END
 376          UNTIL (maxChars=0) OR isEOF(g^.genif, d) ;
 377          checkPostRead(g, d)
 378       END
 379    END
 380 END doReadText ;
 381
 382
 383 PROCEDURE doWriteText (g: ChanDev;
 384                        d: DeviceTablePtr;
 385                        from: ADDRESS;
 386                        charsToWrite: CARDINAL) ;
 387 VAR
 388    i: CARDINAL ;
 389 BEGIN
 390    checkValid(g, d) ;
 391    checkFlags(write+text, d) ;
 392    WITH d^ DO
 393       checkPreWrite(g, d) ;
 394       INCL(flags, textFlag) ;
 395       WHILE (charsToWrite>0) AND doWBytes(g^.genif, d, from, charsToWrite, i) DO
 396          INC(from, i) ;
 397          DEC(charsToWrite, i)
 398       END ;
 399       IF isError(g^.genif, d)
 400       THEN
 401          checkErrno(g, d) ;
 402          (* if our target system does not support errno then we *)
 403          RAISEdevException(cid, did, notAvailable,
 404                            'textwrite unrecoverable errno')
 405       END ;
 406       checkPostWrite(g, d)
 407    END
 408 END doWriteText ;
 409
 410
 411 PROCEDURE doReadLocs (g: ChanDev;
 412                       d: DeviceTablePtr;
 413                       to: ADDRESS;
 414                       maxLocs: CARDINAL;
 415                       VAR locsRead: CARDINAL) ;
 416 VAR
 417    i: CARDINAL ;
 418 BEGIN
 419    checkValid(g, d) ;
 420    checkFlags(read+raw, d) ;
 421    IF maxLocs>0
 422    THEN
 423       WITH d^ DO
 424          INCL(flags, rawFlag) ;
 425          checkPreRead(g, d, FALSE, TRUE) ;
 426          locsRead := 0 ;
 427          REPEAT
 428             IF doRBytes(g^.genif, d, to, maxLocs, i)
 429             THEN
 430                INC(locsRead, i) ;
 431                INC(to, i) ;
 432                DEC(maxLocs, i)
 433             ELSE
 434                checkErrno(g, d) ;
 435                (* if our target system does not support errno then we *)
 436                RAISEdevException(cid, did, notAvailable,
 437                                  'rawread unrecoverable errno')
 438             END
 439          UNTIL (maxLocs=0) OR isEOF(g^.genif, d) ;
 440          checkPostRead(g, d)
 441       END
 442    END
 443 END doReadLocs ;
 444
 445
 446 PROCEDURE doWriteLocs (g: ChanDev;
 447                        d: DeviceTablePtr;
 448                        from: ADDRESS;
 449                        locsToWrite: CARDINAL) ;
 450 VAR
 451    i: CARDINAL ;
 452 BEGIN
 453    checkValid(g, d) ;
 454    checkFlags(write+raw, d) ;
 455    WITH d^ DO
 456       checkPreWrite(g, d) ;
 457       INCL(flags, rawFlag) ;
 458       WHILE doWBytes(g^.genif, d, from, locsToWrite, i) AND (i<locsToWrite) DO
 459          INC(from, i) ;
 460          DEC(locsToWrite, i)
 461       END ;
 462       IF isError(g^.genif, d)
 463       THEN
 464          checkErrno(g, d) ;
 465          (* if our target system does not support errno then we *)
 466          RAISEdevException(cid, did, notAvailable,
 467                            'rawwrite unrecoverable errno')
 468       END ;
 469       checkPostWrite(g, d)
 470    END
 471 END doWriteLocs ;
 472
 473
 474 BEGIN
 475    (*                                 seqfile, streamfile, programargs, stdchans, term , socket, rndfile *)
 476    raiseEofInLook := deviceExceptions{ FALSE  , FALSE     , FALSE      , FALSE   , FALSE, FALSE , FALSE };
 477    raiseEofInSkip := deviceExceptions{ TRUE   , TRUE      , TRUE       , TRUE    , TRUE , TRUE  , TRUE };
 478 END RTgen.