paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-24 09:39:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed crashes with ide and 1.9.x

Browse Source
This commit is contained in:
peter 2004-11-02 23:53:19 +00:00
parent 0dbbb1aac0
commit 0eb61a4823
26 changed files with 534 additions and 387 deletions

6
fv/buildfv.pas
View File

@ -8,7 +8,6 @@ interface
uses
fvcommon,
objects,
callspec,
drivers,
fileio,
memory,
@ -38,7 +37,10 @@ implementation
end.
{
$Log$
Revision 1.5 2002-09-07 15:06:36 peter
Revision 1.6 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.5 2002/09/07 15:06:36 peter
* old logs removed and tabs fixed
Revision 1.4 2002/05/29 22:15:19 pierre

15
fv/dialogs.pas
View File

@ -1424,13 +1424,16 @@ END;
PROCEDURE TInputLine.DrawCursor;
VAR I, X: Sw_Integer; S: String;
BEGIN
if (TextModeGFV) then
If (State AND sfFocused <> 0) Then
Begin { Focused window }
if (TextModeGFV) then
begin
Cursor.Y:=0;
Cursor.X:=CurPos-FirstPos+1;
TView.ResetCursor;
ResetCursor;
end
else If (State AND sfFocused <> 0) Then Begin { Focused window }
else
begin
X := TextWidth(LeftArr); { Preset x position }
I := 0; { Preset cursor width }
If (Data <> Nil) Then Begin { Data pointer valid }
@ -1447,6 +1450,7 @@ BEGIN
Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
End;
end;
END;
{--TInputLine---------------------------------------------------------------}
@ -4225,7 +4229,10 @@ END;
END.
{
$Log$
Revision 1.22 2002-10-17 13:27:53 pierre
Revision 1.23 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.22 2002/10/17 13:27:53 pierre
* fix TCluster.Get/SetData on big endian machines
Revision 1.21 2002/10/17 11:24:16 pierre

22
fv/drivers.pas
View File

@ -252,15 +252,15 @@ TYPE
Double: Boolean; { Double click state }
Where: TPoint); { Mouse position }
evKeyDown: (
{ ** KEY EVENT ** }
{ ** KEY EVENT ** }
Case Sw_Integer Of
0: (KeyCode: Word); { Full key code }
1: (
{$ifdef ENDIAN_BIG}
ScanCode: Byte;
CharCode: Char;
{$else not ENDIAN_BIG}
CharCode: Char; { Char code }
ScanCode: Byte;
CharCode: Char;
{$else not ENDIAN_BIG}
CharCode: Char; { Char code }
ScanCode: Byte; { Scan code }
{$endif not ENDIAN_BIG}
KeyShift: byte)); { Shift states }
@ -732,7 +732,7 @@ Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
GetTimeOfDay(tv{,tz});
GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
{$else}
FPGetTimeOfDay(@tv,nil{,tz});
FPGetTimeOfDay(@tv,nil{,tz});
GetDosTicks:=((tv.tv_Sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 54945;
{$endif}
@ -1576,8 +1576,9 @@ VAR ResultLength, FormatIndex, Justify, Wth: Byte; Fill: Char; S: String;
PROCEDURE HandleParameter (I : LongInt);
BEGIN
While (FormatIndex <= Length(Format)) Do Begin { While length valid }
While (Format[FormatIndex] <> '%') AND { Param char not found }
(FormatIndex <= Length(Format)) Do Begin { Length still valid }
While (FormatIndex <= Length(Format)) and
(Format[FormatIndex] <> '%') { Param char not found }
Do Begin { Length still valid }
Result[ResultLength+1] := Format[FormatIndex]; { Transfer character }
Inc(ResultLength); { One character added }
Inc(FormatIndex); { Next param char }
@ -1709,7 +1710,10 @@ BEGIN
END.
{
$Log$
Revision 1.38 2003-10-01 16:20:27 marco
Revision 1.39 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.38 2003/10/01 16:20:27 marco
* baseunix fixes for 1.1
Revision 1.37 2002/10/17 11:22:46 pierre

26
fv/fvcommon.pas
View File

@ -260,7 +260,6 @@ Given two long integers returns the maximum longint of the two.
---------------------------------------------------------------------}
FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
{$IFDEF PPC_DELPHI3} { DELPHI 3+ CODE }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ MISSING DELPHI3 ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -281,7 +280,6 @@ Returns the max free memory block size available under Delphi 3+.
14Aug98 LdB
---------------------------------------------------------------------}
FUNCTION MaxAvail: LongInt;
{$ENDIF}
{***************************************************************************}
{ INITIALIZED PUBLIC VARIABLES }
@ -392,36 +390,28 @@ BEGIN
Else MaxLongIntOf := A; { Else take A }
END;
{$IFDEF PPC_DELPHI3} { DELPHI 3+ CODE }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ MISSING DELPHI3 ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB }
{---------------------------------------------------------------------------}
FUNCTION MemAvail: LongInt;
VAR Ms: TMemoryStatus;
BEGIN
GlobalMemoryStatus(Ms); { Get memory status }
MemAvail := Ms.dwAvailPhys; { Avail physical memory }
{ Unlimited }
MemAvail:=high(longint);
END;
{---------------------------------------------------------------------------}
{ MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB }
{---------------------------------------------------------------------------}
FUNCTION MaxAvail: LongInt;
VAR Ms: TMemoryStatus;
BEGIN
GlobalMemoryStatus(Ms); { Get memory status }
MaxAvail := Ms.dwTotalPhys; { Max physical memory }
{ Unlimited }
MaxAvail:=high(longint);
END;
{$ENDIF}
END.
{
$Log$
Revision 1.5 2003-06-05 14:45:06 peter
Revision 1.6 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.5 2003/06/05 14:45:06 peter
* use Windows THandle
Revision 1.4 2002/09/07 15:06:36 peter

13
fv/menus.pas
View File

@ -1606,6 +1606,7 @@ FUNCTION NewMenu (Items: PMenuItem): PMenu;
VAR P: PMenu;
BEGIN
New(P); { Create new menu }
FillChar(P^,sizeof(TMenu),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Items := Items; { Hold item list }
P^.Default := Items; { Set default item }
@ -1647,10 +1648,9 @@ FUNCTION NewLine (Next: PMenuItem): PMenuItem;
VAR P: PMenuItem;
BEGIN
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next menu item }
P^.Name := Nil; { Clear name ptr }
P^.HelpCtx := hcNoContext; { Clear help context }
End;
NewLine := P; { Return new line }
END;
@ -1664,6 +1664,7 @@ VAR P: PMenuItem; R: TRect; T: PView;
BEGIN
If (Name <> '') AND (Command <> 0) Then Begin
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item }
P^.Name := NewStr(Name); { Hold item name }
@ -1691,11 +1692,10 @@ VAR P: PMenuItem;
BEGIN
If (Name <> '') AND (SubMenu <> Nil) Then Begin
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item }
P^.Name := NewStr(Name); { Hold submenu name }
P^.Command := 0; { Clear item command }
P^.Disabled := False; { Item not disabled }
P^.HelpCtx := AHelpCtx; { Set help context }
P^.SubMenu := SubMenu; { Hold next submenu }
End;
@ -1759,7 +1759,10 @@ END;
END.
{
$Log$
Revision 1.16 2002-10-17 11:24:17 pierre
Revision 1.17 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.16 2002/10/17 11:24:17 pierre
* Clean up the Load/Store routines so they are endian independent
Revision 1.15 2002/09/07 15:06:37 peter

7
fv/stddlg.pas
View File

@ -829,9 +829,10 @@ function MatchesMask(What, Mask: string): boolean;
end;
found:=true;
repeat
if found then
inc(i2);
inc(i2);
inc(i1);
if (i1>length(hstr1)) or (i2>length(hstr2)) then
break;
case hstr1[i1] of
'?' :
found:=true;
@ -853,7 +854,7 @@ function MatchesMask(What, Mask: string): boolean;
else
found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
end;
until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
until (not found);
if found then
found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
CmpStr:=found;

159
fv/views.pas
View File

@ -856,11 +856,10 @@ CONST
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
USES
{$IFDEF USE_VIDEO_API}
Video,
USES
Video;
{$ENDIF USE_VIDEO_API}
CallSpec;
{***************************************************************************}
{ PRIVATE TYPE DEFINITIONS }
@ -1440,7 +1439,8 @@ BEGIN
Draw; { Draw interior }
If (GOptions AND goDrawFocus <> 0) Then
DrawFocus; { Draw focus }
If (State AND sfCursorVis <> 0) Then
if not TextModeGFV and
(State AND sfCursorVis <> 0) Then
DrawCursor; { Draw any cursor }
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
@ -1496,14 +1496,10 @@ BEGIN
UnlockScreenUpdate;
{$endif USE_VIDEO_API}
if TextModeGFV or UseFixedFont then
begin
DrawScreenBuf;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
Begin
DrawMask := DrawMask and Not vdCursor;
DrawCursor; { Draw any cursor }
End;
end;
begin
DrawScreenBuf;
TView.DrawCursor;
end;
End;
ReleaseViewLimits; { Release the limits }
End;
@ -1784,8 +1780,6 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
VAR
OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@ -1795,7 +1789,6 @@ BEGIN
Mask := Mask AND NOT vdCursor; { Clear cursor draw }
If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
Mask := Mask AND NOT vdFocus; { Clear focus draws }
OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
END;
@ -1819,7 +1812,7 @@ BEGIN
If ((DrawMask and vdInSetCursor)=0) and (State AND sfCursorVis <> 0) Then
Begin { Cursor visible }
if TextModeGFV or UseFixedFont then
ResetCursor
TView.DrawCursor
else
begin
SetDrawMask(vdCursor or vdInSetCursor); { Set draw mask }
@ -1864,7 +1857,10 @@ BEGIN
DrawView; { Draw the view now }
End;
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
begin
Owner^.ResetCurrent; { Reset current }
Owner^.ResetCursor;
end;
Owner^.Unlock;
End;
END;
@ -1955,23 +1951,30 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
VAR OldState, Command: Word;
ShouldDrawCursor,
ShouldDraw : Boolean;
BEGIN
OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
ShouldDraw:=false;
ShouldDrawCursor:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
Then SetState(sfExposed, Enable); { Expose this view }
If Enable Then DrawView Else { Draw the view }
If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid }
RawOrigin.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
If Enable Then
ShouldDraw:=true
Else
If (Owner <> Nil) Then
Owner^.ReDrawArea( { Owner valid }
RawOrigin.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected }
If (Owner <> Nil) Then
Owner^.ResetCurrent; { Reset selected }
ShouldDrawCursor:=true;
End;
If (AState AND sfFocused <> 0) Then Begin { Focus change }
If (Owner <> Nil) Then Begin { Owner valid }
@ -1986,22 +1989,28 @@ BEGIN
SetDrawMask(vdFocus); { Set focus draw mask }
ShouldDraw:=true;
End;
ShouldDrawCursor:=true;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) and { Change cursor state }
(OldState<>State)
Then Begin
if TextModeGFV or UseFixedFont then
ResetCursor
else
begin
SetDrawMask(vdCursor); { Set cursor draw mask }
ShouldDraw:=true;
end;
End;
If ShouldDraw then
begin
(OldState<>State) then
ShouldDrawCursor:=true;
if (TextModeGFV or UseFixedFont) then
begin
If ShouldDraw then
DrawView; { Redraw the border }
end;
if ShouldDrawCursor Then
DrawCursor;
end
else
Begin
if ShouldDrawCursor Then
begin
SetDrawMask(vdCursor); { Set cursor draw mask }
ShouldDraw:=true;
end;
If ShouldDraw then
DrawView; { Redraw the border }
End;
END;
{--TView--------------------------------------------------------------------}
@ -2161,12 +2170,12 @@ BEGIN
assigned(Owner) then
begin
State:= State and not sfShadow;
Owner^.ReDrawArea(RawOrigin.X + RawSize.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X, RawOrigin.Y + RawSize.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X + RawSize.X + 1 , RawOrigin.Y,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X, RawOrigin.Y + RawSize.Y + 1 ,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
State:= State or sfShadow;
end;
If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords }
@ -2546,7 +2555,7 @@ BEGIN
Tp := Last; { Set temporary ptr }
Repeat
Tp := Tp^.Next; { Get next view }
IF Byte(Longint(CallPointerMethodLocal(P,PreviousFramePointer,@self,Tp)))<>0 THEN
IF Byte(Longint(CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp)))<>0 THEN
Begin { Test each view }
FirstThat := Tp; { View returned true }
Exit; { Now exit }
@ -2810,7 +2819,7 @@ BEGIN
if tp=nil then
exit;
Hp:=Tp^.Next; { Get next view }
CallPointerMethodLocal(P,PreviousFramePointer,@self,Tp);
CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp);
Until (Tp=L0); { Until last }
End;
END;
@ -5179,7 +5188,9 @@ VAR
PrevP,PP : PView;
CurOrigin : TPoint;
I,XI : longint;
B : Word;
ViewPort : ViewPortType;
Shadowed,
Skip : boolean;
BEGIN
{$ifdef DEBUG}
@ -5205,6 +5216,7 @@ BEGIN
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue;
Shadowed:=false;
Skip:=false;
While Assigned(P) do Begin
{ If parent not visible or
@ -5225,21 +5237,46 @@ BEGIN
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
{ If position is owned by another view that is before self
then skip }
If ((PP^.State AND sfVisible) <> 0) AND
(XI>=PP^.Origin.X) AND
(XI<PP^.Origin.X+PP^.Size.X) AND
(Y>=PP^.Origin.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y) then
Begin
Skip:=true;
break;
End;
If ((PP^.State AND sfVisible) <> 0) then
begin
if (XI>=PP^.Origin.X) AND
(XI<PP^.Origin.X+PP^.Size.X) AND
(Y>=PP^.Origin.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y) then
Begin
Skip:=true;
break;
End;
If ((PP^.State AND sfShadow) <> 0) AND
{ Vertical Shadow }
(
(
(XI>=PP^.Origin.X+PP^.Size.X) AND
(XI<PP^.Origin.X+PP^.Size.X+ShadowSize.X) AND
(Y>=PP^.Origin.Y+1) AND
(Y<PP^.Origin.Y+PP^.Size.Y+ShadowSize.Y)
) or
{ Horizontal Shadow }
(
(XI>=PP^.Origin.X+1) AND
(XI<PP^.Origin.X+PP^.Size.X+ShadowSize.X) AND
(Y>=PP^.Origin.Y+PP^.Size.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y+ShadowSize.Y)
)
) then
Begin
Shadowed:=true;
End;
end;
PP:=PP^.Next;
End;
If Not Skip and Assigned(P^.Buffer) then Begin
begin
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
B:=TDrawBuffer(Buf)[I];
if Shadowed then
B:=$0800 or (B and $FF);
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=B;
{$IFDEF GRAPH_API}
If (pointer(P^.Buffer)=pointer(VideoBuf)) and (SpVideoBuf^[Y*TextScreenWidth+XI]=EmptyVideoBufCell) then
OldVideoBuf^[Y*TextScreenWidth+XI]:=0;
@ -5262,7 +5299,6 @@ VAR
PrevP,PP : PView;
CurOrigin : TPoint;
I,J : longint;
Col,OrigCol : byte;
B : Word;
ViewPort : ViewPortType;
Skip : boolean;
@ -5315,12 +5351,8 @@ BEGIN
If not Skip and Assigned(P^.Buffer) then Begin
B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
OrigCol:=B shr 8;
if OrigCol and $F >= 8 then
Col:=OrigCol and $7
else
Col:=0;
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (col shl 8) or (B and $FF);
B:=$0800 or (B and $FF);
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:=B;
End;
PrevP:=P;
If Skip then
@ -5820,7 +5852,10 @@ END.
{
$Log$
Revision 1.40 2002-10-17 11:24:17 pierre
Revision 1.41 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.40 2002/10/17 11:24:17 pierre
* Clean up the Load/Store routines so they are endian independent
Revision 1.39 2002/09/22 19:42:21 hajny

6
fvision/buildfv.pas
View File

@ -8,7 +8,6 @@ interface
uses
fvcommon,
objects,
callspec,
drivers,
fileio,
memory,
@ -38,7 +37,10 @@ implementation
end.
{
$Log$
Revision 1.5 2002-09-07 15:06:36 peter
Revision 1.6 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.5 2002/09/07 15:06:36 peter
* old logs removed and tabs fixed
Revision 1.4 2002/05/29 22:15:19 pierre

15
fvision/dialogs.pas
View File

@ -1424,13 +1424,16 @@ END;
PROCEDURE TInputLine.DrawCursor;
VAR I, X: Sw_Integer; S: String;
BEGIN
if (TextModeGFV) then
If (State AND sfFocused <> 0) Then
Begin { Focused window }
if (TextModeGFV) then
begin
Cursor.Y:=0;
Cursor.X:=CurPos-FirstPos+1;
TView.ResetCursor;
ResetCursor;
end
else If (State AND sfFocused <> 0) Then Begin { Focused window }
else
begin
X := TextWidth(LeftArr); { Preset x position }
I := 0; { Preset cursor width }
If (Data <> Nil) Then Begin { Data pointer valid }
@ -1447,6 +1450,7 @@ BEGIN
Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
End;
end;
END;
{--TInputLine---------------------------------------------------------------}
@ -4225,7 +4229,10 @@ END;
END.
{
$Log$
Revision 1.22 2002-10-17 13:27:53 pierre
Revision 1.23 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.22 2002/10/17 13:27:53 pierre
* fix TCluster.Get/SetData on big endian machines
Revision 1.21 2002/10/17 11:24:16 pierre

22
fvision/drivers.pas
View File

@ -252,15 +252,15 @@ TYPE
Double: Boolean; { Double click state }
Where: TPoint); { Mouse position }
evKeyDown: (
{ ** KEY EVENT ** }
{ ** KEY EVENT ** }
Case Sw_Integer Of
0: (KeyCode: Word); { Full key code }
1: (
{$ifdef ENDIAN_BIG}
ScanCode: Byte;
CharCode: Char;
{$else not ENDIAN_BIG}
CharCode: Char; { Char code }
ScanCode: Byte;
CharCode: Char;
{$else not ENDIAN_BIG}
CharCode: Char; { Char code }
ScanCode: Byte; { Scan code }
{$endif not ENDIAN_BIG}
KeyShift: byte)); { Shift states }
@ -732,7 +732,7 @@ Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
GetTimeOfDay(tv{,tz});
GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
{$else}
FPGetTimeOfDay(@tv,nil{,tz});
FPGetTimeOfDay(@tv,nil{,tz});
GetDosTicks:=((tv.tv_Sec mod 86400) div 60)*1092+((tv.tv_Sec mod 60)*1000000+tv.tv_USec) div 54945;
{$endif}
@ -1576,8 +1576,9 @@ VAR ResultLength, FormatIndex, Justify, Wth: Byte; Fill: Char; S: String;
PROCEDURE HandleParameter (I : LongInt);
BEGIN
While (FormatIndex <= Length(Format)) Do Begin { While length valid }
While (Format[FormatIndex] <> '%') AND { Param char not found }
(FormatIndex <= Length(Format)) Do Begin { Length still valid }
While (FormatIndex <= Length(Format)) and
(Format[FormatIndex] <> '%') { Param char not found }
Do Begin { Length still valid }
Result[ResultLength+1] := Format[FormatIndex]; { Transfer character }
Inc(ResultLength); { One character added }
Inc(FormatIndex); { Next param char }
@ -1709,7 +1710,10 @@ BEGIN
END.
{
$Log$
Revision 1.38 2003-10-01 16:20:27 marco
Revision 1.39 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.38 2003/10/01 16:20:27 marco
* baseunix fixes for 1.1
Revision 1.37 2002/10/17 11:22:46 pierre

26
fvision/fvcommon.pas
View File

@ -260,7 +260,6 @@ Given two long integers returns the maximum longint of the two.
---------------------------------------------------------------------}
FUNCTION MaxLongIntOf (A, B: LongInt): LongInt;
{$IFDEF PPC_DELPHI3} { DELPHI 3+ CODE }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ MISSING DELPHI3 ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -281,7 +280,6 @@ Returns the max free memory block size available under Delphi 3+.
14Aug98 LdB
---------------------------------------------------------------------}
FUNCTION MaxAvail: LongInt;
{$ENDIF}
{***************************************************************************}
{ INITIALIZED PUBLIC VARIABLES }
@ -392,36 +390,28 @@ BEGIN
Else MaxLongIntOf := A; { Else take A }
END;
{$IFDEF PPC_DELPHI3} { DELPHI 3+ CODE }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ MISSING DELPHI3 ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ MemAvail -> Platforms WIN/NT - Updated 14Aug98 LdB }
{---------------------------------------------------------------------------}
FUNCTION MemAvail: LongInt;
VAR Ms: TMemoryStatus;
BEGIN
GlobalMemoryStatus(Ms); { Get memory status }
MemAvail := Ms.dwAvailPhys; { Avail physical memory }
{ Unlimited }
MemAvail:=high(longint);
END;
{---------------------------------------------------------------------------}
{ MaxAvail -> Platforms WIN/NT - Updated 14Aug98 LdB }
{---------------------------------------------------------------------------}
FUNCTION MaxAvail: LongInt;
VAR Ms: TMemoryStatus;
BEGIN
GlobalMemoryStatus(Ms); { Get memory status }
MaxAvail := Ms.dwTotalPhys; { Max physical memory }
{ Unlimited }
MaxAvail:=high(longint);
END;
{$ENDIF}
END.
{
$Log$
Revision 1.5 2003-06-05 14:45:06 peter
Revision 1.6 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.5 2003/06/05 14:45:06 peter
* use Windows THandle
Revision 1.4 2002/09/07 15:06:36 peter

13
fvision/menus.pas
View File

@ -1606,6 +1606,7 @@ FUNCTION NewMenu (Items: PMenuItem): PMenu;
VAR P: PMenu;
BEGIN
New(P); { Create new menu }
FillChar(P^,sizeof(TMenu),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Items := Items; { Hold item list }
P^.Default := Items; { Set default item }
@ -1647,10 +1648,9 @@ FUNCTION NewLine (Next: PMenuItem): PMenuItem;
VAR P: PMenuItem;
BEGIN
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next menu item }
P^.Name := Nil; { Clear name ptr }
P^.HelpCtx := hcNoContext; { Clear help context }
End;
NewLine := P; { Return new line }
END;
@ -1664,6 +1664,7 @@ VAR P: PMenuItem; R: TRect; T: PView;
BEGIN
If (Name <> '') AND (Command <> 0) Then Begin
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item }
P^.Name := NewStr(Name); { Hold item name }
@ -1691,11 +1692,10 @@ VAR P: PMenuItem;
BEGIN
If (Name <> '') AND (SubMenu <> Nil) Then Begin
New(P); { Allocate memory }
FillChar(P^,sizeof(TMenuItem),0);
If (P <> Nil) Then Begin { Check valid pointer }
P^.Next := Next; { Hold next item }
P^.Name := NewStr(Name); { Hold submenu name }
P^.Command := 0; { Clear item command }
P^.Disabled := False; { Item not disabled }
P^.HelpCtx := AHelpCtx; { Set help context }
P^.SubMenu := SubMenu; { Hold next submenu }
End;
@ -1759,7 +1759,10 @@ END;
END.
{
$Log$
Revision 1.16 2002-10-17 11:24:17 pierre
Revision 1.17 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.16 2002/10/17 11:24:17 pierre
* Clean up the Load/Store routines so they are endian independent
Revision 1.15 2002/09/07 15:06:37 peter

7
fvision/stddlg.pas
View File

@ -829,9 +829,10 @@ function MatchesMask(What, Mask: string): boolean;
end;
found:=true;
repeat
if found then
inc(i2);
inc(i2);
inc(i1);
if (i1>length(hstr1)) or (i2>length(hstr2)) then
break;
case hstr1[i1] of
'?' :
found:=true;
@ -853,7 +854,7 @@ function MatchesMask(What, Mask: string): boolean;
else
found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
end;
until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
until (not found);
if found then
found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
CmpStr:=found;

159
fvision/views.pas
View File

@ -856,11 +856,10 @@ CONST
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
USES
{$IFDEF USE_VIDEO_API}
Video,
USES
Video;
{$ENDIF USE_VIDEO_API}
CallSpec;
{***************************************************************************}
{ PRIVATE TYPE DEFINITIONS }
@ -1440,7 +1439,8 @@ BEGIN
Draw; { Draw interior }
If (GOptions AND goDrawFocus <> 0) Then
DrawFocus; { Draw focus }
If (State AND sfCursorVis <> 0) Then
if not TextModeGFV and
(State AND sfCursorVis <> 0) Then
DrawCursor; { Draw any cursor }
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
@ -1496,14 +1496,10 @@ BEGIN
UnlockScreenUpdate;
{$endif USE_VIDEO_API}
if TextModeGFV or UseFixedFont then
begin
DrawScreenBuf;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
Begin
DrawMask := DrawMask and Not vdCursor;
DrawCursor; { Draw any cursor }
End;
end;
begin
DrawScreenBuf;
TView.DrawCursor;
end;
End;
ReleaseViewLimits; { Release the limits }
End;
@ -1784,8 +1780,6 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
VAR
OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@ -1795,7 +1789,6 @@ BEGIN
Mask := Mask AND NOT vdCursor; { Clear cursor draw }
If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
Mask := Mask AND NOT vdFocus; { Clear focus draws }
OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
END;
@ -1819,7 +1812,7 @@ BEGIN
If ((DrawMask and vdInSetCursor)=0) and (State AND sfCursorVis <> 0) Then
Begin { Cursor visible }
if TextModeGFV or UseFixedFont then
ResetCursor
TView.DrawCursor
else
begin
SetDrawMask(vdCursor or vdInSetCursor); { Set draw mask }
@ -1864,7 +1857,10 @@ BEGIN
DrawView; { Draw the view now }
End;
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
begin
Owner^.ResetCurrent; { Reset current }
Owner^.ResetCursor;
end;
Owner^.Unlock;
End;
END;
@ -1955,23 +1951,30 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
VAR OldState, Command: Word;
ShouldDrawCursor,
ShouldDraw : Boolean;
BEGIN
OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
ShouldDraw:=false;
ShouldDrawCursor:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
Then SetState(sfExposed, Enable); { Expose this view }
If Enable Then DrawView Else { Draw the view }
If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid }
RawOrigin.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
If Enable Then
ShouldDraw:=true
Else
If (Owner <> Nil) Then
Owner^.ReDrawArea( { Owner valid }
RawOrigin.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected }
If (Owner <> Nil) Then
Owner^.ResetCurrent; { Reset selected }
ShouldDrawCursor:=true;
End;
If (AState AND sfFocused <> 0) Then Begin { Focus change }
If (Owner <> Nil) Then Begin { Owner valid }
@ -1986,22 +1989,28 @@ BEGIN
SetDrawMask(vdFocus); { Set focus draw mask }
ShouldDraw:=true;
End;
ShouldDrawCursor:=true;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) and { Change cursor state }
(OldState<>State)
Then Begin
if TextModeGFV or UseFixedFont then
ResetCursor
else
begin
SetDrawMask(vdCursor); { Set cursor draw mask }
ShouldDraw:=true;
end;
End;
If ShouldDraw then
begin
(OldState<>State) then
ShouldDrawCursor:=true;
if (TextModeGFV or UseFixedFont) then
begin
If ShouldDraw then
DrawView; { Redraw the border }
end;
if ShouldDrawCursor Then
DrawCursor;
end
else
Begin
if ShouldDrawCursor Then
begin
SetDrawMask(vdCursor); { Set cursor draw mask }
ShouldDraw:=true;
end;
If ShouldDraw then
DrawView; { Redraw the border }
End;
END;
{--TView--------------------------------------------------------------------}
@ -2161,12 +2170,12 @@ BEGIN
assigned(Owner) then
begin
State:= State and not sfShadow;
Owner^.ReDrawArea(RawOrigin.X + RawSize.X, RawOrigin.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X, RawOrigin.Y + RawSize.Y,
RawOrigin.X + RawSize.X + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X + RawSize.X + 1 , RawOrigin.Y,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
Owner^.ReDrawArea(RawOrigin.X, RawOrigin.Y + RawSize.Y + 1 ,
RawOrigin.X + RawSize.X + 1 + ShadowSize.X*SysFontWidth,
RawOrigin.Y + RawSize.Y + 1 + ShadowSize.Y*SysFontHeight); { Owner redraws area }
State:= State or sfShadow;
end;
If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords }
@ -2546,7 +2555,7 @@ BEGIN
Tp := Last; { Set temporary ptr }
Repeat
Tp := Tp^.Next; { Get next view }
IF Byte(Longint(CallPointerMethodLocal(P,PreviousFramePointer,@self,Tp)))<>0 THEN
IF Byte(Longint(CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp)))<>0 THEN
Begin { Test each view }
FirstThat := Tp; { View returned true }
Exit; { Now exit }
@ -2810,7 +2819,7 @@ BEGIN
if tp=nil then
exit;
Hp:=Tp^.Next; { Get next view }
CallPointerMethodLocal(P,PreviousFramePointer,@self,Tp);
CallPointerMethodLocal(P,get_caller_frame(get_frame),@self,Tp);
Until (Tp=L0); { Until last }
End;
END;
@ -5179,7 +5188,9 @@ VAR
PrevP,PP : PView;
CurOrigin : TPoint;
I,XI : longint;
B : Word;
ViewPort : ViewPortType;
Shadowed,
Skip : boolean;
BEGIN
{$ifdef DEBUG}
@ -5205,6 +5216,7 @@ BEGIN
If (XI<ViewPort.X1) OR
(XI>=ViewPort.X2) Then
Continue;
Shadowed:=false;
Skip:=false;
While Assigned(P) do Begin
{ If parent not visible or
@ -5225,21 +5237,46 @@ BEGIN
While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
{ If position is owned by another view that is before self
then skip }
If ((PP^.State AND sfVisible) <> 0) AND
(XI>=PP^.Origin.X) AND
(XI<PP^.Origin.X+PP^.Size.X) AND
(Y>=PP^.Origin.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y) then
Begin
Skip:=true;
break;
End;
If ((PP^.State AND sfVisible) <> 0) then
begin
if (XI>=PP^.Origin.X) AND
(XI<PP^.Origin.X+PP^.Size.X) AND
(Y>=PP^.Origin.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y) then
Begin
Skip:=true;
break;
End;
If ((PP^.State AND sfShadow) <> 0) AND
{ Vertical Shadow }
(
(
(XI>=PP^.Origin.X+PP^.Size.X) AND
(XI<PP^.Origin.X+PP^.Size.X+ShadowSize.X) AND
(Y>=PP^.Origin.Y+1) AND
(Y<PP^.Origin.Y+PP^.Size.Y+ShadowSize.Y)
) or
{ Horizontal Shadow }
(
(XI>=PP^.Origin.X+1) AND
(XI<PP^.Origin.X+PP^.Size.X+ShadowSize.X) AND
(Y>=PP^.Origin.Y+PP^.Size.Y) AND
(Y<PP^.Origin.Y+PP^.Size.Y+ShadowSize.Y)
)
) then
Begin
Shadowed:=true;
End;
end;
PP:=PP^.Next;
End;
If Not Skip and Assigned(P^.Buffer) then Begin
begin
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
B:=TDrawBuffer(Buf)[I];
if Shadowed then
B:=$0800 or (B and $FF);
P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=B;
{$IFDEF GRAPH_API}
If (pointer(P^.Buffer)=pointer(VideoBuf)) and (SpVideoBuf^[Y*TextScreenWidth+XI]=EmptyVideoBufCell) then
OldVideoBuf^[Y*TextScreenWidth+XI]:=0;
@ -5262,7 +5299,6 @@ VAR
PrevP,PP : PView;
CurOrigin : TPoint;
I,J : longint;
Col,OrigCol : byte;
B : Word;
ViewPort : ViewPortType;
Skip : boolean;
@ -5315,12 +5351,8 @@ BEGIN
If not Skip and Assigned(P^.Buffer) then Begin
B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
OrigCol:=B shr 8;
if OrigCol and $F >= 8 then
Col:=OrigCol and $7
else
Col:=0;
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (col shl 8) or (B and $FF);
B:=$0800 or (B and $FF);
P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:=B;
End;
PrevP:=P;
If Skip then
@ -5820,7 +5852,10 @@ END.
{
$Log$
Revision 1.40 2002-10-17 11:24:17 pierre
Revision 1.41 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.40 2002/10/17 11:24:17 pierre
* Clean up the Load/Store routines so they are endian independent
Revision 1.39 2002/09/22 19:42:21 hajny

28
ide/fpcompil.pas
View File

@ -550,9 +550,6 @@ var
const
MaxFileNameSize = 46;
begin
{$ifdef TEMPHEAP}
switch_to_base_heap;
{$endif TEMPHEAP}
case CompilationPhase of
cpCompiling :
begin
@ -620,9 +617,6 @@ begin
FormatParams)
);
KeyST^.SetText(^C+KeyS);
{$ifdef TEMPHEAP}
switch_to_temp_heap;
{$endif TEMPHEAP}
end;
@ -738,9 +732,6 @@ end;
function CompilerComment(Level:Longint; const s:string):boolean; {$ifndef FPC}far;{$endif}
begin
{$ifdef TEMPHEAP}
switch_to_base_heap;
{$endif TEMPHEAP}
CompilerComment:=false;
if (status.verbosity and Level)<>0 then
begin
@ -768,9 +759,6 @@ begin
{ update memory usage }
{ HeapView^.Update; }
end;
{$ifdef TEMPHEAP}
switch_to_temp_heap;
{$endif TEMPHEAP}
end;
@ -944,10 +932,6 @@ begin
ChangeRedirOut(FPOutFileName,false);
ChangeRedirError(FPErrFileName,false);
{$endif}
{$ifdef TEMPHEAP}
split_heap;
switch_to_temp_heap;
{$endif TEMPHEAP}
{ insert "" around name so that spaces are allowed }
{ only supported in compiler after 2000/01/14 PM }
if pos(' ',FileName)>0 then
@ -1089,9 +1073,6 @@ begin
else if error=0 then
WUtils.DeleteFile(GetExePath+PpasFile);
end;
{$ifdef TEMPHEAP}
switch_to_base_heap;
{$endif TEMPHEAP}
{$ifdef redircompiler}
RestoreRedirOut;
RestoreRedirError;
@ -1140,10 +1121,6 @@ begin
end;
{ Update the app }
Message(Application,evCommand,cmUpdate,nil);
{$ifdef TEMPHEAP}
releasetempheap;
unsplit_heap;
{$endif TEMPHEAP}
DummyView:=Desktop^.First;
while (DummyView<>nil) and (DummyView^.GetState(sfVisible)=false) do
begin
@ -1336,7 +1313,10 @@ end;
end.
{
$Log$
Revision 1.24 2004-09-09 20:33:00 jonas
Revision 1.25 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.24 2004/09/09 20:33:00 jonas
* made CompilerStop declaration compliant to new tstopprocedure type in
compiler

37
ide/fpdesk.pas
View File

@ -285,7 +285,7 @@ begin
begin
PushStatus(msg_storingbreakpoints);
New(S, Init(30*1024,4096));
BreakpointsCollection^.Store(S^);
S^.Put(BreakpointsCollection);
S^.Seek(0);
F^.CreateResource(resBreakpoints,rcBinary,0);
OK:=F^.AddResourceEntryFromStream(resBreakpoints,langDefault,0,S^,S^.GetSize);
@ -745,11 +745,10 @@ end;
function ReadFlags(F: PResourceFile): boolean;
var
size : sw_word;
OK: boolean;
OK: boolean;
begin
OK:=F^.ReadResourceEntry(resDesktopFlags,langDefault,DesktopFileFlags,
size);
sizeof(DesktopFileFlags));
if OK=false then
ErrorBox(msg_errorreadingflags,nil);
ReadFlags:=OK;
@ -769,15 +768,13 @@ end;
function ReadVideoMode(F: PResourceFile;var NewScreenMode : TVideoMode): boolean;
var
size : sw_word;
OK,test : boolean;
begin
size:=SizeOf(TVideoMode);
test:=F^.ReadResourceEntry(resVideo,langDefault,NewScreenMode,
size);
sizeof(NewScreenMode));
if not test then
NewScreenMode:=ScreenMode;
OK:=test and (size = SizeOf(TVideoMode));
OK:=test;
if OK=false then
ErrorBox(msg_errorreadingvideomode,nil);
ReadVideoMode:=OK;
@ -854,22 +851,22 @@ begin
Application^.SetScreenVideoMode(VM);
end;
if ((DesktopFileFlags and dfHistoryLists)<>0) then
OK:=OK and ReadHistory(F);
OK:=ReadHistory(F) and OK;
if ((DesktopFileFlags and dfWatches)<>0) then
OK:=OK and ReadWatches(F);
OK:=ReadWatches(F) and OK;
if ((DesktopFileFlags and dfBreakpoints)<>0) then
OK:=OK and ReadBreakpoints(F);
OK:=ReadBreakpoints(F) and OK;
if ((DesktopFileFlags and dfOpenWindows)<>0) then
OK:=OK and ReadOpenWindows(F);
OK:=ReadOpenWindows(F) and OK;
{ no errors if no browser info available PM }
if ((DesktopFileFlags and dfSymbolInformation)<>0) then
OK:=OK and ReadSymbols(F);
OK:=ReadSymbols(F) and OK;
if ((DesktopFileFlags and dfCodeCompleteWords)<>0) then
OK:=OK and ReadCodeComplete(F);
OK:=ReadCodeComplete(F) and OK;
if ((DesktopFileFlags and dfCodeTemplates)<>0) then
OK:=OK and ReadCodeTemplates(F);
OK:=ReadCodeTemplates(F) and OK;
{$ifdef Unix}
OK:=OK and ReadKeys(F);
OK:=ReadKeys(F) and OK;
{$endif Unix}
Dispose(F, Done);
end;
@ -966,7 +963,13 @@ end;
END.
{
$Log$
Revision 1.6 2002-09-07 15:40:42 peter
Revision 1.8 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.7 2002/02/09 00:32:27 pierre
* fix error when loading breakpoints, try to load other items even after an error
Revision 1.6 2002/09/07 15:40:42 peter
* old logs removed and tabs fixed
Revision 1.5 2002/09/04 14:03:52 pierre

9
ide/fpide.pas
View File

@ -1230,10 +1230,8 @@ begin
end;
function TIDEApp.GetPalette: PPalette;
var P: string;
begin
P:=AppPalette;
GetPalette:=@P;
GetPalette:=@AppPalette;
end;
function TIDEApp.IsClosing: Boolean;
@ -1254,7 +1252,10 @@ end;
END.
{
$Log$
Revision 1.26 2003-09-29 14:36:59 peter
Revision 1.27 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.26 2003/09/29 14:36:59 peter
* win32 fixed
Revision 1.25 2003/01/31 11:01:00 pierre

41
ide/weditor.pas
View File

@ -1181,7 +1181,7 @@ Var
buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
s2 : String;
len,
numb : Sw_integer;
numb : Sw_word;
found : Boolean;
begin
len:=length(str);
@ -1225,7 +1225,7 @@ Var
buffer : Array[0..MaxBufLength-1] of Char Absolute block;
len,
numb,
x : Sw_integer;
x : Sw_word;
found : Boolean;
p : pchar;
c : char;
@ -1897,7 +1897,7 @@ begin
else
begin
CP:=0; RX:=0;
while (RX<=X) and (CP<=length(S)) do
while (RX<=X) and (CP<length(S)) do
begin
Inc(CP);
if S[CP]=TAB then
@ -2249,14 +2249,16 @@ var
begin
if (C='.') then
begin
if (LineText[X+1]='.') then
if (X>=length(LineText)) or
(LineText[X+1]='.') then
cc:=ccSymbol
else
cc:=ccRealNumber;
end
else {'E','e'}
begin
if (LineText[X+1]in ['+','-','0'..'9']) then
if (X>=length(LineText)) or
(LineText[X+1]in ['+','-','0'..'9']) then
cc:=ccRealNumber
else
cc:=ccAlpha
@ -3731,10 +3733,10 @@ var SelectColor,
HighlightRowColor,
ErrorMessageColor : word;
B: TDrawBuffer;
I,X,Y,AX,AY,MaxX,LSX: sw_integer;
X,Y,AX,AY,MaxX,LSX: sw_integer;
PX: TPoint;
LineCount: sw_integer;
Line,PrevLine: PCustomLine;
Line: PCustomLine;
LineText,Format: string;
isBreak : boolean;
C: char;
@ -3756,7 +3758,7 @@ begin
Color:=(Color and $F0) or $F;
CombineColors:=Color;
end;
var PrevEI,EI: PEditorLineInfo;
var
FoldPrefix,FoldSuffix: string;
{ SkipLine: boolean;}
{ FoldStartLine: sw_integer;}
@ -3797,7 +3799,6 @@ begin
UpdateAttrsRange(GetLastSyntaxedLine,Delta.Y+Size.Y,AttrAll);
{$endif TEST_PARTIAL_SYNTAX}
LSX:=GetReservedColCount;
PrevLine:=nil; PrevEI:=nil; {FoldStartLine:=-1;}
Y:=0; AY:=Delta.Y;
for Y:=0 to Size.Y-1 do
begin
@ -3816,19 +3817,16 @@ begin
if assigned(Line) then
begin
IsBreak:=Line^.IsFlagSet(lfBreakpoint);
EI:=Line^.GetEditorInfo(@Self);
end
else
begin
IsBreak:=false;
EI:=nil;
end;
end
else
begin
Line:=nil;
IsBreak:=false;
EI:=nil;
end;
begin
@ -3919,13 +3917,11 @@ begin
WriteLine(0,Y,Size.X,1,B);
end; { if not SkipLine ... }
end; { not errorline }
PrevEI:=EI; PrevLine:=Line;
end; { while (Y<Size.Y) ... }
DrawCursor;
end;
procedure TCustomCodeEditor.DrawCursor;
var LSX: sw_integer;
begin
if Elockflag>0 then
DrawCursorCalled:=true
@ -3942,7 +3938,9 @@ const
sfV_CV_F:word = sfVisible + sfCursorVis + sfFocused;
var
p,p2 : PView;
{$ifndef FVISION}
G : PGroup;
{$endif FVISION}
cur : TPoint;
function Check0:boolean;
@ -4661,7 +4659,6 @@ end;
function TCustomCodeEditor.EditorToViewLine(EditorLine: sw_integer): sw_integer;
var I,Line: sw_integer;
F: PFold;
begin
if not IsFlagSet(efFolds) then
Line:=EditorLine
@ -5341,7 +5338,7 @@ end;
procedure TCustomCodeEditor.IndentBlock;
var
ey,i,indlen : Sw_integer;
ey,i{,indlen} : Sw_integer;
S,Ind : String;
Pos : Tpoint;
begin
@ -5582,7 +5579,7 @@ procedure TCustomCodeEditor.ExpandCodeTemplate;
var Line,ShortCutInEditor,ShortCut: string;
X,Y,I,LineIndent: sw_integer;
CodeLines: PUnsortedStringCollection;
CanJump,Expanded: boolean;
CanJump: boolean;
CP: TPoint;
begin
{
@ -5594,7 +5591,7 @@ begin
Lock;
CP.X:=-1; CP.Y:=-1; Expanded:=false;
CP.X:=-1; CP.Y:=-1;
Line:=GetDisplayText(CurPos.Y);
X:=CurPos.X; ShortCut:='';
if X<=length(Line) then
@ -5661,7 +5658,6 @@ begin
SetCurPtr(0,CurPos.Y);
end;
end;
Expanded:=true;
end;
Dispose(CodeLines, Done);
@ -6118,7 +6114,7 @@ var S: string;
IFindStr : string;
BT : BTable;
function ContainsText(const SubS:string;var S: string; Start: Sw_word): Sw_integer;
function ContainsText(const SubS:string;var S: string; Start: Sw_integer): Sw_integer;
var
P: Sw_Integer;
begin
@ -7274,7 +7270,10 @@ end;
END.
{
$Log$
Revision 1.44 2004-02-13 06:53:57 pierre
Revision 1.45 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.44 2004/02/13 06:53:57 pierre
* fix for webbug 2940
Revision 1.43 2004/02/10 07:16:28 pierre

29
ide/wini.pas
View File

@ -85,7 +85,6 @@ const MainSectionName : string[40] = 'MainSection';
implementation
uses
CallSpec,
WUtils;
constructor TINIEntry.Init(const ALine: string);
@ -215,7 +214,7 @@ begin
for I:=0 to Sections^.Count-1 do
begin
S:=Sections^.At(I);
CallPointerLocal(EnumProc,PreviousFramePointer,S);
CallPointerLocal(EnumProc,get_caller_frame(get_frame),S);
end;
end;
@ -226,12 +225,12 @@ begin
for I:=0 to Entries^.Count-1 do
begin
E:=Entries^.At(I);
CallPointerLocal(EnumProc,PreviousFramePointer,E);
CallPointerLocal(EnumProc,get_caller_frame(get_frame),E);
end;
end;
function TINISection.SearchEntry(Tag: string): PINIEntry;
function MatchingEntry(E: PINIEntry): boolean; {$ifndef FPC}far;{$endif}
function MatchingEntry(E: PINIEntry): boolean;
begin
MatchingEntry:=UpcaseStr(E^.GetTag)=Tag;
end;
@ -308,9 +307,9 @@ end;
function TINIFile.IsModified: boolean;
function SectionModified(P: PINISection): boolean; {$ifndef FPC}far;{$endif}
function SectionModified(P: PINISection): boolean;
function EntryModified(E: PINIEntry): boolean; {$ifndef FPC}far;{$endif}
function EntryModified(E: PINIEntry): boolean;
begin
EntryModified:=E^.Modified;
end;
@ -369,7 +368,7 @@ begin
end;
function TINIFile.SearchSection(Section: string): PINISection;
function MatchingSection(P: PINISection): boolean; {$ifndef FPC}far;{$endif}
function MatchingSection(P: PINISection): boolean;
var SN: string;
M: boolean;
begin
@ -402,16 +401,7 @@ begin
for I:=0 to P^.Entries^.Count-1 do
begin
E:=P^.Entries^.At(I);
{$ifdef FPC}
CallPointerMethodLocal(EnumProc,CurrentFramePointer,@Self,E);
{$else}
asm
push E.word[2]
push E.word[0]
push word ptr [bp]
call EnumProc
end;
{$endif}
CallPointerMethodLocal(EnumProc,get_frame,@Self,E);
end;
end;
@ -489,7 +479,10 @@ end;
END.
{
$Log$
Revision 1.3 2002-09-07 15:40:50 peter
Revision 1.4 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.3 2002/09/07 15:40:50 peter
* old logs removed and tabs fixed
}

12
ide/wnghelp.pas
View File

@ -125,7 +125,6 @@ procedure RegisterHelpType;
implementation
uses CallSpec;
function DefNGGetAttrColor(Attr: char; var Color: byte): boolean;
begin
@ -253,7 +252,7 @@ begin
Name:=NGDecompressStr(StrPas(P));
FilePos:=SubItemsOfs;
end;
CallPointerLocal(EnumProc,PreviousFramePointer,@CIR);
CallPointerLocal(EnumProc,get_caller_frame(get_frame),@CIR);
Inc(I);
end;
end;
@ -282,7 +281,7 @@ begin
begin
S:=StrPas(LineP);
ParamS:=NGDecompressStr(S);
CallPointerLocal(LineEnumProc,PreviousFramePointer,@ParamS);
CallPointerLocal(LineEnumProc,get_caller_frame(get_frame),@ParamS);
Inc(Ptrint(LineP),length(S)+1);
end;
if Assigned(LinkEnumProc) and (SeeAlsoOfs>0) then
@ -296,7 +295,7 @@ begin
S:=StrPas(NextLinkNamePtr);
LR.Name:=S;
Move(NextLinkOfsPtr^,LR.FilePos,4);
CallPointerLocal(LinkEnumProc,PreviousFramePointer,@LR);
CallPointerLocal(LinkEnumProc,get_caller_frame(get_frame),@LR);
Inc(Ptrint(NextLinkNamePtr),length(S)+1);
Inc(Ptrint(NextLinkOfsPtr),4);
end;
@ -520,7 +519,10 @@ end;
END.
{
$Log$
Revision 1.4 2004-05-03 21:12:54 peter
Revision 1.5 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.4 2004/05/03 21:12:54 peter
* 64bit fixes
Revision 1.3 2002/09/07 15:40:50 peter

18
ide/wos2help.pas
View File

@ -132,7 +132,6 @@ procedure RegisterHelpType;
implementation
uses CallSpec;
function DefINFGetAttrColor(TextStyle, TextColor: byte; var Color: byte): boolean;
{
@ -250,7 +249,7 @@ end;
function TOS2HelpFile.ReadTOC: boolean;
var OK: boolean;
I,J,L,Count: longint;
I,Count: longint;
TE: TINFTOCEntry;
W: word;
C: array[0..255] of char;
@ -317,9 +316,8 @@ end;
function TOS2HelpFile.ReadTopicRec(FileOfs: longint; Topic: PTopic; Lines: PUnsortedStringCollection): boolean;
var Line: string;
LastTextChar: char;
CharsInLine: sw_integer;
LeftMargin,RightMargin: byte;
LeftMargin: byte;
TextStyle,TextColor: byte;
InMonospace: boolean;
Align: (alLeft,alRight,alCenter);
@ -363,7 +361,6 @@ begin
end;
end;
AddChar(C);
LastTextChar:=C;
if C=hscLineBreak then
begin
CharsInLine:=0;
@ -384,7 +381,6 @@ var H: TINFTopicHeader;
Dict: PWordArray;
Spacing: boolean;
function NextByte: byte;
var B: byte;
begin
NextByte:=Text^[TextOfs];
Inc(TextOfs);
@ -423,7 +419,7 @@ begin
if OK then
begin
LineNo:=0;
Line:=''; LeftMargin:=0; RightMargin:=0; LastTextChar:=hscLineBreak;
Line:=''; LeftMargin:=0;
InTempMargin:=false;
CharsInLine:=0; TextStyle:=0; TextColor:=0; Align:=alLeft;
CurLinkCtx:=-1; InMonospace:=false;
@ -471,7 +467,8 @@ begin
LeftMargin:=NextByte;
end;
$03 :
RightMargin:=NextByte;
{ right margin, not used }
NextByte;
$04 :
begin
TextStyle:=NextByte;
@ -614,7 +611,10 @@ end;
END.
{
$Log$
Revision 1.3 2002-09-07 15:40:50 peter
Revision 1.4 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.3 2002/09/07 15:40:50 peter
* old logs removed and tabs fixed
}

34
ide/wresourc.pas
View File

@ -33,7 +33,7 @@ type
LangID : longint;
Flags : longint;
DataOfs: longint;
DataLen: longint;
DataLen: sw_word;
end;
TResourceHeader = packed record
@ -59,7 +59,7 @@ type
LangID : longint;
Flags : longint;
DataOfs : longint;
DataLen : longint;
DataLen : sw_word;
procedure BuildHeader(var Header : TResourceEntryHeader);
end;
@ -114,7 +114,7 @@ type
var Source: TStream; ADataSize: longint): boolean; virtual;
function DeleteResourceEntry(const ResName: string; ALangID: longint): boolean; virtual;
function DeleteResource(const ResName: string): boolean; virtual;
function ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; var BufSize: sw_word): boolean;
function ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; BufSize: sw_word): boolean;
function ReadResourceEntryToStream(const ResName: string; ALangID: longint; var DestS: TStream): boolean;
procedure Flush; virtual;
destructor Done; virtual;
@ -144,7 +144,7 @@ type
implementation
uses CallSpec,
uses
WUtils;
function TResourceEntryCollection.At(Index: Sw_Integer): PResourceEntry;
@ -229,7 +229,7 @@ begin
for I:=0 to Items^.Count-1 do
begin
EP:=Items^.At(I);
if Byte(Longint(CallPointerMethodLocal(Func,PreviousFramePointer,@Self,EP)))<>0 then
if Byte(Longint(CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,EP)))<>0 then
begin
P := EP;
Break;
@ -245,7 +245,7 @@ begin
for I:=0 to Items^.Count-1 do
begin
RP:=Items^.At(I);
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP);
CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP);
end;
end;
@ -371,7 +371,7 @@ begin
for I:=0 to Resources^.Count-1 do
begin
RP:=Resources^.At(I);
if Byte(Longint(CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP)))<>0 then
if Byte(Longint(CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP)))<>0 then
begin
P := RP;
Break;
@ -387,7 +387,7 @@ begin
for I:=0 to Resources^.Count-1 do
begin
RP:=Resources^.At(I);
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,RP);
CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP);
end;
end;
@ -398,7 +398,7 @@ begin
for I:=0 to Entries^.Count-1 do
begin
E:=Entries^.At(I);
CallPointerMethodLocal(Func,PreviousFramePointer,@Self,E);
CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,E);
end;
end;
@ -520,7 +520,7 @@ begin
DeleteResource:=OK;
end;
function TResourceFile.ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; var BufSize: sw_word): boolean;
function TResourceFile.ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; BufSize: sw_word): boolean;
var E: PResourceEntry;
P: PResource;
OK: boolean;
@ -528,6 +528,7 @@ var E: PResourceEntry;
TempBuf: pointer;
const TempBufSize = 4096;
begin
E:=nil;
P:=FindResource(ResName);
OK:=P<>nil;
if OK then E:=P^.Items^.SearchEntryForLang(ALangID);
@ -643,8 +644,8 @@ end;
procedure TResourceFile.WriteResourceTable;
var RH: TResourceHeader;
REH: TResourceEntryHeader;
procedure WriteResource(P: PResource); {$ifndef FPC}far;{$endif}
procedure WriteResourceEntry(P: PResourceEntry); {$ifndef FPC}far;{$endif}
procedure WriteResource(P: PResource);
procedure WriteResourceEntry(P: PResourceEntry);
begin
P^.BuildHeader(REH);
S^.Write(REH,SizeOf(REH));
@ -677,13 +678,13 @@ var RH : TResourceHeader;
REH : TResourceEntryHeader;
Size: longint;
NamesSize: longint;
procedure AddResourceEntrySize(P: PResourceEntry); {$ifndef FPC}far;{$endif}
procedure AddResourceEntrySize(P: PResourceEntry);
begin
if UpdatePosData then P^.DataOfs:=Size;
P^.BuildHeader(REH);
Inc(Size,REH.DataLen);
end;
procedure AddResourceSize(P: PResource); {$ifndef FPC}far;{$endif}
procedure AddResourceSize(P: PResource);
var RH: TResourceHeader;
begin
P^.BuildHeader(RH);
@ -797,7 +798,10 @@ end;
END.
{
$Log$
Revision 1.2 2002-09-07 15:40:50 peter
Revision 1.3 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.2 2002/09/07 15:40:50 peter
* old logs removed and tabs fixed
}

6
ide/wvphelp.pas
View File

@ -71,7 +71,6 @@ procedure RegisterHelpType;
implementation
uses CallSpec;
function DefVPHGetAttrColor(TextStyle, TextColor: byte; var Color: byte): boolean;
begin
@ -183,7 +182,10 @@ end;
END.
{
$Log$
Revision 1.3 2002-09-07 15:40:50 peter
Revision 1.4 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.3 2002/09/07 15:40:50 peter
* old logs removed and tabs fixed
}

9
ide/wwinhelp.pas
View File

@ -235,7 +235,7 @@ procedure RegisterHelpType;
implementation
uses {Crt,}Strings,CallSpec;
uses Strings;
function ReadString(F: PStream): string;
var S: string;
@ -1229,7 +1229,7 @@ begin
TEN.LinkData1:=LinkData1;
TEN.LinkData2Size:=LinkData2Size;
TEN.LinkData2:=LinkData2;
DoCont:=(longint(CallPointerLocal(EnumProc,PreviousFramePointer,@TEN)) and $ff)<>0;
DoCont:=(longint(CallPointerLocal(EnumProc,get_caller_frame(get_frame),@TEN)) and $ff)<>0;
case TL.RecordType of
$02: ;
$20,$23:
@ -1677,7 +1677,10 @@ end;
END.
{
$Log$
Revision 1.5 2002-11-28 08:44:19 pierre
Revision 1.6 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.5 2002/11/28 08:44:19 pierre
* Correct the wrong code commented out by last commit
Revision 1.4 2002/11/27 20:07:03 peter

198
rtl/inc/objects.pp
View File

@ -566,6 +566,48 @@ TYPE
{ INTERFACE ROUTINES }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ CALL HELPERS INTERFACE ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ Constructor calls.
Ctor Pointer to the constructor.
Obj Pointer to the instance. NIL if new instance to be allocated.
VMT Pointer to the VMT (obtained by TypeOf()).
returns Pointer to the instance.
}
function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer;
function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;
{ Method calls.
Method Pointer to the method.
Obj Pointer to the instance. NIL if new instance to be allocated.
returns Pointer to the instance.
}
function CallVoidMethod(Method: pointer; Obj: pointer): pointer;
function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer;
{ Local-function/procedure calls.
Func Pointer to the local function (which must be far-coded).
Frame Frame pointer of the wrapping function.
}
function CallVoidLocal(Func: pointer; Frame: Pointer): pointer;
function CallPointerLocal(Func: pointer; Frame: Pointer; Param1: pointer): pointer;
{ Calls of functions/procedures local to methods.
Func Pointer to the local function (which must be far-coded).
Frame Frame pointer of the wrapping method.
Obj Pointer to the object that the method belongs to.
}
function CallVoidMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer): pointer;
function CallPointerMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ DYNAMIC STRING INTERFACE ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@ -696,61 +738,32 @@ Uses dos;
{***************************************************************************}
type
FramePointer = pointer;
PointerLocal = function(_EBP: FramePointer; Param1: pointer): pointer;
VoidLocal = function(_EBP: Pointer): pointer;
PointerLocal = function(_EBP: Pointer; Param1: pointer): pointer;
VoidMethodLocal = function(_EBP: Pointer): pointer;
PointerMethodLocal = function(_EBP: Pointer; Param1: pointer): pointer;
VoidConstructor = function(VMT: pointer; Obj: pointer): pointer;
PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer;
VoidMethod = function(Obj: pointer): pointer;
PointerMethod = function(Obj: pointer; Param1: pointer): pointer;
function PreviousFramePointer: FramePointer;assembler;
{$undef FPC_PreviousFramePointer_Implemented}
function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer;
begin
{$ifdef VER1_0}
asm
{$ifdef cpui386}
{$define FPC_PreviousFramePointer_Implemented}
asm
movl (%ebp), %eax
end ['EAX'];
{$endif}
{$ifdef cpux86_64}
{$define FPC_PreviousFramePointer_Implemented}
asm
movq (%rbp), %rax
end ['RAX'];
movl Obj, %esi
{$endif}
{$ifdef cpum68k}
{$define FPC_PreviousFramePointer_Implemented}
asm
move.l (a6),d0
end ['D0'];
move.l Obj, a5
{$endif}
{$ifdef cpusparc}
{$define FPC_PreviousFramePointer_Implemented}
asm
{ flush register windows, so they are stored in the stack }
ta 3
{ we have first our own frame }
ld [%fp+56],%i0
ld [%i0+56],%i0
end;
end;
CallVoidConstructor := VoidConstructor(Ctor)(VMT, Obj);
{$else}
CallVoidConstructor := VoidConstructor(Ctor)(Obj, VMT);
{$endif}
{$ifdef cpupowerpc}
{$define FPC_PreviousFramePointer_Implemented}
asm
lwz r3,0(r1)
end;
{$endif cpupowerpc}
{$ifdef cpuarm}
{$define FPC_PreviousFramePointer_Implemented}
{$warning FIX ME !!!! }
asm
// on the arm, even assembler declared procedure save fp because it's part of the
// entry code where e.g. the link register is saved so we've to dereference fp
// here twice
ldr r0,[fp,#-12]
ldr r0,[r0,#-12]
end;
{$endif cpuarm}
{$ifndef FPC_PreviousFramePointer_Implemented}
{$error PreviousFramePointer function not implemented}
{$endif not FPC_PreviousFramePointer_Implemented}
function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;
@ -767,22 +780,37 @@ begin
move.l Obj, a5
{$endif}
end;
{$else}
{ 1.1 does not esi to be loaded }
{$define FPC_CallPointerConstructor_Implemented}
{$endif}
CallPointerConstructor := PointerConstructor(Ctor)(VMT, Obj, Param1)
end;
{$ifdef cpupowerpc}
{$define FPC_CallPointerConstructor_Implemented}
{ for the powerpc, we don't need to load self, because we use standard calling conventions
so self should be in a register anyways }
{$else}
{ 1.1 does not esi to be loaded }
{$define FPC_CallPointerConstructor_Implemented}
CallPointerConstructor := PointerConstructor(Ctor)(Obj, VMT, Param1)
{$endif}
end;
{$ifndef FPC_CallPointerConstructor_Implemented}
{$error CallPointerConstructor function not implemented}
{$endif not FPC_CallPointerConstructor_Implemented}
function CallVoidMethod(Method: pointer; Obj: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallVoidMethod := VoidMethod(Method)(Obj)
end;
function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer;
{$undef FPC_CallPointerMethod_Implemented}
begin
@ -813,12 +841,58 @@ end;
{$endif not FPC_CallPointerMethod_Implemented}
function CallPointerLocal(Func: pointer; Frame: FramePointer; Param1: pointer): pointer;
function CallVoidLocal(Func: pointer; Frame: Pointer): pointer;
begin
CallVoidLocal := VoidLocal(Func)(Frame)
end;
function CallPointerLocal(Func: pointer; Frame: Pointer; Param1: pointer): pointer;
begin
CallPointerLocal := PointerLocal(Func)(Frame, Param1)
end;
function CallVoidMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallVoidMethodLocal := VoidMethodLocal(Func)(Frame)
end;
function CallPointerMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallPointerMethodLocal := PointerMethodLocal(Func)(Frame, Param1)
end;
{***************************************************************************}
{ PRIVATE INITIALIZED VARIABLES }
{***************************************************************************}
@ -1789,7 +1863,6 @@ VAR
I, W: Longint;
Li: LongInt;
P: PPointerArray;
OldVal : Boolean;
BEGIN
If (ALimit <> BlkCount) Then Begin { Change is needed }
ChangeListSize := False; { Preset failure }
@ -1933,7 +2006,7 @@ VAR I: LongInt;
BEGIN
For I := Count DownTo 1 Do
Begin { Down from last item }
IF Boolean(Byte(ptrint(CallPointerLocal(Test,PreviousFramePointer,Items^[I-1])))) THEN
IF Boolean(Byte(ptrint(CallPointerLocal(Test,get_caller_frame(get_frame),Items^[I-1])))) THEN
Begin { Test each item }
LastThat := Items^[I-1]; { Return item }
Exit; { Now exit }
@ -1949,7 +2022,7 @@ FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
VAR I: LongInt;
BEGIN
For I := 1 To Count Do Begin { Up from first item }
IF Boolean(Byte(ptrint(CallPointerLocal(Test,PreviousFramePointer,Items^[I-1])))) THEN
IF Boolean(Byte(ptrint(CallPointerLocal(Test,get_caller_frame(get_frame),Items^[I-1])))) THEN
Begin { Test each item }
FirstThat := Items^[I-1]; { Return item }
Exit; { Now exit }
@ -2063,7 +2136,7 @@ PROCEDURE TCollection.ForEach (Action: Pointer);
VAR I: LongInt;
BEGIN
For I := 1 To Count Do { Up from first item }
CallPointerLocal(Action,PreviousFramePointer,Items^[I-1]); { Call with each item }
CallPointerLocal(Action,get_caller_frame(get_frame),Items^[I-1]); { Call with each item }
END;
{--TCollection--------------------------------------------------------------}
@ -2946,7 +3019,10 @@ BEGIN
END.
{
$Log$
Revision 1.34 2004-10-03 17:43:47 florian
Revision 1.35 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.34 2004/10/03 17:43:47 florian
* fixedPreviousFramePointer on sparc
Revision 1.33 2004/08/26 22:58:01 carl

4
utils/h2pas/h2pas.pas
View File

@ -8017,8 +8017,8 @@ end.
{
$Log$
Revision 1.13 2004-09-15 19:16:38 hajny
* regenerated
Revision 1.14 2004-11-02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.9 2004/09/08 22:21:41 carl
+ support for creating packed records