* fixes for ansistrings

compiler/pdecl.pas

@@ -559,27 +559,19 @@ unit pdecl;
               consume(RECKKLAMMER);
               if p^.value>255 then
                 d:=new(pstringdef,longinit(p^.value))
-              else if p^.value<>255 then
-                d:=new(pstringdef,shortinit(p^.value))
-{$ifndef GDB}
-                 else d:=new(pstringdef,shortinit(255));
-{$else GDB}
-                 else d:=globaldef('STRING');
-{$endif GDB}
+              else
+                if p^.value<>255 then
+                  d:=new(pstringdef,shortinit(p^.value))
+              else
+                d:=cshortstringdef;
               disposetree(p);
            end
-           { should string without suffix be an ansistring also
-             in ansistring mode ?? (PM) Yes!!! (FK) }
           else
             begin
                if cs_ansistrings in aktlocalswitches then
-                 d:=new(pstringdef,ansiinit(0))
+                 d:=cansistringdef
                else
-{$ifndef GDB}
-                 d:=new(pstringdef,shortinit(255));
-{$else GDB}
-                 d:=globaldef('STRING');
-{$endif GDB}
+                 d:=cshortstringdef;
             end;
           stringtype:=d;
        end;
@@ -2094,7 +2086,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.81  1998-11-13 15:40:22  pierre
+  Revision 1.82  1998-11-16 10:18:07  peter
+    * fixes for ansistrings
+
+  Revision 1.81  1998/11/13 15:40:22  pierre
     + added -Se in Makefile cvstest target
     + lexlevel cleanup
       normal_function_level main_program_level and unit_init_level defined

compiler/psystem.pas

@@ -69,9 +69,8 @@ procedure insert_intern_types(p : psymtable);
 {
   all the types inserted into the system unit
 }
-var
-  booleandef  : pdef;
 {$ifdef GDB}
+var
   { several defs to simulate more or less C++ objects for GDB }
   vmtdef      : precdef;
   pvmtdef     : ppointerdef;
@@ -100,9 +99,9 @@ begin
   p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
   p^.insert(new(ptypesym,init('file',cfiledef)));
 {$ifdef i386}
-  p^.insert(new(ptypesym,init('REAL',new(pfloatdef,init(s64real)))));
+  p^.insert(new(ptypesym,init('REAL',c64floatdef)));
+  p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
   p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bit)))));
-  p^.insert(new(ptypesym,init('EXTENDED',new(pfloatdef,init(s80real)))));
 {$endif}
 {$ifdef m68k}
   { internal definitions }
@@ -112,40 +111,33 @@ begin
   if (cs_fp_emulation) in aktmoduleswitches then
     p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s32real)))))
   else
-    p^.insert(new(ptypesym,init('DOUBLE',new(pfloatdef,init(s64real)))));
+    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',new(pfloatdef,init(s80real)))));
+    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',new(ppointerdef,init(voiddef)))));
+  p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
   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)));
   p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
-  booleandef:=new(porddef,init(bool8bit,0,1));
-  p^.insert(new(ptypesym,init('BOOLEAN',booleandef)));
-  p^.insert(new(ptypesym,init('BYTEBOOL',booleandef)));
+  p^.insert(new(ptypesym,init('BOOLEAN',booldef)));
+  p^.insert(new(ptypesym,init('BYTEBOOL',booldef)));
   p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
   p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
-  p^.insert(new(ptypesym,init('CHAR',new(porddef,init(uchar,0,255)))));
+  p^.insert(new(ptypesym,init('CHAR',cchardef)));
   p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil)))));
-  p^.insert(new(ptypesym,init('CARDINAL',new(porddef,init(u32bit,0,$ffffffff)))));
+  p^.insert(new(ptypesym,init('CARDINAL',u32bitdef)));
   p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
   p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
   p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
-  { !!!!!
-  p^.insert(new(ptypesym,init('COMP',new(porddef,init(s64bit,0,0)))));
-  p^.insert(new(ptypesym,init('SINGLE',new(porddef,init(s32real,0,0)))));
-  p^.insert(new(ptypesym,init('EXTENDED',new(porddef,init(s80real,0,0)))));
-  p^.insert(new(ptypesym,init('FILE',new(pfiledef,init(ft_untyped,nil)))));
-  }
+{$ifdef GDB}
   { Add a type for virtual method tables in lowercase }
   { so it isn't reachable!                            }
-{$ifdef GDB}
   vmtsymtable:=new(psymtable,init(recordsymtable));
   vmtdef:=new(precdef,init(vmtsymtable));
   pvmtdef:=new(ppointerdef,init(vmtdef));
@@ -240,7 +232,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  1998-11-09 11:44:36  peter
+  Revision 1.11  1998-11-16 10:18:09  peter
+    * fixes for ansistrings
+
+  Revision 1.10  1998/11/09 11:44:36  peter
     + va_list for printf support
 
   Revision 1.9  1998/11/05 12:02:54  peter

compiler/tccal.pas

@@ -248,32 +248,43 @@ implementation
          regi : tregister;
          store_valid, old_count_ref : boolean;
 
-      { types.is_equal can't handle a formaldef ! }
-      function is_equal(def1,def2 : pdef) : boolean;
+      { check if the resulttype from tree p is equal with def, needed
+        for stringconstn and formaldef }
+      function is_equal(p:ptree;def:pdef) : boolean;
 
         begin
            { safety check }
-           if not (assigned(def1) or assigned(def2)) then
+           if not (assigned(def) or assigned(p^.resulttype)) then
             begin
               is_equal:=false;
               exit;
             end;
            { all types can be passed to a formaldef }
-           is_equal:=(def1^.deftype=formaldef) or
-             (types.is_equal(def1,def2))
+           is_equal:=(def^.deftype=formaldef) or
+             (types.is_equal(p^.resulttype,def))
            { to support ansi/long/wide strings in a proper way }
            { string and string[10] are assumed as equal        }
            { when searching the correct overloaded procedure   }
              or
              (
-              (def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
-              (pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
+              (def^.deftype=stringdef) and (p^.resulttype^.deftype=stringdef) and
+              (pstringdef(def)^.string_typ=pstringdef(p^.resulttype)^.string_typ)
+             )
+             or
+             (
+              (p^.left^.treetype=stringconstn) and
+              (is_ansistring(p^.resulttype) and is_pchar(def))
+             )
+             or
+             (
+              (p^.left^.treetype=ordconstn) and
+              (is_char(p^.resulttype) and (is_shortstring(def) or is_ansistring(def)))
              )
            { set can also be a not yet converted array constructor }
              or
              (
-              (def1^.deftype=setdef) and (def2^.deftype=arraydef) and
-              (parraydef(def2)^.IsConstructor) and not(parraydef(def2)^.IsVariant)
+              (def^.deftype=setdef) and (p^.resulttype^.deftype=arraydef) and
+              (parraydef(p^.resulttype)^.IsConstructor) and not(parraydef(p^.resulttype)^.IsVariant)
              )
              ;
         end;
@@ -483,7 +494,7 @@ implementation
                         hp:=procs;
                         while assigned(hp) do
                           begin
-                             if is_equal(hp^.nextpara^.data,pt^.resulttype) then
+                             if is_equal(pt,hp^.nextpara^.data) then
                                begin
                                   if hp^.nextpara^.data=pt^.resulttype then
                                     begin
@@ -503,7 +514,7 @@ implementation
                         if exactmatch then
                           begin
                              { the first .... }
-                             while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do
+                             while (assigned(procs)) and not(is_equal(pt,procs^.nextpara^.data)) do
                                begin
                                   hp:=procs^.next;
                                   dispose(procs);
@@ -513,7 +524,7 @@ implementation
                              hp:=procs;
                              while (assigned(hp)) and assigned(hp^.next) do
                                begin
-                                  if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then
+                                  if not(is_equal(pt,hp^.next^.nextpara^.data)) then
                                     begin
                                        hp2:=hp^.next^.next;
                                        dispose(hp^.next);
@@ -611,7 +622,7 @@ implementation
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  if not is_equal(hp^.nextpara^.data,pt^.resulttype) then
+                                  if not is_equal(pt,hp^.nextpara^.data) then
                                     begin
                                        def_to:=hp^.nextpara^.data;
                                        if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
@@ -673,25 +684,40 @@ implementation
                              pt:=pt^.right;
                           end;
                      end;
+
+                   { reset nextpara for all procs left }
+                   hp:=procs;
+                   while assigned(hp) do
+                    begin
+                      hp^.nextpara:=hp^.firstpara;
+                      hp:=hp^.next;
+                    end;
+
                    { let's try to eliminate equal is exact is there }
-                   {if assigned(procs^.next) then
+                   if assigned(procs^.next) then
                      begin
                         pt:=p^.left;
                         while assigned(pt) do
                           begin
                              if pt^.exact_match_found then
                                begin
-                                  hp:=procs;
-                                  while (assigned(procs)) and (procs^.nextpara^.data<>pt^.resulttype) do
-                                    begin
-                                       hp:=procs^.next;
-                                       dispose(procs);
-                                       procs:=hp;
-                                    end;
+                                 while assigned(procs) and (procs^.nextpara^.data<>pt^.resulttype) do
+                                   begin
+                                      hp:=procs^.next;
+                                      dispose(procs);
+                                      procs:=hp;
+                                   end;
+                               end;
+                             { update nextpara for all procedures }
+                             hp:=procs;
+                             while assigned(hp) do
+                               begin
+                                  hp^.nextpara:=hp^.nextpara^.next;
+                                  hp:=hp^.next;
                                end;
                              pt:=pt^.right;
                           end;
-                     end; }
+                     end;
 
                    if assigned(procs^.next) then
                      begin
@@ -941,7 +967,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  1998-11-10 10:09:17  peter
+  Revision 1.12  1998-11-16 10:18:10  peter
+    * fixes for ansistrings
+
+  Revision 1.11  1998/11/10 10:09:17  peter
     * va_list -> array of const
 
   Revision 1.10  1998/11/09 11:44:41  peter