* generic write_float and str_float

  * fixed constant float conversions

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
 

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

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

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

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/
 

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

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/
 

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

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)))));
-{$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)))));}
+  p^.insert(new(ptypesym,init('REAL',s64floatdef)));
+{$ifdef i386}
+  p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bitcomp)))));
 {$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

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/
 

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

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

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

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

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

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(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/
 

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/
 

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

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/
 

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/
 

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^.value_real:=v;
-         { default value is double }
-         p^.realtyp:=ait_real_64bit;
-{$endif}
-{$ifdef m68k}
-         p^.resulttype:=new(pfloatdef,init(s32real));
+         p^.resulttype:=def;
          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