gcc/m2/gm2-libs-pim/InOut.mod

   1 (* InOut.mod provides a compatible PIM [234] InOut module.
   2
   3 Copyright (C) 2004-2023 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 InOut ;
  28
  29 IMPORT FIO, SFIO, Terminal ;
  30 FROM FIO IMPORT File, StdIn, StdOut ;
  31
  32 FROM DynamicStrings IMPORT String, InitString, Mark, KillString, ConCat,
  33                            RemoveWhitePrefix, char, ConCatChar, Length ;
  34
  35 FROM StringConvert IMPORT CardinalToString, stoc, stoi, ctos, itos ;
  36 FROM ASCII IMPORT nul ;
  37 FROM SYSTEM IMPORT ADR ;
  38 FROM libc IMPORT read, write ;
  39 FROM Termbase IMPORT AssignRead, AssignWrite ;
  40 IMPORT Keyboard ;
  41
  42
  43 CONST
  44    stdin = 0 ;
  45    stdout = 1 ;
  46
  47 TYPE
  48    CharSet = SET OF CHAR ;
  49
  50 VAR
  51    in, out: File ;
  52    inUsed,
  53    outUsed: BOOLEAN ;
  54
  55
  56 (*
  57    OpenInput - reads a string from stdin as the filename for reading.
  58                If the filename ends with `.' then it appends the defext
  59                extension. The global variable Done is set if all
  60                was successful.
  61 *)
  62
  63 PROCEDURE OpenInput (defext: ARRAY OF CHAR) ;
  64 VAR
  65    s: String ;
  66 BEGIN
  67    s := ReadS() ;
  68    IF char(s, -1)='.'
  69    THEN
  70       s := ConCat(s, Mark(InitString(defext)))
  71    END ;
  72    IF SFIO.Exists(s)
  73    THEN
  74       in := SFIO.OpenToRead(s) ;
  75       Done := FIO.IsNoError(in) ;
  76       inUsed := TRUE
  77    ELSE
  78       Done := FALSE ;
  79       inUsed := FALSE
  80    END ;
  81    s := KillString(s)
  82 END OpenInput ;
  83
  84
  85 (*
  86    CloseInput - closes an opened input file and returns input back to
  87                 StdIn.
  88 *)
  89
  90 PROCEDURE CloseInput ;
  91 BEGIN
  92    IF inUsed
  93    THEN
  94       FIO.Close(in) ;
  95       in := StdIn ;
  96       inUsed := FALSE
  97    END
  98 END CloseInput ;
  99
 100
 101 (*
 102    OpenOutput - reads a string from stdin as the filename for writing.
 103                 If the filename ends with `.' then it appends the defext
 104                 extension. The global variable Done is set if all
 105                 was successful.
 106 *)
 107
 108 PROCEDURE OpenOutput (defext: ARRAY OF CHAR) ;
 109 VAR
 110    s: String ;
 111 BEGIN
 112    s := ReadS() ;
 113    IF char(s, -1)='.'
 114    THEN
 115       s := ConCat(s, Mark(InitString(defext)))
 116    END ;
 117    IF SFIO.Exists(s)
 118    THEN
 119       out := SFIO.OpenToWrite(s) ;
 120       Done := FIO.IsNoError(out) ;
 121       outUsed := TRUE
 122    ELSE
 123       Done := FALSE ;
 124       outUsed := FALSE
 125    END ;
 126    s := KillString(s)
 127 END OpenOutput ;
 128
 129
 130 (*
 131    CloseOutput - closes an opened output file and returns output back to
 132                  StdOut.
 133 *)
 134
 135 PROCEDURE CloseOutput ;
 136 BEGIN
 137    IF outUsed
 138    THEN
 139       FIO.Close(out) ;
 140       out := StdOut ;
 141       outUsed := FALSE
 142    END
 143 END CloseOutput ;
 144
 145
 146 (*
 147    LocalRead -
 148 *)
 149
 150 PROCEDURE LocalRead (VAR ch: CHAR) ;
 151 BEGIN
 152    ch := FIO.ReadChar(in) ;
 153    Done := FIO.IsNoError(in) AND (NOT FIO.EOF(in))
 154 END LocalRead ;
 155
 156
 157 (*
 158    LocalStatus - returns TRUE if more characters may be read.
 159 *)
 160
 161 PROCEDURE LocalStatus () : BOOLEAN ;
 162 BEGIN
 163    IF inUsed
 164    THEN
 165       RETURN Done
 166    ELSE
 167       RETURN Keyboard.KeyPressed ()
 168    END
 169 END LocalStatus ;
 170
 171
 172 (*
 173    ReadS - returns a string which has is a sequence of characters.
 174            Leading white space is ignored and string is terminated
 175            with a character <= ' '.
 176 *)
 177
 178 PROCEDURE ReadS () : String ;
 179 VAR
 180    s : String ;
 181    ch: CHAR ;
 182 BEGIN
 183    s := InitString('') ;
 184    REPEAT
 185       Read(ch)
 186    UNTIL ch>' ' ;
 187    WHILE ch>' ' DO
 188       s := ConCatChar(s, ch) ;
 189       Read(ch)
 190    END ;
 191    (* successful *)
 192    RETURN( s )
 193 END ReadS ;
 194
 195
 196 (*
 197    Read - reads a single character from the current input file.
 198           Done is set to FALSE if end of file is reached or an
 199           error occurs.
 200 *)
 201
 202 PROCEDURE Read (VAR ch: CHAR) ;
 203 BEGIN
 204    Terminal.Read(ch)
 205 END Read ;
 206
 207
 208 (*
 209    ReadString - reads a sequence of characters. Leading white space
 210                 is ignored and the string is terminated with a character
 211                 <= ' '
 212 *)
 213
 214 PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
 215 VAR
 216    h, i: CARDINAL ;
 217 BEGIN
 218    (* skip leading spaces *)
 219    REPEAT
 220       Read(termCH)
 221    UNTIL termCH>' ' ;
 222    s[0] := termCH ;
 223    i := 1 ;
 224    h := HIGH(s) ;
 225    IF i<=h
 226    THEN
 227       REPEAT
 228          Read(termCH) ;
 229          IF termCH<=' '
 230          THEN
 231             s[i] := nul ;
 232             (* successful *)
 233             RETURN
 234          END ;
 235          s[i] := termCH ;
 236          INC(i)
 237       UNTIL i>h ;
 238    END ;
 239    Done := FALSE   (* out of space *)
 240 END ReadString ;
 241
 242
 243 (*
 244    WriteString - writes a string to the output file.
 245 *)
 246
 247 PROCEDURE WriteString (s: ARRAY OF CHAR) ;
 248 BEGIN
 249    FIO.WriteString(out, s) ;
 250    Done := FIO.IsNoError(out)
 251 END WriteString ;
 252
 253
 254 (*
 255    LocalWrite -
 256 *)
 257
 258 PROCEDURE LocalWrite (ch: CHAR) ;
 259 BEGIN
 260    FIO.WriteChar(out, ch) ;
 261    Done := FIO.IsNoError(out)
 262 (*
 263    IF outUsed
 264    THEN
 265       FIO.WriteChar(out, ch) ;
 266       Done := FIO.IsNoError(out)
 267    ELSE
 268       Done := (write(stdout, ADR(ch), 1) = 1)
 269    END
 270 *)
 271 END LocalWrite ;
 272
 273
 274 (*
 275    Write - writes out a single character, ch, to the current output file.
 276 *)
 277
 278 PROCEDURE Write (ch: CHAR) ;
 279 BEGIN
 280    Terminal.Write(ch)
 281 END Write ;
 282
 283
 284 (*
 285    WriteS - writes a String to the output device.
 286             It returns the string, s.
 287 *)
 288
 289 PROCEDURE WriteS (s: String) : String ;
 290 VAR
 291    i, h: CARDINAL ;
 292 BEGIN
 293    i := 0 ;
 294    h := Length(s) ;
 295    WHILE i<h DO
 296       Write(char(s, i)) ;
 297       INC(i)
 298    END ;
 299    RETURN( s )
 300 END WriteS ;
 301
 302
 303 (*
 304    WriteLn - writes a newline to the output file.
 305 *)
 306
 307 PROCEDURE WriteLn ;
 308 BEGIN
 309    IF outUsed
 310    THEN
 311       FIO.WriteLine(out) ;
 312       Done := FIO.IsNoError(out)
 313    ELSE
 314       Terminal.WriteLn
 315    END
 316 END WriteLn ;
 317
 318
 319 (*
 320    ReadInt - reads a string and converts it into an INTEGER, x.
 321              Done is set if an INTEGER is read.
 322 *)
 323
 324 PROCEDURE ReadInt (VAR x: INTEGER) ;
 325 VAR
 326    s: String ;
 327 BEGIN
 328    s := RemoveWhitePrefix(ReadS()) ;
 329    IF char(s, 0) IN CharSet{'-', '+', '0'..'9'}
 330    THEN
 331       x := stoi(s) ;
 332       Done := TRUE
 333    ELSE
 334       Done := FALSE
 335    END ;
 336    s := KillString(s)
 337 END ReadInt ;
 338
 339
 340 (*
 341    ReadInt - reads a string and converts it into an INTEGER, x.
 342              Done is set if an INTEGER is read.
 343 *)
 344
 345 PROCEDURE ReadCard (VAR x: CARDINAL) ;
 346 VAR
 347    s: String ;
 348 BEGIN
 349    s := RemoveWhitePrefix(ReadS()) ;
 350    IF char(s, 0) IN CharSet{'+', '0'..'9'}
 351    THEN
 352       x := stoc(s) ;
 353       Done := TRUE
 354    ELSE
 355       Done := FALSE
 356    END ;
 357    s := KillString(s)
 358 END ReadCard ;
 359
 360
 361 (*
 362    WriteCard - writes the CARDINAL, x, to the output file. It ensures
 363                that the number occupies, n, characters. Leading spaces
 364                are added if required.
 365 *)
 366
 367 PROCEDURE WriteCard (x, n: CARDINAL) ;
 368 BEGIN
 369    IF KillString(SFIO.WriteS(out, ctos(x, n, ' ')))=NIL
 370    THEN
 371    END
 372 END WriteCard ;
 373
 374
 375 (*
 376    WriteInt - writes the INTEGER, x, to the output file. It ensures
 377               that the number occupies, n, characters. Leading spaces
 378               are added if required.
 379 *)
 380
 381 PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) ;
 382 BEGIN
 383    IF KillString(SFIO.WriteS(out, itos(x, n, ' ', FALSE)))=NIL
 384    THEN
 385    END
 386 END WriteInt ;
 387
 388
 389 (*
 390    WriteOct - writes the CARDINAL, x, to the output file in octal.
 391               It ensures that the number occupies, n, characters.
 392               Leading spaces are added if required.
 393 *)
 394
 395 PROCEDURE WriteOct (x, n: CARDINAL) ;
 396 BEGIN
 397    IF KillString(SFIO.WriteS(out, CardinalToString(x, n, ' ', 8, FALSE)))=NIL
 398    THEN
 399    END
 400 END WriteOct ;
 401
 402
 403 (*
 404    WriteHex - writes the CARDINAL, x, to the output file in hexadecimal.
 405               It ensures that the number occupies, n, characters.
 406               Leading spaces are added if required.
 407 *)
 408
 409 PROCEDURE WriteHex (x, n: CARDINAL) ;
 410 BEGIN
 411    IF KillString(SFIO.WriteS(out, CardinalToString(x, n, ' ', 16, TRUE)))=NIL
 412    THEN
 413    END
 414 END WriteHex ;
 415
 416
 417 (*
 418    Init -
 419 *)
 420
 421 PROCEDURE Init ;
 422 BEGIN
 423    in := FIO.StdIn ;
 424    out := FIO.StdOut ;
 425    inUsed := FALSE ;
 426    outUsed := FALSE ;
 427    AssignRead(LocalRead, LocalStatus, Done) ;
 428    AssignWrite(LocalWrite, Done)
 429 END Init ;
 430
 431
 432 BEGIN
 433    Init
 434 END InOut.