paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 13:10:34 +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_8bit,
ait_const_symbol,
ait_real_80bit,
ait_real_64bit,
ait_real_32bit,
ait_real_extended,
ait_comp,
ait_external,
ait_align,
@ -278,7 +278,7 @@ unit aasm;
{ bestreal is defined in globals }
{$ifdef i386}
const
ait_bestreal = ait_real_extended;
ait_bestreal = ait_real_80bit;
type
pai_bestreal = pai_extended;
tai_bestreal = tai_extended;
@ -522,7 +522,7 @@ uses
begin
inherited init;
typ:=ait_real_extended;
typ:=ait_real_80bit;
value:=_value;
end;
@ -1006,7 +1006,11 @@ uses
end.
{
$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
* fixed nasm,intel writer

12
compiler/ag386bin.pas
View File

@ -350,7 +350,7 @@ unit ag386bin;
objectalloc^.sectionalloc(8);
ait_real_32bit :
objectalloc^.sectionalloc(4);
ait_real_extended :
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_const_rva,
ait_const_symbol :
@ -455,7 +455,7 @@ unit ag386bin;
objectalloc^.sectionalloc(8);
ait_real_32bit :
objectalloc^.sectionalloc(4);
ait_real_extended :
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_const_rva,
ait_const_symbol :
@ -604,7 +604,7 @@ unit ag386bin;
objectoutput^.writebytes(pai_double(hp)^.value,8);
ait_real_32bit :
objectoutput^.writebytes(pai_single(hp)^.value,4);
ait_real_extended :
ait_real_80bit :
objectoutput^.writebytes(pai_extended(hp)^.value,10);
ait_string :
objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
@ -774,7 +774,11 @@ unit ag386bin;
end.
{
$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
Revision 1.3 1999/05/05 17:34:29 peter

12
compiler/ag386int.pas
View File

@ -450,7 +450,7 @@ unit ag386int;
end;
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_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_string : begin
counter := 0;
@ -533,7 +533,7 @@ unit ag386int;
if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
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(':');
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
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
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(':')
end;
ait_instruction : begin
@ -773,7 +773,11 @@ ait_stab_function_name : ;
end.
{
$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
Revision 1.35 1999/05/02 22:41:49 peter

8
compiler/ag386nsm.pas
View File

@ -448,7 +448,7 @@ unit ag386nsm;
end;
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_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_string : begin
counter := 0;
@ -737,7 +737,11 @@ ait_stab_function_name : ;
end.
{
$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
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
begin
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
begin
{ found! }
@ -96,9 +96,9 @@ implementation
consts^.concat(new(pai_cut,init));
consts^.concat(new(pai_label,init(lastlabel)));
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_32bit : consts^.concat(new(pai_single,init(p^.value_real)));
ait_real_extended : consts^.concat(new(pai_extended,init(p^.value_real)));
else
internalerror(10120);
end;
@ -410,7 +410,11 @@ implementation
end.
{
$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
* old asm moved to oldasm/

115
compiler/cg386inl.pas
View File

@ -35,7 +35,7 @@ implementation
globtype,systems,
cobjects,verbose,globals,files,
symtable,aasm,types,
hcodegen,temp_gen,pass_2,
hcodegen,temp_gen,pass_1,pass_2,
{$ifndef OLDASM}
i386base,i386asm,
{$else}
@ -148,9 +148,9 @@ implementation
procedure secondinline(var p : ptree);
const
{ tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
float_name: array[tfloattype] of string[8]=
('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
{tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
{ float_name: array[tfloattype] of string[8]=
('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
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);
var
@ -188,6 +188,7 @@ implementation
node,hp : ptree;
typedtyp,
pararesult : pdef;
orgfloattype : tfloattype;
has_length : boolean;
dummycoll : tdefcoll;
iolabel : plabel;
@ -280,6 +281,16 @@ implementation
hp^.right:=nil;
if hp^.is_colon_para then
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
parameter as their destination instead of being pushed }
if doread and
@ -368,40 +379,15 @@ implementation
begin
if pararesult^.deftype=floatdef then
push_int(-1);
end
end;
{ push also the real type for floats }
if pararesult^.deftype=floatdef then
push_int(ord(orgfloattype));
end;
case pararesult^.deftype of
stringdef :
begin
{$ifndef OLDREAD}
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;
pointerdef :
begin
@ -415,48 +401,17 @@ implementation
end;
floatdef :
begin
{$ifndef OLDREAD}
emitcall(rdwrprefix[doread]+'FLOAT',true);
if doread then
begin
emitcall(rdwrprefix[doread]+'FLOAT',true);
StoreDirectFuncResult(destpara);
end
else
{$endif}
emitcall(rdwrprefix[doread]+float_name[pfloatdef(pararesult)^.typ],true)
StoreDirectFuncResult(destpara);
end;
orddef :
begin
case porddef(pararesult)^.typ of
{$ifndef OLDREAD}
s8bit,s16bit,s32bit :
emitcall(rdwrprefix[doread]+'SINT',true);
u8bit,u16bit,u32bit :
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 :
emitcall(rdwrprefix[doread]+'CHAR',true);
s64bitint:
@ -468,10 +423,8 @@ implementation
bool32bit :
emitcall(rdwrprefix[doread]+'BOOLEAN',true);
end;
{$ifndef OLDREAD}
if doread then
StoreDirectFuncResult(destpara);
{$endif}
end;
end;
end;
@ -533,6 +486,7 @@ implementation
hp,node : ptree;
dummycoll : tdefcoll;
is_real,has_length : boolean;
realtype : tfloattype;
procedureprefix : string;
begin
@ -543,7 +497,10 @@ implementation
while assigned(node^.right) do node:=node^.right;
{ if a real parameter somewhere then call REALSTR }
if (node^.left^.resulttype^.deftype=floatdef) then
is_real:=true;
begin
is_real:=true;
realtype:=pfloatdef(node^.left^.resulttype)^.typ;
end;
node:=p^.left;
{ we have at least two args }
@ -570,6 +527,11 @@ implementation
hp:=node;
node:=node^.right;
hp^.right:=nil;
{ if real push real type }
if is_real then
push_int(ord(realtype));
{ frac para }
if hp^.is_colon_para and assigned(node) and
node^.is_colon_para then
@ -610,6 +572,13 @@ implementation
else
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 }
secondcallparan(hp,@dummycoll,false
,false,false,0
@ -620,7 +589,7 @@ implementation
exit;
if is_real then
emitcall(procedureprefix+float_name[pfloatdef(hp^.resulttype)^.typ],true)
emitcall(procedureprefix+'FLOAT',true)
else
case porddef(hp^.resulttype)^.typ of
u32bit:
@ -1272,7 +1241,11 @@ implementation
end.
{
$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
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
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 }
end;
s80real : p^.right^.realtyp:=ait_real_80bit;
end;
end;
end;
secondpass(p^.right);
@ -864,7 +863,11 @@ implementation
end.
{
$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
* old asm moved to oldasm/

12
compiler/pexpr.pas
View File

@ -1058,7 +1058,7 @@ unit pexpr;
constchar :
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal :
p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^);
p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^,bestrealdef^);
constbool :
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constset :
@ -1634,7 +1634,7 @@ unit pexpr;
else
begin
consume(INTCONST);
p1:=genrealconstnode(d);
p1:=genrealconstnode(d,bestrealdef^);
end;
end
else
@ -1651,7 +1651,7 @@ unit pexpr;
d:=1.0;
end;
consume(REALNUMBER);
p1:=genrealconstnode(d);
p1:=genrealconstnode(d,bestrealdef^);
end;
_STRING : begin
pd:=stringtype;
@ -1979,7 +1979,11 @@ unit pexpr;
end.
{
$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
Revision 1.99 1999/05/01 13:24:31 peter

118
compiler/psystem.pas
View File

@ -81,58 +81,61 @@ var
vmtarraydef : parraydef;
vmtsymtable : psymtable;
begin
p^.insert(new(ptypesym,init('longint',s32bitdef)));
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
p^.insert(new(ptypesym,init('void',voiddef)));
p^.insert(new(ptypesym,init('char',cchardef)));
{ Internal types }
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}
p^.insert(new(ptypesym,init('qword',cu64bitdef)));
p^.insert(new(ptypesym,init('int64',cs64bitintdef)));
{$endif INT64}
{$ifdef i386}
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('char',cchardef)));
p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
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('void_pointer',voidpointerdef)));
p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
p^.insert(new(ptypesym,init('void_farpointer',voidfarpointerdef)));
p^.insert(new(ptypesym,init('openchararray',openchararraydef)));
p^.insert(new(ptypesym,init('file',cfiledef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('REAL',c64floatdef)));
p^.insert(new(ptypesym,init('s32real',s32floatdef)));
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('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}
{$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('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('LONGSTRING',clongstringdef)));
p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
@ -151,23 +154,6 @@ begin
p^.insert(new(ptypesym,init('INT64',cs64bitintdef)));
{$endif INT64}
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;
@ -176,13 +162,16 @@ procedure readconstdefs;
Load all default definitions for consts from the system unit
}
begin
s32bitdef:=porddef(globaldef('longint'));
u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
u32bitdef:=porddef(globaldef('ulong'));
cformaldef:=pformaldef(globaldef('formal'));
s32bitdef:=porddef(globaldef('longint'));
{$ifdef INT64}
cu64bitdef:=porddef(globaldef('qword'));
cs64bitintdef:=porddef(globaldef('int64'));
{$endif INT64}
cformaldef:=pformaldef(globaldef('formal'));
voiddef:=porddef(globaldef('void'));
cchardef:=porddef(globaldef('char'));
cshortstringdef:=pstringdef(globaldef('shortstring'));
clongstringdef:=pstringdef(globaldef('longstring'));
@ -190,17 +179,10 @@ begin
cwidestringdef:=pstringdef(globaldef('widestring'));
openshortstringdef:=pstringdef(globaldef('openshortstring'));
openchararraydef:=parraydef(globaldef('openchararray'));
{$ifdef i386}
c64floatdef:=pfloatdef(globaldef('s64real'));
{$endif}
{$ifdef m68k}
c64floatdef:=pfloatdef(globaldef('s32real'));
{$endif m68k}
s32floatdef:=pfloatdef(globaldef('s32real'));
s64floatdef:=pfloatdef(globaldef('s64real'));
s80floatdef:=pfloatdef(globaldef('s80real'));
s32fixeddef:=pfloatdef(globaldef('cs32fixed'));
voiddef:=porddef(globaldef('void'));
u8bitdef:=porddef(globaldef('byte'));
u16bitdef:=porddef(globaldef('word'));
s32fixeddef:=pfloatdef(globaldef('s32fixed'));
booldef:=porddef(globaldef('boolean'));
voidpointerdef:=ppointerdef(globaldef('void_pointer'));
charpointerdef:=ppointerdef(globaldef('char_pointer'));
@ -219,12 +201,12 @@ begin
{ create definitions for constants }
oldregisterdef:=registerdef;
registerdef:=false;
cformaldef:=new(pformaldef,init);
voiddef:=new(porddef,init(uvoid,0,0));
u8bitdef:=new(porddef,init(u8bit,0,255));
u16bitdef:=new(porddef,init(u16bit,0,65535));
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
cformaldef:=new(pformaldef,init);
{$ifdef INT64}
cu64bitdef:=new(porddef,init(u64bit,0,0));
cs64bitintdef:=new(porddef,init(s64bitint,0,0));
@ -241,11 +223,13 @@ begin
openchararraydef:=new(parraydef,init(0,-1,s32bitdef));
parraydef(openchararraydef)^.definition:=cchardef;
{$ifdef i386}
c64floatdef:=new(pfloatdef,init(s64real));
s32floatdef:=new(pfloatdef,init(s32real));
s64floatdef:=new(pfloatdef,init(s64real));
s80floatdef:=new(pfloatdef,init(s80real));
{$endif}
{$ifdef m68k}
c64floatdef:=new(pfloatdef,init(s32real));
s32floatdef:=new(pfloatdef,init(s32real))
s64floatdef:=new(pfloatdef,init(s32real));
if (cs_fp_emulation in aktmoduleswitches) then
s80floatdef:=new(pfloatdef,init(s32real))
else
@ -264,7 +248,11 @@ end;
end.
{
$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
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)));
s32real : curconstsegment^.concat(new(pai_single,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))));
else internalerror(18);
end;
@ -714,7 +714,11 @@ unit ptconst;
end.
{
$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
* old asm moved to oldasm/

8
compiler/ra386att.pas
View File

@ -1841,7 +1841,7 @@ Begin
AS_DQ:
Begin
Consume(AS_DQ);
BuildRealConstant(s64bit);
BuildRealConstant(s64bitcomp);
end;
AS_SINGLE:
Begin
@ -1983,7 +1983,11 @@ begin
end.
{
$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
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)));
s64real : p^.concat(new(pai_double,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))));
end;
end;
@ -1400,7 +1400,11 @@ end;
end.
{
$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
Revision 1.11 1999/05/02 22:41:57 peter

13
compiler/symdef.inc
View File

@ -1117,8 +1117,8 @@
f32bit,
s32real : savesize:=4;
s64real : savesize:=8;
s64bit : savesize:=8;
s80real : savesize:=extended_size;
s64bitcomp : savesize:=8;
else
savesize:=0;
end;
@ -1148,7 +1148,7 @@
stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+
tostr($ffff)+';');
{ found this solution in stabsread.c from GDB v4.16 }
s64bit : stabstring := strpnew('r'+
s64bitcomp : stabstring := strpnew('r'+
s32bitdef^.numberstring+';-'+tostr(savesize)+';0;');
{$ifdef i386}
{ under dos at least you must give a size of twelve instead of 10 !! }
@ -1164,8 +1164,9 @@
procedure tfloatdef.write_rtti_data;
const
{tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
translate : array[tfloattype] of byte =
(ftFixed32,ftSingle,ftDouble,ftExtended,ftComp,ftFixed16);
(ftSingle,ftDouble,ftExtended,ftComp,ftFixed16,ftFixed32);
begin
rttilist^.concat(new(pai_const,init_8bit(tkFloat)));
write_rtti_name;
@ -3459,7 +3460,11 @@ Const local_symtable_index : longint = $8001;
{
$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
Revision 1.108 1999/04/28 22:30:52 pierre

8
compiler/symdefh.inc
View File

@ -316,7 +316,7 @@
{ moment. }
{ s64 bit is considered as a real because all }
{ calculations are done by the fpu. }
tfloattype = (f32bit,s32real,s64real,s80real,s64bit,f16bit);
tfloattype = (s32real,s64real,s80real,s64bitcomp,f16bit,f32bit);
pfloatdef = ^tfloatdef;
tfloatdef = object(tdef)
@ -506,7 +506,11 @@
{
$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
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 }
voidfarpointerdef : ppointerdef;
cformaldef : pformaldef; { unique formal definition }
voiddef : porddef; { Pointer to Void (procedure) }
cchardef : porddef; { Pointer to Char }
booldef : porddef; { pointer to boolean type }
u8bitdef : porddef; { Pointer to 8-Bit unsigned }
u16bitdef : porddef; { Pointer to 16-Bit unsigned }
u32bitdef : porddef; { Pointer to 32-Bit unsigned }
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 }
cs64bitintdef : porddef; { pointer to 64 bit signed def, }
cs64bitdef : porddef; { pointer to 64 bit signed def, }
{ 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 }
s32fixeddef : pfloatdef; { pointer to type of temp. fixed }
@ -354,6 +355,13 @@ unit symtable;
normal_function_level = 2;
in_loading : boolean = false;
{$ifdef i386}
bestrealdef : ^pfloatdef = @s80floatdef;
{$endif}
{$ifdef m68k}
bestrealdef : ^pfloatdef = @s64floatdef;
{$endif}
var
macros : psymtable; { pointer for die Symboltabelle mit }
@ -3204,7 +3212,11 @@ const localsymtablestack : psymtable = nil;
end.
{
$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
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 }
if (rt=realconstn) and is_constintnode(p^.left) then
begin
t:=genrealconstnode(p^.left^.value);
t:=genrealconstnode(p^.left^.value,p^.right^.resulttype);
disposetree(p^.left);
p^.left:=t;
lt:=realconstn;
end;
if (lt=realconstn) and is_constintnode(p^.right) then
begin
t:=genrealconstnode(p^.right^.value);
t:=genrealconstnode(p^.right^.value,p^.left^.resulttype);
disposetree(p^.right);
p^.right:=t;
rt:=realconstn;
@ -214,10 +214,10 @@ implementation
if int(rv)=0 then
begin
Message(parser_e_invalid_float_operation);
t:=genrealconstnode(0);
t:=genrealconstnode(0,bestrealdef^);
end
else
t:=genrealconstnode(int(lv)/int(rv));
t:=genrealconstnode(int(lv)/int(rv),bestrealdef^);
firstpass(t);
end;
else
@ -235,18 +235,18 @@ implementation
lvd:=p^.left^.value_real;
rvd:=p^.right^.value_real;
case p^.treetype of
addn : t:=genrealconstnode(lvd+rvd);
subn : t:=genrealconstnode(lvd-rvd);
muln : t:=genrealconstnode(lvd*rvd);
caretn : t:=genrealconstnode(exp(ln(lvd)*rvd));
addn : t:=genrealconstnode(lvd+rvd,bestrealdef^);
subn : t:=genrealconstnode(lvd-rvd,bestrealdef^);
muln : t:=genrealconstnode(lvd*rvd,bestrealdef^);
caretn : t:=genrealconstnode(exp(ln(lvd)*rvd),bestrealdef^);
slashn : begin
if rvd=0 then
begin
Message(parser_e_invalid_float_operation);
t:=genrealconstnode(0);
t:=genrealconstnode(0,bestrealdef^);
end
else
t:=genrealconstnode(lvd/rvd);
t:=genrealconstnode(lvd/rvd,bestrealdef^);
end;
ltn : t:=genordinalconstnode(ord(lvd<rvd),booldef);
lten : t:=genordinalconstnode(ord(lvd<=rvd),booldef);
@ -473,12 +473,12 @@ implementation
begin
if (porddef(ld)^.typ<>s64bitint) then
begin
p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
p^.left:=gentypeconvnode(p^.left,cs64bitdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>s64bitint) then
begin
p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
p^.right:=gentypeconvnode(p^.right,cs64bitdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
@ -749,10 +749,10 @@ implementation
p^.location.loc:=LOC_REGISTER;
end
else
{ convert both to c64float }
{ convert both to bestreal }
begin
p^.right:=gentypeconvnode(p^.right,c64floatdef);
p^.left:=gentypeconvnode(p^.left,c64floatdef);
p^.right:=gentypeconvnode(p^.right,bestrealdef^);
p^.left:=gentypeconvnode(p^.left,bestrealdef^);
firstpass(p^.left);
firstpass(p^.right);
calcregisters(p,1,1,0);
@ -1004,8 +1004,8 @@ implementation
if p^.treetype=slashn then
begin
CGMessage(type_h_use_div_for_int);
p^.right:=gentypeconvnode(p^.right,c64floatdef);
p^.left:=gentypeconvnode(p^.left,c64floatdef);
p^.right:=gentypeconvnode(p^.right,bestrealdef^);
p^.left:=gentypeconvnode(p^.left,bestrealdef^);
firstpass(p^.left);
firstpass(p^.right);
{ maybe we need an integer register to save }
@ -1074,7 +1074,11 @@ implementation
end.
{
$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
* old asm moved to oldasm/

143
compiler/tccnv.pas
View File

@ -321,100 +321,93 @@ implementation
var
t : ptree;
begin
if p^.left^.treetype=ordconstn then
begin
{ convert constants direct }
{ not because of type conversion }
t:=genrealconstnode(p^.left^.value);
{ do a first pass here
because firstpass of typeconv does
not redo it for left field !! }
firstpass(t);
{ the type can be something else than s64real !!}
t:=gentypeconvnode(t,p^.resulttype);
firstpass(t);
disposetree(p);
p:=t;
exit;
end
else
begin
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
if p^.left^.treetype=ordconstn then
begin
t:=genrealconstnode(p^.left^.value,pfloatdef(p^.resulttype));
firstpass(t);
disposetree(p);
p:=t;
exit;
end;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
procedure first_int_to_fix(var p : ptree);
var
t : ptree;
begin
if p^.left^.treetype=ordconstn then
begin
{ convert constants direct }
p^.treetype:=fixconstn;
p^.value_fix:=p^.left^.value shl 16;
p^.disposetyp:=dt_nothing;
disposetree(p^.left);
p^.location.loc:=LOC_MEM;
end
else
begin
if p^.registers32<1 then
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end;
if p^.left^.treetype=ordconstn then
begin
t:=genfixconstnode(p^.left^.value shl 16,p^.resulttype);
firstpass(t);
disposetree(p);
p:=t;
exit;
end;
if p^.registers32<1 then
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end;
procedure first_real_to_fix(var p : ptree);
var
t : ptree;
begin
if p^.left^.treetype=realconstn then
begin
{ convert constants direct }
p^.treetype:=fixconstn;
p^.value_fix:=round(p^.left^.value_real*65536);
p^.disposetyp:=dt_nothing;
disposetree(p^.left);
p^.location.loc:=LOC_MEM;
end
else
begin
{ at least one fpu and int register needed }
if p^.registers32<1 then
p^.registers32:=1;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_REGISTER;
end;
if p^.left^.treetype=fixconstn then
begin
t:=genfixconstnode(round(p^.left^.value_real*65536),p^.resulttype);
firstpass(t);
disposetree(p);
p:=t;
exit;
end;
{ at least one fpu and int register needed }
if p^.registers32<1 then
p^.registers32:=1;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_REGISTER;
end;
procedure first_fix_to_real(var p : ptree);
var
t : ptree;
begin
if p^.left^.treetype=fixconstn then
begin
{ convert constants direct }
p^.treetype:=realconstn;
p^.value_real:=round(p^.left^.value_fix/65536.0);
p^.disposetyp:=dt_nothing;
disposetree(p^.left);
p^.location.loc:=LOC_MEM;
end
else
begin
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
if p^.left^.treetype=fixconstn then
begin
t:=genrealconstnode(round(p^.left^.value_fix/65536.0),p^.resulttype);
firstpass(t);
disposetree(p);
p:=t;
exit;
end;
if p^.registersfpu<1 then
p^.registersfpu:=1;
p^.location.loc:=LOC_FPU;
end;
procedure first_real_to_real(var p : ptree);
var
t : ptree;
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 }
{$ifdef i386}
if (pfloatdef(p^.resulttype)^.typ=s64bit) and
(pfloatdef(p^.left^.resulttype)^.typ<>s64bit) and
if (pfloatdef(p^.resulttype)^.typ=s64bitcomp) and
(pfloatdef(p^.left^.resulttype)^.typ<>s64bitcomp) and
not (p^.explizit) then
CGMessage(type_w_convert_real_2_comp);
{$endif}
@ -940,7 +933,11 @@ implementation
end.
{
$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
* old asm moved to oldasm/

44
compiler/tcinl.pas
View File

@ -131,7 +131,7 @@ implementation
begin
case p^.inlinenumber of
in_const_pi :
hp:=genrealconstnode(pi);
hp:=genrealconstnode(pi,bestrealdef^);
else
internalerror(89);
end;
@ -194,28 +194,28 @@ implementation
in_const_frac :
begin
if isreal then
hp:=genrealconstnode(frac(vr))
hp:=genrealconstnode(frac(vr),bestrealdef^)
else
hp:=genrealconstnode(frac(vl));
hp:=genrealconstnode(frac(vl),bestrealdef^);
end;
in_const_int :
begin
if isreal then
hp:=genrealconstnode(int(vr))
hp:=genrealconstnode(int(vr),bestrealdef^)
else
hp:=genrealconstnode(int(vl));
hp:=genrealconstnode(int(vl),bestrealdef^);
end;
in_const_abs :
begin
if isreal then
hp:=genrealconstnode(abs(vr))
hp:=genrealconstnode(abs(vr),bestrealdef^)
else
hp:=genordinalconstnode(abs(vl),p^.left^.resulttype);
end;
in_const_sqr :
begin
if isreal then
hp:=genrealconstnode(sqr(vr))
hp:=genrealconstnode(sqr(vr),bestrealdef^)
else
hp:=genordinalconstnode(sqr(vl),p^.left^.resulttype);
end;
@ -253,42 +253,42 @@ implementation
begin
if vr<0.0 then
message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(sqrt(vr))
hp:=genrealconstnode(sqrt(vr),bestrealdef^)
end
else
begin
if vl<0 then
message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(sqrt(vl));
hp:=genrealconstnode(sqrt(vl),bestrealdef^);
end;
end;
in_const_arctan :
begin
if isreal then
hp:=genrealconstnode(arctan(vr))
hp:=genrealconstnode(arctan(vr),bestrealdef^)
else
hp:=genrealconstnode(arctan(vl));
hp:=genrealconstnode(arctan(vl),bestrealdef^);
end;
in_const_cos :
begin
if isreal then
hp:=genrealconstnode(cos(vr))
hp:=genrealconstnode(cos(vr),bestrealdef^)
else
hp:=genrealconstnode(cos(vl));
hp:=genrealconstnode(cos(vl),bestrealdef^);
end;
in_const_sin :
begin
if isreal then
hp:=genrealconstnode(sin(vr))
hp:=genrealconstnode(sin(vr),bestrealdef^)
else
hp:=genrealconstnode(sin(vl));
hp:=genrealconstnode(sin(vl),bestrealdef^);
end;
in_const_exp :
begin
if isreal then
hp:=genrealconstnode(exp(vr))
hp:=genrealconstnode(exp(vr),bestrealdef^)
else
hp:=genrealconstnode(exp(vl));
hp:=genrealconstnode(exp(vl),bestrealdef^);
end;
in_const_ln :
begin
@ -296,13 +296,13 @@ implementation
begin
if vr<=0.0 then
message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(ln(vr))
hp:=genrealconstnode(ln(vr),bestrealdef^)
end
else
begin
if vl<=0 then
message(cg_w_may_wrong_math_argument);
hp:=genrealconstnode(ln(vl));
hp:=genrealconstnode(ln(vl),bestrealdef^);
end;
end;
else
@ -1104,7 +1104,11 @@ implementation
end.
{
$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
Revision 1.31 1999/05/02 21:33:57 florian

41
compiler/tcld.pas
View File

@ -287,35 +287,10 @@ implementation
end
else
begin
if (p^.right^.treetype=realconstn) then
begin
if p^.left^.resulttype^.deftype=floatdef then
begin
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;
p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
firstpass(p^.right);
if codegenerror then
exit;
end;
p^.resulttype:=voiddef;
@ -413,7 +388,7 @@ implementation
end;
floatdef :
begin
hp^.left:=gentypeconvnode(hp^.left,s80floatdef);
hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
firstpass(hp^.left);
end;
stringdef :
@ -477,7 +452,11 @@ implementation
end.
{
$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
* old asm moved to oldasm/

8
compiler/tcmat.pas
View File

@ -197,7 +197,7 @@ implementation
{$endif i386}
then
begin
t:=genrealconstnode(-p^.left^.value_real);
t:=genrealconstnode(-p^.left^.value_real,bestrealdef^);
disposetree(p);
firstpass(t);
p:=t;
@ -377,7 +377,11 @@ implementation
end.
{
$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
* 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 gentypenode(t : pdef) : 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 genmethodcallnode(v : pprocsym;st : psymtable;mp : ptree) : ptree;
@ -770,7 +770,7 @@ unit tree;
end;
function genrealconstnode(v : bestreal) : ptree;
function genrealconstnode(v : bestreal;def : pdef) : ptree;
var
p : ptree;
@ -786,22 +786,21 @@ unit tree;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=0;
{$endif SUPPORT_MMX}
{$ifdef i386}
p^.resulttype:=c64floatdef;
p^.resulttype:=def;
p^.value_real:=v;
{ default value is double }
p^.realtyp:=ait_real_64bit;
{$endif}
{$ifdef m68k}
p^.resulttype:=new(pfloatdef,init(s32real));
p^.value_real:=v;
{ default value is double }
p^.realtyp:=ait_real_32bit;
{$endif}
case pfloatdef(def)^.typ of
s32real :
p^.realtyp:=ait_real_32bit;
s64real :
p^.realtyp:=ait_real_64bit;
s80real :
p^.realtyp:=ait_real_80bit;
end;
p^.lab_real:=nil;
genrealconstnode:=p;
end;
function genstringconstnode(const s : string) : ptree;
var
@ -1717,7 +1716,11 @@ unit tree;
end.
{
$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
Revision 1.75 1999/05/01 13:25:02 peter