TP3/shell/CompilerSource.mod

IMPLEMENTATION MODULE CompilerSource ;

(* Source-buffer access and {$I file} expansion.  The parser still sees one
   flat TextBuf; this module owns the cursor, include state and the include
   pre-pass. *)

FROM SYSTEM IMPORT BYTE, ADR ;
FROM TextBuf IMPORT TextLimit, Length, CharAt, DeleteFromTo, InsertStr ;
FROM Posix IMPORT open, read, close ;
FROM CompilerShared IMPORT srcPos, Err, OK, EMemOvf, EFileNF, EInclNest ;

VAR
   srcName    : ARRAY [0..255] OF CHAR ;
   inclName   : ARRAY [0..127] OF CHAR ;
   inclPath   : ARRAY [0..383] OF CHAR ;
   incBuf     : ARRAY [0..TextLimit] OF CHAR ;

PROCEDURE CurCh () : CHAR ;
BEGIN
   IF srcPos >= srcLen THEN
      RETURN 0C
   END ;
   RETURN CharAt (srcPos)
END CurCh ;

PROCEDURE GetCh () : CHAR ;
VAR ch : CHAR ;
BEGIN
   ch := CurCh () ;
   IF srcPos < srcLen THEN
      INC (srcPos)
   END ;
   RETURN ch
END GetCh ;

PROCEDURE PeekAhead (k : CARDINAL) : CHAR ;
BEGIN
   IF srcPos + k >= srcLen THEN
      RETURN 0C
   END ;
   RETURN CharAt (srcPos + k)
END PeekAhead ;

PROCEDURE Upper (ch : CHAR) : CHAR ;
BEGIN
   IF (ch >= 'a') AND (ch <= 'z') THEN
      RETURN CHR (ORD (ch) - ORD ('a') + ORD ('A'))
   END ;
   RETURN ch
END Upper ;

PROCEDURE SetSourcePath (path : ARRAY OF CHAR) ;
(* remember the path the buffer was loaded from; MakeIncludePath keeps only its
   directory *)
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i < 255) AND (i <= HIGH (path)) AND (path [i] # 0C) DO
      srcName [i] := path [i] ;
      INC (i)
   END ;
   srcName [i] := 0C
END SetSourcePath ;

PROCEDURE ReadWholeFile (path : ARRAY OF CHAR ; VAR n : CARDINAL) : BOOLEAN ;
(* Read path into incBuf with the same CR/LF normalisation as LoadWorkFile,
   and report its length in n.  FALSE if it could not be opened.  ^Z ends the
   text, as it does for every other reader here. *)
VAR fd : INTEGER ;
    k : LONGINT ;
    b : BYTE ;
    ch : CHAR ;
    prevCR, emit : BOOLEAN ;
BEGIN
   n := 0 ;
   fd := open (ADR (path), 0, 0) ;
   IF fd < 0 THEN
      RETURN FALSE
   END ;
   prevCR := FALSE ;
   LOOP
      k := read (fd, ADR (b), 1) ;
      IF k # 1 THEN EXIT END ;
      IF b = 26 THEN EXIT END ;            (* ^Z *)
      emit := TRUE ;
      IF b = 10 THEN
         IF prevCR THEN
            emit := FALSE
         ELSE
            ch := CHR (13)                 (* lone LF -> CR *)
         END ;
         prevCR := FALSE
      ELSIF b = 13 THEN
         ch := CHR (13) ;
         prevCR := TRUE
      ELSE
         ch := CHR (ORD (b)) ;
         prevCR := FALSE
      END ;
      IF emit AND (n <= TextLimit) THEN
         incBuf [n] := ch ;
         INC (n)
      END
   END ;
   k := close (fd) ;
   RETURN TRUE
END ReadWholeFile ;

PROCEDURE MakeIncludePath () ;
(* inclPath := directory (srcName) + inclName, defaulting the extension to
   .PAS when the name has none (TPSRC10 kpasext). *)
VAR i, j, last : CARDINAL ; dot : BOOLEAN ;
BEGIN
   dot := FALSE ;
   i := 0 ;
   WHILE (i < 127) AND (inclName [i] # 0C) DO
      IF inclName [i] = '.' THEN dot := TRUE END ;
      INC (i)
   END ;
   IF (NOT dot) AND (i <= 123) THEN
      inclName [i]     := '.' ;
      inclName [i + 1] := 'P' ;
      inclName [i + 2] := 'A' ;
      inclName [i + 3] := 'S' ;
      inclName [i + 4] := 0C
   END ;
   last := 0 ;
   i := 0 ;
   WHILE (i < 256) AND (srcName [i] # 0C) DO
      IF srcName [i] = '/' THEN last := i + 1 END ;
      INC (i)
   END ;
   j := 0 ;
   WHILE j < last DO
      inclPath [j] := srcName [j] ;
      INC (j)
   END ;
   i := 0 ;
   WHILE (i < 127) AND (inclName [i] # 0C) DO
      inclPath [j] := inclName [i] ;
      INC (j) ;
      INC (i)
   END ;
   inclPath [j] := 0C
END MakeIncludePath ;

PROCEDURE ExpandIncludes () ;
(* Replace every {$I name} directive in the buffer with the named file's text,
   BEFORE parsing.

   This is a pre-pass, and it has to be.  Skip is called by lookahead routines
   (DeclaresProc, PeekKw, KwAhead) that SAVE AND RESTORE srcPos; an include
   performed inside Skip would run once during the lookahead and once for real,
   and the second pass would see the first splice's text and report error 96.
   A splice also grows the buffer, which a rewind cannot undo.  So the whole
   expansion is done here, in one forward scan with no lookahead, and the
   parser only ever sees the finished text.

   The scan has to recognise exactly what the lexer does, or it would expand a
   directive that the lexer would have read as a string or a comment: a quoted
   literal is skipped, then star-paren comments (which is why {$I} written
   inside one is inert - t56_include.inc relies on that), then brace comments,
   and only then a brace directive.

   Divergence from the original: TP3 STREAMS the include file line by line and
   switches back to the outer file at EOF (TPSRC10 fileline/getincl/fileeof);
   we hold the whole source in TextBuf and address it by index, so the include
   is spliced in place.  A nested {$I} therefore cannot switch back on its own
   - which TP3 also refuses, and that is the error 96 reported here. *)
VAR i, d0, d1, k, ni, n : CARDINAL ;
    c, letter : CHAR ;
    isInc : BOOLEAN ;
BEGIN
   i := 0 ;
   inclActive := FALSE ;
   inclEnd := 0 ;
   WHILE (i < Length ()) AND OK () DO
      c := CharAt (i) ;
      IF c = "'" THEN
         INC (i) ;
         WHILE (i < Length ()) AND (CharAt (i) # "'") DO INC (i) END ;
         IF i < Length () THEN INC (i) END
      ELSIF (c = '(') AND (i + 1 < Length ()) AND (CharAt (i + 1) = '*') THEN
         INC (i, 2) ;
         WHILE (i < Length ()) AND NOT ((CharAt (i) = '*')
                     AND (i + 1 < Length ()) AND (CharAt (i + 1) = ')')) DO
            INC (i)
         END ;
         IF i < Length () THEN INC (i, 2) END
      ELSIF (c = '{') AND (i + 1 < Length ()) AND (CharAt (i + 1) = '$') THEN
         d0 := i ;
         d1 := i + 2 ;
         WHILE (d1 < Length ()) AND (CharAt (d1) # '}') DO INC (d1) END ;
         IF i + 2 < Length () THEN
            letter := Upper (CharAt (i + 2))
         ELSE
            letter := 0C
         END ;
         isInc := FALSE ;
         IF letter = 'I' THEN
            k := i + 3 ;
            WHILE (k < d1) AND ((CharAt (k) = ' ') OR (CharAt (k) = CHR (9))) DO
               INC (k)
            END ;
            IF (k >= d1) OR ((CharAt (k) # '+') AND (CharAt (k) # '-')) THEN
               isInc := TRUE
            END
         END ;
         IF isInc THEN
            IF inclActive AND (d0 < inclEnd) THEN
               srcPos := d0 ;
               Err (EInclNest) ;                  (* 96 *)
               RETURN
            END ;
            ni := 0 ;
            WHILE (k < d1) AND (ni < 127) DO
               inclName [ni] := CharAt (k) ;
               INC (k) ;
               INC (ni)
            END ;
            WHILE (ni > 0) AND ((inclName [ni - 1] = ' ')
                                OR (inclName [ni - 1] = CHR (9))) DO
               DEC (ni)
            END ;
            inclName [ni] := 0C ;
            MakeIncludePath () ;
            IF NOT ReadWholeFile (inclPath, n) THEN
               srcPos := d0 ;
               Err (EFileNF) ;                    (* 90 *)
               RETURN
            END ;
            DeleteFromTo (d0, d1 - d0 + 1) ;
            IF NOT InsertStr (d0, incBuf, n) THEN
               srcPos := d0 ;
               Err (EMemOvf) ;
               RETURN
            END ;
            inclEnd := d0 + n ;
            inclActive := TRUE ;
            i := d0                                 (* scan the new text too *)
         ELSE
            i := d1 + 1                             (* ordinary directive: leave it *)
         END
      ELSIF c = '{' THEN
         INC (i) ;
         WHILE (i < Length ()) AND (CharAt (i) # '}') DO INC (i) END ;
         IF i < Length () THEN INC (i) END
      ELSE
         INC (i)
      END
   END ;
   srcLen := Length () ;
   srcPos := 0
END ExpandIncludes ;

END CompilerSource.