paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

- some writeln(s) removed in compiler

Browse Source 
+ many files added to RTL
* some errors fixed in RTL
This commit is contained in:
mazen 2002-12-24 21:30:20 +00:00
parent 9f00031530
commit 311508131a
8 changed files with 1010 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/mppcsparc
View File

@ -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

10
compiler/sparc/cpupi.pas
View File

@ -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

13
rtl/linux/signal.inc
View File

@ -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

65
rtl/linux/sparc/syscall.inc
View File

@ -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
}

68
rtl/linux/sparc/syscallh.inc Normal file
View File

@ -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
}

327
rtl/sparc/math.inc Normal file
View File

@ -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
}

551
rtl/sparc/set.inc Normal file
View File

@ -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
}

15
rtl/sparc/setjump.inc
View File

@ -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