From 0f633b3a6b1cd275c7b5f58506d62be421bebcfe Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 09:06:23 -0400 Subject: [PATCH 1/8] Updated Lape, Removed redundant methods, and fixed lpdump --- Units/MMLAddon/LPInc/lpexportedmethods.inc | 30 +++++++++++----------- Units/MMLAddon/mmlpsthread.pas | 4 +-- Units/Misc/lpdump.pas | 4 +-- Units/lape | 2 +- 4 files changed, 20 insertions(+), 20 deletions(-) diff --git a/Units/MMLAddon/LPInc/lpexportedmethods.inc b/Units/MMLAddon/LPInc/lpexportedmethods.inc index e2b59e55b..df8944e3f 100644 --- a/Units/MMLAddon/LPInc/lpexportedmethods.inc +++ b/Units/MMLAddon/LPInc/lpexportedmethods.inc @@ -162,16 +162,16 @@ AddGlobalFunc('function pow(base,exponent: extended): extended', @Lape_pow); AddGlobalFunc('function RiemannGauss(Xstart,StepSize,Sigma: extended; AmountSteps: integer): extended', @Lape_RiemannGauss); AddGlobalFunc('function DiscreteGauss(Xstart,Xend: integer; sigma: extended): TExtendedArray', @Lape_DiscreteGauss); AddGlobalFunc('function GaussMatrix(N: integer; sigma: extended): T2DExtendedArray', @Lape_GaussMatrix); -AddGlobalFunc('function Max(a, b: integer): integer', @Lape_Max); -AddGlobalFunc('function Min(a, b: Integer): Integer', @Lape_Min); +//AddGlobalFunc('function Max(a, b: integer): integer', @Lape_Max); +//AddGlobalFunc('function Min(a, b: Integer): Integer', @Lape_Min); AddGlobalFunc('function MinE(a, b: extended): extended', @Lape_MinE); AddGlobalFunc('function MaxE(a, b: extended): extended', @Lape_MaxE); AddGlobalFunc('function Point(x, y: integer): TPoint', @Lape_Point); AddGlobalFunc('function Distance(x1,y1,x2,y2: integer): integer', @Lape_Distance); -AddGlobalFunc('function Hypot(X, Y: Extended): Extended', @Lape_Hypot); +//AddGlobalFunc('function Hypot(X, Y: Extended): Extended', @Lape_Hypot); AddGlobalFunc('function RandomRange(const aFrom, aTo: Integer): Integer', @Lape_RandomRange); AddGlobalFunc('function RandomE: extended', @Lape_RandomE); -AddGlobalFunc('function ArcTan2(y,x: extended): extended', @Lape_ArcTan2); +//AddGlobalFunc('function ArcTan2(y,x: extended): extended', @Lape_ArcTan2); AddGlobalFunc('procedure IncEx(var x: integer; increase: integer);', @Lape_IncEx); AddGlobalFunc('procedure DecEx(var x: integer; Decrease: integer);', @Lape_DecEx); AddGlobalFunc('function Factorial(number: longword): Int64', @Lape_Factorial); @@ -186,25 +186,25 @@ AddGlobalFunc('function logn(base, x: extended): extended', @Lape_logn); AddGlobalFunc('function sar(AValue: longint; shift: byte): longint', @Lape_sar); AddGlobalFunc('function ror(num: longword; shift: byte): LongWord', @Lape_ror); AddGlobalFunc('function rol(num: longword; shift: byte): LongWord', @Lape_rol); -AddGlobalFunc('function tan(e: extended): extended', @Lape_tan); +//AddGlobalFunc('function tan(e: extended): extended', @Lape_tan); AddGlobalFunc('function radians(e: extended): extended', @Lape_radians); AddGlobalFunc('function degrees(e: extended): extended', @Lape_degrees); -AddGlobalFunc('function ArcSin(e: extended): extended', @Lape_ArcSin); -AddGlobalFunc('function ArcCos(e: extended): extended', @Lape_ArcCos); -AddGlobalFunc('function Cotan(e: extended): extended', @Lape_Cotan); -AddGlobalFunc('function Secant(e: extended): extended', @Lape_Secant); -AddGlobalFunc('function Cosecant(e: extended): extended', @Lape_Cosecant); +//AddGlobalFunc('function ArcSin(e: extended): extended', @Lape_ArcSin); +//AddGlobalFunc('function ArcCos(e: extended): extended', @Lape_ArcCos); +//AddGlobalFunc('function Cotan(e: extended): extended', @Lape_Cotan); +//AddGlobalFunc('function Secant(e: extended): extended', @Lape_Secant); +//AddGlobalFunc('function Cosecant(e: extended): extended', @Lape_Cosecant); AddGlobalFunc('function Cot(e: extended): extended', @Lape_Cot); AddGlobalFunc('function Sec(e: extended): extended', @Lape_Sec); AddGlobalFunc('function Csc(e: extended): extended', @Lape_Csc); -AddGlobalFunc('function Cosh(e: extended): extended', @Lape_Cosh); -AddGlobalFunc('function Sinh(e: extended): extended', @Lape_Sinh); -AddGlobalFunc('function Tanh(e: extended): extended', @Lape_Tanh); +//AddGlobalFunc('function Cosh(e: extended): extended', @Lape_Cosh); +//AddGlobalFunc('function Sinh(e: extended): extended', @Lape_Sinh); +//AddGlobalFunc('function Tanh(e: extended): extended', @Lape_Tanh); AddGlobalFunc('function CotH(e: extended): extended', @Lape_CotH); AddGlobalFunc('function SecH(e: extended): extended', @Lape_SecH); AddGlobalFunc('function CscH(e: extended): extended', @Lape_CscH); -AddGlobalFunc('function ArcCosh(e: extended): extended', @Lape_ArcCosh); -AddGlobalFunc('function ArcSinh(e: extended): extended', @Lape_ArcSinh); +//AddGlobalFunc('function ArcCosh(e: extended): extended', @Lape_ArcCosh); +//AddGlobalFunc('function ArcSinh(e: extended): extended', @Lape_ArcSinh); AddGlobalFunc('function DecRet(e: Extended): Extended', @Lape_DecRet); AddGlobalFunc('function log10(f: Extended): Extended', @Lape_log10); AddGlobalFunc('function MinA(a: TIntegerArray): Integer', @Lape_MinA); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index e0c1c2480..1b176a15d 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -41,7 +41,7 @@ interface settings, settingssandbox, lcltype, dialogs, ExtCtrls {$IFDEF USE_SQLITE}, msqlite3{$ENDIF} {$IFDEF USE_LAPE} - , lpparser, lpcompiler, lptypes, lpvartypes, + , lpparser, lpcompiler, lptypes, lpvartypes, ffi, lpffi, lpffiwrappers, lpeval, lpinterpreter, lputils, lpexceptions, LPDump {$ENDIF}; @@ -312,7 +312,6 @@ implementation SynRegExpr, lclintf, // for GetTickCount and others. Clipbrd, - lpffi, ffi, // For lape FFI DCPcrypt2, DCPrc2, DCPrc4, DCPrc5, DCPrc6, @@ -1394,6 +1393,7 @@ constructor TLPThread.Create(CreateSuspended: Boolean; TheSyncInfo: PSyncInfo; p Compiler := TLPCompiler.Create(Parser); Running := bFalse; + InitializeFFI(Compiler); InitializePascalScriptBasics(Compiler); ExposeGlobals(Compiler); diff --git a/Units/Misc/lpdump.pas b/Units/Misc/lpdump.pas index bd0f3628a..30798b85c 100644 --- a/Units/Misc/lpdump.pas +++ b/Units/Misc/lpdump.pas @@ -24,7 +24,7 @@ TLPCompiler = class(TLapeCompiler) function addGlobalType(Typ: TLapeType; AName: lpString = ''; ACopy: Boolean = True): TLapeType; override; function addGlobalType(Str: lpString; AName: lpString): TLapeType; override; function addGlobalFunc(AHeader: lpString; Value: Pointer): TLapeGlobalVar; override; - function addDelayedCode(ACode: lpString; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; override; + function addDelayedCode(ACode: lpString; AFileName: lpString = ''; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; virtual; procedure getInfo(aItems: TStrings); end; @@ -92,7 +92,7 @@ function TLPCompiler.addGlobalFunc(AHeader: lpString; Value: Pointer): TLapeGlob FItems.Add(AddLeadingSemiColon(AHeader) + ' forward;'); end; -function TLPCompiler.addDelayedCode(ACode: lpString; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; +function TLPCompiler.addDelayedCode(ACode: lpString; AFileName: lpString = ''; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; begin Result := inherited; FItems.Add(ACode); diff --git a/Units/lape b/Units/lape index fab60b30d..ee92d04f5 160000 --- a/Units/lape +++ b/Units/lape @@ -1 +1 @@ -Subproject commit fab60b30d2e62414843158964f122534452fa52a +Subproject commit ee92d04f53d0ab053321ed6535e7fbf12df63b11 From e08e75f2f08d5805d125425e12f46d11c9449563 Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 10:14:55 -0400 Subject: [PATCH 2/8] Updated Class Wrappers for new Lape --- Units/MMLAddon/LPInc/Classes/MML/lptclient.pas | 2 +- Units/MMLAddon/LPInc/Classes/lpclasshelper.pas | 10 ++++++++++ Units/MMLAddon/LPInc/Classes/miniLCL/lplclcomctrls.pas | 4 ++-- Units/MMLAddon/LPInc/Classes/miniLCL/lplclcontrols.pas | 8 ++++---- Units/MMLAddon/LPInc/Classes/miniLCL/lplclforms.pas | 4 ++-- Units/MMLAddon/LPInc/Classes/miniLCL/lplclstdctrls.pas | 4 ++-- Units/MMLAddon/LPInc/Classes/miniLCL/lplclsystem.pas | 2 +- Units/MMLAddon/mmlpsthread.pas | 5 +++-- 8 files changed, 25 insertions(+), 14 deletions(-) diff --git a/Units/MMLAddon/LPInc/Classes/MML/lptclient.pas b/Units/MMLAddon/LPInc/Classes/MML/lptclient.pas index 00a87b52f..a8ac4621c 100644 --- a/Units/MMLAddon/LPInc/Classes/MML/lptclient.pas +++ b/Units/MMLAddon/LPInc/Classes/MML/lptclient.pas @@ -143,7 +143,7 @@ procedure Register_TClient(Compiler: TLapeCompiler); begin addClass('TClient'); - addGlobalType('procedure(s: string)', 'TWriteLnProc'); + addNativeGlobalType('procedure(s: string)', 'TWriteLnProc'); addClassVar('TClient', 'IOManager', 'TIOManager', @TClient_IOManager_Read, @TClient_IOManager_Write); addClassVar('TClient', 'MFiles', 'TMFiles', @TClient_MFiles_Read, @TClient_MFiles_Write); diff --git a/Units/MMLAddon/LPInc/Classes/lpclasshelper.pas b/Units/MMLAddon/LPInc/Classes/lpclasshelper.pas index 1a138c535..9066f7855 100644 --- a/Units/MMLAddon/LPInc/Classes/lpclasshelper.pas +++ b/Units/MMLAddon/LPInc/Classes/lpclasshelper.pas @@ -13,6 +13,7 @@ TLapeCompilerHelper = class helper for TLapeCompiler public procedure addClass(const Name: string; const Parent: string = 'TObject'); procedure addClassVar(const Obj, Item, Typ: string; const Read: Pointer; const Write: Pointer = nil; const Arr: boolean = False; const ArrType: string = 'UInt32'); + function addNativeGlobalType(Str: lpString; AName: lpString): TLapeType; end; generic TRegisterWrapper<_T> = class(TComponent) @@ -73,6 +74,15 @@ TOnMouseEventWrapper = class(specialize TRegisterWrapper) implementation +function TLapeCompilerHelper.addNativeGlobalType(Str: lpString; AName: lpString): TLapeType; +begin + with addGlobalType(Str, '_' + AName) do + begin + addGlobalType('native _' + AName, AName); + Name := '!' + AName; + end; +end; + procedure TLapeCompilerHelper.addClass(const Name: string; const Parent: string = 'TObject'); begin addGlobalType(Format('type %s', [Parent]), Name); diff --git a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcomctrls.pas b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcomctrls.pas index 68b061459..0f1814463 100644 --- a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcomctrls.pas +++ b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcomctrls.pas @@ -1346,8 +1346,8 @@ procedure RegisterLCLComCtrls(Compiler: TLapeCompiler); addGlobalType('(tmBottomRight, tmTopLeft, tmBoth)', 'TTickMark'); addGlobalType('(tsNone, tsAuto, tsManual)', 'TTickStyle'); addGlobalType('(trLeft, trRight, trTop, trBottom)', 'TTrackBarScalePos'); - addGlobalType('procedure(Sender: TObject; Index: integer)', 'TCheckListClicked'); - addGlobalType('procedure(Sender: TObject; var AllowChange: Boolean)', 'TTabChangingEvent'); + addNativeGlobalType('procedure(Sender: TObject; Index: integer)', 'TCheckListClicked'); + addNativeGlobalType('procedure(Sender: TObject; var AllowChange: Boolean)', 'TTabChangingEvent'); addGlobalType('(tsTabs, tsButtons, tsFlatButtons)', 'TTabStyle'); addGlobalType('(tpTop, tpBottom, tpLeft, tpRight)', 'TTabPosition'); addGlobalType('(nboShowCloseButtons, nboMultiLine, nboHidePageListPopup, nboKeyboardTabSwitch, nboShowAddTabButton)', 'TCTabControlOption'); diff --git a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcontrols.pas b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcontrols.pas index ca8b9ebe7..8af788287 100644 --- a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcontrols.pas +++ b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclcontrols.pas @@ -1721,11 +1721,11 @@ procedure RegisterLCLControls(Compiler: TLapeCompiler); begin addGlobalType('(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble, ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum, ssScroll, ssTriple, ssQuad, ssExtra1, ssExtra2)', 'TShiftStateEnum'); addGlobalType('set of TShiftStateEnum', 'TShiftState'); - addGlobalType('procedure(Sender: TObject; var Key: Word; Shift: TShiftState)','TKeyEvent'); - addGlobalType('procedure(Sender: TObject; var Key: char)','TKeyPressEvent'); + addNativeGlobalType('procedure(Sender: TObject; var Key: Word; Shift: TShiftState)','TKeyEvent'); + addNativeGlobalType('procedure(Sender: TObject; var Key: char)','TKeyPressEvent'); addGlobalType('(mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2)','TMouseButton'); - addGlobalType('procedure(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer)','TMouseEvent'); - addGlobalType('procedure(Sender: TObject; Shift: TShiftState; X, Y: Integer)', 'TMouseMoveEvent'); + addNativeGlobalType('procedure(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer)','TMouseEvent'); + addNativeGlobalType('procedure(Sender: TObject; Shift: TShiftState; X, Y: Integer)', 'TMouseMoveEvent'); addGlobalType('(sbHorizontal, sbVertical)','TScrollBarKind'); addGlobalType('(alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom)', 'TAlign'); addGlobalType('(bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin)','TFormBorderStyle'); diff --git a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclforms.pas b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclforms.pas index b705bdd89..1c0724be4 100644 --- a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclforms.pas +++ b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclforms.pas @@ -1209,8 +1209,8 @@ procedure RegisterLCLForms(Compiler: TLapeCompiler); with Compiler do begin AddGlobalType('(caNone, caHide, caFree, caMinimize)','TCloseAction'); - AddGlobalType('procedure(Sender: TObject; var CloseAction: TCloseAction)','TCloseEvent'); - AddGlobalType('procedure(Sender : TObject; var CanClose : boolean)','TCloseQueryEvent'); + AddNativeGlobalType('procedure(Sender: TObject; var CloseAction: TCloseAction)','TCloseEvent'); + AddNativeGlobalType('procedure(Sender : TObject; var CanClose : boolean)','TCloseQueryEvent'); AddGlobalType('(poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poMainFormCenter, poOwnerFormCenter)', 'TPosition'); AddGlobalType('(biSystemMenu, biMinimize, biMaximize, biHelp)', 'TBorderIcon'); AddGlobalType('set of TBorderIcon', 'TBorderIcons'); diff --git a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclstdctrls.pas b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclstdctrls.pas index 3e27b1ca3..369e52c1c 100644 --- a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclstdctrls.pas +++ b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclstdctrls.pas @@ -1986,10 +1986,10 @@ procedure RegisterLCLStdCtrls(Compiler: TLapeCompiler); begin addGlobalType('(ssNone, ssHorizontal, ssVertical, ssBoth,ssAutoHorizontal, ssAutoVertical, ssAutoBoth)','TScrollStyle'); addGlobalType('(scLineUp,scLineDown, scPageUp,scPageDown,scPosition, scTrack,scTop,scBottom,scEndScroll)','TScrollCode'); - addGlobalType('procedure(Sender: TObject; ScrollCode: TScrollCode;var ScrollPos: Integer)','TScrollEvent'); + addNativeGlobalType('procedure(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer)', 'TScrollEvent'); addGlobalType('(odSelected, odGrayed, odDisabled, odChecked, odFocused, odDefault, odHotLight, odInactive, odNoAccel, odNoFocusRect, odReserved1, odReserved2, odComboBoxEdit, odPainted)' , 'TOwnerDrawStateType'); addGlobalType('set of TOwnerDrawStateType', 'TOwnerDrawState'); - addGlobalType('procedure(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState)', 'TDrawItemEvent'); + addNativeGlobalType('procedure(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState)', 'TDrawItemEvent'); addGlobalType('(csDropDown,csSimple,csDropDownList,csOwnerDrawFixed,csOwnerDrawVariable)','TComboBoxStyle'); addGlobalType('(lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable, lbVirtual)', 'TListBoxStyle'); addGlobalType('(sbsNone, sbsSingle, sbsSunken)','TStaticBorderStyle'); diff --git a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclsystem.pas b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclsystem.pas index a3e185bb2..b451c9fd5 100644 --- a/Units/MMLAddon/LPInc/Classes/miniLCL/lplclsystem.pas +++ b/Units/MMLAddon/LPInc/Classes/miniLCL/lplclsystem.pas @@ -1283,7 +1283,7 @@ procedure RegisterLCLSystem(Compiler: TLapeCompiler); begin with Compiler do begin - addGlobalType('Procedure(Sender:TObject)','TNotifyEvent'); + addNativeGlobalType('procedure(Sender: TObject)', 'TNotifyEvent'); addGlobalType('^TNotifyEvent','PNotifyEvent'); addGlobalType('dword','THandle'); addGlobalType('string','TComponentName'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 1b176a15d..c21fd1b79 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -320,7 +320,7 @@ implementation DCPsha1, DCPsha256, DCPsha512, DCPtiger - {$IFDEF USE_LAPE}, lpClasses{$ENDIF}; + {$IFDEF USE_LAPE}, lpClasses, lpClassHelper{$ENDIF}; {$ifdef Linux} {$define PS_SafeCall} @@ -1414,7 +1414,8 @@ constructor TLPThread.Create(CreateSuspended: Boolean; TheSyncInfo: PSyncInfo; p addGlobalFunc('procedure _writeln; override;', @lp_WriteLn); addGlobalFunc('procedure DebugLn(s: string);', @lp_DebugLn); - addGlobalFunc('procedure Sync(proc: Pointer);', @lp_Sync); + addNativeGlobalType('procedure();', 'TSyncMethod'); + addGlobalFunc('procedure Sync(Proc: TSyncMethod);', @lp_Sync); addGlobalFunc('function GetCurrThreadID(): PtrUInt;', @lp_CurrThreadID); for I := 0 to High(VirtualKeys) do From 9c5b54de57c86c557156b7a3ab718d174f1baa1a Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 10:41:06 -0400 Subject: [PATCH 3/8] Updated CC to support native in type decl. --- Units/Misc/CastaliaSimplePasPar.pas | 2 +- Units/Misc/lpdump.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Units/Misc/CastaliaSimplePasPar.pas b/Units/Misc/CastaliaSimplePasPar.pas index 68600c091..3da14b349 100644 --- a/Units/Misc/CastaliaSimplePasPar.pas +++ b/Units/Misc/CastaliaSimplePasPar.pas @@ -4537,7 +4537,7 @@ procedure TmwSimplePasPar.ExplicitType; procedure TmwSimplePasPar.TypeKind; begin - if (TokenID = tokIdentifier) and (GenID = tokPrivate) then + if ((TokenID = tokIdentifier) and (GenID = tokPrivate)) or (ExID = tokNative) then NextToken; case TokenID of diff --git a/Units/Misc/lpdump.pas b/Units/Misc/lpdump.pas index 30798b85c..f6b5081c2 100644 --- a/Units/Misc/lpdump.pas +++ b/Units/Misc/lpdump.pas @@ -24,7 +24,7 @@ TLPCompiler = class(TLapeCompiler) function addGlobalType(Typ: TLapeType; AName: lpString = ''; ACopy: Boolean = True): TLapeType; override; function addGlobalType(Str: lpString; AName: lpString): TLapeType; override; function addGlobalFunc(AHeader: lpString; Value: Pointer): TLapeGlobalVar; override; - function addDelayedCode(ACode: lpString; AFileName: lpString = ''; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; virtual; + function addDelayedCode(ACode: lpString; AFileName: lpString = ''; AfterCompilation: Boolean = True; IsGlobal: Boolean = True): TLapeTree_Base; override; procedure getInfo(aItems: TStrings); end; From 42b09591e65039854897789df251135c72845a83 Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 11:10:40 -0400 Subject: [PATCH 4/8] Updated CC to support ^const in parameter list. --- Units/Misc/CastaliaSimplePasPar.pas | 9 ++++++++- Units/Misc/lpdump.pas | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/Units/Misc/CastaliaSimplePasPar.pas b/Units/Misc/CastaliaSimplePasPar.pas index 3da14b349..86960781b 100644 --- a/Units/Misc/CastaliaSimplePasPar.pas +++ b/Units/Misc/CastaliaSimplePasPar.pas @@ -4575,7 +4575,14 @@ procedure TmwSimplePasPar.TypeKind; end; tokPointerSymbol: begin - PointerType; + Lexer.InitAhead; + if Lexer.AheadTokenID = tokConst then + begin + NextToken; + NextToken; + TypeKind; + end else + PointerType; end; tokString: begin diff --git a/Units/Misc/lpdump.pas b/Units/Misc/lpdump.pas index f6b5081c2..857dad865 100644 --- a/Units/Misc/lpdump.pas +++ b/Units/Misc/lpdump.pas @@ -69,7 +69,7 @@ function TLPCompiler.addGlobalVar(Val: Int32; AName: lpString): TLapeGlobalVar; begin Result := inherited; if (Length(AName) > 0) and (AName[1] <> '!') then - FItems.Add(AddLeadingSemiColon('var ' + AName + ': ' + IntToStr(Val))); + FItems.Add(AddLeadingSemiColon('var ' + AName + ': Int32 = ' + IntToStr(Val))); end; function TLPCompiler.addGlobalType(Typ: TLapeType; AName: lpString = ''; ACopy: Boolean = True): TLapeType; From e39fa05a9dc75cbcb69e05ea02115faff71ff011 Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 13:18:56 -0400 Subject: [PATCH 5/8] Updated CC to parse operator overloads --- Units/Misc/CastaliaSimplePasPar.pas | 32 +++++++++++++++++++++++++---- Units/Misc/ValistusDefines.inc | 2 +- 2 files changed, 29 insertions(+), 5 deletions(-) diff --git a/Units/Misc/CastaliaSimplePasPar.pas b/Units/Misc/CastaliaSimplePasPar.pas index 86960781b..90df6749b 100644 --- a/Units/Misc/CastaliaSimplePasPar.pas +++ b/Units/Misc/CastaliaSimplePasPar.pas @@ -1029,6 +1029,7 @@ procedure TmwSimplePasPar.PackageFile; procedure TmwSimplePasPar.ProgramFile; begin // DR 2002-01-11 + Write(IntToStr(Lexer.LineNumber) + ': '); WriteLn(TokenID); Expected(tokProgram); QualifiedIdentifier; if TokenID = tokRoundOpen then @@ -1145,9 +1146,9 @@ procedure TmwSimplePasPar.UsedUnitName; procedure TmwSimplePasPar.Block; begin - while TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokExports, + while (TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokExports, tokFunction, tokLabel, tokProcedure, tokResourceString, tokThreadVar, tokType, - tokVar{$IFDEF D8_NEWER}, tokSquareOpen{$ENDIF}] do + tokVar{$IFDEF D8_NEWER}, tokSquareOpen{$ENDIF}]) do begin DeclarationSection; end; @@ -1186,8 +1187,10 @@ procedure TmwSimplePasPar.DeclarationSection; begin ExportsClause; end; - tokFunction: + tokFunction, tokIdentifier: begin + if (TokenID = tokIdentifier) and (Lexer.ExId <> tokOperator) then + SynError(InvalidDeclarationSection); ProcedureDeclarationSection; end; tokLabel: @@ -2106,7 +2109,28 @@ procedure TmwSimplePasPar.ProcedureMethodDeclaration; procedure TmwSimplePasPar.FunctionProcedureName; begin - Expected(tokIdentifier); + if not (Lexer.TokenID in [tokIdentifier, + + //Operators =) + tokMinus, tokOr, tokPlus, tokXor, + tokAnd, tokAs, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar, tokStarStar, + tokDivAsgn, + tokMulAsgn, + tokPlusAsgn, + tokMinusAsgn, + tokPowAsgn]) then + begin + if TokenID = tokNull then + ExpectedFatal(tokIdentifier) {jdj 7/22/1999} + else + begin + if Assigned(FOnMessage) then + FOnMessage(Self, meError, Format(rsExpected, [TokenName(tokIdentifier), fLexer.Token]), + fLexer.PosXY.X, fLexer.PosXY.Y); + end; + end + else + NextToken; end; procedure TmwSimplePasPar.ObjectNameOfMethod; diff --git a/Units/Misc/ValistusDefines.inc b/Units/Misc/ValistusDefines.inc index b58a4d343..2d1f46627 100644 --- a/Units/Misc/ValistusDefines.inc +++ b/Units/Misc/ValistusDefines.inc @@ -5,7 +5,7 @@ {.$DEFINE ccFORMCAPTION} {$DEFINE ciCHECKDUPLICATES} -{$DEFINE D8_NEWER1} +{$DEFINE D8_NEWER} {$DEFINE D9_NEWER} {$DEFINE D10_NEWER} {.$DEFINE D11_NEWER} From 2bdd7b71060b36f5e192cb64d5ec5f9781ad7403 Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 13:20:03 -0400 Subject: [PATCH 6/8] Missed files in e39fa05 --- Units/Misc/CastaliaSimplePasPar.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/Units/Misc/CastaliaSimplePasPar.pas b/Units/Misc/CastaliaSimplePasPar.pas index 90df6749b..49ef2b5ac 100644 --- a/Units/Misc/CastaliaSimplePasPar.pas +++ b/Units/Misc/CastaliaSimplePasPar.pas @@ -1029,7 +1029,6 @@ procedure TmwSimplePasPar.PackageFile; procedure TmwSimplePasPar.ProgramFile; begin // DR 2002-01-11 - Write(IntToStr(Lexer.LineNumber) + ': '); WriteLn(TokenID); Expected(tokProgram); QualifiedIdentifier; if TokenID = tokRoundOpen then From f5da85049bb6c58e72319709b04e03564f01ea77 Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 13:22:04 -0400 Subject: [PATCH 7/8] More missed files from e39fa05 --- Units/Misc/v_ideCodeParser.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Units/Misc/v_ideCodeParser.pas b/Units/Misc/v_ideCodeParser.pas index 0fad753e8..0127bce40 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/Units/Misc/v_ideCodeParser.pas @@ -1042,9 +1042,9 @@ procedure TCodeParser.ParseFile; if (TokenID = TokUses) then MainUsesClause; - while TokenID in [TokClass, TokConst, TokConstructor, TokDestructor, TokExports, + while (TokenID in [TokClass, TokConst, TokConstructor, TokDestructor, TokExports, TokFunction, TokLabel, TokProcedure, TokResourceString, TokThreadVar, TokType, - TokVar{$IFDEF D8_NEWER}, TokSquareOpen{$ENDIF}] do + TokVar{$IFDEF D8_NEWER}, TokSquareOpen{$ENDIF}]) or (Lexer.ExID = tokOperator) do begin DeclarationSection; end; From bb577a45723c2efaeead3631105e7b083b9c6c2a Mon Sep 17 00:00:00 2001 From: John Peel Date: Sat, 9 Jul 2016 15:32:56 -0400 Subject: [PATCH 8/8] Small changes to CC to support new Lape features. --- Units/Misc/CastaliaSimplePasPar.pas | 34 +++++++++++++++++++---------- Units/Misc/v_ideCodeInsight.pas | 3 ++- Units/Misc/v_ideCodeParser.pas | 9 ++++---- 3 files changed, 29 insertions(+), 17 deletions(-) diff --git a/Units/Misc/CastaliaSimplePasPar.pas b/Units/Misc/CastaliaSimplePasPar.pas index 49ef2b5ac..3d9503565 100644 --- a/Units/Misc/CastaliaSimplePasPar.pas +++ b/Units/Misc/CastaliaSimplePasPar.pas @@ -2113,6 +2113,8 @@ procedure TmwSimplePasPar.FunctionProcedureName; //Operators =) tokMinus, tokOr, tokPlus, tokXor, tokAnd, tokAs, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar, tokStarStar, + tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual, + tokIn, tokIs, tokNotEqual, tokDivAsgn, tokMulAsgn, tokPlusAsgn, @@ -2153,13 +2155,12 @@ procedure TmwSimplePasPar.FunctionProcedureBlock; NoExternal: Boolean; begin NoExternal := True; - if TokenID = tokSemiColon - then SEMICOLON; + if TokenID = tokSemiColon then SEMICOLON; case ExID of tokForward: ForwardDeclaration; // DR 2001-07-23 else - while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, + while (ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister, tokReintroduce, tokSafeCall, tokStdCall, tokVirtual, tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20 @@ -2171,20 +2172,29 @@ procedure TmwSimplePasPar.FunctionProcedureBlock; {$IFDEF D9_NEWER} , tokInline {$ENDIF} - ] // DR 2001-11-14 + , tokConst + ]) or (TokenID = tokConstRef)// DR 2001-11-14 do begin - case ExId of - tokExternal: + case TokenID of + tokConstRef: + begin + NextToken; + if (TokenID = tokSemiColon) then SEMICOLON; + end + else + case ExId of + tokExternal: + begin + ProceduralDirective; + if TokenID = tokSemiColon then SEMICOLON; + NoExternal := False; + end; + else begin ProceduralDirective; if TokenID = tokSemiColon then SEMICOLON; - NoExternal := False; end; - else - begin - ProceduralDirective; - if TokenID = tokSemiColon then SEMICOLON; end; end; end; @@ -5038,7 +5048,7 @@ procedure TmwSimplePasPar.ExportedHeading; tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20 tokLocal, tokVarargs // DR 2001-11-14 {$IFDEF D8_NEWER}, tokStatic{$ENDIF}{$IFDEF D9_NEWER}, tokInline{$ENDIF} - ] do + , tokConst] do begin ProceduralDirective; if TokenID = tokSemiColon then SEMICOLON; diff --git a/Units/Misc/v_ideCodeInsight.pas b/Units/Misc/v_ideCodeInsight.pas index 2bceb2024..6289da2a9 100644 --- a/Units/Misc/v_ideCodeInsight.pas +++ b/Units/Misc/v_ideCodeInsight.pas @@ -1339,7 +1339,8 @@ procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, Ins (Item is TciOutParameter) or (Item is TciFormalParameter) or (Item is TciInParameter) or - (Item is TciVarParameter) then + (Item is TciVarParameter) or + (Item is TciConstRefParameter) then begin FirstColumn := FormatFirstColumn('param'); c[0] := TciParameterName; diff --git a/Units/Misc/v_ideCodeParser.pas b/Units/Misc/v_ideCodeParser.pas index 0127bce40..cf42237f6 100644 --- a/Units/Misc/v_ideCodeParser.pas +++ b/Units/Misc/v_ideCodeParser.pas @@ -919,7 +919,8 @@ function TciProcedureDeclaration.GetParamDeclarations: TDeclarationArray; (fItems[i] is TciOutParameter) or (fItems[i] is TciFormalParameter) or (fItems[i] is TciInParameter) or - (fItems[i] is TciVarParameter) then + (fItems[i] is TciVarParameter) or + (fItems[i] is TciConstRefParameter) then begin SetLength(Result, Length(Result) + 1); Result[High(Result)] := fItems[i]; @@ -1224,7 +1225,7 @@ procedure TCodeParser.TypeKind; procedure TCodeParser.TypedConstant; begin - if (not InDeclarations([TciVarDeclaration, TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + if (not InDeclarations([TciVarDeclaration, TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter, TciConstRefParameter])) then begin inherited; Exit; @@ -1473,7 +1474,7 @@ procedure TCodeParser.VarParameter; procedure TCodeParser.ParameterName; begin - if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter, TciConstRefParameter])) then begin inherited; Exit; @@ -1486,7 +1487,7 @@ procedure TCodeParser.ParameterName; procedure TCodeParser.NewFormalParameterType; begin - if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter, TciConstRefParameter])) then begin inherited; Exit;