* synchronised with trunk till r40605

git-svn-id: branches/debug_eh@40606 -

compiler/aasmcnst.pas

@@ -269,6 +269,8 @@ type
      { finalize the asmlist: add the necessary symbols etc }
      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
      procedure finalize_asmlist_add_indirect_sym(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
+     { prepare finalization (common for the default and overridden versions }
+     procedure finalize_asmlist_prepare(const options: ttcasmlistoptions; var alignment: shortint);
 
      { functionality of the above for vectorized dead strippable sections }
      procedure finalize_vectorized_dead_strip_asmlist(def: tdef; const basename, itemname: TSymStr; st: tsymtable; alignment: shortint; options: ttcasmlistoptions); virtual;
@@ -928,9 +930,7 @@ implementation
      end;
 
 
-   procedure ttai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
-     var
-       prelist: tasmlist;
+   procedure ttai_typedconstbuilder.finalize_asmlist_prepare(const options: ttcasmlistoptions; var alignment: shortint);
      begin
        if tcalo_apply_constalign in options then
          alignment:=const_align(alignment);
@@ -946,7 +946,14 @@ implementation
              tcalo_vectorized_dead_strip_end]*options)<>[]) and
           not fvectorized_finalize_called then
          internalerror(2015110602);
+     end;
+
 
+   procedure ttai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
+     var
+       prelist: tasmlist;
+     begin
+       finalize_asmlist_prepare(options, alignment);
        prelist:=tasmlist.create;
        { only now add items based on the symbolname, because it may be
          modified by the "section" specifier in case of a typed constant }

compiler/arm/aoptcpu.pas

@@ -439,6 +439,19 @@ Implementation
 
               { finally get rid of the mov }
               taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
+              { Remove preindexing and postindexing for LDR in some cases.
+                For example:
+                  ldr	reg2,[reg1, xxx]!
+                  mov reg1,reg2
+                must be translated to:
+                  ldr	reg1,[reg1, xxx]
+
+                Preindexing must be removed there, since the same register is used as the base and as the target.
+                Such case is not allowed for ARM CPU and produces crash. }
+              if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
+                and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
+              then
+                taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
               asml.remove(movp);
               movp.free;
             end;

compiler/browcol.pas

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

compiler/llvm/aasmllvm.pas

@@ -107,7 +107,7 @@ interface
         constructor getelementptr_reg_size_ref_size_const(dst:tregister;ptrsize:tdef;const ref:treference;indextype:tdef;index1:ptrint;indirect:boolean);
         constructor getelementptr_reg_tai_size_const(dst:tregister;const ai:tai;indextype:tdef;index1:ptrint;indirect:boolean);
 
-        constructor blockaddress(fun, lab: tasmsymbol);
+        constructor blockaddress(size: tdef; fun, lab: tasmsymbol);
         constructor landingpad(dst:tregister;def:tdef;firstclause:taillvm);
         constructor exceptclause(op:tllvmop;def:tdef;kind:TAsmSymbol;nextclause:taillvm);
         constructor cleanupclause;
@@ -551,7 +551,7 @@ uses
             end;
           la_blockaddress:
             case opnr of
-              0: result:=operand_write
+              1: result:=operand_write
               else
                 result:=operand_read;
             end
@@ -710,7 +710,7 @@ uses
             end;
           la_blockaddress:
             case opnr of
-              0: result:=voidcodepointertype
+              1: result:=voidcodepointertype
               else
                 internalerror(2015111904);
             end
@@ -1074,12 +1074,13 @@ uses
         loadconst(index+1,index1);
       end;
 
-    constructor taillvm.blockaddress(fun, lab: tasmsymbol);
+    constructor taillvm.blockaddress(size: tdef; fun, lab: tasmsymbol);
       begin
         create_llvm(la_blockaddress);
-        ops:=2;
-        loadsymbol(0,fun,0);
-        loadsymbol(1,lab,0);
+        ops:=3;
+        loaddef(0,size);
+        loadsymbol(1,fun,0);
+        loadsymbol(2,lab,0);
       end;
 
 

compiler/llvm/agllvm.pas

@@ -644,12 +644,18 @@ implementation
           end;
         la_blockaddress:
           begin
-            owner.writer.AsmWrite('i8* blockaddress(');
-            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
+            { nested -> no type }
+            if owner.fdecllevel = 0 then
+              begin
+                owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
+                owner.writer.AsmWrite(' ');
+              end;
+            owner.writer.AsmWrite('blockaddress(');
+            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
             { getopstr would add a "label" qualifier, which blockaddress does
               not want }
             owner.writer.AsmWrite(',%');
-            with taillvm(hp).oper[1]^ do
+            with taillvm(hp).oper[2]^ do
               begin
                 if (typ<>top_ref) or
                    (ref^.refaddr<>addr_full) then

compiler/llvm/nllvmadd.pas

@@ -261,7 +261,7 @@ implementation
               equaln:
                 llvmfpcmp:=lfc_oeq;
               unequaln:
-                llvmfpcmp:=lfc_one;
+                llvmfpcmp:=lfc_une;
               else
                 internalerror(2015031506);
             end;

compiler/llvm/nllvminl.pas

@@ -36,6 +36,7 @@ interface
 
         function first_get_frame: tnode; override;
         function first_abs_real: tnode; override;
+        function first_fma: tnode; override;
         function first_sqr_real: tnode; override;
         function first_sqrt_real: tnode; override;
         function first_trunc_real: tnode; override;
@@ -52,6 +53,7 @@ implementation
        verbose,globals,globtype,constexp,
        aasmbase, aasmdata,
        symconst,symtype,symdef,defutil,
+       compinnr,
        nutils,nadd,nbas,ncal,ncnv,ncon,nflw,ninl,nld,nmat,
        pass_2,
        cgbase,cgutils,tgobj,hlcgobj,
@@ -146,6 +148,26 @@ implementation
         left:=nil;
       end;
 
+    function tllvminlinenode.first_fma: tnode;
+      var
+        procname: string[15];
+      begin
+        case inlinenumber of
+          in_fma_single:
+            procname:='llvm_fma_f32';
+          in_fma_double:
+            procname:='llvm_fma_f64';
+          in_fma_extended:
+            procname:='llvm_fma_f80';
+          in_fma_float128:
+            procname:='llvm_fma_f128';
+          else
+            internalerror(2018122101);
+        end;
+        result:=ccallnode.createintern(procname,left);
+        left:=nil;
+      end;
+
 
     function tllvminlinenode.first_sqr_real: tnode;
       begin
@@ -175,7 +197,7 @@ implementation
           else
             internalerror(2018121602);
         end;
-        result:=ccallnode.createinternfromunit('SYSTEM',intrinsic, ccallparanode.create(left,nil));
+        result:=ccallnode.createintern(intrinsic, ccallparanode.create(left,nil));
         left:=nil;
       end;
 

compiler/llvm/nllvmld.pas

@@ -124,7 +124,7 @@ procedure tllvmloadnode.pass_generate_code;
       labelsym:
         begin
           selfreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
-          ai:=taillvm.blockaddress(
+          ai:=taillvm.blockaddress(voidcodepointertype,
               current_asmdata.RefAsmSymbol(current_procinfo.procdef.mangledname,AT_FUNCTION),
               location.reference.symbol
             );

compiler/llvm/nllvmtcon.pas

@@ -109,6 +109,7 @@ interface
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
       procedure queue_typeconvn(fromdef, todef: tdef); override;
       procedure queue_emit_staticvar(vs: tstaticvarsym); override;
+      procedure queue_emit_label(l: tlabelsym); override;
       procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
       procedure queue_emit_ordconst(value: int64; def: tdef); override;
 
@@ -128,6 +129,7 @@ implementation
   uses
     verbose,systems,fmodule,
     aasmdata,
+    procinfo,
     cpubase,cpuinfo,llvmbase,
     symtable,llvmdef,defutil,defcmp,
     ngenutil;
@@ -187,6 +189,7 @@ implementation
       newasmlist: tasmlist;
       decl: taillvmdecl;
     begin
+      finalize_asmlist_prepare(options,alignment);
       newasmlist:=tasmlist.create;
       if assigned(foverriding_def) then
         def:=foverriding_def;
@@ -783,6 +786,24 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.queue_emit_label(l: tlabelsym);
+    var
+      ai: taillvm;
+      typedai: tai;
+      tmpintdef: tdef;
+      op,
+      firstop,
+      secondop: tllvmop;
+    begin
+      ai:=taillvm.blockaddress(voidcodepointertype,
+          current_asmdata.RefAsmSymbol(current_procinfo.procdef.mangledname,AT_FUNCTION),
+          current_asmdata.RefAsmSymbol(l.mangledname,AT_LABEL)
+        );
+      emit_tai(ai,voidcodepointertype);
+      fqueue_offset:=low(fqueue_offset);
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
     begin
       { we've already incorporated the offset via the inserted operations above,

packages/fcl-js/src/jswriter.pp

@@ -355,8 +355,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(TJSWriterChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
-  If (MinLen>Capacity) then
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -364,7 +364,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 
@@ -377,8 +377,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
-  If (MinLen>Capacity) then
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -386,7 +386,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 

packages/fcl-passrc/src/pasresolveeval.pas

@@ -134,7 +134,7 @@ const
   nFoundCallCandidateX = 3057;
   nTextAfterFinalIgnored = 3058;
   nNoMemberIsProvidedToAccessProperty = 3059;
-  // free 3060
+  nTheUseOfXisNotAllowedInARecord = 3060;
   // free 3061
   // free 3062
   // free 3063
@@ -251,6 +251,7 @@ resourcestring
   sFoundCallCandidateX = 'Found call candidate %s';
   sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
   sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
+  sTheUseOfXisNotAllowedInARecord = 'The use of "%s" is not allowed in a record';
   sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
   sSymbolXIsExperimental = 'Symbol "%s" is experimental';
   sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
@@ -697,6 +698,8 @@ type
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
+      LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
       Flags: TResEvalFlags): TResEvalEnum; virtual;
     {$ifdef FPC_HAS_CPSTRING}
@@ -1534,9 +1537,6 @@ var
   UInt: TMaxPrecUInt;
   Flo: TMaxPrecFloat;
   aCurrency: TMaxPrecCurrency;
-  {$ifdef FPC_HAS_CPSTRING}
-  LeftCP, RightCP: TSystemCodePage;
-  {$endif}
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
 begin
@@ -1634,58 +1634,10 @@ begin
       end;
       end;
     {$ifdef FPC_HAS_CPSTRING}
-    revkString:
-      case RightValue.Kind of
-      revkString:
-        begin
-        LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
-        RightCP:=GetCodePage(TResEvalString(RightValue).S);
-        if (LeftCP=RightCP) then
-          begin
-          Result:=TResEvalString.Create;
-          TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
-          end
-        else
-          begin
-          Result:=TResEvalUTF16.Create;
-          TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                  +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-          end;
-        end;
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                +TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141834,Expr);
-      end;
+    revkString,
     {$endif}
     revkUnicodeString:
-      case RightValue.Kind of
-      {$ifdef FPC_HAS_CPSTRING}
-      revkString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
-                                +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-        end;
-      {$endif}
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141811,Expr);
-      end;
+      Result:=EvalStringAddExpr(Expr,Expr.left,Expr.right,LeftValue,RightValue);
     revkSetOfInt:
       case RightValue.Kind of
       revkSetOfInt:
@@ -4792,6 +4744,72 @@ begin
     {$endif}
 end;
 
+function TResExprEvaluator.EvalStringAddExpr(Expr, LeftExpr,
+  RightExpr: TPasExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+{$ifdef FPC_HAS_CPSTRING}
+var
+  LeftCP, RightCP: TSystemCodePage;
+{$endif}
+begin
+  case LeftValue.Kind of
+  {$ifdef FPC_HAS_CPSTRING}
+  revkString:
+    case RightValue.Kind of
+    revkString:
+      begin
+      LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
+      RightCP:=GetCodePage(TResEvalString(RightValue).S);
+      if (LeftCP=RightCP) then
+        begin
+        Result:=TResEvalString.Create;
+        TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
+        end
+      else
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                                +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+        end;
+      end;
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                              +TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141834,Expr);
+    end;
+  {$endif}
+  revkUnicodeString:
+    case RightValue.Kind of
+    {$ifdef FPC_HAS_CPSTRING}
+    revkString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
+                              +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+      end;
+    {$endif}
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141811,Expr);
+    end;
+  else
+    RaiseNotYetImplemented(20181219233139,Expr);
+  end;
+end;
+
 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
   Flags: TResEvalFlags): TResEvalEnum;
 var

packages/fcl-passrc/src/pasresolver.pp

@@ -216,14 +216,24 @@ Works:
   - pass as arg  doit(procedure begin end)
   - modifiers  assembler varargs cdecl
   - typecast
+  - with
+  - self
 - built-in procedure Val(const s: string; var e: enumtype; out Code: integertype);
 
 ToDo:
-- anonymous methods:
-  - with
-  - self
+- operator overload
+   - operator enumerator
+   - binaryexpr
+- advanced records:
+  - $modeswitch AdvancedRecords
+  - sub type
+  - const
+  - var
+  - function/procedure/class function/class procedure
+  - property, class property
+  - RTTI
+  - operator overloading
 - Include/Exclude for set of int/char/bool
-- set of CharRange
 - error if property method resolution is not used
 - $H-hintpos$H+
 - $pop, $push
@@ -235,13 +245,12 @@ ToDo:
 - proc: check if forward and impl default values match
 - call array of proc without ()
 - attributes
-- object
 - type helpers
 - record/class helpers
+- array of const
 - generics, nested param lists
+- object
 - futures
-- operator overload
-   - operator enumerator
 - TPasFileType
 - labels
 - $zerobasedstrings on|off
@@ -529,6 +538,7 @@ type
     bfWriteStr,
     bfVal,
     bfConcatArray,
+    bfConcatString,
     bfCopyArray,
     bfInsertArray,
     bfDeleteArray,
@@ -563,6 +573,7 @@ const
     'WriteStr',
     'Val',
     'Concat',
+    'Concat',
     'Copy',
     'Insert',
     'Delete',
@@ -838,9 +849,16 @@ type
     destructor Destroy; override;
   end;
 
+  { TPasClassOrRecordScope }
+
+  TPasClassOrRecordScope = Class(TPasIdentifierScope)
+  public
+    DefaultProperty: TPasProperty;
+  end;
+
   { TPasRecordScope }
 
-  TPasRecordScope = Class(TPasIdentifierScope)
+  TPasRecordScope = Class(TPasClassOrRecordScope)
   end;
 
   TPasClassScopeFlag = (
@@ -863,12 +881,11 @@ type
 
   { TPasClassScope }
 
-  TPasClassScope = Class(TPasIdentifierScope)
+  TPasClassScope = Class(TPasClassOrRecordScope)
   public
     AncestorScope: TPasClassScope;
     CanonicalClassOf: TPasClassOfType;
     DirectAncestor: TPasType; // TPasClassType or TPasAliasType, see GetPasClassAncestor
-    DefaultProperty: TPasProperty;
     Flags: TPasClassScopeFlags;
     AbstractProcs: TArrayOfPasProcedure;
     Interfaces: TFPList; // list corresponds to TPasClassType(Element).Interfaces,
@@ -894,7 +911,7 @@ type
     DeclarationProc: TPasProcedure; // the corresponding forward declaration
     ImplProc: TPasProcedure; // the corresponding proc with Body
     OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
-    ClassScope: TPasClassScope;
+    ClassScope: TPasClassOrRecordScope;
     SelfArg: TPasArgument;
     Flags: TPasProcedureScopeFlags;
     BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
@@ -1424,7 +1441,7 @@ type
     procedure FinishWithDo(El: TPasImplWithDo); virtual;
     procedure FinishDeclaration(El: TPasElement); virtual;
     procedure FinishVariable(El: TPasVariable); virtual;
-    procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
+    procedure FinishProperty(PropEl: TPasProperty); virtual;
     procedure FinishArgument(El: TPasArgument); virtual;
     procedure FinishAncestors(aClass: TPasClassType); virtual;
     procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
@@ -1449,6 +1466,9 @@ type
     procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
       out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       var LeftResolved, RightResolved: TPasResolverResult); virtual;
+    function ComputeAddStringRes(
+      const LeftResolved, RightResolved: TPasResolverResult; ExprEl: TPasExpr;
+      out ResolvedEl: TPasResolverResult): boolean; virtual;
     procedure ComputeArrayParams(Params: TParamsExpr;
       out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       StartEl: TPasElement);
@@ -1602,6 +1622,12 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
       {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_ConcatString_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_ConcatString_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    procedure BI_ConcatString_OnEval({%H-}Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
     function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_CopyArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
@@ -4298,7 +4324,7 @@ begin
         else
           begin
           // give a hint
-          if Data^.Proc.Parent is TPasClassType then
+          if Data^.Proc.Parent is TPasMembersType then
             LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
               [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
           end;
@@ -4397,7 +4423,7 @@ begin
             begin
             // Delphi/FPC do not give a message when hiding a non virtual method
             // -> emit Hint with other message id
-            if (Data^.Proc.Parent is TPasClassType) then
+            if (Data^.Proc.Parent is TPasMembersType) then
               begin
               ProcScope:=Proc.CustomData as TPasProcedureScope;
               if (ProcScope.ImplProc<>nil)  // not abstract, external
@@ -4920,7 +4946,7 @@ begin
   else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
     begin
     aType:=ResolveAliasType(El);
-    if (aType is TPasClassType) and (aType.CustomData=nil) then
+    if (aType is TPasMembersType) and (aType.CustomData=nil) then
       exit;
     EmitTypeHints(El,TPasAliasType(El).DestType);
     end
@@ -5423,6 +5449,22 @@ begin
         if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
           RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
       end
+    else if Proc.Parent is TPasRecordType then
+      begin
+      if Proc.IsReintroduced then
+        RaiseMsg(20181218195735,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'reintroduce'],Proc);
+      if Proc.IsVirtual then
+        RaiseMsg(20181218195431,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'virtual'],Proc);
+      if Proc.IsOverride then
+        RaiseMsg(20181218195437,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'override'],Proc);
+      if Proc.IsAbstract then
+        RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
+      if Proc.IsForward then
+        RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
+      if Proc.IsStatic then
+        if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
+          RaiseMsg(20181218195519,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'static'],Proc);
+      end
     else
       begin
       // intf proc, forward proc, proc body, method body, anonymous proc
@@ -5466,7 +5508,7 @@ begin
     if Proc.LibrarySymbolName<>nil then
       ResolveExpr(Proc.LibrarySymbolName,rraRead);
 
-    if Proc.Parent is TPasClassType then
+    if Proc.Parent is TPasMembersType then
       begin
       FinishMethodDeclHeader(Proc);
       exit;
@@ -5581,7 +5623,7 @@ procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
 
 var
   Abort: boolean;
-  ClassScope: TPasClassScope;
+  ClassOrRecScope: TPasClassOrRecordScope;
   FindData: TFindOverloadProcData;
   OverloadProc: TPasProcedure;
   ProcScope: TPasProcedureScope;
@@ -5591,14 +5633,14 @@ begin
   ProcScope:=TopScope as TPasProcedureScope;
   // ToDo: store the scanner flags *before* it has parsed the token after the proc
   StoreScannerFlagsInProc(ProcScope);
-  ClassScope:=Scopes[ScopeCount-2] as TPasClassScope;
-  ProcScope.ClassScope:=ClassScope;
+  ClassOrRecScope:=Scopes[ScopeCount-2] as TPasClassOrRecordScope;
+  ProcScope.ClassScope:=ClassOrRecScope;
   FindData:=Default(TFindOverloadProcData);
   FindData.Proc:=Proc;
   FindData.Args:=Proc.ProcType.Args;
   FindData.Kind:=fopkMethod;
   Abort:=false;
-  ClassScope.IterateElements(Proc.Name,ClassScope,@OnFindOverloadProc,@FindData,Abort);
+  ClassOrRecScope.IterateElements(Proc.Name,ClassOrRecScope,@OnFindOverloadProc,@FindData,Abort);
 
   if FindData.Found=nil then
     begin
@@ -5643,24 +5685,25 @@ begin
       if proFixCaseOfOverrides in Options then
         Proc.Name:=OverloadProc.Name;
       // remove abstract
-      if OverloadProc.IsAbstract then
-        for i:=length(ClassScope.AbstractProcs)-1 downto 0 do
-          if ClassScope.AbstractProcs[i]=OverloadProc then
-            Delete(ClassScope.AbstractProcs,i,1);
+      if OverloadProc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
+        for i:=length(TPasClassScope(ClassOrRecScope).AbstractProcs)-1 downto 0 do
+          if TPasClassScope(ClassOrRecScope).AbstractProcs[i]=OverloadProc then
+            Delete(TPasClassScope(ClassOrRecScope).AbstractProcs,i,1);
       end;
     end;
   // add abstract
-  if Proc.IsAbstract then
-    Insert(Proc,ClassScope.AbstractProcs,length(ClassScope.AbstractProcs));
+  if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
+    Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
+           length(TPasClassScope(ClassOrRecScope).AbstractProcs));
 end;
 
 procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
 var
   ProcName: String;
-  CurClassType: TPasClassType;
+  ClassRecType: TPasMembersType;
   ImplProcScope, DeclProcScope: TPasProcedureScope;
   DeclProc: TPasProcedure;
-  CurClassScope: TPasClassScope;
+  CurClassRecScope: TPasClassOrRecordScope;
   SelfArg: TPasArgument;
   p: Integer;
 begin
@@ -5685,14 +5728,14 @@ begin
   if not IsValidIdent(ProcName) then
     RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
 
-  // search proc in class
+  // search proc in class/record
   ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
-  CurClassScope:=ImplProcScope.ClassScope;
-  if CurClassScope=nil then
+  CurClassRecScope:=ImplProcScope.ClassScope;
+  if CurClassRecScope=nil then
     RaiseInternalError(20161013172346);
-  CurClassType:=NoNil(CurClassScope.Element) as TPasClassType;
+  ClassRecType:=NoNil(CurClassRecScope.Element) as TPasMembersType;
 
-  DeclProc:=FindProcOverload(ProcName,ImplProc,CurClassScope);
+  DeclProc:=FindProcOverload(ProcName,ImplProc,CurClassRecScope);
   if DeclProc=nil then
     RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
   DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
@@ -5721,14 +5764,14 @@ begin
         or (DeclProc.ClassType=TPasClassProcedure)
         or (DeclProc.ClassType=TPasClassFunction) then
       begin
-      if not DeclProc.IsStatic then
+      if (not DeclProc.IsStatic) and (CurClassRecScope is TPasClassScope) then
         begin
         // 'Self' in a class proc is the hidden classtype argument
         SelfArg:=TPasArgument.Create('Self',DeclProc);
         ImplProcScope.SelfArg:=SelfArg;
         {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
         SelfArg.Access:=argConst;
-        SelfArg.ArgType:=CurClassScope.CanonicalClassOf;
+        SelfArg.ArgType:=TPasClassScope(CurClassRecScope).CanonicalClassOf;
         SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
         AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
         end;
@@ -5740,8 +5783,8 @@ begin
       ImplProcScope.SelfArg:=SelfArg;
       {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
       SelfArg.Access:=argConst;
-      SelfArg.ArgType:=CurClassType;
-      CurClassType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
+      SelfArg.ArgType:=ClassRecType;
+      ClassRecType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
       AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
       end;
     end;
@@ -5783,7 +5826,7 @@ begin
   if (C=TPasVariable) or (C=TPasConst) then
     FinishVariable(TPasVariable(El))
   else if C=TPasProperty then
-    FinishPropertyOfClass(TPasProperty(El))
+    FinishProperty(TPasProperty(El))
   else if C=TPasArgument then
     FinishArgument(TPasArgument(El))
   else if C=TPasMethodResolution then
@@ -5812,6 +5855,9 @@ begin
     ResolveExpr(El.Expr,rraRead);
   if El.VarType<>nil then
     begin
+    if (El.Parent is TPasRecordType) and (El.VarType=El.Parent) then
+      RaiseMsg(20181218173631,nTypeXIsNotYetCompletelyDefined,
+        sTypeXIsNotYetCompletelyDefined,[El.VarType.Name],El);
     if El.Expr<>nil then
       CheckAssignCompatibility(El,El.Expr,true);
     end
@@ -5855,7 +5901,7 @@ begin
     EmitTypeHints(El,El.VarType);
 end;
 
-procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
+procedure TPasResolver.FinishProperty(PropEl: TPasProperty);
 var
   PropType: TPasType;
   ClassScope: TPasClassScope;
@@ -6750,7 +6796,7 @@ begin
   CreateReference(IntfProc,Expr,rraRead);
   if IntfProc.ClassType<>El.ProcClass then
     RaiseXExpectedButYFound(20180323144107,GetElementTypeName(El.ProcClass),GetElementTypeName(IntfProc),El.InterfaceProc);
-  // Note: do not create map here. CheckImplements in FinishPropertyOfClass must be called before.
+  // Note: do not create map here. CheckImplements in FinishProperty must be called before.
 
   // El.ImplementationProc is resolved in FinishClassType
 end;
@@ -7863,7 +7909,7 @@ begin
     // identifier is a proc and args brackets are missing
     if El.Parent.ClassType=TPasProperty then
       // a property accessor does not need args -> ok
-      // Note: the detailed tests are in FinishPropertyOfClass
+      // Note: the detailed tests are in FinishProperty
     else
       begin
       // examples: funca or @proca or a.funca or @a.funca ...
@@ -7936,7 +7982,8 @@ procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
   Access: TResolvedRefAccess);
 var
   ProcScope, DeclProcScope, SelfScope: TPasProcedureScope;
-  AncestorScope, ClassScope: TPasClassScope;
+  AncestorScope: TPasClassScope;
+  ClassRecScope: TPasClassOrRecordScope;
   DeclProc, AncestorProc: TPasProcedure;
 begin
   {$IFDEF VerbosePasResolver}
@@ -7955,13 +8002,24 @@ begin
   SelfScope:=ProcScope.GetSelfScope;
   if SelfScope=nil then
     RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
-  ClassScope:=SelfScope.ClassScope;
+  ClassRecScope:=SelfScope.ClassScope;
 
-  AncestorScope:=ClassScope.AncestorScope;
-  if AncestorScope=nil then
+  AncestorScope:=nil;
+  if ClassRecScope is TPasClassScope then
     begin
-    // 'inherited;' without ancestor class is silently ignored
-    exit;
+    // inherited in class method
+    AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
+    if AncestorScope=nil then
+      begin
+      // 'inherited;' without ancestor class is silently ignored
+      exit;
+      end;
+    end
+  else
+    begin
+    // inherited in record method
+    RaiseMsg(20181218194022,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
+      ['inherited'],El);
     end;
 
   // search ancestor in element, i.e. 'inherited' expression
@@ -7986,7 +8044,8 @@ procedure TPasResolver.ResolveInheritedCall(El: TBinaryExpr;
 // El.right is the identifier and parameters
 var
   ProcScope, SelfScope: TPasProcedureScope;
-  AncestorScope, ClassScope: TPasClassScope;
+  AncestorScope: TPasClassScope;
+  ClassRecScope: TPasClassOrRecordScope;
   AncestorClass: TPasClassType;
   InhScope: TPasDotClassScope;
 begin
@@ -7998,11 +8057,22 @@ begin
   SelfScope:=ProcScope.GetSelfScope;
   if SelfScope=nil then
     RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
-  ClassScope:=SelfScope.ClassScope;
+  ClassRecScope:=SelfScope.ClassScope;
 
-  AncestorScope:=ClassScope.AncestorScope;
-  if AncestorScope=nil then
-    RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
+  AncestorScope:=nil;
+  if ClassRecScope is TPasClassScope then
+    begin
+    // inherited in class method
+    AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
+    if AncestorScope=nil then
+      RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
+    end
+  else
+    begin
+    // inherited in record method
+    RaiseMsg(20181218194436,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
+      ['inherited'],El);
+    end;
 
   // search call in ancestor
   AncestorClass:=TPasClassType(AncestorScope.Element);
@@ -9325,12 +9395,12 @@ procedure TPasResolver.AddProcedure(El: TPasProcedure);
 var
   ProcName, aClassName: String;
   p: SizeInt;
-  CurClassType: TPasClassType;
+  ClassOrRecType: TPasMembersType;
   ProcScope: TPasProcedureScope;
   HasDot: Boolean;
   CurEl: TPasElement;
   Identifier: TPasIdentifier;
-  CurClassScope: TPasClassScope;
+  ClassOrRecScope: TPasClassOrRecordScope;
   C: TClass;
 begin
   {$IFDEF VerbosePasResolver}
@@ -9370,12 +9440,12 @@ begin
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
     {$ENDIF}
-    CurClassType:=nil;
+    ClassOrRecType:=nil;
     repeat
       p:=Pos('.',ProcName);
       if p<1 then
         begin
-        if CurClassType=nil then
+        if ClassOrRecType=nil then
           RaiseInternalError(20161013170829);
         break;
         end;
@@ -9387,10 +9457,10 @@ begin
       if not IsValidIdent(aClassName) then
         RaiseNotYetImplemented(20161013170844,El);
 
-      if CurClassType<>nil then
+      if ClassOrRecType<>nil then
         begin
-        CurClassScope:=TPasClassScope(CurClassType.CustomData);
-        Identifier:=CurClassScope.FindLocalIdentifier(aClassName);
+        ClassOrRecScope:=TPasClassOrRecordScope(ClassOrRecType.CustomData);
+        Identifier:=ClassOrRecScope.FindLocalIdentifier(aClassName);
         if Identifier=nil then
           RaiseIdentifierNotFound(20180430130635,aClassName,El);
         CurEl:=Identifier.Element;
@@ -9398,7 +9468,7 @@ begin
       else
         CurEl:=FindElementWithoutParams(aClassName,El,false);
 
-      if not (CurEl is TPasClassType) then
+      if not (CurEl is TPasMembersType) then
         begin
         aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
         {$IFDEF VerbosePasResolver}
@@ -9407,26 +9477,29 @@ begin
         RaiseXExpectedButYFound(20170216152557,
           'class',aClassname+':'+GetElementTypeName(CurEl),El);
         end;
-      CurClassType:=TPasClassType(CurEl);
-      if CurClassType.ObjKind<>okClass then
+      ClassOrRecType:=TPasMembersType(CurEl);
+      if ClassOrRecType is TPasClassType then
         begin
-        aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
-        RaiseXExpectedButYFound(20180321161722,
-          'class',aClassname+':'+GetElementTypeName(CurEl),El);
+        if TPasClassType(ClassOrRecType).ObjKind<>okClass then
+          begin
+          aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
+          RaiseXExpectedButYFound(20180321161722,
+            'class',aClassname+':'+GetElementTypeName(CurEl),El);
+          end
         end;
-      if CurClassType.GetModule<>El.GetModule then
+      if ClassOrRecType.GetModule<>El.GetModule then
         begin
         aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
         RaiseMsg(20180211230432,nMethodClassXInOtherUnitY,sMethodClassXInOtherUnitY,
-          [aClassName,CurClassType.GetModule.Name],El);
+          [aClassName,ClassOrRecType.GetModule.Name],El);
         end;
     until false;
 
     if not IsValidIdent(ProcName) then
       RaiseNotYetImplemented(20161013170956,El);
 
-    ProcScope.VisibilityContext:=CurClassType;
-    ProcScope.ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
+    ProcScope.VisibilityContext:=ClassOrRecType;
+    ProcScope.ClassScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
     end;// HasDot=true
 end;
 
@@ -9714,90 +9787,9 @@ begin
             exit;
             end;
         eopAdd:
-          case LeftResolved.BaseType of
-          btChar:
-            begin
-            case RightResolved.BaseType of
-            btChar: SetBaseType(btString);
-            {$ifdef FPC_HAS_CPSTRING}
-            btAnsiChar:
-              if BaseTypeChar=btAnsiChar then
-                SetBaseType(btString)
-              else
-                SetBaseType(btUnicodeString);
-            {$endif}
-            btWideChar:
-              if BaseTypeChar=btWideChar then
-                SetBaseType(btString)
-              else
-                SetBaseType(btUnicodeString);
-            else
-              // use right type for result
-              SetRightValueExpr([rrfReadable]);
-            end;
-            exit;
-            end;
-          {$ifdef FPC_HAS_CPSTRING}
-          btAnsiChar:
-            begin
-            case RightResolved.BaseType of
-            btChar:
-              if BaseTypeChar=btAnsiChar then
-                SetBaseType(btString)
-              else
-                SetBaseType(btUnicodeString);
-            btAnsiChar:
-              if BaseTypeChar=btAnsiChar then
-                SetBaseType(btString)
-              else
-                SetBaseType(btAnsiString);
-            btWideChar:
-              if BaseTypeChar=btWideChar then
-                SetBaseType(btString)
-              else
-                SetBaseType(btUnicodeString);
-            else
-              // use right type for result
-              SetRightValueExpr([rrfReadable]);
-            end;
-            exit;
-            end;
-          {$endif}
-          btWideChar:
-            begin
-              case RightResolved.BaseType of
-              btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
-                if BaseTypeChar=btWideChar then
-                  SetBaseType(btString)
-                else
-                  SetBaseType(btUnicodeString);
-              else
-                // use right type for result
-                SetRightValueExpr([rrfReadable]);
-              end;
-              exit;
-            end;
-          {$ifdef FPC_HAS_CPSTRING}
-          btShortString:
-            begin
-              case RightResolved.BaseType of
-              btChar,btAnsiChar,btShortString,btWideChar:
-                // use left type for result
-                SetLeftValueExpr([rrfReadable]);
-              else
-                // shortstring + string => string
-                SetRightValueExpr([rrfReadable]);
-              end;
-              exit;
-            end;
-          {$endif}
-          btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
-            begin
-              // string + x => string
-              SetLeftValueExpr([rrfReadable]);
+          if RightResolved.BaseType in btAllStringAndChars then
+            if ComputeAddStringRes(LeftResolved,RightResolved,Bin,ResolvedEl) then
               exit;
-            end;
-          end;
         eopLessThan,
         eopGreaterThan,
         eopLessthanEqual,
@@ -10286,6 +10278,117 @@ begin
   if Flags=[] then ;
 end;
 
+function TPasResolver.ComputeAddStringRes(const LeftResolved,
+  RightResolved: TPasResolverResult; ExprEl: TPasExpr; out
+  ResolvedEl: TPasResolverResult): boolean;
+
+  procedure SetBaseType(BaseType: TResolverBaseType);
+  begin
+    SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
+                         ExprEl,[rrfReadable]);
+  end;
+
+  procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
+  begin
+    SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
+      LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,ExprEl,Flags);
+  end;
+
+  procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
+  begin
+    SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
+      RightResolved.LoTypeEl,RightResolved.HiTypeEl,ExprEl,Flags);
+  end;
+
+begin
+  Result:=true;
+  case LeftResolved.BaseType of
+  btChar:
+    begin
+    case RightResolved.BaseType of
+    btChar: SetBaseType(btString);
+    {$ifdef FPC_HAS_CPSTRING}
+    btAnsiChar:
+      if BaseTypeChar=btAnsiChar then
+        SetBaseType(btString)
+      else
+        SetBaseType(btUnicodeString);
+    {$endif}
+    btWideChar:
+      if BaseTypeChar=btWideChar then
+        SetBaseType(btString)
+      else
+        SetBaseType(btUnicodeString);
+    else
+      // use right type for result
+      SetRightValueExpr([rrfReadable]);
+    end;
+    exit;
+    end;
+  {$ifdef FPC_HAS_CPSTRING}
+  btAnsiChar:
+    begin
+    case RightResolved.BaseType of
+    btChar:
+      if BaseTypeChar=btAnsiChar then
+        SetBaseType(btString)
+      else
+        SetBaseType(btUnicodeString);
+    btAnsiChar:
+      if BaseTypeChar=btAnsiChar then
+        SetBaseType(btString)
+      else
+        SetBaseType(btAnsiString);
+    btWideChar:
+      if BaseTypeChar=btWideChar then
+        SetBaseType(btString)
+      else
+        SetBaseType(btUnicodeString);
+    else
+      // use right type for result
+      SetRightValueExpr([rrfReadable]);
+    end;
+    exit;
+    end;
+  {$endif}
+  btWideChar:
+    begin
+      case RightResolved.BaseType of
+      btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
+        if BaseTypeChar=btWideChar then
+          SetBaseType(btString)
+        else
+          SetBaseType(btUnicodeString);
+      else
+        // use right type for result
+        SetRightValueExpr([rrfReadable]);
+      end;
+      exit;
+    end;
+  {$ifdef FPC_HAS_CPSTRING}
+  btShortString:
+    begin
+      case RightResolved.BaseType of
+      btChar,btAnsiChar,btShortString,btWideChar:
+        // use left type for result
+        SetLeftValueExpr([rrfReadable]);
+      else
+        // shortstring + string => string
+        SetRightValueExpr([rrfReadable]);
+      end;
+      exit;
+    end;
+  {$endif}
+  btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
+    begin
+      // string + x => string
+      SetLeftValueExpr([rrfReadable]);
+      exit;
+    end;
+  end;
+  Result:=false;
+end;
+
 procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
   ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
   StartEl: TPasElement);
@@ -11844,24 +11947,20 @@ begin
           {$IFDEF VerbosePasResEval}
           writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
           {$ENDIF}
-          case BuiltInProc.BuiltIn of
-            bfLength: BI_Length_OnEval(BuiltInProc,Params,Flags,Result);
-            bfAssigned: Result:=nil;
-            bfChr: BI_Chr_OnEval(BuiltInProc,Params,Flags,Result);
-            bfOrd: BI_Ord_OnEval(BuiltInProc,Params,Flags,Result);
-            bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Flags,Result);
-            bfPred,bfSucc: BI_PredSucc_OnEval(BuiltInProc,Params,Flags,Result);
-            bfStrFunc: BI_StrFunc_OnEval(BuiltInProc,Params,Flags,Result);
-            bfConcatArray: Result:=nil;
-            bfCopyArray: Result:=nil;
-            bfTypeInfo: Result:=nil;
-            bfDefault: BI_Default_OnEval(BuiltInProc,Params,Flags,Result);
+          if BuiltInProc.Eval<>nil then
+            BuiltInProc.Eval(BuiltInProc,Params,Flags,Result)
           else
-            {$IFDEF VerbosePasResEval}
-            writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
-            {$ENDIF}
-            RaiseNotYetImplemented(20170624192324,Params);
-          end;
+            case BuiltInProc.BuiltIn of
+              bfAssigned: Result:=nil;
+              bfConcatArray: Result:=nil;
+              bfCopyArray: Result:=nil;
+              bfTypeInfo: Result:=nil;
+            else
+              {$IFDEF VerbosePasResEval}
+              writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+              {$ENDIF}
+              RaiseNotYetImplemented(20170624192324,Params);
+            end;
           {$IFDEF VerbosePasResEval}
           {AllowWriteln}
           if Result<>nil then
@@ -13501,6 +13600,95 @@ begin
     ResolvedEl.BaseType:=btArrayLit;
 end;
 
+function TPasResolver.BI_ConcatString_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  i: Integer;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    // all params: char or string
+    Param:=Params.Params[i];
+    ComputeElement(Param,ParamResolved,[]);
+    if not (rrfReadable in ParamResolved.Flags)
+        or not (ParamResolved.BaseType in btAllStringAndChars) then
+      exit(CheckRaiseTypeArgNo(20181219230329,i+1,Param,ParamResolved,'string',RaiseOnError));
+    end;
+  Result:=cExact;
+end;
+
+procedure TPasResolver.BI_ConcatString_OnGetCallResult(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult);
+var
+  i: Integer;
+  Param: TPasExpr;
+  ParamResolved, CombinedResolved: TPasResolverResult;
+begin
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    // all params: char or string
+    Param:=Params.Params[i];
+    ComputeElement(Param,ParamResolved,[]);
+    if i=0 then
+      ResolvedEl:=ParamResolved
+    else
+      begin
+      ComputeAddStringRes(ResolvedEl,ParamResolved,Params,CombinedResolved);
+      ResolvedEl:=CombinedResolved;
+      end;
+    end;
+end;
+
+procedure TPasResolver.BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
+var
+  i: Integer;
+  Param: TPasExpr;
+  Value, NewValue: TResEvalValue;
+  ok: Boolean;
+begin
+  Value:=nil;
+  Evaluated:=nil;
+  ok:=false;
+  try
+    for i:=0 to length(Params.Params)-1 do
+      begin
+      // all params: char or string
+      Param:=Params.Params[i];
+      Value:=Eval(Param,Flags);
+      if Value=nil then
+        exit;
+      if i=0 then
+        begin
+        Evaluated:=Value;
+        Value:=nil;
+        end
+      else
+        begin
+        NewValue:=ExprEvaluator.EvalStringAddExpr(Param,Params.Params[i-1],Param,
+          Evaluated,Value);
+        ReleaseEvalValue(Evaluated);
+        Evaluated:=NewValue;
+        ReleaseEvalValue(Value);
+        end;
+      end;
+    ok:=true;
+  finally
+    ReleaseEvalValue(Value);
+    if not ok then
+      ReleaseEvalValue(Evaluated);
+  end;
+end;
+
 function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
   Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
 var
@@ -14576,8 +14764,9 @@ var
   OnlyTypeMembers, IsClassOf: Boolean;
   TypeEl: TPasType;
   C: TClass;
-  ClassScope: TPasClassScope;
+  ClassRecScope: TPasClassOrRecordScope;
   i: Integer;
+  AbstractProcs: TArrayOfPasProcedure;
 begin
   StartScope:=FindData.StartScope;
   OnlyTypeMembers:=false;
@@ -14694,25 +14883,29 @@ begin
         RaiseInternalError(20170131141936);
       Ref.Context:=TResolvedRefCtxConstructor.Create;
       if StartScope is TPasDotClassScope then
-        ClassScope:=TPasDotClassScope(StartScope).ClassScope
+        ClassRecScope:=TPasDotClassScope(StartScope).ClassScope
       else if (StartScope is TPasWithExprScope)
-          and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
-        ClassScope:=TPasClassScope(TPasWithExprScope(StartScope).Scope)
+          and (TPasWithExprScope(StartScope).Scope is TPasClassOrRecordScope) then
+        ClassRecScope:=TPasClassOrRecordScope(TPasWithExprScope(StartScope).Scope)
       else if (StartScope is TPasProcedureScope) then
-        ClassScope:=TPasProcedureScope(StartScope).ClassScope
+        ClassRecScope:=TPasProcedureScope(StartScope).ClassScope
       else
         RaiseInternalError(20170131150855,GetObjName(StartScope));
-      TypeEl:=ClassScope.Element as TPasType;
+      TypeEl:=ClassRecScope.Element as TPasType;
       TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
-      if (length(ClassScope.AbstractProcs)>0) then
+      if ClassRecScope is TPasClassScope then
         begin
-        if IsClassOf then
-          // aClass.Create: do not warn
-        else
-          for i:=0 to length(ClassScope.AbstractProcs)-1 do
-            LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
-              sConstructingClassXWithAbstractMethodY,
-              [TypeEl.Name,ClassScope.AbstractProcs[i].Name],FindData.ErrorPosEl);
+        AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
+        if (length(AbstractProcs)>0) then
+          begin
+          if IsClassOf then
+            // aClass.Create: do not warn
+          else
+            for i:=0 to length(AbstractProcs)-1 do
+              LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
+                sConstructingClassXWithAbstractMethodY,
+                [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+          end;
         end;
       end;
     {$IFDEF VerbosePasResolver}
@@ -15181,7 +15374,8 @@ begin
         nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
   if bfChr in TheBaseProcs then
     AddBuiltInProc('Chr','function Chr(const Integer): char',
-        @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,nil,nil,bfChr);
+        @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,
+        @BI_Chr_OnEval,nil,bfChr);
   if bfOrd in TheBaseProcs then
     AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
         @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
@@ -15222,6 +15416,10 @@ begin
     AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
         @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
         nil,nil,bfConcatArray);
+  if bfConcatString in TheBaseProcs then
+    AddBuiltInProc('Concat','function Concat(const String1, String2, ...): String',
+        @BI_ConcatString_OnGetCallCompatibility,@BI_ConcatString_OnGetCallResult,
+        @BI_ConcatString_OnEval,nil,bfConcatString);
   if bfCopyArray in TheBaseProcs then
     AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
         @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
@@ -20528,7 +20726,7 @@ var
 begin
   Result:=false;
   if El=nil then exit;
-  if El.Parent is TPasClassType then exit(true);
+  if El.Parent is TPasMembersType then exit(true);
   if not (El.CustomData is TPasProcedureScope) then exit;
   ProcScope:=TPasProcedureScope(El.CustomData);
   Result:=IsMethod(ProcScope.DeclarationProc);

packages/fcl-passrc/src/pastree.pp

@@ -692,14 +692,31 @@ type
     Members: TPasRecordType;
   end;
 
-  { TPasRecordType }
+  { TPasMembersType - base type for TPasRecordType and TPasClassType }
 
-  TPasRecordType = class(TPasType)
+  TPasMembersType = class(TPasType)
   private
     procedure ClearChildReferences(El: TPasElement; arg: pointer);
-    procedure GetMembers(S: TStrings);
   protected
     procedure SetParent(const AValue: TPasElement); override;
+  public
+    PackMode: TPackMode;
+    Members: TFPList;
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
+    Constructor Create(const AName: string; AParent: TPasElement); override;
+    Destructor Destroy; override;
+    Function IsPacked: Boolean;
+    Function IsBitPacked : Boolean;
+    Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    Procedure SetGenericTemplates(AList: TFPList); virtual;
+  end;
+
+  { TPasRecordType }
+
+  TPasRecordType = class(TPasMembersType)
+  private
+    procedure GetMembers(S: TStrings);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -708,15 +725,9 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    PackMode: TPackMode;
-    Members: TFPList;     // list of TPasVariable elements
     VariantEl: TPasElement; // nil or TPasVariable or TPasType
     Variants: TFPList;	// list of TPasVariant elements, may be nil!
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
-    Function IsPacked: Boolean;
-    Function IsBitPacked : Boolean;
     Function IsAdvancedRecord : Boolean;
-    Procedure SetGenericTemplates(AList : TFPList);
   end;
 
   TPasGenericTemplateType = Class(TPasType);
@@ -734,9 +745,7 @@ type
 
   { TPasClassType }
 
-  TPasClassType = class(TPasType)
-  private
-    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  TPasClassType = class(TPasMembersType)
   protected
     procedure SetParent(const AValue: TPasElement); override;
   public
@@ -746,7 +755,6 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    PackMode: TPackMode;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
@@ -755,25 +763,20 @@ type
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     GUIDExpr : TPasExpr;
-    Members: TFPList;     // list of TPasElement
     Modifiers: TStringList;
     Interfaces : TFPList; // list of TPasType
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
     ExternalNameSpace : String;
     ExternalName : String;
     InterfaceType: TPasClassInterfaceType;
-    Procedure SetGenericTemplates(AList : TFPList);
+    Procedure SetGenericTemplates(AList : TFPList); override;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
-    Function IsPacked : Boolean;
     Function InterfaceGUID : string;
     Function IsSealed : Boolean;
     Function IsAbstract : Boolean;
     Function HasModifier(const aModifier: String): Boolean;
   end;
 
-
-
   TArgumentAccess = (argDefault, argConst, argVar, argOut, argConstRef);
 
   { TPasArgument }
@@ -2948,22 +2951,12 @@ end;
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  Members := TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 
 destructor TPasRecordType.Destroy;
 var
   i: Integer;
 begin
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
-
-  for i := 0 to Members.Count - 1 do
-    TPasVariable(Members[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.Members'){$ENDIF};
-  FreeAndNil(Members);
-
   ReleaseAndNil(TPasElement(VariantEl){$IFDEF CheckPasTreeRefCount},'TPasRecordType.VariantEl'{$ENDIF});
 
   if Assigned(Variants) then
@@ -2978,19 +2971,12 @@ end;
 
 { TPasClassType }
 
-procedure TPasClassType.ClearChildReferences(El: TPasElement; arg: pointer);
-begin
-  El.ClearTypeReferences(Self);
-  if arg=nil then ;
-end;
-
 procedure TPasClassType.SetParent(const AValue: TPasElement);
 begin
   if (AValue=nil) and (Parent<>nil) then
     begin
     // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
+    // -> clear all references to this class (releasing loops)
     if AncestorType=Self then
       ReleaseAndNil(TPasElement(AncestorType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
     if HelperForType=Self then
@@ -3002,27 +2988,15 @@ end;
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  PackMode:=pmNone;                     // 12/04/04 - Dave - Added
   IsShortDefinition := False;
-  Members := TFPList.Create;
   Modifiers := TStringList.Create;
   Interfaces:= TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 
 destructor TPasClassType.Destroy;
 var
   i: Integer;
-  El: TPasElement;
 begin
-  for i := 0 to Members.Count - 1 do
-    begin
-    El:=TPasElement(Members[i]);
-    El.Parent:=nil;
-    El.Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Members'){$ENDIF};
-    end;
-  FreeAndNil(Members);
-
   for i := 0 to Interfaces.Count - 1 do
     TPasElement(Interfaces[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Interfaces'){$ENDIF};
   FreeAndNil(Interfaces);
@@ -3030,9 +3004,6 @@ begin
   ReleaseAndNil(TPasElement(HelperForType){$IFDEF CheckPasTreeRefCount},'TPasClassType.HelperForType'{$ENDIF});
   ReleaseAndNil(TPasElement(GUIDExpr){$IFDEF CheckPasTreeRefCount},'TPasClassType.GUIDExpr'{$ENDIF});
   FreeAndNil(Modifiers);
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
   inherited Destroy;
 end;
 
@@ -3062,26 +3033,12 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Interfaces[i]),true);
   ForEachChildCall(aMethodCall,Arg,HelperForType,true);
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
 end;
 
 procedure TPasClassType.SetGenericTemplates(AList: TFPList);
-
-Var
-  I : Integer;
-
 begin
   ObjKind:=okGeneric;
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-  ObjKind:=okGeneric;
+  inherited SetGenericTemplates(AList);
 end;
 
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
@@ -3155,12 +3112,6 @@ begin
   Result:=false;
 end;
 
-function TPasClassType.IsPacked: Boolean;
-begin
-  Result:=PackMode<>pmNone;
-end;
-
-
 { TPasArgument }
 
 destructor TPasArgument.Destroy;
@@ -3987,12 +3938,95 @@ begin
   ForEachChildCall(aMethodCall,Arg,EnumType,true);
 end;
 
-procedure TPasRecordType.ClearChildReferences(El: TPasElement; arg: pointer);
+{ TPasMembersType }
+
+procedure TPasMembersType.ClearChildReferences(El: TPasElement; arg: pointer);
 begin
   El.ClearTypeReferences(Self);
   if arg=nil then ;
 end;
 
+procedure TPasMembersType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this class/record (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
+constructor TPasMembersType.Create(const AName: string; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  PackMode:=pmNone;
+  Members := TFPList.Create;
+  GenericTemplateTypes:=TFPList.Create;
+end;
+
+destructor TPasMembersType.Destroy;
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  for i := 0 to Members.Count - 1 do
+    begin
+    El:=TPasElement(Members[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.Members'){$ENDIF};
+    end;
+  FreeAndNil(Members);
+
+  for i := 0 to GenericTemplateTypes.Count - 1 do
+    begin
+    El:=TPasElement(GenericTemplateTypes[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.GenericTemplateTypes'){$ENDIF};
+    end;
+  FreeAndNil(GenericTemplateTypes);
+
+  inherited Destroy;
+end;
+
+function TPasMembersType.IsPacked: Boolean;
+begin
+  Result:=(PackMode <> pmNone);
+end;
+
+function TPasMembersType.IsBitPacked: Boolean;
+begin
+  Result:=(PackMode=pmBitPacked)
+end;
+
+procedure TPasMembersType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
+  for i:=0 to Members.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
+end;
+
+procedure TPasMembersType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+  El: TPasElement;
+begin
+  For I:=0 to AList.Count-1 do
+    begin
+    El:=TPasElement(AList[i]);
+    El.Parent:=Self;
+    GenericTemplateTypes.Add(El);
+    end;
+  AList.Clear;
+end;
+
+{ TPasRecordType }
+
 procedure TPasRecordType.GetMembers(S: TStrings);
 
 Var
@@ -4049,17 +4083,6 @@ begin
   end;
 end;
 
-procedure TPasRecordType.SetParent(const AValue: TPasElement);
-begin
-  if (AValue=nil) and (Parent<>nil) then
-    begin
-    // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
-    end;
-  inherited SetParent(AValue);
-end;
-
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -4093,54 +4116,30 @@ var
   i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
   ForEachChildCall(aMethodCall,Arg,VariantEl,true);
   if Variants<>nil then
     for i:=0 to Variants.Count-1 do
       ForEachChildCall(aMethodCall,Arg,TPasElement(Variants[i]),false);
 end;
 
-function TPasRecordType.IsPacked: Boolean;
-begin
-  Result:=(PackMode <> pmNone);
-end;
-
-function TPasRecordType.IsBitPacked: Boolean;
-begin
-  Result:=(PackMode=pmBitPacked)
-end;
-
 function TPasRecordType.IsAdvancedRecord: Boolean;
 
 Var
   I : Integer;
+  Member: TPasElement;
 
 begin
   Result:=False;
   I:=0;
   While (Not Result) and (I<Members.Count) do
     begin
-    Result:=TPasElement(Members[i]).InheritsFrom(TPasProcedureBase) or
-            TPasElement(Members[i]).InheritsFrom(TPasProperty);
+    Member:=TPasElement(Members[i]);
+    if (Member.Visibility<>visPublic) then exit(true);
+    if (Member.ClassType<>TPasVariable) then exit(true);
     Inc(I);
     end;
 end;
 
-procedure TPasRecordType.SetGenericTemplates(AList: TFPList);
-var
-  I: Integer;
-begin
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-end;
-
 procedure TPasProcedureType.GetArguments(List : TStrings);
 
 Var

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1479,6 +1479,25 @@ begin
         begin
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
         case BuiltInProc.BuiltIn of
+        bfExit:
+          begin
+          if El.Parent is TParamsExpr then
+            begin
+            Params:=(El.Parent as TParamsExpr).Params;
+            if length(Params)=1 then
+              begin
+              SubEl:=El.Parent;
+              while (SubEl<>nil) and not (SubEl is TPasProcedure) do
+                SubEl:=SubEl.Parent;
+              if (SubEl is TPasProcedure)
+                  and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
+                begin
+                SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
+                UseElement(SubEl,rraAssign,false);
+                end;
+              end;
+            end;
+          end;
         bfTypeInfo:
           begin
           Params:=(El.Parent as TParamsExpr).Params;
@@ -1490,9 +1509,10 @@ begin
           {$ENDIF}
           if ParamResolved.IdentEl=nil then
             RaiseNotSupported(20180628155107,Params[0]);
-          if ParamResolved.IdentEl is TPasFunction then
+          if (ParamResolved.IdentEl is TPasProcedure)
+              and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
             begin
-            SubEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType;
+            SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
             MarkImplScopeRef(El,SubEl,psraTypeInfo);
             UseTypeInfo(SubEl);
             end

packages/fcl-passrc/src/pparser.pp

@@ -81,7 +81,7 @@ const
   nErrRecordConstantsNotAllowed = 2035;
   nErrRecordMethodsNotAllowed = 2036;
   nErrRecordPropertiesNotAllowed = 2037;
-  nErrRecordVisibilityNotAllowed = 2038;
+  // free , was nErrRecordVisibilityNotAllowed = 2038;
   nParserTypeNotAllowedHere = 2039;
   nParserNotAnOperand = 2040;
   nParserArrayPropertiesCannotHaveDefaultValue = 2041;
@@ -142,7 +142,7 @@ resourcestring
   SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
-  SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
+  // free, was SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
   SParserTypeNotAllowedHere = 'Type "%s" not allowed here';
   SParserNotAnOperand = 'Not an operand: (%d : %s)';
   SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
@@ -4504,7 +4504,7 @@ begin
   ParseVarList(Parent,List,AVisibility,False);
   tt:=[tkEnd,tkSemicolon];
   if ClosingBrace then
-   include(tt,tkBraceClose);
+    Include(tt,tkBraceClose);
   if not (CurToken in tt) then
     ParseExc(nParserExpectedSemiColonEnd,SParserExpectedSemiColonEnd);
 end;
@@ -6362,15 +6362,13 @@ begin
       tkGeneric, // Counts as field name
       tkIdentifier :
         begin
-          if CheckVisibility(CurtokenString,v) then
-            begin
-            If not (msAdvancedRecords in Scanner.CurrentModeSwitches) then
-              ParseExc(nErrRecordVisibilityNotAllowed,SErrRecordVisibilityNotAllowed);
-            if not (v in [visPrivate,visPublic,visStrictPrivate]) then
-              ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
-            NextToken;
-            Continue;
-            end;
+        If AllowMethods and CheckVisibility(CurTokenString,v) then
+          begin
+          if not (v in [visPrivate,visPublic,visStrictPrivate]) then
+            ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
+          NextToken;
+          Continue;
+          end;
         OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
@@ -6423,12 +6421,15 @@ begin
   try
     Result.PackMode:=PackMode;
     NextToken;
-    ParseRecordFieldList(Result,tkEnd,true);
+    ParseRecordFieldList(Result,tkEnd,msAdvancedRecords in Scanner.CurrentModeSwitches);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
     if not ok then
+      begin
+      Result.Parent:=nil; // clear references from members to Result
       Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      end;
   end;
 end;
 
@@ -6826,7 +6827,8 @@ begin
     end;
     exit;
     end;
-  if ((AobjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches) and  CurTokenIsIdentifier('external')) then
+  if ((AObjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches)
+      and CurTokenIsIdentifier('external')) then
     begin
     NextToken;
     if CurToken<>tkString then

packages/fcl-passrc/src/pscanner.pp

@@ -749,6 +749,7 @@ type
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
   protected
+    function ReadIdentifier(const AParam: string): string;
     function FetchLine: boolean;
     procedure AddFile(aFilename: string); virtual;
     function GetMacroName(const Param: String): String;
@@ -3457,13 +3458,16 @@ begin
 end;
 
 procedure TPascalScanner.HandleIFDEF(const AParam: String);
+var
+  aName: String;
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       PPSkipMode := ppSkipElseBranch
     else
       begin
@@ -3472,20 +3476,23 @@ begin
       end;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[aName])
       else
-        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[aName]);
     end;
 end;
 
 procedure TPascalScanner.HandleIFNDEF(const AParam: String);
+var
+  aName: String;
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       begin
       PPSkipMode := ppSkipIfBranch;
       PPIsSkipping := true;
@@ -3494,9 +3501,9 @@ begin
       PPSkipMode := ppSkipElseBranch;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[aName])
       else
-        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[aName]);
     end;
 end;
 
@@ -4682,6 +4689,16 @@ begin
   FReadOnlyValueSwitches:=AValue;
 end;
 
+function TPascalScanner.ReadIdentifier(const AParam: string): string;
+var
+  p, l: Integer;
+begin
+  p:=1;
+  l:=length(AParam);
+  while (p<=l) and (AParam[p] in IdentChars) do inc(p);
+  Result:=LeftStr(AParam,p-1);
+end;
+
 function TPascalScanner.FetchLine: boolean;
 begin
   if CurSourceFile.IsEOF then

packages/fcl-passrc/tests/tcresolver.pas

@@ -239,7 +239,7 @@ type
 
     // strings
     Procedure TestChar_BuiltInProcs;
-    Procedure TestString_SetLength;
+    Procedure TestString_BuiltInProcs;
     Procedure TestString_Element;
     Procedure TestStringElement_MissingArgFail;
     Procedure TestStringElement_IndexNonIntFail;
@@ -483,7 +483,27 @@ type
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_Variant;
-    Procedure TestRecord_VarExternal; // ToDo
+    Procedure TestRecord_VarExternal;
+    Procedure TestRecord_VarSelfFail;
+
+    // advanced record
+    Procedure TestAdvRecord;
+    Procedure TestAdvRecord_Private; // ToDo
+    // Todo: Procedure TestAdvRecord_ForwardFail
+    // ToDo: public, private, strict private
+    // ToDo: TestAdvRecordPublsihedFail
+    // ToDo: TestAdvRecord_VirtualFail
+    // ToDo: TestAdvRecord_OverrideFail
+    // ToDo: constructor, destructor
+    // ToDo: class function/procedure
+    // ToDo: nested record type
+    // ToDo: const
+    // todo: var
+    // todo: class var
+    // todo: property
+    // todo: class property
+    // todo: TestRecordAsFuncResult
+    // todo: for in record
 
     // class
     Procedure TestClass;
@@ -1579,7 +1599,7 @@ begin
       if (Msg<>E.Message) and (Msg<>E.MsgPattern) and (Msg<>Full) then
         begin
         {$IFDEF VerbosePasResolver}
-        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
+        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'} E.Message={',E.Message,'} Full={',Full,'}');
         {$ENDIF}
         AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
           '{'+Msg+'}','{'+E.Message+'} OR {'+E.MsgPattern+'} OR {'+Full+'}');
@@ -3200,14 +3220,17 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestString_SetLength;
+procedure TTestResolver.TestString_BuiltInProcs;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  s: string;');
-  Add('begin');
-  Add('  SetLength({#a_var}s,3);');
-  Add('  SetLength({#b_var}s,length({#c_read}s));');
+  Add([
+  'var',
+  '  s: string;',
+  'begin',
+  '  SetLength({#a_var}s,3);',
+  '  SetLength({#b_var}s,length({#c_read}s));',
+  '  s:=concat(''a'',s);',
+  '']);
   ParseProgram;
   CheckAccessMarkers;
 end;
@@ -7787,6 +7810,55 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecord_VarSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TRec = record',
+  '    r: Trec;',
+  '  end;',
+  'begin']);
+  CheckResolverException('type "TRec" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolver.TestAdvRecord;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TRec.DoIt;',
+  'begin',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAdvRecord_Private;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '  private',
+  '    a: byte;',
+  '  public',
+  '    b: byte;',
+  '  end;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  '  r.a:=r.b;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcscanner.pas

@@ -1404,7 +1404,7 @@ procedure TTestScanner.TestDefine2;
 
 begin
   FSCanner.Defines.Add('ALWAYS');
-  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}');
+  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS comment} of {$ENDIF}');
 end;
 
 procedure TTestScanner.TestDefine21;

packages/fcl-passrc/tests/tctypeparser.pas

@@ -2043,6 +2043,7 @@ Var
   P : TPasFunction;
 
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
   AssertEquals('Member count',3,TheRecord.Members.Count);
   AssertField1([]);
@@ -2057,6 +2058,7 @@ end;
 
 procedure TTestRecordTypeParser.TestFieldAndClassVar;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class var y : integer;'],'',False);
   AssertField1([]);
   AssertTrue('Second field is class var',vmClass in Field2.VarModifiers);
@@ -2064,6 +2066,7 @@ end;
 
 procedure TTestRecordTypeParser.TestFieldAndVar;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','var y : integer;'],'',False);
   AssertField1([]);
   AssertTrue('Second field is regular var',not (vmClass in Field2.VarModifiers));

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -128,6 +128,7 @@ type
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_FunctionResultAssembler;
+    procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
 
     // whole program optimization
@@ -2158,6 +2159,20 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultExit;
+begin
+  StartProgram(false);
+  Add([
+  'function GetIt: longint;',
+  'begin',
+  '  exit(3);',
+  'end;',
+  'begin',
+  '  GetIt;']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
 begin
   StartProgram(false);

packages/fv/src/app.pas

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

packages/fv/src/platform.inc

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

packages/fv/src/tabs.pas

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

packages/fv/src/views.pas

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

packages/ide/fpcodcmp.pas

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

packages/ide/fpcodtmp.pas

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

packages/ide/fpcompil.pas

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

packages/ide/fpdebug.pas

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

packages/ide/fphelp.pas

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

packages/ide/fpide.pas

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

packages/ide/fpini.pas

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

packages/ide/fpmfile.inc

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

packages/ide/fpmsrch.inc

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

packages/ide/fpmwnd.inc

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

packages/ide/fpswitch.pas

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

packages/ide/fpsymbol.pas

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

packages/ide/fptools.pas

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

packages/ide/fpviews.pas

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

packages/ide/globdir.inc

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

packages/ide/wcedit.pas

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

packages/ide/weditor.pas

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

packages/ide/whelp.pas

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

packages/ide/whtmlhlp.pas

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

packages/ide/whtmlscn.pas

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

packages/ide/wini.pas

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

packages/ide/wnghelp.pas

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

packages/ide/wresourc.pas

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

packages/ide/wutils.pas

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

packages/ide/wwinhelp.pas

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

packages/pastojs/src/fppas2js.pp

@@ -168,6 +168,7 @@ Works:
   - low(), high()
   - when passing as argument set state referenced
   - set of (enum,enum2)  - anonymous enumtype
+  - set of char, boolean, integer range, char range, enum range
 - with-do  using local var
   - with record do i:=v;
   - with classinstance do begin create; i:=v; f(); i:=a[]; end;
@@ -361,15 +362,18 @@ Works:
 - procedure val(const string; var enumtype; out int)
 
 ToDos:
-- do not rename property Date
 - cmd line param to set modeswitch
+- Result:=inherited;
+- move local types to unit scope
+- records:
+  - move local types to global
+  - use rtl.createRecord to create a record type
+  - use Object.create to instantiate simple records
+  - use TRec.$create to instantiate complex records
+  - advanced records:
+    - functions
+    - rtti
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
-- bug:
-  v:=a[0]  gives Local variable "a" is assigned but never used
-- bug:
-  exit(something) gives function result not set
-- constructor does not need reintroduce
-- double utf8bom at start must give error  pscanner 4259
 - setlength(dynarray)  modeswitch to not create a copy
 - 'new', 'Function' -> class var use .prototype
 - static arrays
@@ -382,17 +386,12 @@ ToDos:
   - record member interface
 - range check o.arr[i]  o.astring[i]
 - record field external name
-- make records more lightweight
 - 1 as TEnum, ERangeError
 - ifthen<T>
 - stdcall of methods: pass original 'this' as first parameter
-- move local types to unit scope
 - property read Arr[0]  https://bugs.freepascal.org/view.php?id=33416
 - write, writeln
 - array of const
-- Result:=inherited;
-- sets
-  - set of char, boolean, integer range, char range, enum range
 - call array of proc element without ()
 - enums with custom values
 - library
@@ -429,14 +428,11 @@ ToDos:
   -O2 CSE
   -O3 DFA
 - objects
-- advanced records
-  - TPasClassRecordType as ancestor
 - class helpers, type helpers, record helpers, array helpers
 - generics
 - operator overloading
   - operator enumerator
 - inline
-- anonymous functions
 - extended RTTI
 - attributes
 
@@ -1238,7 +1234,7 @@ type
     procedure FinishVariable(El: TPasVariable); override;
     procedure FinishArgument(El: TPasArgument); override;
     procedure FinishProcedureType(El: TPasProcedureType); override;
-    procedure FinishPropertyOfClass(PropEl: TPasProperty); override;
+    procedure FinishProperty(PropEl: TPasProperty); override;
     procedure CheckExternalClassConstructor(Ref: TResolvedReference); virtual;
     procedure CheckConditionExpr(El: TPasExpr;
       const ResolvedEl: TPasResolverResult); override;
@@ -1769,6 +1765,7 @@ type
     Function ConvertBuiltIn_WriteStr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_Val(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_ConcatArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_ConcatString(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_CopyArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_InsertArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_DeleteArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
@@ -3660,7 +3657,7 @@ begin
     end;
 end;
 
-procedure TPas2JSResolver.FinishPropertyOfClass(PropEl: TPasProperty);
+procedure TPas2JSResolver.FinishProperty(PropEl: TPasProperty);
 var
   Getter, Setter: TPasElement;
   GetterIsBracketAccessor, SetterIsBracketAccessor: Boolean;
@@ -3670,7 +3667,7 @@ var
   IndexExpr: TPasExpr;
   PropArgs: TFPList;
 begin
-  inherited FinishPropertyOfClass(PropEl);
+  inherited FinishProperty(PropEl);
 
   ParentC:=PropEl.Parent.ClassType;
   if (ParentC=TPasClassType) then
@@ -3898,7 +3895,7 @@ begin
     // read 16-bit
     v:=(Bytes[BytePos] shl 8)+Bytes[(BytePos+1) and 15];
     // change some bits
-    v:=v+(ord(Name[i]) shl (11-BitPos));
+    v:=v+integer((ord(Name[i]) shl (11-BitPos)));
     // write 16 bit
     Bytes[BytePos]:=(v shr 8) and $ff;
     Bytes[(BytePos+1) and 15]:=v and $ff;
@@ -3950,7 +3947,7 @@ var
   TIName: String;
 begin
   Result:=cIncompatible;
-  //writeln('TPas2JSResolver.CheckAssignCompatibilityCustom ',GetResolverResultDbg(LHS));
+  //writeln('TPas2JSResolver.CheckAssignCompatibilityCustom LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
   if LHS.BaseType=btCustom then
     begin
     if not (LHS.LoTypeEl is TPasUnresolvedSymbolRef) then
@@ -3978,7 +3975,12 @@ begin
             Result:=cExact;
           end
         else if RHS.BaseType=btContext then
-          Result:=cJSValueConversion;
+          Result:=cJSValueConversion
+        else if (RHS.BaseType=btProc) and (RHS.IdentEl=nil) then
+          begin
+          // JSValue:=anonymousproc
+          Result:=cExact;
+          end;
         end
       else if RHS.BaseType=btContext then
         begin
@@ -5848,7 +5850,7 @@ var
   C: TJSCallExpression;
   Proc: TPasProcedure;
   ProcScope: TPasProcedureScope;
-  ClassScope: TPasClassScope;
+  ClassScope: TPasClassOrRecordScope;
   aClass: TPasElement;
   ArgEx: TJSLiteral;
   FunName: String;
@@ -8521,6 +8523,7 @@ begin
           bfWriteStr: Result:=ConvertBuiltIn_WriteStr(El,AContext);
           bfVal: Result:=ConvertBuiltIn_Val(El,AContext);
           bfConcatArray: Result:=ConvertBuiltIn_ConcatArray(El,AContext);
+          bfConcatString: Result:=ConvertBuiltIn_ConcatString(El,AContext);
           bfCopyArray: Result:=ConvertBuiltIn_CopyArray(El,AContext);
           bfInsertArray: Result:=ConvertBuiltIn_InsertArray(El,AContext);
           bfDeleteArray: Result:=ConvertBuiltIn_DeleteArray(El,AContext);
@@ -10742,6 +10745,40 @@ begin
     end;
 end;
 
+function TPasToJSConverter.ConvertBuiltIn_ConcatString(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Params: TPasExprArray;
+  A: TJSElement;
+  Call: TJSCallExpression;
+  i: Integer;
+  DotEx: TJSDotMemberExpression;
+begin
+  Params:=El.Params;
+  if Length(Params)=1 then
+    // concat(a) -> a
+    Result:=ConvertElement(Params[0],AContext)
+  else
+    begin
+    // concat(a,b,c) -> a.concat(b,c)
+    Result:=nil;
+    A:=ConvertElement(Params[0],AContext); // beware: might fail
+    Call:=CreateCallExpression(El);
+    try
+      DotEx:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,Params[0]));
+      DotEx.MExpr:=A;
+      DotEx.Name:='concat';
+      Call.Expr:=DotEx;
+      for i:=1 to length(Params)-1 do
+        Call.AddArg(ConvertElement(Params[i],AContext));
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
+    end;
+end;
+
 function TPasToJSConverter.ConvertBuiltIn_CopyArray(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
 var
@@ -12548,7 +12585,7 @@ begin
       List:=TJSStatementList(CreateElement(TJSStatementList,El));
       List.A:=Result;
       Result:=List;
-      OrdType:=GetOrdType(0,El.Values.Count-1,El);
+      OrdType:=GetOrdType(0,TMaxPrecInt(El.Values.Count)-1,El);
       // module.$rtti.$TIEnum("TMyEnum",{...});
       Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewEnum),false,AContext,TIObj);
       List.B:=Call;
@@ -16484,10 +16521,10 @@ var
           StartInt:=0;
           {$IFDEF FPC_HAS_CPSTRING}
           if InValue.Kind=revkString then
-            EndInt:=length(UTF8Decode(TResEvalString(InValue).S))-1
+            EndInt:=TMaxPrecInt(length(UTF8Decode(TResEvalString(InValue).S)))-1
           else
           {$ENDIF}
-            EndInt:=length(TResEvalUTF16(InValue).S)-1;
+            EndInt:=TMaxPrecInt(length(TResEvalUTF16(InValue).S))-1;
           ReleaseEvalValue(InValue);
           end;
         revkRangeInt,revkSetOfInt:

packages/pastojs/src/pas2jscompiler.pp

@@ -1084,8 +1084,8 @@ procedure TPas2jsCompilerFile.CreateConverter;
 begin
   if FConverter<>nil then exit;
   FConverter:=TPasToJSConverter.Create;
-  FConverter.Options:=GetInitialConverterOptions;
   FConverter.Globals:=Compiler.ConverterGlobals;
+  FConverter.Options:=GetInitialConverterOptions;
 end;
 
 procedure TPas2jsCompilerFile.OnResolverCheckSrcName(const Element: TPasElement);

packages/pastojs/tests/tcconverter.pp

@@ -1259,6 +1259,7 @@ end;
 procedure TTestConverter.SetUp;
 begin
   FConverter:=TPasToJSConverter.Create;
+  FConverter.Globals:=TPasToJSConverterGlobals.Create(FConverter);
 end;
 
 procedure TTestConverter.TearDown;

packages/pastojs/tests/tcfiler.pas

@@ -444,8 +444,8 @@ begin
   FInitialFlags.ModeSwitches:=Scanner.CurrentModeSwitches;
   FInitialFlags.BoolSwitches:=Scanner.CurrentBoolSwitches;
   FInitialFlags.ConverterOptions:=Converter.Options;
-  FInitialFlags.TargetPlatform:=Converter.TargetPlatform;
-  FInitialFlags.TargetProcessor:=Converter.TargetProcessor;
+  FInitialFlags.TargetPlatform:=Converter.Globals.TargetPlatform;
+  FInitialFlags.TargetProcessor:=Converter.Globals.TargetProcessor;
   // ToDo: defines
 end;
 

packages/pastojs/tests/tcmodules.pas

@@ -533,6 +533,7 @@ type
     Procedure TestExternalClass_OverloadHint;
     Procedure TestExternalClass_SameNamePublishedProperty;
     Procedure TestExternalClass_Property;
+    Procedure TestExternalClass_PropertyDate;
     Procedure TestExternalClass_ClassProperty;
     Procedure TestExternalClass_ClassOf;
     Procedure TestExternalClass_ClassOtherUnit;
@@ -1197,6 +1198,7 @@ function TCustomTestModule.CreateConverter: TPasToJSConverter;
 begin
   Result:=TPasToJSConverter.Create;
   Result.Options:=co_tcmodules;
+  Result.Globals:=TPasToJSConverterGlobals.Create(Result);
 end;
 
 procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
@@ -1769,9 +1771,9 @@ begin
     if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
     if (Marker<>nil) then
       begin
-      if Item.SourcePos.Row<>Marker^.Row then continue;
-      if (Item.SourcePos.Column<Marker^.StartCol)
-          or (Item.SourcePos.Column>Marker^.EndCol) then continue;
+      if Item.SourcePos.Row<>cardinal(Marker^.Row) then continue;
+      if (Item.SourcePos.Column<cardinal(Marker^.StartCol))
+          or (Item.SourcePos.Column>cardinal(Marker^.EndCol)) then continue;
       end;
     // found
     FHintMsgsGood.Add(Item);
@@ -4068,6 +4070,9 @@ begin
   'procedure DoMore(f,g: TProc);',
   'begin',
   'end;',
+  'procedure DoOdd(v: jsvalue);',
+  'begin',
+  'end;',
   'procedure DoIt(f: TFunc);',
   'begin',
   '  DoIt(function(b:word): word',
@@ -4075,6 +4080,7 @@ begin
   '      Result:=1+b;',
   '    end);',
   '  DoMore(procedure begin end, procedure begin end);',
+  '  DoOdd(procedure begin end);',
   'end;',
   'begin',
   '  DoMore(procedure begin end,',
@@ -4087,6 +4093,8 @@ begin
     LinesToStr([ // statements
     'this.DoMore = function (f, g) {',
     '};',
+    'this.DoOdd = function (v) {',
+    '};',
     'this.DoIt = function (f) {',
     '  $mod.DoIt(function (b) {',
     '    var Result = 0;',
@@ -4096,6 +4104,8 @@ begin
     '  $mod.DoMore(function () {',
     '  }, function () {',
     '  });',
+    '  $mod.DoOdd(function () {',
+    '  });',
     '};',
     '']),
     LinesToStr([
@@ -6369,6 +6379,8 @@ begin
   '  s:=#$20AC;', // euro
   '  s:=#$10437;', // outside BMP
   '  s:=default(string);',
+  '  s:=concat(s);',
+  '  s:=concat(s,''a'',s)',
   '']);
   ConvertProgram;
   CheckSource('TestStringConst',
@@ -6385,8 +6397,10 @@ begin
     '$mod.s=''"\''"'';',
     '$mod.s="€";',
     '$mod.s="'#$F0#$90#$90#$B7'";',
-    '$mod.s="";'
-    ]));
+    '$mod.s="";',
+    '$mod.s = $mod.s;',
+    '$mod.s = $mod.s.concat("a", $mod.s);',
+    '']));
 end;
 
 procedure TTestModule.TestStringConstSurrogate;
@@ -13848,27 +13862,28 @@ end;
 procedure TTestModule.TestExternalClass_Property;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtA''');
-  Add('    function getYear: longint;');
-  Add('    procedure setYear(Value: longint);');
-  Add('    property Year: longint read getyear write setyear;');
-  Add('  end;');
-  Add('  TExtB = class (TExtA)');
-  Add('    procedure OtherSetYear(Value: longint);');
-  Add('    property year write othersetyear;');
-  Add('  end;');
-  Add('procedure textb.othersetyear(value: longint);');
-  Add('begin');
-  Add('  setYear(Value+4);');
-  Add('end;');
-  Add('var');
-  Add('  A: texta;');
-  Add('  B: textb;');
-  Add('begin');
-  Add('  a.year:=a.year+1;');
-  Add('  b.year:=b.year+2;');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    function getYear: longint;',
+  '    procedure setYear(Value: longint);',
+  '    property Year: longint read getyear write setyear;',
+  '  end;',
+  '  TExtB = class (TExtA)',
+  '    procedure OtherSetYear(Value: longint);',
+  '    property year write othersetyear;',
+  '  end;',
+  'procedure textb.othersetyear(value: longint);',
+  'begin',
+  '  setYear(Value+4);',
+  'end;',
+  'var',
+  '  A: texta;',
+  '  B: textb;',
+  'begin',
+  '  a.year:=a.year+1;',
+  '  b.year:=b.year+2;']);
   ConvertProgram;
   CheckSource('TestExternalClass_NonExternalOverride',
     LinesToStr([ // statements
@@ -13890,6 +13905,62 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_PropertyDate;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '  end;',
+  '  TExtB = class (TExtA)',
+  '    FDate: string;',
+  '    property Date: string read FDate write FDate;',
+  '    property ExtA: string read FDate write FDate;',
+  '  end;',
+  '  {$M+}',
+  '  TObject = class',
+  '    FDate: string;',
+  '  published',
+  '    property Date: string read FDate write FDate;',
+  '    property ExtA: string read FDate write FDate;',
+  '  end;',
+  'var',
+  '  B: textb;',
+  '  o: TObject;',
+  'begin',
+  '  b.date:=b.exta;',
+  '  o.date:=o.exta;']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_PropertyDate',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '    this.FDate = "";',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FDate = "";',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("FDate", rtl.string);',
+    '  $r.addProperty("Date", 0, rtl.string, "FDate", "FDate");',
+    '  $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate");',
+    '});',
+    'this.B = null;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.B.FDate = $mod.B.FDate;',
+    '$mod.o.FDate = $mod.o.FDate;',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_ClassProperty;
 begin
   StartProgram(false);

packages/pastojs/tests/tcprecompile.pas

@@ -552,7 +552,7 @@ begin
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
-    '  rtl.checkVersion(10101);',
+    '  rtl.checkVersion(10301);',
     '  var $mod = this;',
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then

packages/pastojs/tests/tcunitsearch.pas

@@ -209,7 +209,7 @@ procedure TCustomTestCLI.SetWorkDir(const AValue: string);
 var
   NewValue: String;
 begin
-  NewValue:=IncludeTrailingPathDelimiter(ResolveDots(AValue));
+  NewValue:=IncludeTrailingPathDelimiter(ExpandFileNamePJ(ResolveDots(AValue)));
   if FWorkDir=NewValue then Exit;
   FWorkDir:=NewValue;
 end;
@@ -228,6 +228,7 @@ begin
   CompilerExe:='/usr/bin/pas2js';
   {$ENDIF}
   FCompiler:=TTestCompiler.Create;
+  //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
   Compiler.Log.OnLog:=@DoLog;
   Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
   Compiler.FileCache.OnReadFile:=@OnReadFile;

packages/pastojs/tests/testpas2js.lpi

@@ -76,6 +76,7 @@
       <Unit9>
         <Filename Value="tcunitsearch.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCUnitSearch"/>
       </Unit9>
       <Unit10>
         <Filename Value="tcprecompile.pas"/>

packages/rtl-extra/src/inc/objects.pp

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

rtl/inc/llvmintr.inc

@@ -31,3 +31,12 @@ function llvm_sqrt_f80(val: extended): extended; compilerproc; external name 'll
 {$ifdef SUPPORT_FLOAT128}
 function llvm_sqrt_f128(val: float128): float128; compilerproc; external name 'llvm.sqrt.f128';
 {$endif}
+
+function llvm_fma_f32(a, b, c: single): single; compilerproc; external name 'llvm.fma.f32';
+function llvm_fma_f64(a, b, c: double): double; compilerproc; external name 'llvm.fma.f64';
+{$ifdef SUPPORT_EXTENDED}
+function llvm_fma_f80(a, b, c: extended): extended; compilerproc; external name 'llvm.fma.f80';
+{$endif}
+{$ifdef SUPPORT_FLOAT128}
+function llvm_fma_f128(a, b, c: float128): float128; compilerproc; external name 'llvm.fma.f128';
+{$endif}

tests/tbs/tb0268.pp

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

tests/test/units/character/tiswhitespace.pp

@@ -77,7 +77,13 @@ var
   uc : UnicodeChar;
 begin  
   e := 1;
-  CheckItems([$0020,$1680,$180E],True,e);
+  { According to:
+    https://en.wikipedia.org/wiki/Unicode_character_property
+    Unicode char $180E, Mongolian Vowel Separator
+    was considered as a space separator but is
+    in the Other,Format category since Unicode version 6.3.0
+    thus $180E is removed here. }
+  CheckItems([$0020,$1680],True,e);
   CheckItems($2000,$200A,True,e);
   CheckItems([$202F,$205F,$3000],True,e);
   CheckItems([$2028,$2029],True,e);

tests/test/units/fpcunit/tcbucketlist.pp

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testutils, testregistry,
-  BucketList;
+  contnrs;
 
 type
   TMyBucketList = Class(TBucketList)

tests/test/units/fpcunit/tccompstreaming.pp

@@ -1,5 +1,7 @@
 Unit tccompstreaming;
 
+{$mode objfpc}
+
 interface
 
 Uses

tests/test/units/fpcunit/tctparser.pp

@@ -8,7 +8,7 @@ uses
   Classes, SysUtils, fpcunit, testutils, testregistry;
 
   { TTestToString }
-
+type
   TTestToString= class(TTestCase)
   private
     fStream : TMemoryStream;
@@ -908,4 +908,4 @@ initialization
 
   RegisterTests([TTestToString,TTestTokenInt,TTestTokenFloat,TTestSymbol,TTestBinary]);
 
-end.
+end.

tests/test/units/fpcunit/testcomps.pp

@@ -1,5 +1,7 @@
 unit testcomps;
 
+{$mode objfpc}
+
 interface
 
 uses classes, sysutils;

utils/pas2js/dist/rtl.js

@@ -2,7 +2,7 @@
 
 var rtl = {
 
-  version: 10101,
+  version: 10301,
 
   quiet: false,
   debug_load_units: false,

utils/pas2js/docs/translation.html

@@ -2940,6 +2940,7 @@ End.
     <li>Intrinsic procedure WriteStr(out s: string; params...)</li>
     <li><i>Debugger;</i> converts to <i>debugger;</i>. If a debugger is running
       it will break on this line just like a break point.</li>
+    <li><i>concat(string1,string2,...)</i> since 1.3</li>
     </ul>
     </div>