Cheb писал(а):Виндовс - это обязательный компонент нормального пека, и стоит соответственно.
Я про то что зачем покупали .
Модератор: Модераторы
DYUMON » 04.03.2020 05:32:55
Cheb писал(а):Виндовс - это обязательный компонент нормального пека, и стоит соответственно.
Cheb » 04.03.2020 13:36:35
{$else unix}
var
M: THandle = 0;
function ThisIsAnOnlyInstance: boolean;
var
N: Utf8String;
d: dword;
begin
if M <> 0 then Result:= Yes
else begin
N:= Utf8Encode(ChangeFileExt(ExtractFileName(ParamStr(0)),'')
+ 'SingleInstanceMutex');
if Mother^.State.IsServer
then N+= Utf8Encode('_srv_' + Mother^.State.ServerModuleName);
M:= OpenMutexA(MUTEX_MODIFY_STATE or SYNCHRONIZE, False, PAnsiChar(N));
if M = 0 then begin
M:= CreateMutexA(nil, True, PAnsiChar(N));
Result:= Yes;
end
else begin
d:= WaitForSingleObject(M, 0);
Result:= d <> WAIT_TIMEOUT;
if not Result then M:= 0; // allow another attempt
end;
end;
end;
{$endif unix}
Cheb » 06.03.2020 21:10:33
{$LANGUAGE RU()|GRCA_NOMINATIVE,,кто_что\GRCA_GENITIVE,,кого_чего\GRCA_DATIVE,,кому_чему\GRCA_ACCUSATIVE,GRCA_GENITIVE,кого_что\GRCA_INSTRUMENTAL,,кем_чем\8,,о_ком_о_чём}
{$LANGUAGE EN()|}
{$LANGUAGE DE(EN)|GRCA_NOMINATIVE,,Nominativ\GRCA_GENITIVE,,Genitiv\GRCA_DATIVE,,Dativ\GRCA_ACCUSATIVE,,Akkusativ}
{$LANGUAGE ES(EN)|GRCA_NOMINATIVE,,Nominativo\GRCA_ACCUSATIVE,,Acusativo\GRCA_DATIVE,,Dativo\GRCA_GENITIVE,,Genitivo\8,,Disyuntivo}
Alex2013 » 09.03.2020 18:13:52
Cheb писал(а):Ну и "экран" размером "со стену дома" конкретно под "нативную" Sony PS 2 тоже "то еще зрелище из старых блокбастеров"
Абсолютный эпик
Cheb писал(а):Я почти, почти уже доделал - когда зацепился за механизм локализации и соответствующий API. Понадобилось.. нгх... добавить.. всего... одну.. гх.. ААА, я не могу! Это сраное говно мозолило мне глаза годами, раздражая, бросая вызов своей убивищной корявостью! Всё! В ады! В переделку!
А тут такой облом ... Cheb » 10.03.2020 11:40:07
(Типа: что будет делать миллионер впав в детство?)
Примерно так я это и представлял... Но не с таким размахом.А тут такой облом ...
Cheb » 14.03.2020 02:24:46
{$ifdef cpu64}
function UnpackDwordToChepersyObjectReference (
d: dword): TChepersyObject; inline;
var chunk: TChepersyMemoryManagerChunk;
begin
if d = 0 then Result:= nil
else begin
chunk:= TChepersyMemoryManagerChunk(
CpsMemoryManager.CIdx2Chunk[d shr 16]);
Assert(Assigned(chunk)
, 'Failed to unpack a dword to an object reference: no such memory manager chunk!');
Result:= TChepersyObject(pointer(qword(
qword(pointer(chunk)) + qword(d and $0000ffff) shl CpsMMAllocGranPoT
)))
end;
end;
function PackChepersyObjectReferenceToDword (
o: TChepersyObject): dword; inline;
var chunk: TChepersyMemoryManagerChunk;
begin
if not Assigned(o) then Result:= 0
else begin
chunk:= o.GetMemoryManagerChunk;
Result:= (dword(chunk.CIdx) shl 16)
or (dword(qword(pointer(o)) - qword(pointer(chunk)))
shr CpsMMAllocGranPoT);
end;
end;
{$else cpu64}
// dumb type-casts on the 32-bit platforms
function UnpackDwordToChepersyObjectReference (d: dword): TChepersyObject; inline;
begin
Result:= TChepersyObject(pointer(d));
end;
function PackChepersyObjectReferenceToDword (o: TChepersyObject): dword; inline;
begin
Result:= dword(pointer(o));
end;
{$endif cpu64} Cheb » 17.03.2020 17:48:07
Что-то я делаю не так. скалогрыз » 17.03.2020 20:27:16
Cheb писал(а):.Ы. Похоже, виснет моя функция формата, причём, конкретно на обработке числительных.
Почему со старыми версиями компилятора не висло? Что-то я делаю не так.
Cheb » 17.03.2020 20:49:34
То есть, фпц 3.3.1 для x86 не использует SEH?.. Что он тогда использует-то?.. Завези отдельные тесты для функции формата,
Cheb » 20.03.2020 02:20:34
runewalsh » 20.03.2020 17:01:46
Cheb » 20.03.2020 19:09:20
{$codepage utf8} или BOM я не использую ещё и по той причине, что они превращают литералы с символами вне 7-битной ASCII в widestring'и.
{$if FPC_FULLVERSION>=30000}
SetMultiByteConversionCodePage(CP_UTF8);
SetMultiByteRTLFileSystemCodePage(CP_UTF8);
{$endif} {$ifdef unix} //utf-8 assumed
function AnsiToUtf16(a: AnsiString): Utf16String;
begin
Result:= Utf8Decode(a);
end;
{$else}
function AnsiToUtf16(a: AnsiString): Utf16String;
var
i: integer;
begin
if a='' then Exit('')
else
{$ifdef CGE_PLATFORM_HAS_WINDOWS98}
if (Mother^.State.OS in [ostWin98])
and Mother^.State.Windows98.DoesNotSupportUnicode
then Result:= Cp1251ToUtf16(a) // assuming Russian/CP1251
else
{$endif}
begin
i:= MultiByteToWideChar(
CP_ACP, MB_PRECOMPOSED, @a[1], length(a), nil, 0);
if i > 0 then begin
SetLength(Result, i);
MultiByteToWideChar(
CP_ACP, MB_PRECOMPOSED, @a[1], length(a), @Result[1], i);
end
else begin
if Mother^.State.OS in [ostWin98, ostWin2k]
then Result:= Cp1251ToUtf16(a)
else Die('MultiByteToWideChar() failed!');
end;
end;
end;
{$endif}
{$endif}program thrtesta;
{$mode objfpc}
{$apptype console}
{$longstrings on}
uses
{$ifdef unix}
cthreads,
{$endif}
SysUtils,
Classes
{$ifdef unix}
, dl
{$else}
, windows
{$endif}
;
type
TTestThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TTestThread.Execute;
begin
WriteLn('> A');
try
byte(nil^):= 0;
except
WriteLn('exe thread ID=',GetCurrentThreadId()
,' catch: ',(ExceptObject as Exception).Message);
end;
WriteLn('< A');
end;
function PCharToString(P: PAnsiChar): Utf8String;
var
i: integer;
p2: PAnsiChar;
begin
if not Assigned(p) then Result:= ''
else begin
p2:= p;
i:= 0;
While p2^ <> #0 do begin
inc(p2);
inc(i);
end;
SetLength(Result, i);
MOVE(p^, Result[1], i);
end;
end;
var
t: TTestThread;
dllhandle: {$ifdef unix} pointer {$else} THandle {$endif};
mypath: string;
{$ifdef unix}
ufn, upn: Utf8String;
{$else}
wfn: UnicodeString;
wpn: AnsiString;
{$endif}
thrproc: procedure; cdecl = nil;
begin
WriteLn('the exe is built using fpc '
,{$I %FPCVERSION%},'/',{$I %FPCTARGETOS%},'/',{$I %FPCTARGETCPU%});
WriteLn('main thread ID=', GetCurrentTHreadId());
t := TTestThread.Create(False);
WriteLn('exe thread created');
try
t.WaitFor;
finally
t.Free;
end;
WriteLn('exe thread terminated');
WriteLn('loading the DLL...');
mypath:= ExtractFilePath(ParamStr(0))
+ {$ifdef unix} 'libthrtestb.so' {$else} 'thrtestb.dll' {$endif};
WriteLn('path is ', mypath);
{$ifdef unix}
ufn:= mypath;
dllhandle:= dlopen(PAnsiChar(nu8), RTLD_NOW);
if not Assigned(DLL) then begin
WriteLn('failed to load: ',PCharToString(dlerror()));
Halt(0);
end;
upn:= 'thrproc';
pointer(thrproc):= dlsym(dllhandle, PAnsiChar(upn));
{$else}
wfn:= mypath;
SetLastError(0);
dllhandle:= LoadLibraryW(PUcs2Char(wfn));
if dllhandle = 0 then begin
WriteLn('failed to load.');
Halt(0);
end;
wpn:= 'thrproc';
pointer(thrproc):= windows.GetProcAddress(dllhandle, PAnsiChar(wpn));
{$endif}
if not Assigned(pointer(thrproc)) then begin
WriteLn('failed to load the procedure.');
Halt(0);
end;
WriteLn('invoking the dll...');
try
thrproc;
except
WriteLn('exe thread ID=',GetCurrentThreadId()
,' catch: ',(ExceptObject as Exception).Message);
end;
WriteLn('unloading the dll...');
{$ifdef unix}
dlClose(dllhandle);
{$else}
FreeLibrary(dllhandle);
{$endif}
WriteLn('done.');
end.library thrtestb;
{$mode objfpc}
{$apptype console}
{$longstrings on}
uses
{$ifdef unix}
cthreads,
{$endif}
SysUtils,
Classes;
type
TTestThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TTestThread.Execute;
begin
WriteLn('> X');
try
WriteLn('> Y');
try
WriteLn('> Z');
try
byte(nil^):= 0;
except
WriteLn('dll thread ID=',GetCurrentThreadId()
,' catch in block Z: ',(ExceptObject as Exception).Message);
end;
WriteLn('< Z');
except
WriteLn('dll thread ID=',GetCurrentThreadId()
,' catch in block Y: ',(ExceptObject as Exception).Message);
end;
WriteLn('< Y');
except
WriteLn('dll thread ID=',GetCurrentThreadId()
,' catch in block X: ',(ExceptObject as Exception).Message);
end;
WriteLn('< X');
end;
procedure MyMainProc; cdecl;
var t: TThread;
begin
WriteLn('the dll is built using fpc '
,{$I %FPCVERSION%},'/',{$I %FPCTARGETOS%},'/',{$I %FPCTARGETCPU%});
try
t := TTestThread.Create(False);
WriteLn('dll thread created');
try
t.WaitFor;
finally
t.Free;
end;
except
WriteLn('dll thread ID=',GetCurrentThreadId()
,' catch in main proc: ',(ExceptObject as Exception).Message);
end;
WriteLn('the dll is done.')
end;
exports
MyMainProc name 'thrproc';
begin
// do nothing.
// The initialization sections DO NOT WORK in Linux for DLLs. And never will.
end.the exe is built using fpc 3.0.4/Win32/i386
main thread ID=6444
exe thread created
> A
exe thread ID=6736 catch: Access violation
< A
exe thread terminated
loading the DLL...
path is d:chentrahmodulesteststhrtestb.dll
invoking the dll...
the dll is built using fpc 3.0.4/Win32/i386
dll thread created
> X
> Y
> Z
An unhandled exception occurred at $1000165F:
EAccessViolation: Access violation
$1000165F
$100173C5
$1000BE1E
$75E6343D
$76F39802
$76F397D5
the exe is built using fpc 2.6.4/Win32/i386
main thread ID=780
exe thread created
> A
exe thread ID=6232 catch: Access violation
< A
exe thread terminated
loading the DLL...
path is d:chentrahmodulesteststhrtestb.dll
invoking the dll...
the dll is built using fpc 3.3.1/Win32/i386
dll thread created
> X
> Y
> Z
dll thread ID=6076 catch in block Z: Access violation
< Z
< Y
< X
the dll is done.
unloading the dll...
done.
try
Найти шкаф;
try
Открыть дверцу;
try
Взять варенье;
try
Открыть банку;
except
Die('Банка хряпнулась :(... ');
end;
except
Die('Варенью йок.');
end;
except
Die('Трагедия при открытии шкафа!');
end;
except
Die('Шкаф упал!');
end;
Сквозняк » 13.04.2020 21:09:21
Seenkao » 14.04.2020 14:37:14
Cheb » 21.04.2020 14:34:07
Автором этого сообщения является Сквозняк, находящийся в вашем чёрном списке. Показать это сообщение.
Но... запуская демку, на i5... и фпс скачет 27-40 (в основном 27)...
Вернуться в Разработки на нашем сайте
Сейчас этот форум просматривают: Google [Bot] и гости: 1