paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 10:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

accelerated conversion from data to lrs

Browse Source 
git-svn-id: trunk@5203 -
This commit is contained in:
mattias 2004-02-17 22:17:40 +00:00
parent bccd8739a1
commit 2bc1daf685
7 changed files with 258 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
designer/jitforms.pp
View File

@ -854,7 +854,7 @@ procedure TJITComponentList.ReaderSetMethodProperty(Reader: TReader;
Instance: TPersistent; PropInfo: PPropInfo; const TheMethodName: string;
var Handled: boolean);
begin
writeln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
//writeln('TJITComponentList.ReaderSetMethodProperty ',PropInfo^.Name,':=',TheMethodName);
end;
{$ENDIF}

48
ide/main.pp
View File

@ -44,11 +44,12 @@ uses
{$ENDIF}
// fpc packages
Classes, SysUtils, Process, TypInfo,
// lcl
LCLProc, LCLMemManager, LCLType, LCLIntf, LMessages, LResources, StdCtrls,
Forms, Buttons, Menus, FileCtrl, Controls, GraphType, Graphics, ExtCtrls,
Dialogs,
// codetools
Laz_XMLCfg, CodeToolsStructs, CodeToolManager, CodeCache, DefineTemplates,
// lcl
LCLType, LCLIntf, LCLproc, LMessages, LResources, StdCtrls, Forms, Buttons,
Menus, FileCtrl, Controls, GraphType, Graphics, ExtCtrls, Dialogs,
// synedit
SynEditKeyCmds,
// compile
@ -3131,11 +3132,13 @@ end;
function TMainIDE.DoSaveFileResources(AnUnitInfo: TUnitInfo;
ResourceCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
const
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
var
ComponentSavingOk: boolean;
MemStream,BinCompStream,TxtCompStream:TMemoryStream;
MemStream, BinCompStream, TxtCompStream: TExtMemoryStream;
Driver: TAbstractObjectWriter;
Writer:TWriter;
Writer: TWriter;
ACaption, AText: string;
CompResourceCode, LFMFilename, TestFilename, ResTestFilename: string;
begin
@ -3158,13 +3161,15 @@ begin
FormEditor1.SaveHiddenDesignerFormProperties(AnUnitInfo.Component);
// stream component to binary stream
BinCompStream:=TMemoryStream.Create;
BinCompStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastBinStreamSize>0 then
BinCompStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
try
Result:=mrOk;
repeat
try
BinCompStream.Position:=0;
Driver:=TBinaryObjectWriter.Create(BinCompStream,4096);
Driver:=TBinaryObjectWriter.Create(BinCompStream,BufSize);
try
Writer:=TWriter.Create(Driver);
try
@ -3175,6 +3180,7 @@ begin
finally
Driver.Free;
end;
AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
except
ACaption:=lisStreamingError;
AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
@ -3202,11 +3208,14 @@ begin
if ComponentSavingOk then begin
// there is no bug in the source, so the resource code should be
// changed too
MemStream:=TMemoryStream.Create;
MemStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastLRSStreamSize>0 then
MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+BufSize;
try
BinCompStream.Position:=0;
BinaryToLazarusResourceCode(BinCompStream,MemStream
,'T'+AnUnitInfo.ComponentName,'FORMDATA');
AnUnitInfo.ComponentLastLRSStreamSize:=MemStream.Size;
MemStream.Position:=0;
SetLength(CompResourceCode,MemStream.Size);
MemStream.Read(CompResourceCode[1],length(CompResourceCode));
@ -3218,7 +3227,7 @@ begin
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.SaveFileResources E ',CompResourceCode);
{$ENDIF}
// replace lazarus form resource code
// replace lazarus form resource code in include file
if not (sfSaveToTestDir in Flags) then begin
// if resource name has changed, delete old resource
if (AnUnitInfo.ComponentName<>AnUnitInfo.ComponentResourceName)
@ -3275,10 +3284,14 @@ begin
repeat
try
// transform binary to text
TxtCompStream:=TMemoryStream.Create;
TxtCompStream:=TExtMemoryStream.Create;
if AnUnitInfo.ComponentLastLFMStreamSize>0 then
TxtCompStream.Capacity:=AnUnitInfo.ComponentLastLFMStreamSize
+BufSize;
try
BinCompStream.Position:=0;
ObjectBinaryToText(BinCompStream,TxtCompStream);
AnUnitInfo.ComponentLastLFMStreamSize:=TxtCompStream.Size;
// stream text to file
TxtCompStream.Position:=0;
LFMCode.LoadFromStream(TxtCompStream);
@ -3653,11 +3666,13 @@ end;
function TMainIDE.DoLoadLFM(AnUnitInfo: TUnitInfo;
Flags: TOpenFlags): TModalResult;
const
BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
var
LFMFilename, ACaption, AText: string;
LFMBuf: TCodeBuffer;
ComponentLoadingOk: boolean;
TxtLFMStream, BinLFMStream:TMemoryStream;
TxtLFMStream, BinLFMStream: TExtMemoryStream;
CInterface: TComponentInterface;
NewComponent: TComponent;
AncestorType: TComponentClass;
@ -3681,11 +3696,12 @@ begin
ComponentLoadingOk:=true;
BinLFMStream:=TMemoryStream.Create;
BinLFMStream:=TExtMemoryStream.Create;
try
TxtLFMStream:=TMemoryStream.Create;
TxtLFMStream:=TExtMemoryStream.Create;
try
LFMBuf.SaveToStream(TxtLFMStream);
AnUnitInfo.ComponentLastLFMStreamSize:=TxtLFMStream.Size;
TxtLFMStream.Position:=0;
// find the classname of the LFM
@ -3709,7 +3725,10 @@ begin
// convert text to binary format
try
if AnUnitInfo.ComponentLastBinStreamSize>0 then
BinLFMStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
ObjectTextToBinary(TxtLFMStream,BinLFMStream);
AnUnitInfo.ComponentLastBinStreamSize:=BinLFMStream.Size;
BinLFMStream.Position:=0;
Result:=mrOk;
except
@ -10316,6 +10335,9 @@ end.
{ =============================================================================
$Log$
Revision 1.711 2004/02/17 22:17:39 mattias
accelerated conversion from data to lrs
Revision 1.710 2004/02/10 00:45:50 mattias
changed mbOk to mbYes for asking to add unit to project

22
ide/project.pp
View File

@ -81,11 +81,6 @@ type
fAutoRevertLockCount: integer;
fBookmarks: TFileBookmarks;
FBuildFileIfActive: boolean;
fCursorPos: TPoint;
fCustomHighlighter: boolean; // do not change highlighter on file extension change
fEditorIndex: integer;
fFileName: string;
fFileReadOnly: Boolean;
fComponent: TComponent;
fComponentName: string; { classname is always T<ComponentName>
this attribute contains the component name,
@ -93,6 +88,14 @@ type
or the designer form is not created.
A component can be a TForm or a TDataModule }
fComponentResourceName: string;
FComponentLastBinStreamSize: TStreamSeekType;
FComponentLastLFMStreamSize: TStreamSeekType;
FComponentLastLRSStreamSize: TStreamSeekType;
fCursorPos: TPoint;
fCustomHighlighter: boolean; // do not change highlighter on file extension change
fEditorIndex: integer;
fFileName: string;
fFileReadOnly: Boolean;
fHasResources: boolean; // source has resource file
FIgnoreFileDateOnDiskValid: boolean;
FIgnoreFileDateOnDisk: longint;
@ -185,6 +188,12 @@ type
property ComponentName: string read fComponentName write fComponentName;
property ComponentResourceName: string read fComponentResourceName
write fComponentResourceName;
property ComponentLastBinStreamSize: TStreamSeekType
read FComponentLastBinStreamSize write FComponentLastBinStreamSize;
property ComponentLastLRSStreamSize: TStreamSeekType
read FComponentLastLRSStreamSize write FComponentLastLRSStreamSize;
property ComponentLastLFMStreamSize: TStreamSeekType
read FComponentLastLFMStreamSize write FComponentLastLFMStreamSize;
property CursorPos: TPoint read fCursorPos write fCursorPos;
property CustomHighlighter: boolean
read fCustomHighlighter write fCustomHighlighter;
@ -2815,6 +2824,9 @@ end.
{
$Log$
Revision 1.148 2004/02/17 22:17:39 mattias
accelerated conversion from data to lrs
Revision 1.147 2004/01/17 13:29:04 mattias
using now fpc constant LineEnding from Vincent

5
lcl/include/bitmap.inc
View File

@ -858,7 +858,7 @@ var
IntfImg: TLazIntfImage;
ImgWriter: TFPCustomImageWriter;
begin
writeln('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0));
//writeln('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0));
if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin
DoWriteOriginal;
exit;
@ -1059,6 +1059,9 @@ end;
{ =============================================================================
$Log$
Revision 1.66 2004/02/17 22:17:40 mattias
accelerated conversion from data to lrs
Revision 1.65 2004/02/17 00:32:25 mattias
fixed TCustomImage.DoAutoSize fixing uninitialized vars

30
lcl/lclintf.pas
View File

@ -70,6 +70,8 @@ function GetTickCount: DWord; cdecl; external;
function GetTickCount: DWord;
{$ENDIF}
function GetTickStep: DWord;
implementation
uses
@ -84,6 +86,11 @@ var
array[TPredefinedClipboardFormat] of TClipboardFormat;
LowerCaseChars: array[char] of char;
UpperCaseChars: array[char] of char;
LastTickValid: boolean;
LastTick: DWord;
//const
// MaxTick = 24*60*60*1000;
{$IFNDEF Win32}
function GetTickCount: DWord;
@ -95,6 +102,25 @@ begin
end;
{$ENDIF}
function GetTickStep: DWord;
var
CurTick: DWord;
begin
CurTick:=GetTickCount;
if LastTickValid then begin
if LastTick<=CurTick then
Result:=CurTick-LastTick
else begin
// tick counter has restarted
Result:=CurTick+(DWord($FFFFFFFF)-LastTick+1);
end;
end else begin
Result:=0;
end;
LastTickValid:=true;
LastTick:=CurTick;
end;
function MakeLong(A,B : Word) : LongInt;
begin
Result := A or B shl 16;
@ -141,6 +167,7 @@ begin
LowerCaseChars[c]:=s[1];
UpperCaseChars[c]:=upcase(c);
end;
LastTickValid:=false;
end;
initialization
@ -151,6 +178,9 @@ end.
{
$Log$
Revision 1.8 2004/02/17 22:17:40 mattias
accelerated conversion from data to lrs
Revision 1.7 2004/02/02 12:44:45 mattias
implemented interface constraints

8
lcl/lclmemmanager.pas
View File

@ -93,6 +93,14 @@ type
function NewItem: Pointer;
procedure EnumerateItems(Method: TLCLEnumItemsMethod);
end;
{ TExtMemoryStream }
TExtMemoryStream = class(TMemoryStream)
public
property Capacity: Longint read FCapacity write SetCapacity;
end;
implementation

208
lcl/lresources.pp
View File

@ -93,7 +93,22 @@ var LazarusResources:TLResourceList;
implementation
const LineEnd:ShortString= LineEnding;
const
LineEnd: ShortString = LineEnding;
var
ByteToStr: array[char] of shortstring;
ByteToStrValid: boolean;
procedure InitByteToStr;
var
c: Char;
begin
if ByteToStrValid then exit;
for c:=Low(char) to High(char) do
ByteToStr[c]:=IntToStr(ord(c));
ByteToStrValid:=true;
end;
{function UTF8Decode(const S: UTF8String): WideString;
begin
@ -108,75 +123,172 @@ procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream;
+#83#187#6#78#83
);
}
var s, Indent: ShortString;
p, x: integer;
c, h: char;
const
ReadBufSize = 4096;
WriteBufSize = 4096;
var
s, Indent: string;
x: integer;
c: char;
RangeString, NewRangeString: boolean;
RightMargin, CurLine: integer;
WriteBufStart, Writebuf: PChar;
WriteBufPos: Integer;
ReadBufStart, ReadBuf: PChar;
ReadBufPos, ReadBufLen: integer;
MinCharCount: Integer;
procedure FillReadBuf;
begin
ReadBuf:=ReadBufStart;
ReadBufPos:=0;
ReadBufLen:=BinStream.Read(ReadBuf^,ReadBufSize);
end;
procedure InitReadBuf;
begin
GetMem(ReadBufStart,ReadBufSize);
FillReadBuf;
end;
function ReadChar(var c: char): boolean;
begin
if ReadBufPos>=ReadBufLen then begin
FillReadBuf;
if ReadBufLen=0 then begin
Result:=false;
exit;
end;
end;
c:=ReadBuf^;
inc(ReadBuf);
inc(ReadBufPos);
Result:=true;
end;
procedure InitWriteBuf;
begin
GetMem(WriteBufStart,WriteBufSize);
WriteBuf:=WriteBufStart;
WriteBufPos:=0;
end;
procedure FlushWriteBuf;
begin
if WriteBufPos>0 then begin
ResStream.Write(WriteBufStart^,WriteBufPos);
WriteBuf:=WriteBufStart;
WriteBufPos:=0;
end;
end;
procedure WriteChar(c: char);
begin
WriteBuf^:=c;
inc(WriteBufPos);
inc(WriteBuf);
if WriteBufPos>=WriteBufSize then
FlushWriteBuf;
end;
procedure WriteString(const s: string);
var
i: Integer;
begin
for i:=1 to length(s) do WriteChar(s[i]);
end;
procedure WriteShortString(const s: string);
var
i: Integer;
begin
for i:=1 to length(s) do WriteChar(s[i]);
end;
begin
// fpc is not optimized for building a constant string out of thousands of
// lines. It needs huge amounts of memory and becomes very slow. Therefore big
// files are split into several strings.
InitReadBuf;
InitWriteBuf;
InitByteToStr;
Indent:='';
s:=Indent+'LazarusResources.Add('''+ResourceName+''','''+ResourceType+''',['
+LineEnd;
ResStream.Write(s[1],length(s));
p:=0;
WriteString(s);
Indent:=' '+Indent;
ResStream.Write(Indent[1],length(Indent));
WriteString(Indent);
x:=length(Indent);
RangeString:=false;
CurLine:=1;
RightMargin:=80;
while p<BinStream.Size do begin
BinStream.Read(c,1);
while ReadChar(c) do begin
NewRangeString:=(ord(c)>=32) and (ord(c)<=127);
// check if new char fits into line or if a new line must be started
if NewRangeString then begin
if RangeString then
s:=''
else begin
s:='''';
end;
s:=s+c;
if c='''' then s:=s+'''';
end else begin
if RangeString then begin
s:='''';
end else
s:='';
s:=s+'#'+IntToStr(ord(c));
end;
inc(x,length(s));
if (x>RightMargin) or ((NewRangeString) and (x=RightMargin)) then begin
if RangeString then begin
h:='''';
ResStream.Write(h,1);
if NewRangeString then
s:=''''+s
else begin
s:=copy(s,2,length(s)-1);
end;
end;
ResStream.Write(LineEnd[1],length(LineEnd));
inc(CurLine);
if (CurLine and 63)<>1 then
s:=Indent+'+'+s
MinCharCount:=2 // char plus '
else
s:=Indent+','+s;
x:=length(s);
MinCharCount:=3; // ' plus char plus '
if c='''' then inc(MinCharCount);
end else begin
MinCharCount:=1+length(ByteToStr[c]); // # plus number
if RangeString then
inc(MinCharCount); // plus ' for ending last string constant
end;
ResStream.Write(s[1],length(s));
if x+MinCharCount>RightMargin then begin
// break line
if RangeString then begin
// end string constant
WriteChar('''');
end;
// write line ending
WriteShortString(LineEnd);
x:=0;
inc(CurLine);
// write indention
WriteString(Indent);
inc(x,length(Indent));
// write operator
if (CurLine and 63)<>1 then
WriteChar('+')
else
WriteChar(',');
inc(x);
RangeString:=false;
end;
// write converted byte
if RangeString<>NewRangeString then begin
WriteChar('''');
inc(x);
end;
if NewRangeString then begin
WriteChar(c);
inc(x);
if c='''' then begin
WriteChar(c);
inc(x);
end;
end else begin
WriteChar('#');
inc(x);
WriteShortString(ByteToStr[c]);
inc(x,length(ByteToStr[c]));
end;
// next
RangeString:=NewRangeString;
inc(p);
end;
if RangeString then begin
h:='''';
ResStream.Write(h,1);
WriteChar('''');
end;
Indent:=copy(Indent,3,length(Indent)-2);
s:=LineEnd+Indent+']);'+LineEnd;
ResStream.Write(s[1],length(s));
WriteString(s);
FlushWriteBuf;
FreeMem(ReadBufStart);
FreeMem(WriteBufStart);
end;
function FindLFMClassName(LFMStream:TStream):ansistring;
@ -1365,8 +1477,14 @@ end;
//------------------------------------------------------------------------------
initialization
procedure InternalInit;
begin
LazarusResources:=TLResourceList.Create;
ByteToStrValid:=false;
end;
initialization
InternalInit;
finalization
LazarusResources.Free;