Просмотр исходного кода

* sLineBreak changed to normal constant like Kylix

peter 23 лет назад
Родитель
Сommit
71a1ae2136
9 измененных файлов с 128 добавлено и 30 удалено
  1. 5 2
      rtl/go32v2/system.pp
  2. 65 1
      rtl/inc/int64.inc
  3. 23 1
      rtl/inc/objpas.inc
  4. 6 2
      rtl/inc/systemh.inc
  5. 9 16
      rtl/inc/text.inc
  6. 5 2
      rtl/netware/system.pp
  7. 5 2
      rtl/os2/system.pas
  8. 5 2
      rtl/unix/sysunixh.inc
  9. 5 2
      rtl/win32/system.pp

+ 5 - 2
rtl/go32v2/system.pp

@@ -57,7 +57,7 @@ const
 
   FileNameCaseSensitive : boolean = false;
 
-  sLineBreak : string[2] = LineEnding;
+  sLineBreak = LineEnding;
   DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
 { Default memory segments (Tp7 compatibility) }
@@ -1529,7 +1529,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.18  2002-05-05 10:23:54  peter
+  Revision 1.19  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.18  2002/05/05 10:23:54  peter
     * fixed memw and meml array sizes
 
   Revision 1.17  2002/04/21 15:52:58  carl

+ 65 - 1
rtl/inc/int64.inc

@@ -145,6 +145,66 @@
          fpc_mod_qword:=0;
          if n=0 then
            HandleErrorFrame(200,get_frame);
+{$ifdef i386}
+         { the following piece of code is taken from the     }
+         { AMD Athlon Processor x86 Code Optimization manual }
+         asm
+            movl n+4,%ecx
+            movl n,%ebx
+            movl z+4,%edx
+            movl z,%eax
+            testl %ecx,%ecx
+            jnz .Lqwordmodr_big_divisior
+            cmpl %ebx,%edx
+            jae .Lqwordmodr_two_divs
+            divl %ebx
+            movl %edx,%eax
+            movl %ecx,%edx
+            leave
+            ret $16
+
+         .Lqwordmodr_two_divs:
+            movl %eax,%ecx
+            movl %edx,%eax
+            xorl %edx,%edx
+            divl %ebx
+            movl %ecx,%eax
+            divl %ebx
+            movl %edx,%eax
+            xorl %edx,%edx
+            leave
+            ret $16
+
+         .Lqwordmodr_big_divisior:
+            movl %ecx,%edi
+            shrl $1,%edx
+            rcrl $1,%eax
+            rorl $1,%edi
+            rcrl $1,%ebx
+            bsrl %ecx,%ecx
+            shrdl %cl,%edi,%ebx
+            shrdl %cl,%edx,%eax
+            shrl %cl,%edx
+            rorl $1,%edi
+            divl %ebx
+            movl z,%ebx
+            movl %eax,%ecx
+            imull %eax,%edi
+            mull n
+            addl %edi,%edx
+            subl %eax,%ebx
+            movl z+4,%ecx
+            movl n,%eax
+            sbbl %edx,%ecx
+            sbbl %edx,%edx
+            andl %edx,%eax
+            andl n+4,%edx
+            addl %ebx,%eax
+            adcl %ecx,%edx
+            leave
+            ret $16
+         end;
+{$else i386}
          lzz:=count_leading_zeros(z);
          lzn:=count_leading_zeros(n);
          { if the denominator contains less zeros }
@@ -164,6 +224,7 @@
            n:=n shr 1;
          until shift<0;
          fpc_mod_qword:=z;
+{$endif i386}
       end;
 
     function fpc_div_int64(n,z : int64) : int64;[public,alias: 'FPC_DIV_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
@@ -566,7 +627,10 @@
 
 {
   $Log$
-  Revision 1.13  2001-11-15 00:07:42  florian
+  Revision 1.14  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.13  2001/11/15 00:07:42  florian
     * qword div qword for i386 improved
 
   Revision 1.12  2001/09/05 15:22:09  jonas

+ 23 - 1
rtl/inc/objpas.inc

@@ -53,6 +53,7 @@
       end;
 
 {$else HASINTF}
+
     { interface helpers }
     procedure fpc_intf_decr_ref(var i: pointer);saveregisters;[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
       begin
@@ -103,6 +104,24 @@
         else
           intf_decr_ref(D);
       end;
+
+    procedure fpc_class_as_intf(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+      const
+        S_OK = 0;
+      var
+        tmpi: pointer; // _AddRef before _Release
+      begin
+        if assigned(S) then
+          begin
+             if TObject(S).GetInterface(iid,tmpi) then
+               handleerror(219);
+             if assigned(D) then
+               IUnknown(D)._Release;
+             D:=tmpi;
+          end
+        else
+          intf_decr_ref(D);
+      end;
 {$endif HASINTF}
 
 
@@ -696,7 +715,10 @@
 
 {
   $Log$
-  Revision 1.21  2002-04-26 15:19:05  peter
+  Revision 1.22  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.21  2002/04/26 15:19:05  peter
     * use saveregisters for incr routines, saves also problems with
       the optimizer
 

+ 6 - 2
rtl/inc/systemh.inc

@@ -95,8 +95,9 @@ Type
 
   UCS4Char            = Cardinal;
   PUCS4Char           = ^UCS4Char;
-
+{$ifndef HASCURRENCY}
   Currency            = Int64;
+{$endif HASCURRENCY}
   HRESULT             = Longint;
   TDateTime           = Double;
   Error               = Longint;
@@ -555,7 +556,10 @@ const
 
 {
   $Log$
-  Revision 1.46  2002-06-02 10:49:30  marco
+  Revision 1.47  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.46  2002/06/02 10:49:30  marco
    * Renamefest supports_double for FreeBSD too
 
   Revision 1.45  2002/04/21 15:51:51  carl

+ 9 - 16
rtl/inc/text.inc

@@ -321,7 +321,7 @@ Begin
      end;
     case TextRec(t).Bufptr^[TextRec(t).BufPos] of
 {$ifdef EOF_CTRLZ}
-         #26 : 
+         #26 :
            begin
              SeekEof := true;
              break;
@@ -494,26 +494,16 @@ end;
 
 
 Procedure fpc_Writeln_End(var f:Text);[Public,Alias:'FPC_WRITELN_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
-const
-{$IFDEF SHORT_LINEBREAK}
-  eollen=1;
-  eol : array[0..0] of char=(#10);
-{$ELSE SHORT_LINEBREAK}
-{$ifdef MAC_LINEBREAK}
-  eollen=1;
-  eol : array[0..0] of char=(#13);
-{$else MAC_LINEBREAK}
-  eollen=2;
-  eol : array[0..1] of char=(#13,#10);
-{$endif MAC_LINEBREAK}
-{$ENDIF SHORT_LINEBREAK}
+var
+  eol : array[0..3] of char;
 begin
   If InOutRes <> 0 then exit;
   case TextRec(f).mode of
     fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
       begin
+        eol:=sLineBreak;
         { Write EOL }
-        WriteBuffer(f,(@sLineBreak+1)^,length(sLineBreak));
+        WriteBuffer(f,eol,length(sLineBreak));
         { Flush }
         if TextRec(f).FlushFunc<>nil then
           FileFunc(TextRec(f).FlushFunc)(TextRec(f));
@@ -1238,7 +1228,10 @@ end;
 
 {
   $Log$
-  Revision 1.16  2001-11-21 14:51:33  jonas
+  Revision 1.17  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.16  2001/11/21 14:51:33  jonas
     * fixed writing of empty ansistring with specified width (merged)
 
   Revision 1.15  2001/09/25 16:34:59  jonas

+ 5 - 2
rtl/netware/system.pp

@@ -60,7 +60,7 @@ CONST
 
    FileNameCaseSensitive : boolean = false;
 
-   sLineBreak : STRING = LineEnding;
+   sLineBreak = LineEnding;
    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
    
 TYPE
@@ -771,7 +771,10 @@ Begin
   StackBottom := SPtr - StackLength;
 End.
 {
   $Log$
-  Revision 1.12  2002-04-15 18:47:34  carl
+  Revision 1.13  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.12  2002/04/15 18:47:34  carl
   + reinstate novell stack checking
 
   Revision 1.11  2002/04/12 17:40:11  carl

+ 5 - 2
rtl/os2/system.pas

@@ -139,7 +139,7 @@ const   UnusedHandle=$ffff;
         LFNSupport: boolean = true;
         FileNameCaseSensitive: boolean = false;
 
-        sLineBreak : string[2] = LineEnding;
+        sLineBreak = LineEnding;
         DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
 var
@@ -1021,7 +1021,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2002-04-21 15:54:20  carl
+  Revision 1.22  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.21  2002/04/21 15:54:20  carl
   + initialize some global variables
 
   Revision 1.20  2002/04/12 17:42:16  carl

+ 5 - 2
rtl/unix/sysunixh.inc

@@ -63,7 +63,7 @@ const
 
   FileNameCaseSensitive : boolean = true;
 
-  sLineBreak : string[1] = LineEnding;
+  sLineBreak = LineEnding;
   DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
 
 var
@@ -73,7 +73,10 @@ var
 
 {
   $Log$
-  Revision 1.13  2001-11-08 13:56:35  marco
+  Revision 1.14  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.13  2001/11/08 13:56:35  marco
    * Fixed a ifdef linux to ifdef unix (related to TRTL change)
 
   Revision 1.12  2001/10/23 21:51:03  peter

+ 5 - 2
rtl/win32/system.pp

@@ -72,7 +72,7 @@ const
 
    FileNameCaseSensitive : boolean = true;
 
-   sLineBreak : string = LineEnding;
+   sLineBreak = LineEnding;
    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
    { Thread count for DLL }
@@ -1564,7 +1564,10 @@ end.
 
 {
   $Log$
-  Revision 1.27  2002-06-04 09:25:14  pierre
+  Revision 1.28  2002-07-01 16:29:05  peter
+    * sLineBreak changed to normal constant like Kylix
+
+  Revision 1.27  2002/06/04 09:25:14  pierre
    * Rename HeapSize to WinAPIHeapSize to avoid conflict with general function
 
   Revision 1.26  2002/04/12 17:45:13  carl