paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 17:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* revert r8118

Browse Source 
git-svn-id: trunk@8139 -
This commit is contained in:
peter 2007-07-22 19:59:00 +00:00
parent 5e36a73b80
commit 67e16340be
19 changed files with 507 additions and 672 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compiler/aasmtai.pas
View File

@ -1876,10 +1876,10 @@ implementation
destructor tai_cpu_abstract.Destroy;
var
i : byte;
i : integer;
begin
for i:=1 to opercnt do
freeop(i-1);
for i:=0 to opercnt-1 do
freeop(i);
inherited destroy;
end;
@ -2092,7 +2092,7 @@ implementation
{ make a copy of the references }
p.opercnt:=0;
p.allocate_oper(ops);
for i:=0 to longint(ops)-1 do
for i:=0 to ops-1 do
begin
p.oper[i]^:=oper[i]^;
case oper[i]^.typ of
@ -2144,14 +2144,14 @@ implementation
constructor tai_cpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
var
i : byte;
i : integer;
begin
inherited ppuload(t,ppufile);
{ hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
ppufile.getdata(condition,sizeof(tasmcond));
allocate_oper(ppufile.getbyte);
for i:=1 to ops do
ppuloadoper(ppufile,oper[i-1]^);
for i:=0 to ops-1 do
ppuloadoper(ppufile,oper[i]^);
opcode:=tasmop(ppufile.getword);
{$ifdef x86}
ppufile.getdata(segprefix,sizeof(Tregister));
@ -2162,13 +2162,13 @@ implementation
procedure tai_cpu_abstract.ppuwrite(ppufile:tcompilerppufile);
var
i : byte;
i : integer;
begin
inherited ppuwrite(ppufile);
ppufile.putdata(condition,sizeof(tasmcond));
ppufile.putbyte(ops);
for i:=1 to ops do
ppuwriteoper(ppufile,oper[i-1]^);
for i:=0 to ops-1 do
ppuwriteoper(ppufile,oper[i]^);
ppufile.putword(word(opcode));
{$ifdef x86}
ppufile.putdata(segprefix,sizeof(Tregister));
@ -2179,19 +2179,19 @@ implementation
procedure tai_cpu_abstract.buildderefimpl;
var
i : byte;
i : integer;
begin
for i:=1 to ops do
ppubuildderefimploper(oper[i-1]^);
for i:=0 to ops-1 do
ppubuildderefimploper(oper[i]^);
end;
procedure tai_cpu_abstract.derefimpl;
var
i : byte;
i : integer;
begin
for i:=1 to ops do
ppuderefoper(oper[i-1]^);
for i:=0 to ops-1 do
ppuderefoper(oper[i]^);
end;

2
compiler/constexp.pas
View File

@ -165,7 +165,7 @@ begin
else if not a.signed and (a.uvalue>qword(high(int64))) then
goto try_qword
else
sspace:=qword(high(int64))-qword(a.svalue);
sspace:=qword(high(int64))-a.svalue;
if sspace>=b then
begin

2
compiler/dbgstabs.pas
View File

@ -653,7 +653,7 @@ implementation
info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
end;
stabsstr:=def.mangledname;
getmem(p,sizeint(length(stabsstr))+255);
getmem(p,length(stabsstr)+255);
strpcopy(p,'"'+obj+':'+RType
+def_stab_number(def.returndef)+info+'",'+tostr(n_function)
+',0,'+

112
compiler/defutil.pas
View File

@ -54,10 +54,6 @@ interface
procedure range_to_type(l,h:TConstExprInt;var def:tdef);
{# Returns the common ordtype of a and b, i.e. a type that can handle
values of both a and b.}
function get_common_type(a,b:Torddef;rebase:boolean):Torddef;
procedure int_to_type(v:TConstExprInt;var def:tdef);
{# Returns true, if definition defines an integer type }
@ -311,99 +307,31 @@ implementation
range_to_basetype:=s32bit
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
range_to_basetype:=u32bit
else if (l>=low(int64)) and (h<=high(int64)) then
range_to_basetype:=s64bit
else
range_to_basetype:=u64bit;
range_to_basetype:=s64bit;
end;
procedure range_to_type(l,h:TConstExprInt;var def:tdef);
var ot:Tordtype;
begin
if cs_common_type in current_settings.localswitches then
begin
{ prefer signed over unsigned }
if (l>=int64(-128)) and (h<=127) then
ot:=s8bit
else if (l>=0) and (h<=255) then
ot:=u8bit
else if (l>=int64(-32768)) and (h<=32767) then
ot:=s16bit
else if (l>=0) and (h<=65535) then
ot:=u16bit
else if (l>=int64(low(longint))) and (h<=high(longint)) then
ot:=s32bit
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
ot:=u32bit
else if (l>=low(int64)) and (h<=high(int64)) then
ot:=s64bit
else
ot:=u64bit;
def:=Torddef.create(ot,l,h);
end
else
begin
{ prefer signed over unsigned }
if (l>=int64(-128)) and (h<=127) then
def:=s8inttype
else if (l>=0) and (h<=255) then
def:=u8inttype
else if (l>=int64(-32768)) and (h<=32767) then
def:=s16inttype
else if (l>=0) and (h<=65535) then
def:=u16inttype
else if (l>=int64(low(longint))) and (h<=high(longint)) then
def:=s32inttype
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
def:=u32inttype
else if (l>=low(int64)) and (h<=high(int64)) then
def:=s64inttype
else
def:=u64inttype;
end;
end;
function get_common_type(a,b:Torddef;rebase:boolean):Torddef;
{Determines the common ordtype of a and b, i.e. a type that can handle
values of both a and b.}
const common_ordtypes:array[u8bit..s64bit,u8bit..s64bit] of Tordtype=
{u8bit} {u16bit} {u32bit} {u64bit} {s8bit} {s16bit} {s32bit} {s64bit}
{u8bit} ((u8bit, u16bit, u32bit, u64bit, s16bit, s16bit, s32bit, s64bit),
{u16bit} (u16bit, u16bit, u32bit, u64bit, s32bit, s32bit, s32bit, s64bit),
{u32bit} (u32bit, u32bit, u32bit, u64bit, s64bit, s64bit, s64bit, s64bit),
{u64bit} (u64bit, u64bit, u64bit, u64bit, uvoid, uvoid, uvoid, uvoid),
{s8bit} (s16bit, s32bit, s64bit, uvoid, s8bit, s16bit, s32bit, s64bit),
{s16bit} (s32bit, s32bit, s64bit, uvoid, s16bit, s16bit, s32bit, s64bit),
{s32bit} (s32bit, s32bit, s64bit, uvoid, s32bit, s32bit, s32bit, s64bit),
{s64bit} (s64bit, s64bit, s64bit, uvoid, s64bit, s64bit, s64bit, s64bit));
var l,h:Tconstexprint;
ordtype:Tordtype;
begin
get_common_type:=nil;
ordtype:=common_ordtypes[a.ordtype,b.ordtype];
if rebase or (ordtype<>uvoid) then
begin
l:=a.low;
if b.low<l then
l:=b.low;
h:=a.high;
if b.high>h then
h:=b.high;
if rebase then
ordtype:=range_to_basetype(l,h);
if not(not h.signed and (h.uvalue>qword(high(int64))) and
(l.signed and (l.svalue<0))
) then
get_common_type:=Torddef.create(ordtype,l,h);
end;
end;
begin
{ prefer signed over unsigned }
if (l>=int64(-128)) and (h<=127) then
def:=s8inttype
else if (l>=0) and (h<=255) then
def:=u8inttype
else if (l>=int64(-32768)) and (h<=32767) then
def:=s16inttype
else if (l>=0) and (h<=65535) then
def:=u16inttype
else if (l>=int64(low(longint))) and (h<=high(longint)) then
def:=s32inttype
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
def:=u32inttype
else if (l>=low(int64)) and (h<=high(int64)) then
def:=s64inttype
else
def:=u64inttype;
end;
procedure int_to_type(v:TConstExprInt;var def:tdef);

1
compiler/globtype.pas
View File

@ -87,7 +87,6 @@ interface
cs_mmx,cs_mmx_saturation,
{ parser }
cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking,
cs_common_type,
{ macpas specific}
cs_external_var, cs_externally_visible
);

45
compiler/i386/n386add.pas
View File

@ -40,11 +40,11 @@ interface
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,defutil,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmdata,aasmcpu,
cgbase,procinfo,
ncon,nset,cgutils,tgobj,
cga,ncgutil,cgobj,cg64f32,cgx86;
cga,ncgutil,cgobj,cg64f32;
{*****************************************************************************
Add64bit
@ -349,31 +349,12 @@ interface
ref:Treference;
use_ref:boolean;
hl4 : tasmlabel;
acc1,acc2:Tregister;
begin
pass_left_right;
case Tcgsize2unsigned[left.location.size] of
OS_8:
begin
acc1:=NR_AL;
acc2:=NR_AH;
end;
OS_16:
begin
acc1:=NR_AX;
acc2:=NR_DX;
end;
OS_32:
begin
acc1:=NR_EAX;
acc2:=NR_EDX;
end;
end;
{The location.register will be filled in later (JM)}
location_reset(location,LOC_REGISTER,left.location.size);
location_reset(location,LOC_REGISTER,OS_INT);
{ Mul supports registers and references, so if not register/reference,
load the location into a register}
use_ref:=false;
@ -391,16 +372,15 @@ interface
cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg);
end;
{Allocate EAX.}
cg.getcpuregister(current_asmdata.CurrAsmList,acc1);
cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
{Load the right value.}
cg.a_load_loc_reg(current_asmdata.CurrAsmList,right.location.size,right.location,acc1);
cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_EAX);
{Also allocate EDX, since it is also modified by a mul (JM).}
if not(location.size in [OS_8,OS_S8]) then
cg.getcpuregister(current_asmdata.CurrAsmList,acc2);
cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
if use_ref then
emit_ref(A_MUL,Tcgsize2opsize[location.size],ref)
emit_ref(A_MUL,S_L,ref)
else
emit_reg(A_MUL,Tcgsize2opsize[location.size],reg);
emit_reg(A_MUL,S_L,reg);
if cs_check_overflow in current_settings.localswitches then
begin
current_asmdata.getjumplabel(hl4);
@ -409,12 +389,11 @@ interface
cg.a_label(current_asmdata.CurrAsmList,hl4);
end;
{Free EAX,EDX}
if not(location.size in [OS_8,OS_S8]) then
cg.ungetcpuregister(current_asmdata.CurrAsmList,acc2);
cg.ungetcpuregister(current_asmdata.CurrAsmList,acc1);
cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
{Allocate a new register and store the result in EAX in it.}
location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,acc1,location.register);
location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register);
location_freetemp(current_asmdata.CurrAsmList,left.location);
location_freetemp(current_asmdata.CurrAsmList,right.location);
end;

7
compiler/msg/errore.msg
View File

@ -125,7 +125,7 @@ general_i_number_of_notes=01023_I_$1 note(s) issued
#
# Scanner
#
# 02083 is the last used one
# 02063 is the last used one
#
% \section{Scanner messages.}
% This section lists the messages that the scanner emits. The scanner takes
@ -350,8 +350,6 @@ scan_w_pic_ignored=02081_W_PIC directive ignored
% ignored.
scan_w_unsupported_switch_by_target=02082_W_The switch "$1" is not supported by the currently selected target
% Some compiler switches like $E are not supported by all targets.
scanner_e_illegal_intpromotion=02083_E_Illegal state for $INTPROMOTION directive
% Only COMMON_TYPE and NATIVE)_INTEGER can be used as state with a \$INTPROMOTION compiler directive
% \end{description}
#
# Parser
@ -2500,9 +2498,6 @@ S*2Aas_assemble using GNU AS
**2Cg_Generate PIC code
**2Ch<n>_<n> bytes heap (between 1023 and 67107840)
**2Ci_IO-checking
**2CI_Integer promotion
**3CIcommon_type=Promote integers to common type before doing operation
**3CInative_integer=Promote integers to native_integer before doing operation
**2Cn_omit linking stage
**2Co_check overflow of integer operations
**2Cp<x>_select instruction set, see fpc -i for possible values

5
compiler/msgidx.inc
View File

@ -103,7 +103,6 @@ const
scan_e_only_packset=02080;
scan_w_pic_ignored=02081;
scan_w_unsupported_switch_by_target=02082;
scanner_e_illegal_intpromotion=02083;
parser_e_syntax_error=03000;
parser_e_dont_nest_interrupt=03004;
parser_w_proc_directive_ignored=03005;
@ -730,9 +729,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 43952;
MsgTxtSize = 43728;
MsgIdxMax : array[1..20] of longint=(
24,84,237,83,63,49,107,22,135,60,
24,83,237,83,63,49,107,22,135,60,
42,1,1,1,1,1,1,1,1,1
);

685
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

198
compiler/nadd.pas
View File

@ -724,7 +724,7 @@ implementation
var
hp : tnode;
lt,rt : tnodetype;
rd,ld,d : tdef;
rd,ld : tdef;
ot : tnodetype;
hsym : tfieldvarsym;
i : longint;
@ -1061,122 +1061,108 @@ implementation
else
inserttypeconv_internal(right,left.resultdef);
end
else if cs_common_type in current_settings.localswitches then
{ is there a signed 64 bit type ? }
else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
begin
d:=get_common_type(Torddef(ld),Torddef(rd),true);
if d=nil then
message2(parser_e_no_common_type,ld.gettypename,rd.gettypename)
if (torddef(ld).ordtype<>s64bit) then
inserttypeconv(left,s64inttype);
if (torddef(rd).ordtype<>s64bit) then
inserttypeconv(right,s64inttype);
end
{ is there a unsigned 64 bit type ? }
else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
begin
if (torddef(ld).ordtype<>u64bit) then
inserttypeconv(left,u64inttype);
if (torddef(rd).ordtype<>u64bit) then
inserttypeconv(right,u64inttype);
end
{ 64 bit cpus do calculations always in 64 bit }
{$ifndef cpu64bit}
{ is there a cardinal? }
else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
begin
{ convert positive constants to u32bit }
if (torddef(ld).ordtype<>u32bit) and
is_constintnode(left) and
(tordconstnode(left).value >= 0) then
inserttypeconv(left,u32inttype);
if (torddef(rd).ordtype<>u32bit) and
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
inserttypeconv(right,u32inttype);
{ when one of the operand is signed or the operation is subn then perform
the operation in 64bit, can't use rd/ld here because there
could be already typeconvs inserted.
This is compatible with the code below for other unsigned types (PFV) }
if is_signed(left.resultdef) or
is_signed(right.resultdef) or
(nodetype=subn) then
begin
if nodetype<>subn then
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end
else
begin
inserttypeconv(left,d);
inserttypeconv(right,d);
if (torddef(left.resultdef).ordtype<>u32bit) then
inserttypeconv(left,u32inttype);
if (torddef(right.resultdef).ordtype<>u32bit) then
inserttypeconv(right,u32inttype);
end;
end
{$endif cpu64bit}
{ generic ord conversion is sinttype }
else
begin
{ is there a signed 64 bit type ? }
if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
{ if the left or right value is smaller than the normal
type sinttype and is unsigned, and the other value
is a constant < 0, the result will always be false/true
for equal / unequal nodes.
}
if (
{ left : unsigned ordinal var, right : < 0 constant }
(
((is_signed(ld)=false) and (is_constintnode(left) =false)) and
((is_constintnode(right)) and (tordconstnode(right).value < 0))
) or
{ right : unsigned ordinal var, left : < 0 constant }
(
((is_signed(rd)=false) and (is_constintnode(right) =false)) and
((is_constintnode(left)) and (tordconstnode(left).value < 0))
)
) then
begin
if nodetype = equaln then
CGMessage(type_w_signed_unsigned_always_false)
else
if nodetype = unequaln then
CGMessage(type_w_signed_unsigned_always_true)
else
if (is_constintnode(left) and (nodetype in [ltn,lten])) or
(is_constintnode(right) and (nodetype in [gtn,gten])) then
CGMessage(type_w_signed_unsigned_always_true)
else
if (is_constintnode(right) and (nodetype in [ltn,lten])) or
(is_constintnode(left) and (nodetype in [gtn,gten])) then
CGMessage(type_w_signed_unsigned_always_false);
end;
{ When there is a signed type or there is a minus operation
we convert to signed int. Otherwise (both are unsigned) we keep
the result also unsigned. This is compatible with Delphi (PFV) }
if is_signed(ld) or
is_signed(rd) or
(nodetype=subn) then
begin
if (torddef(ld).ordtype<>s64bit) then
inserttypeconv(left,s64inttype);
if (torddef(rd).ordtype<>s64bit) then
inserttypeconv(right,s64inttype);
inserttypeconv(right,sinttype);
inserttypeconv(left,sinttype);
end
{ is there a unsigned 64 bit type ? }
else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
begin
if (torddef(ld).ordtype<>u64bit) then
inserttypeconv(left,u64inttype);
if (torddef(rd).ordtype<>u64bit) then
inserttypeconv(right,u64inttype);
end
{ 64 bit cpus do calculations always in 64 bit }
{$ifndef cpu64bit}
{ is there a cardinal? }
else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
begin
{ convert positive constants to u32bit }
if (torddef(ld).ordtype<>u32bit) and
is_constintnode(left) and
(tordconstnode(left).value >= 0) then
inserttypeconv(left,u32inttype);
if (torddef(rd).ordtype<>u32bit) and
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
inserttypeconv(right,u32inttype);
{ when one of the operand is signed or the operation is subn then perform
the operation in 64bit, can't use rd/ld here because there
could be already typeconvs inserted.
This is compatible with the code below for other unsigned types (PFV) }
if is_signed(left.resultdef) or
is_signed(right.resultdef) or
(nodetype=subn) then
begin
if nodetype<>subn then
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end
else
begin
if (torddef(left.resultdef).ordtype<>u32bit) then
inserttypeconv(left,u32inttype);
if (torddef(right.resultdef).ordtype<>u32bit) then
inserttypeconv(right,u32inttype);
end;
end
{$endif cpu64bit}
{ generic ord conversion is sinttype }
else
begin
{ if the left or right value is smaller than the normal
type sinttype and is unsigned, and the other value
is a constant < 0, the result will always be false/true
for equal / unequal nodes.
}
if (
{ left : unsigned ordinal var, right : < 0 constant }
(
((is_signed(ld)=false) and (is_constintnode(left) =false)) and
((is_constintnode(right)) and (tordconstnode(right).value < 0))
) or
{ right : unsigned ordinal var, left : < 0 constant }
(
((is_signed(rd)=false) and (is_constintnode(right) =false)) and
((is_constintnode(left)) and (tordconstnode(left).value < 0))
)
) then
begin
if nodetype = equaln then
CGMessage(type_w_signed_unsigned_always_false)
else
if nodetype = unequaln then
CGMessage(type_w_signed_unsigned_always_true)
else
if (is_constintnode(left) and (nodetype in [ltn,lten])) or
(is_constintnode(right) and (nodetype in [gtn,gten])) then
CGMessage(type_w_signed_unsigned_always_true)
else
if (is_constintnode(right) and (nodetype in [ltn,lten])) or
(is_constintnode(left) and (nodetype in [gtn,gten])) then
CGMessage(type_w_signed_unsigned_always_false);
end;
{ When there is a signed type or there is a minus operation
we convert to signed int. Otherwise (both are unsigned) we keep
the result also unsigned. This is compatible with Delphi (PFV) }
if is_signed(ld) or
is_signed(rd) or
(nodetype=subn) then
begin
inserttypeconv(right,sinttype);
inserttypeconv(left,sinttype);
end
else
begin
inserttypeconv(right,uinttype);
inserttypeconv(left,uinttype);
end;
inserttypeconv(right,uinttype);
inserttypeconv(left,uinttype);
end;
end;
end

5
compiler/ninl.pas
View File

@ -1297,10 +1297,7 @@ implementation
v:=torddef(def).low
else
v:=torddef(def).high;
if cs_common_type in current_settings.localswitches then
hp:=cordconstnode.create(v,Torddef.create(Torddef(def).ordtype,v,v),true)
else
hp:=cordconstnode.create(v,def,true);
hp:=cordconstnode.create(v,def,true);
typecheckpass(hp);
do_lowhigh:=hp;
end;

11
compiler/options.pas
View File

@ -504,17 +504,6 @@ begin
IllegalPara(opt);
break;
end;
'I':
begin
delete(more,1,1);
if upper(more)='COMMON_TYPE' then
include(init_settings.localswitches,cs_common_type)
else if upper(more)='NATIVE_INTEGER' then
exclude(init_settings.localswitches,cs_common_type)
else
illegalpara(opt);
break;
end;
'i' :
If UnsetBool(More, j) then
exclude(init_settings.localswitches,cs_check_io)

10
compiler/rgobj.pas
View File

@ -1581,7 +1581,7 @@ unit rgobj;
procedure Trgobj.translate_registers(list:TAsmList);
var
hp,p,q:Tai;
i:byte;
i:shortint;
{$ifdef arm}
so:pshifterop;
{$endif arm}
@ -1643,8 +1643,8 @@ unit rgobj;
with Taicpu(p) do
begin
current_filepos:=fileinfo;
for i:=1 to ops do
with oper[i-1]^ do
for i:=0 to ops-1 do
with oper[i]^ do
case typ of
Top_reg:
if (getregtype(reg)=regtype) then
@ -1892,7 +1892,7 @@ unit rgobj;
{ check whether and if so which and how (read/written) this instructions contains
registers that must be spilled }
for counter := 0 to longint(instr.ops)-1 do
for counter := 0 to instr.ops-1 do
with instr.oper[counter]^ do
begin
case typ of
@ -2057,7 +2057,7 @@ unit rgobj;
live_registers:=oldlive_registers;
{ substitute registers }
for counter:=0 to longint(instr.ops)-1 do
for counter:=0 to instr.ops-1 do
with instr.oper[counter]^ do
case typ of
top_reg:

16
compiler/scandir.pas
View File

@ -1222,21 +1222,6 @@ implementation
do_localswitch(cs_bitpacking);
end;
procedure dir_intpromotion;
var s:string;
begin
current_scanner.skipspace;
s:=upper(current_scanner.readcomment);
if s='COMMON_TYPE' then
include(current_settings.localswitches,cs_common_type)
else if s='NATIVE_INTEGER' then
exclude(current_settings.localswitches,cs_common_type)
else
message1(scanner_e_illegal_intpromotion,s);
end;
{****************************************************************************
Initialize Directives
@ -1284,7 +1269,6 @@ implementation
AddDirective('INFO',directive_all, @dir_info);
AddDirective('INLINE',directive_all, @dir_inline);
AddDirective('INTERFACES',directive_all, @dir_interfaces);
AddDirective('INTPROMOTION',directive_all, @dir_intpromotion);
AddDirective('L',directive_all, @dir_link);
AddDirective('LIBEXPORT',directive_mac, @dir_libexport);
AddDirective('LIBRARYPATH',directive_all, @dir_librarypath);

8
compiler/scanner.pas
View File

@ -349,14 +349,6 @@ implementation
include(init_settings.moduleswitches,cs_support_goto);
end;
{ turn on common type promotion for mode tp }
if (m_tp7 in current_settings.modeswitches) then
begin
include(current_settings.localswitches,cs_common_type);
if changeinit then
include(init_settings.localswitches,cs_common_type);
end;
{ Default enum packing for delphi/tp7 }
if (m_tp7 in current_settings.modeswitches) or
(m_delphi in current_settings.modeswitches) then

27
compiler/x86/aasmcpu.pas
View File

@ -1037,10 +1037,9 @@ implementation
* required to have unspecified size in the instruction too...)
}
var
i,j,oprs:byte;
insot,
currot,
asize: longint;
i,j,asize,oprs : longint;
insflags:cardinal;
siz : array[0..2] of longint;
begin
@ -1050,10 +1049,10 @@ implementation
if (p^.opcode<>opcode) or (p^.ops<>ops) then
exit;
for i:=1 to p^.ops do
for i:=0 to p^.ops-1 do
begin
insot:=p^.optypes[i-1];
currot:=oper[i-1]^.ot;
insot:=p^.optypes[i];
currot:=oper[i]^.ot;
{ Check the operand flags }
if (insot and (not currot) and OT_NON_SIZE)<>0 then
exit;
@ -1103,11 +1102,11 @@ implementation
oprs:=2
else
oprs:=p^.ops;
for i:=1 to oprs do
if ((p^.optypes[i-1] and OT_SIZE_MASK) <> 0) then
for i:=0 to oprs-1 do
if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
begin
for j:=1 to oprs do
siz[j-1]:=p^.optypes[i-1] and OT_SIZE_MASK;
for j:=0 to oprs-1 do
siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
break;
end;
end
@ -1115,15 +1114,15 @@ implementation
oprs:=2;
{ Check operand sizes }
for i:=1 to p^.ops do
for i:=0 to p^.ops-1 do
begin
insot:=p^.optypes[i-1];
currot:=oper[i-1]^.ot;
insot:=p^.optypes[i];
currot:=oper[i]^.ot;
if ((insot and OT_SIZE_MASK)=0) and
((currot and OT_SIZE_MASK and (not siz[i-1]))<>0) and
((currot and OT_SIZE_MASK and (not siz[i]))<>0) and
{ Immediates can always include smaller size }
((currot and OT_IMMEDIATE)=0) and
(((insot and OT_SIZE_MASK) or siz[i-1])<(currot and OT_SIZE_MASK)) then
(((insot and OT_SIZE_MASK) or siz[i])<(currot and OT_SIZE_MASK)) then
exit;
end;
end;

2
compiler/x86/itcpugas.pas
View File

@ -107,7 +107,7 @@ implementation
p:=0;
i:=regnumber_count_bsstart;
repeat
if (p<=high(tregisterindex)-i) and (att_regname_table[att_regname_index[p+i]]<=s) then
if (p+i<=high(tregisterindex)) and (att_regname_table[att_regname_index[p+i]]<=s) then
p:=p+i;
i:=i shr 1;
until i=0;

2
compiler/x86/itx86int.pas
View File

@ -66,7 +66,7 @@ implementation
p:=0;
i:=regnumber_count_bsstart;
repeat
if (p<=high(tregisterindex)-i) and (int_regname_table[int_regname_index[p+i]]<=s) then
if (p+i<=high(tregisterindex)) and (int_regname_table[int_regname_index[p+i]]<=s) then
p:=p+i;
i:=i shr 1;
until i=0;

9
compiler/x86/nx86add.pas
View File

@ -1067,14 +1067,9 @@ unit nx86add;
procedure tx86addnode.second_addordinal;
begin
{ filter unsigned MUL opcode, which requires special handling }
{ if (nodetype=muln) and
if (nodetype=muln) and
(not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef))) then}
{Handle unsigned with the 1 operand mul/imul and signed 8-bit as
well, because there is no mul immediate for signed 8-bit.}
if (nodetype=muln) and
((def_cgsize(left.resultdef) in [OS_8,OS_16,OS_32,OS_64,OS_S8]) or
(def_cgsize(right.resultdef) in [OS_8,OS_16,OS_32,OS_64,OS_S8])) then
not(is_signed(right.resultdef))) then
begin
second_mul;
exit;