From 11800f0804ebccbd0744721b40cebf1d887f10a6 Mon Sep 17 00:00:00 2001 From: marco Date: Mon, 11 Nov 2013 11:21:08 +0000 Subject: [PATCH 01/14] * hints fixes by AlexL, Mantis #25230 git-svn-id: trunk@26059 - --- ide/fphelp.pas | 2 +- ide/fpide.pas | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ide/fphelp.pas b/ide/fphelp.pas index ac300ffe72..aafc1b8fa9 100644 --- a/ide/fphelp.pas +++ b/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'; diff --git a/ide/fpide.pas b/ide/fpide.pas index f96e651593..dacea17928 100644 --- a/ide/fpide.pas +++ b/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, From bd083c0b8e87e60ec47f628353a5c3392bd0e918 Mon Sep 17 00:00:00 2001 From: nickysn Date: Mon, 11 Nov 2013 21:01:13 +0000 Subject: [PATCH 02/14] * ti8086moddivnode.pass_generate_code converted to 16-bit. Note that this code is still not active, due to the cpuneedsdiv32helper define, but will eventually be enabled for 16-bit divisions. git-svn-id: trunk@26062 - --- compiler/i8086/n8086mat.pas | 200 ++++++++++++++++++------------------ 1 file changed, 100 insertions(+), 100 deletions(-) diff --git a/compiler/i8086/n8086mat.pas b/compiler/i8086/n8086mat.pas index d8feaba51f..beccd1f28e 100644 --- a/compiler/i8086/n8086mat.pas +++ b/compiler/i8086/n8086mat.pas @@ -61,7 +61,7 @@ implementation ti8086moddivnode *****************************************************************************} - function log2(i : dword) : dword; + function log2(i : word) : word; begin result:=0; i:=i shr 1; @@ -79,9 +79,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 +90,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 +107,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.} + emit_const_reg(A_SAR,S_W,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); + emit_const_reg(A_SAR,S_W,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); + emit_const_reg(A_SAR,S_W,power,hreg1); end end else - emit_const_reg(A_SHR,S_L,power,hreg1); + emit_const_reg(A_SHR,S_W,power,hreg1); location.register:=hreg1; end else @@ -148,85 +148,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); + emit_const_reg(A_SAR,S_W,s,NR_DX); + emit_const_reg(A_SHR,S_W,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 +243,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 +267,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 +283,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); + emit_const_reg(A_SHR,S_W,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; From dc432918daa56f8fbcfdad93697c7b017e9e0096 Mon Sep 17 00:00:00 2001 From: nickysn Date: Mon, 11 Nov 2013 22:34:41 +0000 Subject: [PATCH 03/14] + enabled the use of the DIV/IDIV instruction for 16-bit div/mod on i8086 * ti8086.moddivnode.pass_generate_code: use cg.a_op_const_reg, instead of emit_const_reg, in order to support generating plain 8086/8088 code (shr/shl/sar reg,const is 186+ if const is >= 2). git-svn-id: trunk@26063 - --- compiler/i8086/n8086mat.pas | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/compiler/i8086/n8086mat.pas b/compiler/i8086/n8086mat.pas index beccd1f28e..869efa8220 100644 --- a/compiler/i8086/n8086mat.pas +++ b/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,6 +63,25 @@ implementation ti8086moddivnode *****************************************************************************} + + 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; @@ -116,13 +137,13 @@ implementation hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); emit_reg_reg(A_MOV,S_W,hreg1,hreg2); {If the left value is signed, hreg2=$ffff, otherwise 0.} - emit_const_reg(A_SAR,S_W,15,hreg2); + 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_W,tordconstnode(right).value.svalue-1,hreg2); { add to the left value } emit_reg_reg(A_ADD,S_W,hreg2,hreg1); { do the shift } - emit_const_reg(A_SAR,S_W,power,hreg1); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_16,power,hreg1); end else begin @@ -135,11 +156,11 @@ implementation else 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_W,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_W,power,hreg1); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_16,power,hreg1); location.register:=hreg1; end else @@ -208,8 +229,8 @@ implementation printf ("; quotient now in DX\n"); } if s<>0 then - emit_const_reg(A_SAR,S_W,s,NR_DX); - emit_const_reg(A_SHR,S_W,15,NR_AX); + 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_W,NR_DX); @@ -304,7 +325,7 @@ implementation emit_const_reg(A_ADC,S_W,0,NR_DX); end; if s<>0 then - emit_const_reg(A_SHR,S_W,aint(s),NR_DX); + 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); From 5f744ff3557d9267b950dcabae60da117f845db6 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Mon, 11 Nov 2013 22:46:19 +0000 Subject: [PATCH 04/14] * fixed spelling error and updated link where to download the html docs git-svn-id: trunk@26064 - --- ide/wconstse.inc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ide/wconstse.inc b/ide/wconstse.inc index 6afdaa77c3..f6db04f4b2 100644 --- a/ide/wconstse.inc +++ b/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'; From 897c8b8f7bf7a4a7d94f1187f0633f324bb5033c Mon Sep 17 00:00:00 2001 From: sergei Date: Tue, 12 Nov 2013 09:31:23 +0000 Subject: [PATCH 05/14] * Cleanup fpc_trunc_real implementation. * For single-precision variant, truncate to 64 bits instead of 32, since this how trunc()/round() are defined. * Do not access float64 as int64, doing so would break on ARM hardfloat after r26010. git-svn-id: trunk@26065 - --- rtl/inc/genmath.inc | 175 +++++++------------------------------------- 1 file changed, 25 insertions(+), 150 deletions(-) diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc index d78d843ee7..90f38d2f31 100644 --- a/rtl/inc/genmath.inc +++ b/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} From 3e393b867b0d33b3bdf706f4603be923dac8c252 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 12 Nov 2013 10:30:28 +0000 Subject: [PATCH 06/14] * small extension of the test git-svn-id: trunk@26066 - --- tests/test/tobjc36.pp | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/test/tobjc36.pp b/tests/test/tobjc36.pp index 1dcf9d7907..00cf92efd8 100644 --- a/tests/test/tobjc36.pp +++ b/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. From 864a72ee695086f767eb33f98d892b0a6da529f4 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Tue, 12 Nov 2013 16:11:17 +0000 Subject: [PATCH 07/14] * fixed (harmless) range errors git-svn-id: trunk@26067 - --- compiler/ogelf.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/ogelf.pas b/compiler/ogelf.pas index ce3bd0aa8f..f964d394a0 100644 --- a/compiler/ogelf.pas +++ b/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; From 2370669f86159b28b796b419745367d0d09929a7 Mon Sep 17 00:00:00 2001 From: pierre Date: Tue, 12 Nov 2013 16:39:20 +0000 Subject: [PATCH 08/14] Avoid infinite recursion on generic classes for IDE browser git-svn-id: trunk@26068 - --- compiler/browcol.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/browcol.pas b/compiler/browcol.pas index 8cc679daee..3a96878ccd 100644 --- a/compiler/browcol.pas +++ b/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 : From f6f183f866271779381e980ef3e985e4ae6c842e Mon Sep 17 00:00:00 2001 From: pierre Date: Tue, 12 Nov 2013 16:41:08 +0000 Subject: [PATCH 09/14] Put both _environ and __environ as .comm inside startup script to avoid crt1.o loading git-svn-id: trunk@26069 - --- rtl/go32v2/v2prt0.as | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/rtl/go32v2/v2prt0.as b/rtl/go32v2/v2prt0.as index c4d2366ab8..5d1aabe478 100644 --- a/rtl/go32v2/v2prt0.as +++ b/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 */ From 06c5acf69a33af6812079fb571ccd965c43a3dd7 Mon Sep 17 00:00:00 2001 From: nickysn Date: Tue, 12 Nov 2013 22:05:05 +0000 Subject: [PATCH 10/14] + added division by zero exception handling for i8086-msdos git-svn-id: trunk@26073 - --- rtl/msdos/prt0stm.asm | 107 ++++++++++++++++++++++++++++++++++++++++++ rtl/msdos/system.pp | 7 +++ 2 files changed, 114 insertions(+) diff --git a/rtl/msdos/prt0stm.asm b/rtl/msdos/prt0stm.asm index 50b240c45d..934269d4de 100644 --- a/rtl/msdos/prt0stm.asm +++ b/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,109 @@ 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 __MEDIUM__ + ; 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 __MEDIUM__ + 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 __MEDIUM__ + push dx +%endif + push cx + jmp FPC_HANDLEERROR + +.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 diff --git a/rtl/msdos/system.pp b/rtl/msdos/system.pp index 565823980d..23f190f82d 100644 --- a/rtl/msdos/system.pp +++ b/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 } From b6c02c651f634668c0879dfe6b07755556d6672b Mon Sep 17 00:00:00 2001 From: nickysn Date: Wed, 13 Nov 2013 00:40:12 +0000 Subject: [PATCH 11/14] * use %ifdef __FAR_CODE__ instead of %ifdef __MEDIUM__ in the int 0 handler (for compatibility with future memory models) git-svn-id: trunk@26074 - --- rtl/msdos/prt0stm.asm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/rtl/msdos/prt0stm.asm b/rtl/msdos/prt0stm.asm index 934269d4de..29f5e1b5ce 100644 --- a/rtl/msdos/prt0stm.asm +++ b/rtl/msdos/prt0stm.asm @@ -199,7 +199,7 @@ FPC_INT00_HANDLER: cmp bx, cx jne .call_previous_handler -%ifndef __MEDIUM__ +%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 @@ -211,7 +211,7 @@ FPC_INT00_HANDLER: ; runerror 200 mov bx, sp mov cx, [bx + 3*2 + 4] ; get caller offset -%ifdef __MEDIUM__ +%ifdef __FAR_CODE__ mov dx, [bx + 3*2 + 6] ; get caller segment %endif add sp, 3*2 + 4 + 6 @@ -219,7 +219,7 @@ FPC_INT00_HANDLER: push ax mov ax, 200 push ax -%ifdef __MEDIUM__ +%ifdef __FAR_CODE__ push dx %endif push cx From 9bfb25ff4c4dba9a08355fae91ff8751ea782c5c Mon Sep 17 00:00:00 2001 From: nickysn Date: Wed, 13 Nov 2013 00:42:47 +0000 Subject: [PATCH 12/14] * use a far jmp to FPC_HANDLEERROR in far code memory models git-svn-id: trunk@26075 - --- rtl/msdos/prt0stm.asm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rtl/msdos/prt0stm.asm b/rtl/msdos/prt0stm.asm index 29f5e1b5ce..5804b0b12a 100644 --- a/rtl/msdos/prt0stm.asm +++ b/rtl/msdos/prt0stm.asm @@ -223,7 +223,11 @@ FPC_INT00_HANDLER: push dx %endif push cx +%ifdef __FAR_CODE__ + jmp far FPC_HANDLEERROR +%else jmp FPC_HANDLEERROR +%endif .call_previous_handler: mov bx, sp From 926c1ba65744564eabad964761f165b04015f702 Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 13 Nov 2013 11:26:24 +0000 Subject: [PATCH 13/14] Fix extension od dxegen.pp source in fpmake git-svn-id: trunk@26076 - --- utils/dxegen/fpmake.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/dxegen/fpmake.pp b/utils/dxegen/fpmake.pp index 2a152fb31e..5fa2bfd50c 100644 --- a/utils/dxegen/fpmake.pp +++ b/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; From 3ce0b3330296d98b10eda303afb9a9059bfdfc66 Mon Sep 17 00:00:00 2001 From: sergei Date: Wed, 13 Nov 2013 12:27:27 +0000 Subject: [PATCH 14/14] * Win64 SEH: when creating a finalization procedure, put its def into the same symtable with sym. By default, defs are added into symtablestack.top, which may be set to something temporary like exceptsymtable. In such cases it is possible that def is destroyed before sym, leaving sym with invalid pointers. git-svn-id: trunk@26077 - --- compiler/x86_64/nx64flw.pas | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/x86_64/nx64flw.pas b/compiler/x86_64/nx64flw.pas index a065cd31f4..d7ed729ab2 100644 --- a/compiler/x86_64/nx64flw.pas +++ b/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);