浏览代码

* fixed set loading
* object inheritance support for browser

peter 26 年之前
父节点
当前提交
bedd3653f2
共有 4 个文件被更改,包括 99 次插入72 次删除
  1. 19 5
      compiler/browcol.pas
  2. 5 2
      compiler/pstatmnt.pas
  3. 68 63
      compiler/tcadd.pas
  4. 7 2
      compiler/tree.pas

+ 19 - 5
compiler/browcol.pas

@@ -1170,22 +1170,32 @@ begin
 end;
 end;
 
 
 function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
 function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
-var I,Idx: sw_integer;
+function ScanObjectCollection(Parent: PObjectSymbol): PObjectSymbol;
+var I: sw_integer;
     OS,P: PObjectSymbol;
     OS,P: PObjectSymbol;
     ObjectC: PObjectSymbolCollection;
     ObjectC: PObjectSymbolCollection;
 begin
 begin
   P:=nil;
   P:=nil;
-  if ObjectTree<>nil then
+  if Parent<>nil then
+  if Parent^.Descendants<>nil then
   begin
   begin
-    ObjectC:=ObjectTree^.Descendants;
+    ObjectC:=Parent^.Descendants;
     for I:=0 to ObjectC^.Count-1 do
     for I:=0 to ObjectC^.Count-1 do
       begin
       begin
         OS:=ObjectC^.At(I);
         OS:=ObjectC^.At(I);
         if OS^.Symbol=O then
         if OS^.Symbol=O then
           begin P:=OS; Break; end;
           begin P:=OS; Break; end;
+        if OS^.Descendants<>nil then
+          begin
+            P:=ScanObjectCollection(OS);
+            if P<>nil then Break;
+          end;
       end;
       end;
   end;
   end;
-  SearchObjectForSymbol:=P;
+  ScanObjectCollection:=P;
+end;
+begin
+  SearchObjectForSymbol:=ScanObjectCollection(ObjectTree);
 end;
 end;
 
 
 
 
@@ -1222,7 +1232,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1999-04-14 18:59:52  peter
+  Revision 1.14  1999-04-15 09:01:32  peter
+    * fixed set loading
+    * object inheritance support for browser
+
+  Revision 1.13  1999/04/14 18:59:52  peter
     * fixed wrong variable names
     * fixed wrong variable names
 
 
   Revision 1.12  1999/04/10 16:15:00  peter
   Revision 1.12  1999/04/10 16:15:00  peter

+ 5 - 2
compiler/pstatmnt.pas

@@ -797,7 +797,6 @@ unit pstatmnt;
         var
         var
           p,p2 : ptree;
           p,p2 : ptree;
           ht : ttoken;
           ht : ttoken;
-          store_allow : boolean;
           again : boolean; { dummy for do_proc_call }
           again : boolean; { dummy for do_proc_call }
           destrukname : stringid;
           destrukname : stringid;
           sym : psym;
           sym : psym;
@@ -1265,7 +1264,11 @@ unit pstatmnt;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.76  1999-04-14 18:41:25  daniel
+  Revision 1.77  1999-04-15 09:01:33  peter
+    * fixed set loading
+    * object inheritance support for browser
+
+  Revision 1.76  1999/04/14 18:41:25  daniel
   * Better use of routines in pbase and symtable. 4k code removed.
   * Better use of routines in pbase and symtable. 4k code removed.
 
 
   Revision 1.75  1999/04/14 09:14:53  peter
   Revision 1.75  1999/04/14 09:14:53  peter

+ 68 - 63
compiler/tcadd.pas

@@ -473,68 +473,8 @@ implementation
            end
            end
          else
          else
 
 
-           { is one of the operands a string?,
-             chararrays are also handled as strings (after conversion) }
-           if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) or
-              (is_chararray(rd) and is_chararray(ld)) then
-            begin
-              if is_widestring(rd) or is_widestring(ld) then
-                begin
-                   if not(is_widestring(rd)) then
-                     p^.right:=gentypeconvnode(p^.right,cwidestringdef);
-                   if not(is_widestring(ld)) then
-                     p^.left:=gentypeconvnode(p^.left,cwidestringdef);
-                   p^.resulttype:=cwidestringdef;
-                   { this is only for add, the comparisaion is handled later }
-                   p^.location.loc:=LOC_REGISTER;
-                end
-              else if is_ansistring(rd) or is_ansistring(ld) then
-                begin
-                   if not(is_ansistring(rd)) then
-                     p^.right:=gentypeconvnode(p^.right,cansistringdef);
-                   if not(is_ansistring(ld)) then
-                     p^.left:=gentypeconvnode(p^.left,cansistringdef);
-                   p^.resulttype:=cansistringdef;
-                   { this is only for add, the comparisaion is handled later }
-                   p^.location.loc:=LOC_REGISTER;
-                end
-              else if is_longstring(rd) or is_longstring(ld) then
-                begin
-                   if not(is_longstring(rd)) then
-                     p^.right:=gentypeconvnode(p^.right,clongstringdef);
-                   if not(is_longstring(ld)) then
-                     p^.left:=gentypeconvnode(p^.left,clongstringdef);
-                   p^.resulttype:=clongstringdef;
-                   { this is only for add, the comparisaion is handled later }
-                   p^.location.loc:=LOC_MEM;
-                end
-              else
-                begin
-                   if not(is_shortstring(rd)) then
-                     p^.right:=gentypeconvnode(p^.right,cshortstringdef);
-                   if not(is_shortstring(ld)) then
-                     p^.left:=gentypeconvnode(p^.left,cshortstringdef);
-                   p^.resulttype:=cshortstringdef;
-                   { this is only for add, the comparisaion is handled later }
-                   p^.location.loc:=LOC_MEM;
-                end;
-              { only if there is a type cast we need to do again }
-              { the first pass                                   }
-              if p^.left^.treetype=typeconvn then
-                firstpass(p^.left);
-              if p^.right^.treetype=typeconvn then
-                firstpass(p^.right);
-              { here we call STRCONCAT or STRCMP or STRCOPY }
-              procinfo.flags:=procinfo.flags or pi_do_call;
-              if p^.location.loc=LOC_MEM then
-                calcregisters(p,0,0,0)
-              else
-                calcregisters(p,1,0,0);
-              convdone:=true;
-           end
-         else
-
-         { left side a setdef ? }
+         { left side a setdef, must be before string processing,
+           else array constructor can be seen as array of char (PFV) }
            if (ld^.deftype=setdef) or is_array_constructor(ld) then
            if (ld^.deftype=setdef) or is_array_constructor(ld) then
              begin
              begin
              { convert array constructors to sets }
              { convert array constructors to sets }
@@ -702,6 +642,67 @@ implementation
             end
             end
          else
          else
 
 
+           { is one of the operands a string?,
+             chararrays are also handled as strings (after conversion) }
+           if (rd^.deftype=stringdef) or (ld^.deftype=stringdef) or
+              (is_chararray(rd) and is_chararray(ld)) then
+            begin
+              if is_widestring(rd) or is_widestring(ld) then
+                begin
+                   if not(is_widestring(rd)) then
+                     p^.right:=gentypeconvnode(p^.right,cwidestringdef);
+                   if not(is_widestring(ld)) then
+                     p^.left:=gentypeconvnode(p^.left,cwidestringdef);
+                   p^.resulttype:=cwidestringdef;
+                   { this is only for add, the comparisaion is handled later }
+                   p^.location.loc:=LOC_REGISTER;
+                end
+              else if is_ansistring(rd) or is_ansistring(ld) then
+                begin
+                   if not(is_ansistring(rd)) then
+                     p^.right:=gentypeconvnode(p^.right,cansistringdef);
+                   if not(is_ansistring(ld)) then
+                     p^.left:=gentypeconvnode(p^.left,cansistringdef);
+                   p^.resulttype:=cansistringdef;
+                   { this is only for add, the comparisaion is handled later }
+                   p^.location.loc:=LOC_REGISTER;
+                end
+              else if is_longstring(rd) or is_longstring(ld) then
+                begin
+                   if not(is_longstring(rd)) then
+                     p^.right:=gentypeconvnode(p^.right,clongstringdef);
+                   if not(is_longstring(ld)) then
+                     p^.left:=gentypeconvnode(p^.left,clongstringdef);
+                   p^.resulttype:=clongstringdef;
+                   { this is only for add, the comparisaion is handled later }
+                   p^.location.loc:=LOC_MEM;
+                end
+              else
+                begin
+                   if not(is_shortstring(rd)) then
+                     p^.right:=gentypeconvnode(p^.right,cshortstringdef);
+                   if not(is_shortstring(ld)) then
+                     p^.left:=gentypeconvnode(p^.left,cshortstringdef);
+                   p^.resulttype:=cshortstringdef;
+                   { this is only for add, the comparisaion is handled later }
+                   p^.location.loc:=LOC_MEM;
+                end;
+              { only if there is a type cast we need to do again }
+              { the first pass                                   }
+              if p^.left^.treetype=typeconvn then
+                firstpass(p^.left);
+              if p^.right^.treetype=typeconvn then
+                firstpass(p^.right);
+              { here we call STRCONCAT or STRCMP or STRCOPY }
+              procinfo.flags:=procinfo.flags or pi_do_call;
+              if p^.location.loc=LOC_MEM then
+                calcregisters(p,0,0,0)
+              else
+                calcregisters(p,1,0,0);
+              convdone:=true;
+           end
+         else
+
          { is one a real float ? }
          { is one a real float ? }
            if (rd^.deftype=floatdef) or (ld^.deftype=floatdef) then
            if (rd^.deftype=floatdef) or (ld^.deftype=floatdef) then
             begin
             begin
@@ -1016,7 +1017,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  1999-04-08 11:34:00  peter
+  Revision 1.25  1999-04-15 09:01:34  peter
+    * fixed set loading
+    * object inheritance support for browser
+
+  Revision 1.24  1999/04/08 11:34:00  peter
     * int/int warning removed, only the hint is left
     * int/int warning removed, only the hint is left
 
 
   Revision 1.23  1999/03/02 22:52:19  peter
   Revision 1.23  1999/03/02 22:52:19  peter

+ 7 - 2
compiler/tree.pas

@@ -145,8 +145,9 @@ unit tree;
           tc_array_2_pointer,
           tc_array_2_pointer,
           tc_pointer_2_array,
           tc_pointer_2_array,
           tc_int_2_int,
           tc_int_2_int,
-          tc_bool_2_int,
           tc_int_2_bool,
           tc_int_2_bool,
+          tc_bool_2_bool,
+          tc_bool_2_int,
           tc_real_2_real,
           tc_real_2_real,
           tc_int_2_real,
           tc_int_2_real,
           tc_int_2_fix,
           tc_int_2_fix,
@@ -1713,7 +1714,11 @@ unit tree;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.71  1999-03-31 13:55:28  peter
+  Revision 1.72  1999-04-15 09:01:35  peter
+    * fixed set loading
+    * object inheritance support for browser
+
+  Revision 1.71  1999/03/31 13:55:28  peter
     * assembler inlining working for ag386bin
     * assembler inlining working for ag386bin
 
 
   Revision 1.70  1999/03/26 00:05:49  peter
   Revision 1.70  1999/03/26 00:05:49  peter