pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

git-svn-id: https://svn.code.sf.net/p/kolmck/code@23 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

Browse Source
This commit is contained in:
dkolmck
2009-09-07 12:32:23 +00:00
parent af5a06d345
commit ab9cb7bae9
1 changed files with 22 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
System/D2006beta/System.pas
View File

@ -43,7 +43,7 @@ interface
Example: {$IF RTLVersion >= 16.2} ... {$IFEND} *) Example: {$IF RTLVersion >= 16.2} ... {$IFEND} *)
const const
RTLVersion = 14.1; RTLVersion = 18.00;
{$EXTERNALSYM CompilerVersion} {$EXTERNALSYM CompilerVersion}
@ -2887,9 +2887,9 @@ begin
MemoryManager := MemMgr; MemoryManager := MemMgr;
end; end;
//{X} - function is replaced with pointer to one. {X+}// - function is replaced with pointer to one.
// function IsMemoryManagerSet: Boolean; {X-}// function IsMemoryManagerSet: Boolean;
function IsDelphiMemoryManagerSet: Boolean; {X+}function IsDelphiMemoryManagerSet: Boolean;
begin begin
with MemoryManager do with MemoryManager do
Result := (@GetMem <> @SysGetMem) or (@FreeMem <> @SysFreeMem) or Result := (@GetMem <> @SysGetMem) or (@FreeMem <> @SysFreeMem) or
@ -3033,6 +3033,8 @@ asm
POP EAX POP EAX
end; end;
// Access to a TLS variable. Note the comment in BeginThread before
// you change the implementation of this function.
function AreOSExceptionsBlocked: Boolean; function AreOSExceptionsBlocked: Boolean;
asm asm
CALL SysInit.@GetTLS CALL SysInit.@GetTLS
@ -3227,7 +3229,7 @@ procedure ErrorAt(ErrorCode: Byte; ErrorAddr: Pointer);
const const
reMap: array [TRunTimeError] of Byte = ( reMap: array [TRunTimeError] of Byte = (
0, 0, { reNone }
203, { reOutOfMemory } 203, { reOutOfMemory }
204, { reInvalidPtr } 204, { reInvalidPtr }
200, { reDivByZero } 200, { reDivByZero }
@ -3675,7 +3677,7 @@ asm
@@fin: @@fin:
*) {X-} *) {X-}
//--------------------------------------- {X+} //---------------------------------------
{X+} // And now, let us write speedy: {X+} // And now, let us write speedy:
CMP ECX, 4 CMP ECX, 4
JGE @@long JGE @@long
@ -9732,7 +9734,7 @@ end;
as a signaling mechanism to an interested debugger. If the debugger sets as a signaling mechanism to an interested debugger. If the debugger sets
the DebugHook flag to 1 or 2, then all exception processing is tracked by the DebugHook flag to 1 or 2, then all exception processing is tracked by
raising these special exceptions. The debugger *MUST* respond to the raising these special exceptions. The debugger *MUST* respond to the
debug event with DBG_CONTINE so that normal processing will occur. debug event with DBG_CONTINUE so that normal processing will occur.
} }
{$IFDEF LINUX} {$IFDEF LINUX}
@ -11124,10 +11126,10 @@ end;
procedure SetExceptionHandler; procedure SetExceptionHandler;
asm asm
XOR EDX,EDX { using [EDX] saves some space over [0] } XOR EDX,EDX { using [EDX] saves some space over [0] }
{X} // now we come here from another place, and EBP is used above for loop counter {X+} // now we come here from another place, and EBP is used above for loop counter
{X} // let us restore it... {X+} // let us restore it...
{X} PUSH EBP {X+} PUSH EBP
{X} LEA EBP, [ESP + $50] {X+} LEA EBP, [ESP + $50]
LEA EAX,[EBP-12] LEA EAX,[EBP-12]
MOV ECX,FS:[EDX] { ECX := head of chain } MOV ECX,FS:[EDX] { ECX := head of chain }
MOV FS:[EDX],EAX { head of chain := @exRegRec } MOV FS:[EDX],EAX { head of chain := @exRegRec }
@ -11145,8 +11147,7 @@ asm
{$ELSE} {$ELSE}
MOV InitContext.ExcFrame,EAX MOV InitContext.ExcFrame,EAX
{$ENDIF} {$ENDIF}
{X+} POP EBP
{X} POP EBP
end; end;
@ -11467,7 +11468,7 @@ asm
LEA ECX,[EBP- (type TExcFrame) - (type TInitContext)] LEA ECX,[EBP- (type TExcFrame) - (type TInitContext)]
MOV InitContext.OuterContext,ECX MOV InitContext.OuterContext,ECX
XOR ECX,ECX XOR ECX,ECX
CMP dword ptr [EBP+12],0 CMP DWORD PTR [EBP+12],0
JNE @@notShutDown JNE @@notShutDown
MOV ECX,[EAX].PackageInfoTable.UnitCount MOV ECX,[EAX].PackageInfoTable.UnitCount
@@notShutDown: @@notShutDown:
@ -12183,9 +12184,9 @@ type
end; end;
const const
skew = sizeof(StrRec); skew = SizeOf(StrRec);
rOff = sizeof(StrRec); { refCnt offset } rOff = SizeOf(StrRec); { refCnt offset }
overHead = sizeof(StrRec) + 1; overHead = SizeOf(StrRec) + 1;
procedure _LStrClr(var S); procedure _LStrClr(var S);
{$IFDEF PUREPASCAL} {$IFDEF PUREPASCAL}
@ -18965,7 +18966,7 @@ end;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
function LoadResString(ResStringRec: PResStringRec): string; function LoadResString(ResStringRec: PResStringRec): string;
var var
Buffer: array [0..1023] of char; Buffer: array [0..4095] of char;
begin begin
if ResStringRec = nil then Exit; if ResStringRec = nil then Exit;
if ResStringRec.Identifier < 64*1024 then if ResStringRec.Identifier < 64*1024 then