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

* support for compiling the objects unit methods that expect local procedure/

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2018-12-20 21:22:40 +00:00
parent e108d9c5eb
commit c6bb85eae9
32 changed files with 358 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/browcol.pas
View File

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

8
packages/fv/src/app.pas
View File

@ -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
packages/fv/src/platform.inc
View File

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

2
packages/fv/src/tabs.pas
View File

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

32
packages/fv/src/views.pas
View File

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

6
packages/ide/fpcodcmp.pas
View File

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

8
packages/ide/fpcodtmp.pas
View File

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

13
packages/ide/fpcompil.pas
View File

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

36
packages/ide/fpdebug.pas
View File

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

6
packages/ide/fphelp.pas
View File

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

7
packages/ide/fpide.pas
View File

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

2
packages/ide/fpini.pas
View File

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

2
packages/ide/fpmfile.inc
View File

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

6
packages/ide/fpmsrch.inc
View File

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

6
packages/ide/fpmwnd.inc
View File

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

16
packages/ide/fpswitch.pas
View File

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

6
packages/ide/fpsymbol.pas
View File

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

8
packages/ide/fptools.pas
View File

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

6
packages/ide/fpviews.pas
View File

@ -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
packages/ide/globdir.inc
View File

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

12
packages/ide/wcedit.pas
View File

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

32
packages/ide/weditor.pas
View File

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

26
packages/ide/whelp.pas
View File

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

8
packages/ide/whtmlhlp.pas
View File

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

10
packages/ide/whtmlscn.pas
View File

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

20
packages/ide/wini.pas
View File

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

18
packages/ide/wnghelp.pas
View File

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

32
packages/ide/wresourc.pas
View File

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

6
packages/ide/wutils.pas
View File

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

12
packages/ide/wwinhelp.pas
View File

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

140
packages/rtl-extra/src/inc/objects.pp
View File

@ -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
tests/tbs/tb0268.pp
View File

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