- some writeln(s) removed in compiler

+ many files added to RTL
* some errors fixed in RTL

compiler/mppcsparc

@@ -17,6 +17,6 @@ then
     SRC_DIR=`echo "$COMP_DIR/"{,sparc,systems}":"`
     gdb -d "$SRC_DIR" --args "$COMP_DIR"/ppcsparc -s -al -Fi"$RTL_DIR"/{unix,linux,sparc,inc} -dSPARC "$@"
   else
-    "$COMP_DIR"/ppcsparc -s -al -Fi"$RTL_DIR"/{unix,linux,sparc,inc} -dSPARC "$@"
+    "$COMP_DIR"/ppcsparc -s -al -Fi"$RTL_DIR"/{unix,linux,sparc,inc,linux/sparc} -dSPARC "$@"
   fi
 fi

compiler/sparc/cpupi.pas

@@ -79,9 +79,6 @@ procedure TSparcProcInfo.after_pass1;
         else
           procdef.localst.address_fixup:=parast.address_fixup+6*4;
 		    firsttemp_offset:=localst.address_fixup+localst.datasize;
-	      WriteLn('Parameter copies start at: %i6+'+tostr(parast.address_fixup));
-    		WriteLn('Locals start at: %o6+'+tostr(localst.address_fixup));
-	      WriteLn('Temp. space start: %o6+'+tostr(firsttemp_offset));
         with tg do
           begin
         		FirstTemp:=firsttemp_offset;
@@ -94,7 +91,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2002-12-21 23:21:47  mazen
+  Revision 1.10  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.9  2002/12/21 23:21:47  mazen
   + added support for the shift nodes
   + added debug output on screen with -an command line option
 

rtl/linux/signal.inc

@@ -138,6 +138,12 @@ type
     { dummy for now PM }
   end;
 {$endif powerpc}
+{$ifdef SPARC}
+  PSigContextRec = ^SigContextRec;
+  SigContextRec = record
+    { dummy for now PM }
+  end;
+{$endif SPARC}
 
 (*
   PSigInfoRec = ^SigInfoRec;
@@ -218,7 +224,12 @@ type
 
 {
   $Log$
-  Revision 1.8  2002-12-18 16:43:26  marco
+  Revision 1.9  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.8  2002/12/18 16:43:26  marco
    * new unix rtl, linux part.....
 
   Revision 1.7  2002/11/12 14:51:44  marco

rtl/linux/sparc/syscall.inc

@@ -34,45 +34,45 @@ Type
                      --- Main:The System Call Self ---
 *****************************************************************************}
 
-function Do_SysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+function Do_SysCall(sysnr:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL1'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   sc
   bnslr
   neg   r3, r3
   lis   r4,Errno@ha
   stw   r3,Errno@l(r4)
-  li    r3,-1
+  li    r3,-1}
 end;
 
-function Do_SysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL1'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   mr  r3,r4   
   sc
   bnslr
   neg   r3, r3
   lis   r4,Errno@ha
   stw   r3,Errno@l(r4)
-  li    r3,-1
+  li    r3,-1}
 end;
 
 
-function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL2'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   mr  r3,r4   
   mr  r4,r5
   sc
@@ -80,16 +80,16 @@ asm
    neg   r3, r3
    lis   r4,Errno@ha
    stw   r3,Errno@l(r4)
-   li    r3,-1
+   li    r3,-1}
 end;
 
-function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL3'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   mr  r3,r4   
   mr  r4,r5
   mr  r5,r6
@@ -98,18 +98,18 @@ asm
    neg   r3, r3
    lis   r4,Errno@ha
    stw   r3,Errno@l(r4)
-   li    r3,-1
+   li    r3,-1}
 
 end;
 
 
-function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL4'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   mr  r3,r4   
   mr  r4,r5
   mr  r5,r6
@@ -119,16 +119,16 @@ asm
    neg   r3, r3
    lis   r4,Errno@ha
    stw   r3,Errno@l(r4)
-   li    r3,-1
+   li    r3,-1}
 end;
 
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {assembler;}[public,alias:'FPC_SYSCALL5'];
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
-  mr  r0,r3
+begin{asm}
+{  mr  r0,r3
   mr  r3,r4   
   mr  r4,r5
   mr  r5,r6
@@ -139,20 +139,20 @@ asm
    neg   r3, r3
    lis   r4,Errno@ha
    stw   r3,Errno@l(r4)
-   li    r3,-1
+   li    r3,-1}
 end;
 
 // Old style syscall:
 // Better use ktrace/strace/gdb for debugging.
 
-Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );assembler;
+Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );{assembler;}
 {
   This function puts the registers in place, does the call, and then
   copies back the registers as they are after the SysCall.
 }
-asm
+begin{asm}
 { load the registers... }
-  lwz  r5, 12(r4)
+(*  lwz  r5, 12(r4)
   lwz  r6, 16(r4)
   lwz  r7, 20(r4)
   mr   r0, r3
@@ -168,7 +168,7 @@ asm
   stw    r4, 4(r8)
   stw    r5, 8(r8)
   stw    r6, 12(r8)
-  stw    r7, 16(r8)
+  stw    r7, 16(r8)*)
 end;
 
 {$IFDEF SYSCALL_DEBUG}
@@ -227,7 +227,12 @@ end;
 
 {
   $Log$
-  Revision 1.1  2002-11-15 12:08:37  mazen
+  Revision 1.2  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.1  2002/11/15 12:08:37  mazen
   + SPARC support added based on PowerPc sources
 
   Revision 1.1  2002/11/09 20:32:14  marco
@@ -237,4 +242,4 @@ end;
     * syscall moved into seperate include
 
 }
- 
+ 

rtl/linux/sparc/syscallh.inc

@@ -0,0 +1,68 @@
+{
+    $Id$
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for powerpc *nix.
+
+    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.
+
+ ****************************************************************************
+
+}
+
+Type
+
+  TSysResult = longint; // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+{$ifdef notsupported}
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+{$endif notsupported}
+
+{
+  $Log$
+  Revision 1.1  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.1  2002/12/22 16:00:28  jonas
+    + added syscallh.inc, adapted syscall.inc
+
+  Revision 1.3  2002/12/18 20:41:33  peter
+    * Threadvar support for Errno
+    * Fixed syscall error return check
+    * Uncommented Syscall with 6 parameters, only 5 were really set
+
+  Revision 1.2  2002/12/18 16:46:37  marco
+   * Some mods.
+
+  Revision 1.1  2002/11/16 15:37:47  marco
+   * TSysParam + result moved to -h
+
+}

rtl/sparc/math.inc

@@ -0,0 +1,327 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    Implementation of mathamatical Routines (only for real)
+
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                       EXTENDED data type routines
+ ****************************************************************************}
+
+    {$define FPC_SYSTEM_HAS_PI}
+    function pi : double;[internproc:in_pi];
+
+    {$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);
+      end;
+
+    function ln(d : extended) : extended;[internconst:in_ln_extended];
+      begin
+        runerror(207);
+      end;
+
+    function sin(d : extended) : extended;[internconst: in_sin_extended];
+      begin
+        runerror(207);
+      end;
+
+    function cos(d : extended) : extended;[internconst:in_cos_extended];
+      begin
+        runerror(207);
+      end;
+
+    function exp(d : extended) : extended;[internconst:in_const_exp];
+      begin
+        runerror(207);
+      end;
+
+
+    function frac(d : extended) : extended;[internconst:in_const_frac];
+      begin
+        runerror(207);
+      end;
+
+
+    }
+    {$define FPC_SYSTEM_HAS_INT}
+    {$warning FIX ME}
+    function int(d : extended) : extended;[internconst:in_const_int];
+      begin
+        runerror(207);
+      end;
+
+
+    {$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;}
+      var
+        temp: packed record
+            case byte of
+              0: (l1,l2: longint);
+              1: (d: double);
+          end;
+      begin{asm}
+{        fctiwz   f1,f1
+        stfd     f1,temp
+        lwz      r3,temp
+        lwz      r4,4+temp}
+      end{ ['R3','F1']};
+
+
+    {$define FPC_SYSTEM_HAS_ROUND}
+    function round(d : extended) : int64;{assembler;}[internconst:in_const_round];
+      { input: d in fr1      }
+      { output: result in r3 }
+      {assembler;}
+      var
+        temp : packed record
+            case byte of
+              0: (l1,l2: longint);
+              1: (d: double);
+          end;
+      begin{asm}
+  {      fctiw    f1,f1
+        stfd     f1,temp
+        lwz      r3,temp
+        lwz      r4,4+temp}
+      end{ ['R3','F1']};
+
+
+   {$define FPC_SYSTEM_HAS_POWER}
+   function power(bas,expo : extended) : extended;
+     begin
+        if bas=0 then
+          begin
+            if expo<>0 then
+              power:=0.0
+            else
+              HandleError(207);
+          end
+        else if expo=0 then
+         power:=1
+        else
+        { bas < 0 is not allowed }
+         if bas<0 then
+          handleerror(207)
+         else
+          power:=exp(ln(bas)*expo);
+     end;
+
+
+{****************************************************************************
+                       Longint data type routines
+ ****************************************************************************}
+
+   function power(bas,expo : longint) : longint;
+     begin
+        if bas=0 then
+          begin
+            if expo<>0 then
+              power:=0
+            else
+              HandleError(207);
+          end
+        else if expo=0 then
+         power:=1
+        else
+         begin
+           if bas<0 then
+            begin
+              if odd(expo) then
+                power:=-round(exp(ln(-bas)*expo))
+              else
+                power:=round(exp(ln(-bas)*expo));
+            end
+           else
+            power:=round(exp(ln(bas)*expo));
+         end;
+     end;
+
+{****************************************************************************
+                    Helper routines to support old TP styled reals
+ ****************************************************************************}
+
+    { 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
+         res : array[0..7] of byte;
+         exponent : word;
+
+      begin
+         { copy mantissa }
+         res[6]:=0;
+         res[5]:=r[1] shl 5;
+         res[4]:=(r[1] shr 3) or (r[2] shl 5);
+         res[3]:=(r[2] shr 3) or (r[3] shl 5);
+         res[2]:=(r[3] shr 3) or (r[4] shl 5);
+         res[1]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
+         res[0]:=(r[5] and $7f) shr 3;
+
+         { copy exponent }
+         { correct exponent: }
+         exponent:=(word(r[0])+(1023-129));
+         res[1]:=res[1] or ((exponent and $f) shl 4);
+         res[0]:=exponent shr 4;
+
+         { set sign }
+         res[0]:=res[0] or (r[5] and $80);
+         real2double:=double(res);
+      end;
+
+
+{****************************************************************************
+                         Int to real helpers
+ ****************************************************************************}
+
+const
+  longint_to_real_helper: int64 = $4330000080000000;
+  cardinal_to_real_helper: int64 = $430000000000000;
+  int_to_real_factor: double = double(high(cardinal))+1.0;
+
+function fpc_int64_to_double(i: int64): double; compilerproc;
+{assembler;}
+{ input: high(i) in r3, low(i) in r4 }
+{ output: double(i) in f0            }
+var
+  temp: packed record
+      case byte of
+        0: (l1,l2: cardinal);
+        1: (d: double);
+    end;
+begin{asm}
+(*           lis    r0,0x4330
+           stw    r0,temp
+           xoris  r3,r3,0x8000
+           stw    r3,4+temp
+           {$ifndef macos}
+           lis    r3,longint_to_real_helper@ha
+           lfd    f1,longint_to_real_helper@l(r3)
+           {$else}
+           lfd    f1,longint_to_real_helper(r2)
+           {$endif}
+           lfd    f0,temp
+           stw    r4,4+temp
+           fsub   f0,f0,f1
+           {$ifndef macos}
+           lis    r4,cardinal_to_real_helper@ha
+           lfd    f1,cardinal_to_real_helper@l(r4)
+           lis    r3,int_to_real_factor@ha
+           lfd    f3,temp
+           lfd    f2,int_to_real_factor@l(r3)
+           {$else}
+           lfd    f1,cardinal_to_real_helper(r2)
+           lfd    f3,temp
+           lfd    f2,int_to_real_factor(r2)
+           {$endif}
+           fsub   f3,f3,f1
+           fmadd  f1,f0,f2,f3*)
+end{ ['R0','R3','R4','F0','F1','F2','F3']};
+
+
+function fpc_qword_to_double(q: qword): double; compilerproc;
+{assembler;}
+{ input: high(q) in r3, low(q) in r4 }
+{ output: double(q) in f0            }
+var
+  temp: packed record
+      case byte of
+        0: (l1,l2: cardinal);
+        1: (d: double);
+    end;
+begin{asm}
+(*           lis    r0,0x4330
+           stw    r0,temp
+           stw    r3,4+temp
+           lfd    f0,temp
+           {$ifndef macos}
+           lis    r3,cardinal_to_real_helper@ha
+           lfd    f1,cardinal_to_real_helper@l(r3)
+           {$else}
+           lfd    f1,cardinal_to_real_helper(r2)
+           {$endif}
+           stw    r4,4+temp
+           fsub   f0,f0,f1
+           lfd    f3,temp
+           {$ifndef macos}
+           lis    r3,int_to_real_factor@ha
+           lfd    f2,int_to_real_factor@l(r3)
+           {$else}
+           lfd    f2,int_to_real_factor(r2)
+           {$endif}
+           fsub   f3,f3,f1
+           fmadd  f1,f0,f2,f3*)
+end{ ['R0','R3','F0','F1','F2','F3']};
+
+
+{
+  $Log$
+  Revision 1.1  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.14  2002/11/28 11:04:16  olle
+    * macos: refs to globals in begin{asm} adapted to macos
+
+  Revision 1.13  2002/10/21 18:08:28  jonas
+    * round has int64 instead of longint result
+
+  Revision 1.12  2002/09/08 13:00:21  jonas
+    * made pi an internproc instead of internconst
+
+  Revision 1.11  2002/09/07 16:01:26  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.10  2002/08/18 22:11:10  florian
+    * fixed remaining assembler errors
+
+  Revision 1.9  2002/08/18 21:37:48  florian
+    * several errors in inline assembler fixed
+
+  Revision 1.8  2002/08/10 17:14:36  jonas
+    * various fixes, mostly changing the names of the modifies registers to
+      upper case since that seems to be required by the compiler
+
+  Revision 1.7  2002/07/31 16:58:12  jonas
+    * fixed conversion from int64/qword to double errors
+
+  Revision 1.6  2002/07/29 21:28:17  florian
+    * several fixes to get further with linux/ppc system unit compilation
+
+  Revision 1.5  2002/07/28 21:39:29  florian
+    * made abs a compiler proc if it is generic
+
+  Revision 1.4  2002/07/28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+}

rtl/sparc/set.inc

@@ -0,0 +1,551 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Include file with set operations called by the compiler
+
+    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.
+
+ **********************************************************************}
+
+{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
+{
+  load a normal set p from a smallset l
+
+  on entry: p in r3, l in r4
+}
+begin{asm}
+{        stw     r4,0(r3)
+        li      r0,0
+        stw     r0,4(r3)
+        stw     r0,8(r3)
+        stw     r0,12(r3)
+        stw     r0,16(r3)
+        stw     r0,20(r3)
+        stw     r0,24(r3)
+        stw     r0,28(r3)}
+end{ ['R0']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+{ checked 2001/09/28 (JM) }
+function fpc_set_create_element(b : byte): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_CREATE_ELEMENT']; compilerproc;
+{
+  create a new set in p from an element b
+
+  on entry: pointer to result in r3, b in r4
+}
+begin{asm}
+{        li      r0,0
+        stw     r0,0(r3)
+        stw     r0,4(r3)
+        stw     r0,8(r3)
+        stw     r0,12(r3)
+        stw     r0,16(r3)
+        stw     r0,20(r3)
+        stw     r0,24(r3)
+        stw     r0,28(r3)
+
+        // r0 := 1 shl r4[27-31] -> bit index in dword (rotate instructions
+        // with count in register only consider lower 5 bits of this register)
+        li      r0,1
+        rlwnm   r0,r0,r4,0,31
+
+        // get the index of the correct *dword* in the set
+        // (((b div 8) div 4)*4= (b div 8) and not(3))
+        // r5 := (r4 rotl(32-3)) and (0x01ffffff8)
+        rlwinm  r4,r4,31-3+1,3,31-2
+
+        // store the result
+        stwx    r0,r3,r4}
+end{ ['R0','R4','R10']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;{assembler;} compilerproc;
+{
+  add the element b to the set pointed by p
+
+  on entry: result in r3, source in r4, b in r5
+}
+begin{asm}
+{       // copy source to result
+       li       r0,8
+       mtctr    r0
+       subi     r4,r4,4
+       subi     r3,r3,4
+Lset_set_byte_copy:
+       lwzu     r0,4(r4)
+       stwu     r0,4(r3)
+       bdnz     Lset_set_byte_copy
+       subi     r3,r3,32
+       // get the index of the correct *dword* in the set
+       // r0 := (r5 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r5,31-3+1,3,31-2
+       // load dword in which the bit has to be set (and update r3 to this address)
+       lwzux    r4,r3,r0
+       li       r0,1
+       // generate bit which has to be inserted
+       // (can't use rlwimi, since that one only works for constants)
+       slw      r5,r0,r5
+       // insert it
+       or       r5,r4,r5
+       // store result
+       stw      r5,0(r3)}
+end{ ['R0','R3','R4','R5','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;{assembler;} compilerproc;
+{
+  suppresses the element b to the set pointed by p
+  used for exclude(set,element)
+
+  on entry: p in r3, b in r4
+}
+begin{asm}
+{       // copy source to result
+       li       r0,8
+       mtctr    r0
+       subi     r4,r4,4
+       subi     r3,r3,4
+Lset_unset_byte_copy:
+       lwzu     r0,4(r4)
+       stwu     r0,4(r3)
+       bdnz     Lset_unset_byte_copy
+       subi     r3,r3,32
+       // get the index of the correct *dword* in the set
+       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r5,31-3+1,3,31-2
+       // load dword in which the bit has to be set (and update r3 to this address)
+       lwzux    r4,r3,r0
+       li       r0,1
+       // generate bit which has to be removed
+       rlwnm    r5,r0,r5,0,31
+       // remove it
+       andc     r5,r4,r5
+       // store result
+       stw      r4,0(r3)}
+end{ ['R0','R3','R4','R5','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;{assembler;} compilerproc;
+{
+  on entry: result in r3, l in r4, h in r5
+
+  on entry: result in r3, ptr to orgset in r4, l in r5, h in r6
+}
+begin{asm}
+{  // copy source to result
+  li       r0,8
+  mtctr    r0
+  subi     r4,r4,4
+  subi     r3,r3,4
+Lset_set_range_copy:
+  lwzu     r0,4(r4)
+  stwu     r0,4(r3)
+  bdnz     Lset_set_range_copy
+  subi     r3,r3,32
+
+  cmplw  cr0,r5,r6
+  bgt    cr0,Lset_range_exit
+  rlwinm r4,r5,31-3+1,3,31-2  // divide by 8 to get starting and ending byte-}
+  { load the set the data cache }
+{  dcbst  r3,r4
+  rlwinm r9,r6,31-3+1,3,31-2  // address and clear two lowest bits to get
+                              //  start/end longint address
+  sub.   r9,r4,r9             // are bit lo and hi in the same longint?
+  rlwinm r6,r6,0,31-5+1,31    // hi := hi mod 32 (= "hi and 31", but the andi
+                              //  instr. only exists in flags modifying form)
+  li     r10,-1               // r10 = $0x0ffffffff = bitmask to be inserted
+  subfic r6,r6,31             // hi := 31 - (hi mod 32) = shift count for later
+  srw    r10,r10,r4           // shift bitmask to clear bits below lo
+                              // note: shift right = opposite little endian!!
+  lwzux  r5,r3,r4             // go to starting pos in set and load value
+                              //  (lo is not necessary anymore)
+  beq    Lset_range_hi        // if bit lo and hi in same longint, keep
+                              //  current mask and adjust for hi bit
+  subic. r9,r9,4              // bit hi in next longint?
+  or     r5,r5,r10            // merge and
+  stw    r5,0(r3)             // store current mask
+  li     r10,-1               // new mask
+  lwzu   r5,4(r3)             // load next longint of set
+  beq    Lset_range_hi        // bit hi in this longint -> go to adjust for hi
+Lset_range_loop:
+  subic. r9,r9,4
+  stwu   r10,4(r3)            // fill longints in between with full mask
+  bne    Lset_range_loop
+  lwzu   r5,4(r3)             // load next value from set
+Lset_range_hi:                // in all cases, r3 here contains the address of
+                              //  the longint which contains the hi bit and r4
+                              //  contains this longint
+  slw    r9,r10,r6            // r9 := bitmask shl (31 - (hi mod 32)) =
+                              //  bitmask with bits higher than hi cleared
+                              //  (r8 = $0xffffffff unless the first beq was
+                              //   taken)
+  and    r10,r9,r10           // combine lo and hi bitmasks for this longint
+  or     r5,r5,r10            // and combine with existing set
+  stw    r5,0(r3)             // store to set
+Lset_range_exit:}
+end{ ['R0','R3','R4','R5','R6','R9','R10','CR0','CTR']};
+
+
+{$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
+
+  on entry: p in r3, b in r4
+}
+begin{asm}
+{       // get the index of the correct *dword* in the set
+       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r4,31-3+1,3,31-2
+       // load dword in which the bit has to be tested
+       lwzx     r3,r3,r0
+
+       li       r0,1
+       // generate bit which has to be tested
+       rlwnm    r4,r0,r4,0,31
+       // test it
+       and.     r3,r3,r4}
+end{ ['R0','R3','R4','CR0']};
+
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+{
+  adds set1 and set2 into set dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+begin{asm}
+       {  load the begin of the result set in the data cache }
+{       dcbst    0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   LMADDSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      or        r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      LMADDSETS1}
+end{ ['R0','R3','R4','R5','R10','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+{
+  multiplies (takes common elements of) set1 and set2 result put in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+begin{asm}
+       {  load the begin of the result set in the data cache }
+{       dcbst    0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   LMMULSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      and       r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      LMMULSETS1}
+end{ ['R0','R3','R4','R5','R10','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+{
+  computes the diff from set1 to set2 result in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+begin{asm}
+       {  load the begin of the result set in the data cache }
+{       dcbst    0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   LMSUBSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      andc      r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      LMSUBSETS1}
+end{ ['R0','R3','R4','R5','R10','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;{assembler;}[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+{
+   computes the symetric diff from set1 to set2 result in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+begin{asm}
+       {  load the begin of the result set in the data cache }
+{       dcbst    0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   LMSYMDIFSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      xor       r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      LMSYMDIFSETS1}
+end{ ['R0','R3','R4','R5','R10','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean;{assembler;}[public,alias:'FPC_SET_COMP_SETS']; compilerproc;
+{
+  compares set1 and set2 zeroflag is set if they are equal
+  on entry: set1 in r3, set2 in r4
+}
+begin{asm}
+{       li       r0,8
+       mtctr    r0
+       subi     r3,r3,4
+       subi     r4,r4,4
+    LMCOMPSETS1:
+       lwzu     r0,4(r3)
+       lwzu     r10,4(r4)
+       sub.     r0,r0,r10
+       bdnzt    cr0*4+eq,LMCOMPSETS1
+       cntlzw   r3,r0
+       srwi.    r3,r3,5}
+end{ ['R0','R3','R4','R10','CR0','CTR']};
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;{assembler;}[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc;
+{
+  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+  on entry: set1 in r3, set2 in r4
+}
+begin{asm}
+{       li       r0,8
+       mtctr    r0
+       subi     r3,r3,4
+       subi     r4,r4,4
+    LMCONTAINSSETS1:
+       lwzu     r0,4(r3)
+       lwzu     r10,4(r4)}
+       { set1 and not(set2) = 0? }
+{       andc.    r0,r0,r10
+       bdnzt    cr0*4+eq,LMCONTAINSSETS1
+       cntlzw   r3,r0
+       srwi.    r3,r3,5}
+end{ ['R0','R3','R4','R10','CR0','CTR']};
+
+
+
+{$ifdef LARGESETS}
+
+procedure do_set(p : pointer;b : word);{assembler;}[public,alias:'FPC_SET_SET_WORD'];
+{
+  sets the element b in set p works for sets larger than 256 elements
+  not yet use by the compiler so
+}
+begin{asm}
+{       pushl %eax
+       movl p,%edi
+       movw b,%ax
+       andl $0xfff8,%eax
+       shrl $3,%eax
+       addl %eax,%edi
+       movb 12(%ebp),%al
+       andl $7,%eax
+       btsl %eax,(%edi)
+       popl %eax}
+end;
+
+
+procedure do_in(p : pointer;b : word);{assembler;}[public,alias:'FPC_SET_IN_WORD'];
+{
+  tests if the element b is in the set p the carryflag is set if it present
+  works for sets larger than 256 elements
+}
+begin{asm}
+{        pushl %eax
+        movl p,%edi
+        movw b,%ax
+        andl $0xfff8,%eax
+        shrl $3,%eax
+        addl %eax,%edi
+        movb 12(%ebp),%al
+        andl $7,%eax
+        btl %eax,(%edi)
+        popl %eax}
+end;
+
+
+procedure add_sets(set1,set2,dest : pointer;size : longint);{assembler;}[public,alias:'FPC_SET_ADD_SETS_SIZE'];
+{
+  adds set1 and set2 into set dest size is the number of bytes in the set
+}
+begin{asm}
+{      movl set1,%esi
+      movl set2,%ebx
+      movl dest,%edi
+      movl size,%ecx
+  LMADDSETSIZES1:
+      lodsl
+      orl (%ebx),%eax
+      stosl
+      addl $4,%ebx
+      decl %ecx
+      jnz LMADDSETSIZES1}
+end;
+
+
+procedure mul_sets(set1,set2,dest : pointer;size : longint);{assembler;}[public,alias:'FPC_SET_MUL_SETS_SIZE'];
+{
+  multiplies (i.E. takes common elements of) set1 and set2 result put in
+  dest size is the number of bytes in the set
+}
+begin{asm}
+{         movl set1,%esi
+         movl set2,%ebx
+         movl dest,%edi
+         movl size,%ecx
+     LMMULSETSIZES1:
+         lodsl
+         andl (%ebx),%eax
+         stosl
+         addl $4,%ebx
+         decl %ecx
+         jnz LMMULSETSIZES1}
+end;
+
+
+procedure sub_sets(set1,set2,dest : pointer;size : longint);{assembler;}[public,alias:'FPC_SET_SUB_SETS_SIZE'];
+begin{asm}
+{         movl set1,%esi
+         movl set2,%ebx
+         movl dest,%edi
+         movl size,%ecx
+     LMSUBSETSIZES1:
+         lodsl
+         movl (%ebx),%edx
+         notl %edx
+         andl %edx,%eax
+         stosl
+         addl $4,%ebx
+         decl %ecx
+         jnz LMSUBSETSIZES1}
+end;
+
+
+procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);{assembler;}[public,alias:'FPC_SET_SYMDIF_SETS_SIZE'];
+{
+   computes the symetric diff from set1 to set2 result in dest
+}
+begin{asm}
+{      movl set1,%esi
+      movl set2,%ebx
+      movl dest,%edi
+      movl size,%ecx
+  LMSYMDIFSETSIZE1:
+      lodsl
+      movl (%ebx),%edx
+      xorl %edx,%eax
+      stosl
+      addl $4,%ebx
+      decl %ecx
+      jnz LMSYMDIFSETSIZE1}
+end;
+
+
+procedure comp_sets(set1,set2 : pointer;size : longint);{assembler;}[public,alias:'FPC_SET_COMP_SETS_SIZE'];
+begin{asm}
+{      movl set1,%esi
+      movl set2,%edi
+      movl size,%ecx
+  LMCOMPSETSIZES1:
+      lodsl
+      movl (%edi),%edx
+      cmpl %edx,%eax
+      jne  LMCOMPSETSIZEEND
+      addl $4,%edi
+      decl %ecx
+      jnz LMCOMPSETSIZES1}
+      { we are here only if the two sets are equal
+        we have zero flag set, and that what is expected }
+{  LMCOMPSETSIZEEND:}
+end;
+
+{$IfNDef NoSetInclusion}
+procedure contains_sets(set1,set2 : pointer; size: longint);{assembler;}[public,alias:'FPC_SET_CONTAINS_SETS'];
+{
+  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+}
+begin{asm}
+{        movl set1,%esi
+        movl set2,%edi
+        movl size,%ecx
+    LMCONTAINSSETS2:
+        movl (%esi),%eax
+        movl (%edi),%edx
+        andl %eax,%edx
+        cmpl %edx,%eax}  {set1 and set2 = set1?}
+{        jne  LMCONTAINSSETEND2
+        addl $4,%esi
+        addl $4,%edi
+        decl %ecx
+        jnz LMCONTAINSSETS2}
+        { we are here only if set2 contains set1
+          we have zero flag set, and that what is expected }
+{    LMCONTAINSSETEND2:}
+end;
+{$EndIf NoSetInclusion}
+
+
+{$endif LARGESET}
+
+{
+  $Log$
+  Revision 1.1  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.16  2002/10/17 10:14:46  jonas
+    * fixed srwi's after cntlzw instructions (should be 5 instead of 31)
+
+  Revision 1.15  2002/09/07 16:01:26  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.14  2002/08/18 22:11:10  florian
+    * fixed remaining assembler errors
+
+  Revision 1.13  2002/08/18 21:37:48  florian
+    * several errors in inline assembler fixed
+
+  Revision 1.12  2002/08/10 17:14:36  jonas
+    * various fixes, mostly changing the names of the modifies registers to
+      upper case since that seems to be required by the compiler
+
+  Revision 1.11  2002/07/28 20:43:49  florian
+    * several fixes for linux/powerpc
+    * several fixes to MT
+
+}

rtl/sparc/setjump.inc

@@ -16,19 +16,24 @@
  **********************************************************************}
 
 { the necessary code can be copied from the linux kernel sources }
-function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
-  asm
+function setjmp(var S : jmp_buf) : longint;{assembler;}[Public, alias : 'FPC_SETJMP'];
+  begin{asm}
     {$warning FIXME!!!!}
   end;
 
-procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];
-  asm
+procedure longjmp(var S : jmp_buf;value : longint);{assembler;}[Public, alias : 'FPC_LONGJMP'];
+  begin{asm}
     {$warning FIXME!!!!}
   end;
 
 {
   $Log$
-  Revision 1.2  2002-11-24 18:19:44  mazen
+  Revision 1.3  2002-12-24 21:30:20  mazen
+  - some writeln(s) removed in compiler
+  + many files added to RTL
+  * some errors fixed in RTL
+
+  Revision 1.2  2002/11/24 18:19:44  mazen
   + setjmp and longjmp
 
   Revision 1.1  2002/11/16 20:10:31  florian