mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 22:20:19 +02:00
* synchronised with trunk up to r26077
git-svn-id: branches/hlcgllvm@26078 -
This commit is contained in:
Jonas Maebe
commit
386cda95b7
@ -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 :
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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';
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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';
|
||||
|
||||
@ -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 */
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 }
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user