gcc/m2/gm2-libs/Scan.mod

   1 (* Scan.mod Provides a primitive symbol fetching from input.
   2
   3 Copyright (C) 2001-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 Scan ;
  28
  29
  30 IMPORT StdIO ;
  31
  32 FROM ASCII IMPORT nul, lf, cr, bs, del, bel ;
  33 FROM StdIO IMPORT Write ;
  34 FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
  35 FROM NumberIO IMPORT WriteCard, CardToStr ;
  36 FROM FIO IMPORT OpenToRead, IsNoError, Close, File, ReadChar ;
  37 FROM StrIO IMPORT WriteLn, WriteString ;
  38 FROM libc IMPORT exit ;
  39
  40
  41 CONST
  42    MaxLength = 255 ;  (* Max Length of Source Line *)
  43
  44 VAR
  45    FileName,
  46    CurrentString       : ARRAY [0..MaxLength] OF CHAR ;
  47    CurrentLineNo       : CARDINAL ;
  48    CurrentCursorPos    : CARDINAL ;
  49    EOF                 : BOOLEAN ;
  50    LengthOfCurSym      : CARDINAL ;
  51    f                   : File ;
  52    Opened              : BOOLEAN ;
  53    HaltOnError         : BOOLEAN ;
  54    AllowComments       : BOOLEAN ;
  55    CommentLeader,
  56    CommentTrailer      : ARRAY [0..MaxLength] OF CHAR ;
  57    TerminateOnEndOfLine: BOOLEAN ;
  58    InString            : BOOLEAN ;
  59
  60
  61 PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
  62 BEGIN
  63    StrCopy(a, FileName) ;
  64    f := OpenToRead(a) ;
  65    IF IsNoError(f)
  66    THEN
  67       StrCopy( '', CurrentString ) ;
  68       LengthOfCurSym := 0 ;
  69       CurrentCursorPos := 0 ;
  70       EOF := FALSE ;
  71       CurrentLineNo := 1 ;
  72       Opened := TRUE
  73    ELSE
  74       Opened := FALSE
  75    END ;
  76    RETURN( Opened )
  77 END OpenSource ;
  78
  79
  80 PROCEDURE CloseSource ;
  81 BEGIN
  82    IF Opened
  83    THEN
  84       Close( f ) ;
  85       Opened := FALSE
  86    END
  87 END CloseSource ;
  88
  89
  90 (*
  91    IsStartOfComment - returns TRUE if we are looking at the start of a comment.
  92 *)
  93
  94 PROCEDURE IsStartOfComment () : BOOLEAN ;
  95 VAR
  96    i, h: CARDINAL ;
  97 BEGIN
  98    IF AllowComments
  99    THEN
 100       i := 0 ;
 101       h := StrLen(CommentLeader) ;
 102       WHILE (i<h) AND (CommentLeader[i]=CurrentString[CurrentCursorPos+i]) DO
 103          INC(i)
 104       END ;
 105       RETURN( i=h )
 106    ELSE
 107       RETURN( FALSE )
 108    END
 109 END IsStartOfComment ;
 110
 111
 112 (*
 113    IsEndOfComment - returns TRUE if we can see the end of comment string.
 114                     If TRUE is returned then we also have consumed the string.
 115 *)
 116
 117 PROCEDURE IsEndOfComment () : BOOLEAN ;
 118 VAR
 119    i, h: CARDINAL ;
 120 BEGIN
 121    IF AllowComments
 122    THEN
 123       IF TerminateOnEndOfLine AND (SymbolChar()=nul)
 124       THEN
 125          NextChar ;
 126          RETURN( TRUE )
 127       ELSE
 128          i := 0 ;
 129          h := StrLen(CommentTrailer) ;
 130          WHILE (i<h) AND (CommentTrailer[i]=CurrentString[CurrentCursorPos+i]) DO
 131             INC(i)
 132          END ;
 133          IF (i=h) AND (h#0)
 134          THEN
 135             (* seen tailer therefore eat it *)
 136             INC(CurrentCursorPos, i) ;
 137             RETURN( TRUE )
 138          ELSE
 139             RETURN( FALSE )
 140          END
 141       END
 142    ELSE
 143       RETURN( FALSE )
 144    END
 145 END IsEndOfComment ;
 146
 147
 148 (*
 149    IsQuote - returns TRUE if the current character is a quote.
 150 *)
 151
 152 PROCEDURE IsQuote () : BOOLEAN ;
 153 BEGIN
 154    RETURN( SymbolChar()='"' )
 155 END IsQuote ;
 156
 157
 158 (*
 159    GetNextSymbol - returns the next symbol from the source file.
 160                    It ignores comments and treats strings differently
 161                    from normal symbols. Strings will return " string ".
 162 *)
 163
 164 PROCEDURE GetNextSymbol (VAR a: ARRAY OF CHAR) ;
 165 VAR
 166    index,
 167    High    : CARDINAL ;
 168 BEGIN
 169    index := 0 ;
 170    High  := HIGH( a ) ;
 171    ChuckUpToSymbol ;
 172
 173    IF InString
 174    THEN
 175       IF (NOT EOF) AND (NOT IsStartOfComment()) AND (index<High) AND IsQuote()
 176       THEN
 177          (* found final quote *)
 178          a[index] := SymbolChar() ;
 179          NextChar ;
 180          INC(index) ;
 181          InString := FALSE ;
 182       ELSE
 183          (* copy literal into, a *)
 184          WHILE (index<High) AND (NOT EOF) AND (SymbolChar()#nul) AND (NOT IsQuote()) DO
 185             a[index] := SymbolChar() ;
 186             NextChar ;
 187             INC(index)
 188          END ;
 189          IF NOT IsQuote()
 190          THEN
 191             WriteError('unterminated string, strings must terminate before the end of a line')
 192          END ;
 193       END
 194    ELSE
 195       IF (NOT EOF) AND (NOT IsStartOfComment())
 196       THEN
 197          IF (index<High) AND IsQuote()
 198          THEN
 199             (* found string start *)
 200             a[index] := SymbolChar() ;
 201             NextChar ; (* skip quote *)
 202             INC(index) ;
 203             InString := TRUE ;
 204          ELSE
 205             (* normal symbol, not a comment and not a string *)
 206             WHILE (index<High) AND (NOT NonSymbolChar()) AND (NOT IsStartOfComment()) DO
 207                a[index] := SymbolChar() ;
 208                NextChar ;
 209                INC(index)
 210             END
 211          END
 212       END
 213    END ;
 214    IF index<High
 215    THEN
 216       a[index] := nul
 217    END ;
 218    LengthOfCurSym := index
 219 END GetNextSymbol ;
 220
 221
 222 (*
 223    ChuckUpToSymbol - throws away white space and comments.
 224 *)
 225
 226 PROCEDURE ChuckUpToSymbol ;
 227 BEGIN
 228    REPEAT
 229       IF (NOT EOF) AND IsStartOfComment()
 230       THEN
 231          NextChar ;
 232          WHILE (NOT EOF) AND (NOT IsEndOfComment()) DO
 233             NextChar
 234          END
 235       END ;
 236       WHILE (NOT EOF) AND NonSymbolChar() DO
 237          NextChar
 238       END
 239    UNTIL EOF OR (NOT IsStartOfComment())
 240 END ChuckUpToSymbol ;
 241
 242
 243 (*
 244    SymbolChar - returns a character from the CurrentString, if the end
 245                 of CurrentString is found then SymbolChar returns nul.
 246 *)
 247
 248 PROCEDURE SymbolChar () : CHAR ;
 249 BEGIN
 250    IF EOF
 251    THEN
 252       RETURN( nul )
 253    ELSE
 254       IF CurrentCursorPos<StrLen(CurrentString)
 255       THEN
 256          RETURN( CurrentString[CurrentCursorPos] )
 257       ELSE
 258          RETURN( nul )
 259       END
 260    END
 261 END SymbolChar ;
 262
 263
 264 (* NextChar advances the CurrentCursorPos along a line of the source, *)
 265 (* resetting the CurrentCursorPos every time a newline is read.       *)
 266
 267 PROCEDURE NextChar ;
 268 BEGIN
 269    IF NOT EOF
 270    THEN
 271       IF CurrentCursorPos<StrLen(CurrentString)
 272       THEN
 273          INC(CurrentCursorPos)
 274       ELSE
 275          ReadString(CurrentString) ;
 276          (* WriteString( CurrentString ) ; WriteLn ; *)
 277          INC(CurrentLineNo) ;
 278          CurrentCursorPos := 0 ;
 279          LengthOfCurSym := 0
 280       END
 281    END
 282 END NextChar ;
 283
 284
 285 PROCEDURE NonSymbolChar () : BOOLEAN ;
 286 BEGIN
 287    RETURN( CurrentString[CurrentCursorPos]<=' ' )
 288 END NonSymbolChar ;
 289
 290
 291 PROCEDURE WriteError (a: ARRAY OF CHAR) ;
 292 VAR
 293    i, j  : CARDINAL ;
 294    LineNo: ARRAY [0..20] OF CHAR ;
 295 BEGIN
 296    WriteString(FileName) ;
 297    Write(':') ;
 298    CardToStr(CurrentLineNo, 0, LineNo) ;
 299    WriteString(LineNo) ;
 300    Write(':') ;
 301    WriteString( CurrentString ) ; WriteLn ;
 302    WriteString(FileName) ;
 303    Write(':') ;
 304    WriteString(LineNo) ;
 305    Write(':') ;
 306    i := 0 ;
 307    j := CurrentCursorPos-LengthOfCurSym ;
 308    WHILE i<j DO
 309       Write(' ') ;
 310       INC( i )
 311    END ;
 312    FOR i := 1 TO LengthOfCurSym DO
 313       Write('^')
 314    END ;
 315    WriteLn ;
 316    WriteString(FileName) ;
 317    Write(':') ;
 318    WriteString(LineNo) ;
 319    Write(':') ;
 320    WriteString( a ) ; WriteLn ;
 321    IF HaltOnError
 322    THEN
 323       exit(1)
 324    END
 325 END WriteError ;
 326
 327
 328 PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
 329 VAR
 330    n    ,
 331    high : CARDINAL ;
 332    ch   : CHAR ;
 333 BEGIN
 334    high := HIGH( a ) ;
 335    n := 0 ;
 336    REPEAT
 337       Read( ch ) ;
 338       IF (ch=del) OR (ch=bs)
 339       THEN
 340          IF n=0
 341          THEN
 342             Write( bel )
 343          ELSE
 344             Write( bs ) ;
 345             Write(' ') ;
 346             Write( bs ) ;
 347             DEC( n )
 348          END
 349       ELSIF n <= high
 350       THEN
 351          IF (ch = cr) OR (cr = lf)
 352          THEN
 353             a[n] := nul
 354          ELSE
 355 (*            Write( ch ) ;
 356  *)           a[n] := ch
 357          END ;
 358          INC( n )
 359       ELSE
 360          ch := cr  (* exit gracefully *)
 361       END
 362    UNTIL ch = cr
 363 END ReadString ;
 364
 365
 366 PROCEDURE Read (VAR ch: CHAR) ;
 367 BEGIN
 368    IF Opened
 369    THEN
 370       ch := ReadChar(f) ;
 371       EOF := NOT IsNoError(f)
 372    ELSE
 373       StdIO.Read( ch )
 374    END ;
 375    IF ch=lf THEN ch := cr END
 376 END Read ;
 377
 378
 379 (*
 380    TerminateOnError - exits with status 1 if we call WriteError.
 381 *)
 382
 383 PROCEDURE TerminateOnError ;
 384 BEGIN
 385    HaltOnError := TRUE
 386 END TerminateOnError ;
 387
 388
 389 (*
 390    DefineComments - defines the start of comments within the source
 391                     file.
 392
 393                     The characters in Start define the comment start
 394                     and characters in End define the end.
 395                     The BOOLEAN eoln determine whether the comment
 396                     is terminated by end of line. If eoln is TRUE
 397                     then End is ignored.
 398 *)
 399
 400 PROCEDURE DefineComments (Start, End: ARRAY OF CHAR; eoln: BOOLEAN) ;
 401 BEGIN
 402    TerminateOnEndOfLine := eoln ;
 403    StrCopy(Start, CommentLeader) ;
 404    StrCopy(End, CommentTrailer) ;
 405    AllowComments := StrLen(CommentLeader)>0
 406 END DefineComments ;
 407
 408
 409 BEGIN
 410    InString             := FALSE ;
 411    AllowComments        := FALSE ;
 412    TerminateOnEndOfLine := FALSE ;
 413    StrCopy(''           , CurrentString) ;
 414    LengthOfCurSym       := 0 ;
 415    CurrentCursorPos     := 0 ;
 416    EOF                  := FALSE ;
 417    CurrentLineNo        := 1 ;
 418    Opened               := FALSE ;
 419    HaltOnError          := FALSE
 420 END Scan.