>а если средствами RTL?
Совсем не то, у автора аналог SetThreadStackGuarantee из WinAPI.
Модератор: Модераторы
runewalsh писал(а):Совсем не то, у автора аналог SetThreadStackGuarantee из WinAPI.
runewalsh писал(а):Нет, резерв стека, предназначенный для обработки ошибки переполнения стека.
а как это поможет, если кол-во вызовов зависит от данных?Mirage писал(а):Если надо предотвратить бесконечную рекурсию, то проще ведь считать кол-во рекурсивных вызовов, пробрасывая соответствующий параметр.
if PtrUInt(sptr) - PtrUInt(StackBottom) < ALLOWED_STACKRESERVE then
raise EStackTooclose.Create('paranoid error')
// ну или halt(), exit() по- вкусу
else
Recurse(params);
резерв стека, предназначенный для обработки ошибки переполнения стека.
ну это точно не то, что Cheb хочет, ему отладочную информацию подавай.
а как это поможет, если кол-во вызовов зависит от данных?
Cheb писал(а):Вообще, этой ф-ии достаточно. Я могу тупо запомнить позицию стека при запуске потока и поднимать ошибку если, скажем, чеперси углубится от неё дальше, чем на 16 мегабайт
скалогрыз писал(а):ЗЫ: почему-то сказано что StackTop "contains the top of the stack for the current process", хотя он threadvar (подразумевая contains the top of the stack for the current thread?)
program project1;
{$mode delphi}{$H+}
var
ttop, tbottom, tlength : PtrUInt;
function TestStack(parameter : pointer) : ptrint;
begin
ttop:=PtrUInt(StackTop);
tbottom:=PtrUInt(Stackbottom);
tlength:=StackLength;
Result:=555;
EndThread(555);
end;
var
tid : TThreadID;
rid : TThreadID;
res : integer;
begin
writeln('stack top = ', PtrUInt(StackTop));
writeln('stack bottom = ', PtrUInt(StackBottom));
writeln('stack length = ', StackLength);
tid:=0;
rid:=BeginThread(nil, 1024*1024, @TestStack, nil, 0, tid);
res:=WaitForThreadTerminate(rid, -1);
writeln(res);
writeln('t stack top = ', PtrUInt(ttop));
writeln('t stack bottom = ', PtrUInt(tbottom));
writeln('t stack length = ', tlength);
end.
скалогрыз писал(а):StackTop, StackBottom не инизиализированы на запуске потока, и к потоку никакого отношения не имеют. Опираться на них в многопоточном приложении нельзя... во всяком случае на 2.6.4
а зачем самому запоминать? StackBottom StackTop
где StackBottom = StackTop - StackLength
а в 3.0.0 почти работает.
//per-unit conditional defines that must be uniform across many units.
{$if FPC_FULLVERSION>=20700}
{$define che_unicode}
{$endif}
type
{$include un_globaldefs.h}
{$ifdef che_unicode}
{$if FPC_FULLVERSION<30000}
{$fatal Impossible to use this compiler version: RTL is not unicode} //The sad truth
{$endif}
{ modeswitch unicodestrings} //is in the main project file
{ warn IMPLICIT_STRING_CAST Error}
{$warn IMPLICIT_STRING_CAST_LOSS Error}
{ warn EXPLICIT_STRING_CAST Error}
{$warn EXPLICIT_STRING_CAST_LOSS Error}
{ if FPC_FULLVERSION<=40000} //***TODO Replace with version in which it is fixed
{$define fix_fpc3_unicode} // Use custom mods of TFileStream, TStringList and TIniFile
{ endif}
AnsiString1251 = type AnsiString(1251);
TFileNameString = UnicodeString;
PFileNameChar = PUnicodeChar;
{$else}
//Legacy Free Pascal below 3.0
RawByteString = AnsiString;
AnsiString1251 = AnsiString;
{$ifdef windows}
//no unicode support for file names
TFileNameString = AnsiString;
PFileNameChar = PAnsiChar;
{$else}
TFileNameString = Utf8String;
PFileNameChar = PAnsiChar;
{$endif}
{$endif}
{
This is a permanent fix for the broken RTL of FPC 2.6.4
See http://bugs.freepascal.org/view.php?id=27221
This fix is required to get Platinum level of Wine compatibility
}
{$ifndef windows}
{$fatal Windows ONLY}
{$endif}
type
TFileStream = class(classes.TFileStream)
public
destructor Destroy; override;
end;
//The rest of the classes are dragged along by the need to base them on the fixed TFileStream
TStringList = class(classes.TStringList)
public
procedure LoadFromFile(const FileName: AnsiString);
procedure SaveToFile(const FileName: AnsiString);
end;
TIniFileKey = class
Private
FIdent: Utf8String;
FValue: Utf8String;
public
constructor Create(const AIdent, AValue: Utf8String);
property Ident: Utf8String read FIdent write FIdent;
property Value: Utf8String read FValue write FValue;
end;
TIniFileKeyList = class(TList)
private
function GetItem(Index: integer): TIniFileKey;
function KeyByName(const AName: Utf8String; CaseSensitive : Boolean): TIniFileKey;
public
destructor Destroy; override;
procedure Clear; override;
property Items[Index: integer]: TIniFileKey read GetItem; default;
end;
TIniFileSection = class
private
FName: Utf8String;
FKeyList: TIniFileKeyList;
public
Function Empty : Boolean;
constructor Create(const AName: Utf8String);
destructor Destroy; override;
property Name: Utf8String read FName;
property KeyList: TIniFileKeyList read FKeyList;
end;
TIniFileSectionList = class(TList)
private
function GetItem(Index: integer): TIniFileSection;
function SectionByName(const AName: Utf8String; CaseSensitive : Boolean): TIniFileSection;
public
destructor Destroy; override;
procedure Clear;override;
property Items[Index: integer]: TIniFileSection read GetItem; default;
end;
{ TCustomIniFile }
TCustomIniFile = class
Private
FFileName: Utf8String;
FSectionList: TIniFileSectionList;
FEscapeLineFeeds: boolean;
FCaseSensitive : Boolean;
FStripQuotes : Boolean;
public
constructor Create(const AFileName: AnsiString; AEscapeLineFeeds : Boolean = False); virtual;
destructor Destroy; override;
function SectionExists(const Section: Utf8String): Boolean; virtual;
function ReadString(const Section, Ident, Default: Utf8String): Utf8String; virtual; abstract;
procedure WriteString(const Section, Ident, Value: String); virtual; abstract;
function ReadInteger(const Section, Ident: Utf8String; Default: Longint): Longint; virtual;
procedure WriteInteger(const Section, Ident: Utf8String; Value: Longint); virtual;
function ReadInt64(const Section, Ident: Utf8String; Default: Int64): Longint; virtual;
procedure WriteInt64(const Section, Ident: Utf8String; Value: Int64); virtual;
function ReadBool(const Section, Ident: Utf8String; Default: Boolean): Boolean; virtual;
procedure WriteBool(const Section, Ident: Utf8String; Value: Boolean); virtual;
function ReadDate(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadDateTime(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadFloat(const Section, Ident: Utf8String; Default: Double): Double; virtual;
function ReadTime(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadBinaryStream(const Section, Name: Utf8String; Value: TStream): Integer; virtual;
procedure WriteDate(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteDateTime(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteFloat(const Section, Ident: Utf8String; Value: Double); virtual;
procedure WriteTime(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteBinaryStream(const Section, Name: Utf8String; Value: TStream); virtual;
procedure ReadSection(const Section: Utf8String; Strings: TStrings); virtual; abstract;
procedure ReadSections(Strings: TStrings); virtual; abstract;
procedure ReadSectionValues(const Section: Utf8String; Strings: TStrings); virtual; abstract;
procedure EraseSection(const Section: Utf8String); virtual; abstract;
procedure DeleteKey(const Section, Ident: String); virtual; abstract;
procedure UpdateFile; virtual; abstract;
function ValueExists(const Section, Ident: Utf8String): Boolean; virtual;
property FileName: Utf8String read FFileName;
property EscapeLineFeeds: boolean read FEscapeLineFeeds;
Property CaseSensitive : Boolean Read FCaseSensitive Write FCaseSensitive;
Property StripQuotes : Boolean Read FStripQuotes Write FStripQuotes;
end;
{ TIniFile }
TIniFile = class(TCustomIniFile)
Private
FStream: TStream;
FCacheUpdates: Boolean;
FDirty : Boolean;
FBOM : String;
procedure FillSectionList(AStrings: TStrings);
Procedure DeleteSection(ASection : TIniFileSection);
Procedure MaybeDeleteSection(ASection : TIniFileSection);
procedure SetCacheUpdates(const AValue: Boolean);
protected
procedure MaybeUpdateFile;
property Dirty : Boolean Read FDirty;
public
constructor Create(const AFileName: AnsiString; AEscapeLineFeeds : Boolean = False); overload; override;
constructor Create(AStream: TStream; AEscapeLineFeeds : Boolean = False); overload;
destructor Destroy; override;
function ReadString(const Section, Ident, Default: Utf8String): Utf8String; override;
procedure WriteString(const Section, Ident, Value: String); override;
procedure ReadSection(const Section: Utf8String; Strings: TStrings); override;
procedure ReadSectionRaw(const Section: Utf8String; Strings: TStrings);
procedure ReadSections(Strings: TStrings); override;
procedure ReadSectionValues(const Section: Utf8String; Strings: TStrings); override;
procedure EraseSection(const Section: Utf8String); override;
procedure DeleteKey(const Section, Ident: String); override;
procedure UpdateFile; override;
property Stream: TStream read FStream;
property CacheUpdates : Boolean read FCacheUpdates write SetCacheUpdates;
end;
TMemIniFile = class(TIniFile)
public
constructor Create(const AFileName: AnsiString; AEscapeLineFeeds : Boolean = False); overload; override;
procedure Clear;
procedure GetStrings(List: TStrings);
procedure Rename(const AFileName: Utf8String; Reload: Boolean);
procedure SetStrings(List: TStrings);
end;
{
This is a temporary fix for the classes unit for FPC 3.0.0
}
type
TFileStream = class(classes.THandleStream)
Private
FFileName : UnicodeString;
public
constructor Create(const AFileName: UnicodeString; Mode: Word);
constructor Create(const AFileName: UnicodeString; Mode: Word; Rights: Cardinal);
destructor Destroy; override;
property FileName : UnicodeString Read FFilename;
end;
{ utf-8 string list}
TStringList = class(classes.TStringList)
public
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure LoadFromFile(const FileName: UnicodeString);
procedure SaveToFile(const FileName: UnicodeString);
end;
{ utf-8 ini file }
TIniFileKey = class
Private
FIdent: Utf8String;
FValue: Utf8String;
public
constructor Create(const AIdent, AValue: Utf8String);
property Ident: Utf8String read FIdent write FIdent;
property Value: Utf8String read FValue write FValue;
end;
TIniFileKeyList = class(TList)
private
function GetItem(Index: integer): TIniFileKey;
function KeyByName(const AName: Utf8String; CaseSensitive : Boolean): TIniFileKey;
public
destructor Destroy; override;
procedure Clear; override;
property Items[Index: integer]: TIniFileKey read GetItem; default;
end;
TIniFileSection = class
private
FName: Utf8String;
FKeyList: TIniFileKeyList;
public
Function Empty : Boolean;
constructor Create(const AName: Utf8String);
destructor Destroy; override;
property Name: Utf8String read FName;
property KeyList: TIniFileKeyList read FKeyList;
end;
TIniFileSectionList = class(TList)
private
function GetItem(Index: integer): TIniFileSection;
function SectionByName(const AName: Utf8String; CaseSensitive : Boolean): TIniFileSection;
public
destructor Destroy; override;
procedure Clear;override;
property Items[Index: integer]: TIniFileSection read GetItem; default;
end;
{ TCustomIniFile }
TCustomIniFile = class
Private
FFileName: Utf8String;
FSectionList: TIniFileSectionList;
FEscapeLineFeeds: boolean;
FCaseSensitive : Boolean;
FStripQuotes : Boolean;
public
constructor Create(const AFileName: UnicodeString; AEscapeLineFeeds : Boolean = False); virtual;
destructor Destroy; override;
function SectionExists(const Section: Utf8String): Boolean; virtual;
function ReadString(const Section, Ident, Default: Utf8String): Utf8String; virtual; abstract;
procedure WriteString(const Section, Ident, Value: String); virtual; abstract;
function ReadInteger(const Section, Ident: Utf8String; Default: Longint): Longint; virtual;
procedure WriteInteger(const Section, Ident: Utf8String; Value: Longint); virtual;
function ReadInt64(const Section, Ident: Utf8String; Default: Int64): Longint; virtual;
procedure WriteInt64(const Section, Ident: Utf8String; Value: Int64); virtual;
function ReadBool(const Section, Ident: Utf8String; Default: Boolean): Boolean; virtual;
procedure WriteBool(const Section, Ident: Utf8String; Value: Boolean); virtual;
function ReadDate(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadDateTime(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadFloat(const Section, Ident: Utf8String; Default: Double): Double; virtual;
function ReadTime(const Section, Ident: Utf8String; Default: TDateTime): TDateTime; virtual;
function ReadBinaryStream(const Section, Name: Utf8String; Value: TStream): Integer; virtual;
procedure WriteDate(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteDateTime(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteFloat(const Section, Ident: Utf8String; Value: Double); virtual;
procedure WriteTime(const Section, Ident: Utf8String; Value: TDateTime); virtual;
procedure WriteBinaryStream(const Section, Name: Utf8String; Value: TStream); virtual;
procedure ReadSection(const Section: Utf8String; Strings: TStrings); virtual; abstract;
procedure ReadSections(Strings: TStrings); virtual; abstract;
procedure ReadSectionValues(const Section: Utf8String; Strings: TStrings); virtual; abstract;
procedure EraseSection(const Section: Utf8String); virtual; abstract;
procedure DeleteKey(const Section, Ident: String); virtual; abstract;
procedure UpdateFile; virtual; abstract;
function ValueExists(const Section, Ident: Utf8String): Boolean; virtual;
property FileName: Utf8String read FFileName;
property EscapeLineFeeds: boolean read FEscapeLineFeeds;
Property CaseSensitive : Boolean Read FCaseSensitive Write FCaseSensitive;
Property StripQuotes : Boolean Read FStripQuotes Write FStripQuotes;
end;
{ TIniFile }
TIniFile = class(TCustomIniFile)
Private
FStream: TStream;
FCacheUpdates: Boolean;
FDirty : Boolean;
FBOM : String;
procedure FillSectionList(AStrings: TStrings);
Procedure DeleteSection(ASection : TIniFileSection);
Procedure MaybeDeleteSection(ASection : TIniFileSection);
procedure SetCacheUpdates(const AValue: Boolean);
protected
procedure MaybeUpdateFile;
property Dirty : Boolean Read FDirty;
public
constructor Create(const AFileName: UnicodeString; AEscapeLineFeeds : Boolean = False); overload; override;
constructor Create(AStream: TStream; AEscapeLineFeeds : Boolean = False); overload;
destructor Destroy; override;
function ReadString(const Section, Ident, Default: Utf8String): Utf8String; override;
procedure WriteString(const Section, Ident, Value: String); override;
procedure ReadSection(const Section: Utf8String; Strings: TStrings); override;
procedure ReadSectionRaw(const Section: Utf8String; Strings: TStrings);
procedure ReadSections(Strings: TStrings); override;
procedure ReadSectionValues(const Section: Utf8String; Strings: TStrings); override;
procedure EraseSection(const Section: Utf8String); override;
procedure DeleteKey(const Section, Ident: String); override;
procedure UpdateFile; override;
property Stream: TStream read FStream;
property CacheUpdates : Boolean read FCacheUpdates write SetCacheUpdates;
end;
TMemIniFile = class(TIniFile)
public
constructor Create(const AFileName: UnicodeString; AEscapeLineFeeds : Boolean = False); overload; override;
procedure Clear;
procedure GetStrings(List: TStrings);
procedure Rename(const AFileName: Utf8String; Reload: Boolean);
procedure SetStrings(List: TStrings);
end;
function TGenericAsset.Devour(c: TGenericAsset): boolean;
begin
f_props:= c.AssetProperties;
f_hash:= c.Hash;
Result:= true;
end;
function THandleAsset.Devour(c: TGenericAsset): boolean;
begin
Self._handle:= (c as THandleAsset).Handle;
Result:= inherited Devour(c);
end;
procedure TGenericAsset.AfterLoading;
var
Counterpart: TGenericAsset;
begin
if gv_RetrievingFromMother then Exit; //loading stored assets
//from module ci stream. Do nothing;
if Assigned(gv_RetrievedAssets)
then Counterpart:= gv_RetrievedAssets.GetByHash(@Hash)
else Counterpart:= nil;
//if Assigned(Counterpart) then AddLog('** %0', [TellInvalidAsset(Counterpart)]);
//bgSay(PervertedFormat('* %0.AfterLoading : Counterpart=%1', [string(Self.ClassName), pointer(counterpart)]));
//if Assigned(counterpart) then
//bgSay(PervertedFormat(' Counterpart=%0', [string(Counterpart.ClassName)]));
if Assigned(Counterpart)
//Counterpart.Exists
//and Counterpart.IsValid //Fuck! It could be *not* valid due to lacking
//some non-saveable derivative objects (like TMotherStream and such.
//Because of that, Counterpart.Actualized() returns false.
//Imma fucking idiot :(
and (ap_actualized in Counterpart.AssetProperties)
then begin
if Mother^.Debug.Verbose then AddLog(' %0.AfterLoading: devouring the retrieved counterpart %1 with hash %2', [string(ClassName), pointer(Counterpart), HashToHex(Hash)]);
if Devour(Counterpart) //copy its fields *including* the ap_actualized flag!
then begin
f_props-= [ap_unclaimed];
if Mother^.Debug.Verbose then AddLog(' ..devoured');
Counterpart.EraseContainer;
end
else begin
if Mother^.Debug.Verbose then AddLog(' ..failed');
EraseContainer; //handles and such are
// always zeroed out when loading session. Previously, this was done via
// skippable fields. But since I switched to using Chepersy for storing
// entire assets in the mother stream, that is just plain not possible.
//actualization is now *stored* in the session as it is a part of a set
// (previously it wasn't because it was a skipped field).
//EraseContainer erases it too.
end;
end
else begin
if Mother^.Debug.Verbose then begin
if Assigned(Counterpart)
then AddLog(' %0.AfterLoading: the counterpart for hash %1 is not valid (%2)',[string(ClassName), HashToHex(Hash), TellInvalidAsset(Counterpart)])
else AddLog(' %0.AfterLoading: no counterpart retrieved for hash %1.',[string(ClassName), HashToHex(Hash)]);
end;
EraseContainer;
end;
{Old version for comparison:
pr: PAssetRecord;
pr:= Mother^.AssetKeeper.Claim(@Hash);
AfterEfCheck; //throw an exception if there was an error
if Assigned(pr) then begin
// The handle could have changed, for example the texture
// we created during the yesterday session from the same image
// (thus the same hash) had different index in OpenGL.
// So we reload it with the value received from the mother module.
_handle:= pr^.Handle;
FActualized:= true;
end;
}
// end;
//bgsay(' 4');
// end;
//Actualized() can be checking a shitload of other things
// besides (ap_actualized in f_props), so beware.
if not Actualized then MyLogClass.AddNonActualizedAsset(Self);
//bgsay(' 5');
end;
function TChepersyObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
if ((CpsMask and CPS_NO_INTERLOCK_MASK) > 0) and not ForceInterlock
then begin
Dec(f_RefCount); Result:= f_RefCount;
end
else
Result:= interlockeddecrement(f_RefCount);
if Result = 0 then Self.OnZeroReferenceCount;
end;
procedure TChepersyObject.OnZeroReferenceCount;
begin
Self.Destroy;
end;
procedure TGenericAsset.OnZeroReferenceCount;
begin
if not Self.MustBeFreedFromMainThread()
or (GetCurrentThreadId() = Mother^.State.MainThreadId)
then inherited //cal Destroy
else begin
EnterWv(TAssetManager.ToDeleteInMainThreadCS); //wrapper to allow the thread load indicator profiling this
if not Assigned(TAssetManager.ToDeleteInMainThread)
then TAssetManager.ToDeleteInMainThread:= TAssetContainer.Create;
TAssetManager.ToDeleteInMainThread.Add(Self); //refcount is 1 again
TAssetManager.ToDeleteInMainThreadCS.Leave;
end;
end;
function TGenericAsset.MustBeFreedFromMainThread: boolean;
begin
Result:= false
end;
function TTexture.MustBeFreedFromMainThread: boolean; begin Result:= True end;
class procedure TAssetManager.Pulse;
var
q: qword;
i, t, c : integer;
begin
if Assigned(ToDeleteInMainThread) then begin
EnterWv(TAssetManager.ToDeleteInMainThreadCS);
t:= Length(ToDeleteInMainThread.List);
if (Mother^.Debug.Verbose) then begin
AddLog(' Delayed deleting of %0 assets in the main thread...', [t]);
Mother^.Timer.UsecDelta(@q); // Not free anymore. On an ARM platform it can take up to a microsecond.
end;
for i:= 0 to High(ToDeleteInMainThread.List) do
ToDeleteInMainThread.List[i]:= nil; //will deadlock the CS if this is not the main thread
if (Mother^.Debug.Verbose) then AddLog(' Deleted %0 delayed assets in %1µs',[t, round(Mother^.Timer.UsecDelta(@q))]);
ToDeleteInMainThread:= nil;
ToDeleteInMainThreadCS.Leave;
end;
//For *now*, just delete them at once, assuming that the cost of
// freeing whatever is negligible.
//***TODO: benchmark and optimize the shit out of this if needed.
if Assigned(Retrieved) then begin
t:= Length(Retrieved.List);
if (Mother^.Debug.Verbose) then begin
AddLog(' Deleting %0 unclaimed assets...', [t]);
Mother^.Timer.UsecDelta(@q); // Not free anymore. On an ARM platform it can take up to a microsecond.
end;
c:=0;
for i:= 0 to High(Retrieved.List) do
if Assigned(Retrieved.List[i]) then with Retrieved.List[i] do begin
//if not Exists then continue;
if Actualized
then begin
if (Mother^.Debug.Verbose) then AddLog(' ..deleting %0', [string(ClassName)]);
c+= 1;
end;
Retrieved.List[i]:= nil;
end;
if (Mother^.Debug.Verbose) then AddLog(' Deleted %0 unclaimed assets in %1µs',[c, round(Mother^.Timer.UsecDelta(@q))]);
Retrieved:= nil;
end;
end;
Cheb писал(а):Так, а зачем мне вообще нужна мегатекстура? Для условно-неограниченных декалей. Элементы декора разные, уляпывание стен (см. Brutal DooM: стилистика замечательная, но тормозит страшно. А с мегатекстурой не тормозило бы:
Cheb писал(а):...как создавался рендер первого квейка... И да, в первом квейке не было уляпывания стен кровью только от того, что мужики спешили. ...на лету создавалась уникальная текстура из наложенной базовой текстуры, предумноженной на лайтмапу. Декали добавить было бы - как два пальца об асфальт. Причём, на цене основного рендеринга вообще не сказалось бы (цена равна нулю), замедлилась бы только генерация этих динамических текстур - а она происходит не каждый кадр, только при заметном смещении камеры или изменении освещения.
Cheb писал(а):Управление будет "ну-ка, големы, быстро воткнули мне типовой домик вот здесь" (привет от RTS)
в больших комнатах (с большим количеством гуро), всё бы начинало либо тормозить, либо чудесным образом пропадать.
Вернуться в Разработки на нашем сайте
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 7