* synchronized with trunk

git-svn-id: branches/wasm@48429 -

compiler/m68k/aoptcpu.pas

@@ -253,26 +253,30 @@ unit aoptcpu;
               opstr:=opname(p);
               case taicpu(p).oper[0]^.typ of
                 top_reg:
-                  begin
+                  { do not optimize away FPU to INT to FPU reg moves. These are used for 
-                    {  move %reg0, %tmpreg; move %tmpreg, <ea> -> move %reg0, <ea> }
+                    to-single-rounding on FPUs which have no FSMOVE/FDMOVE. (KB) }
-                    taicpu(p).loadOper(1,taicpu(next).oper[1]^);
+                  if not ((taicpu(p).opcode = A_FMOVE) and
-                    asml.remove(next);
+                    (getregtype(taicpu(p).oper[0]^.reg) <> getregtype(taicpu(p).oper[1]^.reg))) then
-                    next.free;
+                    begin
-                    result:=true;
+                      {  move %reg0, %tmpreg; move %tmpreg, <ea> -> move %reg0, <ea> }
-                    { also remove leftover move %reg0, %reg0, which can occur as the result
+                      taicpu(p).loadOper(1,taicpu(next).oper[1]^);
-                      of the previous optimization, if %reg0 and %tmpreg was different types
+                      asml.remove(next);
-                      (addr vs. data), so these moves were left in by the cg }
+                      next.free;
-                    if MatchOperand(taicpu(p).oper[0]^,taicpu(p).oper[1]^) then
+                      result:=true;
-                      begin
+                      { also remove leftover move %reg0, %reg0, which can occur as the result
-                        DebugMsg('Optimizer: '+opstr+' + '+opstr+' removed',p);
+                        of the previous optimization, if %reg0 and %tmpreg was different types
-                        GetNextInstruction(p,next);
+                        (addr vs. data), so these moves were left in by the cg }
-                        asml.remove(p);
+                      if MatchOperand(taicpu(p).oper[0]^,taicpu(p).oper[1]^) then
-                        p.free;
+                        begin
-                        p:=next;
+                          DebugMsg('Optimizer: '+opstr+' + '+opstr+' removed',p);
-                      end
+                          GetNextInstruction(p,next);
-                    else
+                          asml.remove(p);
-                      DebugMsg('Optimizer: '+opstr+' + '+opstr+' to '+opstr+' #1',p)
+                          p.free;
-                  end;
+                          p:=next;
+                        end
+                      else
+                        DebugMsg('Optimizer: '+opstr+' + '+opstr+' to '+opstr+' #1',p)
+                    end;
                 top_const:
                   begin
                     // DebugMsg('Optimizer: '+opstr+' + '+opstr+' to '+opstr+' #2',p);

compiler/m68k/cgcpu.pas

@@ -1051,10 +1051,40 @@ unit cgcpu;
     procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
       var
         instr : taicpu;
+        op: tasmop;
+        href: treference;
+        hreg: tregister;
       begin
-        instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
+        if fromsize > tosize then
-        add_move_instruction(instr);
+          begin
-        list.concat(instr);
+            { we have to do a load-store through an intregister or the stack in this case,
+              which is probably the fastest way, and simpler than messing around with FPU control
+              words for one-off custom rounding (KB) }
+            case tosize of
+              OS_F32:
+                  begin
+                    //list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via intreg')));
+                    hreg := getintregister(list,OS_32);
+                    list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], reg1, hreg));
+                    list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], hreg, reg2));
+                  end;
+            else
+              begin
+                //list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via stack')));
+                reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, 0, []);
+                href.direction:=dir_dec;
+                list.concat(taicpu.op_reg_ref(A_FMOVE, tcgsize2opsize[tosize], reg1, href));
+                href.direction:=dir_inc;
+                list.concat(taicpu.op_ref_reg(A_FMOVE, tcgsize2opsize[tosize], href, reg2));
+              end;
+            end;
+          end
+        else
+          begin
+            instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
+            add_move_instruction(instr);
+            list.concat(instr);
+          end;
       end;
 
 
@@ -1067,6 +1097,8 @@ unit cgcpu;
         href := ref;
         fixref(list,href,current_settings.fputype = fpu_coldfire);
         list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
+        if fromsize > tosize then
+          a_load_reg_reg(list,fromsize,tosize,reg,reg);
       end;
 
     procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);

compiler/m68k/n68kadd.pas

@@ -26,7 +26,7 @@ unit n68kadd;
 interface
 
     uses
-       symtype,node,nadd,ncgadd,cpubase,cgbase;
+       node,nadd,ncgadd,cpubase,cgbase;
 
 
     type
@@ -34,7 +34,7 @@ interface
        private
           function getresflags(unsigned: boolean) : tresflags;
           function getfloatresflags: tresflags;
-          function inlineable_realconstnode(const n: tnode; fpu_type : tdef): boolean;
+          function inlineable_realconstnode(const n: tnode): boolean;
           procedure second_mul64bit;
        protected
           function use_generic_mul64bit: boolean; override;
@@ -55,7 +55,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,paramgr,
+      symconst,symdef,paramgr,symtype,
       aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
       cpuinfo,pass_1,pass_2,
       cpupara,cgutils,procinfo,
@@ -146,14 +146,9 @@ implementation
       end;
 
 
-    function t68kaddnode.inlineable_realconstnode(const n: tnode; fpu_type : tdef): boolean;
+    function t68kaddnode.inlineable_realconstnode(const n: tnode): boolean;
       begin
-        if assigned(fpu_type) and
+        result:=(n.nodetype = realconstn) and
-	   ((FPUM68K_HAS_EXTENDED in fpu_capabilities[current_settings.fputype])
-            or (fpu_type.size < sizeof(bestreal))) then
-          result:=false
-        else
-          result:=(n.nodetype = realconstn) and
             not ((trealconstnode(n).value_real=MathInf.Value) or
                  (trealconstnode(n).value_real=MathNegInf.Value) or
                  (trealconstnode(n).value_real=MathQNaN.value));
@@ -196,7 +191,7 @@ implementation
 
         { have left in the register, right can be a memory location }
         if (FPUM68K_HAS_FLOATIMMEDIATE in fpu_capabilities[current_settings.fputype]) and
-           inlineable_realconstnode(left,resultdef) then
+           inlineable_realconstnode(left) then
           begin
             location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
             current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FMOVE,tcgsize2opsize[left.location.size],trealconstnode(left).value_real,location.register))
@@ -216,7 +211,7 @@ implementation
           LOC_REFERENCE,LOC_CREFERENCE:
               begin
                 if (FPUM68K_HAS_FLOATIMMEDIATE in fpu_capabilities[current_settings.fputype]) and
-                   inlineable_realconstnode(right,resultdef) then
+                   inlineable_realconstnode(right) then
                   current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(op,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,location.register))
                 else
                   begin
@@ -289,7 +284,7 @@ implementation
                   begin
                     hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
                     if not (current_settings.fputype = fpu_coldfire) and
-                       inlineable_realconstnode(right,left.resultdef) then
+                       inlineable_realconstnode(right) then
                       current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FCMP,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,left.location.register))
                     else
                       begin

packages/fcl-registry/tests/regtcxmlreg.pp

@@ -94,13 +94,13 @@ begin
   SetLength(S1,100);
   For I:=0 to 99 do
     S1[I]:=i;
-  XMLReg.SetValueData('b',dtBinary,S1[1],Length(S1));
+  XMLReg.SetValueData('b',dtBinary,S1[0],Length(S1));
   XMLReg.Flush;
-  DS:=SizeOf(S1) div 4;
+  DS:=Length(S1) div 4;
   SetLength(S2,DS);
   For I:=0 to DS-1 do
     S2[I]:=i;
-  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[1],ds));
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[0],DS));
   AssertTrue('Correct data type reported',dt=dtBinary);
   AssertEquals('Correct data buffer size reported',Length(S1),DS);
 end;

packages/pasjpeg/examples/example.pas

@@ -1,3 +1,8 @@
+{$IFDEF FPC}
+{$MODE DELPHI}
+{$GOTO ON}
+{$DEFINE DELPHI_STREAM}
+{$ENDIF}
 Unit example;
 
 { This file illustrates how to use the IJG code as a subroutine library
@@ -37,6 +42,10 @@ function read_JPEG_file (filename : string) : boolean;
 
 implementation
 
+{$ifdef delphi_stream}
+  uses
+    Classes;
+{$endif delphi_stream}
 { <setjmp.h> is used for the optional error recovery mechanism shown in
   the second part of the example. }
 
@@ -93,7 +102,11 @@ var
 
   jerr : jpeg_error_mgr;
   { More stuff }
+{$ifdef delphi_stream}
+  outfile : TFileStream;
+{$else delphi_stream}
   outfile : FILE;               { target file }
+{$endif delphi_stream}
   row_pointer : array[0..0] of JSAMPROW ;       { pointer to JSAMPLE row[s] }
   row_stride : int;             { physical row width in image buffer }
 begin
@@ -117,7 +130,9 @@ begin
     stdio stream.  You can also write your own code to do something else.
     VERY IMPORTANT: use "b" option to fopen() if you are on a machine that
     requires it in order to write binary files. }
-
+{$ifdef delphi_stream}
+  outfile := TFileStream.Create(filename, fmCreate);
+{$else delphi_stream}
   Assign(outfile, filename);
   {$push}{$I-}
   ReWrite(outfile, 1);
@@ -127,6 +142,7 @@ begin
     WriteLn(output, 'can''t open ', filename);
     Halt(1);
   end;
+{$endif delphi_stream}
   jpeg_stdio_dest(@cinfo, @outfile);
 
   { Step 3: set parameters for compression }
@@ -179,7 +195,11 @@ begin
 
   jpeg_finish_compress(@cinfo);
   { After finish_compress, we can close the output file. }
+{$ifdef delphi_stream}
+  outfile.Free;
+{$else delphi_stream}
   system.close(outfile);
+{$endif delphi_stream}
 
   { Step 7: release JPEG compression object }
 
@@ -321,7 +341,11 @@ var
 
   jerr  : my_error_mgr;
   { More stuff }
-  infile : FILE;                { source file }
+{$ifdef delphi_stream}
+  infile : TFileStream;
+{$else delphi_stream}
+  infile : FILE;               { target file }
+{$endif delphi_stream}
   buffer : JSAMPARRAY;          { Output row buffer }
   row_stride : int;             { physical row width in output buffer }
 begin
@@ -331,6 +355,9 @@ begin
     VERY IMPORTANT: use "b" option to fopen() if you are on a machine that
     requires it in order to read binary files. }
 
+{$ifdef delphi_stream}
+  infile := TFileStream.Create(filename, fmOpenRead);
+{$else delphi_stream}
   Assign(infile, filename);
   {$push}{$I-}
   Reset(infile, 1);
@@ -341,6 +368,7 @@ begin
     read_JPEG_file := FALSE;
     exit;
   end;
+{$endif delphi_stream}
 
   { Step 1: allocate and initialize JPEG decompression object }
 
@@ -356,7 +384,11 @@ begin
     { Nomssi: if we get here, we are in trouble, because e.g. cinfo.mem
               is not guaranted to be NIL }
     jpeg_destroy_decompress(@cinfo);
+{$ifdef delphi_stream}
+    infile.Free;
+{$else delphi_stream}
     system.close(infile);
+{$endif delphi_stream}
     read_JPEG_file := FALSE;
     exit;
   end;
@@ -440,7 +472,11 @@ begin
     Here we postpone it until after no more JPEG errors are possible,
     so as to simplify the setjmp error logic above.  (Actually, I don't
     think that jpeg_destroy can do an error exit, but why assume anything...) }
+{$ifdef delphi_stream}
+  infile.Free;
+{$else delphi_stream}
   system.close(infile);
+{$endif delphi_stream}
 
   { At this point you may want to check to see whether any corrupt-data
     warnings occurred (test whether jerr.pub.num_warnings is nonzero). }