paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-29 01:42:04 +01:00
Code Issues Packages Projects Releases Wiki Activity

* new int - int conversion -dNEWCNV

Browse Source 
* some function renamings
This commit is contained in:
peter 1998-11-26 13:10:39 +00:00
parent 13d2cb30b0
commit a62eb86cde
5 changed files with 683 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

719
compiler/cg386cnv.pas
View File

File diff suppressed because it is too large Load Diff

10
compiler/cg386inl.pas
View File

@ -739,7 +739,7 @@ implementation
exprasmlist^.concat(new(pai386,op_reg(asmop,opsize, exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
p^.location.register))); p^.location.register)));
emitoverflowcheck(p); emitoverflowcheck(p);
emitrangecheck(p); emitrangecheck(p,p^.resulttype);
end; end;
in_dec_x, in_dec_x,
in_inc_x : in_inc_x :
@ -843,7 +843,7 @@ implementation
ungetregister32(hregister); ungetregister32(hregister);
end; end;
emitoverflowcheck(p^.left^.left); emitoverflowcheck(p^.left^.left);
emitrangecheck(p^.left^.left); emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
end; end;
in_assigned_x : in_assigned_x :
begin begin
@ -970,7 +970,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.18 1998-11-24 17:04:27 peter Revision 1.19 1998-11-26 13:10:40 peter
* new int - int conversion -dNEWCNV
* some function renamings
Revision 1.18 1998/11/24 17:04:27 peter
* fixed length(char) when char is a variable * fixed length(char) when char is a variable
Revision 1.17 1998/11/05 12:02:33 peter Revision 1.17 1998/11/05 12:02:33 peter

61
compiler/htypechk.pas
View File

@ -64,11 +64,26 @@ implementation
function isconvertable(def_from,def_to : pdef; function isconvertable(def_from,def_to : pdef;
var doconv : tconverttype;fromtreetype : ttreetyp; var doconv : tconverttype;fromtreetype : ttreetyp;
explicit : boolean) : boolean; explicit : boolean) : boolean;
const {$ifdef NEWCNV}
{ Tbasetype: uauto,uvoid,uchar, { Tbasetype: uauto,uvoid,uchar,
u8bit,u16bit,u32bit, u8bit,u16bit,u32bit,
s8bit,s16bit,s32, s8bit,s16bit,s32,
bool8bit,bool16bit,boot32bit } bool8bit,bool16bit,boot32bit }
type
tbasedef=(bvoid,bchar,bint,bbool);
const
basedeftbl:array[tbasetype] of tbasedef =
(bvoid,bvoid,bchar,
bint,bint,bint,
bint,bint,bint,
bbool,bbool,bbool);
basedefconverts : array[tbasedef,tbasedef] of tconverttype =
((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
(tc_not_possible,tc_not_possible,tc_bool_2_int,tc_int_2_bool));
{$else}
const
basedefconverts : array[tbasetype,tbasetype] of tconverttype = basedefconverts : array[tbasetype,tbasetype] of tconverttype =
{uauto} {uauto}
((tc_not_possible,tc_not_possible,tc_not_possible, ((tc_not_possible,tc_not_possible,tc_not_possible,
@ -130,6 +145,7 @@ implementation
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int, tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int, tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_int_2_bool,tc_int_2_bool,tc_only_rangechecks32bit)); tc_int_2_bool,tc_int_2_bool,tc_only_rangechecks32bit));
{$endif}
var var
b : boolean; b : boolean;
@ -148,8 +164,18 @@ implementation
case def_to^.deftype of case def_to^.deftype of
orddef : orddef :
begin begin
if (def_from^.deftype=orddef) then case def_from^.deftype of
orddef :
begin begin
{$ifdef NEWCNV}
doconv:=basedefconverts[basedeftbl[porddef(def_from)^.typ],basedeftbl[porddef(def_to)^.typ]];
b:=true;
if (doconv=tc_not_possible) or
((doconv=tc_int_2_bool) and
(not explicit) and
(not is_boolean(def_from))) then
b:=false;
{$else}
doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ]; doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
b:=true; b:=true;
if (doconv=tc_not_possible) or if (doconv=tc_not_possible) or
@ -157,6 +183,15 @@ implementation
(not explicit) and (not explicit) and
(not is_boolean(def_from))) then (not is_boolean(def_from))) then
b:=false; b:=false;
{$endif}
end;
{$ifdef NEWCNV}
enumdef :
begin
doconv:=tc_int_2_int;
b:=true;
end;
{$endif}
end; end;
end; end;
@ -164,14 +199,14 @@ implementation
begin begin
case def_from^.deftype of case def_from^.deftype of
stringdef : begin stringdef : begin
doconv:=tc_string_to_string; doconv:=tc_string_2_string;
b:=true; b:=true;
end; end;
orddef : begin orddef : begin
{ char to string} { char to string}
if is_char(def_from) then if is_char(def_from) then
begin begin
doconv:=tc_char_to_string; doconv:=tc_char_2_string;
b:=true; b:=true;
end; end;
end; end;
@ -261,7 +296,7 @@ implementation
if (parraydef(def_to)^.lowrange=0) and if (parraydef(def_to)^.lowrange=0) and
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
begin begin
doconv:=tc_pointer_to_array; doconv:=tc_pointer_2_array;
b:=true; b:=true;
end; end;
end; end;
@ -269,7 +304,7 @@ implementation
{ array of char to string } { array of char to string }
if is_equal(parraydef(def_to)^.definition,cchardef) then if is_equal(parraydef(def_to)^.definition,cchardef) then
begin begin
doconv:=tc_string_chararray; doconv:=tc_string_2_chararray;
b:=true; b:=true;
end; end;
end; end;
@ -285,7 +320,7 @@ implementation
if (fromtreetype=stringconstn) and if (fromtreetype=stringconstn) and
is_pchar(def_to) then is_pchar(def_to) then
begin begin
doconv:=tc_cstring_charpointer; doconv:=tc_cstring_2_pchar;
b:=true; b:=true;
end; end;
end; end;
@ -294,7 +329,7 @@ implementation
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
is_pchar(def_to) then is_pchar(def_to) then
begin begin
doconv:=tc_cchar_charpointer; doconv:=tc_cchar_2_pchar;
b:=true; b:=true;
end; end;
end; end;
@ -303,7 +338,7 @@ implementation
if (parraydef(def_from)^.lowrange=0) and if (parraydef(def_from)^.lowrange=0) and
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
begin begin
doconv:=tc_array_to_pointer; doconv:=tc_array_2_pointer;
b:=true; b:=true;
end; end;
end; end;
@ -370,7 +405,7 @@ implementation
if (def_from^.deftype=procdef) then if (def_from^.deftype=procdef) then
begin begin
def_from^.deftype:=procvardef; def_from^.deftype:=procvardef;
doconv:=tc_proc2procvar; doconv:=tc_proc_2_procvar;
b:=is_equal(def_from,def_to); b:=is_equal(def_from,def_to);
def_from^.deftype:=procdef; def_from^.deftype:=procdef;
end end
@ -675,7 +710,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-11-17 00:36:42 peter Revision 1.9 1998-11-26 13:10:42 peter
* new int - int conversion -dNEWCNV
* some function renamings
Revision 1.8 1998/11/17 00:36:42 peter
* more ansistring fixes * more ansistring fixes
Revision 1.7 1998/10/14 13:33:24 peter Revision 1.7 1998/10/14 13:33:24 peter

94
compiler/tccnv.pas
View File

@ -234,30 +234,43 @@ implementation
type type
tfirstconvproc = procedure(var p : ptree); tfirstconvproc = procedure(var p : ptree);
{$ifdef NEWCNV}
procedure first_int_to_int(var p : ptree);
begin
if (p^.registers32=0) and
(p^.left^.location.loc<>LOC_REGISTER) and
(p^.resulttype^.size>p^.left^.resulttype^.size) then
begin
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end;
end;
{$else}
procedure first_bigger_smaller(var p : ptree); procedure first_bigger_smaller(var p : ptree);
begin begin
if (p^.left^.location.loc<>LOC_REGISTER) and (p^.registers32=0) then if (p^.left^.location.loc<>LOC_REGISTER) and (p^.registers32=0) then
p^.registers32:=1; p^.registers32:=1;
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
end; end;
{$endif}
procedure first_cstring_to_pchar(var p : ptree);
procedure first_cstring_charpointer(var p : ptree);
begin begin
p^.registers32:=1; p^.registers32:=1;
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
end; end;
procedure first_string_chararray(var p : ptree); procedure first_string_to_chararray(var p : ptree);
begin begin
p^.registers32:=1; p^.registers32:=1;
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
end; end;
procedure first_string_string(var p : ptree); procedure first_string_to_string(var p : ptree);
begin begin
if pstringdef(p^.resulttype)^.string_typ<> if pstringdef(p^.resulttype)^.string_typ<>
pstringdef(p^.left^.resulttype)^.string_typ then pstringdef(p^.left^.resulttype)^.string_typ then
@ -309,7 +322,7 @@ implementation
end; end;
procedure first_int_real(var p : ptree); procedure first_int_to_real(var p : ptree);
var var
t : ptree; t : ptree;
begin begin
@ -338,7 +351,7 @@ implementation
end; end;
procedure first_int_fix(var p : ptree); procedure first_int_to_fix(var p : ptree);
begin begin
if p^.left^.treetype=ordconstn then if p^.left^.treetype=ordconstn then
begin begin
@ -358,7 +371,7 @@ implementation
end; end;
procedure first_real_fix(var p : ptree); procedure first_real_to_fix(var p : ptree);
begin begin
if p^.left^.treetype=realconstn then if p^.left^.treetype=realconstn then
begin begin
@ -381,7 +394,7 @@ implementation
end; end;
procedure first_fix_real(var p : ptree); procedure first_fix_to_real(var p : ptree);
begin begin
if p^.left^.treetype=fixconstn then if p^.left^.treetype=fixconstn then
begin begin
@ -401,7 +414,7 @@ implementation
end; end;
procedure first_real_real(var p : ptree); procedure first_real_to_real(var p : ptree);
begin begin
if p^.registersfpu<1 then if p^.registersfpu<1 then
p^.registersfpu:=1; p^.registersfpu:=1;
@ -417,7 +430,7 @@ implementation
end; end;
procedure first_chararray_string(var p : ptree); procedure first_chararray_to_string(var p : ptree);
begin begin
{ the only important information is the location of the } { the only important information is the location of the }
{ result } { result }
@ -426,7 +439,7 @@ implementation
end; end;
procedure first_cchar_charpointer(var p : ptree); procedure first_cchar_to_pchar(var p : ptree);
begin begin
p^.left:=gentypeconvnode(p^.left,cshortstringdef); p^.left:=gentypeconvnode(p^.left,cshortstringdef);
{ convert constant char to constant string } { convert constant char to constant string }
@ -436,13 +449,15 @@ implementation
end; end;
{$ifndef NEWCNV}
procedure first_locmem(var p : ptree); procedure first_locmem(var p : ptree);
begin begin
p^.location.loc:=LOC_MEM; p^.location.loc:=LOC_MEM;
end; end;
{$endif}
procedure first_bool_int(var p : ptree); procedure first_bool_to_int(var p : ptree);
begin begin
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated { Florian I think this is overestimated
@ -456,7 +471,7 @@ implementation
end; end;
procedure first_int_bool(var p : ptree); procedure first_int_to_bool(var p : ptree);
begin begin
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated { Florian I think this is overestimated
@ -500,6 +515,7 @@ implementation
p^.location.loc:=LOC_MEM; p^.location.loc:=LOC_MEM;
end; end;
procedure first_ansistring_to_pchar(var p : ptree); procedure first_ansistring_to_pchar(var p : ptree);
begin begin
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
@ -529,13 +545,39 @@ implementation
aprocdef : pprocdef; aprocdef : pprocdef;
proctype : tdeftype; proctype : tdeftype;
const const
firstconvert : array[tconverttype] of firstconvert : array[tconverttype] of tfirstconvproc = (
tfirstconvproc = (first_nothing,first_nothing, {$ifdef NEWCNV}
first_nothing, {equal}
first_nothing, {not_possible}
first_string_to_string,
first_char_to_string,
first_pchar_to_string,
first_cchar_to_pchar,
first_cstring_to_pchar,
first_ansistring_to_pchar,
first_string_to_chararray,
first_chararray_to_string,
first_array_to_pointer,
first_pointer_to_array,
first_int_to_int,
first_bool_to_int,
first_int_to_bool,
first_real_to_real,
first_int_to_real,
first_int_to_fix,
first_real_to_fix,
first_fix_to_real,
first_proc_to_procvar,
first_arrayconstructor_to_set,
first_load_smallset
);
{$else}
first_nothing,first_nothing,
first_bigger_smaller,first_nothing,first_bigger_smaller, first_bigger_smaller,first_nothing,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_string_string, first_bigger_smaller,first_string_to_string,
first_cstring_charpointer,first_string_chararray, first_cstring_to_pchar,first_string_to_chararray,
first_array_to_pointer,first_pointer_to_array, first_array_to_pointer,first_pointer_to_array,
first_char_to_string,first_bigger_smaller, first_char_to_string,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
@ -547,16 +589,16 @@ implementation
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller, first_bigger_smaller,first_bigger_smaller,
first_bool_int,first_int_bool, first_bool_to_int,first_int_to_bool,
first_int_real,first_real_fix, first_int_to_real,first_real_to_fix,
first_fix_real,first_int_fix,first_real_real, first_fix_to_real,first_int_to_fix,first_real_to_real,
first_locmem,first_proc_to_procvar, first_locmem,first_proc_to_procvar,
first_cchar_charpointer, first_cchar_to_pchar,
first_load_smallset, first_load_smallset,
first_ansistring_to_pchar, first_ansistring_to_pchar,
first_pchar_to_string, first_pchar_to_string,
first_arrayconstructor_to_set); first_arrayconstructor_to_set);
{$endif}
begin begin
aprocdef:=nil; aprocdef:=nil;
{ if explicite type cast, then run firstpass } { if explicite type cast, then run firstpass }
@ -689,7 +731,7 @@ implementation
aprocdef:=pprocsym(p^.left^.symtableentry)^.definition; aprocdef:=pprocsym(p^.left^.symtableentry)^.definition;
end; end;
p^.convtyp:=tc_proc2procvar; p^.convtyp:=tc_proc_2_procvar;
{ Now check if the procedure we are going to assign to { Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type. the procvar, is compatible with the procvar's type.
Did the original procvar support do such a check? Did the original procvar support do such a check?
@ -913,7 +955,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-11-05 12:03:03 peter Revision 1.9 1998-11-26 13:10:43 peter
* new int - int conversion -dNEWCNV
* some function renamings
Revision 1.8 1998/11/05 12:03:03 peter
* released useansistring * released useansistring
* removed -Sv, its now available in fpc modes * removed -Sv, its now available in fpc modes

50
compiler/tree.pas
View File

@ -45,7 +45,8 @@ unit tree;
pconstset = ^tconstset; pconstset = ^tconstset;
tconstset = array[0..31] of byte; tconstset = array[0..31] of byte;
ttreetyp = (addn, {Represents the + operator.} ttreetyp = (
addn, {Represents the + operator.}
muln, {Represents the * operator.} muln, {Represents the * operator.}
subn, {Represents the - operator.} subn, {Represents the - operator.}
divn, {Represents the div operator.} divn, {Represents the div operator.}
@ -125,16 +126,44 @@ unit tree;
arrayconstructrangen, {Range element to allow sets in array construction tree} arrayconstructrangen, {Range element to allow sets in array construction tree}
{ added for optimizations where we cannot suppress } { added for optimizations where we cannot suppress }
nothingn, nothingn,
loadvmtn); {???.} loadvmtn
);
{$ifdef NEWCNV}
tconverttype = (
tc_equal,
tc_not_possible,
tc_string_2_string,
tc_char_2_string,
tc_pchar_2_string,
tc_cchar_2_pchar,
tc_cstring_2_pchar,
tc_ansistring_2_pchar,
tc_string_2_chararray,
tc_chararray_2_string,
tc_array_2_pointer,
tc_pointer_2_array,
tc_int_2_int,
tc_bool_2_int,
tc_int_2_bool,
tc_real_2_real,
tc_int_2_real,
tc_int_2_fix,
tc_real_2_fix,
tc_fix_2_real,
tc_proc_2_procvar,
tc_arrayconstructor_2_set,
tc_load_smallset
);
{$else}
tconverttype = (tc_equal,tc_not_possible,tc_u8bit_2_s32bit, tconverttype = (tc_equal,tc_not_possible,tc_u8bit_2_s32bit,
tc_only_rangechecks32bit,tc_s8bit_2_s32bit, tc_only_rangechecks32bit,tc_s8bit_2_s32bit,
tc_u16bit_2_s32bit,tc_s16bit_2_s32bit, tc_u16bit_2_s32bit,tc_s16bit_2_s32bit,
tc_s32bit_2_s16bit,tc_s32bit_2_u8bit, tc_s32bit_2_s16bit,tc_s32bit_2_u8bit,
tc_s32bit_2_u16bit,tc_string_to_string, tc_s32bit_2_u16bit,tc_string_2_string,
tc_cstring_charpointer,tc_string_chararray, tc_cstring_2_pchar,tc_string_2_chararray,
tc_array_to_pointer,tc_pointer_to_array, tc_array_2_pointer,tc_pointer_2_array,
tc_char_to_string,tc_u8bit_2_s16bit, tc_char_2_string,tc_u8bit_2_s16bit,
tc_u8bit_2_u16bit,tc_s8bit_2_s16bit, tc_u8bit_2_u16bit,tc_s8bit_2_s16bit,
tc_s16bit_2_s8bit,tc_s16bit_2_u8bit, tc_s16bit_2_s8bit,tc_s16bit_2_u8bit,
tc_u16bit_2_s8bit,tc_u16bit_2_u8bit, tc_u16bit_2_s8bit,tc_u16bit_2_u8bit,
@ -148,9 +177,10 @@ unit tree;
tc_int_2_real,tc_real_2_fix, tc_int_2_real,tc_real_2_fix,
tc_fix_2_real,tc_int_2_fix,tc_real_2_real, tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
tc_chararray_2_string, tc_chararray_2_string,
tc_proc2procvar,tc_cchar_charpointer,tc_load_smallset, tc_proc_2_procvar,tc_cchar_2_pchar,tc_load_smallset,
tc_ansistring_2_pchar,tc_pchar_2_string, tc_ansistring_2_pchar,tc_pchar_2_string,
tc_arrayconstructor_2_set); tc_arrayconstructor_2_set);
{$endif}
{ allows to determine which elementes are to be replaced } { allows to determine which elementes are to be replaced }
tdisposetyp = (dt_nothing,dt_leftright,dt_left, tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@ -1622,7 +1652,11 @@ unit tree;
end. end.
{ {
$Log$ $Log$
Revision 1.53 1998-11-24 12:52:42 peter Revision 1.54 1998-11-26 13:10:44 peter
* new int - int conversion -dNEWCNV
* some function renamings
Revision 1.53 1998/11/24 12:52:42 peter
* sets are not written twice anymore * sets are not written twice anymore
* optimize for emptyset+single element which uses a new routine from * optimize for emptyset+single element which uses a new routine from
set.inc FPC_SET_CREATE_ELEMENT set.inc FPC_SET_CREATE_ELEMENT