+ Implemented by TSE

fcl/inc/parser.inc

@@ -15,110 +15,317 @@
 {*                             TParser                                      *}
 {****************************************************************************}
 
-Procedure TParser.ReadBuffer;
+{!!!TSE 21.09.1998 Changed by Thomas Seban (TSE) }
 
+const
+  ParseBufSize     = 4096;
+
+procedure BinToHex(Buffer, Text: PChar; BufSize: Integer);
 begin
 end;
 
+function HexToBin(Text, Buffer: PChar; BufSize: Integer) : Integer;
+begin
+end;
 
-Procedure TParser.SkipBlanks;
-
+procedure TParser.ReadBuffer;
+var
+  Count            : Integer;
 begin
+  Inc(FOrigin, FSourcePtr - FBuffer);
+
+  FSourceEnd[0] := FSaveChar;
+  Count         := FBufPtr - FSourcePtr;
+  if Count <> 0 then 
+  begin
+    Move(FSourcePtr[0], FBuffer[0], Count);
+  end;
+  
+  FBufPtr := FBuffer + Count;
+  Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
+  
+  FSourcePtr := FBuffer;
+  FSourceEnd := FBufPtr;
+  if (FSourceEnd = FBufEnd) then
+  begin
+    FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
+    if FSourceEnd = FBuffer then 
+    begin
+      Error(SLineTooLong);
+    end;
+  end;
+  FSaveChar := FSourceEnd[0];
+  FSourceEnd[0] := #0;
 end;
 
 
-constructor TParser.Create(Stream: TStream);
+procedure TParser.SkipBlanks;
+var
+  Count            : Integer;
+begin
+  Inc(FOrigin, FSourcePtr - FBuffer);
+  FSourceEnd[0] := FSaveChar;
+  Count := FBufPtr - FSourcePtr;
+  if Count <> 0 then Move(FSourcePtr[0], FBuffer[0], Count);
+  FBufPtr := FBuffer + Count;
+  Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
+  FSourcePtr := FBuffer;
+  FSourceEnd := FBufPtr;
+  if FSourceEnd = FBufEnd then
+  begin
+    FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
+    if FSourceEnd = FBuffer then Error(SLineTooLong);
+  end;
+  FSaveChar := FSourceEnd[0];
+  FSourceEnd[0] := #0;
+end;
 
+constructor TParser.Create(Stream: TStream);
 begin
+  inherited Create;
+  
+  FStream := Stream;
+  GetMem(FBuffer, ParseBufSize);
+  
+  FBuffer[0]  := #0;
+  FBufPtr     := FBuffer;
+  FBufEnd     := FBuffer + ParseBufSize;
+  FSourcePtr  := FBuffer;
+  FSourceEnd  := FBuffer;
+  FTokenPtr   := FBuffer;
+  FSourceLine := 1;
+  
+  NextToken;
 end;
 
 
 destructor TParser.Destroy;
-
 begin
+  if FBuffer <> nil then
+  begin
+    FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
+    FreeMem(FBuffer, ParseBufSize);
+  end;
+  
+  inherited Destroy;
 end;
 
-
-Procedure TParser.CheckToken(T: Char);
-
+procedure TParser.CheckToken(T : Char);
 begin
+  if Token <> T then 
+  begin
+    case T of
+      toSymbol:
+        Error(SIdentifierExpected);
+      toString:
+        Error(SStringExpected);
+      toInteger, toFloat:
+        Error(SNumberExpected);
+    else
+//      ErrorFmt(SCharExpected, [T]);
+        ErrorStr('"' + T + '"' + SCharExpected);
+    end;
+  end;
 end;
 
-
-Procedure TParser.CheckTokenSymbol(const S: string);
-
+procedure TParser.CheckTokenSymbol(const S: string);
 begin
+  if not TokenSymbolIs(S) then begin
+    // ErrorFmt(SSymbolExpected, [S]);
+    ErrorStr(S + SSymbolExpected);
+  end;
 end;
 
-
 Procedure TParser.Error(const Ident: string);
-
 begin
+  ErrorStr(Ident);
 end;
 
-
 {!!!!!!
 Procedure TParser.ErrorFmt(const Ident: string; const Args: array of const);
-
 begin
+  ErrorStr(Format(Ident, Args));
 end;
 !!!!!!}
 
 Procedure TParser.ErrorStr(const Message: string);
-
 begin
+//  raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
+  raise EParserError.Create(Message + SParseError + IntToStr(FSourceLine));
 end;
 
 
 Procedure TParser.HexToBinary(Stream: TStream);
-
+var
+  Count            : Integer;
+  Buffer           : array[0..255] of Char;
 begin
+  SkipBlanks;
+  while FSourcePtr^ <> '}' do
+  begin
+    Count := HexToBin(FSourcePtr, Buffer, SizeOf(Buffer));
+    if Count = 0 then Error(SInvalidBinary);
+    Stream.Write(Buffer, Count);
+    Inc(FSourcePtr, Count * 2);
+    SkipBlanks;
+  end;
+  NextToken;
 end;
 
 
 Function TParser.NextToken: Char;
-
+var
+  I                : Integer;
+  P, S             : PChar;
 begin
+  SkipBlanks;
+  P := FSourcePtr;
+  FTokenPtr := P;
+  case P^ of
+    'A'..'Z', 'a'..'z', '_':
+      begin
+        Inc(P);
+        while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
+        Result := toSymbol;
+      end;
+    '#', '''':
+      begin
+        S := P;
+        while True do
+          case P^ of
+            '#':
+              begin
+                Inc(P);
+                I := 0;
+                while P^ in ['0'..'9'] do
+                begin
+                  I := I * 10 + (Ord(P^) - Ord('0'));
+                  Inc(P);
+                end;
+                S^ := Chr(I);
+                Inc(S);
+              end;
+            '''':
+              begin
+                Inc(P);
+                while True do
+                begin
+                  case P^ of
+                    #0, #10, #13: 
+                      Error(SInvalidString);
+                    '''':
+                      begin
+                        Inc(P);
+                        if P^ <> '''' then Break;
+                      end;
+                  end;
+                  S^ := P^;
+                  Inc(S);
+                  Inc(P);
+                end;
+              end;
+          else
+            Break;
+          end;
+        FStringPtr := S;
+        Result := toString;
+      end;
+    '$':
+      begin
+        Inc(P);
+        while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
+        Result := toInteger;
+      end;
+    '-', '0'..'9':
+      begin
+        Inc(P);
+        while P^ in ['0'..'9'] do Inc(P);
+        Result := toInteger;
+        while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do
+        begin
+          Inc(P);
+          Result := toFloat;
+        end;
+      end;
+  else
+    Result := P^;
+    if Result <> toEOF then Inc(P);
+  end;
+  FSourcePtr := P;
+  FToken := Result;
 end;
 
-
 Function TParser.SourcePos: Longint;
-
 begin
+  Result := FOrigin + (FTokenPtr - FBuffer);
 end;
 
 
 Function TParser.TokenComponentIdent: String;
-
+var
+  P                : PChar;
 begin
+  CheckToken(toSymbol);
+  P := FSourcePtr;
+  while P^ = '.' do
+  begin
+    Inc(P);
+    if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
+      Error(SIdentifierExpected);
+    repeat
+      Inc(P)
+    until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+  end;
+  FSourcePtr := P;
+  Result := TokenString;
 end;
 
-
 Function TParser.TokenFloat: Extended;
-
+var
+  FloatError       : Integer;
+  Back             : Real;
 begin
+  Result   := 0;
+
+  // doesn't work, overload function not found
+  // systemh.inc compiled without -S2 switch => SizeOf(Integer) = 2
+  // classes.pp compiled with -S2 switch => SizeOf(Integer) = 4
+  // Val(TokenString, Back, FloatError); 
+  
+  Val(TokenString, Back); // this works fine
+  Result := Back;
 end;
 
-
 Function TParser.TokenInt: Longint;
-
 begin
+  Result := StrToInt(TokenString);
 end;
 
-
 Function TParser.TokenString: string;
-
-begin
+var
+  L                : Integer;
+  StrBuf           : array[0..1023] of Char;
+begin 
+  if FToken = toString then begin
+    L := FStringPtr - FTokenPtr 
+  end else begin
+    L := FSourcePtr - FTokenPtr;
+  end;
+  
+  StrLCopy(StrBuf, FTokenPtr, L);
+  Result := StrPas(StrBuf);
 end;
 
-
 Function TParser.TokenSymbolIs(const S: string): Boolean;
-
 begin
+  Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
 end;
 {
   $Log$
-  Revision 1.1  1998-05-04 14:30:12  michael
+  Revision 1.2  1998-09-23 07:48:11  michael
+  + Implemented by TSE
+
+  Revision 1.1  1998/05/04 14:30:12  michael
   * Split file according to Class; implemented dummys for all methods, so unit compiles.
 
 }