* absolute to object field supported, fixes tb0458

compiler/htypechk.pas

@@ -736,13 +736,15 @@ implementation
              typeconvn :
                begin
                  { typecast sizes must match, exceptions:
+                   - implicit typecast made by absolute
                    - from formaldef
                    - from void
                    - from open array
                    - typecast from pointer to array }
                  fromdef:=ttypeconvnode(hp).left.resulttype.def;
                  todef:=hp.resulttype.def;
-                 if not((fromdef.deftype=formaldef) or
+                 if not((nf_absolute in ttypeconvnode(hp).flags) or
+                        (fromdef.deftype=formaldef) or
                         is_void(fromdef) or
                         is_open_array(fromdef) or
                         ((fromdef.deftype=pointerdef) and (todef.deftype=arraydef)) or
@@ -941,7 +943,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2003-10-21 18:16:13  peter
+  Revision 1.72  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.71  2003/10/21 18:16:13  peter
     * IncompatibleTypes() added that will include unit names when
       the typenames are the same
 

compiler/ncgld.pas

@@ -80,16 +80,20 @@ implementation
             absolutesym :
                begin
                   { this is only for toasm and toaddr }
-                  if (tabsolutesym(symtableentry).abstyp=toaddr) then
-                   begin
+                  case tabsolutesym(symtableentry).abstyp of
+                    toaddr :
+                      begin
 {$ifdef i386}
-                     if tabsolutesym(symtableentry).absseg then
-                      location.reference.segment:=NR_FS;
+                        if tabsolutesym(symtableentry).absseg then
+                          location.reference.segment:=NR_FS;
 {$endif i386}
-                     location.reference.offset:=tabsolutesym(symtableentry).fieldoffset;
-                   end
-                  else
-                   location.reference.symbol:=objectlibrary.newasmsymboldata(tabsolutesym(symtableentry).mangledname);
+                        location.reference.offset:=tabsolutesym(symtableentry).fieldoffset;
+                      end;
+                    toasm :
+                      location.reference.symbol:=objectlibrary.newasmsymboldata(tabsolutesym(symtableentry).mangledname);
+                    else
+                      internalerror(200310283);
+                  end;
                end;
             constsym:
               begin
@@ -888,7 +892,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.96  2003-10-17 14:38:32  peter
+  Revision 1.97  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.96  2003/10/17 14:38:32  peter
     * 64k registers supported
     * fixed some memory leaks
 

compiler/ncnv.pas

@@ -1079,6 +1079,13 @@ implementation
         if codegenerror then
          exit;
 
+        { When absolute force tc_equal }
+        if (nf_absolute in flags) then
+          begin
+            convtype:=tc_equal;
+            exit;
+          end;
+
         eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,
                              nf_explicit in flags,true,convtype,aprocdef);
         case eq of
@@ -1826,7 +1833,8 @@ implementation
 {$endif}
         expectloc:=left.expectloc;
 
-        if nf_explicit in flags then
+        if (nf_explicit in flags) or
+           (nf_absolute in flags) then
          begin
            { check if the result could be in a register }
            if not(tstoreddef(resulttype.def).is_intregable) and
@@ -2111,7 +2119,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.126  2003-10-23 14:44:07  peter
+  Revision 1.127  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.126  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation
 

compiler/nflw.pas

@@ -219,7 +219,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtable,paramgr,defutil,htypechk,pass_1,
+      symconst,paramgr,defcmp,defutil,htypechk,pass_1,
       ncal,nadd,ncon,nmem,nld,ncnv,nbas,cgobj,
     {$ifdef state_tracking}
       nstate,
@@ -732,7 +732,9 @@ implementation
          hp:=t2;
          while (hp.nodetype=subscriptn) or
                ((hp.nodetype=vecn) and
-                is_constintnode(tvecnode(hp).right)) do
+                is_constintnode(tvecnode(hp).right)) or
+               ((hp.nodetype=typeconvn) and
+                (ttypeconvnode(hp).convtype=tc_equal))  do
            hp:=tunarynode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
            in the same level as the para of the current proc }
@@ -1467,7 +1469,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.85  2003-10-23 14:44:07  peter
+  Revision 1.86  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.85  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation
 

compiler/nld.pas

@@ -368,89 +368,68 @@ implementation
     function tloadnode.det_resulttype:tnode;
       begin
          result:=nil;
-         { handle first absolute as it will replace the symtableentry }
-         if symtableentry.typ=absolutesym then
-           begin
-             { force the resulttype to the type of the absolute }
-             resulttype:=tabsolutesym(symtableentry).vartype;
-             { replace the symtableentry when it points to a var, else
-               we are finished }
-             if (tabsolutesym(symtableentry).abstyp=tovar) then
-              begin
-                symtableentry:=tabsolutesym(symtableentry).ref;
-                symtable:=symtableentry.owner;
-                include(flags,nf_absolute);
-              end
-             else
-              exit;
-           end;
          case symtableentry.typ of
-            constsym:
-              begin
-                 if tconstsym(symtableentry).consttyp=constresourcestring then
-                   resulttype:=cansistringtype
-                 else
-                   internalerror(22799);
-              end;
-            varsym :
-              begin
-                inc(tvarsym(symtableentry).refs);
-                { Nested variable? The we need to load the framepointer of
-                  the parent procedure }
-                if (symtable.symtabletype in [localsymtable,parasymtable]) and
-                   (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
-                  begin
-                    if assigned(left) then
-                      internalerror(200309289);
-                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
-                  end;
-                { if it's refered by absolute then it's used }
-                if nf_absolute in flags then
-                  tvarsym(symtableentry).varstate:=vs_used
-                else
-                  begin
-                    { fix self type which is declared as voidpointer in the
-                      definition }
-                    if vo_is_self in tvarsym(symtableentry).varoptions then
-                      begin
-                        resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
-                        if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
-                           (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
-                          resulttype.setdef(tclassrefdef.create(resulttype))
-                        else if is_object(resulttype.def) and
-                                (nf_load_self_pointer in flags) then
-                          resulttype.setdef(tpointerdef.create(resulttype));
-                      end
-                    else if vo_is_vmt in tvarsym(symtableentry).varoptions then
-                      begin
-                        resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
-                        resulttype.setdef(tclassrefdef.create(resulttype));
-                      end
-                    else
-                      resulttype:=tvarsym(symtableentry).vartype;
-                  end;
-              end;
-            typedconstsym :
-                if not(nf_absolute in flags) then
-                  resulttype:=ttypedconstsym(symtableentry).typedconsttype;
-            procsym :
-                begin
-                   if not assigned(procdef) then
-                    begin
-                      if Tprocsym(symtableentry).procdef_count>1 then
-                       CGMessage(parser_e_no_overloaded_procvars);
-                      procdef:=tprocsym(symtableentry).first_procdef;
-                    end;
-
-                   { the result is a procdef, addrn and proc_to_procvar
-                     typeconvn need this as resulttype so they know
-                     that the address needs to be returned }
-                   resulttype.setdef(procdef);
-
-                   { process methodpointer }
+           absolutesym :
+             resulttype:=tabsolutesym(symtableentry).vartype;
+           constsym:
+             begin
+               if tconstsym(symtableentry).consttyp=constresourcestring then
+                 resulttype:=cansistringtype
+               else
+                 internalerror(22799);
+             end;
+           varsym :
+             begin
+               inc(tvarsym(symtableentry).refs);
+               { Nested variable? The we need to load the framepointer of
+                 the parent procedure }
+               if (symtable.symtabletype in [localsymtable,parasymtable]) and
+                  (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
+                 begin
                    if assigned(left) then
-                     resulttypepass(left);
+                     internalerror(200309289);
+                   left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
+                 end;
+               { fix self type which is declared as voidpointer in the
+                 definition }
+               if vo_is_self in tvarsym(symtableentry).varoptions then
+                 begin
+                   resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                   if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
+                      (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
+                     resulttype.setdef(tclassrefdef.create(resulttype))
+                   else if is_object(resulttype.def) and
+                           (nf_load_self_pointer in flags) then
+                     resulttype.setdef(tpointerdef.create(resulttype));
+                 end
+               else if vo_is_vmt in tvarsym(symtableentry).varoptions then
+                 begin
+                   resulttype.setdef(tprocdef(symtableentry.owner.defowner)._class);
+                   resulttype.setdef(tclassrefdef.create(resulttype));
+                 end
+               else
+                 resulttype:=tvarsym(symtableentry).vartype;
+             end;
+           typedconstsym :
+             resulttype:=ttypedconstsym(symtableentry).typedconsttype;
+           procsym :
+             begin
+               if not assigned(procdef) then
+                begin
+                  if Tprocsym(symtableentry).procdef_count>1 then
+                   CGMessage(parser_e_no_overloaded_procvars);
+                  procdef:=tprocsym(symtableentry).first_procdef;
                 end;
+
+               { the result is a procdef, addrn and proc_to_procvar
+                 typeconvn need this as resulttype so they know
+                 that the address needs to be returned }
+               resulttype.setdef(procdef);
+
+               { process methodpointer }
+               if assigned(left) then
+                 resulttypepass(left);
+             end;
            else
              internalerror(200104141);
          end;
@@ -1272,7 +1251,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.115  2003-10-23 14:44:07  peter
+  Revision 1.116  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.115  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation
 

compiler/pdecsub.pas

@@ -217,6 +217,7 @@ implementation
       var
         storepos : tfileposinfo;
         vs       : tvarsym;
+        sl       : tsymlist;
       begin
         if not is_void(pd.rettype.def) then
          begin
@@ -246,14 +247,18 @@ implementation
              as the name is lowercase and unreachable from the code }
            if pd.resultname='' then
             pd.resultname:=pd.procsym.name;
-           vs:=tabsolutesym.create_ref(pd.resultname,pd.rettype,tstoredsym(pd.funcretsym));
+           sl:=tsymlist.create;
+           sl.addsym(sl_load,pd.funcretsym);
+           vs:=tabsolutesym.create_ref(pd.resultname,pd.rettype,sl);
            include(vs.varoptions,vo_is_funcret);
            pd.localst.insert(vs);
 
            { insert result also if support is on }
            if (m_result in aktmodeswitches) then
             begin
-              vs:=tabsolutesym.create_ref('RESULT',pd.rettype,tstoredsym(pd.funcretsym));
+              sl:=tsymlist.create;
+              sl.addsym(sl_load,pd.funcretsym);
+              vs:=tabsolutesym.create_ref('RESULT',pd.rettype,sl);
               include(vs.varoptions,vo_is_funcret);
               include(vs.varoptions,vo_is_result);
               pd.localst.insert(vs);
@@ -2127,7 +2132,10 @@ const
 end.
 {
   $Log$
-  Revision 1.148  2003-10-07 21:14:33  peter
+  Revision 1.149  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.148  2003/10/07 21:14:33  peter
     * compare_paras() has a parameter to ignore hidden parameters
     * cross unit overload searching ignores hidden parameters when
       comparing parameter lists. Now function(string):string is

compiler/pdecvar.pas

@@ -43,7 +43,7 @@ implementation
        fmodule,
        { pass 1 }
        node,
-       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
+       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
        { codegen }
        ncgutil,
        { parser }
@@ -130,7 +130,7 @@ implementation
          maxsize, startvarrecsize : longint;
          usedalign,
          minalignment,maxalignment,startvarrecalign : byte;
-         pt : tnode;
+         hp,pt : tnode;
          vs,vs2    : tvarsym;
          srsym : tsym;
          oldsymtablestack,
@@ -241,29 +241,6 @@ implementation
                    symtablestack.replace(vs,abssym);
                    vs.free;
                  end
-                { variable }
-                else if (pt.nodetype=loadn) then
-                 begin
-                   { we should check the result type of srsym }
-                   if not (tloadnode(pt).symtableentry.typ in [varsym,typedconstsym]) then
-                     Message(parser_e_absolute_only_to_var_or_const);
-                   abssym:=tabsolutesym.create(vs.realname,tt);
-                   abssym.fileinfo:=vs.fileinfo;
-                   abssym.abstyp:=tovar;
-                   abssym.ref:=tstoredsym(tloadnode(pt).symtableentry);
-                   symtablestack.replace(vs,abssym);
-                   vs.free;
-                   { the variable cannot be put into a register
-                     if the size definition is not the same.
-                   }
-                   if tloadnode(pt).symtableentry.typ = varsym then
-                     begin
-                       if abssym.vartype.def <>
-                          tvarsym(tloadnode(pt).symtableentry).vartype.def then
-                          tvarsym(tloadnode(pt).symtableentry).varoptions:=
-                          tvarsym(tloadnode(pt).symtableentry).varoptions-[vo_regable,vo_fpuregable]
-                     end;
-                 end
                 { address }
                 else if is_constintnode(pt) and
                         ((target_info.system in [system_i386_go32v2,system_i386_watcom,
@@ -292,8 +269,28 @@ implementation
                    symtablestack.replace(vs,abssym);
                    vs.free;
                  end
+                { variable }
                 else
-                 Message(parser_e_absolute_only_to_var_or_const);
+                  begin
+                    { remove subscriptn before checking for loadn }
+                    hp:=pt;
+                    while (hp.nodetype in [subscriptn,typeconvn,vecn]) do
+                      hp:=tsubscriptnode(hp).left;
+                    if (hp.nodetype=loadn) then
+                     begin
+                       { we should check the result type of loadn }
+                       if not (tloadnode(hp).symtableentry.typ in [varsym,typedconstsym]) then
+                         Message(parser_e_absolute_only_to_var_or_const);
+                       abssym:=tabsolutesym.create(vs.realname,tt);
+                       abssym.fileinfo:=vs.fileinfo;
+                       abssym.abstyp:=tovar;
+                       abssym.ref:=node_to_symlist(pt);
+                       symtablestack.replace(vs,abssym);
+                       vs.free;
+                     end
+                    else
+                     Message(parser_e_absolute_only_to_var_or_const);
+                  end;
                 if assigned(abssym) then
                  begin
                    { try to consume the hint directives with absolute symbols }
@@ -649,7 +646,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2003-10-05 12:55:37  peter
+  Revision 1.57  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.56  2003/10/05 12:55:37  peter
     * allow absolute with value for win32,wdos
 
   Revision 1.55  2003/10/03 14:45:09  peter

compiler/pexpr.pas

@@ -27,7 +27,7 @@ unit pexpr;
 interface
 
     uses
-      symtype,symdef,
+      symtype,symdef,symbase,
       node,
       globals,
       cpuinfo;
@@ -43,6 +43,10 @@ interface
 
     procedure string_dec(var t: ttype);
 
+    procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
+
+    function node_to_symlist(p1:tnode):tsymlist;
+
     function parse_paras(__colon,in_prop_paras : boolean) : tnode;
 
     { the ID token has to be consumed before calling this function }
@@ -68,7 +72,7 @@ implementation
        globtype,tokens,verbose,
        systems,widestr,
        { symtable }
-       symconst,symbase,symsym,symtable,defutil,defcmp,
+       symconst,symtable,symsym,defutil,defcmp,
        { pass 1 }
        pass_1,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@@ -147,6 +151,92 @@ implementation
 
 
 
+    procedure symlist_to_node(var p1:tnode;st:tsymtable;pl:tsymlist);
+      var
+        plist : psymlistitem;
+      begin
+        plist:=pl.firstsym;
+        while assigned(plist) do
+         begin
+           case plist^.sltype of
+             sl_load :
+               begin
+                 if not assigned(st) then
+                   st:=plist^.sym.owner;
+                 { p1 can already contain the loadnode of
+                   the class variable. When there is no tree yet we
+                   may need to load it for with or objects }
+                 if not assigned(p1) then
+                  begin
+                    case st.symtabletype of
+                      withsymtable :
+                        p1:=tnode(twithsymtable(st).withrefnode).getcopy;
+                      objectsymtable :
+                        p1:=load_self_node;
+                    end;
+                  end;
+                 if assigned(p1) then
+                  p1:=csubscriptnode.create(plist^.sym,p1)
+                 else
+                  p1:=cloadnode.create(plist^.sym,st);
+               end;
+             sl_subscript :
+               p1:=csubscriptnode.create(plist^.sym,p1);
+             sl_typeconv :
+               p1:=ctypeconvnode.create_explicit(p1,plist^.tt);
+             sl_vec :
+               p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32bittype,true));
+             else
+               internalerror(200110205);
+           end;
+           plist:=plist^.next;
+         end;
+      end;
+
+
+    function node_to_symlist(p1:tnode):tsymlist;
+      var
+        sl : tsymlist;
+
+        procedure addnode(p:tnode);
+        begin
+          case p.nodetype of
+            subscriptn :
+              begin
+                addnode(tsubscriptnode(p).left);
+                sl.addsym(sl_subscript,tsubscriptnode(p).vs);
+              end;
+            typeconvn :
+              begin
+                addnode(ttypeconvnode(p).left);
+                sl.addtype(sl_typeconv,ttypeconvnode(p).totype);
+              end;
+            vecn :
+              begin
+                addnode(tsubscriptnode(p).left);
+                if tvecnode(p).right.nodetype=ordconstn then
+                  sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value)
+                else
+                  begin
+                    Message(cg_e_illegal_expression);
+                    { recovery }
+                    sl.addconst(sl_vec,0);
+                  end;
+             end;
+            loadn :
+              sl.addsym(sl_load,tloadnode(p).symtableentry);
+            else
+              internalerror(200310282);
+          end;
+        end;
+
+      begin
+        sl:=tsymlist.create;
+        addnode(p1);
+        result:=sl;
+      end;
+
+
     function parse_paras(__colon,in_prop_paras : boolean) : tnode;
 
       var
@@ -806,46 +896,6 @@ implementation
 
     { the following procedure handles the access to a property symbol }
     procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode);
-
-        procedure symlist_to_node(var p1:tnode;pl:tsymlist);
-        var
-          plist : psymlistitem;
-        begin
-          plist:=pl.firstsym;
-          while assigned(plist) do
-           begin
-             case plist^.sltype of
-               sl_load :
-                 begin
-                   { p1 can already contain the loadnode of
-                     the class variable. When there is no tree yet we
-                     may need to load it for with or objects }
-                   if not assigned(p1) then
-                    begin
-                      case st.symtabletype of
-                        withsymtable :
-                          p1:=tnode(twithsymtable(st).withrefnode).getcopy;
-                        objectsymtable :
-                          p1:=load_self_node;
-                      end;
-                    end;
-                   if assigned(p1) then
-                    p1:=csubscriptnode.create(plist^.sym,p1)
-                   else
-                    p1:=cloadnode.create(plist^.sym,st);
-                 end;
-               sl_subscript :
-                 p1:=csubscriptnode.create(plist^.sym,p1);
-               sl_vec :
-                 p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32bittype,true));
-               else
-                 internalerror(200110205);
-             end;
-             plist:=plist^.next;
-           end;
-          include(p1.flags,nf_isproperty);
-        end;
-
       var
          paras : tnode;
          p2    : tnode;
@@ -900,7 +950,8 @@ implementation
                      varsym :
                        begin
                          { generate access code }
-                         symlist_to_node(p1,tpropertysym(sym).writeaccess);
+                         symlist_to_node(p1,st,tpropertysym(sym).writeaccess);
+                         include(p1.flags,nf_isproperty);
                          consume(_ASSIGNMENT);
                          { read the expression }
                          p2:=comp_expr(true);
@@ -928,7 +979,8 @@ implementation
                      varsym :
                        begin
                           { generate access code }
-                          symlist_to_node(p1,tpropertysym(sym).readaccess);
+                          symlist_to_node(p1,st,tpropertysym(sym).readaccess);
+                          include(p1.flags,nf_isproperty);
                        end;
                      procsym :
                        begin
@@ -1162,7 +1214,15 @@ implementation
               case srsym.typ of
                 absolutesym :
                   begin
-                    p1:=cloadnode.create(srsym,srsymtable);
+                    if (tabsolutesym(srsym).abstyp=tovar) then
+                      begin
+                        p1:=nil;
+                        symlist_to_node(p1,nil,tabsolutesym(srsym).ref);
+                        p1:=ctypeconvnode.create(p1,tabsolutesym(srsym).vartype);
+                        include(p1.flags,nf_absolute);
+                      end
+                    else
+                      p1:=cloadnode.create(srsym,srsymtable);
                   end;
 
                 varsym :
@@ -2412,7 +2472,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.135  2003-10-09 15:20:56  peter
+  Revision 1.136  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.135  2003/10/09 15:20:56  peter
     * self is not a token anymore. It is handled special when found
       in a code block and when parsing an method
 

compiler/rautils.pas

@@ -795,6 +795,7 @@ var
   srsymtable : tsymtable;
   harrdef : tarraydef;
   l : longint;
+  plist : psymlistitem;
 Begin
   SetupVar:=false;
   asmsearchsym(s,sym,srsymtable);
@@ -803,7 +804,15 @@ Begin
   if sym.typ=absolutesym then
     begin
       if (tabsolutesym(sym).abstyp=tovar) then
-        sym:=tabsolutesym(sym).ref
+        begin
+          { Only support simple loads }
+          plist:=tabsolutesym(sym).ref.firstsym;
+          if assigned(plist) and
+             (plist^.sltype=sl_load) then
+            sym:=plist^.sym
+          else
+            Message(asmr_e_unsupported_symbol_type);
+        end
       else
         Message(asmr_e_unsupported_symbol_type);
     end;
@@ -1543,7 +1552,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.72  2003-10-24 17:39:03  peter
+  Revision 1.73  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.72  2003/10/24 17:39:03  peter
     * more intel parser updates
 
   Revision 1.71  2003/10/23 17:19:11  peter

compiler/symconst.pas

@@ -140,7 +140,8 @@ type
     sl_load,
     sl_call,
     sl_subscript,
-    sl_vec
+    sl_vec,
+    sl_typeconv
   );
 
   { base types for orddef }
@@ -376,7 +377,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2003-10-08 19:19:45  peter
+  Revision 1.69  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.68  2003/10/08 19:19:45  peter
     * set_varstate cleanup
 
   Revision 1.67  2003/10/07 15:17:07  peter

compiler/symppu.pas

@@ -173,6 +173,7 @@ implementation
     function tcompilerppufile.getsymlist:tsymlist;
       var
         symderef : tderef;
+        tt  : ttype;
         slt : tsltype;
         idx : longint;
         p   : tsymlist;
@@ -191,6 +192,11 @@ implementation
                 getderef(symderef);
                 p.addsymderef(slt,symderef);
               end;
+            sl_typeconv :
+              begin
+                gettype(tt);
+                p.addtype(slt,tt);
+              end;
             sl_vec :
               begin
                 idx:=getlongint;
@@ -356,6 +362,8 @@ implementation
              sl_load,
              sl_subscript :
                putderef(hp^.symderef);
+             sl_typeconv :
+               puttype(hp^.tt);
              sl_vec :
                putlongint(hp^.value);
              else
@@ -392,7 +400,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  2003-10-23 14:44:07  peter
+  Revision 1.23  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.22  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation
 

compiler/symsym.pas

@@ -239,10 +239,10 @@ interface
        tabsolutesym = class(tvarsym)
           abstyp  : absolutetyp;
           absseg  : boolean;
-          ref     : tstoredsym;
           asmname : pstring;
+          ref     : tsymlist;
           constructor create(const n : string;const tt : ttype);
-          constructor create_ref(const n : string;const tt : ttype;sym:tstoredsym);
+          constructor create_ref(const n : string;const tt : ttype;_ref:tsymlist);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure buildderef;override;
           procedure deref;override;
@@ -1486,11 +1486,11 @@ implementation
       end;
 
 
-    constructor tabsolutesym.create_ref(const n : string;const tt : ttype;sym:tstoredsym);
+    constructor tabsolutesym.create_ref(const n : string;const tt : ttype;_ref:tsymlist);
       begin
         inherited create(n,vs_value,tt);
         typ:=absolutesym;
-        ref:=sym;
+        ref:=_ref;
       end;
 
 
@@ -1507,7 +1507,7 @@ implementation
          absseg:=false;
          case abstyp of
            tovar :
-             asmname:=stringdup(ppufile.getstring);
+             ref:=ppufile.getsymlist;
            toasm :
              asmname:=stringdup(ppufile.getstring);
            toaddr :
@@ -1534,7 +1534,7 @@ implementation
          ppufile.putbyte(byte(abstyp));
          case abstyp of
            tovar :
-             ppufile.putstring(ref.name);
+             ppufile.putsymlist(ref);
            toasm :
              ppufile.putstring(asmname^);
            toaddr :
@@ -1551,6 +1551,8 @@ implementation
       begin
         { inheritance of varsym.deref ! }
         vartype.buildderef;
+        if (abstyp=tovar) then
+          ref.buildderef;
       end;
 
 
@@ -1562,32 +1564,14 @@ implementation
          { inheritance of varsym.deref ! }
          vartype.resolve;
          { own absolute deref }
-         if (abstyp=tovar) and (asmname<>nil) then
-           begin
-              { search previous loaded symtables }
-              searchsym(asmname^,srsym,srsymtable);
-              if not assigned(srsym) then
-               srsym:=searchsymonlyin(owner,asmname^);
-              if not assigned(srsym) then
-               srsym:=generrorsym;
-              ref:=tstoredsym(srsym);
-              stringdispose(asmname);
-           end;
+         if (abstyp=tovar) then
+           ref.resolve;
       end;
 
 
     function tabsolutesym.mangledname : string;
       begin
          case abstyp of
-           tovar :
-             begin
-               case ref.typ of
-                 varsym :
-                   mangledname:=tvarsym(ref).mangledname;
-                 else
-                   internalerror(200111011);
-               end;
-             end;
            toasm :
              mangledname:=asmname^;
            toaddr :
@@ -2689,7 +2673,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.130  2003-10-22 20:40:00  peter
+  Revision 1.131  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.130  2003/10/22 20:40:00  peter
     * write derefdata in a separate ppu entry
 
   Revision 1.129  2003/10/22 15:22:33  peter

compiler/symtype.pas

@@ -136,10 +136,11 @@ interface
       psymlistitem = ^tsymlistitem;
       tsymlistitem = record
         sltype : tsltype;
-        sym    : tsym;
-        symderef : tderef;
-        value  : longint;
         next   : psymlistitem;
+        case byte of
+          0 : (sym : tsym; symderef : tderef);
+          1 : (value  : longint);
+          2 : (tt : ttype);
       end;
 
       tsymlist = class
@@ -153,6 +154,7 @@ interface
         procedure addsym(slt:tsltype;p:tsym);
         procedure addsymderef(slt:tsltype;const d:tderef);
         procedure addconst(slt:tsltype;v:longint);
+        procedure addtype(slt:tsltype;const tt:ttype);
         procedure clear;
         function  getcopy:tsymlist;
         procedure resolve;
@@ -425,11 +427,10 @@ implementation
         if not assigned(p) then
          internalerror(200110203);
         new(hp);
+        fillchar(hp^,sizeof(tsymlistitem),0);
         hp^.sltype:=slt;
         hp^.sym:=p;
         hp^.symderef.reset;
-        hp^.value:=0;
-        hp^.next:=nil;
         if assigned(lastsym) then
          lastsym^.next:=hp
         else
@@ -443,11 +444,9 @@ implementation
         hp : psymlistitem;
       begin
         new(hp);
+        fillchar(hp^,sizeof(tsymlistitem),0);
         hp^.sltype:=slt;
-        hp^.sym:=nil;
         hp^.symderef:=d;
-        hp^.value:=0;
-        hp^.next:=nil;
         if assigned(lastsym) then
          lastsym^.next:=hp
         else
@@ -461,11 +460,25 @@ implementation
         hp : psymlistitem;
       begin
         new(hp);
+        fillchar(hp^,sizeof(tsymlistitem),0);
         hp^.sltype:=slt;
-        hp^.sym:=nil;
-        hp^.symderef.reset;
         hp^.value:=v;
-        hp^.next:=nil;
+        if assigned(lastsym) then
+         lastsym^.next:=hp
+        else
+         firstsym:=hp;
+        lastsym:=hp;
+      end;
+
+
+    procedure tsymlist.addtype(slt:tsltype;const tt:ttype);
+      var
+        hp : psymlistitem;
+      begin
+        new(hp);
+        fillchar(hp^,sizeof(tsymlistitem),0);
+        hp^.sltype:=slt;
+        hp^.tt:=tt;
         if assigned(lastsym) then
          lastsym^.next:=hp
         else
@@ -507,7 +520,18 @@ implementation
         hp:=firstsym;
         while assigned(hp) do
          begin
-           hp^.sym:=tsym(hp^.symderef.resolve);
+           case hp^.sltype of
+             sl_call,
+             sl_load,
+             sl_subscript :
+               hp^.sym:=tsym(hp^.symderef.resolve);
+             sl_typeconv :
+               hp^.tt.resolve;
+             sl_vec :
+               ;
+             else
+              internalerror(200110205);
+           end;
            hp:=hp^.next;
          end;
       end;
@@ -526,6 +550,8 @@ implementation
              sl_load,
              sl_subscript :
                hp^.symderef.build(hp^.sym);
+             sl_typeconv :
+               hp^.tt.buildderef;
              sl_vec :
                ;
              else
@@ -915,7 +941,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.32  2003-10-23 14:44:07  peter
+  Revision 1.33  2003-10-28 15:36:01  peter
+    * absolute to object field supported, fixes tb0458
+
+  Revision 1.32  2003/10/23 14:44:07  peter
     * splitted buildderef and buildderefimpl to fix interface crc
       calculation