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

View File

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

View File

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

View File

@ -278,6 +278,18 @@ FOR FPC THESE ARE THE TRANSLATIONS
{$DEFINE OS_GO32} {$DEFINE OS_GO32}
{$ENDIF} {$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 } { 32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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