Explorar o código

* several fixes for linux/powerpc
* several fixes to MT

florian %!s(int64=23) %!d(string=hai) anos
pai
achega
7ac5c3743d

+ 27 - 2
rtl/fakertl/system.pp

@@ -10,16 +10,41 @@ type
   longint=$80000000..$7fffffff;
   pchar=^char;
 
+var
+   a,b,c,d : longint;
+   s1,s2 : string;
+   i1,i2 : int64;
+
 implementation
 
+{ $i ../powerpc/powerpc.inc}
+
+{
+procedure p1(l1,l2,l3 : longint);
+
+  begin
+  end;
+
+
 procedure do_exit;[public,alias:'FPC_DO_EXIT'];
 begin
 end;
+}
 
 begin
+   b:=4;
+   a:=b;
+   i1:=i2;
+   // p1(a,b,3);
+   // s1:=s2;
 end.
+
+{
   $Log$
-  Revision 1.2  2000-07-13 11:33:38  michael
+  Revision 1.3  2002-07-28 20:43:47  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.2  2000/07/13 11:33:38  michael
   + removed logs
- 
 }

+ 5 - 2
rtl/inc/compproc.inc

@@ -256,7 +256,11 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
 
 {
   $Log$
-  Revision 1.16  2002-04-25 20:14:56  peter
+  Revision 1.17  2002-07-28 20:43:47  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.16  2002/04/25 20:14:56  peter
     * updated compilerprocs
     * incr ref count has now a value argument instead of var
 
@@ -362,5 +366,4 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
        chars)
     * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
       still nil (used to crash, now return resp -1 and 0)
-
 }

+ 22 - 20
rtl/inc/generic.inc

@@ -33,7 +33,7 @@ begin
   for i:=0 to count do
          bytearray(dest)[i]:=bytearray(source)[i];
 end;
-{$endif ndef FPC_SYSTEM_HAS_MOVE}
+{$endif not FPC_SYSTEM_HAS_MOVE}
 
 
 {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
@@ -53,7 +53,7 @@ begin
   for i:=(count div 4)*4 to count-1 do
     bytearray(x)[i]:=value;
 end;
-{$endif ndef FPC_SYSTEM_HAS_FILLCHAR}
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
 
 
 {$ifndef FPC_SYSTEM_HAS_FILLBYTE}
@@ -61,7 +61,7 @@ procedure FillByte (var x;count : longint;value : byte );
 begin
   FillChar (X,Count,CHR(VALUE));
 end;
-{$endif ndef FPC_SYSTEM_HAS_FILLBYTE}
+{$endif not FPC_SYSTEM_HAS_FILLBYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_FILLWORD}
@@ -78,7 +78,7 @@ begin
   for i:=(count div 2)*2 to count-1 do
     wordarray(x)[i]:=value;
 end;
-{$endif ndef FPC_SYSTEM_HAS_FILLWORD}
+{$endif not FPC_SYSTEM_HAS_FILLWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_FILLDWORD}
@@ -98,7 +98,7 @@ begin
       end;
    end;
 end;
-{$endif ndef FPC_SYSTEM_HAS_FILLDWORD}
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
@@ -106,7 +106,7 @@ function IndexChar(Const buf;len:longint;b:char):longint;
 begin
   IndexChar:=IndexByte(Buf,Len,byte(B));
 end;
-{$endif ndef FPC_SYSTEM_HAS_INDEXCHAR}
+{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
@@ -123,7 +123,7 @@ begin
    i:=-1;                                {Can't use 0, since it is a possible value}
   IndexByte:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXWORD}
@@ -140,7 +140,7 @@ begin
    i:=-1;           {Can't use 0, since it is a possible value for index}
   Indexword:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_INDEXWORD}
+{$endif not FPC_SYSTEM_HAS_INDEXWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
@@ -156,7 +156,7 @@ begin
    i:=-1;           {Can't use 0, since it is a possible value for index}
   IndexDWord:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_INDEXDWORD}
+{$endif not FPC_SYSTEM_HAS_INDEXDWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
@@ -164,7 +164,7 @@ function CompareChar(Const buf1,buf2;len:longint):longint;
 begin
   CompareChar:=CompareByte(buf1,buf2,len);
 end;
-{$endif ndef FPC_SYSTEM_HAS_COMPARECHAR}
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
@@ -193,7 +193,7 @@ begin
    end;
   CompareByte:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
@@ -222,7 +222,7 @@ begin
    end;
   CompareWord:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_COMPAREWORD}
+{$endif not FPC_SYSTEM_HAS_COMPAREWORD}
 
 
 {$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
@@ -316,7 +316,7 @@ begin
    end;
   CompareChar0:=I;
 end;
-{$endif ndef FPC_SYSTEM_HAS_COMPARECHAR0}
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
 
 
 {****************************************************************************
@@ -362,7 +362,7 @@ begin
    fpc_help_constructor:=_self;
 end;
 
-{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
 
@@ -391,7 +391,7 @@ begin
    _self:=nil;
 end;
 
-{$endif ndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+{$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
 procedure fpc_help_fail(var _self : pointer; var vmt : pointer; vmt_pos : cardinal);safecall; [public,alias:'FPC_HELP_FAIL'];
@@ -455,7 +455,7 @@ procedure fpc_dispose_class(_self: tobject; flag : longint);saveregisters;[publi
 
 {$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
 
-procedure fpc_check_object(vmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT'];  {$ifdef hascompilerproc} compilerproc; {$endif}
+procedure fpc_check_object(obj : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT'];  {$ifdef hascompilerproc} compilerproc; {$endif}
    type
      pvmt = ^tvmt;
      tvmt = packed record
@@ -555,8 +555,6 @@ begin
  }
 end;
 
-
-
 {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY}
 
 {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
@@ -770,7 +768,7 @@ begin
      abs:=l;
 end;
 
-{$endif ndef FPC_SYSTEM_HAS_ABS_LONGINT}
+{$endif not FPC_SYSTEM_HAS_ABS_LONGINT}
 
 {$ifndef FPC_SYSTEM_HAS_ODD_LONGINT}
 
@@ -947,7 +945,11 @@ end;
 
 {
   $Log$
-  Revision 1.27  2002-06-16 08:19:03  carl
+  Revision 1.28  2002-07-28 20:43:47  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.27  2002/06/16 08:19:03  carl
   * bugfix of FPC_NEW_CLASS (was not creating correct instance)
   + FPC_HELP_FAIL_CLASS now tested (no longer required)
 

+ 8 - 4
rtl/inc/genmath.inc

@@ -988,6 +988,7 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
                     Helper routines to support old TP styled reals
  ****************************************************************************}
 
+{$ifndef FPC_SYSTEM_HAS_REAL2DOUBLE}
     function real2double(r : real48) : double;
 
       var
@@ -1014,11 +1015,16 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
          res[7]:=res[7] or (r[5] and $80);
          real2double:=double(res);
       end;
-{$endif}
+{$endif FPC_SYSTEM_HAS_REAL2DOUBLE}
+{$endif SUPPORT_DOUBLE}
 
 {
   $Log$
-  Revision 1.3  2001-12-26 21:03:56  peter
+  Revision 1.4  2002-07-28 20:43:48  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.3  2001/12/26 21:03:56  peter
     * merged fixes from 1.0.x
 
   Revision 1.2  2001/07/30 21:38:55  peter
@@ -1026,6 +1032,4 @@ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
 
   Revision 1.1.2.1  2001/07/29 23:58:16  carl
   + generic version of mathematical routines (taken from m68k directory)
-
-
 }

+ 7 - 1
rtl/inc/system.inc

@@ -203,11 +203,13 @@ begin
  D:=real2double(b);
 end;
 
+{$ifdef SUPPORT_EXTENDED}
 operator := (b:real48) e:extended;
 
 begin
  e:=real2double(b);
 end;
+{$endif SUPPORT_EXTENDED}
 
 { Include processor specific routines }
 {$I math.inc}
@@ -755,7 +757,11 @@ end;
 
 {
   $Log$
-  Revision 1.31  2002-07-26 22:46:06  florian
+  Revision 1.32  2002-07-28 20:43:48  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.31  2002/07/26 22:46:06  florian
     * interface of system unit for Linux/PowerPC compiles
 
   Revision 1.30  2002/07/26 16:42:00  florian

+ 11 - 1
rtl/inc/threadh.inc

@@ -24,6 +24,10 @@ type
 function BeginThread(sa : Pointer;stacksize : dword;
   ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
   var ThreadId : DWord) : DWord;
+{ Delphi uses a longint for threadid }
+function BeginThread(sa : Pointer;stacksize : dword;
+  ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
+  var ThreadId : Longint) : DWord;
 
 { add some simplfied forms which make lifer easier and porting }
 { to other OSes too ...                                        }
@@ -31,6 +35,8 @@ function BeginThread(ThreadFunction : tthreadfunc) : DWord;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
   var ThreadId : DWord) : DWord;
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
+  var ThreadId : Longint) : DWord;
 
 procedure EndThread(ExitCode : DWord);
 procedure EndThread;
@@ -47,7 +53,11 @@ procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
 
 {
   $Log$
-  Revision 1.5  2001-10-23 21:51:03  peter
+  Revision 1.6  2002-07-28 20:43:48  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.5  2001/10/23 21:51:03  peter
     * criticalsection renamed to rtlcriticalsection for kylix compatibility
 
   Revision 1.4  2001/01/26 16:37:54  florian

+ 15 - 4
rtl/linux/signal.inc

@@ -88,7 +88,7 @@ type
            status: cardinal;
   end;
 
-{$Ifdef i386}
+{$ifdef i386}
   PSigContextRec = ^SigContextRec;
   SigContextRec = record
     gs, __gsh: word;
@@ -114,14 +114,21 @@ type
     oldmask: cardinal;
     cr2: cardinal;
   end;
-{$ENDIF}
+{$endif i386}
 
 {$Ifdef m68k}
   PSigContextRec = ^SigContextRec;
   SigContextRec = record
     { dummy for now PM }
   end;
-{$ENDIF}
+{$endif m68k}
+
+{$ifdef powerpc}
+  PSigContextRec = ^SigContextRec;
+  SigContextRec = record
+    { dummy for now PM }
+  end;
+{$endif powerpc}
 
 (*
   PSigInfoRec = ^SigInfoRec;
@@ -192,7 +199,11 @@ type
 
 {
   $Log$
-  Revision 1.4  2001-06-27 21:37:38  peter
+  Revision 1.5  2002-07-28 20:43:48  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.4  2001/06/27 21:37:38  peter
     * v10 merges
 
   Revision 1.3  2001/04/04 22:50:59  peter

+ 14 - 6
rtl/linux/syscalls.inc

@@ -32,6 +32,7 @@ Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );assembler;
 }
 {$ifdef i386}
 {$ASMMODE ATT}
+{$define fpc_syscall_ok}
 asm
 { load the registers... }
   movl 12(%ebp),%eax
@@ -56,8 +57,9 @@ asm
   movl %ebx,(%eax)
 end;
 {$ASMMODE DEFAULT}
-{$else}
+{$endif i386}
 {$ifdef m68k}
+{$define fpc_syscall_ok}
 asm
 { load the registers... }
   move.l 12(a6),a0
@@ -81,10 +83,12 @@ asm
   move.l (sp)+,d1
   move.l d1,(a0)
 end;
-{$else}
-{$error Cannot decide which processor you have ! define i386 or m68k }
-{$endif}
-{$endif}
+{$endif m68k}
+{$ifndef fpc_syscall_ok}
+{$error Cannot decide which processor you have!}
+asm
+end;
+{$endif not fpc_syscall_ok}
 
 {$IFDEF SYSCALL_DEBUG}
 Const
@@ -554,7 +558,11 @@ end;
 
 {
   $Log$
-  Revision 1.5  2001-10-14 13:33:20  peter
+  Revision 1.6  2002-07-28 20:43:48  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.5  2001/10/14 13:33:20  peter
     * start of thread support for linux
 
   Revision 1.4  2001/06/02 00:31:30  peter

+ 27 - 12
rtl/powerpc/math.inc

@@ -20,15 +20,22 @@
                        EXTENDED data type routines
  ****************************************************************************}
 
+    {$define FPC_SYSTEM_HAS_PI}
     function pi : double;[internconst:in_pi];
       begin
         pi := 3.14159265358979320;
       end;
 
+    {$define FPC_SYSTEM_HAS_ABS}
     function abs(d : extended) : extended;[internproc:in_abs_extended];
+
+    {$define FPC_SYSTEM_HAS_SQR}
     function sqr(d : extended) : extended;[internproc:in_sqr_extended];
+
+    {$define FPC_SYSTEM_HAS_SQRT}
     function sqrt(d : extended) : extended;[internproc:in_sqrt_extended];
 
+    {
     function arctan(d : extended) : extended;[internconst:in_arctan_extended];
       begin
         runerror(207);
@@ -49,25 +56,27 @@
         runerror(207);
       end;
 
-    function exp(d : extended) : extended;assembler;[internconst:in_const_exp];
+    function exp(d : extended) : extended;[internconst:in_const_exp];
       begin
         runerror(207);
       end;
 
 
-    function frac(d : extended) : extended;assembler;[internconst:in_const_frac];
+    function frac(d : extended) : extended;[internconst:in_const_frac];
       begin
         runerror(207);
       end;
 
 
-    function int(d : extended) : extended;assembler;[internconst:in_const_int];
+    function int(d : extended) : extended;[internconst:in_const_int];
       begin
         runerror(207);
       end;
+    }
 
-
-    function trunc(d : extended) : longint;assembler;[internconst:in_const_trunc];
+    {$define FPC_SYSTEM_HAS_TRUNC}
+    {$warning FIX ME}
+    function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
       { input: d in fr1      }
       { output: result in r3 }
       assembler;
@@ -82,9 +91,11 @@
         fctiwz   fr1,fr1
         stfd     fr1,temp.d
         lwz      r3,temp.l2
-      end ['r3','fr1'];
+        // !!!! fix int64 result
+      end ['r3','f1'];
 
 
+    {$define FPC_SYSTEM_HAS_ROUND}
     function round(d : extended) : longint;assembler;[internconst:in_const_round];
       { input: d in fr1      }
       { output: result in r3 }
@@ -100,9 +111,10 @@
         fctiw    fr1,fr1
         stfd     fr1,temp.d
         lwz      r3,temp.l2
-      end ['r3','fr1'];
+      end ['r3','f1'];
 
 
+   {$define FPC_SYSTEM_HAS_POWER}
    function power(bas,expo : extended) : extended;
      begin
         if bas=0 then
@@ -158,6 +170,7 @@
 
     { warning: the following converts a little-endian TP-style real }
     { to a big-endian double. So don't byte-swap the TP real!       }
+    {$define FPC_SYSTEM_HAS_REAL2DOUBLE}
     function real2double(r : real48) : double;
 
       var
@@ -218,7 +231,7 @@ asm
            lfd    fr2,int_to_real_factor@l(r3)
            fsub   fr3,fr3,fr1
            fmadd  fr1,fr0,fr2,fr3
-end ['r0','r3','r4','fr0','fr1','fr2','fr3'];
+end ['r0','r3','r4','f0','f1','f2','f3'];
 
 
 function fpc_qword_to_real(q: qword): double; compilerproc;
@@ -246,13 +259,17 @@ asm
            lfd    fr2,int_to_real_factor@l(r3)
            fsub   fr3,fr3,fr1
            fmadd  fr1,fr0,fr2,fr3
-end ['r0','r3','fr0','fr1','fr2','fr3'];
+end ['r0','r3','f0','f1','f2','f3'];
 
 
 
 {
   $Log$
-  Revision 1.3  2001-12-02 16:19:45  jonas
+  Revision 1.4  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.3  2001/12/02 16:19:45  jonas
     * fpu results are returned in fr1, not fr0
 
   Revision 1.2  2001/10/30 17:18:14  jonas
@@ -262,6 +279,4 @@ end ['r0','r3','fr0','fr1','fr2','fr3'];
 
   Revision 1.1  2001/10/28 14:09:13  jonas
     + initial implementation, lots of things still missing
-
-
 }

+ 37 - 24
rtl/powerpc/powerpc.inc

@@ -311,7 +311,6 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_FILLWORD}
-
 procedure fillword(var x;count : longint;value : word);
 begin
 {       registers:
@@ -337,7 +336,7 @@ begin
                 stwux   r5,r13,r14
                 bdnz    .FillWordLoop
 .FillWordEnd:
-        end [r13,r14,ctr]
+        end ['r13','r14','ctr']
 end;
 
 
@@ -527,17 +526,20 @@ end ['r0','r3','r4','r9','r10','cr0','ctr'];
                               Object Helpers
 ****************************************************************************}
 
-{define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
-(*
-use generic implementation for now
-procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
-*)
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+procedure fpc_help_constructor; assembler;compilerproc;
+asm
+end;
 
 {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
 procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; {$ifdef hascompilerproc} compilerproc; {$endif}
-assembler
+assembler;
 asm
-!!!!!!!!!!!
+{$warning FIX ME!}
+// !!!!!!!!!!!
 end;
 
 
@@ -551,7 +553,8 @@ procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; {$
 procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
 assembler;
 asm
-!!!!!!!!!!!
+{$warning FIX ME!}
+// !!!!!!!!!!!
 end;
 
 
@@ -559,7 +562,8 @@ end;
 procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
 assembler;
 asm
-!!!!!!!!!!!
+{$warning FIX ME!}
+// !!!!!!!!!!!
 end;
 
 {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
@@ -568,7 +572,8 @@ procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$
   VMT is allways at pos 0 }
 assembler;
 asm
-!!!!!!!!!!!
+{$warning FIX ME!}
+// !!!!!!!!!!!
 end;
 
 
@@ -580,11 +585,12 @@ use generic implementation for now
 procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
 *)
 
-{define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
-(*
-use generic implementation for now
-procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
-*)
+{ use generic implementation for now }
+{ that's a problem currently, the generic has a another prototy than this defined in compproc.inc (FK) }
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+procedure fpc_check_object_ext; compilerproc;assembler;
+asm
+end;
 
 {****************************************************************************
                                  String
@@ -645,8 +651,8 @@ LShortStrCopyLoop:
         bdnz    LShortStrCopyLoop
 end ['r0','r3','r4','r5','r10','cr0','ctr'];
 
-
-function fpc_shortstr_concat(const s1: shortstring): shortstring; compilerproc;
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+function fpc_shortstr_concat(const s1,s2: shortstring): shortstring; compilerproc;
 { expects that results (r3) contains a pointer to the current string and s1 }
 { (r4) a pointer to the one that has to be concatenated                     }
 assembler;
@@ -743,21 +749,24 @@ function strlen(p:pchar):longint;assembler;
 {$define FPC_SYSTEM_HAS_GET_FRAME}
 function get_frame:longint;assembler;
 asm
-        !!!!!!! depends on ABI !!!!!!!!
+    {$warning FIX ME!}
+    //    !!!!!!! depends on ABI !!!!!!!!
 end ['r3'];
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
 function get_caller_addr(framebp:longint):longint;assembler;
 asm
-        !!!!!!! depends on ABI !!!!!!!!
+   {$warning FIX ME!}
+    //     !!!!!!! depends on ABI !!!!!!!!
 end ['r3'];
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
 function get_caller_frame(framebp:longint):longint;assembler;
 asm
-        !!!!!!! depends on ABI !!!!!!!!
+    {$warning FIX ME!}
+   //     !!!!!!! depends on ABI !!!!!!!!
 end ['r3'];
 
 {$define FPC_SYSTEM_HAS_ABS_LONGINT}
@@ -826,6 +835,7 @@ LDecLockedLoop:
 end ['r3','r10'];
 
 procedure inclocked(var l : longint);assembler;
+asm
 LIncLockedLoop:
 {$ifdef MT}
     lwarx   r10,0,r3
@@ -842,7 +852,11 @@ end ['r3','r10'];
 
 {
   $Log$
-  Revision 1.8  2002-07-26 15:45:56  florian
+  Revision 1.9  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.8  2002/07/26 15:45:56  florian
     * changed multi threading define: it's MT instead of MTRTL
 
   Revision 1.7  2001/09/28 13:28:49  jonas
@@ -876,5 +890,4 @@ end ['r3','r10'];
 
   Revision 1.1  2000/07/27 07:32:12  jonas
     + initial version by Casey Duncan (not yet thoroughly debugged or complete)
-
 }

+ 23 - 0
rtl/powerpc/rttip.inc

@@ -0,0 +1,23 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    Implementation of processor optimized RTTI code
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{
+  $Log$
+  Revision 1.1  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+}

+ 9 - 4
rtl/powerpc/set.inc

@@ -193,7 +193,8 @@ Lset_range_exit:
 end ['r0','r3','r4','r5','r6','r9','r10','cr0','ctr'];
 
 
-function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;assembler;[public,alias:'FPC_SET_IN_BYTE'];
+{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;
 {
   tests if the element b is in the set p, the **zero** flag is cleared if it's present
 
@@ -319,7 +320,7 @@ asm
        sub.     r0,r0,r10
        bdnzt    cr0*4+eq,LMCOMPSETS1
        cntlzw   r3,r0
-       srwi.    r3,r3,31 
+       srwi.    r3,r3,31
 end ['r0','r3','r4','r10','cr0','ctr'];
 
 function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc;
@@ -339,7 +340,7 @@ asm
        andc.    r0,r0,r10
        bdnzt    cr0*4+eq,LMCONTAINSSETS1
        cntlzw   r3,r0
-       srwi.    r3,r3,31 
+       srwi.    r3,r3,31
 end ['r0','r3','r4','r10','cr0','ctr'];
 
 
@@ -509,7 +510,11 @@ end;
 
 {
   $Log$
-  Revision 1.10  2001-09-28 13:27:02  jonas
+  Revision 1.11  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.10  2001/09/28 13:27:02  jonas
     * use rlwnm instead of slw, because, although the programming
       environments manual states otherwise, slw uses the whole contents of
       the register instead of bits 27-31 as shift count (rlwnm doesn't)

+ 23 - 0
rtl/powerpc/setjump.inc

@@ -0,0 +1,23 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    SetJmp and LongJmp implementation for exception handling
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{
+  $Log$
+  Revision 1.1  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+}

+ 10 - 2
rtl/unix/sysunix.inc

@@ -145,6 +145,8 @@ asm
 end['A0','D0'];
 {$endif m68k}
 {$ifndef fpc_getheapstart_ok}
+asm
+end;
 {$error Getheapstart code is not implemented }
 {$endif not fpc_getheapstart_ok}
 
@@ -164,6 +166,8 @@ asm
 end ['D0'];
 {$endif m68k}
 {$ifndef fpc_getheapsize_ok}
+asm
+end;
 {$error Getheapsize code is not implemented }
 {$endif not fpc_getheapsize_ok}
 
@@ -750,7 +754,7 @@ Begin
   IsLibrary := FALSE;
   StackBottom := Sptr - StackLength;
 { Set up signals handlers }
-   InstallSignals;
+  InstallSignals;
 { Setup heap }
   InitHeap;
   InitExceptions;
@@ -767,7 +771,11 @@ End.
 
 {
   $Log$
-  Revision 1.22  2002-05-31 13:37:24  marco
+  Revision 1.23  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.22  2002/05/31 13:37:24  marco
    * more Renamefest
 
   Revision 1.21  2002/04/21 15:55:00  carl

+ 6 - 4
rtl/win32/activex.pp

@@ -2619,7 +2619,11 @@ end.
 
 {
   $Log$
-  Revision 1.4  2002-03-01 12:42:42  peter
+  Revision 1.5  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.4  2002/03/01 12:42:42  peter
     * fixed HASINTF
 
   Revision 1.3  2002/02/28 13:52:59  marco
@@ -2629,7 +2633,5 @@ end.
    * Merged objidl.idl translation. Most of wtypes.idl also included. Size slightly     increased.
 
   Revision 1.1  2001/08/19 21:02:02  florian
-    * fixed and added a lot of stuff to get the Jedi DX( headers
-      compiled
-
+    * fixed and added a lot of stuff to get the Jedi DX8 headers      compiled
 }

+ 8 - 1
rtl/win32/system.pp

@@ -14,6 +14,9 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$ifndef VER1_0}
+{ $define MT}
+{$endif VER1_0}
 unit {$ifdef VER1_0}SysWin32{$else}System{$endif};
 interface
 
@@ -1564,7 +1567,11 @@ end.
 
 {
   $Log$
-  Revision 1.28  2002-07-01 16:29:05  peter
+  Revision 1.29  2002-07-28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  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

+ 38 - 16
rtl/win32/thread.inc

@@ -57,14 +57,14 @@ procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_IN
      offset:=threadvarblocksize;
      inc(threadvarblocksize,size);
   end;
-  
-  
-type ltvInitEntry = 
-  record
-    varaddr : pdword;
-    size    : longint;
-  end;
-  pltvInitEntry = ^ltvInitEntry;
+
+
+type
+   ltvInitEntry = packed record
+      varaddr : pdword;
+      size    : longint;
+   end;
+   pltvInitEntry = ^ltvInitEntry;
 
 procedure init_unit_threadvars (tableEntry : pltvInitEntry);
 begin
@@ -80,10 +80,10 @@ type TltvInitTablesTable =
     count : dword;
     tables: array [1..32767] of pltvInitEntry;
   end;
-  
+
 var
   ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_LOCALTHREADVARTABLES';
-  
+
 procedure init_all_unit_threadvars; [public,alias: 'FPC_INITIALIZELOCALTHREADVARS'];
 var i : integer;
 begin
@@ -98,7 +98,13 @@ end;
 function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR'];
 
   begin
+     asm
+        pushal
+     end;
      relocate_threadvar:=TlsGetValue(dataindex)+offset;
+     asm
+        popal
+     end;
   end;
 
 procedure AllocateThreadVars;
@@ -135,8 +141,8 @@ procedure InitThread;
      { we don't need to set the data to 0 because we did this with }
      { the fillchar above, but it looks nicer                      }
 
-     { ExceptAddrStack and ExceptObjectStack are threadvars       }
-     { so every thread has its on exception handling capabilities }
+     { ExceptAddrStack and ExceptObjectStack are threadvars        }
+     { so every thread has its own exception handling capabilities }
      InitExceptions;
      InOutRes:=0;
      // ErrNo:=0;
@@ -204,21 +210,33 @@ function BeginThread(ThreadFunction : tthreadfunc) : DWord;
   end;
 
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
-
   var
      dummy : dword;
-
   begin
      BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,dummy);
   end;
 
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
   var ThreadId : DWord) : DWord;
-
   begin
      BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,ThreadId);
   end;
 
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
+  var ThreadId : Longint) : DWord;
+  begin
+     BeginThread:=BeginThread(nil,0,ThreadFunction,p,0,DWord(ThreadId));
+  end;
+
+
+function BeginThread(sa : Pointer;stacksize : dword;
+  ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
+  var ThreadId : Longint) : DWord;
+  begin
+     BeginThread:=BeginThread(sa,stacksize,ThreadFunction,p,creationflags,DWord(threadid));
+  end;
+
+
 procedure EndThread(ExitCode : DWord);
 
   begin
@@ -250,7 +268,11 @@ procedure LeaveCriticalSection(var cs : TRTLCriticalSection);
 
 {
   $Log$
-  Revision 1.8  2002-03-31 10:03:13  armin
+  Revision 1.9  2002-07-28 20:43:50  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+  Revision 1.8  2002/03/31 10:03:13  armin
   + call to DoneThread was missing
 
   Revision 1.7  2002/03/28 16:31:35  armin

+ 9 - 5
rtl/win32/wdllprt0.as

@@ -1,6 +1,5 @@
-//DLL Startup code for WIN32 port of FPK-Pascal 0.9.98
-//Written by P.Ozerski
-//16.10.1998
+// DLL Startup code for WIN32 port of Free Pascal
+// Written by P.Ozerski 16.10.1998
      .text
      .globl _mainCRTStartup
 _mainCRTStartup:
@@ -27,5 +26,10 @@ _WinMainCRTStartup:
      popl     %ebx
      popl     %ebp
      ret      $12
-
-
+//
+// $Log$
+// Revision 1.3  2002-07-28 20:43:51  florian
+//   * several fixes for linux/powerpc
+//   * several fixes to MT
+//
+//

+ 10 - 4
rtl/win32/wprt0.as

@@ -1,6 +1,5 @@
-//Startup code for WIN32 port of FPK-Pascal 0.9.98
-//Written by P.Ozerski
-//1998
+//Startup code for WIN32 port of Free Pascal
+//Written by P.Ozerski 1998
 // modified by Pierre Muller
      .text
      .globl _mainCRTStartup
@@ -11,4 +10,11 @@ _mainCRTStartup:
 _WinMainCRTStartup:
      movb   $0,U_SYSTEM_ISCONSOLE
      call   _FPC_EXE_Entry
- 
+
+//
+// $Log$
+// Revision 1.3  2002-07-28 20:43:51  florian
+//   * several fixes for linux/powerpc
+//   * several fixes to MT
+//
+//