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

* generic write_float and str_float

Browse Source 
* fixed constant float conversions
This commit is contained in:
peter 1999-05-06 09:05:05 +00:00
parent cc192abd33
commit 1c96916943
21 changed files with 348 additions and 336 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/aasm.pas
View File

@ -49,9 +49,9 @@ unit aasm;
ait_const_16bit, ait_const_16bit,
ait_const_8bit, ait_const_8bit,
ait_const_symbol, ait_const_symbol,
ait_real_80bit,
ait_real_64bit, ait_real_64bit,
ait_real_32bit, ait_real_32bit,
ait_real_extended,
ait_comp, ait_comp,
ait_external, ait_external,
ait_align, ait_align,
@ -278,7 +278,7 @@ unit aasm;
{ bestreal is defined in globals } { bestreal is defined in globals }
{$ifdef i386} {$ifdef i386}
const const
ait_bestreal = ait_real_extended; ait_bestreal = ait_real_80bit;
type type
pai_bestreal = pai_extended; pai_bestreal = pai_extended;
tai_bestreal = tai_extended; tai_bestreal = tai_extended;
@ -522,7 +522,7 @@ uses
begin begin
inherited init; inherited init;
typ:=ait_real_extended; typ:=ait_real_80bit;
value:=_value; value:=_value;
end; end;
@ -1006,7 +1006,11 @@ uses
end. end.
{ {
$Log$ $Log$
Revision 1.41 1999-05-02 22:41:46 peter Revision 1.42 1999-05-06 09:05:05 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.41 1999/05/02 22:41:46 peter
* moved section names to systems * moved section names to systems
* fixed nasm,intel writer * fixed nasm,intel writer

12
compiler/ag386bin.pas
View File

@ -350,7 +350,7 @@ unit ag386bin;
objectalloc^.sectionalloc(8); objectalloc^.sectionalloc(8);
ait_real_32bit : ait_real_32bit :
objectalloc^.sectionalloc(4); objectalloc^.sectionalloc(4);
ait_real_extended : ait_real_80bit :
objectalloc^.sectionalloc(10); objectalloc^.sectionalloc(10);
ait_const_rva, ait_const_rva,
ait_const_symbol : ait_const_symbol :
@ -455,7 +455,7 @@ unit ag386bin;
objectalloc^.sectionalloc(8); objectalloc^.sectionalloc(8);
ait_real_32bit : ait_real_32bit :
objectalloc^.sectionalloc(4); objectalloc^.sectionalloc(4);
ait_real_extended : ait_real_80bit :
objectalloc^.sectionalloc(10); objectalloc^.sectionalloc(10);
ait_const_rva, ait_const_rva,
ait_const_symbol : ait_const_symbol :
@ -604,7 +604,7 @@ unit ag386bin;
objectoutput^.writebytes(pai_double(hp)^.value,8); objectoutput^.writebytes(pai_double(hp)^.value,8);
ait_real_32bit : ait_real_32bit :
objectoutput^.writebytes(pai_single(hp)^.value,4); objectoutput^.writebytes(pai_single(hp)^.value,4);
ait_real_extended : ait_real_80bit :
objectoutput^.writebytes(pai_extended(hp)^.value,10); objectoutput^.writebytes(pai_extended(hp)^.value,10);
ait_string : ait_string :
objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len); objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
@ -774,7 +774,11 @@ unit ag386bin;
end. end.
{ {
$Log$ $Log$
Revision 1.4 1999-05-05 22:21:47 peter Revision 1.5 1999-05-06 09:05:07 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.4 1999/05/05 22:21:47 peter
* updated messages * updated messages
Revision 1.3 1999/05/05 17:34:29 peter Revision 1.3 1999/05/05 17:34:29 peter

12
compiler/ag386int.pas
View File

@ -450,7 +450,7 @@ unit ag386int;
end; end;
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value)); ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value)); ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
ait_real_extended : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value)); ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value)); ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
ait_string : begin ait_string : begin
counter := 0; counter := 0;
@ -533,7 +533,7 @@ unit ag386int;
if (assigned(hp^.next) and not(pai(hp^.next)^.typ in if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit, [ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_rva, ait_const_symbol,ait_const_rva,
ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_string])) then
AsmWriteLn(':'); AsmWriteLn(':');
end; end;
end; end;
@ -549,7 +549,7 @@ ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]
if assigned(hp^.next) and not(pai(hp^.next)^.typ in if assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit, [ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_rva, ait_const_symbol,ait_const_rva,
ait_real_64bit,ait_real_extended,ait_string]) then ait_real_64bit,ait_real_80bit,ait_string]) then
AsmWriteLn(':') AsmWriteLn(':')
end; end;
ait_instruction : begin ait_instruction : begin
@ -773,7 +773,11 @@ ait_stab_function_name : ;
end. end.
{ {
$Log$ $Log$
Revision 1.36 1999-05-04 21:44:31 florian Revision 1.37 1999-05-06 09:05:09 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.36 1999/05/04 21:44:31 florian
* changes to compile it with Delphi 4.0 * changes to compile it with Delphi 4.0
Revision 1.35 1999/05/02 22:41:49 peter Revision 1.35 1999/05/02 22:41:49 peter

8
compiler/ag386nsm.pas
View File

@ -448,7 +448,7 @@ unit ag386nsm;
end; end;
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value)); ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value)); ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
ait_real_extended : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value)); ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value)); ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
ait_string : begin ait_string : begin
counter := 0; counter := 0;
@ -737,7 +737,11 @@ ait_stab_function_name : ;
end. end.
{ {
$Log$ $Log$
Revision 1.31 1999-05-04 21:44:32 florian Revision 1.32 1999-05-06 09:05:11 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.31 1999/05/04 21:44:32 florian
* changes to compile it with Delphi 4.0 * changes to compile it with Delphi 4.0
Revision 1.30 1999/05/02 22:41:50 peter Revision 1.30 1999/05/02 22:41:50 peter

10
compiler/cg386con.pas
View File

@ -75,7 +75,7 @@ implementation
if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
begin begin
if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.value_real)) or if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.value_real)) or
((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.value_real)) or ((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.value_real)) or
((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.value_real)) then ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.value_real)) then
begin begin
{ found! } { found! }
@ -96,9 +96,9 @@ implementation
consts^.concat(new(pai_cut,init)); consts^.concat(new(pai_cut,init));
consts^.concat(new(pai_label,init(lastlabel))); consts^.concat(new(pai_label,init(lastlabel)));
case p^.realtyp of case p^.realtyp of
ait_real_80bit : consts^.concat(new(pai_extended,init(p^.value_real)));
ait_real_64bit : consts^.concat(new(pai_double,init(p^.value_real))); ait_real_64bit : consts^.concat(new(pai_double,init(p^.value_real)));
ait_real_32bit : consts^.concat(new(pai_single,init(p^.value_real))); ait_real_32bit : consts^.concat(new(pai_single,init(p^.value_real)));
ait_real_extended : consts^.concat(new(pai_extended,init(p^.value_real)));
else else
internalerror(10120); internalerror(10120);
end; end;
@ -410,7 +410,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.32 1999-05-01 13:24:06 peter Revision 1.33 1999-05-06 09:05:12 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.32 1999/05/01 13:24:06 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

115
compiler/cg386inl.pas
View File

@ -35,7 +35,7 @@ implementation
globtype,systems, globtype,systems,
cobjects,verbose,globals,files, cobjects,verbose,globals,files,
symtable,aasm,types, symtable,aasm,types,
hcodegen,temp_gen,pass_2, hcodegen,temp_gen,pass_1,pass_2,
{$ifndef OLDASM} {$ifndef OLDASM}
i386base,i386asm, i386base,i386asm,
{$else} {$else}
@ -148,9 +148,9 @@ implementation
procedure secondinline(var p : ptree); procedure secondinline(var p : ptree);
const const
{ tfloattype = (f32bit,s32real,s64real,s80real,s64bit); } {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
float_name: array[tfloattype] of string[8]= { float_name: array[tfloattype] of string[8]=
('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16'); ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC); incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB); addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
var var
@ -188,6 +188,7 @@ implementation
node,hp : ptree; node,hp : ptree;
typedtyp, typedtyp,
pararesult : pdef; pararesult : pdef;
orgfloattype : tfloattype;
has_length : boolean; has_length : boolean;
dummycoll : tdefcoll; dummycoll : tdefcoll;
iolabel : plabel; iolabel : plabel;
@ -280,6 +281,16 @@ implementation
hp^.right:=nil; hp^.right:=nil;
if hp^.is_colon_para then if hp^.is_colon_para then
CGMessage(parser_e_illegal_colon_qualifier); CGMessage(parser_e_illegal_colon_qualifier);
{ when float is written then we need bestreal to be pushed
convert here else we loose the old flaot type }
if (not doread) and
(ft<>ft_typed) and
(hp^.left^.resulttype^.deftype=floatdef) then
begin
orgfloattype:=pfloatdef(hp^.left^.resulttype)^.typ;
hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
firstpass(hp^.left);
end;
{ when read ord,floats are functions, so they need this { when read ord,floats are functions, so they need this
parameter as their destination instead of being pushed } parameter as their destination instead of being pushed }
if doread and if doread and
@ -368,40 +379,15 @@ implementation
begin begin
if pararesult^.deftype=floatdef then if pararesult^.deftype=floatdef then
push_int(-1); push_int(-1);
end end;
{ push also the real type for floats }
if pararesult^.deftype=floatdef then
push_int(ord(orgfloattype));
end; end;
case pararesult^.deftype of case pararesult^.deftype of
stringdef : stringdef :
begin begin
{$ifndef OLDREAD}
emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname,true); emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname,true);
{$else}
if doread then
begin
{ push maximum string length }
case pstringdef(pararesult)^.string_typ of
st_shortstring:
emitcall ('FPC_READ_TEXT_STRING',true);
st_ansistring:
emitcall ('FPC_READ_TEXT_ANSISTRING',true);
st_longstring:
emitcall ('FPC_READ_TEXT_LONGSTRING',true);
st_widestring:
emitcall ('FPC_READ_TEXT_ANSISTRING',true);
end
end
else
Case pstringdef(Pararesult)^.string_typ of
st_shortstring:
emitcall ('FPC_WRITE_TEXT_STRING',true);
st_ansistring:
emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
st_longstring:
emitcall ('FPC_WRITE_TEXT_LONGSTRING',true);
st_widestring:
emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
end;
{$endif}
end; end;
pointerdef : pointerdef :
begin begin
@ -415,48 +401,17 @@ implementation
end; end;
floatdef : floatdef :
begin begin
{$ifndef OLDREAD} emitcall(rdwrprefix[doread]+'FLOAT',true);
if doread then if doread then
begin StoreDirectFuncResult(destpara);
emitcall(rdwrprefix[doread]+'FLOAT',true);
StoreDirectFuncResult(destpara);
end
else
{$endif}
emitcall(rdwrprefix[doread]+float_name[pfloatdef(pararesult)^.typ],true)
end; end;
orddef : orddef :
begin begin
case porddef(pararesult)^.typ of case porddef(pararesult)^.typ of
{$ifndef OLDREAD}
s8bit,s16bit,s32bit : s8bit,s16bit,s32bit :
emitcall(rdwrprefix[doread]+'SINT',true); emitcall(rdwrprefix[doread]+'SINT',true);
u8bit,u16bit,u32bit : u8bit,u16bit,u32bit :
emitcall(rdwrprefix[doread]+'UINT',true); emitcall(rdwrprefix[doread]+'UINT',true);
{$else}
u8bit :
if doread then
emitcall('FPC_READ_TEXT_BYTE',true);
s8bit :
if doread then
emitcall('FPC_READ_TEXT_SHORTINT',true);
u16bit :
if doread then
emitcall('FPC_READ_TEXT_WORD',true);
s16bit :
if doread then
emitcall('FPC_READ_TEXT_INTEGER',true);
s32bit :
if doread then
emitcall('FPC_READ_TEXT_LONGINT',true)
else
emitcall('FPC_WRITE_TEXT_LONGINT',true);
u32bit :
if doread then
emitcall('FPC_READ_TEXT_CARDINAL',true)
else
emitcall('FPC_WRITE_TEXT_CARDINAL',true);
{$endif}
uchar : uchar :
emitcall(rdwrprefix[doread]+'CHAR',true); emitcall(rdwrprefix[doread]+'CHAR',true);
s64bitint: s64bitint:
@ -468,10 +423,8 @@ implementation
bool32bit : bool32bit :
emitcall(rdwrprefix[doread]+'BOOLEAN',true); emitcall(rdwrprefix[doread]+'BOOLEAN',true);
end; end;
{$ifndef OLDREAD}
if doread then if doread then
StoreDirectFuncResult(destpara); StoreDirectFuncResult(destpara);
{$endif}
end; end;
end; end;
end; end;
@ -533,6 +486,7 @@ implementation
hp,node : ptree; hp,node : ptree;
dummycoll : tdefcoll; dummycoll : tdefcoll;
is_real,has_length : boolean; is_real,has_length : boolean;
realtype : tfloattype;
procedureprefix : string; procedureprefix : string;
begin begin
@ -543,7 +497,10 @@ implementation
while assigned(node^.right) do node:=node^.right; while assigned(node^.right) do node:=node^.right;
{ if a real parameter somewhere then call REALSTR } { if a real parameter somewhere then call REALSTR }
if (node^.left^.resulttype^.deftype=floatdef) then if (node^.left^.resulttype^.deftype=floatdef) then
is_real:=true; begin
is_real:=true;
realtype:=pfloatdef(node^.left^.resulttype)^.typ;
end;
node:=p^.left; node:=p^.left;
{ we have at least two args } { we have at least two args }
@ -570,6 +527,11 @@ implementation
hp:=node; hp:=node;
node:=node^.right; node:=node^.right;
hp^.right:=nil; hp^.right:=nil;
{ if real push real type }
if is_real then
push_int(ord(realtype));
{ frac para } { frac para }
if hp^.is_colon_para and assigned(node) and if hp^.is_colon_para and assigned(node) and
node^.is_colon_para then node^.is_colon_para then
@ -610,6 +572,13 @@ implementation
else else
push_int(-1); push_int(-1);
{ Convert float to bestreal }
if is_real then
begin
hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
firstpass(hp^.left);
end;
{ last arg longint or real } { last arg longint or real }
secondcallparan(hp,@dummycoll,false secondcallparan(hp,@dummycoll,false
,false,false,0 ,false,false,0
@ -620,7 +589,7 @@ implementation
exit; exit;
if is_real then if is_real then
emitcall(procedureprefix+float_name[pfloatdef(hp^.resulttype)^.typ],true) emitcall(procedureprefix+'FLOAT',true)
else else
case porddef(hp^.resulttype)^.typ of case porddef(hp^.resulttype)^.typ of
u32bit: u32bit:
@ -1272,7 +1241,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.46 1999-05-05 16:18:20 jonas Revision 1.47 1999-05-06 09:05:13 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.46 1999/05/05 16:18:20 jonas
* changes to handle_val so register vars are pushed/poped only once * changes to handle_val so register vars are pushed/poped only once
Revision 1.45 1999/05/01 13:24:08 peter Revision 1.45 1999/05/01 13:24:08 peter

11
compiler/cg386ld.pas
View File

@ -425,9 +425,8 @@ implementation
case pfloatdef(p^.left^.resulttype)^.typ of case pfloatdef(p^.left^.resulttype)^.typ of
s32real : p^.right^.realtyp:=ait_real_32bit; s32real : p^.right^.realtyp:=ait_real_32bit;
s64real : p^.right^.realtyp:=ait_real_64bit; s64real : p^.right^.realtyp:=ait_real_64bit;
s80real : p^.right^.realtyp:=ait_real_extended; s80real : p^.right^.realtyp:=ait_real_80bit;
{ what about f32bit and s64bit } end;
end;
end; end;
end; end;
secondpass(p^.right); secondpass(p^.right);
@ -864,7 +863,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.52 1999-05-01 13:24:10 peter Revision 1.53 1999-05-06 09:05:16 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.52 1999/05/01 13:24:10 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

12
compiler/pexpr.pas
View File

@ -1058,7 +1058,7 @@ unit pexpr;
constchar : constchar :
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef); p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal : constreal :
p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^); p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^,bestrealdef^);
constbool : constbool :
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef); p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constset : constset :
@ -1634,7 +1634,7 @@ unit pexpr;
else else
begin begin
consume(INTCONST); consume(INTCONST);
p1:=genrealconstnode(d); p1:=genrealconstnode(d,bestrealdef^);
end; end;
end end
else else
@ -1651,7 +1651,7 @@ unit pexpr;
d:=1.0; d:=1.0;
end; end;
consume(REALNUMBER); consume(REALNUMBER);
p1:=genrealconstnode(d); p1:=genrealconstnode(d,bestrealdef^);
end; end;
_STRING : begin _STRING : begin
pd:=stringtype; pd:=stringtype;
@ -1979,7 +1979,11 @@ unit pexpr;
end. end.
{ {
$Log$ $Log$
Revision 1.100 1999-05-04 21:44:57 florian Revision 1.101 1999-05-06 09:05:21 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.100 1999/05/04 21:44:57 florian
* changes to compile it with Delphi 4.0 * changes to compile it with Delphi 4.0
Revision 1.99 1999/05/01 13:24:31 peter Revision 1.99 1999/05/01 13:24:31 peter

118
compiler/psystem.pas
View File

@ -81,58 +81,61 @@ var
vmtarraydef : parraydef; vmtarraydef : parraydef;
vmtsymtable : psymtable; vmtsymtable : psymtable;
begin begin
p^.insert(new(ptypesym,init('longint',s32bitdef))); { Internal types }
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
p^.insert(new(ptypesym,init('void',voiddef)));
p^.insert(new(ptypesym,init('char',cchardef)));
p^.insert(new(ptypesym,init('formal',cformaldef))); p^.insert(new(ptypesym,init('formal',cformaldef)));
p^.insert(new(ptypesym,init('void',voiddef)));
p^.insert(new(ptypesym,init('byte',u8bitdef)));
p^.insert(new(ptypesym,init('word',u16bitdef)));
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
p^.insert(new(ptypesym,init('longint',s32bitdef)));
{$ifdef INT64} {$ifdef INT64}
p^.insert(new(ptypesym,init('qword',cu64bitdef))); p^.insert(new(ptypesym,init('qword',cu64bitdef)));
p^.insert(new(ptypesym,init('int64',cs64bitintdef))); p^.insert(new(ptypesym,init('int64',cs64bitintdef)));
{$endif INT64} {$endif INT64}
{$ifdef i386} p^.insert(new(ptypesym,init('char',cchardef)));
p^.insert(new(ptypesym,init('s64real',c64floatdef)));
{$endif i386}
p^.insert(new(ptypesym,init('s80real',s80floatdef)));
p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
p^.insert(new(ptypesym,init('byte',u8bitdef)));
p^.insert(new(ptypesym,init('string',cshortstringdef)));
p^.insert(new(ptypesym,init('shortstring',cshortstringdef))); p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
p^.insert(new(ptypesym,init('longstring',clongstringdef))); p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef))); p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef))); p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
p^.insert(new(ptypesym,init('openshortstring',openshortstringdef))); p^.insert(new(ptypesym,init('openshortstring',openshortstringdef)));
p^.insert(new(ptypesym,init('word',u16bitdef)));
p^.insert(new(ptypesym,init('boolean',booldef))); p^.insert(new(ptypesym,init('boolean',booldef)));
p^.insert(new(ptypesym,init('void_pointer',voidpointerdef))); p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
p^.insert(new(ptypesym,init('char_pointer',charpointerdef))); p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
p^.insert(new(ptypesym,init('void_farpointer',voidfarpointerdef))); p^.insert(new(ptypesym,init('void_farpointer',voidfarpointerdef)));
p^.insert(new(ptypesym,init('openchararray',openchararraydef))); p^.insert(new(ptypesym,init('openchararray',openchararraydef)));
p^.insert(new(ptypesym,init('file',cfiledef))); p^.insert(new(ptypesym,init('file',cfiledef)));
{$ifdef i386} p^.insert(new(ptypesym,init('s32real',s32floatdef)));
p^.insert(new(ptypesym,init('REAL',c64floatdef))); p^.insert(new(ptypesym,init('s64real',s64floatdef)));
p^.insert(new(ptypesym,init('s80real',s80floatdef)));
p^.insert(new(ptypesym,init('s32fixed',s32fixeddef)));
{ Add a type for virtual method tables in lowercase }
{ so it isn't reachable! }
vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precdef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,init(vmtdef));
vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
vmtsymtable^.insert(new(pvarsym,init('mlength',globaldef('longint'))));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := voidpointerdef;
vmtsymtable^.insert(new(pvarsym,init('__pfn',vmtarraydef)));
p^.insert(new(ptypesym,init('__vtbl_ptr_type',vmtdef)));
p^.insert(new(ptypesym,init('pvmt',pvmtdef)));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := pvmtdef;
p^.insert(new(ptypesym,init('vtblarray',vmtarraydef)));
insertinternsyms(p);
{ Normal types }
p^.insert(new(ptypesym,init('SINGLE',s32floatdef)));
p^.insert(new(ptypesym,init('DOUBLE',s64floatdef)));
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef))); p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit))))); p^.insert(new(ptypesym,init('REAL',s64floatdef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bitcomp)))));
{$endif} {$endif}
{$ifdef m68k}
{ internal definitions }
p^.insert(new(ptypesym,init('s32real',c64floatdef)));
{ mappings... }
p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s32real)))));
if (cs_fp_emulation) in aktmoduleswitches then
p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('DOUBLE',c64floatdef)));
if (cs_fp_emulation) in aktmoduleswitches then
p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s32real)))))
else
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
{ p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s32real)))));}
{$endif}
p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
p^.insert(new(ptypesym,init('POINTER',voidpointerdef))); p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
p^.insert(new(ptypesym,init('FARPOINTER',voidfarpointerdef))); p^.insert(new(ptypesym,init('FARPOINTER',voidfarpointerdef)));
p^.insert(new(ptypesym,init('STRING',cshortstringdef))); { p^.insert(new(ptypesym,init('STRING',cshortstringdef))); }
p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef))); p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef))); p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef))); p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
@ -151,23 +154,6 @@ begin
p^.insert(new(ptypesym,init('INT64',cs64bitintdef))); p^.insert(new(ptypesym,init('INT64',cs64bitintdef)));
{$endif INT64} {$endif INT64}
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef))))); p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
{ Add a type for virtual method tables in lowercase }
{ so it isn't reachable! }
vmtsymtable:=new(psymtable,init(recordsymtable));
vmtdef:=new(precdef,init(vmtsymtable));
pvmtdef:=new(ppointerdef,init(vmtdef));
vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
vmtsymtable^.insert(new(pvarsym,init('mlength',globaldef('longint'))));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := voidpointerdef;
vmtsymtable^.insert(new(pvarsym,init('__pfn',vmtarraydef)));
p^.insert(new(ptypesym,init('__vtbl_ptr_type',vmtdef)));
p^.insert(new(ptypesym,init('pvmt',pvmtdef)));
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
vmtarraydef^.definition := pvmtdef;
p^.insert(new(ptypesym,init('vtblarray',vmtarraydef)));
insertinternsyms(p);
end; end;
@ -176,13 +162,16 @@ procedure readconstdefs;
Load all default definitions for consts from the system unit Load all default definitions for consts from the system unit
} }
begin begin
s32bitdef:=porddef(globaldef('longint')); u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
u32bitdef:=porddef(globaldef('ulong')); u32bitdef:=porddef(globaldef('ulong'));
cformaldef:=pformaldef(globaldef('formal')); s32bitdef:=porddef(globaldef('longint'));
{$ifdef INT64} {$ifdef INT64}
cu64bitdef:=porddef(globaldef('qword')); cu64bitdef:=porddef(globaldef('qword'));
cs64bitintdef:=porddef(globaldef('int64')); cs64bitintdef:=porddef(globaldef('int64'));
{$endif INT64} {$endif INT64}
cformaldef:=pformaldef(globaldef('formal'));
voiddef:=porddef(globaldef('void'));
cchardef:=porddef(globaldef('char')); cchardef:=porddef(globaldef('char'));
cshortstringdef:=pstringdef(globaldef('shortstring')); cshortstringdef:=pstringdef(globaldef('shortstring'));
clongstringdef:=pstringdef(globaldef('longstring')); clongstringdef:=pstringdef(globaldef('longstring'));
@ -190,17 +179,10 @@ begin
cwidestringdef:=pstringdef(globaldef('widestring')); cwidestringdef:=pstringdef(globaldef('widestring'));
openshortstringdef:=pstringdef(globaldef('openshortstring')); openshortstringdef:=pstringdef(globaldef('openshortstring'));
openchararraydef:=parraydef(globaldef('openchararray')); openchararraydef:=parraydef(globaldef('openchararray'));
{$ifdef i386} s32floatdef:=pfloatdef(globaldef('s32real'));
c64floatdef:=pfloatdef(globaldef('s64real')); s64floatdef:=pfloatdef(globaldef('s64real'));
{$endif}
{$ifdef m68k}
c64floatdef:=pfloatdef(globaldef('s32real'));
{$endif m68k}
s80floatdef:=pfloatdef(globaldef('s80real')); s80floatdef:=pfloatdef(globaldef('s80real'));
s32fixeddef:=pfloatdef(globaldef('cs32fixed')); s32fixeddef:=pfloatdef(globaldef('s32fixed'));
voiddef:=porddef(globaldef('void'));
u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
booldef:=porddef(globaldef('boolean')); booldef:=porddef(globaldef('boolean'));
voidpointerdef:=ppointerdef(globaldef('void_pointer')); voidpointerdef:=ppointerdef(globaldef('void_pointer'));
charpointerdef:=ppointerdef(globaldef('char_pointer')); charpointerdef:=ppointerdef(globaldef('char_pointer'));
@ -219,12 +201,12 @@ begin
{ create definitions for constants } { create definitions for constants }
oldregisterdef:=registerdef; oldregisterdef:=registerdef;
registerdef:=false; registerdef:=false;
cformaldef:=new(pformaldef,init);
voiddef:=new(porddef,init(uvoid,0,0)); voiddef:=new(porddef,init(uvoid,0,0));
u8bitdef:=new(porddef,init(u8bit,0,255)); u8bitdef:=new(porddef,init(u8bit,0,255));
u16bitdef:=new(porddef,init(u16bit,0,65535)); u16bitdef:=new(porddef,init(u16bit,0,65535));
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff)); u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff)); s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
cformaldef:=new(pformaldef,init);
{$ifdef INT64} {$ifdef INT64}
cu64bitdef:=new(porddef,init(u64bit,0,0)); cu64bitdef:=new(porddef,init(u64bit,0,0));
cs64bitintdef:=new(porddef,init(s64bitint,0,0)); cs64bitintdef:=new(porddef,init(s64bitint,0,0));
@ -241,11 +223,13 @@ begin
openchararraydef:=new(parraydef,init(0,-1,s32bitdef)); openchararraydef:=new(parraydef,init(0,-1,s32bitdef));
parraydef(openchararraydef)^.definition:=cchardef; parraydef(openchararraydef)^.definition:=cchardef;
{$ifdef i386} {$ifdef i386}
c64floatdef:=new(pfloatdef,init(s64real)); s32floatdef:=new(pfloatdef,init(s32real));
s64floatdef:=new(pfloatdef,init(s64real));
s80floatdef:=new(pfloatdef,init(s80real)); s80floatdef:=new(pfloatdef,init(s80real));
{$endif} {$endif}
{$ifdef m68k} {$ifdef m68k}
c64floatdef:=new(pfloatdef,init(s32real)); s32floatdef:=new(pfloatdef,init(s32real))
s64floatdef:=new(pfloatdef,init(s32real));
if (cs_fp_emulation in aktmoduleswitches) then if (cs_fp_emulation in aktmoduleswitches) then
s80floatdef:=new(pfloatdef,init(s32real)) s80floatdef:=new(pfloatdef,init(s32real))
else else
@ -264,7 +248,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.21 1999-04-26 18:28:15 peter Revision 1.22 1999-05-06 09:05:23 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.21 1999/04/26 18:28:15 peter
* better read/write array * better read/write array
Revision 1.20 1999/04/17 13:12:20 peter Revision 1.20 1999/04/17 13:12:20 peter

8
compiler/ptconst.pas
View File

@ -181,7 +181,7 @@ unit ptconst;
s64real : curconstsegment^.concat(new(pai_double,init(value))); s64real : curconstsegment^.concat(new(pai_double,init(value)));
s32real : curconstsegment^.concat(new(pai_single,init(value))); s32real : curconstsegment^.concat(new(pai_single,init(value)));
s80real : curconstsegment^.concat(new(pai_extended,init(value))); s80real : curconstsegment^.concat(new(pai_extended,init(value)));
s64bit : curconstsegment^.concat(new(pai_comp,init(value))); s64bitcomp : curconstsegment^.concat(new(pai_comp,init(value)));
f32bit : curconstsegment^.concat(new(pai_const,init_32bit(trunc(value*65536)))); f32bit : curconstsegment^.concat(new(pai_const,init_32bit(trunc(value*65536))));
else internalerror(18); else internalerror(18);
end; end;
@ -714,7 +714,11 @@ unit ptconst;
end. end.
{ {
$Log$ $Log$
Revision 1.41 1999-05-01 13:24:39 peter Revision 1.42 1999-05-06 09:05:24 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.41 1999/05/01 13:24:39 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

8
compiler/ra386att.pas
View File

@ -1841,7 +1841,7 @@ Begin
AS_DQ: AS_DQ:
Begin Begin
Consume(AS_DQ); Consume(AS_DQ);
BuildRealConstant(s64bit); BuildRealConstant(s64bitcomp);
end; end;
AS_SINGLE: AS_SINGLE:
Begin Begin
@ -1983,7 +1983,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.44 1999-05-05 22:22:00 peter Revision 1.45 1999-05-06 09:05:25 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.44 1999/05/05 22:22:00 peter
* updated messages * updated messages
Revision 1.43 1999/05/04 21:45:01 florian Revision 1.43 1999/05/04 21:45:01 florian

8
compiler/rautils.pas
View File

@ -1302,7 +1302,7 @@ end;
s32real : p^.concat(new(pai_single,init(value))); s32real : p^.concat(new(pai_single,init(value)));
s64real : p^.concat(new(pai_double,init(value))); s64real : p^.concat(new(pai_double,init(value)));
s80real : p^.concat(new(pai_extended,init(value))); s80real : p^.concat(new(pai_extended,init(value)));
s64bit : p^.concat(new(pai_comp,init(value))); s64bitcomp : p^.concat(new(pai_comp,init(value)));
f32bit : p^.concat(new(pai_const,init_32bit(trunc(value*$10000)))); f32bit : p^.concat(new(pai_const,init_32bit(trunc(value*$10000))));
end; end;
end; end;
@ -1400,7 +1400,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.12 1999-05-05 22:22:04 peter Revision 1.13 1999-05-06 09:05:27 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.12 1999/05/05 22:22:04 peter
* updated messages * updated messages
Revision 1.11 1999/05/02 22:41:57 peter Revision 1.11 1999/05/02 22:41:57 peter

13
compiler/symdef.inc
View File

@ -1117,8 +1117,8 @@
f32bit, f32bit,
s32real : savesize:=4; s32real : savesize:=4;
s64real : savesize:=8; s64real : savesize:=8;
s64bit : savesize:=8;
s80real : savesize:=extended_size; s80real : savesize:=extended_size;
s64bitcomp : savesize:=8;
else else
savesize:=0; savesize:=0;
end; end;
@ -1148,7 +1148,7 @@
stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+ stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+
tostr($ffff)+';'); tostr($ffff)+';');
{ found this solution in stabsread.c from GDB v4.16 } { found this solution in stabsread.c from GDB v4.16 }
s64bit : stabstring := strpnew('r'+ s64bitcomp : stabstring := strpnew('r'+
s32bitdef^.numberstring+';-'+tostr(savesize)+';0;'); s32bitdef^.numberstring+';-'+tostr(savesize)+';0;');
{$ifdef i386} {$ifdef i386}
{ under dos at least you must give a size of twelve instead of 10 !! } { under dos at least you must give a size of twelve instead of 10 !! }
@ -1164,8 +1164,9 @@
procedure tfloatdef.write_rtti_data; procedure tfloatdef.write_rtti_data;
const const
{tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
translate : array[tfloattype] of byte = translate : array[tfloattype] of byte =
(ftFixed32,ftSingle,ftDouble,ftExtended,ftComp,ftFixed16); (ftSingle,ftDouble,ftExtended,ftComp,ftFixed16,ftFixed32);
begin begin
rttilist^.concat(new(pai_const,init_8bit(tkFloat))); rttilist^.concat(new(pai_const,init_8bit(tkFloat)));
write_rtti_name; write_rtti_name;
@ -3459,7 +3460,11 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.109 1999-05-05 10:05:56 florian Revision 1.110 1999-05-06 09:05:28 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.109 1999/05/05 10:05:56 florian
* a delphi compiled compiler recompiles ppc * a delphi compiled compiler recompiles ppc
Revision 1.108 1999/04/28 22:30:52 pierre Revision 1.108 1999/04/28 22:30:52 pierre

8
compiler/symdefh.inc
View File

@ -316,7 +316,7 @@
{ moment. } { moment. }
{ s64 bit is considered as a real because all } { s64 bit is considered as a real because all }
{ calculations are done by the fpu. } { calculations are done by the fpu. }
tfloattype = (f32bit,s32real,s64real,s80real,s64bit,f16bit); tfloattype = (s32real,s64real,s80real,s64bitcomp,f16bit,f32bit);
pfloatdef = ^tfloatdef; pfloatdef = ^tfloatdef;
tfloatdef = object(tdef) tfloatdef = object(tdef)
@ -506,7 +506,11 @@
{ {
$Log$ $Log$
Revision 1.23 1999-04-26 18:30:02 peter Revision 1.24 1999-05-06 09:05:30 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.23 1999/04/26 18:30:02 peter
* farpointerdef moved into pointerdef.is_far * farpointerdef moved into pointerdef.is_far
Revision 1.22 1999/04/26 13:31:49 peter Revision 1.22 1999/04/26 13:31:49 peter

22
compiler/symtable.pas
View File

@ -295,20 +295,21 @@ unit symtable;
charpointerdef : ppointerdef; { pointer for Char-Pointerdef } charpointerdef : ppointerdef; { pointer for Char-Pointerdef }
voidfarpointerdef : ppointerdef; voidfarpointerdef : ppointerdef;
cformaldef : pformaldef; { unique formal definition }
voiddef : porddef; { Pointer to Void (procedure) } voiddef : porddef; { Pointer to Void (procedure) }
cchardef : porddef; { Pointer to Char } cchardef : porddef; { Pointer to Char }
booldef : porddef; { pointer to boolean type }
u8bitdef : porddef; { Pointer to 8-Bit unsigned } u8bitdef : porddef; { Pointer to 8-Bit unsigned }
u16bitdef : porddef; { Pointer to 16-Bit unsigned } u16bitdef : porddef; { Pointer to 16-Bit unsigned }
u32bitdef : porddef; { Pointer to 32-Bit unsigned } u32bitdef : porddef; { Pointer to 32-Bit unsigned }
s32bitdef : porddef; { Pointer to 32-Bit signed } s32bitdef : porddef; { Pointer to 32-Bit signed }
booldef : porddef; { pointer to boolean type }
cformaldef : pformaldef; { unique formal definition }
cu64bitdef : porddef; { pointer to 64 bit unsigned def } cu64bitdef : porddef; { pointer to 64 bit unsigned def }
cs64bitintdef : porddef; { pointer to 64 bit signed def, } cs64bitdef : porddef; { pointer to 64 bit signed def, }
{ calculated by the int unit on i386 } { calculated by the int unit on i386 }
c64floatdef : pfloatdef; { pointer for realconstn } s32floatdef : pfloatdef; { pointer for realconstn }
s64floatdef : pfloatdef; { pointer for realconstn }
s80floatdef : pfloatdef; { pointer to type of temp. floats } s80floatdef : pfloatdef; { pointer to type of temp. floats }
s32fixeddef : pfloatdef; { pointer to type of temp. fixed } s32fixeddef : pfloatdef; { pointer to type of temp. fixed }
@ -354,6 +355,13 @@ unit symtable;
normal_function_level = 2; normal_function_level = 2;
in_loading : boolean = false; in_loading : boolean = false;
{$ifdef i386}
bestrealdef : ^pfloatdef = @s80floatdef;
{$endif}
{$ifdef m68k}
bestrealdef : ^pfloatdef = @s64floatdef;
{$endif}
var var
macros : psymtable; { pointer for die Symboltabelle mit } macros : psymtable; { pointer for die Symboltabelle mit }
@ -3204,7 +3212,11 @@ const localsymtablestack : psymtable = nil;
end. end.
{ {
$Log$ $Log$
Revision 1.6 1999-05-05 09:19:16 florian Revision 1.7 1999-05-06 09:05:31 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.6 1999/05/05 09:19:16 florian
* more fixes to get it with delphi running * more fixes to get it with delphi running
Revision 1.5 1999/05/01 13:24:43 peter Revision 1.5 1999/05/01 13:24:43 peter

40
compiler/tcadd.pas
View File

@ -178,14 +178,14 @@ implementation
{ other operand is a real const } { other operand is a real const }
if (rt=realconstn) and is_constintnode(p^.left) then if (rt=realconstn) and is_constintnode(p^.left) then
begin begin
t:=genrealconstnode(p^.left^.value); t:=genrealconstnode(p^.left^.value,p^.right^.resulttype);
disposetree(p^.left); disposetree(p^.left);
p^.left:=t; p^.left:=t;
lt:=realconstn; lt:=realconstn;
end; end;
if (lt=realconstn) and is_constintnode(p^.right) then if (lt=realconstn) and is_constintnode(p^.right) then
begin begin
t:=genrealconstnode(p^.right^.value); t:=genrealconstnode(p^.right^.value,p^.left^.resulttype);
disposetree(p^.right); disposetree(p^.right);
p^.right:=t; p^.right:=t;
rt:=realconstn; rt:=realconstn;
@ -214,10 +214,10 @@ implementation
if int(rv)=0 then if int(rv)=0 then
begin begin
Message(parser_e_invalid_float_operation); Message(parser_e_invalid_float_operation);
t:=genrealconstnode(0); t:=genrealconstnode(0,bestrealdef^);
end end
else else
t:=genrealconstnode(int(lv)/int(rv)); t:=genrealconstnode(int(lv)/int(rv),bestrealdef^);
firstpass(t); firstpass(t);
end; end;
else else
@ -235,18 +235,18 @@ implementation
lvd:=p^.left^.value_real; lvd:=p^.left^.value_real;
rvd:=p^.right^.value_real; rvd:=p^.right^.value_real;
case p^.treetype of case p^.treetype of
addn : t:=genrealconstnode(lvd+rvd); addn : t:=genrealconstnode(lvd+rvd,bestrealdef^);
subn : t:=genrealconstnode(lvd-rvd); subn : t:=genrealconstnode(lvd-rvd,bestrealdef^);
muln : t:=genrealconstnode(lvd*rvd); muln : t:=genrealconstnode(lvd*rvd,bestrealdef^);
caretn : t:=genrealconstnode(exp(ln(lvd)*rvd)); caretn : t:=genrealconstnode(exp(ln(lvd)*rvd),bestrealdef^);
slashn : begin slashn : begin
if rvd=0 then if rvd=0 then
begin begin
Message(parser_e_invalid_float_operation); Message(parser_e_invalid_float_operation);
t:=genrealconstnode(0); t:=genrealconstnode(0,bestrealdef^);
end end
else else
t:=genrealconstnode(lvd/rvd); t:=genrealconstnode(lvd/rvd,bestrealdef^);
end; end;
ltn : t:=genordinalconstnode(ord(lvd<rvd),booldef); ltn : t:=genordinalconstnode(ord(lvd<rvd),booldef);
lten : t:=genordinalconstnode(ord(lvd<=rvd),booldef); lten : t:=genordinalconstnode(ord(lvd<=rvd),booldef);
@ -473,12 +473,12 @@ implementation
begin begin
if (porddef(ld)^.typ<>s64bitint) then if (porddef(ld)^.typ<>s64bitint) then
begin begin
p^.left:=gentypeconvnode(p^.left,cs64bitintdef); p^.left:=gentypeconvnode(p^.left,cs64bitdef);
firstpass(p^.left); firstpass(p^.left);
end; end;
if (porddef(rd)^.typ<>s64bitint) then if (porddef(rd)^.typ<>s64bitint) then
begin begin
p^.right:=gentypeconvnode(p^.right,cs64bitintdef); p^.right:=gentypeconvnode(p^.right,cs64bitdef);
firstpass(p^.right); firstpass(p^.right);
end; end;
calcregisters(p,2,0,0); calcregisters(p,2,0,0);
@ -749,10 +749,10 @@ implementation
p^.location.loc:=LOC_REGISTER; p^.location.loc:=LOC_REGISTER;
end end
else else
{ convert both to c64float } { convert both to bestreal }
begin begin
p^.right:=gentypeconvnode(p^.right,c64floatdef); p^.right:=gentypeconvnode(p^.right,bestrealdef^);
p^.left:=gentypeconvnode(p^.left,c64floatdef); p^.left:=gentypeconvnode(p^.left,bestrealdef^);
firstpass(p^.left); firstpass(p^.left);
firstpass(p^.right); firstpass(p^.right);
calcregisters(p,1,1,0); calcregisters(p,1,1,0);
@ -1004,8 +1004,8 @@ implementation
if p^.treetype=slashn then if p^.treetype=slashn then
begin begin
CGMessage(type_h_use_div_for_int); CGMessage(type_h_use_div_for_int);
p^.right:=gentypeconvnode(p^.right,c64floatdef); p^.right:=gentypeconvnode(p^.right,bestrealdef^);
p^.left:=gentypeconvnode(p^.left,c64floatdef); p^.left:=gentypeconvnode(p^.left,bestrealdef^);
firstpass(p^.left); firstpass(p^.left);
firstpass(p^.right); firstpass(p^.right);
{ maybe we need an integer register to save } { maybe we need an integer register to save }
@ -1074,7 +1074,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.28 1999-05-01 13:24:46 peter Revision 1.29 1999-05-06 09:05:32 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.28 1999/05/01 13:24:46 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

143
compiler/tccnv.pas
View File

@ -321,100 +321,93 @@ implementation
var var
t : ptree; t : ptree;
begin begin
if p^.left^.treetype=ordconstn then if p^.left^.treetype=ordconstn then
begin begin
{ convert constants direct } t:=genrealconstnode(p^.left^.value,pfloatdef(p^.resulttype));
{ not because of type conversion } firstpass(t);
t:=genrealconstnode(p^.left^.value); disposetree(p);
{ do a first pass here p:=t;
because firstpass of typeconv does exit;
not redo it for left field !! } end;
firstpass(t); if p^.registersfpu<1 then
{ the type can be something else than s64real !!} p^.registersfpu:=1;
t:=gentypeconvnode(t,p^.resulttype); p^.location.loc:=LOC_FPU;
firstpass(t);
disposetree(p);
p:=t;
exit;
end
else
begin
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
end; end;
procedure first_int_to_fix(var p : ptree); procedure first_int_to_fix(var p : ptree);
var
t : ptree;
begin begin
if p^.left^.treetype=ordconstn then if p^.left^.treetype=ordconstn then
begin begin
{ convert constants direct } t:=genfixconstnode(p^.left^.value shl 16,p^.resulttype);
p^.treetype:=fixconstn; firstpass(t);
p^.value_fix:=p^.left^.value shl 16; disposetree(p);
p^.disposetyp:=dt_nothing; p:=t;
disposetree(p^.left); exit;
p^.location.loc:=LOC_MEM; end;
end if p^.registers32<1 then
else p^.registers32:=1;
begin p^.location.loc:=LOC_REGISTER;
if p^.registers32<1 then
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end;
end; end;
procedure first_real_to_fix(var p : ptree); procedure first_real_to_fix(var p : ptree);
var
t : ptree;
begin begin
if p^.left^.treetype=realconstn then if p^.left^.treetype=fixconstn then
begin begin
{ convert constants direct } t:=genfixconstnode(round(p^.left^.value_real*65536),p^.resulttype);
p^.treetype:=fixconstn; firstpass(t);
p^.value_fix:=round(p^.left^.value_real*65536); disposetree(p);
p^.disposetyp:=dt_nothing; p:=t;
disposetree(p^.left); exit;
p^.location.loc:=LOC_MEM; end;
end { at least one fpu and int register needed }
else if p^.registers32<1 then
begin p^.registers32:=1;
{ at least one fpu and int register needed } if p^.registersfpu<1 then
if p^.registers32<1 then p^.registersfpu:=1;
p^.registers32:=1; p^.location.loc:=LOC_REGISTER;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_REGISTER;
end;
end; end;
procedure first_fix_to_real(var p : ptree); procedure first_fix_to_real(var p : ptree);
var
t : ptree;
begin begin
if p^.left^.treetype=fixconstn then if p^.left^.treetype=fixconstn then
begin begin
{ convert constants direct } t:=genrealconstnode(round(p^.left^.value_fix/65536.0),p^.resulttype);
p^.treetype:=realconstn; firstpass(t);
p^.value_real:=round(p^.left^.value_fix/65536.0); disposetree(p);
p^.disposetyp:=dt_nothing; p:=t;
disposetree(p^.left); exit;
p^.location.loc:=LOC_MEM; end;
end if p^.registersfpu<1 then
else p^.registersfpu:=1;
begin p^.location.loc:=LOC_FPU;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
end; end;
procedure first_real_to_real(var p : ptree); procedure first_real_to_real(var p : ptree);
var
t : ptree;
begin begin
if p^.left^.treetype=realconstn then
begin
t:=genrealconstnode(p^.left^.value_real,p^.resulttype);
firstpass(t);
disposetree(p);
p:=t;
exit;
end;
{ comp isn't a floating type } { comp isn't a floating type }
{$ifdef i386} {$ifdef i386}
if (pfloatdef(p^.resulttype)^.typ=s64bit) and if (pfloatdef(p^.resulttype)^.typ=s64bitcomp) and
(pfloatdef(p^.left^.resulttype)^.typ<>s64bit) and (pfloatdef(p^.left^.resulttype)^.typ<>s64bitcomp) and
not (p^.explizit) then not (p^.explizit) then
CGMessage(type_w_convert_real_2_comp); CGMessage(type_w_convert_real_2_comp);
{$endif} {$endif}
@ -940,7 +933,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.27 1999-05-01 13:24:48 peter Revision 1.28 1999-05-06 09:05:34 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.27 1999/05/01 13:24:48 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

44
compiler/tcinl.pas
View File

@ -131,7 +131,7 @@ implementation
begin begin
case p^.inlinenumber of case p^.inlinenumber of
in_const_pi : in_const_pi :
hp:=genrealconstnode(pi); hp:=genrealconstnode(pi,bestrealdef^);
else else
internalerror(89); internalerror(89);
end; end;
@ -194,28 +194,28 @@ implementation
in_const_frac : in_const_frac :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(frac(vr)) hp:=genrealconstnode(frac(vr),bestrealdef^)
else else
hp:=genrealconstnode(frac(vl)); hp:=genrealconstnode(frac(vl),bestrealdef^);
end; end;
in_const_int : in_const_int :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(int(vr)) hp:=genrealconstnode(int(vr),bestrealdef^)
else else
hp:=genrealconstnode(int(vl)); hp:=genrealconstnode(int(vl),bestrealdef^);
end; end;
in_const_abs : in_const_abs :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(abs(vr)) hp:=genrealconstnode(abs(vr),bestrealdef^)
else else
hp:=genordinalconstnode(abs(vl),p^.left^.resulttype); hp:=genordinalconstnode(abs(vl),p^.left^.resulttype);
end; end;
in_const_sqr : in_const_sqr :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(sqr(vr)) hp:=genrealconstnode(sqr(vr),bestrealdef^)
else else
hp:=genordinalconstnode(sqr(vl),p^.left^.resulttype); hp:=genordinalconstnode(sqr(vl),p^.left^.resulttype);
end; end;
@ -253,42 +253,42 @@ implementation
begin begin
if vr<0.0 then if vr<0.0 then
message(cg_w_may_wrong_math_argument); message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(sqrt(vr)) hp:=genrealconstnode(sqrt(vr),bestrealdef^)
end end
else else
begin begin
if vl<0 then if vl<0 then
message(cg_w_may_wrong_math_argument); message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(sqrt(vl)); hp:=genrealconstnode(sqrt(vl),bestrealdef^);
end; end;
end; end;
in_const_arctan : in_const_arctan :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(arctan(vr)) hp:=genrealconstnode(arctan(vr),bestrealdef^)
else else
hp:=genrealconstnode(arctan(vl)); hp:=genrealconstnode(arctan(vl),bestrealdef^);
end; end;
in_const_cos : in_const_cos :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(cos(vr)) hp:=genrealconstnode(cos(vr),bestrealdef^)
else else
hp:=genrealconstnode(cos(vl)); hp:=genrealconstnode(cos(vl),bestrealdef^);
end; end;
in_const_sin : in_const_sin :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(sin(vr)) hp:=genrealconstnode(sin(vr),bestrealdef^)
else else
hp:=genrealconstnode(sin(vl)); hp:=genrealconstnode(sin(vl),bestrealdef^);
end; end;
in_const_exp : in_const_exp :
begin begin
if isreal then if isreal then
hp:=genrealconstnode(exp(vr)) hp:=genrealconstnode(exp(vr),bestrealdef^)
else else
hp:=genrealconstnode(exp(vl)); hp:=genrealconstnode(exp(vl),bestrealdef^);
end; end;
in_const_ln : in_const_ln :
begin begin
@ -296,13 +296,13 @@ implementation
begin begin
if vr<=0.0 then if vr<=0.0 then
message(cg_w_may_wrong_math_argument); message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(ln(vr)) hp:=genrealconstnode(ln(vr),bestrealdef^)
end end
else else
begin begin
if vl<=0 then if vl<=0 then
message(cg_w_may_wrong_math_argument); message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(ln(vl)); hp:=genrealconstnode(ln(vl),bestrealdef^);
end; end;
end; end;
else else
@ -1104,7 +1104,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.32 1999-05-05 22:25:21 florian Revision 1.33 1999-05-06 09:05:35 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.32 1999/05/05 22:25:21 florian
* fixed register allocation for val * fixed register allocation for val
Revision 1.31 1999/05/02 21:33:57 florian Revision 1.31 1999/05/02 21:33:57 florian

41
compiler/tcld.pas
View File

@ -287,35 +287,10 @@ implementation
end end
else else
begin begin
if (p^.right^.treetype=realconstn) then p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
begin firstpass(p^.right);
if p^.left^.resulttype^.deftype=floatdef then if codegenerror then
begin exit;
case pfloatdef(p^.left^.resulttype)^.typ of
s32real : p^.right^.realtyp:=ait_real_32bit;
s64real : p^.right^.realtyp:=ait_real_64bit;
s80real : p^.right^.realtyp:=ait_real_extended;
{ what about f32bit and s64bit }
else
begin
p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
{ nochmal firstpass wegen der Typkonvertierung aufrufen }
firstpass(p^.right);
if codegenerror then
exit;
end;
end;
end;
end
else
begin
p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
firstpass(p^.right);
if codegenerror then
exit;
end;
end; end;
p^.resulttype:=voiddef; p^.resulttype:=voiddef;
@ -413,7 +388,7 @@ implementation
end; end;
floatdef : floatdef :
begin begin
hp^.left:=gentypeconvnode(hp^.left,s80floatdef); hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
firstpass(hp^.left); firstpass(hp^.left);
end; end;
stringdef : stringdef :
@ -477,7 +452,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.25 1999-05-01 13:24:54 peter Revision 1.26 1999-05-06 09:05:36 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.25 1999/05/01 13:24:54 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

8
compiler/tcmat.pas
View File

@ -197,7 +197,7 @@ implementation
{$endif i386} {$endif i386}
then then
begin begin
t:=genrealconstnode(-p^.left^.value_real); t:=genrealconstnode(-p^.left^.value_real,bestrealdef^);
disposetree(p); disposetree(p);
firstpass(t); firstpass(t);
p:=t; p:=t;
@ -377,7 +377,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.13 1999-05-01 13:24:55 peter Revision 1.14 1999-05-06 09:05:38 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.13 1999/05/01 13:24:55 peter
* merged nasm compiler * merged nasm compiler
* old asm moved to oldasm/ * old asm moved to oldasm/

31
compiler/tree.pas
View File

@ -257,7 +257,7 @@ unit tree;
function gentypeconvnode(node : ptree;t : pdef) : ptree; function gentypeconvnode(node : ptree;t : pdef) : ptree;
function gentypenode(t : pdef) : ptree; function gentypenode(t : pdef) : ptree;
function gencallparanode(expr,next : ptree) : ptree; function gencallparanode(expr,next : ptree) : ptree;
function genrealconstnode(v : bestreal) : ptree; function genrealconstnode(v : bestreal;def : pdef) : ptree;
function gencallnode(v : pprocsym;st : psymtable) : ptree; function gencallnode(v : pprocsym;st : psymtable) : ptree;
function genmethodcallnode(v : pprocsym;st : psymtable;mp : ptree) : ptree; function genmethodcallnode(v : pprocsym;st : psymtable;mp : ptree) : ptree;
@ -770,7 +770,7 @@ unit tree;
end; end;
function genrealconstnode(v : bestreal) : ptree; function genrealconstnode(v : bestreal;def : pdef) : ptree;
var var
p : ptree; p : ptree;
@ -786,22 +786,21 @@ unit tree;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
p^.registersmmx:=0; p^.registersmmx:=0;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
{$ifdef i386} p^.resulttype:=def;
p^.resulttype:=c64floatdef;
p^.value_real:=v; p^.value_real:=v;
{ default value is double } case pfloatdef(def)^.typ of
p^.realtyp:=ait_real_64bit; s32real :
{$endif} p^.realtyp:=ait_real_32bit;
{$ifdef m68k} s64real :
p^.resulttype:=new(pfloatdef,init(s32real)); p^.realtyp:=ait_real_64bit;
p^.value_real:=v; s80real :
{ default value is double } p^.realtyp:=ait_real_80bit;
p^.realtyp:=ait_real_32bit; end;
{$endif}
p^.lab_real:=nil; p^.lab_real:=nil;
genrealconstnode:=p; genrealconstnode:=p;
end; end;
function genstringconstnode(const s : string) : ptree; function genstringconstnode(const s : string) : ptree;
var var
@ -1717,7 +1716,11 @@ unit tree;
end. end.
{ {
$Log$ $Log$
Revision 1.76 1999-05-04 14:27:04 pierre Revision 1.77 1999-05-06 09:05:39 peter
* generic write_float and str_float
* fixed constant float conversions
Revision 1.76 1999/05/04 14:27:04 pierre
* avoid RTE220 in gentypedconstloadnode * avoid RTE220 in gentypedconstloadnode
Revision 1.75 1999/05/01 13:25:02 peter Revision 1.75 1999/05/01 13:25:02 peter