paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 21:50:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added currency support based on int64

Browse Source 
+ is_64bit for use in cg units instead of is_64bitint
  * removed cgmessage from n386add, replace with internalerrors
This commit is contained in:
peter 2003-04-23 20:16:03 +00:00
parent 9e2084b8d5
commit c21ca3dfa0
19 changed files with 492 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/cg64f32.pas
View File

@ -569,7 +569,7 @@ unit cg64f32;
from_signed := is_signed(fromdef);
to_signed := is_signed(todef);
if not is_64bitint(todef) then
if not is_64bit(todef) then
begin
oldregisterdef := registerdef;
registerdef := false;
@ -688,7 +688,7 @@ unit cg64f32;
{ in all cases, there is only a problem if the higest bit is set }
if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
begin
if is_64bitint(fromdef) then
if is_64bit(fromdef) then
begin
hreg := p.location.registerhigh;
opsize := OS_32;
@ -836,7 +836,12 @@ begin
end.
{
$Log$
Revision 1.39 2003-04-22 10:09:34 daniel
Revision 1.40 2003-04-23 20:16:03 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.39 2003/04/22 10:09:34 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used

9
compiler/cgobj.pas
View File

@ -1423,7 +1423,7 @@ unit cgobj;
if not(cs_check_range in aktlocalswitches) or
not(todef.deftype in [orddef,enumdef,arraydef]) then
exit;
if is_64bitint(p.resulttype.def) or is_64bitint(todef) then
if is_64bit(p.resulttype.def) or is_64bit(todef) then
begin
cg64.g_rangecheck64(list,p,todef);
exit;
@ -1842,7 +1842,12 @@ finalization
end.
{
$Log$
Revision 1.87 2003-04-23 14:42:07 daniel
Revision 1.88 2003-04-23 20:16:03 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.87 2003/04/23 14:42:07 daniel
* Further register allocator work. Compiler now smaller with new
allocator than without.
* Somebody forgot to adjust ppu version number

21
compiler/defcmp.pas
View File

@ -57,6 +57,7 @@ interface
tc_bool_2_int,
tc_real_2_real,
tc_int_2_real,
tc_real_2_currency,
tc_proc_2_procvar,
tc_arrayconstructor_2_set,
tc_load_smallset,
@ -150,7 +151,7 @@ implementation
bint,bint,bint,bint,
bint,bint,bint,bint,
bbool,bbool,bbool,
bchar,bchar);
bchar,bchar,bint);
basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
{ void, char, int, bool }
@ -241,6 +242,14 @@ implementation
eq:=te_convert_l1;
end;
end;
floatdef :
begin
if is_currency(def_to) then
begin
doconv:=tc_real_2_currency;
eq:=te_convert_l2;
end;
end;
classrefdef,
procvardef,
pointerdef :
@ -370,7 +379,8 @@ implementation
case def_from.deftype of
orddef :
begin { ordinal to real }
if is_integer(def_from) then
if is_integer(def_from) or
is_currency(def_from) then
begin
doconv:=tc_int_2_real;
eq:=te_convert_l1;
@ -1183,7 +1193,12 @@ implementation
end.
{
$Log$
Revision 1.22 2003-04-23 11:37:33 peter
Revision 1.23 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.22 2003/04/23 11:37:33 peter
* po_comp for proc to procvar fixed
Revision 1.21 2003/04/10 17:57:52 peter

32
compiler/defutil.pas
View File

@ -161,6 +161,9 @@ interface
{# Returns true, if def is a 64 bit integer type }
function is_64bitint(def : tdef) : boolean;
{# Returns true, if def is a 64 bit type }
function is_64bit(def : tdef) : boolean;
{# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
the value is placed within the range
}
@ -194,11 +197,20 @@ implementation
{ returns true, if def is a currency type }
function is_currency(def : tdef) : boolean;
begin
is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
case s64currencytype.def.deftype of
orddef :
result:=(def.deftype=orddef) and
(torddef(s64currencytype.def).typ=torddef(def).typ);
floatdef :
result:=(def.deftype=floatdef) and
(tfloatdef(s64currencytype.def).typ=tfloatdef(def).typ);
else
internalerror(200304222);
end;
end;
function range_to_basetype(low,high:TConstExprInt):tbasetype;
function range_to_basetype(low,high:TConstExprInt):tbasetype;
begin
{ generate a unsigned range if high<0 and low>=0 }
if (low>=0) and (high<0) then
@ -302,7 +314,7 @@ implementation
orddef :
begin
dt:=torddef(def).typ;
is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit,scurrency]);
end;
enumdef :
is_signed:=tenumdef(def).min < 0;
@ -519,6 +531,13 @@ implementation
end;
{ true, if def is a 64 bit type }
function is_64bit(def : tdef) : boolean;
begin
is_64bit:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit,scurrency])
end;
{ if l isn't in the range of def a range check error (if not explicit) is generated and
the value is placed within the range }
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
@ -739,7 +758,12 @@ implementation
end.
{
$Log$
Revision 1.3 2003-03-17 19:05:08 peter
Revision 1.4 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.3 2003/03/17 19:05:08 peter
* dynamic array is also a special array
Revision 1.2 2002/12/23 20:58:03 peter

34
compiler/i386/n386add.pas
View File

@ -570,13 +570,13 @@ interface
falselabel:=ofl;
end;
else
CGMessage(type_e_mismatch);
internalerror(2003042212);
end;
secondpass(right);
maketojumpbool(exprasmlist,right,lr_load_regvars);
end;
else
CGMessage(type_e_mismatch);
internalerror(2003042213);
end;
end;
end;
@ -613,7 +613,7 @@ interface
cmpop:=true;
end;
else
CGMessage(type_e_mismatch);
internalerror(2003042214);
end;
if (right.location.loc<>LOC_FPUREGISTER) then
@ -845,10 +845,7 @@ interface
andn :
op:=A_AND;
else
begin
{ no < or > support for sets }
CGMessage(type_e_mismatch);
end;
internalerror(2003042215);
end;
{ left must be a register }
left_must_be_reg(opsize,noswap);
@ -988,13 +985,11 @@ interface
op:=OP_OR;
andn:
op:=OP_AND;
muln:
else
begin
{ should be handled in pass_1 (JM) }
{ everything should be handled in pass_1 (JM) }
internalerror(200109051);
end;
else
CGMessage(type_e_mismatch);
end;
{ left and right no register? }
@ -1246,7 +1241,7 @@ interface
andn:
op:=A_PAND;
else
CGMessage(type_e_mismatch);
internalerror(2003042214);
end;
{ left and right no register? }
@ -1508,7 +1503,7 @@ interface
exit;
end
{ 64bit operations }
else if is_64bitint(left.resulttype.def) then
else if is_64bit(left.resulttype.def) then
begin
second_add64bit;
exit;
@ -1605,7 +1600,7 @@ interface
andn :
op:=A_AND;
else
CGMessage(type_e_mismatch);
internalerror(200304229);
end;
{ filter MUL, which requires special handling }
@ -1647,7 +1642,7 @@ interface
equaln,unequaln :
cmpop:=true;
else
CGMessage(type_e_mismatch);
internalerror(2003042210);
end;
left_must_be_reg(opsize,false);
emit_op_right_left(A_CMP,opsize);
@ -1661,7 +1656,7 @@ interface
set_result_location(true,true);
end
else
CGMessage(type_e_mismatch);
internalerror(2003042211);
end;
begin
@ -1669,7 +1664,12 @@ begin
end.
{
$Log$
Revision 1.64 2003-04-23 09:51:16 daniel
Revision 1.65 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.64 2003/04/23 09:51:16 daniel
* Removed usage of edi in a lot of places when new register allocator used
+ Added newra versions of g_concatcopy and secondadd_float

80
compiler/i386/n386cnv.pas
View File

@ -171,6 +171,7 @@ implementation
emit_ref(A_FILD,S_IQ,href);
emit_const_reg(A_ADD,S_L,8,r);
end;
scurrency,
s64bit:
begin
emit_ref(A_FILD,S_IQ,href);
@ -359,38 +360,39 @@ implementation
{$ifdef fpc}
const
secondconvert : array[tconverttype] of pointer = (
{$ifdef fpc}@{$endif}second_nothing, {equal}
{$ifdef fpc}@{$endif}second_nothing, {not_possible}
{$ifdef fpc}@{$endif}second_nothing, {second_string_to_string, handled in resulttype pass }
{$ifdef fpc}@{$endif}second_char_to_string,
{$ifdef fpc}@{$endif}second_nothing, {char_to_charray}
{$ifdef fpc}@{$endif}second_nothing, { pchar_to_string, handled in resulttype pass }
{$ifdef fpc}@{$endif}second_nothing, {cchar_to_pchar}
{$ifdef fpc}@{$endif}second_cstring_to_pchar,
{$ifdef fpc}@{$endif}second_ansistring_to_pchar,
{$ifdef fpc}@{$endif}second_string_to_chararray,
{$ifdef fpc}@{$endif}second_nothing, { chararray_to_string, handled in resulttype pass }
{$ifdef fpc}@{$endif}second_array_to_pointer,
{$ifdef fpc}@{$endif}second_pointer_to_array,
{$ifdef fpc}@{$endif}second_int_to_int,
{$ifdef fpc}@{$endif}second_int_to_bool,
{$ifdef fpc}@{$endif}second_bool_to_bool,
{$ifdef fpc}@{$endif}second_bool_to_int,
{$ifdef fpc}@{$endif}second_real_to_real,
{$ifdef fpc}@{$endif}second_int_to_real,
{$ifdef fpc}@{$endif}second_proc_to_procvar,
{$ifdef fpc}@{$endif}second_nothing, { arrayconstructor_to_set }
{$ifdef fpc}@{$endif}second_nothing, { second_load_smallset, handled in first pass }
{$ifdef fpc}@{$endif}second_cord_to_pointer,
{$ifdef fpc}@{$endif}second_nothing, { interface 2 string }
{$ifdef fpc}@{$endif}second_nothing, { interface 2 guid }
{$ifdef fpc}@{$endif}second_class_to_intf,
{$ifdef fpc}@{$endif}second_char_to_char,
{$ifdef fpc}@{$endif}second_nothing, { normal_2_smallset }
{$ifdef fpc}@{$endif}second_nothing, { dynarray_2_openarray }
{$ifdef fpc}@{$endif}second_nothing, { pwchar_2_string }
{$ifdef fpc}@{$endif}second_nothing, { variant_2_dynarray }
{$ifdef fpc}@{$endif}second_nothing { dynarray_2_variant}
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_bool,
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_nothing, { real_to_currency, handled in resulttype pass }
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing, { pwchar_2_string }
@second_nothing, { variant_2_dynarray }
@second_nothing { dynarray_2_variant}
);
type
tprocedureofobject = procedure of object;
@ -406,9 +408,9 @@ implementation
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
tprocedureofobject(r)();
end;
{$else}
{$else fpc}
begin
case c of
tc_equal,
@ -430,6 +432,7 @@ implementation
tc_bool_2_int : second_bool_to_int;
tc_real_2_real : second_real_to_real;
tc_int_2_real : second_int_to_real;
tc_real_2_currency : second_nothing;
tc_proc_2_procvar : second_proc_to_procvar;
tc_arrayconstructor_2_set : second_nothing;
tc_load_smallset : second_nothing;
@ -446,14 +449,19 @@ implementation
else internalerror(2002101101);
end;
end;
{$endif}
{$endif fpc}
begin
ctypeconvnode:=ti386typeconvnode;
end.
{
$Log$
Revision 1.59 2003-04-22 23:50:23 peter
Revision 1.60 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.59 2003/04/22 23:50:23 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

48
compiler/nadd.pas
View File

@ -190,6 +190,17 @@ implementation
(left.resulttype.def.deftype=floatdef) and
(tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then
resultrealtype:=left.resulttype
{ when there is a currency type then use currency, but
only when currency is defined as float }
else
if (s64currencytype.def.deftype=floatdef) and
(is_currency(right.resulttype.def) or
is_currency(left.resulttype.def)) then
begin
resultrealtype:=s64currencytype;
inserttypeconv(right,resultrealtype);
inserttypeconv(left,resultrealtype);
end
else
begin
inserttypeconv(right,resultrealtype);
@ -765,6 +776,14 @@ implementation
end;
end;
end
{ is there a currency type ? }
else if ((torddef(rd).typ=scurrency) or (torddef(ld).typ=scurrency)) then
begin
if (torddef(ld).typ<>scurrency) then
inserttypeconv(left,s64currencytype);
if (torddef(rd).typ<>scurrency) then
inserttypeconv(right,s64currencytype);
end
{ is there a signed 64 bit type ? }
else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
begin
@ -1240,13 +1259,17 @@ implementation
case nodetype of
slashn :
begin
hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resultrealtype));
{ slashn will only work with floats }
hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype));
include(hp.flags,nf_is_currency);
result:=hp;
end;
muln :
begin
hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,resultrealtype));
if s64currencytype.def.deftype=floatdef then
hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype))
else
hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
include(hp.flags,nf_is_currency);
result:=hp
end;
@ -1497,12 +1520,22 @@ implementation
exit;
end;
{ when currency is used set the result of the
parameters to s64bit, so they are not converted }
if is_currency(resulttype.def) then
begin
left.resulttype:=cs64bittype;
right.resulttype:=cs64bittype;
end;
{ otherwise, create the parameters for the helper }
right := ccallparanode.create(
cordconstnode.create(ord(cs_check_overflow in aktlocalswitches),booltype,true),
ccallparanode.create(right,ccallparanode.create(left,nil)));
left := nil;
if torddef(resulttype.def).typ = s64bit then
{ only qword needs the unsigned code, the
signed code is also used for currency }
if is_signed(resulttype.def) then
procname := 'fpc_mul_int64'
else
procname := 'fpc_mul_qword';
@ -1647,7 +1680,7 @@ implementation
calcregisters(self,1,0,0);
end
{ is there a 64 bit type ? }
else if (torddef(ld).typ in [s64bit,u64bit]) then
else if (torddef(ld).typ in [s64bit,u64bit,scurrency]) then
begin
result := first_add64bitint;
if assigned(result) then
@ -1917,7 +1950,12 @@ begin
end.
{
$Log$
Revision 1.83 2003-04-23 10:10:07 peter
Revision 1.84 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.83 2003/04/23 10:10:07 peter
* expectloc fixes
Revision 1.82 2003/04/22 23:50:22 peter

11
compiler/ncal.pas
View File

@ -2145,7 +2145,7 @@ type
else
begin
expectloc:=LOC_REGISTER;
if is_64bitint(resulttype.def) then
if is_64bit(resulttype.def) then
registers32:=2
else
registers32:=1;
@ -2250,7 +2250,7 @@ type
newcall := self.getcopy;
tcallnode(newcall).left := paras;
tcallnode(newcall).right := oldright;
newblock := internalstatements(statement);
addstatement(statement,callparatemps);
{ add the copy of the call node after the callparatemps block }
@ -2483,7 +2483,12 @@ begin
end.
{
$Log$
Revision 1.141 2003-04-23 13:21:06 peter
Revision 1.142 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.141 2003/04/23 13:21:06 peter
* fix warning for calling constructor inside constructor
Revision 1.140 2003/04/23 12:35:34 florian

19
compiler/ncgadd.pas
View File

@ -116,7 +116,7 @@ interface
if not cmpop then
begin
location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
LOC_REFERENCE,LOC_CREFERENCE:
@ -125,7 +125,7 @@ interface
if not cmpop then
begin
location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
end;
@ -136,7 +136,7 @@ interface
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
if not cmpop then
location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
end;
@ -156,7 +156,7 @@ interface
(location.register.enum <> right.location.register.enum)) then
begin
rg.ungetregister(exprasmlist,right.location.register);
if is_64bitint(right.resulttype.def) then
if is_64bit(right.resulttype.def) then
rg.ungetregister(exprasmlist,right.location.registerhigh);
end;
if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
@ -164,7 +164,7 @@ interface
(location.register.enum <> left.location.register.enum)) then
begin
rg.ungetregister(exprasmlist,left.location.register);
if is_64bitint(left.resulttype.def) then
if is_64bit(left.resulttype.def) then
rg.ungetregister(exprasmlist,left.location.registerhigh);
end;
end;
@ -753,7 +753,7 @@ interface
exit;
end
{ 64bit operations }
else if is_64bitint(left.resulttype.def) then
else if is_64bit(left.resulttype.def) then
begin
second_op64bit;
exit;
@ -816,7 +816,12 @@ begin
end.
{
$Log$
Revision 1.7 2003-04-22 23:50:22 peter
Revision 1.8 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.7 2003/04/22 23:50:22 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

9
compiler/ncgld.pas
View File

@ -831,7 +831,7 @@ implementation
enumdef,
orddef :
begin
if is_64bitint(lt) then
if is_64bit(lt) then
begin
case torddef(lt).typ of
s64bit:
@ -1009,7 +1009,12 @@ begin
end.
{
$Log$
Revision 1.50 2003-04-23 10:12:14 peter
Revision 1.51 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.50 2003/04/23 10:12:14 peter
* allow multi pass2 changed to global boolean instead of node flag
Revision 1.49 2003/04/22 23:50:22 peter

13
compiler/ncgmat.pas
View File

@ -158,7 +158,7 @@ implementation
begin
if is_64bitint(left.resulttype.def) then
if is_64bit(left.resulttype.def) then
begin
secondpass(left);
@ -268,7 +268,7 @@ implementation
exit;
location_copy(location,left.location);
if is_64bitint(resulttype.def) then
if is_64bit(resulttype.def) then
begin
{ this code valid for 64-bit cpu's only ,
otherwise helpers are called in pass_1
@ -367,7 +367,7 @@ implementation
shrn: op:=OP_SHR;
end;
if is_64bitint(left.resulttype.def) then
if is_64bit(left.resulttype.def) then
begin
{ already hanled in 1st pass }
internalerror(2002081501);
@ -467,7 +467,12 @@ begin
end.
{
$Log$
Revision 1.8 2003-04-22 10:09:35 daniel
Revision 1.9 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.8 2003/04/22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used

101
compiler/ncnv.pas
View File

@ -51,6 +51,7 @@ interface
procedure mark_write;override;
function docompare(p: tnode) : boolean; override;
private
function resulttype_int_to_int : tnode;
function resulttype_cord_to_pointer : tnode;
function resulttype_chararray_to_string : tnode;
function resulttype_string_to_chararray : tnode;
@ -59,6 +60,7 @@ interface
function resulttype_char_to_chararray : tnode;
function resulttype_int_to_real : tnode;
function resulttype_real_to_real : tnode;
function resulttype_real_to_currency : tnode;
function resulttype_cchar_to_pchar : tnode;
function resulttype_cstring_to_pchar : tnode;
function resulttype_char_to_char : tnode;
@ -103,7 +105,7 @@ interface
function _first_nothing : tnode;
function _first_array_to_pointer : tnode;
function _first_int_to_real : tnode;
function _first_real_to_real : tnode;
function _first_real_to_real: tnode;
function _first_pointer_to_array : tnode;
function _first_cchar_to_pchar : tnode;
function _first_bool_to_int : tnode;
@ -767,10 +769,42 @@ implementation
end;
function ttypeconvnode.resulttype_int_to_real : tnode;
function ttypeconvnode.resulttype_int_to_int : tnode;
var
v : TConstExprInt;
begin
result:=nil;
if left.nodetype=ordconstn then
begin
v:=tordconstnode(left).value;
if is_currency(resulttype.def) then
v:=v*10000
else if is_currency(left.resulttype.def) then
v:=v div 10000;
result:=cordconstnode.create(v,resulttype,false);
end
else
begin
{ multiply by 10000 for currency. We need to use getcopy to pass
the argument because the current node is always disposed. Only
inserting the multiply in the left node is not possible because
it'll get in an infinite loop to convert int->currency }
if is_currency(resulttype.def) then
begin
result:=caddnode.create(muln,getcopy,cordconstnode.create(10000,resulttype,false));
include(result.flags,nf_is_currency);
end
else if is_currency(left.resulttype.def) then
begin
result:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,resulttype,false));
include(result.flags,nf_is_currency);
end;
end;
end;
function ttypeconvnode.resulttype_int_to_real : tnode;
var
t : trealconstnode;
rv : bestreal;
begin
result:=nil;
@ -778,9 +812,10 @@ implementation
begin
rv:=tordconstnode(left).value;
if is_currency(resulttype.def) then
rv:=rv*10000.0;
t:=crealconstnode.create(rv,resulttype);
result:=t;
rv:=rv*10000.0
else if is_currency(left.resulttype.def) then
rv:=rv/10000.0;
result:=crealconstnode.create(rv,resulttype);
end
else
begin
@ -792,16 +827,35 @@ implementation
begin
result:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resulttype));
include(result.flags,nf_is_currency);
end
else if is_currency(left.resulttype.def) then
begin
result:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,resulttype));
include(result.flags,nf_is_currency);
end;
end;
end;
function ttypeconvnode.resulttype_real_to_currency : tnode;
begin
if not is_currency(resulttype.def) then
internalerror(200304221);
result:=nil;
left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resulttype));
include(left.flags,nf_is_currency);
resulttypepass(left);
{ Convert constants directly, else call Round() }
if left.nodetype=realconstn then
result:=cordconstnode.create(round(trealconstnode(left).value_real),resulttype,false)
else
result:=ccallnode.createinternres('fpc_round',
ccallparanode.create(left,nil),resulttype);
left:=nil;
end;
function ttypeconvnode.resulttype_real_to_real : tnode;
var
t : tnode;
begin
result:=nil;
if is_currency(left.resulttype.def) and not(is_currency(resulttype.def)) then
@ -818,10 +872,7 @@ implementation
resulttypepass(left);
end;
if left.nodetype=realconstn then
begin
t:=crealconstnode.create(trealconstnode(left).value_real,resulttype);
result:=t;
end;
result:=crealconstnode.create(trealconstnode(left).value_real,resulttype);
end;
@ -944,12 +995,13 @@ implementation
{ chararray_2_string } @ttypeconvnode.resulttype_chararray_to_string,
{ array_2_pointer } nil,
{ pointer_2_array } nil,
{ int_2_int } nil,
{ int_2_int } @ttypeconvnode.resulttype_int_to_int,
{ int_2_bool } nil,
{ bool_2_bool } nil,
{ bool_2_int } nil,
{ real_2_real } @ttypeconvnode.resulttype_real_to_real,
{ int_2_real } @ttypeconvnode.resulttype_int_to_real,
{ real_2_currency } @ttypeconvnode.resulttype_real_to_currency,
{ proc_2_procvar } nil,
{ arrayconstructor_2_set } @ttypeconvnode.resulttype_arrayconstructor_to_set,
{ load_smallset } nil,
@ -978,7 +1030,7 @@ implementation
r.proc:=resulttypeconvert[c];
r.obj:=self;
if assigned(r.proc) then
result:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
result:=tprocedureofobject(r)();
end;
{$else}
begin
@ -993,6 +1045,7 @@ implementation
tc_chararray_2_string : resulttype_chararray_to_string;
tc_real_2_real : resulttype_real_to_real;
tc_int_2_real : resulttype_int_to_real;
tc_real_2_currency : resulttype_real_to_currency;
tc_arrayconstructor_2_set : resulttype_arrayconstructor_to_set;
tc_cord_2_pointer : resulttype_cord_to_pointer;
tc_intf_2_guid : resulttype_interface_to_guid;
@ -1328,7 +1381,7 @@ implementation
expectloc:=LOC_REGISTER
else
expectloc:=left.expectloc;
if is_64bitint(resulttype.def) then
if is_64bit(resulttype.def) then
registers32:=max(registers32,2)
else
registers32:=max(registers32,1);
@ -1387,7 +1440,7 @@ implementation
}
typname := lower(pbestrealtype^.def.gettypename);
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resulttype.def) then
if is_64bit(left.resulttype.def) then
begin
if is_signed(left.resulttype.def) then
fname := 'fpc_int64_to_'+typname
@ -1705,6 +1758,7 @@ implementation
@ttypeconvnode._first_bool_to_int,
@ttypeconvnode._first_real_to_real,
@ttypeconvnode._first_int_to_real,
nil, { removed in resulttype_real_to_currency }
@ttypeconvnode._first_proc_to_procvar,
@ttypeconvnode._first_arrayconstructor_to_set,
@ttypeconvnode._first_load_smallset,
@ -1733,7 +1787,7 @@ implementation
{ and should be quite portable too }
r.proc:=firstconvert[c];
r.obj:=self;
first_call_helper:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
first_call_helper:=tprocedureofobject(r){$ifdef FPC}(){$endif FPC}
end;
@ -2037,7 +2091,12 @@ begin
end.
{
$Log$
Revision 1.107 2003-04-23 13:13:08 peter
Revision 1.108 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.107 2003/04/23 13:13:08 peter
* fix checking of procdef type which was broken since loadn returned
pointertype for tp procvar

22
compiler/ncon.pas
View File

@ -45,6 +45,9 @@ interface
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
function docompare(p: tnode) : boolean; override;
{$ifdef extdebug}
procedure _dowrite;override;
{$endif}
end;
trealconstnodeclass = class of trealconstnode;
@ -410,6 +413,15 @@ implementation
(value_real = trealconstnode(p).value_real);
end;
{$ifdef extdebug}
procedure Trealconstnode._dowrite;
begin
inherited _dowrite;
writeln(',');
system.write(writenodeindention,'value = ',value_real);
end;
{$endif}
{*****************************************************************************
TORDCONSTNODE
@ -491,7 +503,8 @@ implementation
begin
inherited _dowrite;
system.write(',value = ',value);
writeln(',');
system.write(writenodeindention,'value = ',value);
end;
{$endif}
@ -925,7 +938,12 @@ begin
end.
{
$Log$
Revision 1.46 2003-04-22 23:50:23 peter
Revision 1.47 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.46 2003/04/22 23:50:23 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

69
compiler/ninl.pas
View File

@ -246,6 +246,7 @@ implementation
procname := procname + 'longword';
u64bit:
procname := procname + 'qword';
scurrency,
s64bit:
procname := procname + 'int64';
else
@ -581,6 +582,10 @@ implementation
para.left:=p1;
end;
{ Currency will be written using the bestreal }
if is_currency(para.left.resulttype.def) then
inserttypeconv(para.left,pbestrealtype^);
case para.left.resulttype.def.deftype of
stringdef :
begin
@ -957,8 +962,11 @@ implementation
end;
u8bit,u16bit,u32bit:
suffix := 'uint_';
scurrency,
s64bit: suffix := 'int64_';
u64bit: suffix := 'qword_';
else
internalerror(200304225);
end;
end;
floatdef:
@ -1039,25 +1047,30 @@ implementation
{ 1.0.x doesn't support int64($ffffffff) correct, it'll expand
to -1 instead of staying $ffffffff. Therefor we use $ffff with
shl twice (PFV) }
if is_signed(t.def) and
is_64bitint(t.def) then
if (inlinenumber=in_low_x) then
v := int64($80000000) shl 32
case torddef(t.def).typ of
s64bit,scurrency :
begin
if (inlinenumber=in_low_x) then
v := int64($80000000) shl 32
else
v := (int64($7fffffff) shl 32) or int64($ffff) shl 16 or int64($ffff)
end;
u64bit :
begin
{ we have to use a dirty trick for high(qword), }
{ because it's bigger than high(tconstexprint) (JM) }
v := 0
end
else
v := (int64($7fffffff) shl 32) or int64($ffff) shl 16 or int64($ffff)
else
if is_64bitint(t.def) then
{ we have to use a dirty trick for high(qword), }
{ because it's bigger than high(tconstexprint) (JM) }
v := 0
else
if not is_signed(t.def) then
v := cardinal(v);
begin
if not is_signed(t.def) then
v := cardinal(v);
end;
end;
hp:=cordconstnode.create(v,t,true);
resulttypepass(hp);
{ fix high(qword) }
if not is_signed(t.def) and
is_64bitint(t.def) and
if (torddef(t.def).typ=u64bit) and
(inlinenumber = in_high_x) then
tordconstnode(hp).value := -1; { is the same as qword($ffffffffffffffff) }
do_lowhigh:=hp;
@ -1654,12 +1667,12 @@ implementation
valid_for_var(tcallparanode(left).left);
if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
is_ordinal(left.resulttype.def) then
is_ordinal(left.resulttype.def) or
is_currency(left.resulttype.def) then
begin
{ value of left gets changed -> must be unique }
{ (bug 1735) (JM) }
set_unique(tcallparanode(left).left);
{ two paras ? }
{ value of left gets changed -> must be unique }
set_unique(tcallparanode(left).left);
{ two paras ? }
if assigned(tcallparanode(left).right) then
begin
if (aktlocalswitches *
@ -1667,7 +1680,10 @@ implementation
begin
{ insert a type conversion }
{ the second param is always longint }
if is_64bitint(left.resulttype.def) then
if is_currency(left.resulttype.def) then
inserttypeconv(tcallparanode(tcallparanode(left).right).left,s64currencytype)
else
if is_64bitint(left.resulttype.def) then
if is_signed(left.resulttype.def) then
inserttypeconv(tcallparanode(tcallparanode(left).right).left,cs64bittype)
else
@ -2061,7 +2077,7 @@ implementation
in_pred_x,
in_succ_x:
begin
if is_64bitint(resulttype.def) then
if is_64bit(resulttype.def) then
begin
if (registers32<2) then
registers32:=2
@ -2090,7 +2106,7 @@ implementation
expectloc:=LOC_VOID;
{ check type }
if is_64bitint(left.resulttype.def) or
if is_64bit(left.resulttype.def) or
{ range/overflow checking doesn't work properly }
{ with the inc/dec code that's generated (JM) }
((left.resulttype.def.deftype = orddef) and
@ -2335,7 +2351,12 @@ begin
end.
{
$Log$
Revision 1.106 2003-04-22 23:50:23 peter
Revision 1.107 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.106 2003/04/22 23:50:23 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

17
compiler/nld.pas
View File

@ -706,7 +706,6 @@ implementation
inserttypeconv(right,left.resulttype);
end;
{ check if the assignment may cause a range check error }
{ if its not explicit, and only if the values are }
{ ordinals, enumdef and floatdef }
@ -726,7 +725,6 @@ implementation
end;
end;
{ call helpers for interface }
if is_interfacecom(left.resulttype.def) then
begin
@ -745,9 +743,8 @@ implementation
test_local_to_procvar(tprocvardef(right.resulttype.def),left.resulttype.def);
end;
function tassignmentnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
@ -757,8 +754,6 @@ implementation
if codegenerror then
exit;
registers32:=left.registers32+right.registers32;
registersfpu:=max(left.registersfpu,right.registersfpu);
{$ifdef SUPPORT_MMX}
@ -766,6 +761,7 @@ implementation
{$endif SUPPORT_MMX}
end;
function tassignmentnode.docompare(p: tnode): boolean;
begin
docompare :=
@ -1025,7 +1021,7 @@ implementation
orddef :
begin
if is_integer(hp.left.resulttype.def) and
not(is_64bitint(hp.left.resulttype.def)) then
not(is_64bitint(hp.left.resulttype.def)) then
begin
hp.left:=ctypeconvnode.create(hp.left,s32bittype);
firstpass(hp.left);
@ -1264,7 +1260,12 @@ begin
end.
{
$Log$
Revision 1.85 2003-04-23 10:10:54 peter
Revision 1.86 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.85 2003/04/23 10:10:54 peter
* procvar is not compared in addrn
Revision 1.84 2003/04/22 23:50:23 peter

152
compiler/nmat.pas
View File

@ -94,8 +94,8 @@ implementation
function tmoddivnode.det_resulttype:tnode;
var
t : tnode;
rd,ld : tdef;
hp,t : tnode;
rd,ld : torddef;
rv,lv : tconstexprint;
begin
result:=nil;
@ -106,6 +106,14 @@ implementation
if codegenerror then
exit;
{ we need 2 orddefs always }
if (left.resulttype.def.deftype<>orddef) then
inserttypeconv(right,s32bittype);
if (right.resulttype.def.deftype<>orddef) then
inserttypeconv(right,s32bittype);
if codegenerror then
exit;
{ check for division by zero }
if is_constintnode(right) then
begin
@ -120,7 +128,7 @@ implementation
begin
lv:=tordconstnode(left).value;
case nodetype of
case nodetype of
modn:
t:=genintconstnode(lv mod rv);
divn:
@ -139,65 +147,92 @@ implementation
exit;
end;
rd:=torddef(right.resulttype.def);
ld:=torddef(left.resulttype.def);
{ if one operand is a cardinal and the other is a positive constant, convert the }
{ constant to a cardinal as well so we don't have to do a 64bit division (JM) }
{ Do the same for qwords and positive constants as well, otherwise things like }
{ "qword mod 10" are evaluated with int64 as result, which is wrong if the }
{ "qword" was > high(int64) (JM) }
if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) then
if (torddef(right.resulttype.def).typ in [u32bit,u64bit]) and
is_constintnode(left) and
(tordconstnode(left).value >= 0) then
inserttypeconv(left,right.resulttype)
else if (torddef(left.resulttype.def).typ in [u32bit,u64bit]) and
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
inserttypeconv(right,left.resulttype);
if (rd.typ in [u32bit,u64bit]) and
is_constintnode(left) and
(tordconstnode(left).value >= 0) then
inserttypeconv(left,right.resulttype)
else
if (ld.typ in [u32bit,u64bit]) and
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
inserttypeconv(right,left.resulttype);
if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) and
(is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def) or
{ when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
((torddef(right.resulttype.def).typ = u32bit) and
is_signed(left.resulttype.def)) or
((torddef(left.resulttype.def).typ = u32bit) and
is_signed(right.resulttype.def))) then
{ when there is one currency value, everything is done
using currency }
if (ld.typ=scurrency) or
(rd.typ=scurrency) then
begin
rd:=right.resulttype.def;
ld:=left.resulttype.def;
{ issue warning if necessary }
if not (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
CGMessage(type_w_mixed_signed_unsigned);
if is_signed(rd) or is_signed(ld) then
begin
if (torddef(ld).typ<>s64bit) then
inserttypeconv(left,cs64bittype);
if (torddef(rd).typ<>s64bit) then
inserttypeconv(right,cs64bittype);
end
else
begin
if (torddef(ld).typ<>u64bit) then
inserttypeconv(left,cu64bittype);
if (torddef(rd).typ<>u64bit) then
inserttypeconv(right,cu64bittype);
end;
if (ld.typ<>scurrency) then
inserttypeconv(left,s64currencytype);
if (rd.typ<>scurrency) then
inserttypeconv(right,s64currencytype);
resulttype:=left.resulttype;
end
else
{ when there is one 64bit value, everything is done
in 64bit }
if (is_64bitint(left.resulttype.def) or
is_64bitint(right.resulttype.def)) then
begin
if is_signed(rd) or is_signed(ld) then
begin
if (torddef(ld).typ<>s64bit) then
inserttypeconv(left,cs64bittype);
if (torddef(rd).typ<>s64bit) then
inserttypeconv(right,cs64bittype);
end
else
begin
if (torddef(ld).typ<>u64bit) then
inserttypeconv(left,cu64bittype);
if (torddef(rd).typ<>u64bit) then
inserttypeconv(right,cu64bittype);
end;
resulttype:=left.resulttype;
end
else
{ when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
if ((rd.typ = u32bit) and
is_signed(left.resulttype.def)) or
((ld.typ = u32bit) and
is_signed(right.resulttype.def)) then
begin
CGMessage(type_w_mixed_signed_unsigned);
if (torddef(ld).typ<>s64bit) then
inserttypeconv(left,cs64bittype);
if (torddef(rd).typ<>s64bit) then
inserttypeconv(right,cs64bittype);
resulttype:=left.resulttype;
end
else
begin
if not(right.resulttype.def.deftype=orddef) or
not(torddef(right.resulttype.def).typ in [s32bit,u32bit]) then
{ Make everything always 32bit }
if not(torddef(right.resulttype.def).typ in [s32bit,u32bit]) then
inserttypeconv(right,s32bittype);
if not(left.resulttype.def.deftype=orddef) or
not(torddef(left.resulttype.def).typ in [s32bit,u32bit]) then
if not(torddef(left.resulttype.def).typ in [s32bit,u32bit]) then
inserttypeconv(left,s32bittype);
{ the resulttype.def depends on the right side, because the left becomes }
{ always 64 bit }
resulttype:=right.resulttype;
end;
{ when the result is currency we need some extra code for
division. this should not be done when the divn node is
created internally }
if (nodetype=divn) and
not(nf_is_currency in flags) and
is_currency(resulttype.def) then
begin
hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
include(hp.flags,nf_is_currency);
result:=hp;
end;
end;
@ -207,11 +242,21 @@ implementation
begin
result := nil;
{ when currency is used set the result of the
parameters to s64bit, so they are not converted }
if is_currency(resulttype.def) then
begin
left.resulttype:=cs64bittype;
right.resulttype:=cs64bittype;
end;
{ otherwise create a call to a helper }
if nodetype = divn then
procname := 'fpc_div_'
else
procname := 'fpc_mod_';
{ only qword needs the unsigned code, the
signed code is also used for currency }
if is_signed(resulttype.def) then
procname := procname + 'int64'
else
@ -400,7 +445,7 @@ implementation
exit;
{ 64 bit ints have their own shift handling }
if not(is_64bitint(left.resulttype.def)) then
if not(is_64bit(left.resulttype.def)) then
begin
regs:=1
end
@ -529,7 +574,7 @@ implementation
registersmmx:=1;
end
{$endif SUPPORT_MMX}
else if is_64bitint(left.resulttype.def) then
else if is_64bit(left.resulttype.def) then
begin
if (left.expectloc<>LOC_REGISTER) and
(registers32<2) then
@ -709,7 +754,7 @@ implementation
end
else
{$endif SUPPORT_MMX}
if is_64bitint(left.resulttype.def) then
if is_64bit(left.resulttype.def) then
begin
if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
begin
@ -748,7 +793,12 @@ begin
end.
{
$Log$
Revision 1.45 2003-04-22 23:50:23 peter
Revision 1.46 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.45 2003/04/22 23:50:23 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

13
compiler/psystem.pas
View File

@ -304,26 +304,30 @@ implementation
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(tfloatdef.create(s64currency));
{$endif x86}
{$ifdef powerpc}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(s64currency));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif powerpc}
{$ifdef sparc}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif sparc}
{$ifdef m68k}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif}
s64currencytype.setdef(tfloatdef.create(s64currency));
{ some other definitions }
voidpointertype.setdef(tpointerdef.create(voidtype));
charpointertype.setdef(tpointerdef.create(cchartype));
@ -479,7 +483,12 @@ implementation
end.
{
$Log$
Revision 1.44 2002-12-06 16:56:59 peter
Revision 1.45 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.44 2002/12/06 16:56:59 peter
* only compile cs_fp_emulation support when cpufpuemu is defined
* define cpufpuemu for m68k only

9
compiler/symconst.pas
View File

@ -146,7 +146,7 @@ type
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
bool8bit,bool16bit,bool32bit,
uchar,uwidechar
uchar,uwidechar,scurrency
);
{ float types }
@ -354,7 +354,12 @@ implementation
end.
{
$Log$
Revision 1.47 2003-04-23 11:37:33 peter
Revision 1.48 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.47 2003/04/23 11:37:33 peter
* po_comp for proc to procvar fixed
Revision 1.46 2003/01/16 22:13:52 peter

37
compiler/symdef.pas
View File

@ -1720,22 +1720,16 @@ implementation
procedure torddef.setsize;
const
sizetbl : array[tbasetype] of longint = (
0,
1,2,4,8,
1,2,4,8,
1,2,4,
1,2,8
);
begin
case typ of
u8bit,s8bit,
uchar,bool8bit:
savesize:=1;
u16bit,s16bit,
bool16bit,uwidechar:
savesize:=2;
s32bit,u32bit,
bool32bit:
savesize:=4;
u64bit,s64bit:
savesize:=8;
else
savesize:=0;
end;
savesize:=sizetbl[typ];
end;
@ -1797,7 +1791,7 @@ implementation
otUByte,otUWord,otULong,otUByte{otNone},
otSByte,otSWord,otSLong,otUByte{otNone},
otUByte,otUWord,otULong,
otUByte,otUWord);
otUByte,otUWord,otUByte);
begin
write_rtti_name;
rttiList.concat(Tai_const.Create_8bit(byte(trans[typ])));
@ -1879,7 +1873,7 @@ implementation
'Byte','Word','DWord','QWord',
'ShortInt','SmallInt','LongInt','Int64',
'Boolean','WordBool','LongBool',
'Char','WideChar');
'Char','WideChar','Currency');
begin
gettypename:=names[typ];
@ -4010,7 +4004,7 @@ implementation
'Uc','Us','Ui','Us',
'Sc','s','i','x',
'b','b','b',
'c','w');
'c','w','x');
var
s : string;
@ -5719,7 +5713,12 @@ begin
end.
{
$Log$
Revision 1.134 2003-04-23 12:35:34 florian
Revision 1.135 2003-04-23 20:16:04 peter
+ added currency support based on int64
+ is_64bit for use in cg units instead of is_64bitint
* removed cgmessage from n386add, replace with internalerrors
Revision 1.134 2003/04/23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...