pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

First attempt at adding support for 64-bit compilers.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1416 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
2011-01-01 03:24:10 +00:00
parent 365fa4655e
commit a76e4b4974
8 changed files with 80 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
components/thtmlport/package/ditherunit.pas
View File

@ -225,10 +225,10 @@ end;
procedure Error(msg: string);
function ReturnAddr: Pointer;
// From classes.pas
{$IFNDEF CPUPOWERPC}
{$IFDEF CPU86}
asm
MOV EAX,[EBP+4] // sysutils.pas says [EBP-4] !
{$ELSE} //Ignore for now on non-Intel.
{$ELSE} //Ignore for now on non-Intel/32-bit.
begin
{$ENDIF}
end;
@ -614,7 +614,7 @@ begin
end;
procedure TDIBWriter.CreateDIB;
{$IFDEF PIXELFORMAT_TOO_SLOW}
{$IFDEF PIXELFORMAT_TOO_SLOW} // LCL port: Not defined with LCL to exclude assembler.
var
SrcColors ,
DstColors : WORD;
@ -1131,14 +1131,26 @@ begin
// Move on to next column
if (FDirection = 1) then
begin
{$IFNDEF FPC}
inc(longInt(ErrorR), sizeof(TErrorTerm));
inc(longInt(ErrorG), sizeof(TErrorTerm));
inc(longInt(ErrorB), sizeof(TErrorTerm));
{$ELSE} //Cast so safe for 64-bits.
inc(PtrUInt(ErrorR), sizeof(TErrorTerm));
inc(PtrUInt(ErrorG), sizeof(TErrorTerm));
inc(PtrUInt(ErrorB), sizeof(TErrorTerm));
{$ENDIF}
end else
begin
{$IFNDEF FPC}
dec(longInt(ErrorR), sizeof(TErrorTerm));
dec(longInt(ErrorG), sizeof(TErrorTerm));
dec(longInt(ErrorB), sizeof(TErrorTerm));
{$ELSE}
dec(PtrUInt(ErrorR), sizeof(TErrorTerm));
dec(PtrUInt(ErrorG), sizeof(TErrorTerm));
dec(PtrUInt(ErrorB), sizeof(TErrorTerm));
{$ENDIF}
end;
end;
{$IFDEF R_PLUS}
@ -1635,8 +1647,13 @@ begin
begin
SrcScanline := DIBSource.ScanLine[Row];
DstScanline := DIBResult.ScanLine[Row];
{$IFNDEF FPC}
Src := pointer(longInt(SrcScanLine) + Ditherer.Column*sizeof(TRGBTriple));
Dst := pointer(longInt(DstScanLine) + Ditherer.Column);
{$ELSE}
Src := pointer(PtrUInt(SrcScanLine) + Ditherer.Column*sizeof(TRGBTriple));
Dst := pointer(PtrUInt(DstScanLine) + Ditherer.Column);
{$ENDIF}
while (Ditherer.Column < Ditherer.Width) and (Ditherer.Column >= 0) do
begin

1
components/thtmlport/package/htmlcons.inc
View File

@ -32,6 +32,7 @@
{$ifdef Win32}
{$O-} {optimization off}
{$endif}
{$DEFINE CPU86} // LCL port: Delphi currently only for Intel, 32-bit.
{$endif}
{$ELSE} // LCL

8
components/thtmlport/package/htmlgif2.pas
View File

@ -260,7 +260,11 @@ end;
constructor TgfFrame.CreateCopy(Item: TgfFrame);
begin
inherited Create;
{$IFNDEF FPC}
System.Move(Item.frLeft, frLeft, DWord(@TheEnd)-DWord(@frLeft));
{$ELSE}
System.Move(Item.frLeft, frLeft, PtrUInt(@TheEnd)-PtrUInt(@frLeft));
{$ENDIF}
IsCopy := True;
end;
@ -287,7 +291,11 @@ begin
inherited Create;
FImageWidth := Item.Width;
FimageHeight := Item.Height;
{$IFNDEF FPC}
System.Move(Item.FAnimated, FAnimated, DWord(@TheEnd)-DWord(@FAnimated));
{$ELSE}
System.Move(Item.FAnimated, FAnimated, PtrUInt(@TheEnd)-PtrUInt(@FAnimated));
{$ENDIF}
IsCopy := True;
Frames := TgfFrameList.Create;

27
components/thtmlport/package/htmlmisc.pas
View File

@ -464,6 +464,7 @@ procedure OutputDebugString(lpOutputString: PChar);
function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
function GlobalLock(hMem: HGLOBAL): Pointer;
function GlobalUnlock(hMem: HGLOBAL): BOOL;
function GlobalFree(hMem: HGLOBAL): HGLOBAL;
function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
@ -499,7 +500,6 @@ function PatBlt(DC: HDC; X, Y, Width, Height: Integer; Rop: DWORD): BOOL;
function SetTextJustification(DC: HDC; BreakExtra, BreakCount: Integer): Integer;
function GetBrushOrgEx(DC: HDC; var lppt: TPoint): BOOL;
function SetBrushOrgEx(DC: HDC; X, Y: Integer; PrevPt: PPoint): BOOL;
function GlobalFree(hMem: HGLOBAL): HGLOBAL;
function timeGetTime: DWORD;
function GetTextExtentExPointW(DC: HDC; p2: PWideChar; p3, p4: Integer;
p5, p6: PInteger; var p7: TSize): BOOL;
@ -562,12 +562,11 @@ begin
end;
function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
// Replace with calls to standard Clipboard methods?
begin
{$IFDEF MSWINDOWS}
Result := Windows.GlobalAlloc(uFlags, dwBytes);
{$ELSE}
Result := THandle(GetMem(dwBytes));
Result := HGLOBAL(GetMem(dwBytes)); {Treating pointer to memory as "handle"}
{$ENDIF}
end;
@ -576,7 +575,7 @@ begin
{$IFDEF MSWINDOWS}
Result := Windows.GlobalLock(hMem);
{$ELSE}
Result := PAnsiChar(hMem);
Result := Pointer(hMem); {"Handle" is pointer to memory}
{$ENDIF}
end;
@ -585,11 +584,20 @@ begin
{$IFDEF MSWINDOWS}
Result := Windows.GlobalUnlock(hMem);
{$ELSE}
FreeMem(Pointer(hMem));
Result := True;
{$ENDIF}
end;
function GlobalFree(hMem: HGLOBAL): HGLOBAL;
begin
{$IFDEF MSWINDOWS}
Result := Windows.GlobalFree(hMem);
{$ELSE}
FreeMem(Pointer(hMem)); {"Handle" is pointer to memory}
Result := 0;
{$ENDIF}
end;
function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
{Use control's Perform method to force it to respond to posted message.
This doesn't work: Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam); }
@ -1014,15 +1022,6 @@ begin
{$ENDIF}
end;
function GlobalFree(hMem: HGLOBAL): HGLOBAL;
begin
{$IFDEF MSWINDOWS}
Result := Windows.GlobalFree(hMem);
{$ELSE}
WriteLn('GlobalFree not implemented yet');
{$ENDIF}
end;
function timeGetTime: DWORD;
begin
Result := GetTickCount;

4
components/thtmlport/package/htmlsbs1.pas
View File

@ -260,7 +260,11 @@ end;
constructor THorzLine.CreateCopy(AMasterList: TSectionList; T: TSectionBase);
begin
inherited Create(AMasterList);
{$IFNDEF FPC}
System.Move((T as THorzline).VSize, VSize, DWord(@BkGnd)-DWord(@VSize)+Sizeof(BkGnd));
{$ELSE}
System.Move((T as THorzline).VSize, VSize, PtrUInt(@BkGnd)-PtrUInt(@VSize)+Sizeof(BkGnd));
{$ENDIF}
end;
procedure THorzLine.CopyToClipboard;

24
components/thtmlport/package/htmlsubs.pas
View File

@ -2916,7 +2916,11 @@ end;
constructor TFormControlObj.CreateCopy(T: TFormControlObj);
begin
inherited Create;
{$IFNDEF FPC}
System.Move(T.Pos, Pos, DWord(@FControl)-DWord(@Pos));
{$ELSE}
System.Move(T.Pos, Pos, PtrUInt(@FControl)-PtrUInt(@Pos));
{$ENDIF}
end;
destructor TFormControlObj.Destroy;
@ -4236,7 +4240,11 @@ var
begin
inherited CreateCopy(AMasterList, T);
TT := T as TBlock;
{$IFNDEF FPC}
System.Move(TT.MargArray, MargArray, DWord(@Converted)-DWord(@MargArray)+Sizeof(Converted));
{$ELSE}
System.Move(TT.MargArray, MargArray, PtrUInt(@Converted)-PtrUInt(@MargArray)+Sizeof(Converted));
{$ENDIF}
MyCell := TBlockCell.CreateCopy(AMasterList, TT.MyCell);
MyCell.Owner := Self;
DrawList := TList.Create;
@ -5531,7 +5539,11 @@ var
begin
inherited;
TT := T as TTableBlock;
{$IFNDEF FPC}
System.Move(TT.WidthAttr, WidthAttr, DWord(@Justify)-DWord(@WidthAttr)+Sizeof(Justify));
{$ELSE}
System.Move(TT.WidthAttr, WidthAttr, PtrUInt(@Justify)-PtrUInt(@WidthAttr)+Sizeof(Justify));
{$ENDIF}
Item := MyCell.Items[0];
Table := Item as ThtmlTable;
end;
@ -6104,7 +6116,11 @@ BitmapList := T.BitmapList; {same list}
InlineList := T.InlineList; {same list}
IsCopy := True;
inherited CreateCopy(Self, T);
{$IFNDEF FPC}
System.Move(T.ShowImages, ShowImages, DWord(@Background)-Dword(@ShowImages)+Sizeof(integer));
{$ELSE}
System.Move(T.ShowImages, ShowImages, PtrUInt(@Background)-PtrUInt(@ShowImages)+Sizeof(integer));
{$ENDIF}
BitmapName := '';
BackgroundBitmap := Nil;
BackgroundMask := Nil;
@ -7129,7 +7145,11 @@ constructor TCellObj.CreateCopy(AMasterList: TSectionList; T: TCellObj);
begin
inherited create;
Cell := TCellObjCell.CreateCopy(AMasterList, T.Cell);
{$IFNDEF FPC}
Move(T.ColSpan, ColSpan, DWord(@Cell)-DWord(@ColSpan));
{$ELSE}
Move(T.ColSpan, ColSpan, PtrUInt(@Cell)-PtrUInt(@ColSpan));
{$ENDIF}
if AMasterList.PrintTableBackground then
begin
@ -7835,7 +7855,11 @@ for I := 0 to ThtmlTable(T).Rows.Count-1 do
Rows.Add(TCellList.CreateCopy(AMasterList, TCellList(ThtmlTable(T).Rows.Items[I])));
Move((T as ThtmlTable).ListsProcessed, ListsProcessed,
{$IFNDEF FPC}
DWord(@EndList)-DWord(@ListsProcessed));
{$ELSE}
PtrUInt(@EndList)-PtrUInt(@ListsProcessed));
{$ENDIF}
SetLength(Widths, NumCols);
SetLength(MaxWidths, NumCols);

8
components/thtmlport/package/htmlun2.pas
View File

@ -498,7 +498,7 @@ type
var
DC: HDC;
{$IFNDEF CPUPOWERPC}
{$IFDEF CPU86}
{----------------StrLenW}
function StrLenW(Str: PWideChar): Cardinal;
{returns number of characters in a string excluding the null terminator}
@ -818,7 +818,7 @@ else
end;
end;
{$IFNDEF CPUPOWERPC}
{$IFDEF CPU86}
function IntMin(A, B: Integer): Integer;
asm
cmp edx, eax
@ -3469,7 +3469,11 @@ begin
end;
Inc(x);
end; // scan every sample byte of the image
{$IFNDEF FPC}
Inc(Integer(ScanLinePtr), ScanLineInc);
{$ELSE}
Inc(ScanLinePtr, ScanLineInc); // LCL port: removed cast for 64-bits.
{$ENDIF}
end;
{ need to call ExCreateRegion one more time because we could have left }
{ a RgnData with less than 2000 rects, so it wasn't yet created/combined }

4
components/thtmlport/package/readhtml.pas
View File

@ -327,7 +327,11 @@ case LoadStyle of
end;
else Result := #0; {to prevent warning msg}
end;
{$IFNDEF FPC}
if (Integer(Buff) and $FFF = 0) {about every 4000 chars}
{$ELSE}
if (PtrUInt(Buff) and $FFF = 0) {about every 4000 chars}
{$ENDIF}
and not LinkSearch and Assigned(MasterList) and (DocS <> '') then
ThtmlViewer(CallingObject).htProgress(((Buff-PChar(DocS)) *MasterList.ProgressStart) div (BuffEnd-PChar(DocS)));
end;