* synchronised with trunk r25259

git-svn-id: branches/cpstrrtl@25267 -

.gitattributes

@@ -10009,6 +10009,7 @@ tests/tbs/tb0594.pp svneol=native#text/plain
 tests/tbs/tb0595.pp svneol=native#text/plain
 tests/tbs/tb0596.pp svneol=native#text/pascal
 tests/tbs/tb0597.pp svneol=native#text/plain
+tests/tbs/tb0598.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
@@ -10667,6 +10668,7 @@ tests/test/jvm/testshort.pp svneol=native#text/plain
 tests/test/jvm/tformalpara.pp svneol=native#text/plain
 tests/test/jvm/tint.pp svneol=native#text/plain
 tests/test/jvm/tintstr.pp svneol=native#text/plain
+tests/test/jvm/tjsetter.java svneol=native#text/plain
 tests/test/jvm/tnestdynarr.pp svneol=native#text/plain
 tests/test/jvm/tnestedset.pp svneol=native#text/plain
 tests/test/jvm/tnestproc.pp svneol=native#text/plain
@@ -10710,6 +10712,7 @@ tests/test/jvm/tw22807.pp svneol=native#text/plain
 tests/test/jvm/tw24089.pp svneol=native#text/plain
 tests/test/jvm/twith.pp svneol=native#text/plain
 tests/test/jvm/uenum.pp svneol=native#text/plain
+tests/test/jvm/ujsetter.pp svneol=native#text/plain
 tests/test/jvm/unsupported.pp svneol=native#text/plain
 tests/test/lcpref.inc svneol=native#text/plain
 tests/test/library/testdll.pp svneol=native#text/plain
@@ -11003,6 +11006,7 @@ tests/test/tcpstr21.pp svneol=native#text/pascal
 tests/test/tcpstr21a.pp svneol=native#text/pascal
 tests/test/tcpstr22.pp svneol=native#text/pascal
 tests/test/tcpstr23.pp svneol=native#text/pascal
+tests/test/tcpstr24.pp svneol=native#text/plain
 tests/test/tcpstr2a.pp svneol=native#text/plain
 tests/test/tcpstr3.pp svneol=native#text/plain
 tests/test/tcpstr4.pp svneol=native#text/plain
@@ -11288,6 +11292,8 @@ tests/test/tgeneric90.pp svneol=native#text/pascal
 tests/test/tgeneric91.pp svneol=native#text/pascal
 tests/test/tgeneric92.pp svneol=native#text/pascal
 tests/test/tgeneric93.pp svneol=native#text/pascal
+tests/test/tgeneric94.pp svneol=native#text/pascal
+tests/test/tgeneric95.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -13510,6 +13516,7 @@ tests/webtbs/tw2473.pp svneol=native#text/plain
 tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
+tests/webtbs/tw24848.pp svneol=native#text/pascal
 tests/webtbs/tw2492.pp svneol=native#text/plain
 tests/webtbs/tw2494.pp svneol=native#text/plain
 tests/webtbs/tw2503.pp svneol=native#text/plain

compiler/aasmdata.pas

@@ -168,8 +168,8 @@ interface
         { asmsymbol }
         function  DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
         function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
-        function  WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
-        function  RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+        function  WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
+        function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
         function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
         { create new assembler label }
         procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
@@ -441,22 +441,22 @@ implementation
       end;
 
 
-    function TAsmData.RefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE)
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,_typ)
         { one normal reference removes the "weak" character of a symbol }
         else if (result.bind=AB_WEAK_EXTERNAL) then
           result.bind:=AB_EXTERNAL;
       end;
 
 
-    function TAsmData.WeakRefAsmSymbol(const s : TSymStr) : TAsmSymbol;
+    function TAsmData.WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype=AT_NONE) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,AT_NONE);
+          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,_typ);
       end;
 
 

compiler/aasmtai.pas

@@ -575,7 +575,9 @@ interface
           constructor Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol);
           constructor Create_rva_sym(_sym:tasmsymbol);
           constructor Createname(const name:string;ofs:aint);
+          constructor Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
           constructor Create_type_name(_typ:taiconst_type;const name:string;ofs:aint);
+          constructor Create_type_name(_typ:taiconst_type;const name:string;_symtyp:Tasmsymtype;ofs:aint);
           constructor Create_nil_codeptr;
           constructor Create_nil_dataptr;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
@@ -1371,7 +1373,9 @@ implementation
       begin
          inherited Create;
          typ:=ait_symbol_end;
-         sym:=current_asmdata.RefAsmSymbol(_name);
+         sym:=current_asmdata.GetAsmSymbol(_name);
+         if not assigned(sym) then
+           internalerror(2013080301);
       end;
 
 
@@ -1694,13 +1698,25 @@ implementation
 
     constructor tai_const.Createname(const name:string;ofs:aint);
       begin
-         self.create_sym_offset(current_asmdata.RefAsmSymbol(name),ofs);
+         self.Createname(name,AT_NONE,ofs);
+      end;
+
+
+    constructor tai_const.Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
+      begin
+         self.create_sym_offset(current_asmdata.RefAsmSymbol(name,_symtyp),ofs);
       end;
 
 
     constructor tai_const.Create_type_name(_typ:taiconst_type;const name:string;ofs:aint);
       begin
-         self.create_sym_offset(current_asmdata.RefAsmSymbol(name),ofs);
+         self.Create_type_name(_typ,name,AT_NONE,ofs);
+      end;
+
+
+    constructor tai_const.Create_type_name(_typ:taiconst_type;const name:string;_symtyp:Tasmsymtype;ofs:aint);
+      begin
+         self.create_sym_offset(current_asmdata.RefAsmSymbol(name,_symtyp),ofs);
          consttype:=_typ;
       end;
 

compiler/arm/narmadd.pas

@@ -41,16 +41,17 @@ interface
           procedure second_cmpordinal;override;
           procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
+          procedure second_add64bit;override;
        end;
 
   implementation
 
     uses
-      globtype,verbose,globals,
-      constexp,symdef,symtable,symtype,
-      aasmbase,aasmdata,aasmcpu,defutil,htypechk,
-      cgbase,cgutils,
-      cpuinfo,pass_1,procinfo,
+      globtype,verbose,globals,systems,
+      constexp,symdef,symtable,symtype,symconst,
+      aasmbase,aasmdata,aasmcpu,
+      defutil,htypechk,cgbase,cgutils,
+      cpuinfo,pass_1,pass_2,procinfo,
       ncon,nadd,ncnv,ncal,nmat,
       ncgutil,cgobj,
       hlcgobj
@@ -483,12 +484,55 @@ interface
           end;
       end;
 
+    procedure tarmaddnode.second_add64bit;
+      var
+        asmList : TAsmList;
+        ll,rl,res : TRegister64;
+        tmpreg: TRegister;
+      begin
+        if (nodetype in [muln]) then
+          begin
+            asmList := current_asmdata.CurrAsmList;
+            pass_left_right;
+
+            if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+              hlcg.location_force_reg(asmList,left.location,left.resultdef,left.resultdef,true);
+            if not(right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+              hlcg.location_force_reg(asmList,right.location,right.resultdef,right.resultdef,true);
+            set_result_location_reg;
+
+            { shortcuts to register64s }
+            ll:=left.location.register64;
+            rl:=right.location.register64;
+            res:=location.register64;
+
+            tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+            asmList.concat(taicpu.op_reg_reg_reg(A_MUL,tmpreg,ll.reglo,rl.reghi));
+            asmList.concat(taicpu.op_reg_reg_reg_reg(A_UMULL,res.reglo,res.reghi,rl.reglo,ll.reglo));
+            asmList.concat(taicpu.op_reg_reg_reg_reg(A_MLA,tmpreg,rl.reglo,ll.reghi,tmpreg));
+            asmList.concat(taicpu.op_reg_reg_reg(A_ADD,res.reghi,tmpreg,res.reghi));
+          end
+        else
+          inherited second_add64bit;
+      end;
 
     function tarmaddnode.pass_1 : tnode;
       var
         unsigned : boolean;
       begin
-        result:=inherited pass_1;
+        { prepare for MUL64 inlining }
+        if (not(cs_check_overflow in current_settings.localswitches)) and
+           (nodetype in [muln]) and
+           (is_64bitint(left.resultdef)) and
+           (not (current_settings.cputype in cpu_thumb)) then
+          begin
+            result := nil;
+            firstpass(left);
+            firstpass(right);
+            expectloc := LOC_REGISTER;
+          end
+        else
+          result:=inherited pass_1;
 
         if not(assigned(result)) then
           begin

compiler/arm/rgcpu.pas

@@ -493,9 +493,12 @@ unit rgcpu;
               A_SMULL,
               A_SMLAL:
                 begin
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                  if current_settings.cputype<cpu_armv6 then
+                    begin
+                      add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
+                      add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                      add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
+                    end;
                 end;
               A_LDRB,
               A_STRB,

compiler/cclasses.pas

@@ -273,6 +273,7 @@ type
     procedure Rename(const ANewName:TSymStr);
     property Name:TSymStr read GetName;
     property Hash:Longword read GetHash;
+    property OwnerList: TFPHashObjectList read FOwner;
   end;
 
   TFPHashObjectList = class(TObject)

compiler/cfileutl.pas

@@ -299,8 +299,8 @@ end;
                     DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
                 end;
             until findnext(dir) <> 0;
+            findclose(dir);
           end;
-        findclose(dir);
       end;
 
 
@@ -1122,8 +1122,8 @@ end;
                         end;
                     end;
                 until findnext(dir) <> 0;
+                FindClose(dir);
               end;
-            FindClose(dir);
 {$endif usedircache}
             if not subdirfound then
               WarnNonExistingPath(currpath);

compiler/cgbase.pas

@@ -624,6 +624,10 @@ implementation
             result:=result+'ms';
           R_SUBMMWHOLE:
             result:=result+'ma';
+          R_SUBMMX:
+            result:=result+'mx';
+          R_SUBMMY:
+            result:=result+'my';
           else
             internalerror(200308252);
         end;

compiler/fpcdefs.inc

@@ -52,7 +52,7 @@
   {//$define SUPPORT_MMX}
   {$define cpumm}
   {$define fewintregisters}
-  {$define cpurox}
+  {//$define cpurox}
   {$define SUPPORT_SAFECALL}
   {$define cpuneedsmulhelper}
   { TODO: add another define in order to disable the div helper for 16-bit divs? }
@@ -217,6 +217,7 @@
   { define cpumm}
   {$define cpurefshaveindexreg}
   {$define fpc_compiler_has_fixup_jmps}
+  {$define SUPPORT_GET_FRAME}
 {$endif mips}
 
 {$ifdef jvm}

compiler/globtype.pas

@@ -581,7 +581,9 @@ interface
          { subroutine contains inherited call }
          pi_has_inherited,
          { subroutine has nested exit }
-         pi_has_nested_exit
+         pi_has_nested_exit,
+         { allocates memory on stack, so stack is unbalanced on exit }
+         pi_has_stack_allocs
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/i386/cgcpu.pas

@@ -326,9 +326,15 @@ unit cgcpu;
                   stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
                 if stacksize<>0 then
                   increase_fp(stacksize);
+                if (not paramanager.use_fixed_stack) then
+                  internal_restore_regs(list,true);
               end
             else
-              list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+              begin
+                if (not paramanager.use_fixed_stack) then
+                  internal_restore_regs(list,not (pi_has_stack_allocs in current_procinfo.flags));
+                list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+              end;
             list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil));
           end;
 
@@ -492,6 +498,7 @@ unit cgcpu;
         { patch the new address, but don't use a_load_reg_reg, that will add a move instruction
           that can confuse the reg allocator }
         list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,destreg));
+        include(current_procinfo.flags,pi_has_stack_allocs);
       end;
 
 

compiler/i8086/cgcpu.pas

@@ -76,6 +76,7 @@ unit cgcpu;
         procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);override;
         procedure g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref: TReference);override;
 
+        procedure g_stackpointer_alloc(list : TAsmList;localsize: longint);override;
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
         procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
         procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
@@ -443,16 +444,16 @@ unit cgcpu;
                         internalerror(2013050102);
 
                     getcpuregister(list,NR_AX);
-                    if size in [OS_16,OS_S16] then
-                      getcpuregister(list,NR_DX);
 
                     a_load_const_reg(list,size,a,ax_subreg);
+                    if size in [OS_16,OS_S16] then
+                      getcpuregister(list,NR_DX);
                     list.concat(taicpu.op_reg(A_IMUL,TCgSize2OpSize[size],reg));
+                    if size in [OS_16,OS_S16] then
+                      ungetcpuregister(list,NR_DX);
                     a_load_reg_reg(list,size,size,ax_subreg,reg);
 
                     ungetcpuregister(list,NR_AX);
-                    if size in [OS_16,OS_S16] then
-                      ungetcpuregister(list,NR_DX);
 
                     { TODO: implement overflow checking? }
 
@@ -722,8 +723,27 @@ unit cgcpu;
 
 
     procedure tcg8086.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
+
+      procedure load_para_loc(r : TRegister;paraloc : PCGParaLocation);
+        var
+          ref : treference;
+        begin
+          paramanager.allocparaloc(list,paraloc);
+          case paraloc^.loc of
+             LOC_REGISTER,LOC_CREGISTER:
+               a_load_reg_reg(list,paraloc^.size,paraloc^.size,r,paraloc^.register);
+             LOC_REFERENCE,LOC_CREFERENCE:
+               begin
+                  reference_reset_base(ref,paraloc^.reference.index,paraloc^.reference.offset,2);
+                  a_load_reg_ref(list,paraloc^.size,paraloc^.size,r,ref);
+               end;
+             else
+               internalerror(2002071004);
+          end;
+        end;
       var
-        pushsize, pushsize2: tcgsize;
+        pushsize,pushsize2 : tcgsize;
+
       begin
         check_register_size(size,r);
         if use_push(cgpara) then
@@ -766,7 +786,21 @@ unit cgcpu;
               end;
           end
         else
-          inherited a_load_reg_cgpara(list,size,r,cgpara);
+          begin
+            if tcgsize2size[cgpara.Size]=4 then
+              begin
+                if (cgpara.location^.Next=nil) or
+                  (tcgsize2size[cgpara.location^.size]<>2) or
+                  (tcgsize2size[cgpara.location^.Next^.size]<>2) or
+                  (cgpara.location^.Next^.Next<>nil) or
+                  (cgpara.location^.shiftval<>0) then
+                  internalerror(2013031102);
+                load_para_loc(r,cgpara.Location);
+                load_para_loc(GetNextReg(r),cgpara.Location^.Next);
+              end
+            else
+              inherited a_load_reg_cgpara(list,size,r,cgpara);
+          end;
       end;
 
 
@@ -1109,13 +1143,13 @@ unit cgcpu;
               OS_S8:
                 begin
                   getcpuregister(list, NR_AX);
-                  getcpuregister(list, NR_DX);
                   list.concat(taicpu.op_ref_reg(A_MOV, S_B, tmpref, NR_AL));
+                  getcpuregister(list, NR_DX);
                   list.concat(taicpu.op_none(A_CBW));
                   list.concat(taicpu.op_none(A_CWD));
                   add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_AX, reg));
-                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_DX, GetNextReg(reg)));
                   ungetcpuregister(list, NR_AX);
+                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_DX, GetNextReg(reg)));
                   ungetcpuregister(list, NR_DX);
                 end;
               OS_16:
@@ -1126,13 +1160,13 @@ unit cgcpu;
               OS_S16:
                 begin
                   getcpuregister(list, NR_AX);
-                  getcpuregister(list, NR_DX);
                   list.concat(taicpu.op_ref_reg(A_MOV, S_W, tmpref, NR_AX));
+                  getcpuregister(list, NR_DX);
                   list.concat(taicpu.op_none(A_CWD));
-                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_AX, reg));
-                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_DX, GetNextReg(reg)));
                   ungetcpuregister(list, NR_AX);
+                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_AX, reg));
                   ungetcpuregister(list, NR_DX);
+                  add_mov(taicpu.op_reg_reg(A_MOV, S_W, NR_DX, GetNextReg(reg)));
                 end;
               OS_32,OS_S32:
                 begin
@@ -1296,6 +1330,13 @@ unit cgcpu;
       end;
 
 
+    procedure tcg8086.g_stackpointer_alloc(list : TAsmList;localsize: longint);
+      begin
+        if localsize>0 then
+          list.concat(Taicpu.Op_const_reg(A_SUB,S_W,localsize,NR_STACK_POINTER_REG));
+      end;
+
+
     procedure tcg8086.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);
       var
         stacksize : longint;

compiler/i8086/cpubase.inc

@@ -155,7 +155,7 @@
          This value can be deduced from the CALLED_USED_REGISTERS array in the
          GCC source.
       }
-      saved_standard_registers : array[0..2] of tsuperregister = (RS_SI,RS_DI,RS_BP);
+      saved_standard_registers : array[0..0] of tsuperregister = (RS_BP);
 
       saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
       {# Required parameter alignment when calling a routine declared as

compiler/i8086/rgcpu.pas

@@ -87,21 +87,44 @@ implementation
                 if taicpu(p).oper[i]^.typ=top_ref then
                   begin
                     href:=taicpu(p).oper[i]^.ref^;
-                    if (href.base<>NR_NO) and (getsupreg(href.base)>=first_int_imreg) then
+                    { in case there's exactly one register used, we can treat it
+                      as either base or index and choose it from the larger set
+                      of registers [BX, BP, SI, DI] }
+                    if (href.base<>NR_NO) xor (href.index<>NR_NO) then
                       begin
-                        add_edge(getsupreg(href.base),RS_AX);
-                        add_edge(getsupreg(href.base),RS_CX);
-                        add_edge(getsupreg(href.base),RS_DX);
-                        add_edge(getsupreg(href.base),RS_SI);
-                        add_edge(getsupreg(href.base),RS_DI);
-                      end;
-                    if (href.index<>NR_NO) and (getsupreg(href.index)>=first_int_imreg) then
+                        if (href.base<>NR_NO) and (getsupreg(href.base)>=first_int_imreg) then
+                          begin
+                            add_edge(getsupreg(href.base),RS_AX);
+                            add_edge(getsupreg(href.base),RS_CX);
+                            add_edge(getsupreg(href.base),RS_DX);
+                          end;
+                        if (href.index<>NR_NO) and (getsupreg(href.index)>=first_int_imreg) then
+                          begin
+                            add_edge(getsupreg(href.index),RS_AX);
+                            add_edge(getsupreg(href.index),RS_CX);
+                            add_edge(getsupreg(href.index),RS_DX);
+                          end;
+                      end
+                    else
                       begin
-                        add_edge(getsupreg(href.index),RS_AX);
-                        add_edge(getsupreg(href.index),RS_BX);
-                        add_edge(getsupreg(href.index),RS_CX);
-                        add_edge(getsupreg(href.index),RS_DX);
-                        add_edge(getsupreg(href.index),RS_BP);
+                        { base is chosen from the set [BX, BP] }
+                        if (href.base<>NR_NO) and (getsupreg(href.base)>=first_int_imreg) then
+                          begin
+                            add_edge(getsupreg(href.base),RS_AX);
+                            add_edge(getsupreg(href.base),RS_CX);
+                            add_edge(getsupreg(href.base),RS_DX);
+                            add_edge(getsupreg(href.base),RS_SI);
+                            add_edge(getsupreg(href.base),RS_DI);
+                          end;
+                        { index is chosen from the set [SI, DI] }
+                        if (href.index<>NR_NO) and (getsupreg(href.index)>=first_int_imreg) then
+                          begin
+                            add_edge(getsupreg(href.index),RS_AX);
+                            add_edge(getsupreg(href.index),RS_BX);
+                            add_edge(getsupreg(href.index),RS_CX);
+                            add_edge(getsupreg(href.index),RS_DX);
+                            add_edge(getsupreg(href.index),RS_BP);
+                          end;
                       end;
                   end;
               end;

compiler/jvm/pjvm.pas

@@ -951,7 +951,24 @@ implementation
                             end;
                           { otherwise we can't do anything, and
                             proc_add_definition will give an error }
-                        end
+                        end;
+                      { add method with the correct visibility }
+                      pd:=tprocdef(parentpd.getcopy);
+                      { get rid of the import name for inherited virtual class methods,
+                        it has to be regenerated rather than amended }
+                      if [po_classmethod,po_virtualmethod]<=pd.procoptions then
+                        begin
+                          stringdispose(pd.import_name);
+                          exclude(pd.procoptions,po_has_importname);
+                        end;
+                      pd.visibility:=p.visibility;
+                      pd.procoptions:=pd.procoptions+procoptions;
+                      { ignore this artificially added procdef when looking for overloads }
+                      include(pd.procoptions,po_ignore_for_overload_resolution);
+                      finish_copied_procdef(pd,parentpd.procsym.realname,obj.symtable,obj);
+                      exclude(pd.procoptions,po_external);
+                      pd.synthetickind:=tsk_anon_inherited;
+                      exit;
                     end;
                 end;
               { make the artificial getter/setter virtual so we can override it in

compiler/mips/cpuelf.pas

@@ -49,6 +49,7 @@ implementation
       stubcount: longint;
       trampolinesection: TObjSection;
       procedure MaybeWriteGOTEntry(relocval:aint;objsym:TObjSymbol);
+      procedure MaybeWriteTLSIEGotEntry(relocval:aint;objsym:TObjSymbol);
       procedure CreatePICStub(objsym:TObjSymbol);
     protected
       procedure PrepareGOT;override;
@@ -225,9 +226,18 @@ implementation
 
 
   function elf_mips_loadsection(objinput:TElfObjInput;objdata:TObjData;const shdr:TElfsechdr;shindex:longint):boolean;
+    var
+      ri: TElfReginfo;
     begin
       case shdr.sh_type of
         SHT_MIPS_REGINFO:
+          begin
+            objinput.ReadBytes(shdr.sh_offset,ri,sizeof(ri));
+            MaybeSwapElfReginfo(ri);
+            TElfObjData(objdata).gp_value:=ri.ri_gp_value;
+            result:=true;
+          end;
+        SHT_MIPS_DWARF:
           result:=true;
       else
         writeln('elf_mips_loadsection: ',hexstr(shdr.sh_type,8),' ',objdata.name);
@@ -555,6 +565,31 @@ implementation
         end;
     end;
 
+  procedure TElfExeOutputMIPS.MaybeWriteTLSIEGotEntry(relocval:aint;objsym:TObjSymbol);
+    var
+      gotoff,tmp:aword;
+    begin
+      gotoff:=objsym.exesymbol.gotoffset;
+      if gotoff=0 then
+        InternalError(2012060903);
+
+      if gotoff=gotobjsec.Data.size+sizeof(pint) then
+        begin
+          tmp:=gotobjsec.mempos+gotoff-sizeof(pint);
+          if (objsym.exesymbol.dynindex>0) then
+            begin
+              gotobjsec.writezeros(sizeof(pint));
+              dynreloclist.Add(TObjRelocation.CreateRaw(tmp,objsym,R_MIPS_TLS_TPREL32));
+            end
+          else
+            begin
+              putword(gotobjsec,relocval);
+              if IsSharedLibrary then
+                dynreloclist.Add(TObjRelocation.CreateRaw(tmp,nil,R_MIPS_TLS_TPREL32));
+            end;
+        end;
+    end;
+
   procedure TElfExeOutputMIPS.CreatePICStub(objsym:TObjSymbol);
     var
       textsec,newsec:TObjSection;
@@ -722,6 +757,9 @@ implementation
                 local_got_relocs.add(objreloc);
               end;
           end;
+
+        R_MIPS_TLS_GOTTPREL:
+          inherited AllocGOTSlot(objreloc.symbol);
       end;
     end;
 
@@ -918,6 +956,34 @@ implementation
               //TODO: check overflow
               address:=(address and $FFFF0000) or ((((SmallInt(address) shl 2)+relocval-curloc) shr 2) and $FFFF);
 
+            R_MIPS_GPREL32:
+              address:=address+relocval+TElfObjData(objsec.objdata).gp_value-gotsymbol.address;
+
+            R_MIPS_TLS_GOTTPREL:
+              begin
+                if IsSharedLibrary then
+                  relocval:=relocval-tlsseg.MemPos
+                else
+                  relocval:=relocval-(tlsseg.MemPos+TP_OFFSET);
+                MaybeWriteTLSIEGotEntry(relocval,objreloc.symbol);
+                relocval:=-(gotsymbol.offset-(objreloc.symbol.exesymbol.gotoffset-sizeof(pint)));
+                // TODO: check overflow
+                address:=(address and $FFFF0000) or (relocval and $FFFF);
+              end;
+
+            R_MIPS_TLS_TPREL_HI16:
+              begin
+                tmp:=SmallInt(address)+relocval-(tlsseg.MemPos+TP_OFFSET);
+                tmp:=(tmp+$8000) shr 16;
+                address:=(address and $FFFF0000) or (tmp and $FFFF);
+              end;
+
+            R_MIPS_TLS_TPREL_LO16:
+              begin
+                tmp:=SmallInt(address)+relocval-(tlsseg.MemPos+TP_OFFSET);
+                address:=(address and $FFFF0000) or (tmp and $FFFF);
+              end;
+
             R_MIPS_JALR: {optimization hint, ignore for now }
               ;
           else

compiler/mips/cpupi.pas

@@ -65,8 +65,8 @@ implementation
     constructor TMIPSProcInfo.create(aparent: tprocinfo);
       begin
         inherited create(aparent);
-        { if (cs_generate_stackframes in current_settings.localswitches) or
-           not (cs_opt_stackframe in current_settings.optimizerswitches) then }
+        if (cs_generate_stackframes in current_settings.localswitches) or
+           not (cs_opt_stackframe in current_settings.optimizerswitches) then
           include(flags,pi_needs_stackframe);
 
         floatregssave:=12; { f20-f31 }

compiler/mips/ncpuinln.pas

@@ -36,6 +36,7 @@ type
     procedure second_abs_real; override;
     procedure second_sqr_real; override;
     procedure second_sqrt_real; override;
+    procedure second_get_frame; override;
   private
     procedure load_fpu_location;
   end;
@@ -133,6 +134,14 @@ begin
   end;
 end;
 
+
+procedure tMIPSELinlinenode.second_get_frame;
+begin
+  location_reset(location,LOC_CREGISTER,OS_ADDR);
+  location.register:=NR_FRAME_POINTER_REG;
+end;
+
+
 begin
   cInlineNode := tMIPSELinlinenode;
 end.

compiler/nadd.pas

@@ -756,7 +756,7 @@ implementation
              case nodetype of
                 addn :
                   begin
-                    t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
+                    t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,nil);
                     typecheckpass(t);
                     tstringconstnode(t).changestringtype(resultdef);
                   end;

compiler/ncginl.pas

@@ -294,7 +294,7 @@ implementation
          end
         else
          begin
-           { length in ansi/wide strings is at offset -sizeof(pint) }
+           { length in ansi/wide strings and high in dynamic arrays is at offset -sizeof(pint) }
            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
            current_asmdata.getjumplabel(lengthlab);
            cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
@@ -312,6 +312,11 @@ implementation
              end;
            if is_widestring(left.resultdef) then
              cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister);
+
+           { Dynamic arrays do not have their length attached but their maximum index }
+           if is_dynamic_array(left.resultdef) then
+             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,1,hregister);
+
            cg.a_label(current_asmdata.CurrAsmList,lengthlab);
            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
            location.register:=hregister;

compiler/ncgld.pas

@@ -1337,7 +1337,7 @@ implementation
                  dec(href.offset,sizeof(pint));
                  cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href);
                  { goto next array element }
-                 advancearrayoffset(href,sizeof(pint)*2);
+                 advancearrayoffset(href,elesize);
                end
               else
               { normal array constructor of the same type }

compiler/ncgrtti.pas

@@ -859,7 +859,7 @@ implementation
               if (oo_has_vmt in def.objectoptions) then
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
               else
-                current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_dataptr);
 
             { write parent typeinfo }
             write_rtti_reference(def.childof,fullrtti);

compiler/ncgvmt.pas

@@ -95,7 +95,7 @@ implementation
         constructor create(c:tobjectdef);
         { write the VMT to al_globals }
         procedure writevmt;
-        procedure writeinterfaceids;
+        procedure writeinterfaceids(list: TAsmList);
       end;
 
 
@@ -446,7 +446,7 @@ implementation
 
                 lists[0].concat(Tai_const.Create_sym(l));
                 if po_abstractmethod in pd.procoptions then
-                  lists[0].concat(Tai_const.Create_sym(nil))
+                  lists[0].concat(Tai_const.Create_nil_codeptr)
                 else
                   lists[0].concat(Tai_const.Createname(pd.mangledname,0));
               end;
@@ -600,7 +600,7 @@ implementation
           rawdata.concat(Tai_const.CreateName(
             make_mangledname('IID',AImplIntf.IntfDef.owner,AImplIntf.IntfDef.objname^),0))
         else
-          rawdata.concat(Tai_const.Create_sym(nil));
+          rawdata.concat(Tai_const.Create_nil_dataptr);
 
         { VTable }
         rawdata.concat(Tai_const.Createname(intf_get_vtbl_name(AImplIntf.VtblImplIntf),0));
@@ -658,7 +658,7 @@ implementation
 
 
   { Write interface identifiers to the data section }
-  procedure TVMTWriter.writeinterfaceids;
+  procedure TVMTWriter.writeinterfaceids(list: TAsmList);
     var
       i : longint;
       s : string;
@@ -666,21 +666,21 @@ implementation
       if assigned(_class.iidguid) then
         begin
           s:=make_mangledname('IID',_class.owner,_class.objname^);
-          maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-          new_section(current_asmdata.asmlists[al_globals],sec_rodata,s,const_align(sizeof(pint)));
-          current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
-          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1)));
-          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D2));
-          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D3));
+          maybe_new_object_file(list);
+          new_section(list,sec_rodata_norel,s,const_align(sizeof(pint)));
+          list.concat(Tai_symbol.Createname_global(s,AT_DATA,0));
+          list.concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1)));
+          list.concat(Tai_const.Create_16bit(_class.iidguid^.D2));
+          list.concat(Tai_const.Create_16bit(_class.iidguid^.D3));
           for i:=Low(_class.iidguid^.D4) to High(_class.iidguid^.D4) do
-            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(_class.iidguid^.D4[i]));
+            list.concat(Tai_const.Create_8bit(_class.iidguid^.D4[i]));
         end;
-      maybe_new_object_file(current_asmdata.asmlists[al_globals]);
+      maybe_new_object_file(list);
       s:=make_mangledname('IIDSTR',_class.owner,_class.objname^);
-      new_section(current_asmdata.asmlists[al_globals],sec_rodata,s,sizeof(pint));
-      current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
-      current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(_class.iidstr^)));
-      current_asmdata.asmlists[al_globals].concat(Tai_string.Create(_class.iidstr^));
+      new_section(list,sec_rodata_norel,s,sizeof(pint));
+      list.concat(Tai_symbol.Createname_global(s,AT_DATA,0));
+      list.concat(Tai_const.Create_8bit(length(_class.iidstr^)));
+      list.concat(Tai_string.Create(_class.iidstr^));
     end;
 
 
@@ -819,7 +819,7 @@ implementation
             (oo_has_vmt in _class.childof.objectoptions) then
            current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname,0))
          else
-           current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
+           current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
 
          { write extended info for classes, for the order see rtl/inc/objpash.inc }
          if is_class(_class) then
@@ -830,7 +830,7 @@ implementation
             if (oo_has_msgint in _class.objectoptions) then
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(intmessagetable))
             else
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
             { pointer to method table or nil }
             current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(methodnametable));
             { pointer to field table }
@@ -841,25 +841,25 @@ implementation
             if _class.members_need_inittable then
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,initrtti)))
             else
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
             { auto table }
-            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
+            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
             { interface table }
             if _class.ImplementedInterfaces.count>0 then
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable))
             else if _class.implements_any_interfaces then
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil))
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr)
             else
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF')));
             { table for string messages }
             if (oo_has_msgstr in _class.objectoptions) then
               current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(strmessagetable))
             else
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
           end;
          { write virtual methods }
          writevirtualmethods(current_asmdata.asmlists[al_globals]);
-         current_asmdata.asmlists[al_globals].concat(Tai_const.create(aitconst_ptr,0));
+         current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_codeptr);
          { write the size of the VMT }
          current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname));
 {$ifdef vtentry}
@@ -958,7 +958,7 @@ implementation
                     begin
                       vmtwriter:=TVMTWriter.create(tobjectdef(def));
                       if is_interface(tobjectdef(def)) then
-                        vmtwriter.writeinterfaceids;
+                        vmtwriter.writeinterfaceids(current_asmdata.AsmLists[al_globals]);
                       if (oo_has_vmt in tobjectdef(def).objectoptions) then
                         vmtwriter.writevmt;
                       vmtwriter.free;

compiler/ncnv.pas

@@ -1048,7 +1048,7 @@ implementation
                    begin
                      pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
                      left.free;
-                     left:=cstringconstnode.createpchar(pchtemp,arrsize);
+                     left:=cstringconstnode.createpchar(pchtemp,arrsize,nil);
                      typecheckpass(left);
                    end;
                  exit;

compiler/ncon.pas

@@ -121,9 +121,11 @@ interface
           value_str : pchar;
           len     : longint;
           lab_str : tasmlabel;
+          astringdef : tdef;
+          astringdefderef : tderef;
           cst_type : tconststringtype;
           constructor createstr(const s : string);virtual;
-          constructor createpchar(s : pchar;l : longint);virtual;
+          constructor createpchar(s: pchar; l: longint; def: tdef);virtual;
           constructor createunistr(w : pcompilerwidestring);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -309,7 +311,7 @@ implementation
               getmem(pc,len+1);
               move(pchar(p.value.valueptr)^,pc^,len);
               pc[len]:=#0;
-              p1:=cstringconstnode.createpchar(pc,len);
+              p1:=cstringconstnode.createpchar(pc,len,p.constdef);
             end;
           constwstring :
             p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
@@ -827,12 +829,19 @@ implementation
       end;
 
 
-    constructor tstringconstnode.createpchar(s : pchar;l : longint);
+    constructor tstringconstnode.createpchar(s: pchar; l: longint; def: tdef);
       begin
          inherited create(stringconstn);
          len:=l;
          value_str:=s;
-         cst_type:=cst_conststring;
+         if assigned(def) and
+            is_ansistring(def) then
+           begin
+             cst_type:=cst_ansistring;
+             astringdef:=def;
+           end
+         else
+           cst_type:=cst_conststring;
          lab_str:=nil;
       end;
 
@@ -880,6 +889,8 @@ implementation
             value_str[len]:=#0;
           end;
         lab_str:=tasmlabel(ppufile.getasmsymbol);
+        if cst_type=cst_ansistring then
+          ppufile.getderef(astringdefderef);
       end;
 
 
@@ -893,18 +904,22 @@ implementation
         else
           ppufile.putdata(value_str^,len);
         ppufile.putasmsymbol(lab_str);
+        if cst_type=cst_ansistring then
+          ppufile.putderef(astringdefderef);
       end;
 
 
     procedure tstringconstnode.buildderefimpl;
       begin
         inherited buildderefimpl;
+        astringdefderef.build(astringdef);
       end;
 
 
     procedure tstringconstnode.derefimpl;
       begin
         inherited derefimpl;
+        astringdef:=tdef(astringdefderef.resolve);
       end;
 
 
@@ -925,6 +940,7 @@ implementation
            end
          else
            n.value_str:=getpcharcopy;
+         n.astringdef:=astringdef;
          dogetcopy:=n;
       end;
 
@@ -948,7 +964,10 @@ implementation
           cst_shortstring :
             resultdef:=cshortstringtype;
           cst_ansistring :
-            resultdef:=getansistringdef;
+            if not assigned(astringdef) then
+              resultdef:=getansistringdef
+            else
+              resultdef:=astringdef;
           cst_unicodestring :
             resultdef:=cunicodestringtype;
           cst_widestring :

compiler/nflw.pas

@@ -1476,6 +1476,9 @@ implementation
          { loop unrolling }
          if cs_opt_loopunroll in current_settings.optimizerswitches then
            begin
+             res:=t2.simplify(false);
+             if assigned(res) then
+               t2:=res;
              res:=unroll_loop(self);
              if assigned(res) then
                begin

compiler/ngenutil.pas

@@ -545,6 +545,7 @@ implementation
       StructList: TFPList absolute arg;
     begin
       if (tdef(p).typ in [objectdef,recorddef]) and
+         not (df_generic in tdef(p).defoptions) and
          ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
         StructList.Add(p);
     end;

compiler/ninl.pas

@@ -2537,7 +2537,7 @@ implementation
           encodedtype:='';
           if not objctryencodetype(left.resultdef,encodedtype,errordef) then
             Message1(type_e_objc_type_unsupported,errordef.typename);
-          result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype));
+          result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
         end;
 
 
@@ -2740,15 +2740,7 @@ implementation
                                cordconstnode.create(1,sinttype,false));
                            exit;
                          end
-                        else if is_dynamic_array(left.resultdef) then
-                          begin
-                            hp := ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil);
-                            result := ccallnode.createintern('fpc_dynarray_length',hp);
-                            { make sure the left node doesn't get disposed, since it's }
-                            { reused in the new node (JM)                              }
-                            left:=nil;
-                            exit;
-                          end
+                        { Length() for dynamic arrays is inlined }
                         else
                           begin
                             { will be handled in simplify }

compiler/nutils.pas

@@ -673,6 +673,16 @@ implementation
 {$endif ARM}
                   exit;
                 end;
+              exitn:
+                begin
+                  inc(result,2);
+                  if (result >= NODE_COMPLEXITY_INF) then
+                    begin
+                      result := NODE_COMPLEXITY_INF;
+                      exit;
+                    end;
+                  p:=texitnode(p).left;
+                end;
               tempcreaten,
               tempdeleten,
               pointerconstn,

compiler/ogbase.pas

@@ -169,6 +169,7 @@ interface
        constructor create(AList:TFPHashObjectList;const AName:string);
        function  address:aword;
        procedure SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype);
+       function  ObjData: TObjData;
      end;
 
      { Stabs is common for all targets }
@@ -256,13 +257,18 @@ interface
 
      TString80 = string[80];
 
+     TObjSymbolList = class(TFPHashObjectList)
+     public
+       Owner: TObjData;
+     end;
+
      TObjData = class(TLinkedListItem)
      private
        FCurrObjSec : TObjSection;
        FObjSectionList  : TFPHashObjectList;
        FCObjSection     : TObjSectionClass;
        { Symbols that will be defined in this object file }
-       FObjSymbolList    : TFPHashObjectList;
+       FObjSymbolList    : TObjSymbolList;
        FCachedAsmSymbolList : TFPObjectList;
        { Special info sections that are written to during object generation }
        FStabsObjSec,
@@ -309,7 +315,7 @@ interface
        procedure layoutsections(var datapos:aword);
        property Name:TString80 read FName;
        property CurrObjSec:TObjSection read FCurrObjSec;
-       property ObjSymbolList:TFPHashObjectList read FObjSymbolList;
+       property ObjSymbolList:TObjSymbolList read FObjSymbolList;
        property ObjSectionList:TFPHashObjectList read FObjSectionList;
        property GroupsList:TFPHashObjectList read FGroupsList;
        property StabsSec:TObjSection read FStabsObjSec write FStabsObjSec;
@@ -522,6 +528,7 @@ interface
         procedure DoRelocationFixup(objsec:TObjSection);virtual;abstract;
         function MemAlign(exesec: TExeSection): longword;
         function DataAlign(exesec: TExeSection): longword;
+        procedure ReplaceExeSectionList(newlist: TFPList);
       public
         CurrDataPos  : aword;
         MaxMemPos    : qword;
@@ -707,6 +714,12 @@ implementation
         offset:=aobjsec.size;
       end;
 
+
+    function TObjSymbol.ObjData: TObjData;
+      begin
+        result:=(OwnerList as TObjSymbolList).Owner;
+      end;
+
 {****************************************************************************
                               TObjRelocation
 ****************************************************************************}
@@ -960,7 +973,8 @@ implementation
         FStabsObjSec:=nil;
         FStabStrObjSec:=nil;
         { symbols }
-        FObjSymbolList:=TFPHashObjectList.Create(true);
+        FObjSymbolList:=TObjSymbolList.Create(true);
+        FObjSymbolList.Owner:=Self;
         FCachedAsmSymbolList:=TFPObjectList.Create(false);
         { section class type for creating of new sections }
         FCObjSection:=TObjSection;
@@ -2517,12 +2531,14 @@ implementation
                     firstcommon:=false;
                   end;
                 internalObjData.setsection(commonObjSection);
-                internalObjData.allocalign(var_align(objsym.size));
+                { TODO: support alignment of common symbols (ELF targets at least),
+                  increase commonObjSection.SecAlign if necessary here. }
+                internalObjData.allocalign(used_align(size_2_align(objsym.size),0,commonObjSection.SecAlign));
                 commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_DATA);
                 commonsym.size:=objsym.size;
                 internalObjData.alloc(objsym.size);
                 if assigned(exemap) then
-                  exemap.AddCommonSymbol(commonsym);
+                  exemap.AddCommonSymbol(objsym);
                 { Assign to the exesymbol }
                 objsym.exesymbol.objsymbol:=commonsym;
                 objsym.exesymbol.state:=symstate_defined;
@@ -3288,6 +3304,22 @@ implementation
       end;
 
 
+    procedure TExeOutput.ReplaceExeSectionList(newlist: TFPList);
+      var
+        tmp: TFPHashObjectList;
+        i: longint;
+      begin
+        tmp:=TFPHashObjectList.Create(true);
+        for i:=0 to newlist.count-1 do
+          TFPHashObject(newlist[i]).ChangeOwner(tmp);
+        { prevent destruction of existing sections }
+        for i:=0 to ExeSectionList.count-1 do
+          ExeSectionList.List[i]:=nil;
+        FExeSectionList.Free;
+        FExeSectionList:=tmp;
+      end;
+
+
 {****************************************************************************
                                 TObjInput
 ****************************************************************************}

compiler/ogelf.pas

@@ -76,6 +76,9 @@ interface
        public
          ident: TElfIdent;
          flags: longword;
+{$ifdef mips}
+         gp_value: longword;
+{$endif mips}
          constructor create(const n:string);override;
          function  sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
          procedure CreateDebugSections;override;
@@ -148,6 +151,7 @@ interface
          class function CanReadObjData(AReader:TObjectreader):boolean;override;
          function CreateSection(const shdr:TElfsechdr;index:longint;objdata:TObjData;
            out secname:string):TElfObjSection;
+         function ReadBytes(offs:longint;out buf;len:longint):boolean;
        end;
 
        TElfVersionDef = class(TFPHashObject)
@@ -267,6 +271,7 @@ interface
          procedure WriteShstrtab;
          procedure FixupSectionLinks;
          procedure InitDynlink;
+         procedure OrderOrphanSections;
        protected
          dynamiclink: boolean;
          hastextrelocs: boolean;
@@ -967,7 +972,7 @@ implementation
             end;
           AB_COMMON :
             begin
-              elfsym.st_value:=var_align(objsym.size);
+              elfsym.st_value:=size_2_align(objsym.size);
               elfsym.st_info:=STB_GLOBAL shl 4;
               elfsym.st_shndx:=SHN_COMMON;
             end;
@@ -1474,6 +1479,13 @@ implementation
       end;
 
 
+    function TElfObjInput.ReadBytes(offs:longint;out buf;len:longint):boolean;
+      begin
+        FReader.Seek(offs);
+        result:=FReader.Read(buf,len);
+      end;
+
+
     procedure TElfObjInput.LoadSection(const shdr:TElfsechdr;index:longint;objdata:tobjdata);
       var
         sec: TElfObjSection;
@@ -2337,6 +2349,7 @@ implementation
         end;
 
       begin
+        OrderOrphanSections;
         inherited Order_end;
         set_oso_keep('.init');
         set_oso_keep('.fini');
@@ -2355,6 +2368,90 @@ implementation
       end;
 
 
+    procedure TElfExeOutput.OrderOrphanSections;
+      var
+        i,j:longint;
+        objdata:TObjData;
+        objsec:TObjSection;
+        exesec:TExeSection;
+        opts:TObjSectionOptions;
+        s:string;
+        newsections,tmp:TFPHashObjectList;
+        allsections:TFPList;
+        inserts:array[0..6] of TExeSection;
+        idx,inspos:longint;
+      begin
+        newsections:=TFPHashObjectList.Create(false);
+        allsections:=TFPList.Create;
+        { copy existing sections }
+        for i:=0 to ExeSectionList.Count-1 do
+          allsections.add(ExeSectionList[i]);
+        inserts[0]:=FindExeSection('.comment');
+        inserts[1]:=nil;
+        inserts[2]:=FindExeSection('.interp');
+        inserts[3]:=FindExeSection('.bss');
+        inserts[4]:=FindExeSection('.data');
+        inserts[5]:=FindExeSection('.rodata');
+        inserts[6]:=FindExeSection('.text');
+
+        for i:=0 to ObjDataList.Count-1 do
+          begin
+            ObjData:=TObjData(ObjDataList[i]);
+            for j:=0 to ObjData.ObjSectionList.Count-1 do
+              begin
+                objsec:=TObjSection(ObjData.ObjSectionList[j]);
+                if objsec.Used then
+                  continue;
+                s:=objsec.name;
+                exesec:=TExeSection(newsections.Find(s));
+                if assigned(exesec) then
+                  begin
+                    exesec.AddObjSection(objsec);
+                    continue;
+                  end;
+                opts:=objsec.SecOptions*[oso_data,oso_load,oso_write,oso_executable];
+                if (objsec.SecOptions*[oso_load,oso_debug]=[]) then
+                  { non-alloc, after .comment
+                    GNU ld places .comment between stabs and dwarf debug info }
+                  inspos:=0
+                else if not (oso_load in objsec.SecOptions) then
+                  inspos:=1   { debugging, skip }
+                else if (oso_load in objsec.SecOptions) and
+                  (TElfObjSection(objsec).shtype=SHT_NOTE) then
+                  inspos:=2   { after .interp }
+                else if (opts=[oso_load,oso_write]) then
+                  inspos:=3   { after .bss }
+                else if (opts=[oso_data,oso_load,oso_write]) then
+                  inspos:=4   { after .data }
+                else if (opts=[oso_data,oso_load]) then
+                  inspos:=5   { rodata, relocs=??? }
+                else if (opts=[oso_data,oso_load,oso_executable]) then
+                  inspos:=6   { text }
+                else
+                  begin
+                    Comment(v_debug,'Orphan section '+objsec.fullname+' has attributes that are not handled!');
+                    continue;
+                  end;
+                if (inserts[inspos]=nil) then
+                  begin
+                    Comment(v_debug,'Orphan section '+objsec.fullname+': nowhere to insert, ignored');
+                    continue;
+                  end;
+                idx:=allsections.IndexOf(inserts[inspos]);
+                exesec:=CExeSection.Create(newsections,s);
+                allsections.Insert(idx+1,exesec);
+                inserts[inspos]:=exesec;
+                exesec.AddObjSection(objsec);
+              end;
+          end;
+        { Now replace the ExeSectionList with content of allsections }
+        if (newsections.count<>0) then
+          ReplaceExeSectionList(allsections);
+        newsections.Free;
+        allsections.Free;
+      end;
+
+
     procedure TElfExeOutput.AfterUnusedSectionRemoval;
       var
         i:longint;
@@ -2438,7 +2535,7 @@ implementation
                 if exesym.ObjSymbol.size=0 then
                   Comment(v_error,'Dynamic variable '+exesym.name+' has zero size');
                 internalobjdata.setSection(dynbssobjsec);
-                internalobjdata.allocalign(var_align(exesym.ObjSymbol.size));
+                internalobjdata.allocalign(size_2_align(exesym.ObjSymbol.size));
                 objsym:=internalobjdata.SymbolDefine(exesym.name,AB_GLOBAL,AT_DATA);
                 objsym.size:=exesym.ObjSymbol.size;
                 objsym.indsymbol:=exesym.ObjSymbol.indsymbol;

compiler/ogmap.pas

@@ -145,7 +145,7 @@ implementation
             writeln(t,p.name);
             s:='';
           end;
-         Add(PadSpace(s,20)+'0x'+PadSpace(sizestr(p.size),16)+p.objsection.objdata.name);
+         Add(PadSpace(s,20)+PadSpace(sizestr(p.size),16)+p.objdata.name);
        end;
 
 

compiler/optloop.pas

@@ -50,7 +50,7 @@ unit optloop;
       begin
 {$ifdef i386}
         { multiply by 2 for CPUs with a long pipeline }
-        if current_settings.cputype in [cpu_Pentium4] then
+        if current_settings.optimizecputype in [cpu_Pentium4] then
           number_unrolls:=60 div node_count(node)
         else
 {$endif i386}
@@ -62,7 +62,7 @@ unit optloop;
 
     type
       treplaceinfo = record
-        loadnode : tloadnode;
+        node : tnode;
         value : Tconstexprint;
       end;
       preplaceinfo = ^treplaceinfo;
@@ -78,12 +78,15 @@ unit optloop;
 
     function replaceloadnodes(var n: tnode; arg: pointer): foreachnoderesult;
       begin
-        if (n.nodetype=loadn) and (tloadnode(n).symtableentry=preplaceinfo(arg)^.loadnode.symtableentry) then
+        if ((n.nodetype=loadn) and (preplaceinfo(arg)^.node.nodetype=loadn) and
+          (tloadnode(n).symtableentry=tloadnode(preplaceinfo(arg)^.node).symtableentry)) or
+          ((n.nodetype=temprefn) and (preplaceinfo(arg)^.node.nodetype=temprefn) and
+          (ttemprefnode(n).tempinfo=ttemprefnode(preplaceinfo(arg)^.node).tempinfo)) then
           begin
             if n.flags*[nf_modify,nf_write]<>[] then
               internalerror(2012090402);
             n.free;
-            n:=cordconstnode.create(preplaceinfo(arg)^.value,preplaceinfo(arg)^.loadnode.resultdef,false);
+            n:=cordconstnode.create(preplaceinfo(arg)^.value,preplaceinfo(arg)^.node.resultdef,false);
           end;
         result:=fen_false;
       end;
@@ -97,6 +100,7 @@ unit optloop;
         unrollblock : tblocknode;
         getridoffor : boolean;
         replaceinfo : treplaceinfo;
+        usesbreakcontinue : boolean;
       begin
         result:=nil;
         if (cs_opt_size in current_settings.optimizerswitches) then
@@ -114,6 +118,8 @@ unit optloop;
                 else
                   counts:=tordconstnode(tfornode(node).t1).value-tordconstnode(tfornode(node).right).value+1;
 
+                usesbreakcontinue:=foreachnodestatic(tfornode(node).t2,@checkbreakcontinue,nil);
+
                 { don't unroll more than we need,
 
                   multiply unroll by two here because we can get rid
@@ -126,13 +132,13 @@ unit optloop;
                 unrollblock:=internalstatements(unrollstatement);
 
                 { can we get rid completly of the for ? }
-                getridoffor:=(unrolls=counts) and not(foreachnodestatic(tfornode(node).t2,@checkbreakcontinue,nil));
+                getridoffor:=(unrolls=counts) and not(usesbreakcontinue);
 
                 if getridoffor then
                   begin
-                    if tfornode(node).left.nodetype<>loadn then
+                    if not(tfornode(node).left.nodetype in [temprefn,loadn]) then
                       internalerror(2012090301);
-                    replaceinfo.loadnode:=tloadnode(tfornode(node).left);
+                    replaceinfo.node:=tfornode(node).left;
                     replaceinfo.value:=tordconstnode(tfornode(node).right).value;
                   end;
 
@@ -150,28 +156,28 @@ unit optloop;
                         addstatement(unrollstatement,tfornode(node).entrylabel);
                       end;
 
-                        if getridoffor then
+                    if getridoffor then
+                      begin
+                        foreachnodestatic(tnode(unrollstatement),@replaceloadnodes,@replaceinfo);
+                        if lnf_backward in tfornode(node).loopflags then
+                          replaceinfo.value:=replaceinfo.value-1
+                        else
+                          replaceinfo.value:=replaceinfo.value+1;
+                      end
+                    else
+                      begin
+                        { for itself increases at the last iteration }
+                        if i<unrolls then
                           begin
-                            foreachnodestatic(tnode(unrollstatement),@replaceloadnodes,@replaceinfo);
+                            { insert incr/decrementation of counter var }
                             if lnf_backward in tfornode(node).loopflags then
-                              replaceinfo.value:=replaceinfo.value-1
+                              addstatement(unrollstatement,
+                                geninlinenode(in_dec_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil)))
                             else
-                              replaceinfo.value:=replaceinfo.value+1;
-                          end
-                        else
-                          begin
-                            { for itself increases at the last iteration }
-                            if i<unrolls then
-                              begin
-                                { insert incr/decrementation of counter var }
-                                if lnf_backward in tfornode(node).loopflags then
-                                  addstatement(unrollstatement,
-                                    geninlinenode(in_dec_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil)))
-                                else
-                                  addstatement(unrollstatement,
-                                    geninlinenode(in_inc_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil)));
-                              end;
-                           end;
+                              addstatement(unrollstatement,
+                                geninlinenode(in_inc_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil)));
+                          end;
+                       end;
                   end;
                 { can we get rid of the for statement? }
                 if getridoffor then

compiler/pdecl.pas

@@ -109,7 +109,13 @@ implementation
                  begin
                    getmem(sp,tstringconstnode(p).len+1);
                    move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
-                   hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len);
+                   { if a non-default ansistring code page has been specified,
+                     keep it }
+                   if is_ansistring(p.resultdef) and
+                      (tstringdef(p.resultdef).encoding<>0) then
+                     hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len,p.resultdef)
+                   else
+                     hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len,nil);
                  end;
              end;
            realconstn :
@@ -942,7 +948,7 @@ implementation
                                 getmem(sp,2);
                                 sp[0]:=chr(tordconstnode(p).value.svalue);
                                 sp[1]:=#0;
-                                sym:=tconstsym.create_string(orgname,constresourcestring,sp,1);
+                                sym:=tconstsym.create_string(orgname,constresourcestring,sp,1,nil);
                              end
                            else
                              Message(parser_e_illegal_expression);
@@ -952,7 +958,7 @@ implementation
                           begin
                              getmem(sp,len+1);
                              move(value_str^,sp^,len+1);
-                             sym:=tconstsym.create_string(orgname,constresourcestring,sp,len);
+                             sym:=tconstsym.create_string(orgname,constresourcestring,sp,len,nil);
                           end;
                       else
                         Message(parser_e_illegal_expression);

compiler/pexpr.pas

@@ -3112,7 +3112,7 @@ implementation
 
              _CSTRING :
                begin
-                 p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern));
+                 p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern),nil);
                  consume(_CSTRING);
                  if token in postfixoperator_tokens then
                    begin

compiler/pgenutil.pas

@@ -278,7 +278,7 @@ uses
         if assigned(parsedtype) then
           begin
             genericdeflist.Add(parsedtype);
-            specializename:='$'+parsedtype.typename;
+            specializename:='$'+parsedtype.fulltypename;
             prettyname:=parsedtype.typesym.prettyname;
             if assigned(poslist) then
               begin
@@ -315,11 +315,11 @@ uses
                   message(type_e_generics_cannot_reference_itself)
                 else
                   begin
-                    specializename:=specializename+'$'+typeparam.resultdef.typename;
-                    if first then
-                      prettyname:=prettyname+typeparam.resultdef.typesym.prettyname
-                    else
-                      prettyname:=prettyname+','+typeparam.resultdef.typesym.prettyname;
+                    { we use the full name of the type to uniquely identify it }
+                    specializename:=specializename+'$'+typeparam.resultdef.fulltypename;
+                    if not first then
+                      prettyname:=prettyname+',';
+                    prettyname:=prettyname+typeparam.resultdef.fullownerhierarchyname+typeparam.resultdef.typesym.prettyname;
                   end;
               end
             else

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 161;
+  CurrentPPUVersion = 162;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/rgobj.pas

@@ -1274,7 +1274,7 @@ unit rgobj;
         end
       {Next test: is it possible and a good idea to coalesce??}
       else if ((u<first_imaginary) and adjacent_ok(u,v)) or
-              ((u>=first_imaginary) and conservative(u,v)) then
+              conservative(u,v) then
         begin
           m.moveset:=ms_coalesced_moves;  {Move coalesced!}
           coalesced_moves.insert(m);

compiler/symdef.pas

@@ -66,6 +66,8 @@ interface
        { tstoreddef }
 
        tstoreddef = class(tdef)
+       private
+          _fullownerhierarchyname : pshortstring;
        protected
           typesymderef  : tderef;
           procedure fillgenericparas(symtable:tsymtable);
@@ -100,6 +102,7 @@ interface
           function  needs_inittable : boolean;override;
           function  rtti_mangledname(rt:trttitype):string;override;
           function  OwnerHierarchyName: string; override;
+          function  fullownerhierarchyname:string;override;
           function  needs_separate_initrtti:boolean;override;
           function  in_currentunit: boolean;
           { regvars }
@@ -1537,6 +1540,7 @@ implementation
           end;
         genericparas.free;
         genconstraintdata.free;
+        stringdispose(_fullownerhierarchyname);
         inherited destroy;
       end;
 
@@ -1626,6 +1630,36 @@ implementation
         until tmp=nil;
       end;
 
+    function tstoreddef.fullownerhierarchyname: string;
+      var
+        tmp: tdef;
+      begin
+        if assigned(_fullownerhierarchyname) then
+          begin
+            result:=_fullownerhierarchyname^;
+            exit;
+          end;
+        { the def can only reside inside structured types or
+          procedures/functions/methods }
+        tmp:=self;
+        result:='';
+        repeat
+          { can be not assigned in case of a forwarddef }
+          if not assigned(tmp.owner) then
+            break
+          else
+            tmp:=tdef(tmp.owner.defowner);
+          if not assigned(tmp) then
+            break;
+          if tmp.typ in [recorddef,objectdef] then
+            result:=tabstractrecorddef(tmp).objrealname^+'.'+result
+          else
+            if tmp.typ=procdef then
+              result:=tprocdef(tmp).customprocname([pno_paranames,pno_proctypeoption])+'.'+result;
+        until tmp=nil;
+        _fullownerhierarchyname:=stringdup(result);
+      end;
+
 
     function tstoreddef.in_currentunit: boolean;
       var
@@ -1777,6 +1811,8 @@ implementation
                 ispowerof2(recsize,temp) and
                 { sizeof(asizeint)*2 records in int registers is currently broken for endian_big targets }
                 (((recsize <= sizeof(asizeint)*2) and (target_info.endian=endian_little)
+                 { records cannot go into registers on 16 bit targets for now }
+                  and (sizeof(asizeint)>2)
                   and not trecorddef(self).contains_float_field) or
                   (recsize <= sizeof(asizeint)))
                 and not needs_inittable;
@@ -6167,27 +6203,37 @@ implementation
 
 
     function tobjectdef.vmtmethodoffset(index:longint):longint;
+      var
+        codeptrsize: Integer;
       begin
+{$ifdef i8086}
+        if current_settings.x86memorymodel in x86_far_code_models then
+          codeptrsize:=4
+        else
+          codeptrsize:=2;
+{$else i8086}
+        codeptrsize:=sizeof(pint);
+{$endif i8086}
         { for offset of methods for classes, see rtl/inc/objpash.inc }
         case objecttype of
         odt_class:
           { the +2*sizeof(pint) is size and -size }
-          vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
+          vmtmethodoffset:=index*codeptrsize+10*sizeof(pint)+2*sizeof(pint);
         odt_helper,
         odt_objcclass,
         odt_objcprotocol:
           vmtmethodoffset:=0;
         odt_interfacecom,odt_interfacecorba,odt_dispinterface:
-          vmtmethodoffset:=index*sizeof(pint);
+          vmtmethodoffset:=index*codeptrsize;
         odt_javaclass,
         odt_interfacejava:
           { invalid }
           vmtmethodoffset:=-1;
         else
 {$ifdef WITHDMT}
-          vmtmethodoffset:=(index+4)*sizeof(pint);
+          vmtmethodoffset:=index*codeptrsize+4*sizeof(pint);
 {$else WITHDMT}
-          vmtmethodoffset:=(index+3)*sizeof(pint);
+          vmtmethodoffset:=index*codeptrsize+3*sizeof(pint);
 {$endif WITHDMT}
         end;
       end;

compiler/symsym.pas

@@ -312,7 +312,7 @@ interface
           constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef);
           constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef);
           constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);
-          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
+          constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);
           constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -2149,13 +2149,16 @@ implementation
       end;
 
 
-    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
+    constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def: tdef);
       begin
          inherited create(constsym,n);
          fillchar(value, sizeof(value), #0);
          consttyp:=t;
          value.valueptr:=str;
-         constdef:=getarraydef(cansichartype,l);
+         if assigned(def) then
+           constdef:=def
+         else
+           constdef:=getarraydef(cansichartype,l);
          value.len:=l;
       end;
 

compiler/symtype.pas

@@ -68,12 +68,14 @@ interface
          procedure deref;virtual;abstract;
          procedure derefimpl;virtual;abstract;
          function  typename:string;
+         function  fulltypename:string;
          function  GetTypeName:string;virtual;
          function  typesymbolprettyname:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:TSymStr;virtual;
          function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
+         function  fullownerhierarchyname:string;virtual;abstract;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
          function  alignment:shortint;virtual;abstract;
@@ -274,11 +276,21 @@ implementation
           result:=result+GetTypeName;
       end;
 
+    function tdef.fulltypename:string;
+      begin
+        result:=fullownerhierarchyname;
+        if assigned(typesym) and
+           not(typ in [procvardef,procdef]) and
+           (typesym.realname[1]<>'$') then
+          result:=result+typesym.realname
+        else
+          result:=result+GetTypeName;
+      end;
+
 
     function tdef.GetTypeName : string;
       begin
-         GetTypeName:='<unknown type>'
-      end;
+         GetTypeName:='<unknown type>'      end;
 
 
     function tdef.typesymbolprettyname:string;

compiler/systems/t_linux.pas

@@ -1380,20 +1380,6 @@ begin
       Concat('EXESECTION .text');
       Concat('  OBJSECTION .text*');
       Concat('ENDEXESECTION');
-
-      { This is not in standard ld scripts, it is handled by 'orphan section' functionality }
-      Concat('EXESECTION __libc_thread_freeres_fn');
-      Concat('  PROVIDE __start__libc_thread_freeres_fn');
-      Concat('  OBJSECTION __libc_thread_freeres_fn');
-      Concat('  PROVIDE __stop__libc_thread_freeres_fn');
-      Concat('ENDEXESECTION');
-
-      Concat('EXESECTION __libc_freeres_fn');
-      Concat('  PROVIDE __start__libc_freeres_fn');
-      Concat('  OBJSECTION __libc_freeres_fn');
-      Concat('  PROVIDE __stop__libc_freeres_fn');
-      Concat('ENDEXESECTION');
-
       Concat('EXESECTION .fini');
       Concat('  OBJSECTION .fini');
       Concat('  PROVIDE __etext');
@@ -1494,13 +1480,6 @@ begin
       Concat('  SYMBOL _end');
       Concat('ENDEXESECTION');
 
-      { This is not in standard ld scripts, it is handled by 'orphan section' functionality }
-      Concat('EXESECTION __libc_freeres_ptrs');
-      Concat('  PROVIDE __start__libc_freeres_ptrs');
-      Concat('  OBJSECTION __libc_freeres_ptrs');
-      Concat('  PROVIDE __stop__libc_freeres_ptrs');
-      Concat('ENDEXESECTION');
-
       ScriptAddGenericSections('.debug_aranges,.debug_pubnames,.debug_info,'+
          '.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
          '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges');

compiler/utils/ppuutils/ppudump.pp

@@ -1183,7 +1183,10 @@ const
          (mask:pi_has_inherited;
          str:' subroutine contains inherited call '),
          (mask:pi_has_nested_exit;
-         str:' subroutine contains a nested subroutine which calls the exit of the current one ')
+         str:' subroutine contains a nested subroutine which calls the exit of the current one '),
+         (mask:pi_has_stack_allocs;
+         str:' allocates memory on stack, so stack may be unbalanced on exit ')
+         
   );
 var
   procinfooptions : tprocinfoflags;

compiler/x86/cgx86.pas

@@ -117,6 +117,8 @@ unit cgx86;
         procedure g_profilecode(list : TAsmList);override;
         procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
         procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
+        procedure g_save_registers(list: TAsmList); override;
+        procedure g_restore_registers(list: TAsmList); override;
 
         procedure g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef);override;
 
@@ -138,6 +140,7 @@ unit cgx86;
         procedure floatloadops(t : tcgsize;var op : tasmop;var s : topsize);
         procedure floatstoreops(t : tcgsize;var op : tasmop;var s : topsize);
 
+        procedure internal_restore_regs(list: TAsmList; use_pop: boolean);
       end;
 
    const
@@ -2343,11 +2346,6 @@ unit cgx86;
     procedure tcgx86.g_stackpointer_alloc(list : TAsmList;localsize : longint);
 
       procedure decrease_sp(a : tcgint);
-{$ifdef i8086}
-        begin
-          list.concat(Taicpu.Op_const_reg(A_SUB,S_W,a,NR_STACK_POINTER_REG));
-        end;
-{$else i8086}
         var
           href : treference;
         begin
@@ -2355,7 +2353,6 @@ unit cgx86;
           { normally, lea is a better choice than a sub to adjust the stack pointer }
           list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,NR_STACK_POINTER_REG));
         end;
-{$endif i8086}
 
 {$ifdef x86}
 {$ifndef NOTARGETWIN}
@@ -2388,7 +2385,11 @@ unit cgx86;
                else
                  begin
                     current_asmdata.getjumplabel(again);
-                    getcpuregister(list,NR_EDI);
+                    { Using a_reg_alloc instead of getcpuregister, so this procedure
+                      does not change "used_in_proc" state of EDI and therefore can be
+                      called after saving registers with "push" instruction
+                      without creating an unbalanced "pop edi" in epilogue }
+                    a_reg_alloc(list,NR_EDI);
                     list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EDI));
                     list.concat(Taicpu.op_const_reg(A_MOV,S_L,localsize div winstackpagesize,NR_EDI));
                     a_label(list,again);
@@ -2402,7 +2403,7 @@ unit cgx86;
                     decrease_sp(localsize mod winstackpagesize-4);
                     reference_reset_base(href,NR_ESP,localsize-4,4);
                     list.concat(Taicpu.op_ref_reg(A_MOV,S_L,href,NR_EDI));
-                    ungetcpuregister(list,NR_EDI);
+                    a_reg_dealloc(list,NR_EDI);
                  end
              end
            else
@@ -2456,9 +2457,24 @@ unit cgx86;
       var
         stackmisalignment: longint;
         para: tparavarsym;
+        regsize: longint;
 {$ifdef i8086}
         dgroup: treference;
 {$endif i8086}
+
+      procedure push_regs;
+        var
+          r: longint;
+        begin
+          regsize:=0;
+          for r := low(saved_standard_registers) to high(saved_standard_registers) do
+            if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
+              begin
+                inc(regsize,sizeof(aint));
+                list.concat(Taicpu.Op_reg(A_PUSH,tcgsize2opsize[OS_ADDR],newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE)));
+              end;
+        end;
+
       begin
 {$ifdef i8086}
         { interrupt support for i8086 }
@@ -2506,48 +2522,24 @@ unit cgx86;
             stackmisalignment := sizeof(pint);
             list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
             if current_procinfo.framepointer=NR_STACK_POINTER_REG then
-              CGmessage(cg_d_stackframe_omited)
+              begin
+{$ifdef i386}
+                if (not paramanager.use_fixed_stack) then
+                  push_regs;
+{$endif i386}
+                CGmessage(cg_d_stackframe_omited);
+              end
             else
               begin
                 { push <frame_pointer> }
                 inc(stackmisalignment,sizeof(pint));
                 include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG);
                 list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
-                if (target_info.system=system_x86_64_win64) then
-                  begin
-                    list.concat(cai_seh_directive.create_reg(ash_pushreg,NR_FRAME_POINTER_REG));
-                    include(current_procinfo.flags,pi_has_unwind_info);
-                  end;
                 { Return address and FP are both on stack }
                 current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint));
                 current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint)));
-                if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then
-                  list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG))
-                else
-                  begin
-                    { load framepointer from hidden $parentfp parameter }
-                    para:=tparavarsym(current_procinfo.procdef.paras[0]);
-                    if not (vo_is_parentfp in para.varoptions) then
-                      InternalError(201201142);
-                    if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
-                       (para.paraloc[calleeside].location^.next<>nil) then
-                      InternalError(201201143);
-                    list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],
-                      para.paraloc[calleeside].location^.register,NR_FRAME_POINTER_REG));
-                    { Need only as much stack space as necessary to do the calls.
-                      Exception filters don't have own local vars, and temps are 'mapped'
-                      to the parent procedure.
-                      maxpushedparasize is already aligned at least on x86_64. }
-                    localsize:=current_procinfo.maxpushedparasize;
-                  end;
+                list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG));
                 current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG);
-                {
-                  TODO: current framepointer handling is not compatible with Win64 at all:
-                  Win64 expects FP to point to the top or into the middle of local area.
-                  In FPC it points to the bottom, making it impossible to generate
-                  UWOP_SET_FPREG unwind code if local area is > 240 bytes.
-                  So for now pretend we never have a framepointer.
-                }
               end;
 
             { allocate stackframe space }
@@ -2563,17 +2555,65 @@ unit cgx86;
                 if current_procinfo.framepointer=NR_STACK_POINTER_REG then
                   current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint));
                 current_procinfo.final_localsize:=localsize;
-                if (target_info.system=system_x86_64_win64) then
-                  begin
-                    if localsize<>0 then
-                      list.concat(cai_seh_directive.create_offset(ash_stackalloc,localsize));
-                    include(current_procinfo.flags,pi_has_unwind_info);
-                  end;
               end;
+
+{$ifdef i386}
+            if (not paramanager.use_fixed_stack) and
+               (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
+              begin
+                regsize:=0;
+                push_regs;
+                reference_reset_base(current_procinfo.save_regs_ref,
+                  current_procinfo.framepointer,
+                  -(localsize+regsize),sizeof(aint));
+              end;
+{$endif i386}
           end;
       end;
 
 
+    procedure tcgx86.g_save_registers(list: TAsmList);
+      begin
+{$ifdef i386}
+        if paramanager.use_fixed_stack then
+{$endif i386}
+          inherited g_save_registers(list);
+      end;
+
+
+    procedure tcgx86.g_restore_registers(list: TAsmList);
+      begin
+{$ifdef i386}
+        if paramanager.use_fixed_stack then
+{$endif i386}
+          inherited g_restore_registers(list);
+      end;
+
+
+    procedure tcgx86.internal_restore_regs(list: TAsmList; use_pop: boolean);
+      var
+        r: longint;
+        hreg: tregister;
+        href: treference;
+      begin
+        href:=current_procinfo.save_regs_ref;
+        for r:=high(saved_standard_registers) downto low(saved_standard_registers) do
+          if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
+            begin
+              hreg:=newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE);
+              { Allocate register so the optimizer does not remove the load }
+              a_reg_alloc(list,hreg);
+              if use_pop then
+                list.concat(Taicpu.Op_reg(A_POP,tcgsize2opsize[OS_ADDR],hreg))
+              else
+                begin
+                  a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,hreg);
+                  inc(href.offset,sizeof(aint));
+                end;
+            end;
+      end;
+
+
     { produces if necessary overflowcode }
     procedure tcgx86.g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef);
       var

compiler/x86/rax86int.pas

@@ -51,6 +51,7 @@ Unit Rax86int;
          actasmtoken : tasmtoken;
          prevasmtoken : tasmtoken;
          ActOpsize : topsize;
+         inexpression : boolean;
          constructor create;override;
          function is_asmopcode(const s: string):boolean;
          function is_asmoperator(const s: string):boolean;
@@ -129,9 +130,6 @@ Unit Rax86int;
         'and','or','xor','wrt','..gotpcrel'
       );
 
-    var
-      inexpression   : boolean;
-
     constructor tx86intreader.create;
       var
         i : tasmop;

compiler/x86_64/cgcpu.pas

@@ -36,7 +36,7 @@ unit cgcpu;
       tcgx86_64 = class(tcgx86)
         procedure init_register_allocators;override;
 
-        procedure g_proc_entry(list : TAsmList; parasize:longint; nostackframe:boolean);override;
+        procedure g_proc_entry(list : TAsmList;localsize:longint; nostackframe:boolean);override;
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
         procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
         procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
@@ -109,7 +109,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgx86_64.g_proc_entry(list : TAsmList;parasize:longint;nostackframe:boolean);
+    procedure tcgx86_64.g_proc_entry(list : TAsmList;localsize:longint;nostackframe:boolean);
       var
         hitem: tlinkedlistitem;
         r: integer;
@@ -117,13 +117,86 @@ unit cgcpu;
         templist: TAsmList;
         frame_offset: longint;
         suppress_endprologue: boolean;
+        stackmisalignment: longint;
+        para: tparavarsym;
       begin
         hitem:=list.last;
         { pi_has_unwind_info may already be set at this point if there are
           SEH directives in assembler body. In this case, .seh_endprologue
           is expected to be one of those directives, and not generated here. }
         suppress_endprologue:=(pi_has_unwind_info in current_procinfo.flags);
-        inherited g_proc_entry(list,parasize,nostackframe);
+
+        { save old framepointer }
+        if not nostackframe then
+          begin
+            { return address }
+            stackmisalignment := sizeof(pint);
+            list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil));
+            if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+              CGmessage(cg_d_stackframe_omited)
+            else
+              begin
+                { push <frame_pointer> }
+                inc(stackmisalignment,sizeof(pint));
+                list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
+                if (target_info.system=system_x86_64_win64) then
+                  begin
+                    list.concat(cai_seh_directive.create_reg(ash_pushreg,NR_FRAME_POINTER_REG));
+                    include(current_procinfo.flags,pi_has_unwind_info);
+                  end;
+                { Return address and FP are both on stack }
+                current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint));
+                current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint)));
+                if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then
+                  list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG))
+                else
+                  begin
+                    { load framepointer from hidden $parentfp parameter }
+                    para:=tparavarsym(current_procinfo.procdef.paras[0]);
+                    if not (vo_is_parentfp in para.varoptions) then
+                      InternalError(201201142);
+                    if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or
+                       (para.paraloc[calleeside].location^.next<>nil) then
+                      InternalError(201201143);
+                    list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],
+                      para.paraloc[calleeside].location^.register,NR_FRAME_POINTER_REG));
+                    { Need only as much stack space as necessary to do the calls.
+                      Exception filters don't have own local vars, and temps are 'mapped'
+                      to the parent procedure.
+                      maxpushedparasize is already aligned at least on x86_64. }
+                    localsize:=current_procinfo.maxpushedparasize;
+                  end;
+                current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG);
+                {
+                  TODO: current framepointer handling is not compatible with Win64 at all:
+                  Win64 expects FP to point to the top or into the middle of local area.
+                  In FPC it points to the bottom, making it impossible to generate
+                  UWOP_SET_FPREG unwind code if local area is > 240 bytes.
+                  So for now pretend we never have a framepointer.
+                }
+              end;
+
+            { allocate stackframe space }
+            if (localsize<>0) or
+               ((target_info.stackalign>sizeof(pint)) and
+                (stackmisalignment <> 0) and
+                ((pi_do_call in current_procinfo.flags) or
+                 (po_assembler in current_procinfo.procdef.procoptions))) then
+              begin
+                if target_info.stackalign>sizeof(pint) then
+                  localsize := align(localsize+stackmisalignment,target_info.stackalign)-stackmisalignment;
+                cg.g_stackpointer_alloc(list,localsize);
+                if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+                  current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint));
+                current_procinfo.final_localsize:=localsize;
+                if (target_info.system=system_x86_64_win64) then
+                  begin
+                    if localsize<>0 then
+                      list.concat(cai_seh_directive.create_offset(ash_stackalloc,localsize));
+                    include(current_procinfo.flags,pi_has_unwind_info);
+                  end;
+               end;
+          end;
 
         if not (pi_has_unwind_info in current_procinfo.flags) then
           exit;

compiler/x86_64/cpuelf.pas

@@ -35,7 +35,8 @@ implementation
   type
     TElfExeOutputx86_64=class(TElfExeOutput)
     private
-      procedure MaybeWriteGOTEntry(reltyp:byte;relocval:aint;objsym:TObjSymbol);
+      procedure MaybeWriteGOTEntry(relocval:aint;objsym:TObjSymbol);
+      procedure MaybeWriteTLSIEGotEntry(relocval:aint;objsym:TObjSymbol);
     protected
       procedure WriteFirstPLTEntry;override;
       procedure WritePLTEntry(exesym:TExeSymbol);override;
@@ -260,7 +261,7 @@ implementation
             ReportNonDSOReloc(reltyp,objsec,objreloc);
 
         { R_X86_64_32 is processed by rtld, but binutils accept it in data sections only.
-          Relocating the against local symbols is tricky: changing into RELATIVE is not possible,
+          Relocating against local symbols is tricky: changing into RELATIVE is not possible,
           so it is changed into relocation against section symbol. This requires adding
           the appropriate section symbol to dynamic symtable. BFD also has some obscure logic
           behind, e.g. it uses .text section for symbols from .data section.
@@ -320,7 +321,7 @@ implementation
     end;
 
 
-  procedure TElfExeOutputx86_64.MaybeWriteGOTEntry(reltyp:byte;relocval:aint;objsym:TObjSymbol);
+  procedure TElfExeOutputx86_64.MaybeWriteGOTEntry(relocval:aint;objsym:TObjSymbol);
     var
       gotoff,tmp:aword;
     begin
@@ -334,18 +335,43 @@ implementation
         begin
           gotobjsec.write(relocval,sizeof(pint));
 
+          tmp:=gotobjsec.mempos+gotoff-sizeof(pint);
+          if (objsym.exesymbol.dynindex>0) then
+            dynreloclist.Add(TObjRelocation.CreateRaw(tmp,objsym,R_X86_64_GLOB_DAT))
+          else
+            if IsSharedLibrary then
+              WriteDynRelocEntry(tmp,R_X86_64_RELATIVE,0,relocval);
+        end;
+    end;
+
+
+  procedure TElfExeOutputx86_64.MaybeWriteTLSIEGotEntry(relocval:aint;objsym:TObjSymbol);
+    var
+      gotoff,tmp: aword;
+      objrel: TObjRelocation;
+    begin
+      gotoff:=objsym.exesymbol.gotoffset;
+      if gotoff=0 then
+        InternalError(2012060903);
+
+      if gotoff=gotobjsec.Data.size+sizeof(pint) then
+        begin
           tmp:=gotobjsec.mempos+gotoff-sizeof(pint);
           if (objsym.exesymbol.dynindex>0) then
             begin
-              if (reltyp=R_X86_64_GOTTPOFF) then
-                if IsSharedLibrary then
-                  dynreloclist.Add(TObjRelocation.CreateRaw(tmp,objsym,R_X86_64_TPOFF64)) // probably incorrect
-                else
-              else
-                dynreloclist.Add(TObjRelocation.CreateRaw(tmp,objsym,R_X86_64_GLOB_DAT));
+              gotobjsec.writezeros(sizeof(pint));
+              dynreloclist.Add(TObjRelocation.CreateRaw(tmp,objsym,R_X86_64_TPOFF64));
             end
-          else if IsSharedLibrary then
-            WriteDynRelocEntry(tmp,R_X86_64_RELATIVE,0,relocval);
+          else
+            begin
+              gotobjsec.write(relocval,sizeof(pint));
+              if IsSharedLibrary then
+                begin
+                  objrel:=TObjRelocation.CreateRaw(tmp,nil,R_X86_64_TPOFF64);
+                  objrel.orgsize:=relocval;
+                  dynreloclist.Add(objrel);
+                end;
+            end;
         end;
     end;
 
@@ -434,8 +460,8 @@ implementation
               //R_X86_64_DTPOFF64 is possible in data??
               R_X86_64_DTPOFF32:
                 begin
-                  { In executable it behaves as TPOFF32, but data expressions
-                    like ".long foo@dtpoff" resolve to positive offset }
+                  { In executable it behaves as TPOFF32 (i.e. generates negative offset),
+                    but data expressions like ".long foo@dtpoff" resolve to positive offset }
                   if IsSharedLibrary or not (oso_executable in objsec.SecOptions) then
                     address:=address+relocval-tlsseg.MemPos
                   else
@@ -446,14 +472,24 @@ implementation
               R_X86_64_TPOFF64:
                 address:=address+relocval-(tlsseg.MemPos+tlsseg.MemSize);
 
-              R_X86_64_GOTTPOFF,
-              R_X86_64_GOTPCREL,
-              R_X86_64_GOTPCREL64:
+              R_X86_64_GOTTPOFF:
                 begin
-                  if (reltyp=R_X86_64_GOTTPOFF) then
+                  if IsSharedLibrary then
+                    relocval:=relocval-tlsseg.MemPos
+                  else
                     relocval:=relocval-(tlsseg.MemPos+tlsseg.MemSize);
 
-                  MaybeWriteGOTEntry(reltyp,relocval,objreloc.symbol);
+                  MaybeWriteTLSIEGotEntry(relocval,objreloc.symbol);
+
+                  { resolves to PC-relative offset to GOT slot }
+                  relocval:=gotobjsec.mempos+objreloc.symbol.exesymbol.gotoffset-sizeof(pint);
+                  address:=address+relocval-PC;
+                end;
+
+              R_X86_64_GOTPCREL,
+              R_X86_64_GOTPCREL64:
+                begin
+                  MaybeWriteGOTEntry(relocval,objreloc.symbol);
 
                   { resolves to PC-relative offset to GOT slot }
                   relocval:=gotobjsec.mempos+objreloc.symbol.exesymbol.gotoffset-sizeof(pint);
@@ -488,7 +524,7 @@ implementation
               R_X86_64_GOT32,
               R_X86_64_GOT64:
                 begin
-                  MaybeWriteGOTEntry(reltyp,relocval,objreloc.symbol);
+                  MaybeWriteGOTEntry(relocval,objreloc.symbol);
 
                   relocval:=gotobjsec.mempos+objreloc.symbol.exesymbol.gotoffset-sizeof(pint)-gotsymbol.address;
                   address:=address+relocval;

compiler/x86_64/cpupi.pas

@@ -69,7 +69,8 @@ implementation
           begin
             { Fixes the case when there are calls done by low-level means
               (cg.a_call_name) but no child callnode }
-            if (pi_do_call in flags) then
+            if (pi_do_call in flags) and
+              not (po_nostackframe in procdef.procoptions) then
               allocate_push_parasize(32);
 
             if not(po_assembler in procdef.procoptions) and

ide/fpmake.pp

@@ -96,10 +96,14 @@ begin
                         end;
               freebsd : begin
                           P.Options.Add('-Fl/usr/local/lib');
-                          P.Options.Add('Xd');
+                          P.Options.Add('-Xd');
                         end;
-              openbsd : P.Options.Add('-Fl/usr/local/lib');
-              netbsd  : P.Options.Add('Xd');
+              openbsd : begin
+                          P.Options.Add('-Fl/usr/local/lib');
+                          P.Options.Add('-Xd');
+                        end;
+              netbsd  : P.Options.Add('-Xd');
+              linux   : P.Options.Add('-Xd');
             end; {case}
 
             P.NeedLibc := true;

packages/bzip2/fpmake.pp

@@ -28,7 +28,7 @@ begin
     P.Email := '';
     P.Description := 'BZip2 decompression unit.';
     P.NeedLibC:= true;
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/chm/fpmake.pp

@@ -25,7 +25,7 @@ begin
     P.Email := '';
     P.Description := 'Standalone CHM reader and writer library';
     P.NeedLibC:= false;
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     D:=P.Dependencies.Add('fcl-xml');
     D:=P.Dependencies.Add('fcl-base');

packages/fcl-base/fpmake.pp

@@ -25,7 +25,7 @@ begin
     P.Email := '';
     P.Description := 'Base library of Free Component Libraries(FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.SourcePath.Add('src/$(OS)');

packages/fcl-base/src/contnrs.pp

@@ -190,9 +190,15 @@ type
   PHashItem=^THashItem;
 
 const
+{$ifdef CPU16}
+  MaxHashListSize = maxsmallint div 16;
+  MaxHashStrSize  = maxsmallint;
+  MaxHashTableSize = maxsmallint div 4;
+{$else CPU16}
   MaxHashListSize = Maxint div 16;
   MaxHashStrSize  = Maxint;
   MaxHashTableSize = Maxint div 4;
+{$endif CPU16}
   MaxItemsPerHash = 3;
 
 type
@@ -2258,7 +2264,7 @@ begin
   if Assigned(N) then
     Result:=N.Data
   else
-    Result:=Nil;  
+    Result:=Nil;
 end;
 
 function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): THTDataNode;
@@ -2347,7 +2353,7 @@ begin
   if Assigned(N) then
     Result:=N.Data
   else
-    Result:='';  
+    Result:='';
 end;
 
 function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): THTStringNode;
@@ -2433,7 +2439,7 @@ begin
   if Assigned(N) then
     Result:=N.Data
   else
-    Result:=Nil;  
+    Result:=Nil;
 end;
 
 function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode;

packages/fcl-db/fpmake.pp

@@ -32,7 +32,7 @@ begin
     P.Email := '';
     P.Description := 'Database library of Free Component Libraries(FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.Directory:=ADirectory;
     P.Version:='2.7.1';

packages/fcl-db/src/base/dataset.inc

@@ -52,10 +52,10 @@ begin
   Active:=False;
   FFieldDefs.Free;
   FFieldList.Free;
-  With FDatasources do
+  With FDataSources do
     begin
     While Count>0 do
-      TDatasource(Items[Count - 1]).DataSet:=Nil;
+      TDataSource(Items[Count - 1]).DataSet:=Nil;
     Free;
     end;
   for i := 0 to FBufferCount do
@@ -174,7 +174,7 @@ Procedure TDataset.ClearBuffers;
 
 begin
   FRecordCount:=0;
-  FactiveRecord:=0;
+  FActiveRecord:=0;
   FCurrentRecord:=-1;
   FBOF:=True;
   FEOF:=True;
@@ -408,10 +408,10 @@ begin
 {$ifdef dsdebug}
   Writeln ('Calling RecalcBufListSize');
 {$endif}
-  FRecordcount := 0;
+  FRecordCount := 0;
   RecalcBufListSize;
-  FBOF:=True;
-  FEOF := (FRecordcount = 0);
+  FBOF := True;
+  FEOF := (FRecordCount = 0);
 end;
 
 Procedure TDataset.DoOnCalcFields;
@@ -759,18 +759,18 @@ begin
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
 {$endif}
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
-  Result:=GetRecord(FBuffers[FBuffercount],gmNext,True)=grOK;
+  Result:=GetRecord(FBuffers[FBufferCount],gmNext,True)=grOK;
 
   if result then
     begin
       If FRecordCount=0 then ActivateBuffers;
-      if FRecordcount=FBuffercount then
-        shiftbuffersbackward
+      if FRecordCount=FBufferCount then
+        ShiftBuffersBackward
       else
         begin
           inc(FRecordCount);
           FCurrentRecord:=FRecordCount - 1;
-          ExchangeBuffers(Fbuffers[FCurrentRecord],FBuffers[FBuffercount]);
+          ExchangeBuffers(FBuffers[FCurrentRecord],FBuffers[FBufferCount]);
         end;
     end
   else
@@ -802,13 +802,13 @@ begin
 {$endif}
   CheckBiDirectional;
   If FRecordCount>0 Then SetCurrentRecord(0);
-  Result:=GetRecord(FBuffers[FBuffercount],gmPrior,True)=grOK;
+  Result:=GetRecord(FBuffers[FBufferCount],gmPrior,True)=grOK;
   if result then
     begin
       If FRecordCount=0 then ActivateBuffers;
-      shiftbuffersforward;
+      ShiftBuffersForward;
 
-      if FRecordcount<FBuffercount then
+      if FRecordCount<FBufferCount then
         inc(FRecordCount);
     end
   else
@@ -825,7 +825,7 @@ begin
 {$ifdef dsdebug}
   Writeln ('Getting previous record(s), need :',FBufferCount);
 {$endif}
-  While (FRecordCount<FbufferCount) and GetPriorRecord do
+  While (FRecordCount<FBufferCount) and GetPriorRecord do
     Inc(Result);
 end;
 
@@ -1124,7 +1124,11 @@ begin
 {$ifdef dsdebug}
   Writeln('Recalculating buffer list size');
 {$endif}
-  ABufferCount := DefaultBufferCount;
+  if IsUniDirectional then
+    ABufferCount := 1
+  else
+    ABufferCount := DefaultBufferCount;
+
   for i := 0 to FDataSources.Count - 1 do
     for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
       begin
@@ -1217,8 +1221,8 @@ begin
     if (value > -1) and (FActiveRecord>Value-1) then
       begin
       for i := 0 to (FActiveRecord-Value) do
-        shiftbuffersbackward;
-      FActiverecord := Value -1;
+        ShiftBuffersBackward;
+      FActiveRecord := Value -1;
       end;
 
     If Assigned(FBuffers) then
@@ -1238,7 +1242,7 @@ begin
   FBufferCount:=Value;
   If Value=-1 then
     Value:=0;
-  if FRecordcount > Value then FRecordcount := Value;
+  if FRecordCount > Value then FRecordCount := Value;
 {$ifdef dsdebug}
   Writeln ('   SetBufListSize: Final FBufferCount=',FBufferCount);
 {$endif}
@@ -1457,11 +1461,11 @@ begin
     UpdateCursorPos;
     InternalCancel;
     FreeFieldBuffers;
-    if (state = dsInsert) and (FRecordcount = 1) then
+    if (State = dsInsert) and (FRecordCount = 1) then
       begin
       FEOF := true;
       FBOF := true;
-      FRecordcount := 0;
+      FRecordCount := 0;
       InitRecord(ActiveBuffer);
       SetState(dsBrowse);
       DataEvent(deDatasetChange,0);
@@ -1469,7 +1473,7 @@ begin
     else
       begin
       SetState(dsBrowse);
-      SetCurrentRecord(FActiverecord);
+      SetCurrentRecord(FActiveRecord);
       resync([]);
       end;
     DoAfterCancel;
@@ -1482,7 +1486,7 @@ begin
   CheckActive;
   DataEvent(deCheckBrowseMode,0);
   Case State of
-    dsedit,dsinsert: begin
+    dsEdit,dsInsert: begin
       UpdateRecord;
       If Modified then Post else Cancel;
     end;
@@ -1553,7 +1557,7 @@ begin
 {$ifdef dsdebug}
     writeln ('Delete: Browse mode set');
 {$endif}
-    SetCurrentRecord(FActiverecord);
+    SetCurrentRecord(FActiveRecord);
     Resync([]);
     DoAfterDelete;
     DoAfterScroll;
@@ -1586,20 +1590,20 @@ Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
   begin
   // need to scroll up al buffers after current one,
   // but copy current bookmark to insert buffer.
-  If FRecordcount > 0 then
+  If FRecordCount > 0 then
     BookBeforeInsert:=Bookmark;
 
   if not DoAppend then
     begin
     if FRecordCount > 0 then
       begin
-      TempBuf := FBuffers[FBuffercount];
-      move(FBuffers[FActiveRecord],FBuffers[FActiveRecord+1],(Fbuffercount-FActiveRecord)*sizeof(FBuffers[0]));
+      TempBuf := FBuffers[FBufferCount];
+      move(FBuffers[FActiveRecord],FBuffers[FActiveRecord+1],(FBufferCount-FActiveRecord)*sizeof(FBuffers[0]));
       FBuffers[FActiveRecord]:=TempBuf;
       end;
     end
-  else if FRecordcount=FBuffercount then
-    shiftbuffersbackward
+  else if FRecordCount=FBufferCount then
+    ShiftBuffersBackward
   else
     begin
     if FRecordCount>0 then
@@ -1621,7 +1625,7 @@ Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
 
     // 1-apr-06, JvdS: It just sets the bookmark of the newly inserted record to the place
     // where the record should be inserted. So it is ok.
-    if FRecordcount > 0 then
+    if FRecordCount > 0 then
       begin
       SetBookMarkData(ActiveBuffer,pointer(BookBeforeInsert));
       FreeBookmark(BookBeforeInsert);
@@ -1667,7 +1671,7 @@ begin
   try
     DoOnNewRecord;
   except
-    SetCurrentRecord(FActiverecord);
+    SetCurrentRecord(FActiveRecord);
     resync([]);
     raise;
   end;
@@ -1685,7 +1689,7 @@ end;
 Procedure TDataset.Edit;
 
 begin
-  If State in [dsedit,dsinsert] then exit;
+  If State in [dsEdit,dsInsert] then exit;
   CheckBrowseMode;
   If Not CanModify then
     DatabaseError(SDatasetReadOnly,Self);
@@ -1697,7 +1701,7 @@ begin
   DoBeforeEdit;
   If Not TryDoing(@InternalEdit,OnEditError) then exit;
   GetCalcFields(ActiveBuffer);
-  SetState(dsedit);
+  SetState(dsEdit);
   DataEvent(deRecordChange,0);
   DoAfterEdit;
 end;
@@ -1873,7 +1877,7 @@ Function TDataset.IsEmpty: Boolean;
 
 begin
   Result:=(fBof and fEof) and
-          (not (state = dsinsert)); // After an insert on an empty dataset, both fBof and fEof are true
+          (not (State = dsInsert)); // After an insert on an empty dataset, both fBof and fEof are true
 end;
 
 Function TDataset.IsLinkedTo(ADataSource: TDataSource): Boolean;
@@ -1919,8 +1923,7 @@ Function TDataset.MoveBy(Distance: Longint): Longint;
 Var
   TheResult: Integer;
 
-  Function Scrollforward : Integer;
-
+  Function ScrollForward : Integer;
   begin
     Result:=0;
 {$ifdef dsdebug}
@@ -1954,8 +1957,8 @@ Var
         end;
       end
   end;
-  Function ScrollBackward : Integer;
 
+  Function ScrollBackward : Integer;
   begin
     CheckBiDirectional;
     Result:=0;
@@ -2083,15 +2086,15 @@ begin
   InternalRefresh;
 { SetCurrentRecord is called by UpdateCursorPos already, so as long as
   InternalRefresh doesn't do strange things this should be ok. }
-//  SetCurrentRecord(FActiverecord);
+//  SetCurrentRecord(FActiveRecord);
   Resync([]);
   DoAfterRefresh;
 end;
 
-Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
+Procedure TDataset.RegisterDataSource(ADataSource : TDataSource);
 
 begin
-  FDatasources.Add(ADataSource);
+  FDataSources.Add(ADataSource);
   RecalcBufListSize;
 end;
 
@@ -2107,16 +2110,16 @@ begin
 {$endif}
   if FIsUnidirectional then Exit;
 // place the cursor of the underlying dataset to the active record
-//  SetCurrentRecord(FActiverecord);
+//  SetCurrentRecord(FActiveRecord);
 
 // Now look if the data on the current cursor of the underlying dataset is still available
-  If GetRecord(Fbuffers[0],gmcurrent,False)<>grOk Then
+  If GetRecord(FBuffers[0],gmCurrent,False)<>grOk Then
 // If that fails and rmExact is set, then raise an exception
     If rmExact in Mode then
       DatabaseError(SNoSuchRecord,Self)
 // else, if rmexact is not set, try to fetch the next  or prior record in the underlying dataset
-    else if (GetRecord(Fbuffers[0],gmnext,True)<>grOk) and
-            (GetRecord(Fbuffers[0],gmprior,True)<>grOk) then
+    else if (GetRecord(FBuffers[0],gmNext,True)<>grOk) and
+            (GetRecord(FBuffers[0],gmPrior,True)<>grOk) then
       begin
 {$ifdef dsdebug}
       Writeln ('Resync: fuzzy resync');
@@ -2138,7 +2141,7 @@ begin
   else
     count := FActiveRecord;
   i := 0;
-  FRecordcount := 1;
+  FRecordCount := 1;
   FActiveRecord := 0;
 
 // Fill the buffers before the active record
@@ -2148,7 +2151,7 @@ begin
 // Fill the rest of the buffer
   getnextrecords;
 // If the buffer is not full yet, try to fetch some more prior records
-  if FRecordcount < FBuffercount then inc(FActiverecord,getpriorrecords);
+  if FRecordCount < FBufferCount then inc(FActiveRecord,getpriorrecords);
 // That's all folks!
   DataEvent(deDatasetChange,0);
 end;
@@ -2213,7 +2216,7 @@ Procedure TDataset.UpdateCursorPos;
 
 begin
   If FRecordCount>0 then
-    SetCurrentRecord(FactiveRecord);
+    SetCurrentRecord(FActiveRecord);
 end;
 
 Procedure TDataset.UpdateRecord;
@@ -2253,8 +2256,8 @@ var TempBuf : pointer;
 
 begin
   TempBuf := FBuffers[0];
-  move(FBuffers[1],FBuffers[0],(fbuffercount)*sizeof(FBuffers[0]));
-  FBuffers[buffercount]:=TempBuf;
+  move(FBuffers[1],FBuffers[0],(FBufferCount)*sizeof(FBuffers[0]));
+  FBuffers[BufferCount]:=TempBuf;
 end;
 
 Procedure TDataset.ShiftBuffersForward;
@@ -2263,11 +2266,11 @@ var TempBuf : pointer;
 
 begin
   TempBuf := FBuffers[FBufferCount];
-  move(FBuffers[0],FBuffers[1],(fbuffercount)*sizeof(FBuffers[0]));
+  move(FBuffers[0],FBuffers[1],(FBufferCount)*sizeof(FBuffers[0]));
   FBuffers[0]:=TempBuf;
 end;
 
-function TDataset.GetFieldValues(const Fieldname: string): Variant;
+function TDataset.GetFieldValues(const FieldName: string): Variant;
 
 var i: Integer;
     FieldList: TList;
@@ -2320,7 +2323,7 @@ begin
 end;
 
 
-Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
+Procedure TDataset.UnRegisterDataSource(ADataSource : TDataSource);
 
 begin
   FDataSources.Remove(ADataSource);

packages/fcl-db/src/base/dsparams.inc

@@ -418,7 +418,7 @@ begin
   end
   else
     NewQuery:=SQL;
-    
+
   Result := NewQuery;
 end;
 
@@ -607,84 +607,84 @@ end;
 
 Procedure TParam.SetAsBlob(const AValue: TBlobData);
 begin
-  Value:=AValue;
   FDataType:=ftBlob;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsBoolean(AValue: Boolean);
 begin
-  Value:=AValue;
   FDataType:=ftBoolean;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsCurrency(const AValue: Currency);
 begin
-  Value:=Avalue;
   FDataType:=ftCurrency;
+  Value:=Avalue;
 end;
 
 Procedure TParam.SetAsDate(const AValue: TDateTime);
 begin
-  Value:=Avalue;
   FDataType:=ftDate;
+  Value:=Avalue;
 end;
 
 Procedure TParam.SetAsDateTime(const AValue: TDateTime);
 begin
-  Value:=AValue;
   FDataType:=ftDateTime;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsFloat(const AValue: Double);
 begin
-  Value:=AValue;
   FDataType:=ftFloat;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsInteger(AValue: Longint);
 begin
-  Value:=AValue;
   FDataType:=ftInteger;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsLargeInt(AValue: LargeInt);
 begin
-  Value:=AValue;
   FDataType:=ftLargeint;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsMemo(const AValue: string);
 begin
-  Value:=AValue;
   FDataType:=ftMemo;
+  Value:=AValue;
 end;
 
 
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 begin
-  Value:=AValue;
   FDataType:=ftSmallInt;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsString(const AValue: string);
 begin
-  Value:=AValue;
   if FDataType <> ftFixedChar then
     FDataType := ftString;
+  Value:=AValue;
 end;
 
 procedure TParam.SetAsWideString(const aValue: WideString);
 begin
-  Value := aValue;
   if FDataType <> ftFixedWideChar then
     FDataType := ftWideString;
+  Value := aValue;
 end;
 
 
 Procedure TParam.SetAsTime(const AValue: TDateTime);
 begin
-  Value:=AValue;
   FDataType:=ftTime;
+  Value:=AValue;
 end;
 
 Procedure TParam.SetAsVariant(const AValue: Variant);
@@ -720,14 +720,14 @@ end;
 
 Procedure TParam.SetAsWord(AValue: LongInt);
 begin
-  Value:=AValue;
   FDataType:=ftWord;
+  Value:=AValue;
 end;
 
 procedure TParam.SetAsFMTBCD(const AValue: TBCD);
 begin
-  FValue:=VarFmtBCDCreate(AValue);
   FDataType:=ftFMTBcd;
+  FValue:=VarFmtBCDCreate(AValue);
 end;
 
 Procedure TParam.SetDataType(AValue: TFieldType);
@@ -1095,7 +1095,7 @@ Var
   I : Integer;
   P : TParam;
   F : TField;
-  
+
 begin
   If (ADataSet<>Nil) then
     For I:=0 to Count-1 do

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -15,19 +15,33 @@ uses
 {$EndIf}
 
 type
+  TPQCursor = Class;
+
+  { TPQTrans }
+
   TPQTrans = Class(TSQLHandle)
-    protected
+  protected
     PGConn        : PPGConn;
+    FList : TThreadList;
+    Procedure RegisterCursor(S : TPQCursor);
+    Procedure UnRegisterCursor(S : TPQCursor);
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
   end;
 
+  { TPQCursor }
+
   TPQCursor = Class(TSQLCursor)
-    protected
+  protected
     Statement    : string;
     StmtName     : string;
     tr           : TPQTrans;
     res          : PPGresult;
     CurTuple     : integer;
     FieldBinding : array of integer;
+   Public
+    Destructor Destroy; override;
   end;
 
   EPQDatabaseError = class(EDatabaseError)
@@ -50,7 +64,7 @@ type
 
   TPQConnection = class (TSQLConnection)
   private
-    FConnectionPool      : array of TPQTranConnection;
+    FConnectionPool      : TThreadList;
     FCursorCount         : dword;
     FConnectString       : string;
     FIntegerDateTimes    : boolean;
@@ -60,6 +74,11 @@ type
     function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
   protected
+    // Add connection to pool.
+    procedure AddConnection(T: TPQTranConnection);
+    // Release connection in pool.
+    procedure ReleaseConnection(Conn: PPGConn; DoClear : Boolean);
+
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
     function GetHandle : pointer; override;
@@ -86,6 +105,7 @@ type
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
     constructor Create(AOwner : TComponent); override;
+    destructor destroy; override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     procedure CreateDB; override;
     procedure DropDB; override;
@@ -152,6 +172,53 @@ const Oid_Bool     = 16;
       oid_numeric   = 1700;
       Oid_uuid      = 2950;
 
+{ TPQTrans }
+
+procedure TPQTrans.RegisterCursor(S: TPQCursor);
+begin
+  FList.Add(S);
+  S.tr:=Self;
+end;
+
+procedure TPQTrans.UnRegisterCursor(S: TPQCursor);
+begin
+  S.tr:=Nil;
+  FList.Remove(S);
+end;
+
+constructor TPQTrans.Create;
+begin
+  Flist:=TThreadList.Create;
+  FList.Duplicates:=dupIgnore;
+end;
+
+destructor TPQTrans.Destroy;
+
+Var
+  L : TList;
+  I : integer;
+
+begin
+  L:=Flist.LockList;
+  try
+    For I:=0 to L.Count-1 do
+      TPQCursor(L[i]).tr:=Nil;
+  finally
+    Flist.UnlockList;
+  end;
+  FreeAndNil(FList);
+  inherited Destroy;
+end;
+
+{ TPQCursor }
+
+destructor TPQCursor.Destroy;
+begin
+  if Assigned(tr) then
+    Tr.UnRegisterCursor(Self);
+  inherited Destroy;
+end;
+
 
 constructor TPQConnection.Create(AOwner : TComponent);
 
@@ -160,6 +227,15 @@ begin
   FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat] + [sqEscapeSlash];
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
+  FConnectionPool:=TThreadlist.Create;
+end;
+
+destructor TPQConnection.destroy;
+begin
+  // We must disconnect here. If it is done in inherited, then connection pool is gone.
+  Connected:=False;
+  FreeAndNil(FConnectionPool);
+  inherited destroy;
 end;
 
 procedure TPQConnection.CreateDB;
@@ -174,7 +250,7 @@ begin
   ExecuteDirectPG('DROP DATABASE ' +DatabaseName);
 end;
 
-procedure TPQConnection.ExecuteDirectPG(const query : string);
+procedure TPQConnection.ExecuteDirectPG(const Query: String);
 
 var ASQLDatabaseHandle    : PPGConn;
     res                   : PPGresult;
@@ -207,6 +283,39 @@ begin
 {$EndIf}
 end;
 
+procedure TPQConnection.AddConnection(T: TPQTranConnection);
+
+begin
+  FConnectionPool.Add(T);
+end;
+
+procedure TPQConnection.ReleaseConnection(Conn: PPGConn; DoClear: Boolean);
+
+Var
+  I : Integer;
+  L : TList;
+  T : TPQTranConnection;
+
+begin
+  L:=FConnectionPool.LockList;
+  // make connection available in pool
+  try
+    for i:=0 to L.Count-1 do
+      begin
+      T:=TPQTranConnection(L[i]);
+      if (T.FPGConn=Conn) then
+        begin
+        T.FTranActive:=false;
+        if DoClear then
+          T.FPGConn:=Nil;
+        break;
+        end;
+      end
+  finally
+    FConnectionPool.UnlockList;
+  end;
+end;
+
 
 function TPQConnection.GetTransactionHandle(trans : TSQLHandle): pointer;
 begin
@@ -218,23 +327,26 @@ var
   res : PPGresult;
   tr  : TPQTrans;
   i   : Integer;
+  L   : TList;
+
 begin
   result := false;
-
   tr := trans as TPQTrans;
-
+  L:=tr.FList.LockList;
+  try
+    For I:=0 to L.Count-1 do
+      begin
+      UnprepareStatement(TPQCursor(L[i]));
+      TPQCursor(L[i]).tr:=Nil;
+      end;
+    L.Clear;
+  finally
+    tr.flist.UnlockList;
+  end;
   res := PQexec(tr.PGConn, 'ROLLBACK');
-
   CheckResultError(res,tr.PGConn,SErrRollbackFailed);
-
   PQclear(res);
-  //make connection available in pool
-  for i:=0 to length(FConnectionPool)-1 do
-    if FConnectionPool[i].FPGConn=tr.PGConn then
-      begin
-      FConnectionPool[i].FTranActive:=false;
-      break;
-      end;
+  ReleaseConnection(tr.PGCOnn,false);
   result := true;
 end;
 
@@ -245,20 +357,12 @@ var
   i   : Integer;
 begin
   result := false;
-
   tr := trans as TPQTrans;
-
   res := PQexec(tr.PGConn, 'COMMIT');
   CheckResultError(res,tr.PGConn,SErrCommitFailed);
-
   PQclear(res);
   //make connection available in pool
-  for i:=0 to length(FConnectionPool)-1 do
-    if FConnectionPool[i].FPGConn=tr.PGConn then
-      begin
-      FConnectionPool[i].FTranActive:=false;
-      break;
-      end;
+  ReleaseConnection(tr.PGConn,false);
   result := true;
 end;
 
@@ -267,35 +371,47 @@ var
   res : PPGresult;
   tr  : TPQTrans;
   i   : Integer;
+  t : TPQTranConnection;
+  L : TList;
 begin
   result:=false;
   tr := trans as TPQTrans;
 
   //find an unused connection in the pool
   i:=0;
-  while i<length(FConnectionPool) do
-    if (FConnectionPool[i].FPGConn=nil) or not FConnectionPool[i].FTranActive then
-      break
-    else
+  t:=Nil;
+  L:=FConnectionPool.LockList;
+  try
+    while (I<L.Count-1) do
+      begin
+      T:=TPQTranConnection(L[i]);
+      if (T.FPGConn=nil) or not T.FTranActive then
+        break
+      else
+        T:=Nil;
       i:=i+1;
-  if i=length(FConnectionPool) then //create a new connection
+      end;
+    // set to active now, so when we exit critical section,
+    // it will be marked active and will not be found.
+    if Assigned(T) then
+      T.FTranActive:=true;
+  finally
+    FConnectionPool.UnLockList;
+  end;
+  if (T=Nil) then
+    begin
+    T:=TPQTranConnection.Create;
+    T.FTranActive:=True;
+    AddConnection(T);
+    end;
+  if (T.FPGConn<>nil) then
+    tr.PGConn:=T.FPGConn
+  else
     begin
     tr.PGConn := PQconnectdb(pchar(FConnectString));
     CheckConnectionStatus(tr.PGConn);
-
     if CharSet <> '' then
       PQsetClientEncoding(tr.PGConn, pchar(CharSet));
-
-    //store the new connection
-    SetLength(FConnectionPool,i+1);
-    FConnectionPool[i]:=TPQTranConnection.Create;
-    FConnectionPool[i].FPGConn:=tr.PGConn;
-    FConnectionPool[i].FTranActive:=true;
-    end
-  else //re-use existing connection
-    begin
-    tr.PGConn:=FConnectionPool[i].FPGConn;
-    FConnectionPool[i].FTranActive:=true;
     end;
 
   res := PQexec(tr.PGConn, 'BEGIN');
@@ -339,7 +455,10 @@ end;
 
 
 procedure TPQConnection.DoInternalConnect;
-var ASQLDatabaseHandle   : PPGConn;
+var
+  ASQLDatabaseHandle   : PPGConn;
+  T : TPQTranConnection;
+
 begin
 {$IfDef LinkDynamically}
   InitialisePostgres3;
@@ -365,24 +484,33 @@ begin
   // This only works for pg>=8.0, so timestamps won't work with earlier versions of pg which are compiled with integer_datetimes on
   if PQparameterStatus<>nil then
     FIntegerDateTimes := PQparameterStatus(ASQLDatabaseHandle,'integer_datetimes') = 'on';
-
-  SetLength(FConnectionPool,1);
-  FConnectionPool[0]:=TPQTranConnection.Create;
-  FConnectionPool[0].FPGConn:=ASQLDatabaseHandle;
-  FConnectionPool[0].FTranActive:=false;
+  T:=TPQTranConnection.Create;
+  T.FPGConn:=ASQLDatabaseHandle;
+  T.FTranActive:=false;
+  AddConnection(T);
 end;
 
 procedure TPQConnection.DoInternalDisconnect;
-var i:integer;
+var
+  i:integer;
+  L : TList;
+  T : TPQTranConnection;
+
 begin
   Inherited;
-  for i:=0 to length(FConnectionPool)-1 do
-    begin
-    if assigned(FConnectionPool[i].FPGConn) then
-      PQfinish(FConnectionPool[i].FPGConn);
-    FConnectionPool[i].Free;
-    end;
-  Setlength(FConnectionPool,0);
+  L:=FConnectionPool.LockList;
+  try
+    for i:=0 to L.Count-1 do
+      begin
+      T:=TPQTranConnection(L[i]);
+      if assigned(T.FPGConn) then
+        PQfinish(T.FPGConn);
+      T.Free;
+      end;
+    L.Clear;
+  finally
+    FConnectionPool.UnLockList;
+  end;
 {$IfDef LinkDynamically}
   ReleasePostgres3;
 {$EndIf}
@@ -396,13 +524,7 @@ begin
     begin
     sErr := PQerrorMessage(conn);
     //make connection available in pool
-    for i:=0 to length(FConnectionPool)-1 do
-      if FConnectionPool[i].FPGConn=conn then
-        begin
-        FConnectionPool[i].FPGConn:=nil;
-        FConnectionPool[i].FTranActive:=false;
-        break;
-        end;
+    ReleaseConnection(Conn,True);
     PQfinish(conn);
     DatabaseError(sErrConnectionFailed + ' (PostgreSQL: ' + sErr + ')', Self);
     end;
@@ -463,14 +585,7 @@ begin
     if assigned(conn) then
       begin
       PQFinish(conn);
-      //make connection available in pool
-      for i:=0 to length(FConnectionPool)-1 do
-        if FConnectionPool[i].FPGConn=conn then
-          begin
-          FConnectionPool[i].FPGConn:=nil;
-          FConnectionPool[i].FTranActive:=false;
-          break;
-          end;
+      ReleaseConnection(Conn,True);
       end;
     raise E;
     end;
@@ -549,18 +664,18 @@ begin
   end;
 end;
 
-Function TPQConnection.AllocateCursorHandle : TSQLCursor;
+function TPQConnection.AllocateCursorHandle: TSQLCursor;
 
 begin
   result := TPQCursor.create;
 end;
 
-Procedure TPQConnection.DeAllocateCursorHandle(var cursor : TSQLCursor);
+procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
 begin
   FreeAndNil(cursor);
 end;
 
-Function TPQConnection.AllocateTransactionHandle : TSQLHandle;
+function TPQConnection.AllocateTransactionHandle: TSQLHandle;
 
 begin
   result := TPQTrans.create;
@@ -625,8 +740,9 @@ begin
     if FStatementType in [stInsert,stUpdate,stDelete, stSelect] then
       begin
       StmtName := 'prepst'+inttostr(FCursorCount);
-      inc(FCursorCount);
-      tr := TPQTrans(aTransaction.Handle);
+      InterlockedIncrement(FCursorCount);
+      TPQTrans(aTransaction.Handle).RegisterCursor(Cursor as TPQCursor);
+
       // Only available for pq 8.0, so don't use it...
       // Res := pqprepare(tr,'prepst'+name+nr,pchar(buf),params.Count,pchar(''));
       s := 'prepare '+StmtName+' ';
@@ -755,7 +871,8 @@ begin
       end
     else
       begin
-      tr := TPQTrans(aTransaction.Handle);
+      // Registercursor sets tr
+      TPQTrans(aTransaction.Handle).RegisterCursor(Cursor as TPQCursor);
 
       if Assigned(AParams) and (AParams.Count > 0) then
         begin
@@ -816,26 +933,39 @@ end;
 function TPQConnection.GetHandle: pointer;
 var
   i:integer;
+  L : TList;
+  T : TPQTranConnection;
+
 begin
   result:=nil;
   if not Connected then
     exit;
   //Get any handle that is (still) connected
-  for i:=0 to length(FConnectionPool)-1 do
-    if assigned(FConnectionPool[i].FPGConn) and (PQstatus(FConnectionPool[i].FPGConn)<>CONNECTION_BAD) then
+  L:=FConnectionPool.LockList;
+  try
+    I:=L.Count-1;
+    While (I>=0) and (Result=Nil) do
       begin
-      Result :=FConnectionPool[i].FPGConn;
-      exit;
+      T:=TPQTranConnection(L[i]);
+      if assigned(T.FPGConn) and (PQstatus(T.FPGConn)<>CONNECTION_BAD) then
+        Result:=T.FPGConn;
+      Dec(I);
       end;
+  finally
+    FConnectionPool.UnLockList;
+  end;
+  if Result<>Nil then
+     exit;
   //Nothing connected!! Reconnect
-  if assigned(FConnectionPool[0].FPGConn) then
-    PQreset(FConnectionPool[0].FPGConn)
+  // T is element 0 after loop
+  if assigned(T.FPGConn) then
+    PQreset(T.FPGConn)
   else
-    FConnectionPool[0].FPGConn := PQconnectdb(pchar(FConnectString));
-  CheckConnectionStatus(FConnectionPool[0].FPGConn);
+    T.FPGConn := PQconnectdb(pchar(FConnectString));
+  CheckConnectionStatus(T.FPGConn);
   if CharSet <> '' then
-    PQsetClientEncoding(FConnectionPool[0].FPGConn, pchar(CharSet));
-  result:=FConnectionPool[0].FPGConn;
+    PQsetClientEncoding(T.FPGConn, pchar(CharSet));
+  result:=T.FPGConn;
 end;
 
 function TPQConnection.Fetch(cursor : TSQLCursor) : boolean;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -1248,11 +1248,11 @@ procedure TSQLTransaction.EndTransaction;
 
 begin
   Case Action of
-    caNone : ;
     caCommit :
       Commit;
     caCommitRetaining :
       CommitRetaining;
+    caNone,
     caRollback :
       RollBack;
     caRollbackRetaining :
@@ -1350,6 +1350,7 @@ end;
 destructor TSQLTransaction.Destroy;
 begin
   EndTransaction;
+  FreeAndNil(FTrans);
   FreeAndNil(FParams);
   inherited Destroy;
 end;

packages/fcl-db/tests/testdbbasics.pas

@@ -410,7 +410,7 @@ begin
     with ds do
       begin
       aDatasource.DataSet := ds;
-      open;
+      Open;
       DataEvents := '';
       Resync([rmExact]);
       if IsUniDirectional then
@@ -418,9 +418,13 @@ begin
       else
         CheckEquals('deDataSetChange:0;DataSetChanged;',DataEvents);
       DataEvents := '';
-      next;
-      CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
-      close;
+      Next;
+      if IsUniDirectional then
+        CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
+      else
+        CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
+      DataEvents := '';
+      Close;
       end;
   finally
     aDatasource.Free;

packages/fcl-db/tests/testfieldtypes.pas

@@ -2250,6 +2250,7 @@ begin
     end
 end;
 
+
 procedure TTestFieldTypes.TestExceptOnsecClose;
 
 var passed : boolean;

packages/fcl-fpcunit/fpmake.pp

@@ -29,7 +29,7 @@ begin
     P.Email := '';
     P.Description := 'Unit testing system inspired by JUnit of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/fcl-image/fpmake.pp

@@ -27,7 +27,7 @@ begin
     P.Email := '';
     P.Description := 'Image loading and conversion parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/fcl-js/fpmake.pp

@@ -22,7 +22,7 @@ begin
     P.HomepageURL := 'www.freepascal.org';
     P.Email := '[email protected]';
     P.Description := 'Javascript scanner/parser/syntax tree units';
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/fcl-json/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Description := 'Json interfacing, part of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
 

packages/fcl-net/fpmake.pp

@@ -28,7 +28,7 @@ begin
     P.Email := '';
     P.Description := 'Network related parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded];
+    P.OSes:=P.OSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src/unix',AllUnixOSes);

packages/fcl-net/src/fpsock.pp

@@ -209,7 +209,7 @@ Const
 
 destructor TSocketStream.Destroy;
 begin
-  FileClose(Handle);
+  CloseSocket(Handle);
   inherited Destroy;
 end;
 

packages/fcl-net/src/ssockets.pp

@@ -246,11 +246,7 @@ end;
 destructor TSocketStream.Destroy;
 begin
   if FSocketInitialized then
-  {$ifdef netware}
   CloseSocket(Handle);
-  {$else}
-  FileClose(Handle);
-  {$endif}
   inherited Destroy;
 end;
 
@@ -340,11 +336,7 @@ Procedure TSocketServer.Close;
 
 begin
   If FSocket<>-1 Then
-    {$ifdef netware}
     CloseSocket(FSocket);
-    {$else}
-    FileClose(FSocket);
-    {$endif}
   FSocket:=-1;
 end;
 

packages/fcl-passrc/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Description := 'Pascal parsing parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
 

packages/fcl-process/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Description := 'Process (execution) related parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.Options.Add('-S2h');
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src/unix',AllUnixOSes);

packages/fcl-registry/fpmake.pp

@@ -26,7 +26,7 @@ begin
     P.Email := '';
     P.Description := 'Windows registry + emulation parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/fcl-sdo/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.HomepageURL := 'www.freepascal.org';
     P.Email := '[email protected]';
     P.Description := 'Free Pascal implementation of Service Data Objects';
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     // P.NeedLibC:= false;
     P.SourcePath.Add('src/base');

packages/fcl-web/src/base/custfcgi.pp

@@ -349,11 +349,11 @@ Type THttpToCGI = array[1..CGIVarCount] of byte;
 
 const HttpToCGI : THttpToCGI =
    (
-     18,  //  1 'HTTP_ACCEPT'           - fieldAccept
-     19,  //  2 'HTTP_ACCEPT_CHARSET'   - fieldAcceptCharset
-     20,  //  3 'HTTP_ACCEPT_ENCODING'  - fieldAcceptEncoding
-     26,  //  4 'HTTP_ACCEPT_LANGUAGE'  - fieldAcceptLanguage
-      0,  //  5
+     18,  //  1 'HTTP_ACCEPT'           - field Accept
+     19,  //  2 'HTTP_ACCEPT_CHARSET'   - field AcceptCharset
+     20,  //  3 'HTTP_ACCEPT_ENCODING'  - field AcceptEncoding
+     26,  //  4 'HTTP_ACCEPT_LANGUAGE'  - field AcceptLanguage
+     37,  //  5  HTTP_AUTHORIZATION     - field Authorization
       0,  //  6
       0,  //  7
       0,  //  8
@@ -391,8 +391,9 @@ const HttpToCGI : THttpToCGI =
 var ACgiVarNr : Integer;
 
 begin
+
   Result := '';
-  if assigned(FCGIParams) and (index < high(HttpToCGI)) and (index > 0) and (index<>35) then
+  if assigned(FCGIParams) and (index <= high(HttpToCGI)) and (index > 0) and (index<>35) then
     begin
     ACgiVarNr:=HttpToCGI[Index];
     if ACgiVarNr>0 then

packages/fcl-web/src/base/custhttpapp.pp

@@ -219,10 +219,13 @@ procedure TFPHTTPServerHandler.HTTPHandleRequest(Sender: TObject;
   var AResponse: TFPHTTPConnectionResponse);
 begin
   // Exceptions are handled by (Do)HandleRequest. It also frees the response/request
-  DoHandleRequest(ARequest,AResponse);
-  ARequest:=Nil;
-  AResponse:=Nil;
-  If Terminated then
+  try
+    DoHandleRequest(ARequest,AResponse);
+  finally  
+    ARequest:=Nil;
+    AResponse:=Nil;
+  end;    
+  If Terminated And Assigned(FServer) then
     FServer.Active:=False;
   if Assigned(OnIdle) then
     OnIdle(Self);

packages/fcl-web/src/base/fphttpserver.pp

@@ -249,11 +249,6 @@ begin
   end;
 end;
 
-procedure HandleRequestError(Sender: TObject; E: Exception);
-begin
-
-end;
-
 procedure TFPHTTPConnectionRequest.InitRequestVars;
 Var
   P : Integer;
@@ -637,8 +632,6 @@ begin
     except
       // Do not let errors in user code escape.
     end
-  else
-    Writeln('Unhandled exception : ',E.ClassName,' : ',E.Message);
 end;
 
 function TFPCustomHttpServer.GetActive: Boolean;

packages/fcl-xml/fpmake.pp

@@ -29,7 +29,7 @@ begin
     P.Email := '';
     P.Description := 'XML and DOM parts of Free Component Libraries (FCL), FPC''s OOP library.';
     P.NeedLibC:= false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/fcl-xml/src/dom.pp

@@ -3,7 +3,7 @@
 
     Implementation of DOM interfaces
     Copyright (c) 1999-2000 by Sebastian Guenther, [email protected]
-    Modified in 2006 by Sergei Gorelkin, [email protected]    
+    Modified in 2006 by Sergei Gorelkin, [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -100,7 +100,11 @@ type
 
   TNodePool = class;
   PNodePoolArray = ^TNodePoolArray;
+{$ifdef CPU16}
+  TNodePoolArray = array[0..MaxSmallInt div sizeof(Pointer)-1] of TNodePool;
+{$else CPU16}
   TNodePoolArray = array[0..MaxInt div sizeof(Pointer)-1] of TNodePool;
+{$endif CPU16}
 
 {$ifndef fpc}
   TFPList = TList;
@@ -1164,7 +1168,7 @@ begin
     while Assigned(parent) and (parent.NodeType <> ELEMENT_NODE) do
       parent := parent.ParentNode;
     Result := TDOMElement(parent);
-  end;  
+  end;
 end;
 
 // TODO: specs prescribe to return default namespace if APrefix=null,
@@ -1201,7 +1205,7 @@ begin
         end;
       end
     end;
-  end;  
+  end;
   result := GetAncestorElement(Self).LookupNamespaceURI(APrefix);
 end;
 
@@ -1231,7 +1235,7 @@ begin
     begin
       result := (nsURI = namespaceURI);
       Exit;
-    end  
+    end
     else if HasAttributes then
     begin
       Map := Attributes;
@@ -1384,7 +1388,7 @@ begin
   if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
     raise EDOMNotFound.Create('NodeWC.InsertBefore');
 
-  // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)  
+  // TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)
   if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
   begin
     Tmp := Self;
@@ -1411,7 +1415,7 @@ begin
           raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
         Tmp := Tmp.NextSibling;
       end;
-    
+
       while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
         InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
     end;
@@ -2132,7 +2136,7 @@ begin
         Result := -NAMESPACE_ERR;
         Exit;
       end;
-    // Name validity has already been checked by IsXmlName() call above.  
+    // Name validity has already been checked by IsXmlName() call above.
     // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
     if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1)) then
     begin
@@ -3021,7 +3025,7 @@ begin
   if Assigned(FAttributes) then
     for I := 0 to FAttributes.Length - 1 do
       FAttributes[I].Normalize;
-  inherited Normalize;    
+  inherited Normalize;
 end;
 
 function TDOMElement.GetAttributes: TDOMNamedNodeMap;

packages/fcl-xml/src/xmlutils.pp

@@ -80,7 +80,7 @@ type
 {$ifndef fpc}
   PtrInt = LongInt;
   TFPList = TList;
-{$endif}  
+{$endif}
 
   PPHashItem = ^PHashItem;
   PHashItem = ^THashItem;
@@ -90,7 +90,11 @@ type
     Next: PHashItem;
     Data: TObject;
   end;
+{$ifdef CPU16}
+  THashItemArray = array[0..MaxSmallInt div sizeof(Pointer)-1] of PHashItem;
+{$else CPU16}
   THashItemArray = array[0..MaxInt div sizeof(Pointer)-1] of PHashItem;
+{$endif CPU16}
   PHashItemArray = ^THashItemArray;
 
   THashForEach = function(Entry: PHashItem; arg: Pointer): Boolean;
@@ -127,7 +131,11 @@ type
     lname: PWideChar;
     lnameLen: Integer;
   end;
+{$ifdef CPU16}
+  TExpHashEntryArray = array[0..MaxSmallInt div sizeof(TExpHashEntry)-1] of TExpHashEntry;
+{$else CPU16}
   TExpHashEntryArray = array[0..MaxInt div sizeof(TExpHashEntry)-1] of TExpHashEntry;
+{$endif CPU16}
   PExpHashEntryArray = ^TExpHashEntryArray;
 
   TDblHashArray = class(TObject)
@@ -135,7 +143,7 @@ type
     FSizeLog: Integer;
     FRevision: LongWord;
     FData: PExpHashEntryArray;
-  public  
+  public
     procedure Init(NumSlots: Integer);
     function Locate(uri: Pointer; localName: PWideChar; localLength: Integer): Boolean;
     destructor Destroy; override;
@@ -533,7 +541,7 @@ begin
   if Assigned(e) then
     Result := e^.Data
   else
-    Result := nil;  
+    Result := nil;
 end;
 
 function THashTable.Lookup(Key: PWideChar; KeyLength: Integer;

packages/fpmkunit/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Description := 'Basic library of the fpmake/fppkg build system.';
     P.NeedLibC:= false;  // true for headers that indirectly link to libc?
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     // All dependencies (including implicit) are listed
     // here to be able to update all requirements to

packages/fpmkunit/src/fpmkunit.pp

@@ -5165,11 +5165,8 @@ Procedure TBuildEngine.ResolveFileNames(APackage : TPackage; ACPU:TCPU;AOS:TOS;D
         if (D.DependencyType=depInclude) then
           begin
             if D.TargetFileName<>'' then
-              begin
-              Exit;
-              Log(vlDebug,SDbgSourceAlreadyResolved,[T.Name]);
-              end;
-            if (ACPU in D.CPUs) and (AOS in D.OSes) then
+              Log(vlDebug,SDbgSourceAlreadyResolved,[D.Value])
+            else if (ACPU in D.CPUs) and (AOS in D.OSes) then
               begin
                 if ExtractFilePath(D.Value)='' then
                   begin
@@ -6115,7 +6112,7 @@ begin
   case Defaults.BuildMode of
     bmOneByOne:  begin
                    if (bmOneByOne in APackage.SupportBuildModes) then
-                     APackage.FBuildMode:=bmBuildUnit
+                     APackage.FBuildMode:=bmOneByOne
                    else if bmBuildUnit in APackage.SupportBuildModes then
                      begin
                        log(vlInfo,SInfoFallbackBuildmodeBU);
@@ -6467,6 +6464,8 @@ begin
         for IOS:=Low(TOS) to high(TOS) do
           if OSCPUSupported[IOS,ICPU] then
             begin
+              // Make sure that the package is resolved for each targbet
+              APackage.FAllFilesResolved:=false;
               ResolveFileNames(APackage,ICPU,IOS,false);
               APackage.GetArchiveFiles(L, ICPU, IOS);
             end;

packages/fppkg/fpmake.pp

@@ -43,7 +43,7 @@ begin
     P.Email := '';
     P.Description := 'Libraries to create fppkg package managers.';
     P.NeedLibC:= false;
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     P.SourcePath.Add('src');
 

packages/hermes/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Description := 'Library for pixel graphics conversion';
     P.NeedLibC := false;
-    P.OSes:=AllOSes-[embedded];
+    P.OSes:=AllOSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/libgd/fpmake.pp

@@ -18,7 +18,7 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
     P.SourcePath.Add('src');
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     T:=P.Targets.AddUnit('gd.pas');
 

packages/pasjpeg/fpmake.pp

@@ -17,7 +17,7 @@ begin
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
-    P.OSes:=P.OSes-[embedded];
+    P.OSes:=P.OSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/paszlib/fpmake.pp

@@ -18,7 +18,7 @@ begin
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     D:=P.Dependencies.Add('hash');
       D.Version:='2.7.1';

packages/sdl/fpmake.pp

@@ -23,7 +23,7 @@ begin
     P.Dependencies.Add('pthreads',AllUnixOSes);
     if Defaults.CPU=arm then
        P.OSes := P.OSes - [darwin];
-    P.OSes := P.OSes - [iphonesim,os2,emx,go32v2,watcom,nativent,embedded,android,amiga];
+    P.OSes := P.OSes - [iphonesim,os2,emx,go32v2,watcom,nativent,embedded,android,amiga,msdos];
 
     T:=P.Targets.AddUnit('logger.pas');
       with T.Dependencies do

packages/sdl/src/sdl_net.pas

@@ -258,11 +258,12 @@ type
 {$ENDIF}
   end;
 
+  PPSDLNet_Socket = ^PSDLNet_Socket;
   PSDLNet_SocketSet = ^TSDLNet_SocketSet;
   TSDLNet_SocketSet = record
     numsockets : integer;
     maxsockets : integer;
-    sockets : PSDLNet_Socket;
+    sockets : PPSDLNet_Socket;
   end;
 
   {* Any network socket can be safely cast to this socket type *}

packages/symbolic/fpmake.pp

@@ -22,7 +22,7 @@ begin
     P.Email := '';
     P.Description := 'Expression parser with support for fast evaluation';
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded];
+    P.OSes:=P.OSes-[embedded,msdos];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');

packages/unzip/fpmake.pp

@@ -18,7 +18,7 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
     P.SourcePath.Add('src');
-    P.OSes := P.OSes - [embedded,nativent];
+    P.OSes := P.OSes - [embedded,nativent,msdos];
 
     T:=P.Targets.AddUnit('unzip51g.pp');
       with T.Dependencies do

packages/winunits-jedi/src/jwawindows.pas

@@ -363,9 +363,9 @@ The list has no order!}
 {$I JwaAccCtrl.pas}
 {$I JwaAclApi.pas}
 {$I JwaSddl.pas}
-{$I JwaLmErr}
-{$I JwaLmCons}
-{$I JwaNtSecApi}
+{$I JwaLmErr.pas}
+{$I JwaLmCons.pas}
+{$I JwaNtSecApi.pas}
 {$I JwaWinCred.pas}
 {$I JwaWtsApi32.pas}
 {$I JwaWinIoctl.pas}
@@ -687,9 +687,9 @@ The list has no order!}
 {$I JwaAccCtrl.pas}
 {$I JwaAclApi.pas}
 {$I JwaSddl.pas}
-{$I JwaLmErr}
-{$I JwaLmCons}
-{$I JwaNtSecApi}
+{$I JwaLmErr.pas}
+{$I JwaLmCons.pas}
+{$I JwaNtSecApi.pas}
 {$I JwaWinCred.pas}
 {$I JwaWtsApi32.pas}
 {$I JwaWinIoctl.pas}

rtl/inc/objpash.inc

@@ -47,18 +47,18 @@
        { methods }
        vmtMethodStart          = vmtParent+sizeof(pointer)*10;
        vmtDestroy              = vmtMethodStart;
-       vmtNewInstance          = vmtMethodStart+sizeof(pointer);
-       vmtFreeInstance         = vmtMethodStart+sizeof(pointer)*2;
-       vmtSafeCallException    = vmtMethodStart+sizeof(pointer)*3;
-       vmtDefaultHandler       = vmtMethodStart+sizeof(pointer)*4;
-       vmtAfterConstruction    = vmtMethodStart+sizeof(pointer)*5;
-       vmtBeforeDestruction    = vmtMethodStart+sizeof(pointer)*6;
-       vmtDefaultHandlerStr    = vmtMethodStart+sizeof(pointer)*7;
-       vmtDispatch             = vmtMethodStart+sizeof(pointer)*8;
-       vmtDispatchStr          = vmtMethodStart+sizeof(pointer)*9;
-       vmtEquals               = vmtMethodStart+sizeof(pointer)*10;
-       vmtGetHashCode          = vmtMethodStart+sizeof(pointer)*11;
-       vmtToString             = vmtMethodStart+sizeof(pointer)*12;
+       vmtNewInstance          = vmtMethodStart+sizeof(codepointer);
+       vmtFreeInstance         = vmtMethodStart+sizeof(codepointer)*2;
+       vmtSafeCallException    = vmtMethodStart+sizeof(codepointer)*3;
+       vmtDefaultHandler       = vmtMethodStart+sizeof(codepointer)*4;
+       vmtAfterConstruction    = vmtMethodStart+sizeof(codepointer)*5;
+       vmtBeforeDestruction    = vmtMethodStart+sizeof(codepointer)*6;
+       vmtDefaultHandlerStr    = vmtMethodStart+sizeof(codepointer)*7;
+       vmtDispatch             = vmtMethodStart+sizeof(codepointer)*8;
+       vmtDispatchStr          = vmtMethodStart+sizeof(codepointer)*9;
+       vmtEquals               = vmtMethodStart+sizeof(codepointer)*10;
+       vmtGetHashCode          = vmtMethodStart+sizeof(codepointer)*11;
+       vmtToString             = vmtMethodStart+sizeof(codepointer)*12;
 
        { IInterface }
        S_OK          = 0;
@@ -110,19 +110,19 @@
          vAutoTable: Pointer;
          vIntfTable: PInterfaceTable;
          vMsgStrPtr: pstringmessagetable;
-         vDestroy: Pointer;
-         vNewInstance: Pointer;
-         vFreeInstance: Pointer;
-         vSafeCallException: Pointer;
-         vDefaultHandler: Pointer;
-         vAfterConstruction: Pointer;
-         vBeforeDestruction: Pointer;
-         vDefaultHandlerStr: Pointer;
-         vDispatch: Pointer;
-         vDispatchStr: Pointer;
-         vEquals: Pointer;
-         vGetHashCode: Pointer;
-         vToString: Pointer;
+         vDestroy: CodePointer;
+         vNewInstance: CodePointer;
+         vFreeInstance: CodePointer;
+         vSafeCallException: CodePointer;
+         vDefaultHandler: CodePointer;
+         vAfterConstruction: CodePointer;
+         vBeforeDestruction: CodePointer;
+         vDefaultHandlerStr: CodePointer;
+         vDispatch: CodePointer;
+         vDispatchStr: CodePointer;
+         vEquals: CodePointer;
+         vGetHashCode: CodePointer;
+         vToString: CodePointer;
        end;
 
        PGuid = ^TGuid;

rtl/inc/socketsh.inc

@@ -180,7 +180,7 @@ function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optle
 function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
 function  fpsocketpair  (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
 
-Function CloseSocket(Sock:Longint):Longint; // vote is still out on this one
+Function CloseSocket(Sock:Longint):Longint;
 
 {Basic Socket Functions}
 {$ifdef legacysocket}

rtl/mips/mips.inc

@@ -76,6 +76,7 @@ var
   end;
 
 
+{$ifndef INTERNAL_BACKTRACE}
 {$define FPC_SYSTEM_HAS_GET_FRAME}
 function get_frame:pointer;assembler;nostackframe;
   asm
@@ -94,6 +95,7 @@ function get_frame:pointer;assembler;nostackframe;
     // lw $2,0($sp)
     move $2,$30
   end;
+{$endif INTERNAL_BACKTRACE}
 
 
 { Try to find previous $fp,$ra register pair

rtl/msdos/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/06/04]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/08/11]
 #
 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 i386-iphonesim i386-android 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 powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd 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 arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android i8086-msdos
@@ -2416,6 +2416,7 @@ dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
 emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
 		  dpmiexcp$(PPUEXT)
 ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+	$(COMPILER) ports.pp
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
 	       strings$(PPUEXT) system$(PPUEXT)
 	$(COMPILER) dos.pp
@@ -2462,14 +2463,26 @@ stdconvs$(PPUEXT) : $(OBJPASDIR)/stdconvs.pp objpas$(PPUEXT) system$(PPUEXT) \
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+	$(COMPILER) (PROCINC)/cpu.pp $(REDIR)
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+	$(COMPILER) (PROCINC)/mmx.pp $(REDIR)
 getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/getopts.pp $(REDIR)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
 lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/lineinfo.pp
 lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/lnfodwrf.pp
 charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/charset.pp
+matrix$(PPUEXT) : $(INC)/matrix.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/matrix.pp
 ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+	$(COMPILER) $(INC)/ucomplex.pp $(REDIR)
 msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+	$(COMPILER) msmouse.pp $(REDIR)
 callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/callspec.pp $(REDIR)
 ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/ctypes.pp $(REDIR)

rtl/msdos/Makefile.fpc

@@ -94,9 +94,12 @@ initc$(PPUEXT) : initc.pp system$(PPUEXT)
 profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
 dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT)
 dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
+
 emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
                   dpmiexcp$(PPUEXT)
+
 ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+	$(COMPILER) ports.pp
 #
 # TP7 Compatible RTL Units
 #
@@ -174,18 +177,41 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 # Other system-independent RTL Units
 #
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+        $(COMPILER) (PROCINC)/cpu.pp $(REDIR)
+
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+        $(COMPILER) (PROCINC)/mmx.pp $(REDIR)
+
 getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/getopts.pp $(REDIR)
+
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
+
 lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/lineinfo.pp
+
 lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/lnfodwrf.pp
+
 charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/charset.pp
+
+matrix$(PPUEXT) : $(INC)/matrix.pp system$(PPUEXT)
+	$(COMPILER) $(INC)/matrix.pp
+
 ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+        $(COMPILER) $(INC)/ucomplex.pp $(REDIR)
 
 #
 # Other system-dependent RTL Units
 #
 msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+        $(COMPILER) msmouse.pp $(REDIR)
+
 callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/callspec.pp $(REDIR)
+
 ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/ctypes.pp $(REDIR)
+

rtl/objpas/unicodedata.pas

@@ -1199,12 +1199,14 @@ function TUCA_PropItemRec.GetCodePoint() : UInt24;
 begin
   if HasCodePoint() then begin
     if Contextual then
-      Result := PUInt24(
-                  PtrUInt(@Self) + Self.GetSelfOnlySize()- SizeOf(UInt24) -
-                  Cardinal(GetContext()^.Size)
-                )^
+      Result := Unaligned(
+                  PUInt24(
+                    PtrUInt(@Self) + Self.GetSelfOnlySize()- SizeOf(UInt24) -
+                    Cardinal(GetContext()^.Size)
+                  )^
+                )
     else
-      Result := PUInt24(PtrUInt(@Self) + Self.GetSelfOnlySize() - SizeOf(UInt24))^
+      Result := Unaligned(PUInt24(PtrUInt(@Self) + Self.GetSelfOnlySize() - SizeOf(UInt24))^)
   end else begin
   {$ifdef uni_debug}
     raise EUnicodeException.Create('TUCA_PropItemRec.GetCodePoint : "No code point available."');
@@ -1238,17 +1240,17 @@ begin
   c := WeightLength;
   p := PByte(PtrUInt(@Self) + SizeOf(TUCA_PropItemRec));
   pd := ADest;
-  pd^.Weights[0] := PWord(p)^;
+  pd^.Weights[0] := Unaligned(PWord(p)^);
   p := p + 2;
   if not IsWeightCompress_1() then begin
-    pd^.Weights[1] := PWord(p)^;
+    pd^.Weights[1] := Unaligned(PWord(p)^);
     p := p + 2;
   end else begin
     pd^.Weights[1] := p^;
     p := p + 1;
   end;
   if not IsWeightCompress_2() then begin
-    pd^.Weights[2] := PWord(p)^;
+    pd^.Weights[2] := Unaligned(PWord(p)^);
     p := p + 2;
   end else begin
     pd^.Weights[2] := p^;

rtl/os2/sockets.pas

@@ -18,18 +18,17 @@
 { $DEFINE notUnix}      // To make ssockets.pp compile
 unit Sockets;
 
-Interface
+interface
 
-Uses
-  so32dll,ctypes;
+uses
+  so32dll, ctypes;
 
-Const
-//  AF_LOCAL       = so32dll.AF_LOCAL;
-  AF_UNSPEC      = so32dll.AF_UNSPEC;
-  AF_LOCAL       = so32dll.AF_LOCAL;
+const
+  AF_UNSPEC      = so32dll.AF_UNSPEC;      // unspecified
+  AF_LOCAL       = so32dll.AF_LOCAL;       // local to host (pipes, portals)
   AF_UNIX        = so32dll.AF_UNIX;
   AF_OS2         = so32dll.AF_OS2;
-  AF_INET        = so32dll.AF_INET;
+  AF_INET        = so32dll.AF_INET;        // internetwork: UDP, TCP, etc.
   AF_IMPLINK     = so32dll.AF_IMPLINK;     // arpanet imp addresses
   AF_PUP         = so32dll.AF_PUP;         // pup protocols: e.g. BSP
   AF_CHAOS       = so32dll.AF_CHAOS;       // mit CHAOS protocols
@@ -97,21 +96,461 @@ Const
 
   PF_MAX       = so32dll.PF_MAX;
 
-const EsockEINTR  = SOCEINTR;
-      EsockEBADF  = SOCEBADF;
-      EsockEFAULT = SOCEFAULT;
-      EsockEINVAL = SOCEINVAL;
-      EsockEACCESS = SOCEACCES;
-      EsockEMFILE  = SOCEMFILE;
-      EsockEMSGSIZE = SOCEMSGSIZE;
-      EsockENOBUFS = SOCENOBUFS;
-      EsockENOTCONN = SOCENOTCONN;
-      EsockENOTSOCK = SOCENOTSOCK;
-      EsockEPROTONOSUPPORT = SOCEPROTONOSUPPORT;
-      EsockEWOULDBLOCK = SOCEWOULDBLOCK;
-
-
-Type
+  EsockEINTR  = SOCEINTR;
+  EsockEBADF  = SOCEBADF;
+  EsockEFAULT = SOCEFAULT;
+  EsockEINVAL = SOCEINVAL;
+  EsockEACCESS = SOCEACCES;
+  EsockEMFILE  = SOCEMFILE;
+  EsockEMSGSIZE = SOCEMSGSIZE;
+  EsockENOBUFS = SOCENOBUFS;
+  EsockENOTCONN = SOCENOTCONN;
+  EsockENOTSOCK = SOCENOTSOCK;
+  EsockEPROTONOSUPPORT = SOCEPROTONOSUPPORT;
+  EsockEWOULDBLOCK = SOCEWOULDBLOCK;
+
+
+(***************************************************************************)
+(*                                                                         *)
+(*                            Option flags per-socket                      *)
+(*                                                                         *)
+(***************************************************************************)
+const
+  // turn on debugging info recording
+  SO_DEBUG        = $0001;
+  // socket has had listen()
+  SO_ACCEPTCONN   = $0002;
+  // allow local address reuse
+  SO_REUSEADDR    = $0004;
+  // keep connections alive
+  SO_KEEPALIVE    = $0008;
+  // just use interface addresses
+  SO_DONTROUTE    = $0010;
+  // permit sending of broadcast msgs
+  SO_BROADCAST    = $0020;
+  // bypass hardware when possible
+  SO_USELOOPBACK  = $0040;
+  // linger on close if data present
+  SO_LINGER       = $0080;
+  // leave received OOB data in line
+  SO_OOBINLINE    = $0100;
+  // limited broadcast sent on all IFs
+  SO_L_BROADCAST  = $0200;
+  // set if shut down called for rcv
+  SO_RCV_SHUTDOWN = $0400;
+  // set if shutdown called for send
+  SO_SND_SHUTDOWN = $0800;
+  // allow local address & port reuse
+  SO_REUSEPORT    = $1000;
+  // allow t/tcp on socket
+  SO_TTCP         = $2000;
+  // aliases so we are cross-platform
+  SHUT_RD         = SO_RCV_SHUTDOWN;
+  SHUT_WR         = SO_SND_SHUTDOWN;
+  SHUT_RDWR       = SO_RCV_SHUTDOWN or SO_SND_SHUTDOWN;
+
+(***************************************************************************)
+(*                                                                         *)
+(*                  Additional options, not kept in so_options             *)
+(*                                                                         *)
+(***************************************************************************)
+  // send buffer size
+  SO_SNDBUF   = $1001;
+  // receive buffer size
+  SO_RCVBUF   = $1002;
+  // send low-water mark
+  SO_SNDLOWAT = $1003;
+  // receive low-water mark
+  SO_RCVLOWAT = $1004;
+  // send timeout
+  SO_SNDTIMEO = $1005;
+  // receive timeout
+  SO_RCVTIMEO = $1006;
+  // get error status and clear
+  SO_ERROR    = $1007;
+  // get socket type
+  SO_TYPE     = $1008;
+  // get socket options
+  SO_OPTIONS  = $1010;
+
+
+(***************************************************************************)
+(*                                                                         *)
+(*      Level number for (get/set)sockopt() to apply to socket itself      *)
+(*                                                                         *)
+(***************************************************************************)
+  // options for socket level
+  SOL_SOCKET = $ffff;
+
+
+(***************************************************************************)
+(*                                                                         *)
+(*  Definitions for sysctl call. The sysctl call uses a hierarchical name  *)
+(* for objects that can be examined or modified.  The name is expressed as *)
+(* a sequence of integers.  Like a file path name, the meaning of each     *)
+(* component depends on its place in the hierarchy. The top-level and kern *)
+(* identifiers are defined here, and other identifiers are defined in the  *)
+(* respective subsystem header files.                                      *)
+(*                                                                         *)
+(***************************************************************************)
+
+// largest number of components supported
+  CTL_MAXNAME    = 12;
+
+  // name is a node
+  CTLTYPE_NODE    =1;
+  // name describes an integer
+  CTLTYPE_INT     =2;
+  // name describes a string
+  CTLTYPE_STRING  =3;
+  // name describes a 64-bit number
+  CTLTYPE_QUAD    =4;
+  // name describes a structure
+  CTLTYPE_STRUCT  =5;
+  // inetcfg sysctl code
+  CTLTYPE_INETCFG =6;
+  // inetver sysctl code
+  CTLTYPE_INEVER  =7;
+
+(*
+ * Top-level identifiers
+ *)
+  // "high kernel": proc, limits
+  CTL_KERN       = 1;
+  // network, see socket.h
+  CTL_NET        = 4;
+  // OS/2 specific codes
+  CTL_OS2        = 9;
+
+
+{
+/*
+ * PF_ROUTE - Routing table
+ *
+ * Three additional levels are defined:
+ *      Fourth: address family, 0 is wildcard
+ *      Fifth: type of info, defined below
+ *      Sixth: flag(s) to mask with for NET_RT_FLAGS
+ */
+}
+  // dump; may limit to a.f.
+  NET_RT_DUMP   = 1;
+  // by flags, e.g. RESOLVING
+  NET_RT_FLAGS  = 2;
+  // survey interface list
+  NET_RT_IFLIST = 3;
+  NET_RT_MAXID  = 4;
+
+
+(***************************************************************************)
+(*                                                                         *)
+(*             Maximum queue length specifiable by listen                  *)
+(*                                                                         *)
+(***************************************************************************)
+  // Maximum queue length specifiable by listen
+  SOMAXCONN = 1024;
+
+
+  // process out-of-band data
+  MSG_OOB       = $1;
+  // peek at incoming message
+  MSG_PEEK      = $2;
+  // send without using routing tables
+  MSG_DONTROUTE = $4;
+  // send without using routing tables
+  MSG_FULLREAD   = $8;
+  // data completes record
+  MSG_EOR        = $10;
+  // data discarded before delivery
+  MSG_TRUNC      = $20;
+  // control data lost before delivery
+  MSG_CTRUNC     = $40;
+  // wait for full request or error
+  MSG_WAITALL    = $80;
+  // this message should be nonblocking
+  MSG_DONTWAIT   = $100;
+  MSG_EOF        = $200;
+  // mem mapped io
+  MSG_MAPIO      = $400;
+
+
+(***************************************************************************)
+(*                                                                         *)
+(*                     "Socket"-level control message types                *)
+(*                                                                         *)
+(***************************************************************************)
+  // access rights (array of int)
+  SCM_RIGHTS = $01;
+
+
+// * bsd select definitions
+
+{
+ * Select uses bit masks of file descriptors in longs.  These macros
+ * manipulate such bit fields (the filesystem macros use chars).
+ * FD_SETSIZE may be defined by the user, but the default here should
+ * be enough for most uses.
+}
+  FD_SETSIZE = 64;
+
+{
+ * ioctl & ip trace support
+}
+  FIONREAD      = (Ord('f') SHL 8) OR 127;
+  FIONBIO       = (Ord('f') SHL 8) OR 126;
+
+  FIOASYNC      = (Ord('f') SHL 8) OR 125;
+  FIOTCPCKSUM   = (Ord('f') SHL 8) OR 128;
+  FIONSTATUS    = (Ord('f') SHL 8) OR 120;
+  FIONURG       = (Ord('f') SHL 8) OR 121;
+
+  SIOCSHIWAT    = (Ord('s') SHL 8) OR  0;
+  SIOCGHIWAT    = (Ord('s') SHL 8) OR  1;
+  SIOCSLOWAT    = (Ord('s') SHL 8) OR  2;
+  SIOCGLOWAT    = (Ord('s') SHL 8) OR  3;
+  SIOCATMARK    = (Ord('s') SHL 8) OR  7;
+  SIOCSPGRP     = (Ord('s') SHL 8) OR  8;
+  SIOCGPGRP     = (Ord('s') SHL 8) OR  9;
+  SIOCSHOSTID   = (Ord('s') SHL 8) OR 10;
+
+  SIOCADDRT     = (Ord('r') SHL 8) OR 10;
+  SIOCDELRT     = (Ord('r') SHL 8) OR 11;
+  SIOMETRIC1RT  = (Ord('r') SHL 8) OR 12;
+  SIOMETRIC2RT  = (Ord('r') SHL 8) OR 13;
+  SIOMETRIC3RT  = (Ord('r') SHL 8) OR 14;
+  SIOMETRIC4RT  = (Ord('r') SHL 8) OR 15;
+
+  SIOCREGADDNET = (Ord('r') SHL 8) OR 12;
+  SIOCREGDELNET = (Ord('r') SHL 8) OR 13;
+  SIOCREGROUTES = (Ord('r') SHL 8) OR 14;
+  SIOCFLUSHROUTES=(Ord('r') SHL 8) OR 15;
+
+  SIOCSIFADDR   = (Ord('i') SHL 8) OR 12;
+  SIOCGIFADDR   = (Ord('i') SHL 8) OR 13;
+  SIOCSIFDSTADDR= (Ord('i') SHL 8) OR 14;
+  SIOCGIFDSTADDR= (Ord('i') SHL 8) OR 15;
+  SIOCSIFFLAGS  = (Ord('i') SHL 8) OR 16;
+  SIOCGIFFLAGS  = (Ord('i') SHL 8) OR 17;
+  SIOCGIFBRDADDR= (Ord('i') SHL 8) OR 18;
+  SIOCSIFBRDADDR= (Ord('i') SHL 8) OR 19;
+  SIOCGIFCONF   = (Ord('i') SHL 8) OR 20;
+  SIOCGIFNETMASK= (Ord('i') SHL 8) OR 21;
+  SIOCSIFNETMASK= (Ord('i') SHL 8) OR 22;
+  SIOCGIFMETRIC = (Ord('i') SHL 8) OR 23;
+  SIOCSIFMETRIC = (Ord('i') SHL 8) OR 24;
+  SIOCSIFSETSIG = (Ord('i') SHL 8) OR 25;
+  SIOCSIFCLRSIG = (Ord('i') SHL 8) OR 26;
+  SIOCSIFBRD    = (Ord('i') SHL 8) OR 27; { SINGLE-rt bcst. using old # for bkw cmpt }
+  SIOCSIFALLRTB = (Ord('i') SHL 8) OR 63; { added to configure all-route broadcst }
+
+  SIOCGIFLOAD     =(Ord('i') SHL 8) OR 27;
+  SIOCSIFFILTERSRC=(Ord('i') SHL 8) OR 28;
+  SIOCGIFFILTERSRC=(Ord('i') SHL 8) OR 29;
+
+  SIOCSARP      = (Ord('i') SHL 8) OR 30;
+  SIOCGARP      = (Ord('i') SHL 8) OR 31;
+  SIOCDARP      = (Ord('i') SHL 8) OR 32;
+  SIOCSIFSNMPSIG= (Ord('i') SHL 8) OR 33;
+  SIOCSIFSNMPCLR= (Ord('i') SHL 8) OR 34;
+  SIOCSIFSNMPCRC= (Ord('i') SHL 8) OR 35;
+  SIOCSIFPRIORITY=(Ord('i') SHL 8) OR 36;
+  SIOCGIFPRIORITY=(Ord('i') SHL 8) OR 37;
+  SIOCSIFFILTERDST=(Ord('i') SHL 8) OR 38;
+  SIOCGIFFILTERDST=(Ord('i') SHL 8) OR 39;
+  SIOCSIF802_3  =  (Ord('i') SHL 8) OR 40;
+  SIOCSIFNO802_3=  (Ord('i') SHL 8) OR 41;
+  SIOCSIFNOREDIR=  (Ord('i') SHL 8) OR 42;
+  SIOCSIFYESREDIR= (Ord('i') SHL 8) OR 43;
+
+  SIOCSIFMTU    = (Ord('i') SHL 8) OR 45;
+  SIOCSIFFDDI   = (Ord('i') SHL 8) OR 46;
+  SIOCSIFNOFDDI = (Ord('i') SHL 8) OR 47;
+  SIOCSRDBRD    = (Ord('i') SHL 8) OR 48;
+  SIOCSARP_TR   = (Ord('i') SHL 8) OR 49;
+  SIOCGARP_TR   = (Ord('i') SHL 8) OR 50;
+
+{ multicast ioctls }
+  SIOCADDMULTI  = (Ord('i') SHL 8) OR 51;    { add m'cast addr }
+  SIOCDELMULTI  = (Ord('i') SHL 8) OR 52;    { del m'cast addr }
+  SIOCMULTISBC  = (Ord('i') SHL 8) OR 61;    { use broadcast to send IP multicast }
+  SIOCMULTISFA  = (Ord('i') SHL 8) OR 62;    { use functional addr to send IP multicast }
+
+
+{$IFDEF SLBOOTP}
+  SIOCGUNIT     = (Ord('i') SHL 8) OR 70;    { Used to retreive unit number on }
+                                             { serial interface }
+{$ENDIF}
+
+  SIOCSIFSPIPE   = (Ord('i') SHL 8) OR 71;   { used to set pipe size on interface }
+                                             { this is used as tcp send buffer size }
+  SIOCSIFRPIPE   = (Ord('i') SHL 8) OR 72;   { used to set pipe size on interface }
+                                             { this is used as tcp recv buffer size }
+  SIOCSIFTCPSEG = (Ord('i') SHL 8) OR 73;    { set the TCP segment size on interface }
+  SIOCSIFUSE576 = (Ord('i') SHL 8) OR 74;    { enable/disable the automatic change of mss to 576 }
+                                             { if going through a router }
+  SIOCGIFVALID  = (Ord('i') SHL 8) OR 75;    { to check if the interface is Valid or not }
+                                             { sk June 14 1995 }
+  SIOCGIFBOUND  = (Ord('i') SHL 8) OR 76;    { ioctl to return bound/shld bind ifs }
+{ Interface Tracing Support }
+  SIOCGIFEFLAGS = (Ord('i') SHL 8) OR 150;
+  SIOCSIFEFLAGS = (Ord('i') SHL 8) OR 151;
+  SIOCGIFTRACE  = (Ord('i') SHL 8) OR 152;
+  SIOCSIFTRACE  = (Ord('i') SHL 8) OR 153;
+
+{$IFDEF SLSTATS}
+  SIOCSSTAT    = (Ord('i') SHL 8) OR 154;
+  SIOCGSTAT    = (Ord('i') SHL 8) OR 155;
+{$ENDIF}
+
+{ NETSTAT stuff }
+  SIOSTATMBUF   = (Ord('n') SHL 8) OR 40;
+  SIOSTATTCP    = (Ord('n') SHL 8) OR 41;
+  SIOSTATUDP    = (Ord('n') SHL 8) OR 42;
+  SIOSTATIP     = (Ord('n') SHL 8) OR 43;
+  SIOSTATSO     = (Ord('n') SHL 8) OR 44;
+  SIOSTATRT     = (Ord('n') SHL 8) OR 45;
+  SIOFLUSHRT    = (Ord('n') SHL 8) OR 46;
+  SIOSTATICMP   = (Ord('n') SHL 8) OR 47;
+  SIOSTATIF     = (Ord('n') SHL 8) OR 48;
+  SIOSTATAT     = (Ord('n') SHL 8) OR 49;
+  SIOSTATARP    = (Ord('n') SHL 8) OR 50;
+  SIOSTATIF42   = (Ord('n') SHL 8) OR 51;
+
+
+{*
+ * User-settable options (used with setsockopt).
+ *}
+  TCP_NODELAY    = $01;    // don't delay send to coalesce packets
+  TCP_MAXSEG     = $02;    // set maximum segment size
+  TCP_MSL        = $03;    // MSL HACK
+  TCP_TIMESTMP   = $04;    // RFC 1323 (RTTM TimeStamp)
+  TCP_WINSCALE   = $05;    // RFC 1323 (Window Scale)
+  TCP_CC         = $06;    // RFC 1644 (Connection Count)
+
+
+  IFF_UP                =  $1;          // interface is up
+  IFF_BROADCAST         =  $2;          // broadcast address valid
+  IFF_DEBUG             =  $4;          // turn on debugging
+  IFF_LOOPBACK          =  $8;          // is a loopback net
+  IFF_POINTOPOINT       =  $10;         // interface is point-to-point link
+  IFF_LINK2             =  $20;         // was trailers, not used
+  IFF_NOTRAILERS        =  IFF_LINK2;
+  IFF_RUNNING           =  $40;         // resources allocated
+  IFF_NOARP             =  $80;         // no address resolution protocol
+  IFF_PROMISC           =  $100;        // receive all packets
+  IFF_ALLMULTI          =  $200;        // receive all multicast packets
+  IFF_BRIDGE            =  $1000;       // support token ring routine field
+  IFF_SNAP              =  $2000;       // support extended SAP header
+  IFF_DEFMTU            =  $400;        // default mtu of 1500
+  IFF_RFC1469_BC        =  1;           // using broadcast
+  IFF_RFC1469_FA        =  2;           // using functional
+  IFF_RFC1469_MA        =  3;           // using multicast
+  IFF_ETHER             =  $4000;       // Ethernet interface
+  IFF_LOOPBRD           =  $8000;       // loop back broadcasts
+  IFF_MULTICAST         =  $800;        // supports multicast
+
+  IFF_SIMPLEX           =  $10000;      // can't hear own transmissions
+  IFF_OACTIVE           =  $20000;      // transmission in progress
+  IFF_802_3             =  $40000;
+  IFF_CANONICAL         =  $80000;
+  IFF_RUNNINGBLK        =  $100000;     // threads waited for intf running
+
+  { Interface enhanced flags }
+  IFFE_PKTTRACE         =  $00000001;   // trace datalink where possible
+  IFFE_IPTRACE          =  $00000002;   // trace ONLY IP packets
+
+
+  { physical protocols IDs }
+  HT_IP                 =  $01;  // IP
+  HT_ETHER              =  $06;  // Ethernet
+  HT_ISO88023           =  $07;  // CSMA CD
+  HT_ISO88025           =  $09;  // Token Ring
+  HT_SLIP               =  $1c;  // Serial Line IP
+  HT_PPP                =  $18;  // PPP IP
+
+
+  IFNAMSIZ              =  16;   // interface name length
+
+{ in.h / inet.h const & func }
+
+{
+ * Protocols
+}
+  IPPROTO_IP              = 0;               { dummy for IP }
+  IPPROTO_ICMP            = 1;               { control message protocol }
+  IPPROTO_GGP             = 3;               { gateway^2 (deprecated) }
+  IPPROTO_TCP             = 6;               { tcp }
+  IPPROTO_EGP             = 8;               { exterior gateway protocol }
+  IPPROTO_PUP             = 12;              { pup }
+  IPPROTO_UDP             = 17;              { user datagram protocol }
+  IPPROTO_IDP             = 22;              { xns idp }
+
+  IPPROTO_RAW             = 255;             { raw IP packet }
+  IPPROTO_MAX             = 256;
+
+{
+ * Ports < IPPORT_RESERVED are reserved for
+ * privileged processes (e.g. root).
+ * Ports > IPPORT_USERRESERVED are reserved
+ * for servers, not necessarily privileged.
+}
+  IPPORT_RESERVED         = 1024;
+  IPPORT_USERRESERVED     = 5000;
+
+{
+ * Link numbers
+}
+  IMPLINK_IP              = 155;
+  IMPLINK_LOWEXPER        = 156;
+  IMPLINK_HIGHEXPER       = 158;
+
+{
+ * Definitions of bits in internet address integers.
+ * On subnets, the decomposition of addresses to host and net parts
+ * is done according to subnet mask, not the masks here.
+}
+  IN_CLASSA_NET           = $ff000000;
+  IN_CLASSA_NSHIFT        = 24;
+  IN_CLASSA_HOST          = $00ffffff;
+  IN_CLASSA_MAX           = 128;
+  IN_CLASSB_NET           = $ffff0000;
+  IN_CLASSB_NSHIFT        = 16;
+  IN_CLASSB_HOST          = $0000ffff;
+  IN_CLASSB_MAX           = 65536;
+
+  IN_CLASSC_NET           = $ffffff00;
+  IN_CLASSC_NSHIFT        = 8;
+  IN_CLASSC_HOST          = $000000ff;
+
+  INADDR_BROADCAST        = $ffffffff;     { must be masked }
+
+  IN_LOOPBACKNET          = 127;           { official! }
+
+{*
+ * Options for use with [gs]etsockopt at the IP level.
+ * }
+  IP_OPTIONS            = 1;   // buf/ip_opts; set/get IP options
+  IP_MULTICAST_IF       = 2;   // u_char; set/get IP multicast i/f
+  IP_MULTICAST_TTL      = 3;   // u_char; set/get IP multicast ttl
+  IP_MULTICAST_LOOP     = 4;   // u_char; set/get IP multicast loopback
+  IP_ADD_MEMBERSHIP     = 5;   // ip_mreq; add an IP group membership
+  IP_DROP_MEMBERSHIP    = 6;   // ip_mreq; drop an IP group membership
+  IP_HDRINCL            = 7;   // int; header is included with data
+  IP_TOS                = 8;   // int; IP type of service and preced.
+  IP_TTL                = 9;   // int; IP time to live
+  IP_RECVOPTS           = 10;  // bool; receive all IP opts w/dgram
+  IP_RECVRETOPTS        = 11;  // bool; receive IP opts for response
+  IP_RECVDSTADDR        = 12;  // bool; receive IP dst addr w/dgram
+  IP_RETOPTS            = 13;  // ip_opts; set/get IP options
+  IP_RECVTRRI           = 14;  // bool; receive token ring routing inf
+
+  IP_DEFAULT_MULTICAST_TTL  = 1;    // normally limit m'casts to 1 hop
+  IP_DEFAULT_MULTICAST_LOOP = 1;    // normally hear sends if a member
+  IP_MAX_MEMBERSHIPS        = 20;   // per socket; must fit in one mbuf
+  MAX_IN_MULTI    = 16*IP_MAX_MEMBERSHIPS;     // 320 max per os2
+
+
+type
   cushort=word;
   cuint16=word;
   cuint32=cardinal;

rtl/os2/system.pas

@@ -1138,7 +1138,7 @@ begin
     IsConsole := ApplicationType <> 3;
 
     {Query maximum path length (QSV_MAX_PATH_LEN = 1)}
-    if DosQuerySysInfo (1, 1, @DW, SizeOf (DW)) = 0 then
+    if DosQuerySysInfo (1, 1, DW, SizeOf (DW)) = 0 then
      RealMaxPathLen := DW;
 
     ExitProc := nil;

rtl/os2/systhrd.inc

@@ -170,10 +170,6 @@ function DosQuerySysState (EntityList, EntityLevel, PID, TID: cardinal;
                                 var Buffer; BufLen: cardinal): cardinal; cdecl;
                                                  external 'DOSCALLS' index 368;
 
-function DosQuerySysInfo (First, Last: cardinal; var Buf; BufSize: cardinal):
-                                                               cardinal; cdecl;
-                                                 external 'DOSCALLS' index 348;
-
 
 
 {*****************************************************************************

tests/tbs/tb0598.pp

@@ -0,0 +1,23 @@
+
+program tb0598;
+
+{$R-}
+
+var
+  a: Cardinal;
+  b: QWord;
+  c1, c2: QWord;
+begin
+  a := 1000000;
+  b := 10000000000000000000;
+  c1 := b div a;
+  c2 := 10000000000000000000 div a;
+  Write(c1, ' = ', c2, ': ');
+  if (c1 <> c2) or (c2 <> 10000000000000) then
+  begin
+    Writeln('FAIL');
+    halt(1);
+  end
+  else
+    Writeln('OK');
+end.

tests/test/jvm/testall.bat

@@ -262,3 +262,9 @@ ppcjvm -O2 -g -B tw24089
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tw24089
 if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g -B  -CTautosetterprefix=Set ujsetter
+if %errorlevel% neq 0 exit /b %errorlevel%
+javac -encoding utf-8 -cp ..\..\..\rtl\units\jvm-java;. tjsetter.java
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tjsetter
+if %errorlevel% neq 0 exit /b %errorlevel%