* fixed crashes with ide and 1.9.x

fv/buildfv.pas

@@ -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

fv/dialogs.pas

@@ -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

fv/drivers.pas

@@ -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

fv/fvcommon.pas

@@ -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

fv/menus.pas

@@ -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

fv/stddlg.pas

@@ -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;

fv/views.pas

@@ -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

fvision/buildfv.pas

@@ -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

fvision/dialogs.pas

@@ -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

fvision/drivers.pas

@@ -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

fvision/fvcommon.pas

@@ -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

fvision/menus.pas

@@ -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

fvision/stddlg.pas

@@ -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;

fvision/views.pas

@@ -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

ide/fpcompil.pas

@@ -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
 

ide/fpdesk.pas

@@ -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

ide/fpide.pas

@@ -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

ide/weditor.pas

@@ -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

ide/wini.pas

@@ -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
 
 }

ide/wnghelp.pas

@@ -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

ide/wos2help.pas

@@ -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
 
 }

ide/wresourc.pas

@@ -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
 
 }

ide/wvphelp.pas

@@ -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
 
 }

ide/wwinhelp.pas

@@ -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

rtl/inc/objects.pp

@@ -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;
+  CallPointerConstructor := PointerConstructor(Ctor)(VMT, Obj, Param1)
 {$else}
-{ 1.1 does not esi to be loaded }
-{$define FPC_CallPointerConstructor_Implemented}
+  { 1.1 does not esi to be loaded }
+  {$define FPC_CallPointerConstructor_Implemented}
+  CallPointerConstructor := PointerConstructor(Ctor)(Obj, VMT, Param1)
 {$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 }
-{$endif}
 {$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

utils/h2pas/h2pas.pas

@@ -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