Browse Source

* freemem change to value parameter
* torddef low/high range changed to int64

peter 24 years ago
parent
commit
e45bb82d81

+ 6 - 2
compiler/i386/n386mem.pas

@@ -157,7 +157,7 @@ implementation
                      emit_push_loc(left.location);
                      emitcall('FPC_FINALIZE');
                   end;
-                emit_push_lea_loc(left.location,true);
+                emit_push_loc(left.location);
                 emitcall('FPC_FREEMEM');
              end;
            simplenewn:
@@ -701,7 +701,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-09-30 16:17:17  jonas
+  Revision 1.18  2001-12-03 21:48:43  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  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

+ 7 - 2
compiler/i386/n386set.pas

@@ -853,8 +853,9 @@ implementation
         end;
 
       var
+         lv,hv,
          max_label: tconstexprint;
-         lv,hv,labels : longint;
+         labels : longint;
          max_linear_list : longint;
          otl, ofl: tasmlabel;
 {$ifdef Delphi}
@@ -1091,7 +1092,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-09-04 11:38:55  jonas
+  Revision 1.18  2001-12-03 21:48:43  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.17  2001/09/04 11:38:55  jonas
     + searchsystype() and searchsystype() functions in symtable
     * changed ninl and nadd to use these functions
     * i386 set comparison functions now return their results in al instead

+ 7 - 3
compiler/i386/n386util.pas

@@ -60,7 +60,7 @@ implementation
     uses
        globtype,globals,systems,verbose,
        cutils,
-       aasm,cpubase,cpuasm,
+       aasm,cpubase,cpuasm,cpuinfo,
        symconst,symbase,symdef,symsym,symtable,
 {$ifdef GDB}
        gdb,
@@ -1115,7 +1115,7 @@ implementation
         op     : tasmop;
         fromdef : tdef;
         lto,hto,
-        lfrom,hfrom : longint;
+        lfrom,hfrom : TConstExprInt;
         is_reg : boolean;
       begin
         { range checking on and range checkable value? }
@@ -1544,7 +1544,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-12-02 16:19:17  jonas
+  Revision 1.24  2001-12-03 21:48:43  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.23  2001/12/02 16:19:17  jonas
     * less unnecessary regvar loading with if-statements
 
   Revision 1.22  2001/10/12 13:51:52  jonas

+ 7 - 3
compiler/ncnv.pas

@@ -229,8 +229,8 @@ implementation
         end;
 
       var
-        l : longint;
-        lr,hr : longint;
+        l : Longint;
+        lr,hr : TConstExprInt;
 
       begin
         new(constset);
@@ -1618,7 +1618,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2001-11-02 23:24:11  jonas
+  Revision 1.45  2001-12-03 21:48:41  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.44  2001/11/02 23:24:11  jonas
     * fixed web bug 1665 (allow char to chararray type conversion) ("merged")
 
   Revision 1.43  2001/11/02 22:58:02  peter

+ 58 - 5
compiler/nmem.pas

@@ -219,8 +219,61 @@ implementation
 
 
     function tnewnode.pass_1 : tnode;
+{$ifdef NEW_COMPILERPROC}
+      var
+        temp          : ttempcreatenode;
+        newstatement  : tstatementnode;
+        newblock      : tblocknode;
+{$endif NEW_COMPILERPROC}
       begin
          result:=nil;
+{$ifdef NEW_COMPILERPROC}
+         { create the blocknode which will hold the generated statements + }
+         { an initial dummy statement                                      }
+         newstatement := cstatementnode.create(nil,cnothingnode.create);
+         newblock := cblocknode.create(newstatement);
+
+         { create temp for result }
+         temp := ctempcreatenode.create(resulttype,
+                                        resulttype.size,true);
+         newstatement.left := cstatementnode.create(nil,temp);
+
+         { create parameter }
+         sizepara := ccallparanode.create(cordconstnode.create
+             (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil);
+
+         { create the call and assign the result to dest  }
+         { the assignment will take care of rangechecking }
+         newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
+           ctemprefnode.create(tempcode),
+           ccallnode.createintern('fpc_getmem',sizepara)));
+         newstatement := tstatementnode(newstatement.left);
+
+         if tpointerdef(resulttype.def).pointertype.def.needs_inittable then
+          begin
+            para := ccallparanode.create(cloadnode.create
+                       (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),
+                    ccallparanode.create(cordconstnode.create
+                       (tpointerdef(resulttype.def).pointertype.def.size,s32bittype),nil));
+            newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
+              ctemprefnode.create(tempcode),
+              ccallnode.createintern('fpc_initialize',sizepara)));
+            newstatement := tstatementnode(newstatement.left);
+                   new(r);
+                   reset_reference(r^);
+                   r^.symbol:=tstoreddef(tpointerdef(resulttype.def).pointertype.def).get_rtti_label(initrtti);
+                   emitpushreferenceaddr(r^);
+                   dispose(r);
+                   { push pointer we just allocated, we need to initialize the
+                     data located at that pointer not the pointer self (PFV) }
+                   emit_push_loc(location);
+                   emitcall('FPC_INITIALIZE');
+          end;
+
+         { and return it }
+         result := newblock;
+{$endif NEW_COMPILERPROC}
+
          if assigned(left) then
           begin
             firstpass(left);
@@ -317,10 +370,6 @@ implementation
          if codegenerror then
           exit;
 
-         if (left.location.loc<>LOC_REFERENCE) {and
-            (left.location.loc<>LOC_CREGISTER)} then
-           CGMessage(cg_e_illegal_expression);
-
          registers32:=left.registers32;
          registersfpu:=left.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -985,7 +1034,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.23  2001-11-02 22:58:02  peter
+  Revision 1.24  2001-12-03 21:48:42  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.23  2001/11/02 22:58:02  peter
     * procsym definition rewrite
 
   Revision 1.22  2001/10/28 17:22:25  peter

+ 6 - 1
compiler/options.pas

@@ -1346,6 +1346,7 @@ begin
   def_symbol('HAS_ADDR_STACK_ON_STACK');
   def_symbol('NOBOUNDCHECK');
   def_symbol('HASCOMPILERPROC');
+  def_symbol('VALUEFREEMEM');
 
 { some stuff for TP compatibility }
 {$ifdef i386}
@@ -1645,7 +1646,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.63  2001-11-24 02:09:54  carl
+  Revision 1.64  2001-12-03 21:48:42  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.63  2001/11/24 02:09:54  carl
   * Renamed ppc.cfg -> fpc.cfg
 
   Revision 1.62  2001/11/23 02:48:46  carl

+ 58 - 10
compiler/symdef.pas

@@ -37,7 +37,7 @@ interface
        { node }
        node,
        { aasm }
-       aasm,cpubase
+       aasm,cpubase,cpuinfo
        ;
 
 
@@ -370,9 +370,9 @@ interface
 
        torddef = class(tstoreddef)
           rangenr  : longint;
-          low,high : longint;
+          low,high : TConstExprInt;
           typ      : tbasetype;
-          constructor create(t : tbasetype;v,b : longint);
+          constructor create(t : tbasetype;v,b : TConstExprInt);
           constructor load(ppufile:tcompilerppufile);
           procedure write(ppufile:tcompilerppufile);override;
           function  is_publishable : boolean;override;
@@ -720,7 +720,7 @@ implementation
        { global }
        verbose,
        { target }
-       systems,cpuinfo,
+       systems,
        { symtable }
        symsym,symtable,
        types,
@@ -1597,7 +1597,7 @@ implementation
                                  TORDDEF
 ****************************************************************************}
 
-    constructor torddef.create(t : tbasetype;v,b : longint);
+    constructor torddef.create(t : tbasetype;v,b : TConstExprInt);
       begin
          inherited create;
          deftype:=orddef;
@@ -1610,12 +1610,44 @@ implementation
 
 
     constructor torddef.load(ppufile:tcompilerppufile);
+      var
+        l1,l2 : longint;
       begin
          inherited loaddef(ppufile);
          deftype:=orddef;
          typ:=tbasetype(ppufile.getbyte);
-         low:=ppufile.getlongint;
-         high:=ppufile.getlongint;
+         if sizeof(TConstExprInt)=8 then
+          begin
+            l1:=ppufile.getlongint;
+            l2:=ppufile.getlongint;
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+{$R- needed here }
+            low:=qword(l1)+(int64(l2) shl 32);
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+          end
+         else
+          low:=ppufile.getlongint;
+         if sizeof(TConstExprInt)=8 then
+          begin
+            l1:=ppufile.getlongint;
+            l2:=ppufile.getlongint;
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+{$R- needed here }
+            high:=qword(l1)+(int64(l2) shl 32);
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+          end
+         else
+          high:=ppufile.getlongint;
          rangenr:=0;
          setsize;
       end;
@@ -1728,8 +1760,20 @@ implementation
       begin
          inherited writedef(ppufile);
          ppufile.putbyte(byte(typ));
-         ppufile.putlongint(low);
-         ppufile.putlongint(high);
+         if sizeof(TConstExprInt)=8 then
+          begin
+            ppufile.putlongint(longint(lo(low)));
+            ppufile.putlongint(longint(hi(low)));
+          end
+         else
+          ppufile.putlongint(low);
+         if sizeof(TConstExprInt)=8 then
+          begin
+            ppufile.putlongint(longint(lo(high)));
+            ppufile.putlongint(longint(hi(high)));
+          end
+         else
+          ppufile.putlongint(high);
          ppufile.writeentry(iborddef);
       end;
 
@@ -5458,7 +5502,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2001-11-30 15:01:51  jonas
+  Revision 1.59  2001-12-03 21:48:42  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.58  2001/11/30 15:01:51  jonas
     * tarraydef.size returns target_info.size_of_pointer instead of 4 for
       dynamic arrays
 

+ 7 - 3
compiler/symsym.pas

@@ -1918,7 +1918,7 @@ implementation
 {$endif Range_check_on}
                  end
                else
-                 valueordptr:=ppufile.getlongint;
+                 valueordptr:=cardinal(ppufile.getlongint);
              end;
            conststring,
            constresourcestring :
@@ -2017,7 +2017,7 @@ implementation
                     ppufile.putlongint(longint(hi(valueordptr)));
                  end
                else
-                 ppufile.putlongint(valueordptr);
+                 ppufile.putlongint(longint(valueordptr));
              end;
            conststring,
            constresourcestring :
@@ -2440,7 +2440,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2001-11-30 16:25:35  jonas
+  Revision 1.29  2001-12-03 21:48:42  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.28  2001/11/30 16:25:35  jonas
     * fixed web bug 1707:
        * tvarsym.getvaluesize doesn't return 0 anymore for dynarrays (found
          by Florian)

+ 8 - 4
compiler/types.pas

@@ -231,7 +231,7 @@ interface
     procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
 
     { returns the range of def }
-    procedure getrange(def : tdef;var l : longint;var h : longint);
+    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
 
     { some type helper routines for MMX support }
     function is_mmx_able_array(p : tdef) : boolean;
@@ -833,7 +833,7 @@ implementation
       the value is placed within the range }
     procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
       var
-         lv,hv: longint;
+         lv,hv: TConstExprInt;
          error: boolean;
       begin
          error := false;
@@ -914,7 +914,7 @@ implementation
 
 
     { return the range from def in l and h }
-    procedure getrange(def : tdef;var l : longint;var h : longint);
+    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
       begin
         case def.deftype of
           orddef :
@@ -1869,7 +1869,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  2001-11-14 01:12:45  florian
+  Revision 1.58  2001-12-03 21:48:43  peter
+    * freemem change to value parameter
+    * torddef low/high range changed to int64
+
+  Revision 1.57  2001/11/14 01:12:45  florian
     * variant paramter passing and functions results fixed
 
   Revision 1.56  2001/11/02 23:24:12  jonas