* merged r15735 through r15751 from trunk

git-svn-id: branches/llvm@15752 -

.gitattributes

@@ -9238,6 +9238,8 @@ tests/test/tinterface4.pp svneol=native#text/plain
 tests/test/tinterface5.pp svneol=native#text/plain
 tests/test/tinterface6.pp svneol=native#text/plain
 tests/test/tinterrupt.pp svneol=native#text/plain
+tests/test/tintfcdecl1.pp svneol=native#text/plain
+tests/test/tintfcdecl2.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tisogoto1.pp svneol=native#text/pascal

compiler/aasmdata.pas

@@ -332,9 +332,6 @@ implementation
         for hal:=low(TAsmListType) to high(TAsmListType) do
           AsmLists[hal]:=TAsmList.create;
         WideInits :=TLinkedList.create;
-        { PIC data }
-        if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin,system_i386_darwin,system_arm_darwin]) then
-          new_section(AsmLists[al_picdata],sec_data_nonlazy,'',sizeof(pint));
         { CFI }
         FAsmCFI:=CAsmCFI.Create;
       end;

compiler/cgobj.pas

@@ -1115,6 +1115,7 @@ implementation
            end;
       end;
 
+
     procedure tcg.a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : aint;align : longint);
       var
         href : treference;
@@ -4169,6 +4170,7 @@ implementation
       var
         l: tasmsymbol;
         ref: treference;
+        nlsymname: string;
       begin
         result := NR_NO;
         case target_info.system of
@@ -4177,10 +4179,12 @@ implementation
           system_powerpc64_darwin,
           system_arm_darwin:
             begin
-              l:=current_asmdata.getasmsymbol('L'+symname+'$non_lazy_ptr');
+              nlsymname:='L'+symname+'$non_lazy_ptr';
+              l:=current_asmdata.getasmsymbol(nlsymname);
               if not(assigned(l)) then
                 begin
-                  l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_LOCAL,AT_DATA);
+                  new_section(current_asmdata.asmlists[al_picdata],sec_data_nonlazy,'',sizeof(pint));
+                  l:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA);
                   current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
                   if not(weak) then
                     current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.RefAsmSymbol(symname).Name))

compiler/defutil.pas

@@ -997,7 +997,7 @@ implementation
             end;
           stringdef :
             begin
-              if is_ansistring(def) or is_widestring(def) then
+              if is_ansistring(def) or is_wide_or_unicode_string(def) then
                 result := OS_ADDR
               else
                 result:=int_cgsize(def.size);

compiler/i386/cgcpu.pas

@@ -552,38 +552,20 @@ unit cgcpu;
       {
       possible calling conventions:
                     default stdcall cdecl pascal register
-      default(0):      OK     OK    OK(1)  OK       OK
-      virtual(2):      OK     OK    OK(3)  OK       OK
+      default(0):      OK     OK    OK     OK       OK
+      virtual(1):      OK     OK    OK     OK       OK(2)
 
       (0):
           set self parameter to correct value
           jmp mangledname
 
-      (1): The code is the following
-           set self parameter to correct value
-           call mangledname
-           set self parameter to interface value
-           ret
-
-           This is different to case (0) because in theory, the caller
-           could reuse the data pushed on the stack so we've to return
-           it unmodified because self is const.
-
-      (2): The wrapper code use %eax to reach the virtual method address
+      (1): The wrapper code use %eax to reach the virtual method address
            set self to correct value
            move self,%eax
            mov  0(%eax),%eax ; load vmt
            jmp  vmtoffs(%eax) ; method offs
 
-      (3): The wrapper code use %eax to reach the virtual method address
-           set self to correct value
-           move self,%eax
-           mov  0(%eax),%eax ; load vmt
-           jmp  vmtoffs(%eax) ; method offs
-           set self parameter to interface value
-
-
-      (4): Virtual use values pushed on stack to reach the method address
+      (2): Virtual use values pushed on stack to reach the method address
            so the following code be generated:
            set self to correct value
            push %ebx ; allocate space for function address
@@ -676,30 +658,11 @@ unit cgcpu;
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
 
-        { case 1 or 2 }
-        if (procdef.proccalloption in clearstack_pocalls) then
-          begin
-            if po_virtualmethod in procdef.procoptions then
-              begin
-                { case 2 }
-                getselftoeax(0);
-                loadvmttoeax;
-                op_oneaxmethodaddr(A_CALL);
-              end
-            else
-              begin
-                { case 1 }
-                cg.a_call_name(list,procdef.mangledname,false);
-              end;
-            { restore param1 value self to interface }
-            g_adjust_self_value(list,procdef,-ioffset);
-            list.concat(taicpu.op_none(A_RET,S_L));
-          end
-        else if po_virtualmethod in procdef.procoptions then
+        if po_virtualmethod in procdef.procoptions then
           begin
             if (procdef.proccalloption=pocall_register) then
               begin
-                { case 4 }
+                { case 2 }
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
                 list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
                 getselftoeax(8);
@@ -715,7 +678,7 @@ unit cgcpu;
               end
             else
               begin
-                { case 3 }
+                { case 1 }
                 getselftoeax(0);
                 loadvmttoeax;
                 op_oneaxmethodaddr(A_JMP);

compiler/nadd.pas

@@ -889,7 +889,14 @@ implementation
         { is one a real float, then both need to be floats, this
           need to be done before the constant folding so constant
           operation on a float and int are also handled }
-        resultrealdef:=pbestrealtype^;
+{$ifdef x86}
+        { use extended as default real type only when the x87 fpu is used }
+        if not(current_settings.fputype=fpu_x87) then
+          resultrealdef:=s64floattype
+        else
+{$endif x86}
+          resultrealdef:=pbestrealtype^;
+
         if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
          begin
            { when both floattypes are already equal then use that

packages/fcl-passrc/src/pastree.pp

@@ -67,6 +67,58 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
 
 type
+
+
+  // Visitor pattern.
+  TPassTreeVisitor = class;
+
+  TPasElementBase = class
+    procedure Accept(Visitor: TPassTreeVisitor); virtual; abstract;
+  end;
+
+
+  TPasModule = class;
+
+  TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
+    visPublished, visAutomated,
+    visStrictPrivate, visStrictProtected);
+
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
+
+  TPasMemberVisibilities = set of TPasMemberVisibility;
+  TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
+  TPasMemberHints = set of TPasMemberHint; 
+
+  TPTreeElement = class of TPasElement;
+
+  { TPasElement }
+
+  TPasElement = class(TPasElementBase)
+  private
+    FRefCount: LongWord;
+    FName: string;
+    FParent: TPasElement;
+    FHints : TPasMemberHints;
+  public
+    SourceFilename: string;
+    SourceLinenumber: Integer;
+    Visibility: TPasMemberVisibility;
+  public
+    constructor Create(const AName: string; AParent: TPasElement); virtual;
+    procedure AddRef;
+    procedure Release;
+    function FullName: string;          // Name including parent's names
+    function PathName: string;          // = Module.Name + FullName
+    function GetModule: TPasModule;
+    function ElementTypeName: string; virtual;
+    function GetDeclaration(full : Boolean) : string; virtual;
+    procedure Accept(Visitor: TPassTreeVisitor); override;
+    property RefCount: LongWord read FRefCount;
+    property Name: string read FName write FName;
+    property Parent: TPasElement read FParent;
+    Property Hints : TPasMemberHints Read FHints Write FHints;
+  end;
+
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
      pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
 
@@ -82,15 +134,16 @@ type
   
   { TPasExpr }
 
-  TPasExpr = class
+  TPasExpr = class(TPasElement)
     Kind      : TPasExprKind;
     OpCode    : TexprOpcode;
-    constructor Create(AKind: TPasExprKind; AOpCode: TexprOpcode);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode);
   end;
 
   TUnaryExpr = class(TPasExpr)
     Operand   : TPasExpr;
-    constructor Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
+    constructor Create(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode);
+    function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
   end;
 
@@ -99,26 +152,29 @@ type
   TBinaryExpr = class(TPasExpr)
     left      : TPasExpr;
     right     : TPasExpr;
-    constructor Create(xleft, xright: TPasExpr; AOpCode: TExprOpCode);
-    constructor CreateRange(xleft, xright: TPasExpr);
+    constructor Create(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode);
+    constructor CreateRange(AParent : TPasElement; xleft, xright: TPasExpr);
+    function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
   end;
 
   TPrimitiveExpr = class(TPasExpr)
     Value     : AnsiString;
-    constructor Create(AKind: TPasExprKind; const AValue : Ansistring);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring);
+    function GetDeclaration(full : Boolean) : string; override;
   end;
   
   TBoolConstExpr = class(TPasExpr)
     Value     : Boolean;
-    constructor Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean);
+    function GetDeclaration(full : Boolean) : string; override;
   end;
 
   { TNilExpr }
 
   TNilExpr = class(TPasExpr)
-    Value     : Boolean;
-    constructor Create;
+    constructor Create(AParent : TPasElement);
+    function GetDeclaration(full : Boolean) : string; override;
   end;
 
   { TParamsExpr }
@@ -127,7 +183,8 @@ type
     Value     : TPasExpr;
     Params    : array of TPasExpr;
     {pekArray, pekFuncCall, pekSet}
-    constructor Create(AKind: TPasExprKind);
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind);
+    function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
     procedure AddParam(xp: TPasExpr);
   end;
@@ -141,69 +198,20 @@ type
 
   TRecordValues = class(TPasExpr)
     Fields    : array of TRecordValuesItem;
-    constructor Create;
+    constructor Create(AParent : TPasElement);
     destructor Destroy; override;
-    procedure AddField(const Name: AnsiString; Value: TPasExpr);
+    procedure AddField(const AName: AnsiString; Value: TPasExpr);
+    function GetDeclaration(full : Boolean) : string; override;
   end;
 
   { TArrayValues }
 
   TArrayValues = class(TPasExpr)
     Values    : array of TPasExpr;
-    constructor Create;
+    constructor Create(AParent : TPasElement);
     destructor Destroy; override;
     procedure AddValues(AValue: TPasExpr);
-  end;
-
-
-  // Visitor pattern.
-  TPassTreeVisitor = class;
-
-  TPasElementBase = class
-    procedure Accept(Visitor: TPassTreeVisitor); virtual; abstract;
-  end;
-
-
-  TPasModule = class;
-
-  TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
-    visPublished, visAutomated,
-    visStrictPrivate, visStrictProtected);
-
-  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
-
-  TPasMemberVisibilities = set of TPasMemberVisibility;
-  TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
-  TPasMemberHints = set of TPasMemberHint; 
-
-  TPTreeElement = class of TPasElement;
-
-  { TPasElement }
-
-  TPasElement = class(TPasElementBase)
-  private
-    FRefCount: LongWord;
-    FName: string;
-    FParent: TPasElement;
-    FHints : TPasMemberHints;
-  public
-    SourceFilename: string;
-    SourceLinenumber: Integer;
-    Visibility: TPasMemberVisibility;
-  public
-    constructor Create(const AName: string; AParent: TPasElement); virtual;
-    procedure AddRef;
-    procedure Release;
-    function FullName: string;          // Name including parent's names
-    function PathName: string;          // = Module.Name + FullName
-    function GetModule: TPasModule;
-    function ElementTypeName: string; virtual;
-    function GetDeclaration(full : Boolean) : string; virtual;
-    procedure Accept(Visitor: TPassTreeVisitor); override;
-    property RefCount: LongWord read FRefCount;
-    property Name: string read FName write FName;
-    property Parent: TPasElement read FParent;
-    Property Hints : TPasMemberHints Read FHints Write FHints;
+    function GetDeclaration(full : Boolean) : string; override;
   end;
 
   { TPasDeclarations }
@@ -255,6 +263,7 @@ type
     InitializationSection: TInitializationSection;
     FinalizationSection: TFinalizationSection;
     PackageName: string;
+    Filename   : String;  // the IN filename, only written when not empty.
   end;
 
   { TPasPackage }
@@ -942,7 +951,16 @@ const
 
   ObjKindNames: array[TPasObjKind] of string = (
     'object', 'class', 'interface');
-
+  
+  OpcodeStrings : Array[TExprOpCode] of string = 
+       ('','+','-','*','/','div','mod','**',
+        'shr','shl',
+        'not','and','or','xor',
+        '=','<>',
+        '<','>','<=','>=',
+        'in','is','as','><',
+        '@','^',
+        '.');
 
 implementation
 
@@ -2375,7 +2393,7 @@ end;
 
 { TPasExpr }
 
-constructor TPasExpr.Create(AKind: TPasExprKind; AOpCode: TexprOpcode);
+constructor TPasExpr.Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode);
 begin
   Kind:=AKind;
   OpCode:=AOpCode;
@@ -2383,26 +2401,49 @@ end;
 
 { TPrimitiveExpr }
 
-constructor TPrimitiveExpr.Create(AKind: TPasExprKind; const AValue : Ansistring);
+function TPrimitiveExpr.GetDeclaration(Full : Boolean):AnsiString;
 begin
-  inherited Create(AKind, eopNone);
+  Result:=Value;
+end;
+
+constructor TPrimitiveExpr.Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring);
+begin
+  inherited Create(AParent,AKind, eopNone);
   Value:=AValue;
 end;
 
 { TBoolConstExpr }
 
-constructor TBoolConstExpr.Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+constructor TBoolConstExpr.Create(AParent : TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean);
 begin
-  inherited Create(AKind, eopNone);
+  inherited Create(AParent,AKind, eopNone);
   Value:=ABoolValue;
 end;
 
+Function TBoolConstExpr.GetDeclaration(Full: Boolean):AnsiString;
+
+begin
+  If Value then
+    Result:='True'
+  else
+    Result:='False';  
+end;
+
+
 
 { TUnaryExpr }
 
-constructor TUnaryExpr.Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
+Function TUnaryExpr.GetDeclaration(Full : Boolean):AnsiString;
+
 begin
-  inherited Create(pekUnary, AOpCode);
+  Result:=OpCodeStrings[Opcode];
+  If Assigned(Operand) then
+    Result:=Result+Operand.GetDeclaration(Full);
+end;
+
+constructor TUnaryExpr.Create(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode);
+begin
+  inherited Create(AParent,pekUnary, AOpCode);
   Operand:=AOperand;
 end;
 
@@ -2413,16 +2454,30 @@ end;
 
 { TBinaryExpr }
 
-constructor TBinaryExpr.Create(xleft,xright:TPasExpr; AOpCode:TExprOpCode);
+function TBinaryExpr.GetDeclaration(Full : Boolean):AnsiString;
+
+begin
+  If Kind=pekRange then
+    Result:='..'
+  else
+    Result:=' '+OpcodeStrings[Opcode]+' ';
+  If Assigned(Left) then
+    Result:=Left.GetDeclaration(Full)+Result;
+  If Assigned(Right) then
+    Result:=Result +Right.GetDeclaration(Full);
+end;
+
+
+constructor TBinaryExpr.Create(AParent : TPasElement; xleft,xright:TPasExpr; AOpCode:TExprOpCode);
 begin
-  inherited Create(pekBinary, AOpCode);
+  inherited Create(AParent,pekBinary, AOpCode);
   left:=xleft;
   right:=xright;
 end;
 
-constructor TBinaryExpr.CreateRange(xleft,xright:TPasExpr);
+constructor TBinaryExpr.CreateRange(AParent : TPasElement; xleft,xright:TPasExpr);
 begin
-  inherited Create(pekRange, eopNone);
+  inherited Create(AParent,pekRange, eopNone);
   left:=xleft;
   right:=xright;
 end;
@@ -2436,6 +2491,21 @@ end;
 
 { TParamsExpr }
 
+Function TParamsExpr.GetDeclaration(Full: Boolean) : Ansistring;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Length(Params) do
+    begin
+    If (Result<>'')  then
+      Result:=Result+', ';
+    Result:=Result+Params[I].GetDeclaration(Full);  
+    end;  
+  Result:='('+Result+')';
+end;
+
 procedure TParamsExpr.AddParam(xp:TPasExpr);
 var
   i : Integer;
@@ -2445,9 +2515,9 @@ begin
   Params[i]:=xp;
 end;
 
-constructor TParamsExpr.Create(AKind: TPasExprKind);
+constructor TParamsExpr.Create(AParent : TPasElement; AKind: TPasExprKind);
 begin
-  inherited Create(AKind, eopNone)
+  inherited Create(AParent,AKind, eopNone)
 end;
 
 destructor TParamsExpr.Destroy;
@@ -2460,9 +2530,24 @@ end;
 
 { TRecordValues }
 
-constructor TRecordValues.Create;
+Function TRecordValues.GetDeclaration(Full : Boolean):AnsiString;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Length(Fields) do
+    begin
+    If Result='' then
+      Result:=Result+'; ';
+    Result:=Result+Fields[I].Name+': '+Fields[i].ValueExp.getDeclaration(Full);
+    end;
+  Result:='('+Result+')'  
+end;
+
+constructor TRecordValues.Create(AParent : TPasElement);
 begin
-  inherited Create(pekListOfExp, eopNone);
+  inherited Create(AParent,pekListOfExp, eopNone);
 end;
 
 destructor TRecordValues.Destroy;
@@ -2473,21 +2558,41 @@ begin
   inherited Destroy;
 end;
 
-procedure TRecordValues.AddField(const Name:AnsiString;Value:TPasExpr);
+procedure TRecordValues.AddField(const AName:AnsiString;Value:TPasExpr);
 var
   i : Integer;
 begin
   i:=length(Fields);
   SetLength(Fields, i+1);
-  Fields[i].Name:=Name;
+  Fields[i].Name:=AName;
   Fields[i].ValueExp:=Value;
 end;
 
 { TArrayValues }
 
-constructor TArrayValues.Create;
+Function TNilExpr.GetDeclaration(Full :Boolean):AnsiString;
+begin
+  Result:='Nil';
+end;
+
+Function TArrayValues.GetDeclaration(Full: Boolean):AnsiString;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Length(Values) do
+    begin
+    If Result='' then
+      Result:=Result+', ';
+    Result:=Result+Values[i].getDeclaration(Full);
+    end;
+  Result:='('+Result+')';
+end;
+
+constructor TArrayValues.Create(AParent : TPasElement);
 begin
-  inherited Create(pekListOfExp, eopNone)
+  inherited Create(AParent,pekListOfExp, eopNone)
 end;
 
 destructor TArrayValues.Destroy;
@@ -2509,9 +2614,9 @@ end;
 
 { TNilExpr }
 
-constructor TNilExpr.Create;
+constructor TNilExpr.Create(AParent : TPasElement);
 begin
-  inherited Create(pekNil, eopNone);
+  inherited Create(AParent,pekNil, eopNone);
 end;
 
 end.

packages/fcl-passrc/src/pparser.pp

@@ -99,6 +99,9 @@ type
   TProcType = (ptProcedure, ptFunction, ptOperator, ptConstructor, ptDestructor,
                ptClassProcedure, ptClassFunction);
 
+               
+  TExprKind = (ek_Normal, ek_PropertyIndex);               
+               
   { TPasParser }
 
   TPasParser = class
@@ -125,8 +128,8 @@ type
     Function IsCurTokenHint: Boolean; overload;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
 
-    function ParseParams(paramskind: TPasExprKind): TParamsExpr;
-    function ParseExpIdent: TPasExpr;
+    function ParseParams(AParent : TPasElement;paramskind: TPasExprKind): TParamsExpr;
+    function ParseExpIdent(AParent : TPasElement): TPasExpr;
   public
     Options : set of TPOptions;
     CurModule: TPasModule;
@@ -145,9 +148,9 @@ type
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
     function isEndOfExp: Boolean;
-    function DoParseExpression(InitExpr: TPasExpr=nil): TPasExpr;
-    function DoParseConstValueExpression: TPasExpr;
-    function ParseExpression: String;
+    function DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr=nil): TPasExpr;
+    function DoParseConstValueExpression(AParent : TPasElement): TPasExpr;
+    function ParseExpression(AParent : TPaselement; Kind: TExprKind=ek_Normal): String;
     function ParseCommand: String; // single, not compound command like begin..end
     procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
     function CheckIfOverloaded(AOwner: TPasClassType;
@@ -400,9 +403,9 @@ function TPasParser.ParseType(Parent: TPasElement; Prefix : String): TPasType;
   begin
     Result := TPasRangeType(CreateElement(TPasRangeType, '', Parent));
     try
-      TPasRangeType(Result).RangeStart := ParseExpression;
+      TPasRangeType(Result).RangeStart := ParseExpression(Result);
       ExpectToken(tkDotDot);
-      TPasRangeType(Result).RangeEnd := ParseExpression;
+      TPasRangeType(Result).RangeEnd := ParseExpression(Result);
     except
       Result.Free;
       raise;
@@ -510,7 +513,7 @@ begin
             break
           else if CurToken in [tkEqual,tkAssign] then
             begin
-            EnumValue.AssignedValue:=ParseExpression;
+            EnumValue.AssignedValue:=ParseExpression(Result);
             NextToken;
             if CurToken = tkBraceClose then
               Break
@@ -648,7 +651,9 @@ procedure TPasParser.ParseFileType(Element: TPasFileType);
 begin
   NextToken;
   If CurToken=tkOf then
-    Element.ElType := ParseType(nil);
+    Element.ElType := ParseType(nil)
+  else 
+   ungettoken;
 end;
 
 function TPasParser.isEndOfExp:Boolean;
@@ -661,7 +666,7 @@ begin
   Result:=(CurToken in EndExprToken) or IsCurTokenHint;
 end;
 
-function TPasParser.ParseParams(paramskind: TPasExprKind): TParamsExpr;
+function TPasParser.ParseParams(AParent: TPasElement;paramskind: TPasExprKind): TParamsExpr;
 var
   params  : TParamsExpr;
   p       : TPasExpr;
@@ -676,12 +681,12 @@ begin
     PClose:=tkBraceClose;
   end;
 
-  params:=TParamsExpr.Create(paramskind);
+  params:=TParamsExpr.Create(AParent,paramskind);
   try
     NextToken;
     if not isEndOfExp then begin
       repeat
-        p:=DoParseExpression;
+        p:=DoParseExpression(AParent);
         if not Assigned(p) then Exit; // bad param syntax
         params.AddParam(p);
 
@@ -740,7 +745,7 @@ begin
   end;
 end;
  
-function TPasParser.ParseExpIdent:TPasExpr;
+function TPasParser.ParseExpIdent(AParent : TPasElement):TPasExpr;
 var
   x       : TPasExpr;
   prm     : TParamsExpr;
@@ -750,13 +755,13 @@ var
 begin
   Result:=nil;
   case CurToken of
-    tkString:           x:=TPrimitiveExpr.Create(pekString, CurTokenString);
-    tkChar:             x:=TPrimitiveExpr.Create(pekString, CurTokenText);
-    tkNumber:           x:=TPrimitiveExpr.Create(pekNumber, CurTokenString);
-    tkIdentifier:       x:=TPrimitiveExpr.Create(pekIdent, CurTokenText);
-    tkfalse, tktrue:    x:=TBoolConstExpr.Create(pekBoolConst, CurToken=tktrue);
-    tknil:              x:=TNilExpr.Create;
-    tkSquaredBraceOpen: x:=ParseParams(pekSet);
+    tkString:           x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenString);
+    tkChar:             x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText);
+    tkNumber:           x:=TPrimitiveExpr.Create(AParent,pekNumber, CurTokenString);
+    tkIdentifier:       x:=TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText);
+    tkfalse, tktrue:    x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
+    tknil:              x:=TNilExpr.Create(Aparent);
+    tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
     tkCaret: begin
       // ^A..^_ characters. See #16341
       NextToken;
@@ -764,7 +769,7 @@ begin
         UngetToken;
         ParseExc(SParserExpectedIdentifier);
       end;
-      x:=TPrimitiveExpr.Create(pekString, '^'+CurTokenText);
+      x:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
     end;
   else
     ParseExc(SParserExpectedIdentifier);
@@ -777,19 +782,19 @@ begin
       while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
         case CurToken of
           tkBraceOpen: begin
-            prm:=ParseParams(pekFuncParams);
+            prm:=ParseParams(AParent,pekFuncParams);
             if not Assigned(prm) then Exit;
             prm.Value:=x;
             x:=prm;
           end;
           tkSquaredBraceOpen: begin
-            prm:=ParseParams(pekArrayParams);
+            prm:=ParseParams(AParent,pekArrayParams);
             if not Assigned(prm) then Exit;
             prm.Value:=x;
             x:=prm;
           end;
           tkCaret: begin
-            u:=TUnaryExpr.Create(x, TokenToExprOp(CurToken));
+            u:=TUnaryExpr.Create(AParent,x, TokenToExprOp(CurToken));
             x:=u;
             NextToken;
           end;
@@ -798,7 +803,7 @@ begin
       if CurToken in [tkDot, tkas] then begin
         optk:=CurToken;
         NextToken;
-        b:=TBinaryExpr.Create(x, ParseExpIdent(), TokenToExprOp(optk));
+        b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
         if not Assigned(b.right) then Exit; // error
         x:=b;
       end;
@@ -806,7 +811,7 @@ begin
 
     if CurToken = tkDotDot then begin
       NextToken;
-      b:=TBinaryExpr.CreateRange(x, DoParseExpression);
+      b:=TBinaryExpr.CreateRange(AParent,x, DoParseExpression(AParent));
       if not Assigned(b.right) then Exit; // error
       x:=b;
     end;
@@ -833,7 +838,7 @@ begin
   end;
 end;
 
-function TPasParser.DoParseExpression(InitExpr: TPasExpr): TPasExpr;
+function TPasParser.DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr): TPasExpr;
 var
   expstack  : TList;
   opstack   : TList;
@@ -886,7 +891,7 @@ const
     t:=PopOper;
     xright:=PopExp;
     xleft:=PopExp;
-    expstack.Add(TBinaryExpr.Create(xleft, xright, TokenToExprOp(t)));
+    expstack.Add(TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t)));
   end;
 
 begin
@@ -921,18 +926,18 @@ begin
 
         if CurToken = tkBraceOpen then begin
           NextToken;
-          x:=DoParseExpression();
+          x:=DoParseExpression(AParent);
           if CurToken<>tkBraceClose then Exit;
           NextToken;
         end else begin
-          x:=ParseExpIdent;
+          x:=ParseExpIdent(AParent);
         end;
 
         if not Assigned(x) then Exit;
         expstack.Add(x);
         for i:=1 to pcount do begin
           tempop:=PopOper;
-          expstack.Add( TUnaryExpr.Create( PopExp, TokenToExprOp(tempop) ));
+          expstack.Add( TUnaryExpr.Create(AParent, PopExp, TokenToExprOp(tempop) ));
         end;
 
       end else
@@ -973,10 +978,11 @@ begin
   end;
 end;
 
-function TPasParser.ParseExpression: String;
+function TPasParser.ParseExpression(Aparent : TPaselement;Kind: TExprKind): String;
 var
   BracketLevel: Integer;
   LastTokenWasWord: Boolean;
+  ls: String;
 begin
   SetLength(Result, 0);
   BracketLevel := 0;
@@ -993,11 +999,21 @@ begin
       if BracketLevel = 0 then
         break;
       Dec(BracketLevel);
-    end else if (BracketLevel = 0) and (CurToken in [tkComma, tkSemicolon,
-      tkColon, tkDotDot, tkthen, tkend, tkelse, tkuntil, tkfinally, tkexcept,
-      tkof, tkbegin, tkdo, tkto, tkdownto, tkinitialization, tkfinalization])
-    then
-      break;
+    end else if (BracketLevel = 0) then 
+    begin
+      if (CurToken in [tkComma, tkSemicolon,
+        tkColon, tkDotDot, tkthen, tkend, tkelse, tkuntil, tkfinally, tkexcept,
+        tkof, tkbegin, tkdo, tkto, tkdownto, tkinitialization, tkfinalization])
+      then
+        break;
+        
+      if (Kind=ek_PropertyIndex) and (CurToken=tkIdentifier) then begin
+        ls:=LowerCase(CurTokenText);
+        if (ls='read') or (ls ='write') or (ls='default') or (ls='nodefault') or (ls='implements') then
+          Break;
+      end;
+        
+    end;
 
     if (CurTokenString<>'') and IsIdentStart[CurTokenString[1]] then
       begin
@@ -1029,7 +1045,7 @@ begin
     Result:='';
 end;
 
-function TPasParser.DoParseConstValueExpression: TPasExpr;
+function TPasParser.DoParseConstValueExpression(Aparent : TPaselement): TPasExpr;
 var
   x : TPasExpr;
   n : AnsiString;
@@ -1052,18 +1068,18 @@ end;
 
 begin
   if CurToken <> tkBraceOpen then
-    Result:=DoParseExpression
+    Result:=DoParseExpression(AParent)
   else begin
     NextToken;
-    x:=DoParseConstValueExpression();
+    x:=DoParseConstValueExpression(Aparent);
     case CurToken of
       tkComma: // array of values (a,b,c);
         begin
-          a:=TArrayValues.Create;
+          a:=TArrayValues.Create(AParent);
           a.AddValues(x);
           repeat
             NextToken;
-            x:=DoParseConstValueExpression();
+            x:=DoParseConstValueExpression(AParent);
             a.AddValues(x);
           until CurToken<>tkComma;
           Result:=a;
@@ -1073,23 +1089,23 @@ begin
         begin
           n:=GetExprIdent(x);
           x.Free;
-          r:=TRecordValues.Create;
+          r:=TRecordValues.Create(AParent);
           NextToken;
-          x:=DoParseConstValueExpression();
+          x:=DoParseConstValueExpression(AParent);
           r.AddField(n, x);
           if not lastfield then
             repeat
               n:=ExpectIdentifier;
               ExpectToken(tkColon);
               NextToken;
-              x:=DoParseConstValueExpression();
+              x:=DoParseConstValueExpression(AParent);
               r.AddField(n, x)
             until lastfield; // CurToken<>tkSemicolon;
           Result:=r;
         end;
     else
       // Binary expression!  ((128 div sizeof(longint)) - 3);       ;
-      Result:=DoParseExpression(x);
+      Result:=DoParseExpression(AParent,x);
     end;
     if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
     NextToken;
@@ -1536,7 +1552,7 @@ begin
   begin
     AUnitName := ExpectIdentifier;
 
-    Element := Engine.FindModule(AUnitName);
+    Element := Engine.FindModule(AUnitName); // should we resolve module here when "IN" filename is not known yet?
     if Assigned(Element) then
       Element.AddRef
     else
@@ -1550,6 +1566,8 @@ begin
       // todo: store unit's file name somewhere
       NextToken; // skip in
       ExpectToken(tkString); // skip unit's real file name
+      if (Element is TPasModule) and (TPasmodule(Element).filename<>'')  then
+        TPasModule(Element).FileName:=curtokenstring;
     end;
 
     if CurToken = tkSemicolon then
@@ -1577,7 +1595,7 @@ begin
 
     // using new expression parser!
     NextToken; // skip tkEqual
-    Result.Expr:=DoParseConstValueExpression;
+    Result.Expr:=DoParseConstValueExpression(Result);
 
     // must unget for the check to be peformed fine!
     UngetToken;
@@ -1595,7 +1613,7 @@ begin
   Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent));
   try
     ExpectToken(tkEqual);
-    Result.Value := ParseExpression;
+    Result.Value := ParseExpression(Result);
     CheckHint(Result,True);
   except
     Result.Free;
@@ -1612,9 +1630,9 @@ var
   begin
     Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, Parent));
     try
-      TPasRangeType(Result).RangeStart := ParseExpression;
+      TPasRangeType(Result).RangeStart := ParseExpression(Result);
       ExpectToken(tkDotDot);
-      TPasRangeType(Result).RangeEnd := ParseExpression;
+      TPasRangeType(Result).RangeEnd := ParseExpression(Result);
       CheckHint(Result,True);
     except
       Result.Free;
@@ -1716,7 +1734,7 @@ begin
           try
             TPasAliasType(Result).DestType :=
               TPasUnresolvedTypeRef.Create(CurTokenString, Parent);
-            ParseExpression;
+            ParseExpression(Parent);
             ExpectToken(tkSquaredBraceClose);
             CheckHint(Result,True);
           except
@@ -1781,7 +1799,7 @@ begin
               break
             else if CurToken in [tkEqual,tkAssign] then
               begin
-              EnumValue.AssignedValue:=ParseExpression;
+              EnumValue.AssignedValue:=ParseExpression(result);
               NextToken;
               if CurToken = tkBraceClose then
                 Break
@@ -1929,7 +1947,7 @@ begin
   // Writeln(LastVar,': Parsed complex type, next: ',CurtokenText);
   If CurToken=tkEqual then
     begin
-    Value := ParseExpression;
+    Value := ParseExpression(Parent);
     for i := 0 to List.Count - 1 do
       TPasVariable(List[i]).Value := Value;
     NextToken;
@@ -2076,7 +2094,7 @@ begin
       NextToken;
       if CurToken = tkEqual then
       begin
-        Value := ParseExpression;
+        Value := ParseExpression(Parent);
       end else
         UngetToken;
     end;
@@ -2378,6 +2396,9 @@ end;
 
 procedure TPasParser.ParseProperty(Element:TPasElement);
 
+var
+  isArray : Boolean;
+
   procedure MaybeReadFullyQualifiedIdentifier(Var r : String);
 
   begin
@@ -2413,11 +2434,16 @@ procedure TPasParser.ParseProperty(Element:TPasElement);
     //writeln(Result);
   end;
 
+var
+  us  : String; 
+  h   : TPasMemberHint;
 begin
-
+  isArray:=False;
   NextToken;
 // if array prop then parse [ arg1:type1;... ]
+
   if CurToken = tkSquaredBraceOpen then begin
+    isArray:=True;
   // !!!: Parse array properties correctly
     ParseArgList(Element, TPasProperty(Element).Args, tkSquaredBraceClose);
     NextToken;
@@ -2432,10 +2458,10 @@ begin
 
   if CurToken <> tkSemicolon then begin
 //  if indexed prop then read the index value
-    if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'INDEX') then
+    if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'INDEX') then begin
 //    read 'index' access modifier
-      TPasProperty(Element).IndexValue := ParseExpression
-    else
+      TPasProperty(Element).IndexValue := ParseExpression(Element,ek_PropertyIndex);
+    end else
 //    not indexed prop will be recheck for another token
       UngetToken;
 
@@ -2490,24 +2516,19 @@ begin
   end;
 
 // if the specifiers list is not finished
-  if CurToken <> tkSemicolon then begin
-    if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then
+  if (CurToken <> tkSemicolon) and (CurToken = tkIdentifier) then begin
+    us:=UpperCase(CurTokenText);
+    if (us = 'DEFAULT') then begin
+      if isArray then ParseExc('Array properties cannot have default value');
 //    read 'default' value modifier -> ParseExpression(DEFAULT <value>)
-      TPasProperty(Element).DefaultValue := ParseExpression
-    else
-//    not "default <value>" prop will be recheck for another token
-      UngetToken;
-
-    NextToken;
-  end;
-
-// if the specifiers list is not finished
-  if CurToken <> tkSemicolon then begin
-    if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'NODEFAULT') then begin
+      TPasProperty(Element).DefaultValue := ParseExpression(Element);
+      NextToken;
+    end else if (us = 'NODEFAULT') then begin
 //    read 'nodefault' modifier
       TPasProperty(Element).IsNodefault:=true;
-    end;
-//  stop recheck for specifiers - start from next token
+    end else
+//    not "default <value>" prop will be recheck for another token
+      UngetToken;
     NextToken;
   end;
 
@@ -2518,55 +2539,28 @@ begin
   end;
 
   if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEFAULT') then begin
+    if not isArray then ParseExc('The default property must be an array property');
 //  what is after DEFAULT token at the end
     NextToken;
     if CurToken = tkSemicolon then begin
 //    ";" then DEFAULT=prop
       TPasProperty(Element).IsDefault := True;
-      UngetToken;
-    end else begin
-//    "!;" then a step back to get phrase "DEFAULT <value>"
-      UngetToken;
-//    DefaultValue  -> ParseExpression(DEFAULT <value>)  and stay on the <value>
-      TPasProperty(Element).DefaultValue := ParseExpression;
-    end;
-
-//!!  there may be DEPRECATED token
-    CheckHint(Element,False);
-    NextToken;
-
+      NextToken;
+    end
   end;
-
-// after DEFAULT may be a ";"
-  if CurToken = tkSemicolon then begin
-    // read semicolon
+  
+  while IsCurTokenHint(h) do begin
+    Element.Hints:=Element.Hints+[h];
     NextToken;
-  end;
-
-  if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEPRECATED') then begin
-//  nothing to do on DEPRECATED - just to accept
-//    NextToken;
-  end else
-    UngetToken;;
-
-//!!   else
-//  not DEFAULT prop accessor will be recheck for another token
-//!!    UngetToken;
+    // there can be multiple hints, separated by the, i.e.:
+    // property Prop: integer read FMyProp write FMyProp; platform; library deprecated;
+    if CurToken=tkSemicolon then 
+      NextToken;
+  end;    
 
-{
-  if CurToken = tkSemicolon then begin
-    // read semicolon
-    NextToken;
-  end;
-  if (CurToken = tkIdentifier) and (UpperCase(CurTokenText) = 'DEPRECATED') then begin
-//  nothing to do - just to process
-    NextToken;
-  end;
-  if CurToken = tkSemicolon then begin
-    // read semicolon
-    NextToken;
-  end;
-}
+  // property parsing must finish at the LAST Semicolon of the property
+  // since we're parsing "one-step" ahead of the semicolon. we must return one-step
+  UngetToken; 
 end;
 
 // Starts after the "begin" token
@@ -2661,7 +2655,7 @@ begin
       CreateBlock(CurBlock.AddRepeatUntil);
     tkIf:
       begin
-        Condition:=ParseExpression;
+        Condition:=ParseExpression(Parent);
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
         CreateBlock(CurBlock.AddIfElse(Condition));
         ExpectToken(tkthen);
@@ -2683,7 +2677,7 @@ begin
     tkwhile:
       begin
         // while Condition do
-        Condition:=ParseExpression;
+        Condition:=ParseExpression(Parent);
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
         CreateBlock(CurBlock.AddWhileDo(Condition));
         ExpectToken(tkdo);
@@ -2694,7 +2688,7 @@ begin
         ExpectIdentifier;
         VarName:=CurTokenString;
         ExpectToken(tkAssign);
-        StartValue:=ParseExpression;
+        StartValue:=ParseExpression(Parent);
         //writeln(i,'FOR Start=',StartValue);
         NextToken;
         if CurToken=tkTo then
@@ -2703,7 +2697,7 @@ begin
           ForDownTo:=true
         else
           ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
-        EndValue:=ParseExpression;
+        EndValue:=ParseExpression(Parent);
         CreateBlock(CurBlock.AddForLoop(VarName,StartValue,EndValue,ForDownTo));
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
         ExpectToken(tkdo);
@@ -2712,7 +2706,7 @@ begin
       begin
         // with Expr do
         // with Expr, Expr do
-        Expr:=ParseExpression;
+        Expr:=ParseExpression(Parent);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
         CreateBlock(CurBlock.AddWithDo(Expr));
         repeat
@@ -2720,14 +2714,14 @@ begin
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
             ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkdo]]));
-          Expr:=ParseExpression;
+          Expr:=ParseExpression(Parent);
           //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
           TPasImplWithDo(CurBlock).AddExpression(Expr);
         until false;
       end;
     tkcase:
       begin
-        Expr:=ParseExpression;
+        Expr:=ParseExpression(Parent);
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
         CreateBlock(CurBlock.AddCaseOf(Expr));
@@ -2747,7 +2741,7 @@ begin
             UngetToken;
             // read case values
             repeat
-              Expr:=ParseExpression;
+              Expr:=ParseExpression(Parent);
               //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
               if CurBlock is TPasImplCaseStatement then
                 TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
@@ -2756,7 +2750,7 @@ begin
               NextToken;
               if CurToken=tkDotDot then
               begin
-                Expr:=Expr+'..'+ParseExpression;
+                Expr:=Expr+'..'+ParseExpression(Parent);
                 NextToken;
               end;
               //writeln(i,'CASE after value Token=',CurTokenText);
@@ -2820,13 +2814,13 @@ begin
         if CurBlock is TPasImplTryExcept then
         begin
           VarName:='';
-          TypeName:=ParseExpression;
+          TypeName:=ParseExpression(Parent);
           //writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
           NextToken;
           if CurToken=tkColon then
           begin
             VarName:=TypeName;
-            TypeName:=ParseExpression;
+            TypeName:=ParseExpression(Parent);
             //writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
           end else
             UngetToken;
@@ -2872,7 +2866,7 @@ begin
         end;
         if CurBlock is TPasImplRepeatUntil then
         begin
-          Condition:=ParseExpression;
+          Condition:=ParseExpression(Parent);
           TPasImplRepeatUntil(CurBlock).Condition:=Condition;
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
           if CloseBlock then break;
@@ -3020,7 +3014,7 @@ begin
         Variant.Values := TStringList.Create;
         while True do
         begin
-      Variant.Values.Add(ParseExpression);
+      Variant.Values.Add(ParseExpression(Parent));
       NextToken;
       if CurToken = tkColon then
         break

packages/fcl-xml/src/sax_xml.pp

@@ -40,6 +40,7 @@ type
     FEndOfStream: Boolean;
     FScannerContext: TXMLScannerContext;
     FTokenText: SAXString;
+    FRawTokenText: string;
     FCurStringValueDelimiter: Char;
     FAttrNameRead: Boolean;
   protected
@@ -103,7 +104,9 @@ procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
 
 implementation
 
-uses htmldefs; // for entities...
+uses
+  xmlutils,
+  htmldefs; // for entities...
 
 const
   WhitespaceChars = [#9, #10, #13, ' '];
@@ -154,6 +157,7 @@ begin
 
     BufferPos := 0;
     while (BufferPos < BufferSize) and not FStopFlag do
+    begin
       case ScannerContext of
         scUnknown:
           case Buffer[BufferPos] of
@@ -176,7 +180,7 @@ begin
           case Buffer[BufferPos] of
             #9, #10, #13, ' ':
               begin
-                FTokenText := FTokenText + Buffer[BufferPos];
+                FRawTokenText := FRawTokenText + Buffer[BufferPos];
                 Inc(BufferPos);
               end;
             '&':
@@ -190,7 +194,7 @@ begin
                 EnterNewScannerContext(scTag);
               end;
             else
-              FScannerContext := scText
+              FScannerContext := scText;
           end;
         scText:
           case Buffer[BufferPos] of
@@ -206,7 +210,7 @@ begin
               end;
             else
             begin
-              FTokenText := FTokenText + Buffer[BufferPos];
+              FRawTokenText := FRawTokenText + Buffer[BufferPos];
               Inc(BufferPos);
             end;
           end;
@@ -220,7 +224,7 @@ begin
             EnterNewScannerContext(scUnknown)
           else
           begin
-            FTokenText := FTokenText + Buffer[BufferPos];
+            FRawTokenText := FRawTokenText + Buffer[BufferPos];
             Inc(BufferPos);
           end;
         scTag:
@@ -237,13 +241,13 @@ begin
                     FAttrNameRead := False;
                   end;
                 end;
-                FTokenText := FTokenText + Buffer[BufferPos];
+                FRawTokenText := FRawTokenText + Buffer[BufferPos];
                 Inc(BufferPos);
               end;
             '=':
               begin
                 FAttrNameRead := True;
-                FTokenText := FTokenText + Buffer[BufferPos];
+                FRawTokenText := FRawTokenText + Buffer[BufferPos];
                 Inc(BufferPos);
               end;
             '>':
@@ -254,99 +258,101 @@ begin
               end;
             else
             begin
-              FTokenText := FTokenText + Buffer[BufferPos];
+              FRawTokenText := FRawTokenText + Buffer[BufferPos];
               Inc(BufferPos);
             end;
           end;
-      end;
+        end;    // case ScannerContext of
+    end;        // while not endOfBuffer
   end;
 end;
 
-procedure TSAXXMLReader.EnterNewScannerContext(NewContext: TXMLScannerContext);
-
-  function SplitTagString(const s: String; var Attr: TSAXAttributes): String;
-  var
-    i, j: Integer;
-    AttrName: String;
-    ValueDelimiter: Char;
-    DoIncJ: Boolean;
+function SplitTagString(const s: SAXString; var Attr: TSAXAttributes): SAXString;
+var
+  i, j: Integer;
+  AttrName: SAXString;
+  ValueDelimiter: WideChar;
+  DoIncJ: Boolean;
+begin
+  Attr := nil;
+  i := 0;
+  repeat
+    Inc(i)
+  until (i > Length(s)) or IsXMLWhitespace(s[i]);
+
+  if i > Length(s) then
+    Result := s
+  else
   begin
-    Attr := nil;
-    i := 0;
-    repeat
-      Inc(i)
-    until (i > Length(s)) or (s[i] in WhitespaceChars);
-
-    if i > Length(s) then
-      Result := LowerCase(s)
-    else
-    begin
-      Result := LowerCase(Copy(s, 1, i - 1));
-      Attr := TSAXAttributes.Create;
+    Result := Copy(s, 1, i - 1);
+    Attr := TSAXAttributes.Create;
+    Inc(i);
 
+    while (i <= Length(s)) and IsXMLWhitespace(s[i]) do
       Inc(i);
 
-      while (i <= Length(s)) and (s[i] in WhitespaceChars) do
-        Inc(i);
-
-      SetLength(AttrName, 0);
-      j := i;
+    SetLength(AttrName, 0);
+    j := i;
 
-      while j <= Length(s) do
-        if s[j] = '=' then
+    while j <= Length(s) do
+      if s[j] = '=' then
+      begin
+        AttrName := Copy(s, i, j - i);
+        Inc(j);
+        if (j < Length(s)) and ((s[j] = '''') or (s[j] = '"')) then
         begin
-          AttrName := LowerCase(Copy(s, i, j - i));
+          ValueDelimiter := s[j];
           Inc(j);
-          if (j < Length(s)) and ((s[j] = '''') or (s[j] = '"')) then
+        end else
+          ValueDelimiter := #0;
+        i := j;
+        DoIncJ := False;
+        while j <= Length(s) do
+          if ValueDelimiter = #0 then
+            if IsXMLWhitespace(s[j]) then
+              break
+            else
+              Inc(j)
+          else if s[j] = ValueDelimiter then
           begin
-            ValueDelimiter := s[j];
-            Inc(j);
+            DoIncJ := True;
+            break
           end else
-            ValueDelimiter := #0;
-          i := j;
-          DoIncJ := False;
-          while j <= Length(s) do
-            if ValueDelimiter = #0 then
-              if s[j] in WhitespaceChars then
-                break
-              else
-                Inc(j)
-            else if s[j] = ValueDelimiter then
-            begin
-              DoIncJ := True;
-              break
-            end else
-              Inc(j);
+            Inc(j);
 
+        if IsXMLName(AttrName) then
           Attr.AddAttribute('', AttrName, '', '', Copy(s, i, j - i));
 
-          if DoIncJ then
-            Inc(j);
+        if DoIncJ then
+          Inc(j);
 
-          while (j <= Length(s)) and (s[j] in WhitespaceChars) do
-            Inc(j);
-          i := j;
-        end
-        else if s[j] in WhitespaceChars then
-        begin
-          Attr.AddAttribute('', Copy(s, i, j - i), '', '', '');
+        while (j <= Length(s)) and IsXMLWhitespace(s[j]) do
           Inc(j);
-          while (j <= Length(s)) and (s[j] in WhitespaceChars) do
-            Inc(j);
-          i := j;
-        end else
+        i := j;
+      end
+      else if IsXMLWhitespace(s[j]) then
+      begin
+        if IsXMLName(@s[i], j-i) then
+          Attr.AddAttribute('', Copy(s, i, j - i), '', '', '');
+        Inc(j);
+        while (j <= Length(s)) and IsXMLWhitespace(s[j]) do
           Inc(j);
-    end;
+        i := j;
+      end else
+        Inc(j);
   end;
+end;
 
+procedure TSAXXMLReader.EnterNewScannerContext(NewContext: TXMLScannerContext);
 var
   Attr: TSAXAttributes;
-  TagName: String;
+  TagName: SAXString;
   Ent: SAXChar;
 begin
+  FTokenText := FRawTokenText;  // this is where conversion takes place
   case ScannerContext of
     scWhitespace:
-      DoIgnorableWhitespace(PSAXChar(TokenText), 1, Length(TokenText));
+      DoIgnorableWhitespace(PSAXChar(TokenText), 0, Length(TokenText));
     scText:
       DoCharacters(PSAXChar(TokenText), 0, Length(TokenText));
     scEntityReference:
@@ -397,7 +403,8 @@ begin
       end;
   end;
   FScannerContext := NewContext;
-  SetLength(FTokenText, 0);
+  FTokenText := '';
+  FRawTokenText := '';
   FCurStringValueDelimiter := #0;
   FAttrNameRead := False;
 end;

packages/fcl-xml/src/xmlread.pp

@@ -321,7 +321,6 @@ type
     FRecognizePE: Boolean;
     FHavePERefs: Boolean;
     FInsideDecl: Boolean;
-    FDocNotValid: Boolean;
     FValue: TWideCharBuf;
     FEntityValue: TWideCharBuf;
     FName: TWideCharBuf;
@@ -497,137 +496,6 @@ begin
     end;
 end;
 
-function Decode_UCS2(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
-var
-  cnt: Cardinal;
-begin
-  cnt := OutCnt;         // num of widechars
-  if cnt > InCnt div sizeof(WideChar) then
-    cnt := InCnt div sizeof(WideChar);
-  Move(InBuf^, OutBuf^, cnt * sizeof(WideChar));
-  Dec(InCnt, cnt*sizeof(WideChar));
-  Dec(OutCnt, cnt);
-  Result := cnt;
-end;
-
-function Decode_UCS2_Swapped(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
-var
-  I: Integer;
-  cnt: Cardinal;
-  InPtr: PChar;
-begin
-  cnt := OutCnt;         // num of widechars
-  if cnt > InCnt div sizeof(WideChar) then
-    cnt := InCnt div sizeof(WideChar);
-  InPtr := InBuf;
-  for I := 0 to cnt-1 do
-  begin
-    OutBuf[I] := WideChar((ord(InPtr^) shl 8) or ord(InPtr[1]));
-    Inc(InPtr, 2);
-  end;
-  Dec(InCnt, cnt*sizeof(WideChar));
-  Dec(OutCnt, cnt);
-  Result := cnt;
-end;
-
-function Decode_88591(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
-var
-  I: Integer;
-  cnt: Cardinal;
-begin
-  cnt := OutCnt;         // num of widechars
-  if cnt > InCnt then
-    cnt := InCnt;
-  for I := 0 to cnt-1 do
-    OutBuf[I] := WideChar(ord(InBuf[I]));
-  Dec(InCnt, cnt);
-  Dec(OutCnt, cnt);
-  Result := cnt;
-end;
-
-function Decode_UTF8(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
-const
-  MaxCode: array[1..4] of Cardinal = ($7F, $7FF, $FFFF, $1FFFFF);
-var
-  i, j, bc: Cardinal;
-  Value: Cardinal;
-begin
-  result := 0;
-  i := OutCnt;
-  while (i > 0) and (InCnt > 0) do
-  begin
-    bc := 1;
-    Value := ord(InBuf^);
-    if Value < $80 then
-      OutBuf^ := WideChar(Value)
-    else
-    begin
-      if Value < $C2 then
-      begin
-        Result := -1;
-        Break;
-      end;
-      Inc(bc);
-      if Value > $DF then
-      begin
-        Inc(bc);
-        if Value > $EF then
-        begin
-          Inc(bc);
-          if Value > $F7 then  // never encountered in the tests.
-          begin
-            Result := -1;
-            Break;
-          end;
-        end;
-      end;
-      if InCnt < bc then
-        Break;
-      j := 1;
-      while j < bc do
-      begin
-        if InBuf[j] in [#$80..#$BF] then
-          Value := (Value shl 6) or (Cardinal(InBuf[j]) and $3F)
-        else
-        begin
-          Result := -1;
-          Break;
-        end;
-        Inc(j);
-      end;
-      Value := Value and MaxCode[bc];
-      // RFC2279 check
-      if Value <= MaxCode[bc-1] then
-      begin
-        Result := -1;
-        Break;
-      end;
-      case Value of
-        0..$D7FF, $E000..$FFFF: OutBuf^ := WideChar(Value);
-        $10000..$10FFFF:
-        begin
-          if i < 2 then Break;
-          OutBuf^ := WideChar($D7C0 + (Value shr 10));
-          OutBuf[1] := WideChar($DC00 xor (Value and $3FF));
-          Inc(OutBuf); // once here
-          Dec(i);
-        end
-        else
-        begin
-          Result := -1;
-          Break;
-        end;
-      end;
-    end;
-    Inc(OutBuf);
-    Inc(InBuf, bc);
-    Dec(InCnt, bc);
-    Dec(i);
-  end;
-  if Result >= 0 then
-    Result := OutCnt-i;
-  OutCnt := i;
-end;
 
 function Is_8859_1(const AEncoding: string): Boolean;
 begin
@@ -1003,7 +871,7 @@ begin
 // see rmt-e2e-61, it now fails but for a completely different reason.
   FillChar(NewDecoder, sizeof(TDecoder), 0);
   if Is_8859_1(AEncoding) then
-    FDecoder.Decode := @Decode_88591
+    FDecoder.Decode := @Decode_8859_1
   else if FindDecoder(AEncoding, NewDecoder) then
     FDecoder := NewDecoder
   else
@@ -1212,7 +1080,6 @@ end;
 
 procedure TXMLReader.ValidationError(const Msg: string; const Args: array of const; LineOffs: Integer);
 begin
-  FDocNotValid := True;
   if FValidate then
     DoError(esError, Format(Msg, Args), LineOffs);
 end;
@@ -3099,7 +2966,6 @@ end;
 
 procedure TXMLReader.ParseEndTag;     // [42]
 var
-  ErrOffset: Integer;
   ElName: PHashItem;
 begin
   ElName := FValidator[FNesting].FElement.NSI.QName;
@@ -3109,18 +2975,17 @@ begin
     FatalError('Unmatching element end tag (expected "</%s>")', [ElName^.Key], FName.Length);
   if FSource.FBuf^ = '>' then    // this handles majority of cases
   begin
-    ErrOffset := FName.Length+1;
     FSource.NextChar;
+    DoEndElement(FName.Length+1);
   end
   else    // but if closing '>' is preceded by whitespace,
   begin   // skipping it is likely to lose position info.
     StoreLocation(FTokenStart);
     Dec(FTokenStart.LinePos, FName.Length);
-    ErrOffset := -1;
     SkipS;
     ExpectChar('>');
+    DoEndElement(-1);
   end;
-  DoEndElement(ErrOffset);
 end;
 
 procedure TXMLReader.ParseAttribute(Elem: TDOMElement; ElDef: TDOMElementDef);

packages/fcl-xml/src/xmlutils.pp

@@ -160,6 +160,13 @@ procedure BufAppend(var ABuffer: TWideCharBuf; wc: WideChar);
 procedure BufAppendChunk(var ABuf: TWideCharBuf; pstart, pend: PWideChar);
 function BufEquals(const ABuf: TWideCharBuf; const Arg: WideString): Boolean;
 
+{ Built-in decoder functions for UTF-8, UTF-16 and ISO-8859-1 }
+
+function Decode_UCS2(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+function Decode_UCS2_Swapped(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+function Decode_UTF8(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+function Decode_8859_1(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+
 {$i names.inc}
 
 implementation
@@ -905,6 +912,140 @@ begin
     CompareMem(ABuf.Buffer, Pointer(Arg), ABuf.Length*sizeof(WideChar));
 end;
 
+{ standard decoders }
+
+function Decode_UCS2(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+var
+  cnt: Cardinal;
+begin
+  cnt := OutCnt;         // num of widechars
+  if cnt > InCnt div sizeof(WideChar) then
+    cnt := InCnt div sizeof(WideChar);
+  Move(InBuf^, OutBuf^, cnt * sizeof(WideChar));
+  Dec(InCnt, cnt*sizeof(WideChar));
+  Dec(OutCnt, cnt);
+  Result := cnt;
+end;
+
+function Decode_UCS2_Swapped(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+var
+  I: Integer;
+  cnt: Cardinal;
+  InPtr: PChar;
+begin
+  cnt := OutCnt;         // num of widechars
+  if cnt > InCnt div sizeof(WideChar) then
+    cnt := InCnt div sizeof(WideChar);
+  InPtr := InBuf;
+  for I := 0 to cnt-1 do
+  begin
+    OutBuf[I] := WideChar((ord(InPtr^) shl 8) or ord(InPtr[1]));
+    Inc(InPtr, 2);
+  end;
+  Dec(InCnt, cnt*sizeof(WideChar));
+  Dec(OutCnt, cnt);
+  Result := cnt;
+end;
+
+function Decode_8859_1(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+var
+  I: Integer;
+  cnt: Cardinal;
+begin
+  cnt := OutCnt;         // num of widechars
+  if cnt > InCnt then
+    cnt := InCnt;
+  for I := 0 to cnt-1 do
+    OutBuf[I] := WideChar(ord(InBuf[I]));
+  Dec(InCnt, cnt);
+  Dec(OutCnt, cnt);
+  Result := cnt;
+end;
+
+function Decode_UTF8(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutBuf: PWideChar; var OutCnt: Cardinal): Integer; stdcall;
+const
+  MaxCode: array[1..4] of Cardinal = ($7F, $7FF, $FFFF, $1FFFFF);
+var
+  i, j, bc: Cardinal;
+  Value: Cardinal;
+begin
+  result := 0;
+  i := OutCnt;
+  while (i > 0) and (InCnt > 0) do
+  begin
+    bc := 1;
+    Value := ord(InBuf^);
+    if Value < $80 then
+      OutBuf^ := WideChar(Value)
+    else
+    begin
+      if Value < $C2 then
+      begin
+        Result := -1;
+        Break;
+      end;
+      Inc(bc);
+      if Value > $DF then
+      begin
+        Inc(bc);
+        if Value > $EF then
+        begin
+          Inc(bc);
+          if Value > $F7 then  // never encountered in the tests.
+          begin
+            Result := -1;
+            Break;
+          end;
+        end;
+      end;
+      if InCnt < bc then
+        Break;
+      j := 1;
+      while j < bc do
+      begin
+        if InBuf[j] in [#$80..#$BF] then
+          Value := (Value shl 6) or (Cardinal(InBuf[j]) and $3F)
+        else
+        begin
+          Result := -1;
+          Break;
+        end;
+        Inc(j);
+      end;
+      Value := Value and MaxCode[bc];
+      // RFC2279 check
+      if Value <= MaxCode[bc-1] then
+      begin
+        Result := -1;
+        Break;
+      end;
+      case Value of
+        0..$D7FF, $E000..$FFFF: OutBuf^ := WideChar(Value);
+        $10000..$10FFFF:
+        begin
+          if i < 2 then Break;
+          OutBuf^ := WideChar($D7C0 + (Value shr 10));
+          OutBuf[1] := WideChar($DC00 xor (Value and $3FF));
+          Inc(OutBuf); // once here
+          Dec(i);
+        end
+        else
+        begin
+          Result := -1;
+          Break;
+        end;
+      end;
+    end;
+    Inc(OutBuf);
+    Inc(InBuf, bc);
+    Dec(InCnt, bc);
+    Dec(i);
+  end;
+  if Result >= 0 then
+    Result := OutCnt-i;
+  OutCnt := i;
+end;
+
 
 initialization
 

packages/graph/src/go32v2/vesa.inc

@@ -515,7 +515,7 @@ end;
           {$endif logging}
           For l := 0 to (Bankrest div 4)-1 Do
             begin
-              pixels := MemL[WinWriteSeg:word(offs)+l*4];
+              pixels := MemL[WinReadSeg:word(offs)+l*4];
               WordArray(Data)[index+l*4] := pixels and $ff;
               pixels := pixels shr 8;
               WordArray(Data)[index+l*4+1] := pixels and $ff;
@@ -798,7 +798,7 @@ end;
                          setreadbank(offs shr 16);
                          setwritebank(offs shr 16);
                          Mem[WinWriteSeg:word(offs)] :=
-                           Mem[WinReadSeg:word(offs)] And byte(currentColor);
+                           Mem[WinReadSeg:word(offs)] Or byte(currentColor);
                          inc(offs);
                        end;
                      HLength := 0
@@ -925,10 +925,10 @@ end;
                  {$ifdef logging2}
                  LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
                  {$endif logging}
-                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
                    bankrest := VLength
                  else {the rest won't fit anymore in the current window }
-                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
                  {$ifdef logging2}
                  LogLn('Rest to be drawn in this window: '+strf(bankrest));
                  {$endif logging}
@@ -953,10 +953,10 @@ end;
                  {$ifdef logging2}
                  LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
                  {$endif logging}
-                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
                    bankrest := VLength
                  else {the rest won't fit anymore in the current window }
-                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
                  {$ifdef logging2}
                  LogLn('Rest to be drawn in this window: '+strf(bankrest));
                  {$endif logging}
@@ -981,10 +981,10 @@ end;
                  {$ifdef logging2}
                  LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
                  {$endif logging}
-                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
                    bankrest := VLength
                  else {the rest won't fit anymore in the current window }
-                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
                  {$ifdef logging2}
                  LogLn('Rest to be drawn in this window: '+strf(bankrest));
                  {$endif logging}
@@ -1010,10 +1010,10 @@ end;
                  {$ifdef logging2}
                  LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
                  {$endif logging}
-                 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+                 If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
                    bankrest := VLength
                  else {the rest won't fit anymore in the current window }
-                   bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+                   bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
                  {$ifdef logging2}
                  LogLn('Rest to be drawn in this window: '+strf(bankrest));
                  {$endif logging}

rtl/darwin/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/08/06]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/08/03]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -2505,6 +2505,7 @@ $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp $(SYSDEPS)
 clocale$(PPUEXT): initc$(PPUEXT) sysutils$(PPUEXT) unixtype$(PPUEXT)
 fpintres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
 fpextres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT)
+iso7185$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
 objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 dateutils$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) sysutils$(PPUEXT) math$(PPUEXT) types$(PPUEXT) sysconst$(PPUEXT) $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/darwin/Makefile.fpc

@@ -125,6 +125,8 @@ fpintres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
 
 fpextres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT)
 
+iso7185$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
+
 objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 

rtl/linux/linux.pp

@@ -101,6 +101,13 @@ const
    if (oldval CMP CMPARG)
      wake UADDR2; }
 
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec;addr2:Pcint;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;timeout:Ptimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
 {$ifndef FPC_USE_LIBC}
 function futex_op(op, oparg, cmp, cmparg: cint): cint; {$ifdef SYSTEMINLINE}inline;{$endif}
 {$endif}
@@ -480,6 +487,45 @@ begin
   fdatasync:=do_SysCall(syscall_nr_fdatasync, fd);
 end;
 
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec;addr2:Pcint;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout),
+                    Tsysparam(addr2),Tsysparam(val3));
+end;
+
+function futex(var uaddr;op,val:cint;timeout:Ptimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout),
+                    Tsysparam(@addr2),Tsysparam(val3));
+end;
+
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec;var addr2;val3:cint):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(@timeout),
+                    Tsysparam(@addr2),Tsysparam(val3));
+end;
+
+function futex(uaddr:Pcint;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout));
+end;
+
+function futex(var uaddr;op,val:cint;timeout:Ptimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(timeout));
+end;
+
+function futex(var uaddr;op,val:cint;var timeout:Ttimespec):cint;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+begin
+  futex:=do_syscall(syscall_nr_futex,Tsysparam(@uaddr),Tsysparam(op),Tsysparam(val),Tsysparam(@timeout));
+end;
+
 {$endif} // non-libc
 
 { FUTEX_OP is a macro, doesn't exist in libC as function}

tests/test/tintfcdecl1.pp

@@ -0,0 +1,42 @@
+program tinfcdecl1;
+
+{$mode objfpc}{$H+}
+
+type
+  IcdeclIntf = interface
+  ['{3C409C8B-3A15-44B2-B22D-6BAA2071CAAD}']
+    function DoSomething : longint; cdecl;
+  end;
+
+  { TcdeclClass }
+
+  TcdeclClass = class(TInterfacedObject,IcdeclIntf)
+  private
+    FCounter: integer;
+  public
+    function DoSomething : longint; cdecl;
+  end;
+
+{ TcdeclClass }
+
+function TcdeclClass.DoSomething: longint; cdecl;
+begin
+  inc(FCounter);
+  result := FCounter;
+end;
+
+var
+  js: TcdeclClass;
+  ji: IcdeclIntf;
+  i: longint;
+begin
+  js := TcdeclClass.Create;
+
+  i := js.DoSomething;
+
+  ji := IcdeclIntf(js);
+  i := ji.DoSomething;
+
+  if i <> 2 then halt(1);
+end.
+

tests/test/tintfcdecl2.pp

@@ -0,0 +1,42 @@
+program tintfcdecl2;
+
+{$mode objfpc}{$H+}
+
+type
+  IcdeclIntf = interface
+  ['{3C409C8B-3A15-44B2-B22D-6BAA2071CAAD}']
+    function DoSomething : longint; cdecl;
+  end;
+
+  { TcdeclClass }
+
+  TcdeclClass = class(TInterfacedObject,IcdeclIntf)
+  private
+    FCounter: integer;
+  public
+    function DoSomething : longint; cdecl; virtual;
+  end;
+
+{ TcdeclClass }
+
+function TcdeclClass.DoSomething: longint; cdecl;
+begin
+  inc(FCounter);
+  result := FCounter;
+end;
+
+var
+  js: TcdeclClass;
+  ji: IcdeclIntf;
+  i: longint;
+begin
+  js := TcdeclClass.Create;
+
+  i := js.DoSomething;
+
+  ji := IcdeclIntf(js);
+  i := ji.DoSomething;
+
+  if i <> 2 then halt(1);
+end.
+