瀏覽代碼

* support for compiling the objects unit methods that expect local procedure/
function pointers using {$modeswitch nestedprocvars} functionality, activate
this for LLVM and also activate that modeswitch for a test that uses this
o also convert the IDE units to use this functionality
o requires extra typecasts because implicit type conversions from
procvar(p: psometype) to procvar(p: pointer) are not supported; on the
plus side, even those type conversions are checked for validity
o note: requires {$modeswitch nestedprocvars} in all programs/units
that rely on this functionality

git-svn-id: trunk@40598 -

Jonas Maebe 6 年之前
父節點
當前提交
c6bb85eae9

+ 9 - 4
compiler/browcol.pas

@@ -23,12 +23,17 @@
 {$ifdef TP}
   {$N+,E+}
 {$endif}
+
 unit browcol;
 
 {$i fpcdefs.inc}
 { $define use_refs}
 {$H-}
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -1745,7 +1750,7 @@ var P: PModuleSymbol;
 begin
   P:=nil;
   if Assigned(Modules) then
-    P:=Modules^.FirstThat(@Match);
+    P:=Modules^.FirstThat(TCallbackFunBoolParam(@Match));
   SearchModule:=P;
 end;
 
@@ -2198,7 +2203,7 @@ begin
        FixupSymbol(At(I));
 end;
 begin
-  Modules^.ForEach(@FixupSymbol);
+  Modules^.ForEach(TCallbackProcParam(@FixupSymbol));
 end;
 procedure ReadSymbolPointers(P: PSymbol);
 var I: sw_integer;
@@ -2222,7 +2227,7 @@ begin
   ReadPointers(S,ModuleNames,PD);
   ReadPointers(S,TypeNames,PD);
   ReadPointers(S,Modules,PD);
-  Modules^.ForEach(@ReadSymbolPointers);
+  Modules^.ForEach(TCallbackProcParam(@ReadSymbolPointers));
   FixupPointers;
   Dispose(PD, Done);
 
@@ -2261,7 +2266,7 @@ begin
   StorePointers(S,ModuleNames);
   StorePointers(S,TypeNames);
   StorePointers(S,Modules);
-  Modules^.ForEach(@WriteSymbolPointers);
+  Modules^.ForEach(TCallbackProcParam(@WriteSymbolPointers));
   StoreBrowserCol:=(S^.Status=stOK);
 end;
 

+ 4 - 4
packages/fv/src/app.pas

@@ -567,7 +567,7 @@ VAR NumCols, NumRows, NumTileable, LeftOver, TileNum: Integer;
 
 BEGIN
    NumTileable := 0;                                  { Zero tileable count }
-   ForEach(@DoCountTileable);                         { Count tileable views }
+   ForEach(TCallbackProcParam(@DoCountTileable));     { Count tileable views }
    If (NumTileable>0) Then Begin
      MostEqualDivisors(NumTileable, NumCols, NumRows,
      NOT TileColumnsFirst);                           { Do pre calcs }
@@ -576,7 +576,7 @@ BEGIN
      Else Begin
        LeftOver := NumTileable MOD NumCols;           { Left over count }
        TileNum := NumTileable-1;                      { Tileable views }
-       ForEach(@DoTile);                              { Tile each view }
+       ForEach(TCallbackProcParam(@DoTile));          { Tile each view }
        DrawView;                                      { Now redraw }
      End;
    End;
@@ -622,14 +622,14 @@ VAR CascadeNum: Integer; LastView: PView; Min, Max: TPoint;
 
 BEGIN
    CascadeNum := 0;                                   { Zero cascade count }
-   ForEach(@DoCount);                                 { Count cascadable }
+   ForEach(TCallbackProcParam(@DoCount));             { Count cascadable }
    If (CascadeNum>0) Then Begin
      LastView^.SizeLimits(Min, Max);                  { Check size limits }
      If (Min.X > R.B.X - R.A.X - CascadeNum) OR
      (Min.Y > R.B.Y - R.A.Y - CascadeNum) Then
      TileError Else Begin                             { Check for error }
        Dec(CascadeNum);                               { One less view }
-       ForEach(@DoCascade);                           { Cascade view }
+       ForEach(TCallbackProcParam(@DoCascade));       { Cascade view }
        DrawView;                                      { Redraw now }
      End;
    End;

+ 12 - 0
packages/fv/src/platform.inc

@@ -278,6 +278,18 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$DEFINE OS_GO32}
 {$ENDIF}
 
+{---------------------------------------------------------------------------}
+{  FPC high level COMPILER needs nested procvars                                  }
+{---------------------------------------------------------------------------}
+
+{$IFDEF CPULLVM}
+  {$DEFINE TYPED_LOCAL_CALLBACKS}
+{$ENDIF}
+
+{$IFDEF TYPED_LOCAL_CALLBACKS}
+  {$MODESWITCH NESTEDPROCVARS}
+{$ENDIF}
+
 {---------------------------------------------------------------------------}
 {  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
 {---------------------------------------------------------------------------}

+ 1 - 1
packages/fv/src/tabs.pas

@@ -706,7 +706,7 @@ begin
   if P<>nil then Delete(P);
 end;
 begin
-  ForEach(@DeleteViews);
+  ForEach(TCallbackProcParam(@DeleteViews));
   inherited Done;
   P:=TabDefs;
   while P<>nil do

+ 19 - 13
packages/fv/src/views.pas

@@ -431,6 +431,12 @@ TYPE
 {---------------------------------------------------------------------------}
 {                  TGroup OBJECT - GROUP OBJECT ANCESTOR                    }
 {---------------------------------------------------------------------------}
+{$ifndef TYPED_LOCAL_CALLBACKS}
+   TGroupFirstThatCallback = CodePointer;
+{$else}
+   TGroupFirstThatCallback = Function(View: PView): Boolean is nested;
+{$endif}
+
    TGroup = OBJECT (TView)
          Phase   : (phFocused, phPreProcess, phPostProcess);
          EndState: Word;                              { Modal result }
@@ -445,7 +451,7 @@ TYPE
       FUNCTION GetHelpCtx: Word; Virtual;
       FUNCTION DataSize: Sw_Word; Virtual;
       FUNCTION ExecView (P: PView): Word; Virtual;
-      FUNCTION FirstThat (P: CodePointer): PView;
+      FUNCTION FirstThat (P:  TGroupFirstThatCallback): PView;
       FUNCTION Valid (Command: Word): Boolean; Virtual;
       FUNCTION FocusNext (Forwards: Boolean): Boolean;
       PROCEDURE Draw; Virtual;
@@ -457,7 +463,7 @@ TYPE
       PROCEDURE SelectDefaultView;
       PROCEDURE Insert (P: PView);
       PROCEDURE Delete (P: PView);
-      PROCEDURE ForEach (P: CodePointer);
+      PROCEDURE ForEach (P: TCallbackProcParam);
       { ForEach can't be virtual because it generates SIGSEGV }
       PROCEDURE EndModal (Command: Word); Virtual;
       PROCEDURE SelectNext (Forwards: Boolean);
@@ -2102,7 +2108,7 @@ END;
 {--TGroup-------------------------------------------------------------------}
 {  FirstThat -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB         }
 {---------------------------------------------------------------------------}
-FUNCTION TGroup.FirstThat (P: CodePointer): PView;
+FUNCTION TGroup.FirstThat (P: TGroupFirstThatCallback): PView;
 VAR
   Tp : PView;
 BEGIN
@@ -2111,7 +2117,7 @@ BEGIN
      Tp := Last;                                      { Set temporary ptr }
      Repeat
        Tp := Tp^.Next;                                { Get next view }
-       IF Byte(Longint(CallPointerMethodLocal(P,
+         IF Byte(Longint(CallPointerMethodLocal(TCallbackFunBoolParam(P),
          { On most systems, locals are accessed relative to base pointer,
            but for MIPS cpu, they are accessed relative to stack pointer.
            This needs adaptation for so low level routines,
@@ -2207,7 +2213,7 @@ PROCEDURE TGroup.Awaken;
    END;
 
 BEGIN
-   ForEach(@DoAwaken);                                { Awaken each view }
+   ForEach(TCallbackProcParam(@DoAwaken));            { Awaken each view }
 END;
 
 {--TGroup-------------------------------------------------------------------}
@@ -2300,7 +2306,7 @@ END;
 {--TGroup-------------------------------------------------------------------}
 {  ForEach -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB           }
 {---------------------------------------------------------------------------}
-PROCEDURE TGroup.ForEach (P: CodePointer);
+PROCEDURE TGroup.ForEach (P: TCallbackProcParam);
 VAR
   Tp,Hp,L0 : PView;
 { Vars Hp and L0 are necessary to hold original pointers in case   }
@@ -2398,7 +2404,7 @@ BEGIN
    Case AState Of
      sfActive, sfDragging: Begin
          Lock;                                        { Lock the view }
-         ForEach(@DoSetState);                        { Set each subview }
+         ForEach(TCallbackProcParam(@DoSetState));    { Set each subview }
          UnLock;                                      { Unlock the view }
        End;
      sfFocused: Begin
@@ -2406,7 +2412,7 @@ BEGIN
            Current^.SetState(sfFocused, Enable);          { Focus current view }
        End;
      sfExposed: Begin
-         ForEach(@DoExpose);                          { Expose each subview }
+         ForEach(TCallbackProcParam(@DoExpose));      { Expose each subview }
        End;
    End;
 END;
@@ -2458,7 +2464,7 @@ BEGIN
    OwnerGroup := @Self;                               { Set as owner group }
    Count := IndexOf(Last);                            { Subview count }
    S.Write(Count, SizeOf(Count));                     { Write the count }
-   ForEach(@DoPut);                                   { Put each in stream }
+   ForEach(TCallbackProcParam(@DoPut));               { Put each in stream }
    PutSubViewPtr(S, Current);                         { Current on stream }
    OwnerGroup := OwnerSave;                           { Restore ownergroup }
 END;
@@ -2502,16 +2508,16 @@ BEGIN
    If (Event.What = evNothing) Then Exit;             { No valid event exit }
    If (Event.What AND FocusedEvents <> 0) Then Begin  { Focused event }
      Phase := phPreProcess;                           { Set pre process }
-     ForEach(@DoHandleEvent);                         { Pass to each view }
+     ForEach(TCallbackProcParam(@DoHandleEvent));     { Pass to each view }
      Phase := phFocused;                              { Set focused }
      DoHandleEvent(Current);                          { Pass to current }
      Phase := phPostProcess;                          { Set post process }
-     ForEach(@DoHandleEvent);                         { Pass to each }
+     ForEach(TCallbackProcParam(@DoHandleEvent));     { Pass to each }
    End Else Begin
      Phase := phFocused;                              { Set focused }
      If (Event.What AND PositionalEvents <> 0) Then   { Positional event }
        DoHandleEvent(FirstThat(@ContainsMouse))       { Pass to first }
-       Else ForEach(@DoHandleEvent);                  { Pass to all }
+       Else ForEach(TCallbackProcParam(@DoHandleEvent)); { Pass to all }
    End;
 END;
 
@@ -2539,7 +2545,7 @@ BEGIN
      SetBounds(Bounds);                               { Set new bounds }
      GetExtent(Clip);                                 { Get new clip extents }
      Lock;                                            { Lock drawing }
-     ForEach(@DoCalcChange);                          { Change each view }
+     ForEach(TCallbackProcParam(@DoCalcChange));      { Change each view }
      UnLock;                                          { Unlock drawing }
    End;
 END;

+ 5 - 1
packages/ide/fpcodcmp.pas

@@ -16,6 +16,10 @@
 
 unit FPCodCmp; { CodeComplete }
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Dialogs,
@@ -269,7 +273,7 @@ begin
       New(UnitsCodeCompleteWords, Init(10,10));
       level:=0;
       Overflow:=false;
-      BrowCol.Modules^.ForEach(@InsertInS);
+      BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
       { if Overflow then
         WarningBox(msg_toomanysymbolscantdisplayall,nil); }
     end;

+ 3 - 5
packages/ide/fpcodtmp.pas

@@ -15,10 +15,8 @@
 
 unit FPCodTmp; { Code Templates }
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
 {$endif}
 
 interface
@@ -154,7 +152,7 @@ begin
 end;
 begin
   if Assigned(AList) and Assigned(Text) then
-    Text^.ForEach(@CopyIt);
+    Text^.ForEach(TCallbackProcParam(@CopyIt));
 end;
 
 procedure TCodeTemplate.SetShortCut(const AShortCut: string);

+ 4 - 9
packages/ide/fpcompil.pas

@@ -12,15 +12,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$i globdir.inc}
 unit FPCompil;
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
-
 interface
 
 { don't redir under linux, because all stdout (also from the ide!) will
@@ -32,6 +25,8 @@ interface
 
 {$mode objfpc}
 
+{$i globdir.inc}
+
 uses
   { We need to include the exceptions from SysUtils, but the types from
     Objects need to be used. Keep the order SysUtils,Objects }
@@ -390,7 +385,7 @@ procedure TCompilerMessageListBox.SelectFirstError;
   var
     P : PCompilerMessage;
 begin
-  P:=List^.FirstThat(@IsError);
+  P:=List^.FirstThat(TCallbackFunBoolParam(@IsError));
   If Assigned(P) then
     Begin
       FocusItem(List^.IndexOf(P));
@@ -861,7 +856,7 @@ procedure ResetErrorMessages;
        PSourceWindow(P)^.Editor^.SetErrorMessage('');
   end;
 begin
-  Desktop^.ForEach(@ResetErrorLine);
+  Desktop^.ForEach(TCallbackProcParam(@ResetErrorLine));
 end;
 
 

+ 18 - 18
packages/ide/fpdebug.pas

@@ -18,8 +18,8 @@ interface
 implementation
 end.
 {$else}
-interface
 {$i globdir.inc}
+interface
 uses
 {$ifdef Windows}
   Windows,
@@ -770,7 +770,7 @@ procedure TDebugController.InsertBreakpoints;
   end;
 
 begin
-  BreakpointsCollection^.ForEach(@DoInsert);
+  BreakpointsCollection^.ForEach(TCallbackProcParam(@DoInsert));
   Disableallinvalidbreakpoints:=false;
 end;
 
@@ -782,7 +782,7 @@ procedure TDebugController.ReadWatches;
   end;
 
 begin
-  WatchesCollection^.ForEach(@DoRead);
+  WatchesCollection^.ForEach(TCallbackProcParam(@DoRead));
   If Assigned(WatchesWindow) then
     WatchesWindow^.Update;
 end;
@@ -795,7 +795,7 @@ procedure TDebugController.RereadWatches;
   end;
 
 begin
-  WatchesCollection^.ForEach(@DoRead);
+  WatchesCollection^.ForEach(TCallbackProcParam(@DoRead));
   If Assigned(WatchesWindow) then
     WatchesWindow^.Update;
 end;
@@ -807,7 +807,7 @@ procedure TDebugController.RemoveBreakpoints;
       PB^.Remove;
     end;
 begin
-   BreakpointsCollection^.ForEach(@DoDelete);
+   BreakpointsCollection^.ForEach(TCallbackProcParam(@DoDelete));
 end;
 
 procedure TDebugController.ResetBreakpointsValues;
@@ -816,7 +816,7 @@ procedure TDebugController.ResetBreakpointsValues;
       PB^.ResetValues;
     end;
 begin
-   BreakpointsCollection^.ForEach(@DoResetVal);
+   BreakpointsCollection^.ForEach(TCallbackProcParam(@DoResetVal));
 end;
 
 destructor TDebugController.Done;
@@ -1168,7 +1168,7 @@ procedure TDebugController.ResetDebuggerRows;
   end;
 
 begin
-  Desktop^.ForEach(@ResetDebuggerRow);
+  Desktop^.ForEach(TCallbackProcParam(@ResetDebuggerRow));
 end;
 
 procedure TDebugController.Reset;
@@ -1614,7 +1614,7 @@ function  ActiveBreakpoints : boolean;
 begin
    IsActive:=false;
    If assigned(BreakpointsCollection) then
-     BreakpointsCollection^.ForEach(@TestActive);
+     BreakpointsCollection^.ForEach(TCallbackProcParam(@TestActive));
    ActiveBreakpoints:=IsActive;
 end;
 
@@ -1959,7 +1959,7 @@ begin
   if index=0 then
     GetGDB:=nil
   else
-    GetGDB:=FirstThat(@IsNum);
+    GetGDB:=FirstThat(TCallbackFunBoolParam(@IsNum));
 end;
 
 procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
@@ -2008,9 +2008,9 @@ procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
 
 begin
   if W=PFPWindow(DisassemblyWindow) then
-    ForEach(@SetInDisassembly)
+    ForEach(TCallbackProcParam(@SetInDisassembly))
   else
-    ForEach(@SetInSource);
+    ForEach(TCallbackProcParam(@SetInSource));
 end;
 
 
@@ -2042,7 +2042,7 @@ procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Ch
   var
     I : longint;
 begin
-  ForEach(@AdaptInSource);
+  ForEach(TCallbackProcParam(@AdaptInSource));
   I:=Count-1;
   While (I>=0) do
     begin
@@ -2065,7 +2065,7 @@ function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : l
   end;
 
 begin
-  FindBreakpointAt:=FirstThat(@IsAtLine);
+  FindBreakpointAt:=FirstThat(TCallbackFunBoolParam(@IsAtLine));
 end;
 
 procedure TBreakpointCollection.ShowAllBreakpoints;
@@ -2083,7 +2083,7 @@ procedure TBreakpointCollection.ShowAllBreakpoints;
   end;
 
 begin
-  ForEach(@SetInSource);
+  ForEach(TCallbackProcParam(@SetInSource));
 end;
 
 function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
@@ -2094,7 +2094,7 @@ function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) :
   end;
 
 begin
-  GetType:=FirstThat(@IsThis);
+  GetType:=FirstThat(TCallbackFunBoolParam(@IsThis));
 end;
 
 
@@ -2111,7 +2111,7 @@ var
 begin
     ToggleFileLine:=false;
     FileName:=OSFileName(FExpand(FileName));
-    PB:=FirstThat(@IsThere);
+    PB:=FirstThat(TCallbackFunBoolParam(@IsThere));
     If Assigned(PB) then
       begin
         { delete it form source window }
@@ -2610,7 +2610,7 @@ procedure TBreakpointsWindow.ReloadBreakpoints;
 begin
   If not assigned(BreakpointsCollection) then
     exit;
-  BreakpointsCollection^.ForEach(@InsertInBreakLB);
+  BreakpointsCollection^.ForEach(TCallbackProcParam(@InsertInBreakLB));
   ReDraw;
 end;
 
@@ -3004,7 +3004,7 @@ destructor TWatch.Done;
 
          begin
           W:=0;
-          ForEach(@GetMax);
+          ForEach(TCallbackProcParam(@GetMax));
           MaxW:=W;
           If assigned(WatchesWindow) then
             WatchesWindow^.WLB^.Update(MaxW);

+ 5 - 1
packages/ide/fphelp.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit FPHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -686,7 +690,7 @@ begin
     end;
 end;
 begin
-  Desktop^.ForEach(@CloseIfHelpWindow);
+  Desktop^.ForEach(TCallbackProcParam(@CloseIfHelpWindow));
 end;
 
 END.

+ 1 - 6
packages/ide/fpide.pas

@@ -14,15 +14,10 @@
  **********************************************************************}
 unit fpide;
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
+{$i globdir.inc}
 
 interface
 
-{$i globdir.inc}
 
 uses
   Objects,Drivers,Views,App,Gadgets,MsgBox,Tabs,

+ 1 - 1
packages/ide/fpini.pas

@@ -681,7 +681,7 @@ begin
   INIFile^.SetEntry(secCompile,ieCompileMode,SwitchesModeStr[SwitchesMode]);
   { Help }
   S:='';
-  HelpFiles^.ForEach(@ConcatName);
+  HelpFiles^.ForEach(TCallbackProcParam(@ConcatName));
   INIFile^.SetEntry(secHelp,ieHelpFiles,EscapeIniText(S));
   { Editor }
   INIFile^.SetIntEntry(secEditor,ieDefaultTabSize,DefaultTabSize);

+ 1 - 1
packages/ide/fpmfile.inc

@@ -205,7 +205,7 @@ function TIDEApp.SaveAll: boolean;
 
 begin
   SaveCancelled:=false;
-  Desktop^.ForEach(@SendSave);
+  Desktop^.ForEach(TCallbackProcParam(@SendSave));
   SaveAll:=not SaveCancelled;
 end;
 

+ 3 - 3
packages/ide/fpmsrch.inc

@@ -98,7 +98,7 @@ begin
     end;
   New(S, Init(500,500));
   ProcedureCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   if Overflow then
     WarningBox(msg_toomanysymbolscantdisplayall,nil);
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
@@ -153,7 +153,7 @@ begin
     end;
   New(S, Init(500,500));
   GlobalsCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   if Overflow then
     WarningBox(msg_toomanysymbolscantdisplayall,nil);
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
@@ -179,7 +179,7 @@ begin
     end;
   New(S, Init(500,500));
   ModulesCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
   Desktop^.Insert(New(PBrowserWindow, Init(R,
     dialog_units,SearchFreeWindowNo,nil,label_sym_globalscope,'',S,nil,nil,nil)));

+ 3 - 3
packages/ide/fpmwnd.inc

@@ -21,7 +21,7 @@ procedure TIDEApp.CloseAll;
   end;
 
 begin
-  Desktop^.ForEach(@SendClose);
+  Desktop^.ForEach(TCallbackProcParam(@SendClose));
 end;
 
 procedure TIDEApp.ResizeApplication(x, y : longint);
@@ -154,8 +154,8 @@ begin
 end;
 begin
   C^.DeleteAll;
-  VisState:=true; Desktop^.ForEach(@AddIt); { add visible windows to list }
-  VisState:=false; Desktop^.ForEach(@AddIt); { add hidden windows }
+  VisState:=true; Desktop^.ForEach(TCallbackProcParam(@AddIt)); { add visible windows to list }
+  VisState:=false; Desktop^.ForEach(TCallbackProcParam(@AddIt)); { add hidden windows }
   LB^.SetRange(C^.Count);
   UpdateButtons;
   ReDraw;

+ 10 - 6
packages/ide/fpswitch.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit FPSwitch;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -804,7 +808,7 @@ function  TSwitches.SetCurrSelParam(const s : String) : boolean;
 var
   FoundP : PSwitchItem;
 begin
-  FoundP:=Items^.FirstThat(@CheckItem);
+  FoundP:=Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   if Assigned(FoundP) then
     begin
       SetCurrSelParam:=true;
@@ -867,7 +871,7 @@ begin
         end;
     end
   else
-    Items^.ForEach(@writeitem);
+    Items^.ForEach(TCallbackProcParam(@writeitem));
 end;
 
 procedure WriteCustom;
@@ -906,7 +910,7 @@ var
   FoundP : PSwitchItem;
   code : integer;
 begin
-  FoundP:=Items^.FirstThat(@checkitem);
+  FoundP:=Items^.FirstThat(TCallbackFunBoolParam(@checkitem));
   if assigned(FoundP) then
    begin
      case FoundP^.Typ of
@@ -1074,12 +1078,12 @@ var
 begin
   GetSourceDirectories:='';
   c:='u';
-  P:=DirectorySwitches^.Items^.FirstThat(@CheckItem);
+  P:=DirectorySwitches^.Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   S:='';
   if assigned(P) then
     S:=P^.Str[SwitchesMode];
   c:='i';
-  P:=DirectorySwitches^.Items^.FirstThat(@CheckItem);
+  P:=DirectorySwitches^.Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   if assigned(P) then
     S:=P^.Str[SwitchesMode]+';'+S;
   if S='' then
@@ -1549,7 +1553,7 @@ begin
    end;
 end;
 begin
-  P^.Items^.ForEach(@HandleSwitch);
+  P^.Items^.ForEach(TCallbackProcParam(@HandleSwitch));
 end;
 var I: integer;
     S: string;

+ 3 - 3
packages/ide/fpsymbol.pas

@@ -298,7 +298,7 @@ procedure CloseAllBrowsers;
   end;
 
 begin
-  Desktop^.ForEach(@SendCloseIfBrowser);
+  Desktop^.ForEach(TCallbackProcParam(@SendCloseIfBrowser));
 end;
 
 procedure RemoveBrowsersCollection;
@@ -367,7 +367,7 @@ begin
    Name:=UpcaseStr(Name);
    If BrowCol.Modules<>nil then
      begin
-       PS:=BrowCol.Modules^.FirstThat(@Search);
+       PS:=BrowCol.Modules^.FirstThat(TCallbackFunBoolParam(@Search));
        If assigned(PS) then
          begin
            S:=PS^.Items^.At(Index);
@@ -744,7 +744,7 @@ begin
 end;
 begin
   BW:=nil;
-  Desktop^.ForEach(@IsBW);
+  Desktop^.ForEach(TCallbackProcParam(@IsBW));
   LastBrowserWindow:=BW;
 end;
 

+ 6 - 2
packages/ide/fptools.pas

@@ -15,6 +15,10 @@
 {$I globdir.inc}
 unit FPTools;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Views,Dialogs,Validate,
@@ -822,7 +826,7 @@ begin
   if OK then
     begin
       ViewCount:=0;
-      F^.ForEachSection(@ProcessSection);
+      F^.ForEachSection(TCallbackProcParam(@ProcessSection));
     end;
   BuildPromptDialogInfo:=OK;
 end;
@@ -1422,7 +1426,7 @@ end;
 begin
   if not Assigned(ToolTempFiles) then Exit;
 {$ifndef DEBUG}
-  ToolTempFiles^.ForEach(@DeleteIt);
+  ToolTempFiles^.ForEach(TCallbackProcParam(@DeleteIt));
 {$endif ndef DEBUG}
   Dispose(ToolTempFiles, Done);
   ToolTempFiles:=nil;

+ 3 - 3
packages/ide/fpviews.pas

@@ -742,7 +742,7 @@ begin
     PSourceWindow(P)^.Editor^.ReloadFile;
 end;
 begin
-  Desktop^.ForEach(@EditorWindowModifiedOnDisk);
+  Desktop^.ForEach(TCallbackProcParam(@EditorWindowModifiedOnDisk));
 end;
 
 function IsThereAnyHelpWindow: boolean;
@@ -2726,7 +2726,7 @@ function   TDisassemblyEditor.GetCurrentLine(address : CORE_ADDR) : PDisasLine;
   Var
     PL : PDisasLine;
 begin
-  PL:=DisasLines^.FirstThat(@IsCorrectLine);
+  PL:=DisasLines^.FirstThat(TCallbackFunBoolParam(@IsCorrectLine));
   if Assigned(PL) then
     begin
       if assigned(CurL) then
@@ -3766,7 +3766,7 @@ begin
   if P<>nil then Delete(P);
 end;
 begin
-  ForEach(@DeleteViews);
+  ForEach(TCallbackProcParam(@DeleteViews));
   inherited Done;
   P:=TabDefs;
   while P<>nil do

+ 8 - 0
packages/ide/globdir.inc

@@ -221,3 +221,11 @@
     {$define GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE}
   {$endif Windows}
 {$endif GDBMI}
+
+{$ifdef cpullvm}
+{$define TYPED_LOCAL_CALLBACKS}
+{$endif}
+
+{$ifdef TYPED_LOCAL_CALLBACKS}
+{$modeswitch nestedprocvars}
+{$endif}

+ 8 - 4
packages/ide/wcedit.pas

@@ -15,6 +15,10 @@
 {$i globdir.inc}
 unit WCEdit;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Views,
@@ -336,7 +340,7 @@ begin
   if not assigned(EditorInfos) then
     GetEditorInfo:=DefaultEditorInfo
   else
-    GetEditorInfo:=EditorInfos^.FirstThat(@Match);
+    GetEditorInfo:=EditorInfos^.FirstThat(TCallbackFunBoolParam(@Match));
 end;
 
 function TLine.GetFlags: longint;
@@ -477,7 +481,7 @@ begin
 end;
 begin
   if Assigned(Lines) then
-    Lines^.ForEach(@AddIt);
+    Lines^.ForEach(TCallbackProcParam(@AddIt));
 end;
 
 procedure TCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
@@ -488,7 +492,7 @@ end;
 begin
   DeleteAllLines;
   if Assigned(ALines) then
-    ALines^.ForEach(@AddIt);
+    ALines^.ForEach(TCallbackProcParam(@AddIt));
   LimitsChanged;
 end;
 
@@ -541,7 +545,7 @@ end;
 begin
   if Idx=-1 then Idx:=Lines^.Count;
   I:=0;
-  Bindings^.ForEach(@RegLine);
+  Bindings^.ForEach(TCallbackProcParam(@RegLine));
   Lines^.AtInsert(Idx,Line);
 end;
 

+ 18 - 14
packages/ide/weditor.pas

@@ -15,6 +15,10 @@
 {$I globdir.inc}
 unit WEditor;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 {tes}
 uses
@@ -1421,7 +1425,7 @@ begin
 end;
 begin
   Count:=LineCount_;
-  if assigned(Childs) then Childs^.ForEach(@AddIt);
+  if assigned(Childs) then Childs^.ForEach(TCallbackProcParam(@AddIt));
   GetLineCount:=Count;
 end;
 
@@ -1592,7 +1596,7 @@ begin
   SearchEditor:=P^.Editor=AEditor;
 end;
 begin
-  SearchBinding:=Bindings^.FirstThat(@SearchEditor);
+  SearchBinding:=Bindings^.FirstThat(TCallbackFunBoolParam(@SearchEditor));
 end;
 
 function TCustomCodeEditorCore.CanDispose: boolean;
@@ -1644,7 +1648,7 @@ begin
   IsClip:=(P^.Editor=Clipboard);
 end;
 begin
-  IsClipBoard:=Bindings^.FirstThat(@IsClip)<>nil;
+  IsClipBoard:=Bindings^.FirstThat(TCallbackFunBoolParam(@IsClip))<>nil;
 end;
 
 function TCustomCodeEditorCore.GetTabSize: integer;
@@ -1716,7 +1720,7 @@ begin
   P^.Editor^.BindingsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoLimitsChanged;
@@ -1725,7 +1729,7 @@ begin
   P^.Editor^.DoLimitsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoContentsChanged;
@@ -1734,7 +1738,7 @@ begin
   P^.Editor^.ContentsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoModifiedChanged;
@@ -1743,7 +1747,7 @@ begin
   P^.Editor^.ModifiedChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoTabSizeChanged;
@@ -1752,7 +1756,7 @@ begin
   P^.Editor^.TabSizeChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.UpdateUndoRedo(cm : word; action : byte);
@@ -1770,7 +1774,7 @@ begin
     end;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 
@@ -1780,7 +1784,7 @@ begin
   P^.Editor^.StoreUndoChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 procedure   TCustomCodeEditorCore.DoSyntaxStateChanged;
 procedure CallIt(P: PEditorBinding);
@@ -1788,7 +1792,7 @@ begin
   P^.Editor^.SyntaxStateChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 function TCustomCodeEditorCore.GetLastVisibleLine : sw_integer;
@@ -1801,7 +1805,7 @@ begin
 end;
 begin
   y:=0;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   GetLastVisibleLine:=y;
 end;
 
@@ -2050,7 +2054,7 @@ begin
 end;
 begin
   MinLine:=-1;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   UpdateAttrs:=MinLine;
 end;
 
@@ -2064,7 +2068,7 @@ begin
 end;
 begin
   MinLine:=-1;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   UpdateAttrsRange:=MinLine;
 end;
 

+ 15 - 11
packages/ide/whelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -384,7 +388,7 @@ begin
   if Assigned(T^.NamedMarks) then
   begin
     New(NT^.NamedMarks, Init(T^.NamedMarks^.Count,10));
-    T^.NamedMarks^.ForEach(@CloneMark);
+    T^.NamedMarks^.ForEach(TCallbackProcParam(@CloneMark));
   end;
   NT^.ExtDataSize:=T^.ExtDataSize;
   if Assigned(T^.ExtData) and (T^.ExtDataSize>0) then
@@ -686,10 +690,10 @@ procedure SearchLRU(P: PTopic);
 begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; end; end;
 var P: PTopic;
 begin
-  Count:=0; Topics^.ForEach(@CountThem);
+  Count:=0; Topics^.ForEach(TCallbackProcParam(@CountThem));
   if (Count>=TopicCacheSize) then
   begin
-    MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(@SearchLRU);
+    MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(TCallbackProcParam(@SearchLRU));
     if P<>nil then
     begin
       FreeMem(P^.Text,P^.TextSize); P^.TextSize:=0; P^.Text:=nil;
@@ -758,7 +762,7 @@ begin
        HelpFile:=SearchFile(SourceFileID);
        P:=SearchTopicInHelpFile(HelpFile,Context);
      end;
-  if P=nil then HelpFiles^.FirstThat(@Search);
+  if P=nil then HelpFiles^.FirstThat(TCallbackFunBoolParam(@Search));
   if P=nil then HelpFile:=nil;
   SearchTopicOwner:=HelpFile;
 end;
@@ -808,7 +812,7 @@ end;
 var P: PIndexEntry;
 begin
   H^.LoadIndex;
-  P:=H^.IndexEntries^.FirstThat(@SearchExact);
+  P:=H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@SearchExact));
   if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
   ScanHelpFileExact:=P<>nil;
 end;
@@ -820,7 +824,7 @@ end;
 var P: PIndexEntry;
 begin
   H^.LoadIndex;
-  P:=H^.IndexEntries^.FirstThat(@Search);
+  P:=H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@Search));
   if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
   ScanHelpFile:=P<>nil;
 end;
@@ -828,9 +832,9 @@ var
   PH : PHelpFile;
 begin
   Keyword:=UpcaseStr(Keyword);
-  PH:=HelpFiles^.FirstThat(@ScanHelpFileExact);
+  PH:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@ScanHelpFileExact));
   if not assigned(PH) then
-    PH:=HelpFiles^.FirstThat(@ScanHelpFile);
+    PH:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@ScanHelpFile));
   TopicSearch:=PH<>nil;
 end;
 
@@ -847,7 +851,7 @@ end;
 begin
   H^.LoadIndex;
   if Keywords^.Count<MaxCollectionSize then
-  H^.IndexEntries^.FirstThat(@InsertKeywords);
+  H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@InsertKeywords));
 end;
 procedure AddLine(S: string);
 begin
@@ -912,7 +916,7 @@ var KW: PIndexEntry;
     St,LastTag : String;
 begin
   New(Keywords, Init(5000,5000));
-  HelpFiles^.ForEach(@InsertKeywordsOfFile);
+  HelpFiles^.ForEach(TCallbackProcParam(@InsertKeywordsOfFile));
   New(Lines, Init((Keywords^.Count div 2)+100,1000));
   T:=NewTopic(0,0,0,'',nil,0);
   if HelpFiles^.Count=0 then
@@ -978,7 +982,7 @@ begin
   Match:=(P^.ID=ID);
 end;
 begin
-  SearchFile:=HelpFiles^.FirstThat(@Match);
+  SearchFile:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@Match));
 end;
 
 function THelpFacility.SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;

+ 6 - 2
packages/ide/whtmlhlp.pas

@@ -12,6 +12,10 @@
  **********************************************************************}
 unit WHTMLHlp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,WHTML,WAnsi,WHelp,WChmHWrap;
@@ -1399,7 +1403,7 @@ begin
   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
     begin
-      P:=Topics^.FirstThat(@MatchCtx);
+      P:=Topics^.FirstThat(TCallbackFunBoolParam(@MatchCtx));
       if P=nil then
         begin
           if LinkNo=0 then
@@ -1673,7 +1677,7 @@ begin
   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
     begin
-      P:=Topics^.FirstThat(@MatchCtx);
+      P:=Topics^.FirstThat(TCallbackFunBoolParam(@MatchCtx));
       if P=nil then
         begin
           if LinkNo=0 then

+ 7 - 3
packages/ide/whtmlscn.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WHTMLScn;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -531,7 +535,7 @@ procedure THTMLLinkScanDocumentCollection.MoveAliasesToSynonym;
       end;
   end;
 begin
-  ForEach(@MoveAliases);
+  ForEach(TCallbackProcParam(@MoveAliases));
 end;
 
 constructor THTMLLinkScanner.Init(const ABaseDir: string);
@@ -834,7 +838,7 @@ procedure THTMLLinkScanFileCollection.CheckNameIDLists;
     end;
 
 begin
-  ForEach(@DoCheckNameList);
+  ForEach(TCallbackProcParam(@DoCheckNameList));
 end;
 
 
@@ -985,7 +989,7 @@ function THTMLFileLinkScanner.FindID(const AName : string) : PNameID;
 var
   D : PHTMLLinkScanFile;
 begin
-  D:=DocumentFiles^.FirstThat(@ContainsNamedID);
+  D:=DocumentFiles^.FirstThat(TCallbackFunBoolParam(@ContainsNamedID));
   if assigned(D) then
     FindID:=D^.FindID(AName)
   else

+ 12 - 8
packages/ide/wini.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WINI;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects;
@@ -49,7 +53,7 @@ type
       function    AddEntry(const Tag,Value,Comment: string): PINIEntry;
       function    SearchEntry(Tag: string): PINIEntry; virtual;
       procedure   DeleteEntry(Tag: string);
-      procedure   ForEachEntry(EnumProc: pointer); virtual;
+      procedure   ForEachEntry(EnumProc: TCallbackProcParam); virtual;
       destructor  Done; virtual;
     private
       NameHash : Cardinal;
@@ -67,8 +71,8 @@ type
       function    IsModified: boolean; virtual;
       function    SearchSection(Section: string): PINISection; virtual;
       function    SearchEntry(const Section, Tag: string): PINIEntry; virtual;
-      procedure   ForEachSection(EnumProc: pointer); virtual;
-      procedure   ForEachEntry(const Section: string; EnumProc: pointer); virtual;
+      procedure   ForEachSection(EnumProc: TCallbackProcParam); virtual;
+      procedure   ForEachEntry(const Section: string; EnumProc: TCallbackProcParam); virtual;
       function    GetEntry(const Section, Tag, Default: string): string; virtual;
       procedure   SetEntry(const Section, Tag, Value: string); virtual;
       procedure   SetEntry(const Section, Tag, Value,Comment: string); virtual;
@@ -354,7 +358,7 @@ begin
   AddEntry:=E;
 end;
 
-procedure TINIFile.ForEachSection(EnumProc: pointer);
+procedure TINIFile.ForEachSection(EnumProc: TCallbackProcParam);
 var I: Sw_integer;
    S: PINISection;
 begin
@@ -365,7 +369,7 @@ begin
     end;
 end;
 
-procedure TINISection.ForEachEntry(EnumProc: pointer);
+procedure TINISection.ForEachEntry(EnumProc: TCallbackProcParam);
 var I: integer;
     E: PINIEntry;
 begin
@@ -472,11 +476,11 @@ function TINIFile.IsModified: boolean;
     end;
 
   begin
-    SectionModified:=(P^.Entries^.FirstThat(@EntryModified)<>nil);
+    SectionModified:=(P^.Entries^.FirstThat(TCallbackFunBoolParam(@EntryModified))<>nil);
   end;
 
 begin
-  IsModified:=(Sections^.FirstThat(@SectionModified)<>nil);
+  IsModified:=(Sections^.FirstThat(TCallbackFunBoolParam(@SectionModified))<>nil);
 end;
 
 
@@ -554,7 +558,7 @@ begin
   SearchEntry:=E;
 end;
 
-procedure TINIFile.ForEachEntry(const Section: string; EnumProc: pointer);
+procedure TINIFile.ForEachEntry(const Section: string; EnumProc: TCallbackProcParam);
 var P: PINISection;
     E: PINIEntry;
     I: integer;

+ 11 - 7
packages/ide/wnghelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WNGHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -109,8 +113,8 @@ type
         IndexLoaded: boolean;
 {        NextHelpCtx: longint;}
         function ReadHeader: boolean;
-        function ReadContainer(EnumProc: pointer): boolean;
-        function ReadTopicRec(LineEnumProc: pointer; LinkEnumProc: pointer): boolean;
+        function ReadContainer(EnumProc: TCallbackProcParam): boolean;
+        function ReadTopicRec(LineEnumProc: TCallbackProcParam; LinkEnumProc: TCallbackProcParam): boolean;
         function ReadRecord(var R: TRecord; ReadData: boolean): boolean;
       end;
 
@@ -228,7 +232,7 @@ begin
   ReadHeader:=OK;
 end;
 
-function TNGHelpFile.ReadContainer(EnumProc: pointer): boolean;
+function TNGHelpFile.ReadContainer(EnumProc: TCallbackProcParam): boolean;
 var OK: boolean;
     R: TRecord;
     I: longint;
@@ -259,7 +263,7 @@ begin
   ReadContainer:=OK;
 end;
 
-function TNGHelpFile.ReadTopicRec(LineEnumProc, LinkEnumProc: pointer): boolean;
+function TNGHelpFile.ReadTopicRec(LineEnumProc, LinkEnumProc: TCallbackProcParam): boolean;
 var OK: boolean;
     R: TRecord;
     I: sw_integer;
@@ -380,7 +384,7 @@ begin
       OK:=ReadRecord(R,false);
       if (OK=false) then Break;
       case R.SClass of
-        ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(@AddToIndex); end;
+        ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(TCallbackProcParam(@AddToIndex)); end;
         ng_rtTopic     : ;
       else
        begin
@@ -477,14 +481,14 @@ begin
         begin
           F^.Seek(T^.FileOfs);
           AddLine('');
-          OK:=ReadContainer(@AddToTopic);
+          OK:=ReadContainer(TCallbackProcParam(@AddToTopic));
           RenderTopic(Lines,T);
         end;
       ng_rtTopic     :
         begin
           F^.Seek(T^.FileOfs);
           AddLine('');
-          OK:=ReadTopicRec(@AddTopicLine,@AddLink);
+          OK:=ReadTopicRec(TCallbackProcParam(@AddTopicLine),TCallbackProcParam(@AddLink));
           TranslateLines(Lines);
           AddLine('');
           { include copyright info }

+ 18 - 14
packages/ide/wresourc.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WResourc;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects;
@@ -79,8 +83,8 @@ type
      TResource = object(TObject)
        constructor Init(const AName: string; AClass, AFlags: longint);
        function    GetName: string; virtual;
-       function    FirstThatEntry(Func: pointer): PResourceEntry; virtual;
-       procedure   ForEachEntry(Func: pointer); virtual;
+       function    FirstThatEntry(Func: TCallbackFunBoolParam): PResourceEntry; virtual;
+       procedure   ForEachEntry(Func: TCallbackProcParam); virtual;
        destructor  Done; virtual;
      private
        Name   : PString;
@@ -103,9 +107,9 @@ type
        constructor Load(var RS: TStream);
        constructor CreateFile(AFileName: string);
        constructor LoadFile(AFileName: string);
-       function    FirstThatResource(Func: pointer): PResource; virtual;
-       procedure   ForEachResource(Func: pointer); virtual;
-       procedure   ForEachResourceEntry(Func: pointer); virtual;
+       function    FirstThatResource(Func: TCallbackFunBoolParam): PResource; virtual;
+       procedure   ForEachResource(Func: TCallbackProcParam); virtual;
+       procedure   ForEachResourceEntry(Func: TCallbackProcParam); virtual;
        function    CreateResource(const Name: string; AClass, AFlags: longint): boolean; virtual;
        function    AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
                    ADataSize: sw_integer): boolean; virtual;
@@ -220,7 +224,7 @@ begin
   GetName:=GetStr(Name);
 end;
 
-function TResource.FirstThatEntry(Func: pointer): PResourceEntry;
+function TResource.FirstThatEntry(Func: TCallbackFunBoolParam): PResourceEntry;
 var EP,P: PResourceEntry;
     I: sw_integer;
 begin
@@ -238,7 +242,7 @@ begin
   FirstThatEntry:=P;
 end;
 
-procedure TResource.ForEachEntry(Func: pointer);
+procedure TResource.ForEachEntry(Func: TCallbackProcParam);
 var RP: PResourceEntry;
     I: sw_integer;
 begin
@@ -364,7 +368,7 @@ begin
     end;
 end;
 
-function TResourceFile.FirstThatResource(Func: pointer): PResource;
+function TResourceFile.FirstThatResource(Func: TCallbackFunBoolParam): PResource;
 var RP,P: PResource;
     I: sw_integer;
 begin
@@ -382,7 +386,7 @@ begin
   FirstThatResource:=P;
 end;
 
-procedure TResourceFile.ForEachResource(Func: pointer);
+procedure TResourceFile.ForEachResource(Func: TCallbackProcParam);
 var RP: PResource;
     I: sw_integer;
 begin
@@ -393,7 +397,7 @@ begin
     end;
 end;
 
-procedure TResourceFile.ForEachResourceEntry(Func: pointer);
+procedure TResourceFile.ForEachResourceEntry(Func: TCallbackProcParam);
 var E: PResourceEntry;
     I: sw_integer;
 begin
@@ -659,10 +663,10 @@ begin
   S^.Write(RH,SizeOf(RH));
   N:=P^.GetName;
   S^.Write(N[1],length(N));
-  P^.ForEachEntry(@WriteResourceEntry);
+  P^.ForEachEntry(TCallbackProcParam(@WriteResourceEntry));
 end;
 begin
-  ForEachResource(@WriteResource);
+  ForEachResource(TCallbackProcParam(@WriteResource));
 end;
 
 procedure TResourceFile.UpdateBlockDatas;
@@ -695,10 +699,10 @@ end;
 begin
   Size:=0; NamesSize:=0;
   Inc(Size,SizeOf(Header)); { this is on start so we always include it }
-  ForEachResourceEntry(@AddResourceEntrySize);
+  ForEachResourceEntry(TCallbackProcParam(@AddResourceEntrySize));
   if IncludeHeaders then
     begin
-      ForEachResource(@AddResourceSize);
+      ForEachResource(TCallbackProcParam(@AddResourceSize));
       Inc(Size,SizeOf(RH)*Resources^.Count);
       Inc(Size,SizeOf(REH)*Entries^.Count);
       Inc(Size,NamesSize);

+ 5 - 1
packages/ide/wutils.pas

@@ -12,6 +12,10 @@
  **********************************************************************}
 unit WUtils;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -687,7 +691,7 @@ end;
 begin
   FreeAll;
   if Assigned(ALines) then
-    ALines^.ForEach(@AddIt);
+    ALines^.ForEach(TCallbackProcParam(@AddIt));
 end;
 
 procedure TUnsortedStringCollection.InsertStr(const S: string);

+ 8 - 4
packages/ide/wwinhelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WWinHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -225,7 +229,7 @@ type
         function UsesHallCompression: boolean;
         procedure ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
         function  ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
-        function  ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
+        function  ProcessTopicBlock(BlockNo: longint; EnumProc: TCallbackFunBoolParam): boolean;
         procedure PhraseDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
         procedure HallDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
       end;
@@ -1165,7 +1169,7 @@ begin
   end;
 end;
 
-function TWinHelpFile.ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
+function TWinHelpFile.ProcessTopicBlock(BlockNo: longint; EnumProc: TCallbackFunBoolParam): boolean;
 var TB: TTopicBlock;
     TL: TWinHelpTopicLink;
     BlockFileOfs: longint;
@@ -1643,14 +1647,14 @@ begin
   begin
     ExtractTopicOffset(T^.FileOfs,BlockNo,BlockOfs);
     TopicStartPos:=-1; GotIt:=false;
-    OK:=ProcessTopicBlock(BlockNo,@SearchTopicStart);
+    OK:=ProcessTopicBlock(BlockNo,TCallbackFunBoolParam(@SearchTopicStart));
     OK:=OK and GotIt and (TopicStartPos<>-1);
     if OK then
     begin
       CurLine:='';
       New(Lines, Init(1000,1000));
       LastEmittedChar:=-1;
-      OK:=ProcessTopicBlock(BlockNo,@RenderTopicProc);
+      OK:=ProcessTopicBlock(BlockNo,TCallbackFunBoolParam(@RenderTopicProc));
       FlushLine;
       BuildTopic(Lines,T);
       Dispose(Lines, Done);

+ 127 - 13
packages/rtl-extra/src/inc/objects.pp

@@ -35,6 +35,14 @@
 {                                                          }
 UNIT Objects;
 
+{$ifdef cpullvm}
+{$define TYPED_LOCAL_CALLBACKS}
+{$endif}
+
+{$ifdef TYPED_LOCAL_CALLBACKS}
+{$modeswitch nestedprocvars}
+{$endif}
+
 {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                   INTERFACE
 {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
@@ -125,6 +133,24 @@ CONST
 {                          PUBLIC TYPE DEFINITIONS                          }
 {***************************************************************************}
 
+{ Callbacks }
+TYPE
+{$ifndef TYPED_LOCAL_CALLBACKS}
+   TCallbackFun = CodePointer;
+   TCallbackProc = CodePointer;
+   TCallbackFunParam = CodePointer;
+   TCallbackFunBool = CodePointer;
+   TCallbackFunBoolParam = CodePointer;
+   TCallbackProcParam = CodePointer;
+{$else}
+   TCallbackFun = Function: Pointer is nested;
+   TCallbackProc = Procedure is nested;
+   TCallbackFunParam = Function(Item: Pointer): Pointer is nested;
+   TCallbackFunBool = Function: Boolean is nested;
+   TCallbackFunBoolParam = Function(Item: Pointer): Boolean is nested;
+   TCallbackProcParam = Procedure(Item: Pointer) is nested;
+{$endif}
+
 {---------------------------------------------------------------------------}
 {                               CHARACTER SET                               }
 {---------------------------------------------------------------------------}
@@ -412,8 +438,8 @@ TYPE
       FUNCTION At (Index: Sw_Integer): Pointer;
       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
-      FUNCTION LastThat (Test: CodePointer): Pointer;
-      FUNCTION FirstThat (Test: CodePointer): Pointer;
+      FUNCTION LastThat (Test: TCallbackFunBoolParam): Pointer;
+      FUNCTION FirstThat (Test: TCallbackFunBoolParam): Pointer;
       PROCEDURE Pack;
       PROCEDURE FreeAll;
       PROCEDURE DeleteAll;
@@ -423,7 +449,7 @@ TYPE
       PROCEDURE AtFree (Index: Sw_Integer);
       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
       PROCEDURE AtDelete (Index: Sw_Integer);
-      PROCEDURE ForEach (Action: CodePointer);
+      PROCEDURE ForEach (Action: TCallbackProcParam);
       PROCEDURE SetLimit (ALimit: Sw_Integer);                       Virtual;
       PROCEDURE Error (Code, Info: Integer);                         Virtual;
       PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
@@ -602,9 +628,14 @@ function CallPointerMethod(Method: codepointer; Obj: pointer; Param1: pointer):
   Func     Pointer to the local function (which must be far-coded).
   Frame    Frame pointer of the wrapping function.
 }
-
-function CallVoidLocal(Func: codepointer; Frame: Pointer): pointer;inline;
-function CallPointerLocal(Func: codepointer; Frame: Pointer; Param1: pointer): pointer;inline;
+function CallVoidLocal(Func: TCallbackFun; Frame: Pointer): pointer;inline;
+function CallPointerLocal(Func: TCallbackFunParam; Frame: Pointer; Param1: pointer): pointer;inline;
+{$ifdef TYPED_LOCAL_CALLBACKS}
+function CallVoidLocal(Func: TCallbackProc; Frame: Pointer): pointer;inline;
+function CallPointerLocal(Func: TCallbackProcParam; Frame: Pointer; Param1: pointer): pointer;inline;
+function CallVoidLocal(Func: TCallbackFunBool; Frame: Pointer): Boolean;inline;
+function CallPointerLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Param1: pointer): Boolean;inline;
+{$endif}
 
 { Calls of functions/procedures local to methods.
 
@@ -612,8 +643,14 @@ function CallPointerLocal(Func: codepointer; Frame: Pointer; Param1: pointer): p
   Frame    Frame pointer of the wrapping method.
   Obj      Pointer to the object that the method belongs to.
 }
-function CallVoidMethodLocal(Func: codepointer; Frame: Pointer; Obj: pointer): pointer;inline;
-function CallPointerMethodLocal(Func: codepointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+function CallVoidMethodLocal(Func: TCallbackFun; Frame: Pointer; Obj: pointer): pointer;inline;
+function CallPointerMethodLocal(Func: TCallbackFunParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+{$ifdef TYPED_LOCAL_CALLBACKS}
+function CallVoidMethodLocal(Func: TCallbackFunBool; Frame: Pointer; Obj: pointer): Boolean;inline;
+function CallPointerMethodLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Obj: pointer; Param1: pointer): Boolean;inline;
+function CallVoidMethodLocal(Func: TCallbackProc; Frame: Pointer; Obj: pointer): pointer;inline;
+function CallPointerMethodLocal(Func: TCallbackProcParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+{$endif}
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -795,7 +832,7 @@ end;
 {$error CallPointerMethod function not implemented}
 {$endif not FPC_CallPointerMethod_Implemented}
 
-
+{$ifndef TYPED_LOCAL_CALLBACKS}
 function CallVoidLocal(Func: codepointer; Frame: Pointer): pointer;inline;
 begin
 {$ifdef cpui8086}
@@ -835,8 +872,83 @@ begin
 {$endif cpui8086}
 end;
 
+{$else}
+
+function CallVoidLocal(Func: TCallbackFun; Frame: Pointer): pointer;inline;
+begin
+  CallVoidLocal:=Func();
+end;
+
+
+function CallVoidLocal(Func: TCallbackProc; Frame: Pointer): pointer;inline;
+begin
+  Func();
+  CallVoidLocal:=nil;
+end;
 
 
+function CallVoidLocal(Func: TCallbackFunBool; Frame: Pointer): boolean;inline;
+begin
+  CallVoidLocal:=Func();
+end;
+
+function CallPointerLocal(Func: TCallbackFunParam; Frame: Pointer; Param1: pointer): pointer;inline;
+begin
+  CallPointerLocal:=Func(Param1);
+end;
+
+
+function CallPointerLocal(Func: TCallbackProcParam; Frame: Pointer; Param1: pointer): pointer;inline;
+begin
+  Func(Param1);
+  CallPointerLocal:=nil;
+end;
+
+
+function CallPointerLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Param1: pointer): boolean;inline;
+begin
+  CallPointerLocal:=Func(Param1);
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackFun; Frame: Pointer; Obj: pointer): pointer;inline;
+begin
+  CallVoidMethodLocal := Func();
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackFunBool; Frame: Pointer; Obj: pointer): Boolean;inline;
+begin
+  CallVoidMethodLocal := Func();
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackProc; Frame: Pointer; Obj: pointer): pointer;inline;
+begin
+  Func();
+  CallVoidMethodLocal := nil;
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackFunParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+begin
+  CallPointerMethodLocal := Func(Param1);
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Obj: pointer; Param1: pointer): Boolean;inline;
+begin
+  CallPointerMethodLocal := Func(Param1);
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackProcParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+begin
+  Func(Param1);
+  CallPointerMethodLocal := nil;
+end;
+
+{$endif}
 
 {***************************************************************************}
 {                      PRIVATE INITIALIZED VARIABLES                        }
@@ -1934,7 +2046,7 @@ END;
 {$PUSH}
 {$W+}
 
-FUNCTION TCollection.LastThat (Test: CodePointer): Pointer;
+FUNCTION TCollection.LastThat (Test: TCallbackFunBoolParam): Pointer;
 VAR I: LongInt;
 
 BEGIN
@@ -1963,7 +2075,7 @@ END;
 {--TCollection--------------------------------------------------------------}
 {  FirstThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB            }
 {---------------------------------------------------------------------------}
-FUNCTION TCollection.FirstThat (Test: CodePointer): Pointer;
+FUNCTION TCollection.FirstThat (Test: TCallbackFunBoolParam): Pointer;
 VAR I: LongInt;
 BEGIN
    For I := 1 To Count Do Begin                       { Up from first item }
@@ -2092,7 +2204,7 @@ END;
 
 {$PUSH}
 {$W+}
-PROCEDURE TCollection.ForEach (Action: CodePointer);
+PROCEDURE TCollection.ForEach (Action: TCallbackProcParam);
 VAR I: LongInt;
 BEGIN
    For I := 1 To Count Do                             { Up from first item }
@@ -2675,7 +2787,9 @@ END;
 FUNCTION TResourceFile.SwitchTo (AStream: PStream; Pack: Boolean): PStream;
 VAR NewBasePos: LongInt;
 
-   PROCEDURE DoCopyResource (Item: PResourceItem);{$IFNDEF FPC}FAR;{$ENDIF}
+   PROCEDURE DoCopyResource (_Item: Pointer);{$IFNDEF FPC}FAR;{$ENDIF}
+   var
+     Item: PResourceItem absolute _Item;
    BEGIN
      Stream^.Seek(BasePos + Item^.Posn);              { Move stream position }
      Item^.Posn := AStream^.GetPos - NewBasePos;      { Hold new position }

+ 4 - 0
tests/tbs/tb0268.pp

@@ -5,6 +5,10 @@
   Self is not reloaded in %esi register
   at entry in local procedure inside method }
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 uses
   objects;