diff --git a/fcl/inc/parser.inc b/fcl/inc/parser.inc index a7a01f556c..d580784e15 100644 --- a/fcl/inc/parser.inc +++ b/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; - -Procedure TParser.SkipBlanks; - +function HexToBin(Text, Buffer: PChar; BufSize: Integer) : Integer; begin end; +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; + + +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 -end; + 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. }