diff --git a/compiler/aasm.pas b/compiler/aasm.pas index 4c8e0d7a7b..232ee19d0f 100644 --- a/compiler/aasm.pas +++ b/compiler/aasm.pas @@ -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 diff --git a/compiler/ag386bin.pas b/compiler/ag386bin.pas index 76a4488215..db7930ef03 100644 --- a/compiler/ag386bin.pas +++ b/compiler/ag386bin.pas @@ -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 diff --git a/compiler/ag386int.pas b/compiler/ag386int.pas index f20a74ed43..24289e6204 100644 --- a/compiler/ag386int.pas +++ b/compiler/ag386int.pas @@ -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 diff --git a/compiler/ag386nsm.pas b/compiler/ag386nsm.pas index 88b4546756..735e4302b3 100644 --- a/compiler/ag386nsm.pas +++ b/compiler/ag386nsm.pas @@ -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 diff --git a/compiler/cg386con.pas b/compiler/cg386con.pas index b3dabde899..21b5c6e40c 100644 --- a/compiler/cg386con.pas +++ b/compiler/cg386con.pas @@ -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/ diff --git a/compiler/cg386inl.pas b/compiler/cg386inl.pas index e17acd9fbf..7daf2590a7 100644 --- a/compiler/cg386inl.pas +++ b/compiler/cg386inl.pas @@ -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 diff --git a/compiler/cg386ld.pas b/compiler/cg386ld.pas index b0664e2f66..551c0dd36c 100644 --- a/compiler/cg386ld.pas +++ b/compiler/cg386ld.pas @@ -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/ diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index be455408d2..086a65143c 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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 diff --git a/compiler/psystem.pas b/compiler/psystem.pas index e4a739352d..147dc38287 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -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 diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 87f5bbcc94..b72cf61150 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -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/ diff --git a/compiler/ra386att.pas b/compiler/ra386att.pas index a926618af3..dd02e17512 100644 --- a/compiler/ra386att.pas +++ b/compiler/ra386att.pas @@ -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 diff --git a/compiler/rautils.pas b/compiler/rautils.pas index 18562d4f69..a812992915 100644 --- a/compiler/rautils.pas +++ b/compiler/rautils.pas @@ -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 diff --git a/compiler/symdef.inc b/compiler/symdef.inc index 9d6897c27a..3a3724d12b 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -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 diff --git a/compiler/symdefh.inc b/compiler/symdefh.inc index ef62fed4aa..77baabfc67 100644 --- a/compiler/symdefh.inc +++ b/compiler/symdefh.inc @@ -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 diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 7021da7160..a4418d9df2 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -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 diff --git a/compiler/tcadd.pas b/compiler/tcadd.pas index 8527856b84..aa9a028874 100644 --- a/compiler/tcadd.pas +++ b/compiler/tcadd.pas @@ -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(lvds64bitint) 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/ diff --git a/compiler/tccnv.pas b/compiler/tccnv.pas index 66f11fb68b..54dd09e90a 100644 --- a/compiler/tccnv.pas +++ b/compiler/tccnv.pas @@ -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/ diff --git a/compiler/tcinl.pas b/compiler/tcinl.pas index 3088d0a0a3..0d052f9093 100644 --- a/compiler/tcinl.pas +++ b/compiler/tcinl.pas @@ -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 diff --git a/compiler/tcld.pas b/compiler/tcld.pas index 0b74e90d6e..d81737abaf 100644 --- a/compiler/tcld.pas +++ b/compiler/tcld.pas @@ -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/ diff --git a/compiler/tcmat.pas b/compiler/tcmat.pas index e723eccd06..6c7a10b5ee 100644 --- a/compiler/tcmat.pas +++ b/compiler/tcmat.pas @@ -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/ diff --git a/compiler/tree.pas b/compiler/tree.pas index c48e35214e..25774c69d0 100644 --- a/compiler/tree.pas +++ b/compiler/tree.pas @@ -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