* synchronised with trunk up to r26077

git-svn-id: branches/hlcgllvm@26078 -

compiler/browcol.pas

@@ -1673,6 +1673,8 @@ end;
                       Symbol^.Flags:=(Symbol^.Flags or sfObject);
                       if tobjectdef(typedef).objecttype=odt_class then
                         Symbol^.Flags:=(Symbol^.Flags or sfClass);
+                      if tobjectdef(typedef).objecttype=odt_class then
+                      if not(df_generic in typedef.defoptions) then
                       ProcessSymTable(Symbol,Symbol^.Items,tobjectdef(typedef).symtable);
                     end;
                   recorddef :

compiler/i8086/n8086mat.pas

@@ -30,6 +30,8 @@ interface
 
     type
       ti8086moddivnode = class(tmoddivnode)
+         function use_moddiv32bit_helper: boolean;
+         function first_moddivint: tnode; override;
          procedure pass_generate_code;override;
       end;
 
@@ -61,7 +63,26 @@ implementation
                              ti8086moddivnode
 *****************************************************************************}
 
-    function log2(i : dword) : dword;
+
+    function ti8086moddivnode.use_moddiv32bit_helper: boolean;
+      begin
+        result:=is_32bit(left.resultdef) or
+                is_64bit(left.resultdef) or
+                is_32bit(right.resultdef) or
+                is_64bit(right.resultdef);
+      end;
+
+
+    function ti8086moddivnode.first_moddivint: tnode;
+      begin
+        if use_moddiv32bit_helper then
+          result:=inherited first_moddivint
+        else
+          result:=nil;
+      end;
+
+
+    function log2(i : word) : word;
       begin
         result:=0;
         i:=i shr 1;
@@ -79,9 +100,9 @@ implementation
         power:longint;
         hl:Tasmlabel;
         op:Tasmop;
-        e : longint;
-        d,l,r,s,m,a,n,t : dword;
-        m_low,m_high,j,k : qword;
+        e : smallint;
+        d,l,r,s,m,a,n,t : word;
+        m_low,m_high,j,k : dword;
       begin
         secondpass(left);
         if codegenerror then
@@ -90,7 +111,7 @@ implementation
         if codegenerror then
           exit;
 
-        if is_64bitint(resultdef) then
+        if is_64bitint(resultdef) or is_32bitint(resultdef) then
           { should be handled in pass_1 (JM) }
           internalerror(200109052);
         { put numerator in register }
@@ -107,39 +128,39 @@ implementation
                   "Cardinal($ffffffff) div 16" overflows! (JM) }
                 if is_signed(left.resultdef) Then
                   begin
-                    if (current_settings.optimizecputype <> cpu_386) and
+                    if (current_settings.optimizecputype > cpu_386) and
                        not(cs_opt_size in current_settings.optimizerswitches) then
                       { use a sequence without jumps, saw this in
                         comp.compilers (JM) }
                       begin
                         { no jumps, but more operations }
                         hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                        emit_reg_reg(A_MOV,S_L,hreg1,hreg2);
-                        {If the left value is signed, hreg2=$ffffffff, otherwise 0.}
-                        emit_const_reg(A_SAR,S_L,31,hreg2);
+                        emit_reg_reg(A_MOV,S_W,hreg1,hreg2);
+                        {If the left value is signed, hreg2=$ffff, otherwise 0.}
+                        cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_16,15,hreg2);
                         {If signed, hreg2=right value-1, otherwise 0.}
-                        emit_const_reg(A_AND,S_L,tordconstnode(right).value.svalue-1,hreg2);
+                        emit_const_reg(A_AND,S_W,tordconstnode(right).value.svalue-1,hreg2);
                         { add to the left value }
-                        emit_reg_reg(A_ADD,S_L,hreg2,hreg1);
+                        emit_reg_reg(A_ADD,S_W,hreg2,hreg1);
                         { do the shift }
-                        emit_const_reg(A_SAR,S_L,power,hreg1);
+                        cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_16,power,hreg1);
                       end
                     else
                       begin
                         { a jump, but less operations }
-                        emit_reg_reg(A_TEST,S_L,hreg1,hreg1);
+                        emit_reg_reg(A_TEST,S_W,hreg1,hreg1);
                         current_asmdata.getjumplabel(hl);
                         cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NS,hl);
                         if power=1 then
-                          emit_reg(A_INC,S_L,hreg1)
+                          emit_reg(A_INC,S_W,hreg1)
                         else
-                          emit_const_reg(A_ADD,S_L,tordconstnode(right).value.svalue-1,hreg1);
+                          emit_const_reg(A_ADD,S_W,tordconstnode(right).value.svalue-1,hreg1);
                         cg.a_label(current_asmdata.CurrAsmList,hl);
-                        emit_const_reg(A_SAR,S_L,power,hreg1);
+                        cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_16,power,hreg1);
                       end
                   end
                 else
-                  emit_const_reg(A_SHR,S_L,power,hreg1);
+                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_16,power,hreg1);
                 location.register:=hreg1;
               end
             else
@@ -148,85 +169,85 @@ implementation
                   begin
                     e:=tordconstnode(right).value.svalue;
                     d:=abs(e);
-                    { Determine algorithm (a), multiplier (m), and shift factor (s) for 32-bit
+                    { Determine algorithm (a), multiplier (m), and shift factor (s) for 16-bit
                       signed integer division. Based on: Granlund, T.; Montgomery, P.L.:
                       "Division by Invariant Integers using Multiplication". SIGPLAN Notices,
                       Vol. 29, June 1994, page 61.
                     }
 
                     l:=log2(d);
-                    j:=qword($80000000) mod qword(d);
-                    k:=(qword(1) shl (32+l)) div (qword($80000000-j));
-                    m_low:=((qword(1)) shl (32+l)) div d;
-                    m_high:=(((qword(1)) shl (32+l)) + k) div d;
+                    j:=dword($8000) mod dword(d);
+                    k:=(dword(1) shl (16+l)) div (dword($8000-j));
+                    m_low:=((dword(1)) shl (16+l)) div d;
+                    m_high:=(((dword(1)) shl (16+l)) + k) div d;
                     while ((m_low shr 1) < (m_high shr 1)) and (l > 0) do
                       begin
                         m_low:=m_low shr 1;
                         m_high:=m_high shr 1;
                         dec(l);
                       end;
-                    m:=dword(m_high);
+                    m:=word(m_high);
                     s:=l;
-                    if (m_high shr 31)<>0 then
+                    if (m_high shr 15)<>0 then
                       a:=1
                     else
                       a:=0;
-                    cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
-                    emit_const_reg(A_MOV,S_L,aint(m),NR_EAX);
-                    cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-                    emit_reg(A_IMUL,S_L,hreg1);
-                    emit_reg_reg(A_MOV,S_L,hreg1,NR_EAX);
+                    cg.getcpuregister(current_asmdata.CurrAsmList,NR_AX);
+                    emit_const_reg(A_MOV,S_W,aint(m),NR_AX);
+                    cg.getcpuregister(current_asmdata.CurrAsmList,NR_DX);
+                    emit_reg(A_IMUL,S_W,hreg1);
+                    emit_reg_reg(A_MOV,S_W,hreg1,NR_AX);
                     if a<>0 then
                       begin
-                        emit_reg_reg(A_ADD,S_L,NR_EAX,NR_EDX);
+                        emit_reg_reg(A_ADD,S_W,NR_AX,NR_DX);
                         {
-                          printf ("; dividend: memory location or register other than EAX or EDX\n");
+                          printf ("; dividend: memory location or register other than AX or DX\n");
                           printf ("\n");
-                          printf ("MOV EAX, 0%08LXh\n", m);
+                          printf ("MOV AX, 0%08LXh\n", m);
                           printf ("IMUL dividend\n");
-                          printf ("MOV EAX, dividend\n");
-                          printf ("ADD EDX, EAX\n");
-                          if (s) printf ("SAR EDX, %d\n", s);
-                          printf ("SHR EAX, 31\n");
-                          printf ("ADD EDX, EAX\n");
-                          if (e < 0) printf ("NEG EDX\n");
+                          printf ("MOV AX, dividend\n");
+                          printf ("ADD DX, AX\n");
+                          if (s) printf ("SAR DX, %d\n", s);
+                          printf ("SHR AX, 15\n");
+                          printf ("ADD DX, AX\n");
+                          if (e < 0) printf ("NEG DX\n");
                           printf ("\n");
-                          printf ("; quotient now in EDX\n");
+                          printf ("; quotient now in DX\n");
                         }
                       end;
                       {
-                        printf ("; dividend: memory location of register other than EAX or EDX\n");
+                        printf ("; dividend: memory location of register other than AX or DX\n");
                         printf ("\n");
-                        printf ("MOV EAX, 0%08LXh\n", m);
+                        printf ("MOV AX, 0%08LXh\n", m);
                         printf ("IMUL dividend\n");
-                        printf ("MOV EAX, dividend\n");
-                        if (s) printf ("SAR EDX, %d\n", s);
-                        printf ("SHR EAX, 31\n");
-                        printf ("ADD EDX, EAX\n");
-                        if (e < 0) printf ("NEG EDX\n");
+                        printf ("MOV AX, dividend\n");
+                        if (s) printf ("SAR DX, %d\n", s);
+                        printf ("SHR AX, 15\n");
+                        printf ("ADD DX, AX\n");
+                        if (e < 0) printf ("NEG DX\n");
                         printf ("\n");
-                        printf ("; quotient now in EDX\n");
+                        printf ("; quotient now in DX\n");
                       }
                     if s<>0 then
-                      emit_const_reg(A_SAR,S_L,s,NR_EDX);
-                    emit_const_reg(A_SHR,S_L,31,NR_EAX);
-                    emit_reg_reg(A_ADD,S_L,NR_EAX,NR_EDX);
+                      cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_16,s,NR_DX);
+                    cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_16,15,NR_AX);
+                    emit_reg_reg(A_ADD,S_W,NR_AX,NR_DX);
                     if e<0 then
-                      emit_reg(A_NEG,S_L,NR_EDX);
-                    cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-                    cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+                      emit_reg(A_NEG,S_W,NR_DX);
+                    cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_DX);
+                    cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX);
                     location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                    cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register)
+                    cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_DX,location.register)
                   end
                 else
                   begin
                     d:=tordconstnode(right).value.svalue;
-                    if d>=$80000000 then
+                    if d>=$8000 then
                       begin
-                        emit_const_reg(A_CMP,S_L,aint(d),hreg1);
+                        emit_const_reg(A_CMP,S_W,aint(d),hreg1);
                         location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                        emit_const_reg(A_MOV,S_L,0,location.register);
-                        emit_const_reg(A_SBB,S_L,-1,location.register);
+                        emit_const_reg(A_MOV,S_W,0,location.register);
+                        emit_const_reg(A_SBB,S_W,-1,location.register);
                       end
                     else
                       begin
@@ -243,19 +264,19 @@ implementation
                         SIGPLAN Notices, Vol. 29, June 1994, page 61.
                         }
                         l:=log2(t)+1;
-                        j:=qword($ffffffff) mod qword(t);
-                        k:=(qword(1) shl (32+l)) div (qword($ffffffff-j));
-                        m_low:=((qword(1)) shl (32+l)) div t;
-                        m_high:=(((qword(1)) shl (32+l)) + k) div t;
+                        j:=dword($ffff) mod dword(t);
+                        k:=(dword(1) shl (16+l)) div (dword($ffff-j));
+                        m_low:=((dword(1)) shl (16+l)) div t;
+                        m_high:=(((dword(1)) shl (16+l)) + k) div t;
                         while ((m_low shr 1) < (m_high shr 1)) and (l>0) do
                           begin
                             m_low:=m_low shr 1;
                             m_high:=m_high shr 1;
                             l:=l-1;
                           end;
-                        if (m_high shr 32)=0 then
+                        if (m_high shr 16)=0 then
                           begin
-                            m:=dword(m_high);
+                            m:=word(m_high);
                             s:=l;
                             a:=0;
                           end
@@ -267,12 +288,12 @@ implementation
                         else
                           begin
                             s:=log2(t);
-                            m_low:=(qword(1) shl (32+s)) div qword(t);
-                            r:=dword(((qword(1)) shl (32+s)) mod qword(t));
+                            m_low:=(dword(1) shl (16+s)) div dword(t);
+                            r:=word(((dword(1)) shl (16+s)) mod dword(t));
                             if (r < ((t>>1)+1)) then
-                              m:=dword(m_low)
+                              m:=word(m_low)
                             else
-                              m:=dword(m_low)+1;
+                              m:=word(m_low)+1;
                             a:=1;
                           end;
                         { Reduce multiplier for either algorithm to smallest possible }
@@ -283,72 +304,72 @@ implementation
                           end;
                         { Adjust multiplier for reduction of even divisors }
                         inc(s,n);
-                        cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
-                        emit_const_reg(A_MOV,S_L,aint(m),NR_EAX);
-                        cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-                        emit_reg(A_MUL,S_L,hreg1);
+                        cg.getcpuregister(current_asmdata.CurrAsmList,NR_AX);
+                        emit_const_reg(A_MOV,S_W,aint(m),NR_AX);
+                        cg.getcpuregister(current_asmdata.CurrAsmList,NR_DX);
+                        emit_reg(A_MUL,S_W,hreg1);
                         if a<>0 then
                           begin
                             {
-                            printf ("; dividend: register other than EAX or memory location\n");
+                            printf ("; dividend: register other than AX or memory location\n");
                             printf ("\n");
-                            printf ("MOV EAX, 0%08lXh\n", m);
+                            printf ("MOV AX, 0%08lXh\n", m);
                             printf ("MUL dividend\n");
-                            printf ("ADD EAX, 0%08lXh\n", m);
-                            printf ("ADC EDX, 0\n");
-                            if (s) printf ("SHR EDX, %d\n", s);
+                            printf ("ADD AX, 0%08lXh\n", m);
+                            printf ("ADC DX, 0\n");
+                            if (s) printf ("SHR DX, %d\n", s);
                             printf ("\n");
-                            printf ("; quotient now in EDX\n");
+                            printf ("; quotient now in DX\n");
                             }
-                            emit_const_reg(A_ADD,S_L,aint(m),NR_EAX);
-                            emit_const_reg(A_ADC,S_L,0,NR_EDX);
+                            emit_const_reg(A_ADD,S_W,aint(m),NR_AX);
+                            emit_const_reg(A_ADC,S_W,0,NR_DX);
                           end;
                         if s<>0 then
-                          emit_const_reg(A_SHR,S_L,aint(s),NR_EDX);
-                        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-                        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+                          cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_16,aint(s),NR_DX);
+                        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_DX);
+                        cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX);
                         location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register)
+                        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_DX,location.register)
                       end;
                   end
               end
           end
         else
           begin
-            cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
-            emit_reg_reg(A_MOV,S_L,hreg1,NR_EAX);
-            cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
+            cg.getcpuregister(current_asmdata.CurrAsmList,NR_AX);
+            emit_reg_reg(A_MOV,S_W,hreg1,NR_AX);
+            cg.getcpuregister(current_asmdata.CurrAsmList,NR_DX);
             {Sign extension depends on the left type.}
-            if torddef(left.resultdef).ordtype=u32bit then
-              emit_reg_reg(A_XOR,S_L,NR_EDX,NR_EDX)
+            if torddef(left.resultdef).ordtype=u16bit then
+              emit_reg_reg(A_XOR,S_W,NR_DX,NR_DX)
             else
-              emit_none(A_CDQ,S_NO);
+              emit_none(A_CWD,S_NO);
 
             {Division depends on the right type.}
-            if Torddef(right.resultdef).ordtype=u32bit then
+            if Torddef(right.resultdef).ordtype=u16bit then
               op:=A_DIV
             else
               op:=A_IDIV;
 
             if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
-              emit_ref(op,S_L,right.location.reference)
+              emit_ref(op,S_W,right.location.reference)
             else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-              emit_reg(op,S_L,right.location.register)
+              emit_reg(op,S_W,right.location.register)
             else
               begin
                 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,right.location.size);
-                hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,u32inttype,right.location,hreg1);
-                emit_reg(op,S_L,hreg1);
+                hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,u16inttype,right.location,hreg1);
+                emit_reg(op,S_W,hreg1);
               end;
 
-            {Copy the result into a new register. Release EAX & EDX.}
-            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+            {Copy the result into a new register. Release AX & DX.}
+            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_DX);
+            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX);
             location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
             if nodetype=divn then
-              cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register)
+              cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_AX,location.register)
             else
-              cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register);
+              cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_DX,location.register);
           end;
       end;
 

compiler/ogelf.pas

@@ -884,7 +884,7 @@ implementation
               dec(data,len);
             if ElfTarget.relocs_use_addend then
               begin
-                objreloc.orgsize:=data;
+                objreloc.orgsize:=aword(data);
                 data:=0;
               end;
           end;
@@ -1076,7 +1076,9 @@ implementation
 
             rel.address:=objreloc.dataoffset;
             rel.info:=ELF_R_INFO(relsym,ElfTarget.encodereloc(objreloc));
+{$push}{$r-}
             rel.addend:=objreloc.orgsize;
+{$pop}
 
             { write reloc }
             { ElfXX_Rel is essentially ElfXX_Rela without the addend field. }
@@ -3114,7 +3116,9 @@ implementation
       begin
         rel.address:=dataofs;
         rel.info:=ELF_R_INFO(symidx,typ);
+{$push}{$r-}
         rel.addend:=addend;
+{$pop}
         MaybeSwapElfReloc(rel);
         dynrelocsec.write(rel,dynrelocsec.shentsize);
       end;

compiler/x86_64/nx64flw.pas

@@ -143,6 +143,7 @@ function create_pd: tprocdef;
   var
     st:TSymTable;
     checkstack: psymtablestackitem;
+    oldsymtablestack: tsymtablestack;
     sym:tprocsym;
   begin
     { get actual procedure symtable (skip withsymtables, etc.) }
@@ -155,8 +156,16 @@ function create_pd: tprocdef;
             break;
           checkstack:=checkstack^.next;
       end;
-    { Create a nested procedure, even from main_program_level. }
+    { Create a nested procedure, even from main_program_level.
+      Furthermore, force procdef and procsym into the same symtable
+      (by default, defs are registered with symtablestack.top which may be
+      something temporary like exceptsymtable - in that case, procdef can be
+      destroyed before procsym, leaving invalid pointers). }
+    oldsymtablestack:=symtablestack;
+    symtablestack:=nil;
     result:=tprocdef.create(max(normal_function_level,st.symtablelevel)+1);
+    symtablestack:=oldsymtablestack;
+    st.insertdef(result);
     result.struct:=current_procinfo.procdef.struct;
     result.proctypeoption:=potype_exceptfilter;
     handle_calling_convention(result);

ide/fphelp.pas

@@ -183,7 +183,7 @@ const
       hint_reloadmodifiedfile= 'Reload file modified on disk';
       hint_tools             = 'Create or change tools';
       hint_environmentmenu   = 'Specify environment settins';
-      hint_preferences       = 'Specify desktop settings';
+      hint_preferences       = 'Specify preferences settings';
       hint_editoroptions     = 'Specify default editor settings';
       hint_codecomplete      = 'Specify CodeComplete keywords';
       hint_codetemplates     = 'Specify CodeTemplates';

ide/fpide.pas

@@ -875,7 +875,7 @@ begin
 {$endif DebugUndo}
       NewLine(
       NewItem(menu_edit_cut,menu_key_edit_cut, cut_key, cmCut, hcCut,
-      NewItem(menu_edit_copy,menu_key_edit_copy, copy_key, cmCopy, hcCut,
+      NewItem(menu_edit_copy,menu_key_edit_copy, copy_key, cmCopy, hcCopy,
       NewItem(menu_edit_paste,menu_key_edit_paste, paste_key, cmPaste, hcPaste,
       NewItem(menu_edit_clear,menu_key_edit_clear, kbCtrlDel, cmClear, hcClear,
       NewItem(menu_edit_selectall,'', kbNoKey, cmSelectAll, hcSelectAll,
@@ -934,7 +934,7 @@ begin
       NewItem('~E~valuate...','Ctrl+F4', kbCtrlF4, cmEvaluate, hcEvaluate,
       NewItem(menu_debug_callstack,menu_key_debug_callstack, kbCtrlF3, cmStack, hcStackWindow,
       NewLine(
-      NewItem(menu_debug_disassemble,'', kbNoKey, cmDisassemble, hcStackWindow,
+      NewItem(menu_debug_disassemble,'', kbNoKey, cmDisassemble, hcDisassemblyWindow,
       NewItem(menu_debug_registers,'', kbNoKey, cmRegisters, hcRegistersWindow,
       NewItem(menu_debug_fpu_registers,'', kbNoKey, cmFPURegisters, hcFPURegisters,
       NewItem(menu_debug_vector_registers,'', kbNoKey, cmVectorRegisters, hcVectorRegisters,

ide/wconstse.inc

@@ -99,9 +99,9 @@
     msg_cutting = 'Cutting';
     { Help system }
 
-    msg_nohelpfilesinstalled1 = 'To keep the size of the FPC download reasonable low, it comes without html formatted docs';
+    msg_nohelpfilesinstalled1 = 'To keep the size of the FPC download reasonably low, it comes without html formatted docs';
     msg_nohelpfilesinstalled2 = 'which are necessary for the IDE.';
-    msg_nohelpfilesinstalled3 = 'To get these docs, go to http://www.freepascal.org/down/docs/docs.html and get one';
+    msg_nohelpfilesinstalled3 = 'To get these docs, go to http://www.freepascal.org/down/docs/docs.var and get one';
     msg_nohelpfilesinstalled4 = 'of the html doc archives and unpack the enclosed contents into your FPC directory.';
     msg_nohelpfilesinstalled5 = 'Add fpctoc.html via Help|Files ... to the IDE help file system.';
     msg_helpindex = 'Help index';

rtl/go32v2/v2prt0.as

@@ -857,6 +857,7 @@ _pascal_start:
         movl    12(%ebx),%eax
         movl    %eax,operatingsystem_parameter_envp
         movl    %eax,__environ
+        movl    %eax,_environ
         movl    8(%ebx),%eax
         movl    %eax,_args
         movl    4(%ebx),%eax
@@ -895,9 +896,10 @@ ___v2prt0_start_fs:
          /* corresponding to _environ C variable */
          /* instead of _environ symbol since commit rev 1.11 */
          /* Thu Aug 19 9:11:52 2004 UTC by peuha */
-         /* _environ is provided by linker script at the same address */
-         /* as __environ if needed by linker. */
+         /* Provide both here to avoid crt1.o loading. */
         .comm  __environ,4
+        .comm  _environ,4
+
 
 /* Here Pierre Muller added all what was in crt1.c  */
 /* in assembler                              */

rtl/inc/genmath.inc

@@ -136,122 +136,18 @@ end;
 type
   float32 = longint;
 {$endif FPC_SYSTEM_HAS_float32}
-{$ifndef FPC_SYSTEM_HAS_flag}
-type
-  flag = byte;
-{$endif FPC_SYSTEM_HAS_flag}
-
-{$ifndef FPC_SYSTEM_HAS_extractFloat64Frac0}
-  Function extractFloat64Frac0(const a: float64): longint;
-    Begin
-      extractFloat64Frac0 := a.high and $000FFFFF;
-    End;
-{$endif not FPC_SYSTEM_HAS_extractFloat64Frac0}
-
-
-{$ifndef FPC_SYSTEM_HAS_extractFloat64Frac1}
-  Function extractFloat64Frac1(const a: float64): longint;
-    Begin
-      extractFloat64Frac1 := a.low;
-    End;
-{$endif not FPC_SYSTEM_HAS_extractFloat64Frac1}
-
-
-{$ifndef FPC_SYSTEM_HAS_extractFloat64Exp}
-  Function extractFloat64Exp(const a: float64): smallint;
-    Begin
-       extractFloat64Exp:= ( a.high shr 20 ) AND $7FF;
-    End;
-{$endif not FPC_SYSTEM_HAS_extractFloat64Exp}
-
 
-{$ifndef FPC_SYSTEM_HAS_extractFloat64Frac}
-  Function extractFloat64Frac(const a: float64): int64;
-    Begin
-      extractFloat64Frac:=int64(a) and $000FFFFFFFFFFFFF;
-    End;
-{$endif not FPC_SYSTEM_HAS_extractFloat64Frac}
-
-
-{$ifndef FPC_SYSTEM_HAS_extractFloat64Sign}
-  Function extractFloat64Sign(const a: float64) : flag;
-    Begin
-       extractFloat64Sign := a.high shr 31;
-    End;
-{$endif not FPC_SYSTEM_HAS_extractFloat64Sign}
-
-
-  Procedure shortShift64Left(a0:longint; a1:longint; count:smallint; VAR z0Ptr:longint; VAR z1Ptr:longint );
-    Begin
-        z1Ptr := a1 shl count;
-        if count = 0 then
-          z0Ptr := a0
-        else
-          z0Ptr := ( a0 shl count ) OR ( a1 shr ( ( - count ) AND 31 ) );
-    End;
-
-   function float64_to_int32_round_to_zero(a: float64 ): longint;
-     Var
-       aSign: flag;
-       aExp, shiftCount: smallint;
-       aSig0, aSig1, absZ, aSigExtra: longint;
-       z: longint;
-     label
-       invalid;
-     Begin
-       aSig1 := extractFloat64Frac1( a );
-       aSig0 := extractFloat64Frac0( a );
-       aExp := extractFloat64Exp( a );
-       aSign := extractFloat64Sign( a );
-       shiftCount := aExp - $413;
-       if 0<=shiftCount then
-       Begin
-          if (aExp=$7FF)  and ((aSig0 or aSig1)<>0) then
-            goto invalid;
-          shortShift64Left(aSig0 OR  $00100000, aSig1, shiftCount, absZ, aSigExtra );
-       End
-       else
-       Begin
-           if aExp<$3FF then
-             begin
-               float64_to_int32_round_to_zero := 0;
-               exit;
-             end;
-           aSig0 := aSig0 or $00100000;
-           aSigExtra := ( aSig0 shl ( shiftCount and 31 ) ) OR  aSig1;
-           absZ := aSig0 shr ( - shiftCount );
-       End;
-       if aSign<>0 then
-         z:=-absZ
-       else
-         z:=absZ;
-       if ((aSign<>0) xor (z<0)) AND  (z<>0) then
-         begin
-invalid:
-           float_raise(float_flag_invalid);
-           if (aSign <> 0) then
-             float64_to_int32_round_to_zero:=longint($80000000)
-           else
-             float64_to_int32_round_to_zero:=$7FFFFFFF;
-           exit;
-         end;
-       if ( aSigExtra <> 0) then
-         float_raise(float_flag_inexact);
-
-       float64_to_int32_round_to_zero := z;
-     End;
-
-
-   function genmath_float64_to_int64_round_to_zero(a : float64) : int64;
+{$ifdef SUPPORT_DOUBLE}
+   { based on softfloat float64_to_int64_round_to_zero }
+   function fpc_trunc_real(d : valreal) : int64; compilerproc;
      var
-       aSign : flag;
        aExp, shiftCount : smallint;
        aSig : int64;
        z : int64;
+       a: float64 absolute d;
      begin
-       aSig:=extractFloat64Frac(a);
-       aExp:=extractFloat64Exp(a);
-       aSign:=extractFloat64Sign(a);
+       aSig:=(int64(a.high and $000fffff) shl 32) or longword(a.low);
+       aExp:=(a.high shr 20) and $7FF;
        if aExp<>0 then
          aSig:=aSig or $0010000000000000;
        shiftCount:= aExp-$433;
@@ -259,10 +155,10 @@ invalid:
          begin
            if aExp>=$43e then
              begin
-               if int64(a)<>$C3E0000000000000 then
+               if (a.high<>$C3E00000) or (a.low<>0) then
                  begin
                    float_raise(float_flag_invalid);
-                   if (aSign=0) or ((aExp=$7FF) and
+                   if (a.high>=0) or ((aExp=$7FF) and
                       (aSig<>$0010000000000000 )) then
                      begin
                        result:=$7FFFFFFFFFFFFFFF;
@@ -287,71 +183,50 @@ invalid:
              float_exception_flags |= float_flag_inexact;
            }
          end;
-       if aSign<>0 then
+       if a.high<0 then
          z:=-z;
        result:=z;
      end;
 
-
-  Function float32_to_int32_round_to_zero( a: Float32 ): longint;
+{$else SUPPORT_DOUBLE}
+  { based on softfloat float32_to_int64_round_to_zero }
+  Function fpc_trunc_real( d: valreal ): int64; compilerproc;
     Var
-       aSign : flag;
+       a : float32 absolute d;
        aExp, shiftCount : smallint;
        aSig : longint;
-       z : longint;
+       aSig64, z : int64;
     Begin
        aSig := a and $007FFFFF;
        aExp := (a shr 23) and $FF;
-       aSign := a shr 31;
-       shiftCount := aExp - $9E;
+       shiftCount := aExp - $BE;
        if ( 0 <= shiftCount ) then
          Begin
-           if ( a <> Float32($CF000000) ) then
+           if ( a <> Float32($DF000000) ) then
              Begin
                float_raise( float_flag_invalid );
-               if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
+               if ( (a>=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
                  Begin
-                   float32_to_int32_round_to_zero:=$7fffffff;
+                   result:=$7fffffffffffffff;
                    exit;
                  end;
              End;
-           float32_to_int32_round_to_zero:=longint($80000000);
+           result:=$8000000000000000;
            exit;
          End
        else
          if ( aExp <= $7E ) then
          Begin
-           float32_to_int32_round_to_zero := 0;
+           result := 0;
            exit;
          End;
-       aSig := ( aSig or $00800000 ) shl 8;
-       z := aSig shr ( - shiftCount );
-       if ( aSign<>0 ) then z := - z;
-       float32_to_int32_round_to_zero := z;
+       aSig64 := int64( aSig or $00800000 ) shl 40;
+       z := aSig64 shr ( - shiftCount );
+       if ( a<0 ) then z := - z;
+       result := z;
     End;
+{$endif SUPPORT_DOUBLE}
 
-
-  function fpc_trunc_real(d : ValReal) : int64;compilerproc;
-    var
-     f32 : float32;
-     f64 : float64;
-    Begin
-     { in emulation mode the real is equal to a single }
-     { otherwise in fpu mode, it is equal to a double  }
-     { extended is not supported yet. }
-     if sizeof(D) > 8 then
-        HandleError(255);
-     if sizeof(D)=8 then
-       begin
-         move(d,f64,sizeof(f64));
-         result:=genmath_float64_to_int64_round_to_zero(f64);
-       end
-     else
-       begin
-         move(d,f32,sizeof(f32));
-         result:=float32_to_int32_round_to_zero(f32);
-       end;
-    end;
 {$endif not FPC_SYSTEM_HAS_TRUNC}
 
 

rtl/msdos/prt0stm.asm

@@ -31,6 +31,10 @@
         extern __nearheap_start
         extern __nearheap_end
 
+        extern __SaveInt00
+
+        extern FPC_HANDLEERROR
+
 %ifdef __TINY__
         resb 0100h
 %endif
@@ -175,6 +179,113 @@ error_msg:
         mov ax, 4CFFh
         int 21h
 
+FPC_INT00_HANDLER:
+        sub sp, 4  ; reserve space on the stack for the retf
+
+        push bx
+        push cx
+        push ds
+
+        ; init ds
+%ifdef __TINY__
+        mov bx, cs
+%else
+        mov bx, dgroup
+%endif
+        mov ds, bx
+
+        ; check whether we're running on the same stack
+        mov cx, ss
+        cmp bx, cx
+        jne .call_previous_handler
+
+%ifndef __FAR_CODE__
+        ; check whether we're coming from the same code segment
+        mov bx, sp
+        mov cx, [bx + 3*2 + 6]  ; get caller segment
+        mov bx, cs
+        cmp bx, cx
+        jne .call_previous_handler
+%endif
+
+        ; runerror 200
+        mov bx, sp
+        mov cx, [bx + 3*2 + 4]  ; get caller offset
+%ifdef __FAR_CODE__
+        mov dx, [bx + 3*2 + 6]  ; get caller segment
+%endif
+        add sp, 3*2 + 4 + 6
+        xor ax, ax
+        push ax
+        mov ax, 200
+        push ax
+%ifdef __FAR_CODE__
+        push dx
+%endif
+        push cx
+%ifdef __FAR_CODE__
+        jmp far FPC_HANDLEERROR
+%else
+        jmp FPC_HANDLEERROR
+%endif
+
+.call_previous_handler:
+        mov bx, sp
+        mov cx, [__SaveInt00]
+        mov [ss:bx + 3*2], cx
+        mov cx, [__SaveInt00+2]
+        mov [ss:bx + 3*2 + 2], cx
+        pop ds
+        pop cx
+        pop bx
+        retf  ; jumps to the previous handler with all registers and stack intact
+
+
+
+        global FPC_INSTALL_INTERRUPT_HANDLERS
+FPC_INSTALL_INTERRUPT_HANDLERS:
+        push ds
+
+        ; save old int 00 handler
+        mov ax, 3500h
+        int 21h
+        mov [__SaveInt00], bx
+        mov bx, es
+        mov [__SaveInt00+2], bx
+
+        ; install the new int 00 handler
+%ifndef __TINY__
+        push cs
+        pop ds
+%endif
+        mov dx, FPC_INT00_HANDLER
+        mov ax, 2500h
+        int 21h
+
+        pop ds
+%ifdef __FAR_CODE__
+        retf
+%else
+        ret
+%endif
+
+
+        global FPC_RESTORE_INTERRUPT_HANDLERS
+FPC_RESTORE_INTERRUPT_HANDLERS:
+        push ds
+
+        mov ax, 2500h
+        lds dx, [__SaveInt00]
+        int 21h
+
+        pop ds
+%ifdef __FAR_CODE__
+        retf
+%else
+        ret
+%endif
+
+
         global FPC_MSDOS_CARRY
 FPC_MSDOS_CARRY:
         stc

rtl/msdos/system.pp

@@ -63,6 +63,8 @@ var
 
   dos_psp:Word;public name 'dos_psp';
 
+  SaveInt00: FarPointer;public name '__SaveInt00';
+
   AllFilesMask: string [3];
 {$ifndef RTLLITE}
 { System info }
@@ -111,6 +113,9 @@ procedure MsDos(var Regs: Registers); external name 'FPC_MSDOS';
   support them }
 procedure MsDos_Carry(var Regs: Registers); external name 'FPC_MSDOS_CARRY';
 
+procedure InstallInterruptHandlers; external name 'FPC_INSTALL_INTERRUPT_HANDLERS';
+procedure RestoreInterruptHandlers; external name 'FPC_RESTORE_INTERRUPT_HANDLERS';
+
 {$I system.inc}
 
 {$I tinyheap.inc}
@@ -264,6 +269,7 @@ procedure system_exit;
 var
   h : byte;
 begin
+  RestoreInterruptHandlers;
   for h:=0 to max_files-1 do
     if openfiles[h] then
       begin
@@ -333,6 +339,7 @@ begin
   StackTop := __stktop;
   StackBottom := __stkbottom;
   StackLength := __stktop - __stkbottom;
+  InstallInterruptHandlers;
   if DetectFPU then
     SysInitFPU;
   { To be set if this is a GUI or console application }

tests/test/tobjc36.pp

@@ -20,6 +20,11 @@ type
     procedure extraproc(a: longint); override;
   end;
 
+  MyObject2 = objcclass(NSObject)
+    // overrides extraproc added to NSObject
+    procedure extraproc(a: longint); override;
+  end;
+
 procedure MyCategory.extraproc(a: longint);
   begin
     if a<>1 then
@@ -33,10 +38,18 @@ procedure MyObject.extraproc(a: longint);
     inherited extraproc(1);
   end;
 
+procedure MyObject2.extraproc(a: longint);
+  begin
+    if a<>3 then
+      halt(3);
+    inherited extraproc(1);
+  end;
+
 
 var
   a: NSObject;
   b: MyObject;
+  c: MyObject2;
 begin
   a:=NSObject.alloc.init;
   a.extraproc(1);
@@ -44,4 +57,7 @@ begin
   b:=MyObject.alloc.init;
   b.extraproc(2);
   b.release;
+  c:=MyObject.alloc.init;
+  c.extraproc(2);
+  c.release;
 end.

utils/dxegen/fpmake.pp

@@ -29,7 +29,7 @@ begin
     P.Directory:=ADirectory;
     P.Version:='2.7.1';
 
-    T:=P.Targets.AddProgram('dxegen.pas');
+    T:=P.Targets.AddProgram('dxegen.pp');
     T.Dependencies.AddUnit('coff');
 
     P.Targets.AddUnit('coff.pp').install:=false;