* made most constant and mem handling processor independent

compiler/cgobj.pas

@@ -128,6 +128,8 @@ unit cgobj;
           procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract;
           procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; abstract;
           procedure a_load_loc_reg(list : taasmoutput;size : tcgsize;const loc: tlocation; reg : tregister);
+          procedure a_load_loc_ref(list : taasmoutput;size : tcgsize;const loc: tlocation; const ref : treference);
+          procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);virtual; abstract;
 
 
           { basic arithmetic operations }
@@ -1264,6 +1266,43 @@ unit cgobj;
         end;
       end;
 
+    procedure tcg.a_load_loc_ref(list : taasmoutput;size : tcgsize;const loc: tlocation; const ref : treference);
+
+      var
+        tmpreg: tregister;
+
+      begin
+        case loc.loc of
+          LOC_REFERENCE,LOC_MEM:
+            begin
+{$ifdef i386}
+              case size of
+                OS_8,OS_S8:
+                  tmpreg := reg32toreg8(getregister32);
+                OS_16,OS_S16:
+                  tmpreg := reg32toreg16(get_scratch_reg(list));
+                else
+                  tmpreg := get_scratch_reg(list);
+              end;
+{$else i386}
+              tmpreg := get_scratch_reg(list);
+{$endif i386}
+              a_load_ref_reg(list,size,loc.reference,tmpreg);
+              a_load_reg_ref(list,size,tmpreg,ref);
+{$ifdef i386}
+              if not (size in [OS_32,OS_S32]) then
+                ungetregister(tmpreg)
+              else
+{$endif i386}
+              free_scratch_reg(list,tmpreg);
+            end;
+          LOC_REGISTER,LOC_CREGISTER:
+            a_load_reg_ref(list,size,loc.register,ref);
+          else
+            internalerror(200109302);
+        end;
+      end;
+
 
     procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
 
@@ -1452,7 +1491,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.2  2001-09-28 20:39:32  jonas
+  Revision 1.3  2001-09-30 16:17:17  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.2  2001/09/28 20:39:32  jonas
     * changed all flow control structures (except for exception handling
       related things) to processor independent code (in new ncgflw unit)
     + generic cgobj unit which contains lots of code generator helpers with

compiler/i386/cgcpu.pas

@@ -59,6 +59,7 @@ unit cgcpu;
         procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
         procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;reg : tregister);override;
         procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
+        procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); override;
 
         {  comparison operations }
         procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
@@ -130,8 +131,25 @@ unit cgcpu;
 
     procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
 
+      var
+        tmpreg: tregister;
+
       begin
-        runerror(211);
+        case size of
+          OS_8,OS_S8,OS_16,OS_S16:
+            begin
+              tmpreg := get_scratch_reg(list);
+              a_load_ref_reg(list,size,r,tmpreg);
+              if target_info.alignment.paraalign = 2 then
+                list.concat(taicpu.op_reg(A_PUSH,S_W,makereg16(tmpreg)))
+              else
+                list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
+            end;
+          OS_32,OS_S32:
+            list.concat(taicpu.op_ref(A_PUSH,S_L,newreference(r)));
+          else
+            internalerror(200109301);
+        end;
       end;
 
 
@@ -232,6 +250,12 @@ unit cgcpu;
       end;
 
 
+    procedure tcg386.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
+
+      begin
+        list.concat(taicpu.op_sym_ofs_reg(A_MOV,S_L,sym,ofs,reg));
+      end;
+
     procedure tcg386.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
 
       var
@@ -684,7 +708,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2001-09-29 21:32:19  jonas
+  Revision 1.3  2001-09-30 16:17:18  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.2  2001/09/29 21:32:19  jonas
     * fixed bug in a_load_reg_reg + implemented a_call
 
   Revision 1.1  2001/09/28 20:39:33  jonas

compiler/i386/cpunode.pas

@@ -29,7 +29,7 @@ unit cpunode;
   implementation
 
     uses
-       ncgbas,ncgflw,ncgcnv,
+       ncgbas,ncgflw,ncgcnv,ncgmem,ncgcon,
        n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
        n386set,n386inl,n386opt,
        { this not really a node }
@@ -38,7 +38,10 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.6  2001-09-29 21:32:47  jonas
+  Revision 1.7  2001-09-30 16:17:18  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.6  2001/09/29 21:32:47  jonas
     * almost all second pass typeconvnode helpers are now processor independent
     * fixed converting boolean to int64/qword
     * fixed register allocation bugs which could cause internalerror 10

compiler/i386/n386con.pas

@@ -27,41 +27,18 @@ unit n386con;
 interface
 
     uses
-       node,ncon;
+       node,ncon,ncgcon;
 
     type
-       ti386realconstnode = class(trealconstnode)
+       ti386realconstnode = class(tcgrealconstnode)
           function pass_1 : tnode;override;
           procedure pass_2;override;
        end;
 
-       ti386ordconstnode = class(tordconstnode)
-          procedure pass_2;override;
-       end;
-
-       ti386pointerconstnode = class(tpointerconstnode)
-          procedure pass_2;override;
-       end;
-
-       ti386stringconstnode = class(tstringconstnode)
-          procedure pass_2;override;
-       end;
-
-       ti386setconstnode = class(tsetconstnode)
-          procedure pass_2;override;
-       end;
-
-       ti386nilnode = class(tnilnode)
-          procedure pass_2;override;
-       end;
-
-
 implementation
 
     uses
-      globtype,widestr,systems,
-      verbose,globals,
-      symconst,symdef,aasm,types,
+      systems,
       temp_gen,
       cpubase,
       cga,tgcpu;
@@ -83,14 +60,6 @@ implementation
       end;
 
     procedure ti386realconstnode.pass_2;
-      const
-        floattype2ait:array[tfloattype] of tait=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit);
-
-      var
-         hp1 : tai;
-         lastlabel : tasmlabel;
-         realait : tait;
 
       begin
          if (value_real=1.0) then
@@ -106,413 +75,19 @@ implementation
               inc(fpuvaroffset);
            end
          else
-           begin
-              lastlabel:=nil;
-              realait:=floattype2ait[tfloatdef(resulttype.def).typ];
-              { const already used ? }
-              if not assigned(lab_real) then
-                begin
-                   { tries to find an old entry }
-                   hp1:=tai(Consts.first);
-                   while assigned(hp1) do
-                     begin
-                        if hp1.typ=ait_label then
-                          lastlabel:=tai_label(hp1).l
-                        else
-                          begin
-                             if (hp1.typ=realait) and (lastlabel<>nil) then
-                               begin
-                                  if(
-                                     ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real)) or
-                                     ((realait=ait_real_64bit) and (tai_real_64bit(hp1).value=value_real)) or
-                                     ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real)) or
-                                     ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real))
-                                    ) then
-                                    begin
-                                       { found! }
-                                       lab_real:=lastlabel;
-                                       break;
-                                    end;
-                               end;
-                             lastlabel:=nil;
-                          end;
-                        hp1:=tai(hp1.next);
-                     end;
-                   { :-(, we must generate a new entry }
-                   if not assigned(lab_real) then
-                     begin
-                        getdatalabel(lastlabel);
-                        lab_real:=lastlabel;
-                        if (cs_create_smart in aktmoduleswitches) then
-                         Consts.concat(Tai_cut.Create);
-                        Consts.concat(Tai_label.Create(lastlabel));
-                        case realait of
-                          ait_real_32bit :
-                            Consts.concat(Tai_real_32bit.Create(value_real));
-                          ait_real_64bit :
-                            Consts.concat(Tai_real_64bit.Create(value_real));
-                          ait_real_80bit :
-                            Consts.concat(Tai_real_80bit.Create(value_real));
-                          ait_comp_64bit :
-                            Consts.concat(Tai_comp_64bit.Create(value_real));
-                        else
-                          internalerror(10120);
-                        end;
-                     end;
-                end;
-              reset_reference(location.reference);
-              location.reference.symbol:=lab_real;
-              location.loc:=LOC_MEM;
-           end;
+           inherited pass_2;
       end;
 
 
-{*****************************************************************************
-                            TI386ORDCONSTNODE
-*****************************************************************************}
-
-    procedure ti386ordconstnode.pass_2;
-      var
-         l : tasmlabel;
-
-      begin
-         location.loc:=LOC_MEM;
-         if is_64bitint(resulttype.def) then
-           begin
-              getdatalabel(l);
-              if (cs_create_smart in aktmoduleswitches) then
-                Consts.concat(Tai_cut.Create);
-              Consts.concat(Tai_label.Create(l));
-              Consts.concat(Tai_const.Create_32bit(longint(lo(value))));
-              Consts.concat(Tai_const.Create_32bit(longint(hi(value))));
-              reset_reference(location.reference);
-              location.reference.symbol:=l;
-           end
-         else
-           begin
-              { non int64 const. behaves as a memory reference }
-              location.reference.is_immediate:=true;
-              location.reference.offset:=longint(value);
-           end;
-      end;
-
-
-{*****************************************************************************
-                          TI386POINTERCONSTNODE
-*****************************************************************************}
-
-    procedure ti386pointerconstnode.pass_2;
-      begin
-         { an integer const. behaves as a memory reference }
-         location.loc:=LOC_MEM;
-         location.reference.is_immediate:=true;
-         location.reference.offset:=longint(value);
-      end;
-
-
-{*****************************************************************************
-                          Ti386STRINGCONSTNODE
-*****************************************************************************}
-
-    procedure ti386stringconstnode.pass_2;
-      var
-         hp1 : tai;
-         l1,l2,
-         lastlabel   : tasmlabel;
-         pc       : pchar;
-         same_string : boolean;
-         l,j,
-         i,mylength  : longint;
-      begin
-         { for empty ansistrings we could return a constant 0 }
-         if is_ansistring(resulttype.def) and
-            (len=0) then
-          begin
-            location.loc:=LOC_MEM;
-            location.reference.is_immediate:=true;
-            location.reference.offset:=0;
-            exit;
-          end;
-         { const already used ? }
-         lastlabel:=nil;
-         if not assigned(lab_str) then
-           begin
-              if is_shortstring(resulttype.def) then
-                mylength:=len+2
-              else
-                mylength:=len+1;
-              { widestrings can't be reused yet }
-              if not(is_widestring(resulttype.def)) then
-                begin
-                  { tries to found an old entry }
-                  hp1:=tai(Consts.first);
-                  while assigned(hp1) do
-                    begin
-                       if hp1.typ=ait_label then
-                         lastlabel:=tai_label(hp1).l
-                       else
-                         begin
-                            { when changing that code, be careful that }
-                            { you don't use typed consts, which are    }
-                            { are also written to consts           }
-                            { currently, this is no problem, because   }
-                            { typed consts have no leading length or   }
-                            { they have no trailing zero           }
-                            if (hp1.typ=ait_string) and (lastlabel<>nil) and
-                               (tai_string(hp1).len=mylength) then
-                              begin
-                                 same_string:=true;
-                                 { if shortstring then check the length byte first and
-                                   set the start index to 1 }
-                                 if is_shortstring(resulttype.def) then
-                                  begin
-                                    if len<>ord(tai_string(hp1).str[0]) then
-                                     same_string:=false;
-                                    j:=1;
-                                  end
-                                 else
-                                  j:=0;
-                                 { don't check if the length byte was already wrong }
-                                 if same_string then
-                                  begin
-                                    for i:=0 to len do
-                                     begin
-                                       if tai_string(hp1).str[j]<>value_str[i] then
-                                        begin
-                                          same_string:=false;
-                                          break;
-                                        end;
-                                       inc(j);
-                                     end;
-                                  end;
-                                 { found ? }
-                                 if same_string then
-                                  begin
-                                    lab_str:=lastlabel;
-                                    { create a new entry for ansistrings, but reuse the data }
-                                    if (st_type in [st_ansistring,st_widestring]) then
-                                     begin
-                                       getdatalabel(l2);
-                                       Consts.concat(Tai_label.Create(l2));
-                                       Consts.concat(Tai_const_symbol.Create(lab_str));
-                                       { return the offset of the real string }
-                                       lab_str:=l2;
-                                     end;
-                                    break;
-                                  end;
-                              end;
-                            lastlabel:=nil;
-                         end;
-                       hp1:=tai(hp1.next);
-                    end;
-                end;
-              { :-(, we must generate a new entry }
-              if not assigned(lab_str) then
-                begin
-                   getdatalabel(lastlabel);
-                   lab_str:=lastlabel;
-                   if (cs_create_smart in aktmoduleswitches) then
-                    Consts.concat(Tai_cut.Create);
-                   Consts.concat(Tai_label.Create(lastlabel));
-                   { generate an ansi string ? }
-                   case st_type of
-                      st_ansistring:
-                        begin
-                           { an empty ansi string is nil! }
-                           if len=0 then
-                             Consts.concat(Tai_const.Create_32bit(0))
-                           else
-                             begin
-                                getdatalabel(l1);
-                                getdatalabel(l2);
-                                Consts.concat(Tai_label.Create(l2));
-                                Consts.concat(Tai_const_symbol.Create(l1));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(-1));
-                                Consts.concat(Tai_label.Create(l1));
-                                getmem(pc,len+2);
-                                move(value_str^,pc^,len);
-                                pc[len]:=#0;
-                                { to overcome this problem we set the length explicitly }
-                                { with the ending null char }
-                                Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
-                                { return the offset of the real string }
-                                lab_str:=l2;
-                             end;
-                        end;
-                      st_widestring:
-                        begin
-                           { an empty wide string is nil! }
-                           if len=0 then
-                             Consts.concat(Tai_const.Create_32bit(0))
-                           else
-                             begin
-                                getdatalabel(l1);
-                                getdatalabel(l2);
-                                Consts.concat(Tai_label.Create(l2));
-                                Consts.concat(Tai_const_symbol.Create(l1));
-
-                                { we use always UTF-16 coding for constants }
-                                { at least for now                          }
-                                { Consts.concat(Tai_const.Create_8bit(2)); }
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(-1));
-                                Consts.concat(Tai_label.Create(l1));
-                                for i:=0 to len-1 do
-                                  Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));
-                                { return the offset of the real string }
-                                lab_str:=l2;
-                             end;
-                        end;
-                      st_shortstring:
-                        begin
-                          { truncate strings larger than 255 chars }
-                          if len>255 then
-                           l:=255
-                          else
-                           l:=len;
-                          { also length and terminating zero }
-                          getmem(pc,l+3);
-                          move(value_str^,pc[1],l+1);
-                          pc[0]:=chr(l);
-                          { to overcome this problem we set the length explicitly }
-                          { with the ending null char }
-                          pc[l+1]:=#0;
-                          Consts.concat(Tai_string.Create_length_pchar(pc,l+2));
-                        end;
-                   end;
-                end;
-           end;
-         reset_reference(location.reference);
-         location.reference.symbol:=lab_str;
-         location.loc:=LOC_MEM;
-      end;
-
-
-{*****************************************************************************
-                           TI386SETCONSTNODE
-*****************************************************************************}
-
-    procedure ti386setconstnode.pass_2;
-      var
-         hp1     : tai;
-         lastlabel   : tasmlabel;
-         i         : longint;
-         neededtyp   : tait;
-      begin
-        { small sets are loaded as constants }
-        if tsetdef(resulttype.def).settype=smallset then
-         begin
-           location.loc:=LOC_MEM;
-           location.reference.is_immediate:=true;
-           location.reference.offset:=plongint(value_set)^;
-           exit;
-         end;
-        if tsetdef(resulttype.def).settype=smallset then
-         neededtyp:=ait_const_32bit
-        else
-         neededtyp:=ait_const_8bit;
-        lastlabel:=nil;
-        { const already used ? }
-        if not assigned(lab_set) then
-          begin
-             { tries to found an old entry }
-             hp1:=tai(Consts.first);
-             while assigned(hp1) do
-               begin
-                  if hp1.typ=ait_label then
-                    lastlabel:=tai_label(hp1).l
-                  else
-                    begin
-                      if (lastlabel<>nil) and (hp1.typ=neededtyp) then
-                        begin
-                          if (hp1.typ=ait_const_8bit) then
-                           begin
-                             { compare normal set }
-                             i:=0;
-                             while assigned(hp1) and (i<32) do
-                              begin
-                                if tai_const(hp1).value<>value_set^[i] then
-                                 break;
-                                inc(i);
-                                hp1:=tai(hp1.next);
-                              end;
-                             if i=32 then
-                              begin
-                                { found! }
-                                lab_set:=lastlabel;
-                                break;
-                              end;
-                             { leave when the end of consts is reached, so no
-                               hp1.next is done }
-                             if not assigned(hp1) then
-                              break;
-                           end
-                          else
-                           begin
-                             { compare small set }
-                             if plongint(value_set)^=tai_const(hp1).value then
-                              begin
-                                { found! }
-                                lab_set:=lastlabel;
-                                break;
-                              end;
-                           end;
-                        end;
-                      lastlabel:=nil;
-                    end;
-                  hp1:=tai(hp1.next);
-               end;
-             { :-(, we must generate a new entry }
-             if not assigned(lab_set) then
-               begin
-                 getdatalabel(lastlabel);
-                 lab_set:=lastlabel;
-                 if (cs_create_smart in aktmoduleswitches) then
-                  Consts.concat(Tai_cut.Create);
-                 Consts.concat(Tai_label.Create(lastlabel));
-                 if tsetdef(resulttype.def).settype=smallset then
-                  begin
-                    move(value_set^,i,sizeof(longint));
-                    Consts.concat(Tai_const.Create_32bit(i));
-                  end
-                 else
-                  begin
-                    for i:=0 to 31 do
-                      Consts.concat(Tai_const.Create_8bit(value_set^[i]));
-                  end;
-               end;
-          end;
-        reset_reference(location.reference);
-        location.reference.symbol:=lab_set;
-        location.loc:=LOC_MEM;
-      end;
-
-
-{*****************************************************************************
-                             TI386NILNODE
-*****************************************************************************}
-
-    procedure ti386nilnode.pass_2;
-      begin
-         location.loc:=LOC_MEM;
-         location.reference.is_immediate:=true;
-         location.reference.offset:=0;
-      end;
-
 begin
    crealconstnode:=ti386realconstnode;
-   cordconstnode:=ti386ordconstnode;
-   cpointerconstnode:=ti386pointerconstnode;
-   cstringconstnode:=ti386stringconstnode;
-   csetconstnode:=ti386setconstnode;
-   cnilnode:=ti386nilnode;
 end.
 {
   $Log$
-  Revision 1.10  2001-08-26 13:36:57  florian
+  Revision 1.11  2001-09-30 16:17:17  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.10  2001/08/26 13:36:57  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/i386/n386mem.pas

@@ -27,22 +27,14 @@ unit n386mem;
 interface
 
     uses
-      node,nmem;
+      node,nmem,ncgmem;
 
     type
-       ti386loadvmtnode = class(tloadvmtnode)
-          procedure pass_2;override;
-       end;
-
-       ti386hnewnode = class(thnewnode)
-          procedure pass_2;override;
-       end;
-
        ti386newnode = class(tnewnode)
           procedure pass_2;override;
        end;
 
-       ti386hdisposenode = class(thdisposenode)
+       ti386addrnode = class(tcgaddrnode)
           procedure pass_2;override;
        end;
 
@@ -50,19 +42,7 @@ interface
           procedure pass_2;override;
        end;
 
-       ti386addrnode = class(taddrnode)
-          procedure pass_2;override;
-       end;
-
-       ti386doubleaddrnode = class(tdoubleaddrnode)
-          procedure pass_2;override;
-       end;
-
-       ti386derefnode = class(tderefnode)
-          procedure pass_2;override;
-       end;
-
-       ti386subscriptnode = class(tsubscriptnode)
+       ti386derefnode = class(tcgderefnode)
           procedure pass_2;override;
        end;
 
@@ -70,55 +50,20 @@ interface
           procedure pass_2;override;
        end;
 
-       ti386selfnode = class(tselfnode)
-          procedure pass_2;override;
-       end;
-
-       ti386withnode = class(twithnode)
-          procedure pass_2;override;
-       end;
-
 implementation
 
     uses
 {$ifdef delphi}
       sysutils,
-{$else}
-      strings,
 {$endif}
-{$ifdef GDB}
-      gdb,
-{$endif GDB}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symbase,symtype,symdef,symsym,symtable,aasm,types,
+      symconst,symtype,symdef,symsym,symtable,aasm,types,
       cgbase,temp_gen,pass_2,
       pass_1,nld,ncon,nadd,
       cpubase,cpuasm,
       cga,tgcpu,n386util;
 
-{*****************************************************************************
-                            TI386LOADNODE
-*****************************************************************************}
-
-    procedure ti386loadvmtnode.pass_2;
-      begin
-         location.register:=getregister32;
-         emit_sym_ofs_reg(A_MOV,
-            S_L,newasmsymbol(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),0,
-            location.register);
-      end;
-
-
-{*****************************************************************************
-                            TI386HNEWNODE
-*****************************************************************************}
-
-    procedure ti386hnewnode.pass_2;
-      begin
-      end;
-
-
 {*****************************************************************************
                             TI386NEWNODE
 *****************************************************************************}
@@ -167,36 +112,18 @@ implementation
 
 
 {*****************************************************************************
-                         TI386HDISPOSENODE
+                             TI386ADDRNODE
 *****************************************************************************}
 
-    procedure ti386hdisposenode.pass_2;
+    procedure ti386addrnode.pass_2;
+
       begin
-         secondpass(left);
-         if codegenerror then
-           exit;
-         reset_reference(location.reference);
-         case left.location.loc of
-            LOC_REGISTER:
-              location.reference.index:=left.location.register;
-            LOC_CREGISTER:
-              begin
-                 location.reference.index:=getregister32;
-                 emit_reg_reg(A_MOV,S_L,
-                   left.location.register,
-                   location.reference.index);
-              end;
-            LOC_MEM,LOC_REFERENCE :
-              begin
-                 del_reference(left.location.reference);
-                 location.reference.index:=getregister32;
-                 emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
-                   location.reference.index);
-              end;
-         end;
+        inherited pass_2;
+        { for use of other segments }
+        if left.location.reference.segment<>R_NO then
+          location.segment:=left.location.reference.segment;
       end;
 
-
 {*****************************************************************************
                          TI386SIMPLENEWDISPOSENODE
 *****************************************************************************}
@@ -257,97 +184,14 @@ implementation
       end;
 
 
-{*****************************************************************************
-                             TI386ADDRNODE
-*****************************************************************************}
-
-    procedure ti386addrnode.pass_2;
-      begin
-         secondpass(left);
-
-         { when loading procvar we do nothing with this node, so load the
-           location of left }
-         if nf_procvarload in flags then
-          begin
-            set_location(location,left.location);
-            exit;
-          end;
-
-         location.loc:=LOC_REGISTER;
-         del_reference(left.location.reference);
-         location.register:=getregister32;
-         {@ on a procvar means returning an address to the procedure that
-           is stored in it.}
-         { yes but left.symtableentry can be nil
-           for example on self !! }
-         { symtableentry can be also invalid, if left is no tree node }
-         if (m_tp_procvar in aktmodeswitches) and
-           (left.nodetype=loadn) and
-           assigned(tloadnode(left).symtableentry) and
-           (tloadnode(left).symtableentry.typ=varsym) and
-           (tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
-           emit_ref_reg(A_MOV,S_L,
-             newreference(left.location.reference),
-             location.register)
-         else
-           emit_ref_reg(A_LEA,S_L,
-             newreference(left.location.reference),
-             location.register);
-         { for use of other segments }
-         if left.location.reference.segment<>R_NO then
-           location.segment:=left.location.reference.segment;
-      end;
-
-
-{*****************************************************************************
-                         TI386DOUBLEADDRNODE
-*****************************************************************************}
-
-    procedure ti386doubleaddrnode.pass_2;
-      begin
-         secondpass(left);
-         location.loc:=LOC_REGISTER;
-         del_reference(left.location.reference);
-         location.register:=getregister32;
-         emit_ref_reg(A_LEA,S_L,
-         newreference(left.location.reference),
-           location.register);
-      end;
-
-
 {*****************************************************************************
                            TI386DEREFNODE
 *****************************************************************************}
 
     procedure ti386derefnode.pass_2;
-      var
-         hr : tregister;
+
       begin
-         secondpass(left);
-         reset_reference(location.reference);
-         case left.location.loc of
-            LOC_REGISTER:
-              location.reference.base:=left.location.register;
-            LOC_CREGISTER:
-              begin
-                 { ... and reserve one for the pointer }
-                 hr:=getregister32;
-                 emit_reg_reg(A_MOV,S_L,left.location.register,hr);
-                 location.reference.base:=hr;
-              end;
-            else
-              begin
-                 { free register }
-                 del_reference(left.location.reference);
-
-                 { ...and reserve one for the pointer }
-                 hr:=getregister32;
-                 emit_ref_reg(
-                   A_MOV,S_L,newreference(left.location.reference),
-                   hr);
-                 location.reference.base:=hr;
-              end;
-         end;
+         inherited pass_2;
          if tpointerdef(left.resulttype.def).is_far then
           location.reference.segment:=R_FS;
          if not tpointerdef(left.resulttype.def).is_far and
@@ -361,57 +205,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                          TI386SUBSCRIPTNODE
-*****************************************************************************}
-
-    procedure ti386subscriptnode.pass_2;
-      var
-         hr : tregister;
-      begin
-         secondpass(left);
-         if codegenerror then
-           exit;
-         { classes and interfaces must be dereferenced implicit }
-         if is_class_or_interface(left.resulttype.def) then
-           begin
-             reset_reference(location.reference);
-             case left.location.loc of
-                LOC_REGISTER:
-                  location.reference.base:=left.location.register;
-                LOC_CREGISTER:
-                  begin
-                     { ... and reserve one for the pointer }
-                     hr:=getregister32;
-                     emit_reg_reg(A_MOV,S_L,left.location.register,hr);
-                       location.reference.base:=hr;
-                  end;
-                else
-                  begin
-                     { free register }
-                     del_reference(left.location.reference);
-
-                     { ... and reserve one for the pointer }
-                     hr:=getregister32;
-                     emit_ref_reg(
-                       A_MOV,S_L,newreference(left.location.reference),
-                       hr);
-                     location.reference.base:=hr;
-                  end;
-             end;
-           end
-         else if is_interfacecom(left.resulttype.def) then
-           begin
-              gettempintfcomreference(location.reference);
-              emit_mov_loc_ref(left.location,location.reference,S_L,false);
-           end
-         else
-           set_location(location,left.location);
-
-         inc(location.reference.offset,vs.address);
-      end;
-
-
 {*****************************************************************************
                              TI386VECNODE
 *****************************************************************************}
@@ -898,164 +691,20 @@ implementation
            end;
       end;
 
-{*****************************************************************************
-                            TI386SELFNODE
-*****************************************************************************}
-
-    procedure ti386selfnode.pass_2;
-      begin
-         reset_reference(location.reference);
-         getexplicitregister32(R_ESI);
-         if (resulttype.def.deftype=classrefdef) or
-           is_class(resulttype.def) then
-           location.register:=R_ESI
-         else
-           location.reference.base:=R_ESI;
-      end;
-
-
-{*****************************************************************************
-                            TI386WITHNODE
-*****************************************************************************}
-
-    procedure ti386withnode.pass_2;
-      var
-        usetemp,with_expr_in_temp : boolean;
-{$ifdef GDB}
-        withstartlabel,withendlabel : tasmlabel;
-        pp : pchar;
-        mangled_length  : longint;
-
-      const
-        withlevel : longint = 0;
-{$endif GDB}
-      begin
-         if assigned(left) then
-            begin
-               secondpass(left);
-               if left.location.reference.segment<>R_NO then
-                 message(parser_e_no_with_for_variable_in_other_segments);
-
-               new(withreference);
-
-               usetemp:=false;
-               if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
-                 begin
-                    { for locals use the local storage }
-                    withreference^:=left.location.reference;
-                    include(flags,nf_islocal);
-                 end
-               else
-                { call can have happend with a property }
-                if is_class_or_interface(left.resulttype.def) then
-                 begin
-                    getexplicitregister32(R_EDI);
-                    emit_mov_loc_reg(left.location,R_EDI);
-                    usetemp:=true;
-                 end
-               else
-                 begin
-                   getexplicitregister32(R_EDI);
-                   emit_lea_loc_reg(left.location,R_EDI,false);
-                   usetemp:=true;
-                 end;
-
-               release_loc(left.location);
-
-               { if the with expression is stored in a temp    }
-               { area we must make it persistent and shouldn't }
-               { release it (FK)                               }
-               if (left.location.loc in [LOC_MEM,LOC_REFERENCE]) and
-                 istemp(left.location.reference) then
-                 begin
-                    normaltemptopersistant(left.location.reference.offset);
-                    with_expr_in_temp:=true;
-                 end
-               else
-                 with_expr_in_temp:=false;
-
-               { if usetemp is set the value must be in %edi }
-               if usetemp then
-                begin
-                  gettempofsizereference(4,withreference^);
-                  normaltemptopersistant(withreference^.offset);
-                  { move to temp reference }
-                  emit_reg_ref(A_MOV,S_L,R_EDI,newreference(withreference^));
-                  ungetregister32(R_EDI);
-{$ifdef GDB}
-                  if (cs_debuginfo in aktmoduleswitches) then
-                    begin
-                      inc(withlevel);
-                      getaddrlabel(withstartlabel);
-                      getaddrlabel(withendlabel);
-                      emitlab(withstartlabel);
-                      withdebugList.concat(Tai_stabs.Create(strpnew(
-                         '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
-                         '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
-                         tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset))));
-                      mangled_length:=length(aktprocsym.definition.mangledname);
-                      getmem(pp,mangled_length+50);
-                      strpcopy(pp,'192,0,0,'+withstartlabel.name);
-                      if (target_info.use_function_relative_addresses) then
-                        begin
-                          strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
-                        end;
-                      withdebugList.concat(Tai_stabn.Create(strnew(pp)));
-                    end;
-{$endif GDB}
-                end;
-
-               { right can be optimize out !!! }
-               if assigned(right) then
-                 secondpass(right);
-
-               if usetemp then
-                 begin
-                   ungetpersistanttemp(withreference^.offset);
-{$ifdef GDB}
-                   if (cs_debuginfo in aktmoduleswitches) then
-                     begin
-                       emitlab(withendlabel);
-                       strpcopy(pp,'224,0,0,'+withendlabel.name);
-                      if (target_info.use_function_relative_addresses) then
-                        begin
-                          strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
-                        end;
-                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
-                       freemem(pp,mangled_length+50);
-                       dec(withlevel);
-                     end;
-{$endif GDB}
-                 end;
-
-               if with_expr_in_temp then
-                 ungetpersistanttemp(left.location.reference.offset);
-
-               dispose(withreference);
-               withreference:=nil;
-            end;
-       end;
 
 begin
-   cloadvmtnode:=ti386loadvmtnode;
-   chnewnode:=ti386hnewnode;
    cnewnode:=ti386newnode;
-   chdisposenode:=ti386hdisposenode;
    csimplenewdisposenode:=ti386simplenewdisposenode;
    caddrnode:=ti386addrnode;
-   cdoubleaddrnode:=ti386doubleaddrnode;
    cderefnode:=ti386derefnode;
-   csubscriptnode:=ti386subscriptnode;
    cvecnode:=ti386vecnode;
-   cselfnode:=ti386selfnode;
-   cwithnode:=ti386withnode;
 end.
 {
   $Log$
-  Revision 1.16  2001-08-30 20:13:57  peter
+  Revision 1.17  2001-09-30 16:17:17  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.16  2001/08/30 20:13:57  peter
     * rtti/init table updates
     * rttisym for reusable global rtti/init info
     * support published for interfaces

compiler/i386/tgcpu.pas

@@ -56,6 +56,7 @@ interface
     procedure testregisters32;
 {$endif TEMPREGDEBUG}
     function getregister32 : tregister;
+    function getaddressregister: tregister;
     procedure ungetregister32(r : tregister);
     { tries to allocate the passed register, if possible }
     function getexplicitregister32(r : tregister) : tregister;
@@ -64,6 +65,8 @@ interface
     procedure ungetregistermmx(r : tregister);
 {$endif SUPPORT_MMX}
 
+    function isaddressregister(reg: tregister): boolean;
+
     procedure ungetregister(r : tregister);
 
     procedure cleartempgen;
@@ -480,6 +483,12 @@ implementation
       end;
 {$endif SUPPORT_MMX}
 
+    function isaddressregister(reg: tregister): boolean;
+
+      begin
+        isaddressregister := true;
+      end;
+      
     procedure del_reference(const ref : treference);
 
       begin
@@ -589,6 +598,13 @@ implementation
 {$endif TEMPREGDEBUG}
       end;
 
+
+    function getaddressregister: tregister;
+
+      begin
+        getaddressregister := getregister32;
+      end;
+
     function getexplicitregister32(r : tregister) : tregister;
 
       begin
@@ -674,7 +690,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2001-08-26 13:37:03  florian
+  Revision 1.6  2001-09-30 16:17:18  jonas
+    * made most constant and mem handling processor independent
+
+  Revision 1.5  2001/08/26 13:37:03  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/ncgcon.pas

@@ -0,0 +1,493 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Generate assembler for constant nodes which are the same for
+    all (most) processors
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgcon;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       node,ncon;
+
+    type
+       tcgrealconstnode = class(trealconstnode)
+          procedure pass_2;override;
+       end;
+
+       tcgordconstnode = class(tordconstnode)
+          procedure pass_2;override;
+       end;
+
+       tcgpointerconstnode = class(tpointerconstnode)
+          procedure pass_2;override;
+       end;
+
+       tcgstringconstnode = class(tstringconstnode)
+          procedure pass_2;override;
+       end;
+
+       tcgsetconstnode = class(tsetconstnode)
+          procedure pass_2;override;
+       end;
+
+       tcgnilnode = class(tnilnode)
+          procedure pass_2;override;
+       end;
+
+
+implementation
+
+    uses
+      globtype,widestr,systems,
+      verbose,globals,
+      symconst,symdef,aasm,types,
+      temp_gen,
+      cpubase,
+      tgcpu;
+
+
+{*****************************************************************************
+                           TCGREALCONSTNODE
+*****************************************************************************}
+
+    procedure tcgrealconstnode.pass_2;
+      { I suppose the parser/pass_1 must make sure the generated real  }
+      { constants are actually supported by the target processor? (JM) }
+
+      const
+        floattype2ait:array[tfloattype] of tait=
+          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit);
+
+      var
+         hp1 : tai;
+         lastlabel : tasmlabel;
+         realait : tait;
+
+      begin
+        lastlabel:=nil;
+        realait:=floattype2ait[tfloatdef(resulttype.def).typ];
+        { const already used ? }
+        if not assigned(lab_real) then
+          begin
+             { tries to find an old entry }
+             hp1:=tai(Consts.first);
+             while assigned(hp1) do
+               begin
+                  if hp1.typ=ait_label then
+                    lastlabel:=tai_label(hp1).l
+                  else
+                    begin
+                       if (hp1.typ=realait) and (lastlabel<>nil) then
+                         begin
+                            if(
+                               ((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real)) or
+                               ((realait=ait_real_64bit) and (tai_real_64bit(hp1).value=value_real)) or
+                               ((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real)) or
+                               ((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real))
+                              ) then
+                              begin
+                                 { found! }
+                                 lab_real:=lastlabel;
+                                 break;
+                              end;
+                         end;
+                       lastlabel:=nil;
+                    end;
+                  hp1:=tai(hp1.next);
+               end;
+             { :-(, we must generate a new entry }
+             if not assigned(lab_real) then
+               begin
+                  getdatalabel(lastlabel);
+                  lab_real:=lastlabel;
+                  if (cs_create_smart in aktmoduleswitches) then
+                   Consts.concat(Tai_cut.Create);
+                  Consts.concat(Tai_label.Create(lastlabel));
+                  case realait of
+                    ait_real_32bit :
+                      Consts.concat(Tai_real_32bit.Create(value_real));
+                    ait_real_64bit :
+                      Consts.concat(Tai_real_64bit.Create(value_real));
+                    ait_real_80bit :
+                      Consts.concat(Tai_real_80bit.Create(value_real));
+                    ait_comp_64bit :
+                      Consts.concat(Tai_comp_64bit.Create(value_real));
+                  else
+                    internalerror(10120);
+                  end;
+               end;
+          end;
+        reset_reference(location.reference);
+        location.reference.symbol:=lab_real;
+        location.loc:=LOC_MEM;
+      end;
+
+{*****************************************************************************
+                            TCGORDCONSTNODE
+*****************************************************************************}
+
+    procedure tcgordconstnode.pass_2;
+      var
+         l : tasmlabel;
+
+      begin
+         location.loc:=LOC_MEM;
+         { still needs to be made more generic (and optimal), this is for }
+         { when Peter implements LOC_ORDCONST (JM)                        }
+         if is_64bitint(resulttype.def) then
+           begin
+              getdatalabel(l);
+              if (cs_create_smart in aktmoduleswitches) then
+                Consts.concat(Tai_cut.Create);
+              Consts.concat(Tai_label.Create(l));
+              Consts.concat(Tai_const.Create_32bit(longint(lo(value))));
+              Consts.concat(Tai_const.Create_32bit(longint(hi(value))));
+              reset_reference(location.reference);
+              location.reference.symbol:=l;
+           end
+         else
+           begin
+              { non int64 const. behaves as a memory reference }
+              location.reference.is_immediate:=true;
+              location.reference.offset:=longint(value);
+           end;
+      end;
+
+
+{*****************************************************************************
+                          TCGPOINTERCONSTNODE
+*****************************************************************************}
+
+    procedure tcgpointerconstnode.pass_2;
+      begin
+         { an integer const. behaves as a memory reference }
+         location.loc:=LOC_MEM;
+         location.reference.is_immediate:=true;
+         location.reference.offset:=longint(value);
+      end;
+
+
+{*****************************************************************************
+                          TCGSTRINGCONSTNODE
+*****************************************************************************}
+
+    procedure tcgstringconstnode.pass_2;
+      var
+         hp1 : tai;
+         l1,l2,
+         lastlabel   : tasmlabel;
+         pc       : pchar;
+         same_string : boolean;
+         l,j,
+         i,mylength  : longint;
+      begin
+         { for empty ansistrings we could return a constant 0 }
+         if is_ansistring(resulttype.def) and
+            (len=0) then
+          begin
+            location.loc:=LOC_MEM;
+            location.reference.is_immediate:=true;
+            location.reference.offset:=0;
+            exit;
+          end;
+         { const already used ? }
+         lastlabel:=nil;
+         if not assigned(lab_str) then
+           begin
+              if is_shortstring(resulttype.def) then
+                mylength:=len+2
+              else
+                mylength:=len+1;
+              { widestrings can't be reused yet }
+              if not(is_widestring(resulttype.def)) then
+                begin
+                  { tries to found an old entry }
+                  hp1:=tai(Consts.first);
+                  while assigned(hp1) do
+                    begin
+                       if hp1.typ=ait_label then
+                         lastlabel:=tai_label(hp1).l
+                       else
+                         begin
+                            { when changing that code, be careful that }
+                            { you don't use typed consts, which are    }
+                            { are also written to consts           }
+                            { currently, this is no problem, because   }
+                            { typed consts have no leading length or   }
+                            { they have no trailing zero           }
+                            if (hp1.typ=ait_string) and (lastlabel<>nil) and
+                               (tai_string(hp1).len=mylength) then
+                              begin
+                                 same_string:=true;
+                                 { if shortstring then check the length byte first and
+                                   set the start index to 1 }
+                                 if is_shortstring(resulttype.def) then
+                                  begin
+                                    if len<>ord(tai_string(hp1).str[0]) then
+                                     same_string:=false;
+                                    j:=1;
+                                  end
+                                 else
+                                  j:=0;
+                                 { don't check if the length byte was already wrong }
+                                 if same_string then
+                                  begin
+                                    for i:=0 to len do
+                                     begin
+                                       if tai_string(hp1).str[j]<>value_str[i] then
+                                        begin
+                                          same_string:=false;
+                                          break;
+                                        end;
+                                       inc(j);
+                                     end;
+                                  end;
+                                 { found ? }
+                                 if same_string then
+                                  begin
+                                    lab_str:=lastlabel;
+                                    { create a new entry for ansistrings, but reuse the data }
+                                    if (st_type in [st_ansistring,st_widestring]) then
+                                     begin
+                                       getdatalabel(l2);
+                                       Consts.concat(Tai_label.Create(l2));
+                                       Consts.concat(Tai_const_symbol.Create(lab_str));
+                                       { return the offset of the real string }
+                                       lab_str:=l2;
+                                     end;
+                                    break;
+                                  end;
+                              end;
+                            lastlabel:=nil;
+                         end;
+                       hp1:=tai(hp1.next);
+                    end;
+                end;
+              { :-(, we must generate a new entry }
+              if not assigned(lab_str) then
+                begin
+                   getdatalabel(lastlabel);
+                   lab_str:=lastlabel;
+                   if (cs_create_smart in aktmoduleswitches) then
+                    Consts.concat(Tai_cut.Create);
+                   Consts.concat(Tai_label.Create(lastlabel));
+                   { generate an ansi string ? }
+                   case st_type of
+                      st_ansistring:
+                        begin
+                           { an empty ansi string is nil! }
+                           if len=0 then
+                             Consts.concat(Tai_const.Create_32bit(0))
+                           else
+                             begin
+                                getdatalabel(l1);
+                                getdatalabel(l2);
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(-1));
+                                Consts.concat(Tai_label.Create(l1));
+                                getmem(pc,len+2);
+                                move(value_str^,pc^,len);
+                                pc[len]:=#0;
+                                { to overcome this problem we set the length explicitly }
+                                { with the ending null char }
+                                Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
+                                { return the offset of the real string }
+                                lab_str:=l2;
+                             end;
+                        end;
+                      st_widestring:
+                        begin
+                           { an empty wide string is nil! }
+                           if len=0 then
+                             Consts.concat(Tai_const.Create_32bit(0))
+                           else
+                             begin
+                                getdatalabel(l1);
+                                getdatalabel(l2);
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
+
+                                { we use always UTF-16 coding for constants }
+                                { at least for now                          }
+                                { Consts.concat(Tai_const.Create_8bit(2)); }
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(-1));
+                                Consts.concat(Tai_label.Create(l1));
+                                for i:=0 to len-1 do
+                                  Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));
+                                { return the offset of the real string }
+                                lab_str:=l2;
+                             end;
+                        end;
+                      st_shortstring:
+                        begin
+                          { truncate strings larger than 255 chars }
+                          if len>255 then
+                           l:=255
+                          else
+                           l:=len;
+                          { also length and terminating zero }
+                          getmem(pc,l+3);
+                          move(value_str^,pc[1],l+1);
+                          pc[0]:=chr(l);
+                          { to overcome this problem we set the length explicitly }
+                          { with the ending null char }
+                          pc[l+1]:=#0;
+                          Consts.concat(Tai_string.Create_length_pchar(pc,l+2));
+                        end;
+                   end;
+                end;
+           end;
+         reset_reference(location.reference);
+         location.reference.symbol:=lab_str;
+         location.loc:=LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                           TCGSETCONSTNODE
+*****************************************************************************}
+
+    procedure tcgsetconstnode.pass_2;
+      var
+         hp1     : tai;
+         lastlabel   : tasmlabel;
+         i         : longint;
+         neededtyp   : tait;
+      begin
+        { small sets are loaded as constants }
+        if tsetdef(resulttype.def).settype=smallset then
+         begin
+           location.loc:=LOC_MEM;
+           location.reference.is_immediate:=true;
+           location.reference.offset:=plongint(value_set)^;
+           exit;
+         end;
+        neededtyp:=ait_const_8bit;
+        lastlabel:=nil;
+        { const already used ? }
+        if not assigned(lab_set) then
+          begin
+             { tries to found an old entry }
+             hp1:=tai(Consts.first);
+             while assigned(hp1) do
+               begin
+                  if hp1.typ=ait_label then
+                    lastlabel:=tai_label(hp1).l
+                  else
+                    begin
+                      if (lastlabel<>nil) and (hp1.typ=neededtyp) then
+                        begin
+                          if (hp1.typ=ait_const_8bit) then
+                           begin
+                             { compare normal set }
+                             i:=0;
+                             while assigned(hp1) and (i<32) do
+                              begin
+                                if tai_const(hp1).value<>value_set^[i] then
+                                 break;
+                                inc(i);
+                                hp1:=tai(hp1.next);
+                              end;
+                             if i=32 then
+                              begin
+                                { found! }
+                                lab_set:=lastlabel;
+                                break;
+                              end;
+                             { leave when the end of consts is reached, so no
+                               hp1.next is done }
+                             if not assigned(hp1) then
+                              break;
+                           end
+                          else
+                           begin
+                             { compare small set }
+                             if plongint(value_set)^=tai_const(hp1).value then
+                              begin
+                                { found! }
+                                lab_set:=lastlabel;
+                                break;
+                              end;
+                           end;
+                        end;
+                      lastlabel:=nil;
+                    end;
+                  hp1:=tai(hp1.next);
+               end;
+             { :-(, we must generate a new entry }
+             if not assigned(lab_set) then
+               begin
+                 getdatalabel(lastlabel);
+                 lab_set:=lastlabel;
+                 if (cs_create_smart in aktmoduleswitches) then
+                  Consts.concat(Tai_cut.Create);
+                 Consts.concat(Tai_label.Create(lastlabel));
+                 if tsetdef(resulttype.def).settype=smallset then
+                  begin
+                    move(value_set^,i,sizeof(longint));
+                    Consts.concat(Tai_const.Create_32bit(i));
+                  end
+                 else
+                  begin
+                    for i:=0 to 31 do
+                      Consts.concat(Tai_const.Create_8bit(value_set^[i]));
+                  end;
+               end;
+          end;
+        reset_reference(location.reference);
+        location.reference.symbol:=lab_set;
+        location.loc:=LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                             TCGNILNODE
+*****************************************************************************}
+
+    procedure tcgnilnode.pass_2;
+      begin
+         location.loc:=LOC_MEM;
+         location.reference.is_immediate:=true;
+         location.reference.offset:=0;
+      end;
+
+begin
+   crealconstnode:=tcgrealconstnode;
+   cordconstnode:=tcgordconstnode;
+   cpointerconstnode:=tcgpointerconstnode;
+   cstringconstnode:=tcgstringconstnode;
+   csetconstnode:=tcgsetconstnode;
+   cnilnode:=tcgnilnode;
+end.
+{
+  $Log$
+  Revision 1.1  2001-09-30 16:17:17  jonas
+    * made most constant and mem handling processor independent
+
+}

compiler/ncgmem.pas

@@ -0,0 +1,451 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Generate assembler for memory related nodes which are
+    the same for all (most?) processors
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncgmem;
+
+{$i defines.inc}
+
+interface
+
+    uses
+      node,nmem;
+
+    type
+       tcgloadvmtnode = class(tloadvmtnode)
+          procedure pass_2;override;
+       end;
+
+       tcghnewnode = class(thnewnode)
+          procedure pass_2;override;
+       end;
+
+       tcghdisposenode = class(thdisposenode)
+          procedure pass_2;override;
+       end;
+
+       tcgaddrnode = class(taddrnode)
+          procedure pass_2;override;
+       end;
+
+       tcgdoubleaddrnode = class(tdoubleaddrnode)
+          procedure pass_2;override;
+       end;
+
+       tcgderefnode = class(tderefnode)
+          procedure pass_2;override;
+       end;
+
+       tcgsubscriptnode = class(tsubscriptnode)
+          procedure pass_2;override;
+       end;
+
+       tcgselfnode = class(tselfnode)
+          procedure pass_2;override;
+       end;
+
+       tcgwithnode = class(twithnode)
+          procedure pass_2;override;
+       end;
+
+implementation
+
+    uses
+{$ifdef delphi}
+      sysutils,
+{$else}
+      strings,
+{$endif}
+{$ifdef GDB}
+      gdb,
+{$endif GDB}
+      globtype,systems,
+      cutils,verbose,globals,
+      symconst,symbase,symdef,symsym,aasm,
+      cgbase,temp_gen,pass_2,
+      nld,ncon,nadd,
+      cpubase,cgobj,cgcpu,
+      cga,tgcpu;
+
+{*****************************************************************************
+                            TCGLOADNODE
+*****************************************************************************}
+
+    procedure tcgloadvmtnode.pass_2;
+
+      begin
+         location.register:=getregister32;
+         cg.a_load_sym_ofs_reg(exprasmlist,
+           newasmsymbol(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname),
+           0,location.register);
+      end;
+
+
+{*****************************************************************************
+                            TCGHNEWNODE
+*****************************************************************************}
+
+    procedure tcghnewnode.pass_2;
+      begin
+      end;
+
+
+{*****************************************************************************
+                         TCGHDISPOSENODE
+*****************************************************************************}
+
+    procedure tcghdisposenode.pass_2;
+      begin
+         secondpass(left);
+         if codegenerror then
+           exit;
+        { is this already set somewhere else? It wasn't present in the }
+        { original i386 code either (JM)                               }
+        { location.loc := LOC_REFERENCE;                               }
+         reset_reference(location.reference);
+         case left.location.loc of
+            LOC_REGISTER:
+              begin
+                if not isaddressregister(left.location.register) then
+                  begin
+                    ungetregister(left.location.register);
+                    location.reference.index := getaddressregister;
+                    cg.a_load_reg_reg(exprasmlist,OS_ADDR,left.location.register,
+                      location.reference.index);
+                  end
+                else
+                  location.reference.index := left.location.register;
+              end;
+            LOC_CREGISTER,LOC_MEM,LOC_REFERENCE:
+              begin
+                 del_location(left.location);
+                 location.reference.index:=getaddressregister;
+                 cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,
+                   location.reference.index);
+              end;
+         end;
+      end;
+
+
+{*****************************************************************************
+                             TCGADDRNODE
+*****************************************************************************}
+
+    procedure tcgaddrnode.pass_2;
+      begin
+         secondpass(left);
+
+         { when loading procvar we do nothing with this node, so load the
+           location of left }
+         if nf_procvarload in flags then
+          begin
+            set_location(location,left.location);
+            exit;
+          end;
+
+         location.loc:=LOC_REGISTER;
+         del_reference(left.location.reference);
+         location.register:=getaddressregister;
+         {@ on a procvar means returning an address to the procedure that
+           is stored in it.}
+         { yes but left.symtableentry can be nil
+           for example on self !! }
+         { symtableentry can be also invalid, if left is no tree node }
+         if (m_tp_procvar in aktmodeswitches) and
+            (left.nodetype=loadn) and
+            assigned(tloadnode(left).symtableentry) and
+            (tloadnode(left).symtableentry.typ=varsym) and
+            (tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
+           cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,
+             location.register)
+         else
+           cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
+             location.register);
+      end;
+
+
+{*****************************************************************************
+                         TCGDOUBLEADDRNODE
+*****************************************************************************}
+
+    procedure tcgdoubleaddrnode.pass_2;
+      begin
+         secondpass(left);
+         location.loc:=LOC_REGISTER;
+         del_reference(left.location.reference);
+         location.register:=getaddressregister;
+         cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
+           location.register);
+      end;
+
+
+{*****************************************************************************
+                           TCGDEREFNODE
+*****************************************************************************}
+
+    procedure tcgderefnode.pass_2;
+
+      begin
+         secondpass(left);
+         reset_reference(location.reference);
+         case left.location.loc of
+            LOC_REGISTER:
+              begin
+                if not isaddressregister(left.location.register) then
+                  begin
+                    ungetregister(left.location.register);
+                    location.reference.base := getaddressregister;
+                    cg.a_load_reg_reg(exprasmlist,OS_ADDR,left.location.register,
+                      location.reference.base);
+                  end
+                else
+                  location.reference.base := left.location.register;
+              end;
+            LOC_CREGISTER,LOC_MEM,LOC_REFERENCE:
+              begin
+                 del_location(left.location);
+                 location.reference.base:=getaddressregister;
+                 cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,
+                   location.reference.base);
+              end;
+         end;
+         { still needs generic checkpointer() support! }
+      end;
+
+
+{*****************************************************************************
+                          TCGSUBSCRIPTNODE
+*****************************************************************************}
+
+    procedure tcgsubscriptnode.pass_2;
+
+      begin
+         secondpass(left);
+         if codegenerror then
+           exit;
+         { classes and interfaces must be dereferenced implicit }
+         if is_class_or_interface(left.resulttype.def) then
+           begin
+             reset_reference(location.reference);
+             case left.location.loc of
+                LOC_REGISTER:
+                  begin
+                    if not isaddressregister(left.location.register) then
+                      begin
+                        ungetregister(left.location.register);
+                        location.reference.base := getaddressregister;
+                        cg.a_load_reg_reg(exprasmlist,OS_ADDR,
+                          left.location.register,location.reference.base);
+                      end
+                    else
+                      location.reference.base := left.location.register;
+                  end;
+                LOC_CREGISTER,LOC_MEM,LOC_REFERENCE:
+                  begin
+                     del_location(left.location);
+                     location.reference.base:=getaddressregister;
+                     cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,
+                       location.reference.base);
+                  end;
+             end;
+           end
+         else if is_interfacecom(left.resulttype.def) then
+           begin
+              gettempintfcomreference(location.reference);
+              cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,
+                location.reference);
+           end
+         else
+           set_location(location,left.location);
+
+        { is this already set somewhere else? It wasn't present in the }
+        { original i386 code either (JM)                               }
+        { location.loc := LOC_REFERENCE;                               }
+         inc(location.reference.offset,vs.address);
+      end;
+
+{*****************************************************************************
+                            TCGSELFNODE
+*****************************************************************************}
+
+    procedure tcgselfnode.pass_2;
+      begin
+         reset_reference(location.reference);
+         getexplicitregister32(SELF_POINTER);
+         if (resulttype.def.deftype=classrefdef) or
+           is_class(resulttype.def) then
+          begin
+            location.loc := LOC_CREGISTER;
+            location.register:=SELF_POINTER;
+          end
+         else
+           begin
+             location.loc := LOC_REFERENCE;
+             location.reference.base:=SELF_POINTER;
+           end;
+      end;
+
+
+{*****************************************************************************
+                            TCGWITHNODE
+*****************************************************************************}
+
+    procedure tcgwithnode.pass_2;
+      var
+        tmpreg: tregister;
+        usetemp,with_expr_in_temp : boolean;
+{$ifdef GDB}
+        withstartlabel,withendlabel : tasmlabel;
+        pp : pchar;
+        mangled_length  : longint;
+
+      const
+        withlevel : longint = 0;
+{$endif GDB}
+      begin
+         if assigned(left) then
+            begin
+               secondpass(left);
+{$ifdef i386}
+               if left.location.reference.segment<>R_NO then
+                 message(parser_e_no_with_for_variable_in_other_segments);
+{$endif i386}
+
+               new(withreference);
+
+               usetemp:=false;
+               if (left.nodetype=loadn) and
+                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
+                 begin
+                    { for locals use the local storage }
+                    withreference^:=left.location.reference;
+                    include(flags,nf_islocal);
+                 end
+               else
+                { call can have happend with a property }
+                begin
+                  tmpreg := cg.get_scratch_reg(exprasmlist);
+                  usetemp:=true;
+                  if is_class_or_interface(left.resulttype.def) then
+                    cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,tmpreg)
+                  else
+                    cg.a_loadaddress_ref_reg(exprasmlist,
+                      left.location.reference,tmpreg);
+                end;
+
+               del_location(left.location);
+
+               { if the with expression is stored in a temp    }
+               { area we must make it persistent and shouldn't }
+               { release it (FK)                               }
+               if (left.location.loc in [LOC_MEM,LOC_REFERENCE]) and
+                 istemp(left.location.reference) then
+                 begin
+                    normaltemptopersistant(left.location.reference.offset);
+                    with_expr_in_temp:=true;
+                 end
+               else
+                 with_expr_in_temp:=false;
+
+               { if usetemp is set the value must be in tmpreg }
+               if usetemp then
+                begin
+                  gettempofsizereference(target_info.size_of_pointer,
+                    withreference^);
+                  normaltemptopersistant(withreference^.offset);
+                  { move to temp reference }
+                  cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference^);
+                  cg.free_scratch_reg(exprasmlist,tmpreg);
+{$ifdef GDB}
+                  if (cs_debuginfo in aktmoduleswitches) then
+                    begin
+                      inc(withlevel);
+                      getaddrlabel(withstartlabel);
+                      getaddrlabel(withendlabel);
+                      emitlab(withstartlabel);
+                      withdebugList.concat(Tai_stabs.Create(strpnew(
+                         '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
+                         '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
+                         tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset))));
+                      mangled_length:=length(aktprocsym.definition.mangledname);
+                      getmem(pp,mangled_length+50);
+                      strpcopy(pp,'192,0,0,'+withstartlabel.name);
+                      if (target_info.use_function_relative_addresses) then
+                        begin
+                          strpcopy(strend(pp),'-');
+                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
+                        end;
+                      withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+                    end;
+{$endif GDB}
+                end;
+
+               { right can be optimize out !!! }
+               if assigned(right) then
+                 secondpass(right);
+
+               if usetemp then
+                 begin
+                   ungetpersistanttemp(withreference^.offset);
+{$ifdef GDB}
+                   if (cs_debuginfo in aktmoduleswitches) then
+                     begin
+                       emitlab(withendlabel);
+                       strpcopy(pp,'224,0,0,'+withendlabel.name);
+                      if (target_info.use_function_relative_addresses) then
+                        begin
+                          strpcopy(strend(pp),'-');
+                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
+                        end;
+                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
+                       freemem(pp,mangled_length+50);
+                       dec(withlevel);
+                     end;
+{$endif GDB}
+                 end;
+
+               if with_expr_in_temp then
+                 ungetpersistanttemp(left.location.reference.offset);
+
+               dispose(withreference);
+               withreference:=nil;
+            end;
+       end;
+
+begin
+   cloadvmtnode:=tcgloadvmtnode;
+   chnewnode:=tcghnewnode;
+   chdisposenode:=tcghdisposenode;
+   caddrnode:=tcgaddrnode;
+   cdoubleaddrnode:=tcgdoubleaddrnode;
+   cderefnode:=tcgderefnode;
+   csubscriptnode:=tcgsubscriptnode;
+   cselfnode:=tcgselfnode;
+   cwithnode:=tcgwithnode;
+end.
+{
+  $Log$
+  Revision 1.1  2001-09-30 16:17:17  jonas
+    * made most constant and mem handling processor independent
+
+
+}