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

+ MIPS specific part of the rtl, by David Zhang

Browse Source 
git-svn-id: trunk@14255 -
This commit is contained in:
florian 2009-11-22 18:35:03 +00:00
parent 01ed4a6745
commit 38c68b58aa
9 changed files with 625 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitattributes vendored
View File

@ -6632,6 +6632,14 @@ rtl/macos/sysos.inc svneol=native#text/plain
rtl/macos/sysosh.inc svneol=native#text/plain
rtl/macos/system.pp svneol=native#text/plain
rtl/macos/sysutils.pp svneol=native#text/plain
rtl/mips/int64p.inc svneol=native#text/plain
rtl/mips/math.inc svneol=native#text/plain
rtl/mips/mipsel.inc svneol=native#text/plain
rtl/mips/set.inc svneol=native#text/plain
rtl/mips/setjump.inc svneol=native#text/plain
rtl/mips/setjumph.inc svneol=native#text/plain
rtl/mips/strings.inc svneol=native#text/plain
rtl/mips/stringss.inc svneol=native#text/plain
rtl/morphos/Makefile svneol=native#text/plain
rtl/morphos/Makefile.fpc svneol=native#text/plain
rtl/morphos/aboxlib.pas -text svneol=unset#text/plain

14
rtl/mips/int64p.inc Normal file
View File

@ -0,0 +1,14 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
This file contains some helper routines for int64 and qword
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.
**********************************************************************}

60
rtl/mips/math.inc Normal file
View File

@ -0,0 +1,60 @@
{
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.
**********************************************************************}
{$ifdef INTERNCONSTINTF}
{$ifndef FPC_SYSTEM_HAS_ABS}
{$define FPC_SYSTEM_HAS_ABS}
function fpc_abs_real(d : valreal) : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$endif}
{$ifndef FPC_SYSTEM_HAS_SQR}
{$define FPC_SYSTEM_HAS_SQR}
function fpc_sqr_real(d : valreal) : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$endif}
{$ifndef FPC_SYSTEM_HAS_SQRT}
{$define FPC_SYSTEM_HAS_SQRT}
function fpc_sqrt_real(d : valreal) : valreal;compilerproc;
begin
{ Function is handled internal in the compiler }
runerror(207);
result:=0;
end;
{$endif}
{$else}
{$define FPC_SYSTEM_HAS_ABS}
function abs(d : extended) : extended;[internproc:fpc_in_abs_real];
{$define FPC_SYSTEM_HAS_SQR}
function sqr(d : extended) : extended;[internproc:fpc_in_sqr_real];
{$define FPC_SYSTEM_HAS_SQRT}
function sqrt(d : extended) : extended;[internproc:fpc_in_sqrt_real];
{$endif}

419
rtl/mips/mipsel.inc Normal file
View File

@ -0,0 +1,419 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2006-2007 by David Zhang
Processor dependent implementation for the system unit for MIPS
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.
**********************************************************************}
{****************************************************************************
MIPS specific stuff
****************************************************************************}
function get_fsr : dword;assembler;nostackframe;[public, alias: 'FPC_GETFSR'];
var
fsr : dword;
asm
cfc1 $2,$31
end;
procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
var
_fsr : dword;
asm
ctc1 $4,$31
end;
function get_got_z : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT_Z'];
asm
move $2,$28
end;
procedure fpc_cpuinit;
var
tmp32: longint;
begin
{ enable div by 0 and invalid operation fpu exceptions }
{ round towards zero; ieee compliant arithmetics }
tmp32 := get_fsr();
set_fsr((tmp32 and $fffffffc) or $00000001);
end;
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:pointer;assembler;nostackframe;
asm
lw $2,0($sp)
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
asm
lw $2,4($4) #movl 4(%eax),%eax
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer):pointer;assembler;nostackframe;
asm
lw $2,0($4)#movl (%eax),%eax
end;
{$define FPC_SYSTEM_HAS_SPTR}
function Sptr:Pointer;assembler;nostackframe;
asm
move $2,$sp
end;
{$ifndef FPC_SYSTEM_HAS_MOVE}
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;
asm
{
Registers:
$7 temp. to do copying
$8 inc/decrement
$9/l0/l1/l2 qword move
}
sw $4,0($23)
sw $5,-4($23)
sw $6,-8($23)
sw $7,-12($23)
sw $8,-16($23)
sw $9,-20($23)
sw $10,-24($23)
sw $11,-28($23)
sw $12,-32($23)
sw $13,-36($23)
sw $14,-40($23)
addiu $23,$23,-44
# count <= 0 ?
ble $6,$0,.Lmoveexit
nop
# source = dest ?
beq $4,$5,.Lmoveexit
nop
# possible overlap?
bgt $4,$5,.Lnopossibleoverlap
nop
# source < dest ....
addu $7,$6,$4
# overlap?
# source+count < dest ?
blt $7,$5,.Lnopossibleoverlap
nop
.Lcopybackward:
# check alignment of source and dest
or $2,$4,$5
# move src and dest to the end of the blocks
# assuming 16 byte block size
addiu $3,$6,-1
addu $4,$4,$3
addu $5,$5,$3
b .Lmovebytewise
li $3,-1
.Lnopossibleoverlap:
# check alignment of source and dest
or $2,$4,$5
# everything 16 byte aligned ?
andi $13,$2,15
beq $13,$0,.Lmovetwordwise
# load direction in delay slot
li $3,16
andi $13,$2,7
beq $13,$0,.Lmoveqwordwise
li $3,8
andi $13,$2,3
beq $13,$0,.Lmovedwordwise
li $3,4
andi $13,$2,1
beq $13,$0,.Lmovewordwise
li $3,2
b .Lmovebytewise
li $3,1
.Lmovetwordwise:
srl $13,$6,4
sll $14,$13,4
beq $14,$0,.Lmoveqwordwise_shift
nop
.Lmovetwordwise_loop:
lw $9,0($4)
lw $10,4($4)
addiu $13,$13,-1
lw $11,8($4)
lw $12,12($4)
addu $4,$4,$3
sw $9,0($5)
sw $10,4($5)
sw $11,8($5)
sw $12,12($5)
addu $5,$5,$3
bne $13,$0,.Lmovetwordwise_loop
nop
subu $6,$6,$14
beq $6,$0,.Lmoveexit
nop
.Lmoveqwordwise_shift:
sra $3,$3,1
.Lmoveqwordwise:
srl $13,$6,3
sll $14,$13,3
beq $14,$0,.Lmovedwordwise_shift
nop
.Lmoveqwordwise_loop:
lw $9,0($4)
lw $10,4($4)
addiu $13,$13,-1
addu $4,$3,$4
sw $9,0($5)
sw $10,4($5)
addu $5,$3,$5
bne $13,0,.Lmoveqwordwise_loop
nop
subu $6,$6,$14
beq $6,$0,.Lmoveexit
nop
.Lmovedwordwise_shift:
sra $3,$3,1
.Lmovedwordwise:
srl $13,$6,2
sll $14,$13,2
beq $14,$0,.Lmovewordwise_shift
nop
.Lmovedwordwise_loop:
lw $9,0($4)
addiu $13,$13,-1
addu $4,$4,$3
sw $9,0($5)
addu $5,$5,$3
bne $13,$0,.Lmovedwordwise_loop
nop
subu $6,$6,$14
beq $6,$0,.Lmoveexit
nop
.Lmovewordwise_shift:
sra $3,$3,1
.Lmovewordwise:
srl $13,$6,1
sll $14,$13,1
beq $14,$0, .Lmovebytewise_shift
nop
.Lmovewordwise_loop:
lhu $9,0($4)
addiu $13,$13,-1
addu $4,$4,$3
sh $9,0($5)
addu $5,$5,$3
bne $13,$0,.Lmovewordwise_loop
nop
subu $6,$6,$14
beq $6,$0, .Lmoveexit
nop
.Lmovebytewise_shift:
sra $3,$3,1
.Lmovebytewise:
beq $6,$0, .Lmoveexit
nop
lbu $9,0($4)
addiu $6,$6,-1
addu $4,$4,$3
sb $9,0($5)
addu $5,$5,$3
bne $6,$0,.Lmovebytewise
nop
.Lmoveexit:
addiu $23,$23,44
lw $4,0($23)
lw $5,-4($23)
lw $6,-8($23)
lw $7,-12($23)
lw $8,-16($23)
lw $9,-20($23)
lw $10,-24($23)
lw $11,-28($23)
lw $12,-32($23)
lw $13,-36($23)
lw $14,-40($23)
end;
{$endif FPC_SYSTEM_HAS_MOVE}
{****************************************************************************
Integer math
****************************************************************************}
{$define FPC_SYSTEM_HAS_ABS_LONGINT}
function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}nostackframe;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}
asm
sra $1,$4,31 #$at,$4,31
xor $2,$4,$1 #$2,$4,$at
sub $2,$2,$1 #$2,$2,$at
end;
var
fpc_system_lock : longint; export name 'fpc_system_lock';
{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
function declocked(var l : longint) : boolean;assembler;nostackframe;
{ input: address of l in $4 }
{ output: boolean indicating whether l is zero after decrementing }
asm
sw $4,0($23)
sw $5,-4($23)
sw $6,-8($23)
sw $7,-12($23)
sw $8,-16($23)
sw $9,-20($23)
sw $10,-24($23)
sw $11,-28($23)
sw $12,-32($23)
sw $13,-36($23)
sw $14,-40($23)
addiu $23,$23,-44
.Ldeclocked1:
lui $5,%hi(fpc_system_lock)
addiu $5,$5,%lo(fpc_system_lock)
ll $6,0($5)
ori $7,$6,1
beq $7,$6,.Ldeclocked1
nop
sc $7,0($5)
beq $7,$0,.Ldeclocked1
nop
lw $5,0($4)
addiu $5,$5,-1
sw $5,0($4)
seq $2,$5,$0
{ unlock }
lui $5,%hi(fpc_system_lock)
addiu $5,$5,%lo(fpc_system_lock)
sw $0,0($5)
addiu $23,$23,44
lw $4,0($23)
lw $5,-4($23)
lw $6,-8($23)
lw $7,-12($23)
lw $8,-16($23)
lw $9,-20($23)
lw $10,-24($23)
lw $11,-28($23)
lw $12,-32($23)
lw $13,-36($23)
lw $14,-40($23)
end;
{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
procedure inclocked(var l : longint);assembler;nostackframe;
asm
{ usually, we shouldn't lock here so saving the stack frame for these extra intructions is
worse the effort, especially while waiting :)
}
{ unlock }
sw $4,0($23)
sw $5,-4($23)
sw $6,-8($23)
sw $7,-12($23)
sw $8,-16($23)
sw $9,-20($23)
sw $10,-24($23)
sw $11,-28($23)
sw $12,-32($23)
sw $13,-36($23)
sw $14,-40($23)
addiu $23,$23,-44
.Ldeclocked1:
lui $5,%hi(fpc_system_lock)
addiu $5,$5,%lo(fpc_system_lock)
ll $6,0($5)
ori $7,$6,1
beq $7,$6,.Ldeclocked1
nop
sc $7,0($5)
beq $7,$0,.Ldeclocked1
nop
lw $5,0($4)
addiu $5,$5,1
sw $5,0($4)
{ unlock }
lui $5,%hi(fpc_system_lock)
addiu $5,$5,%lo(fpc_system_lock)
sw $0,0($5)
addiu $23,$23,44
lw $4,0($23)
lw $5,-4($23)
lw $6,-8($23)
lw $7,-12($23)
lw $8,-16($23)
lw $9,-20($23)
lw $10,-24($23)
lw $11,-28($23)
lw $12,-32($23)
lw $13,-36($23)
lw $14,-40($23)
end;

15
rtl/mips/set.inc Normal file
View File

@ -0,0 +1,15 @@
{
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.
**********************************************************************}

52
rtl/mips/setjump.inc Normal file
View File

@ -0,0 +1,52 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Jonas Maebe and David Zhang
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.
**********************************************************************}
procedure longjmp(var s : jmp_buf;value:longint);assembler;nostackframe;[Public,alias:'FPC_LONGJMP'];
asm
lw $31,0($4) #PC
lw $sp,4($4) #SP
lw $16,8($4) #S0,$16
lw $17,12($4)#S1,$16
lw $18,16($4)#S2,$16
lw $19,20($4)#S3,$16
lw $20,24($4)#S4,$16
lw $21,28($4)#S5,$16
lw $22,32($4)#S6,$16
lw $23,36($4)#S7,$16
lw $fp,40($4)#FP
lw $gp,44($4)#GP
j $31
nop
end;
function setjmp(var S:jmp_buf):longint;assembler;nostackframe;[Public,alias:'FPC_SETJMP'];
asm
sw $31,0($4) #PC
sw $sp,4($4) #SP
sw $16,8($4) #S0,$16
sw $17,12($4)#S1,$16
sw $18,16($4)#S2,$16
sw $19,20($4)#S3,$16
sw $20,24($4)#S4,$16
sw $21,28($4)#S5,$16
sw $22,32($4)#S6,$16
sw $23,36($4)#S7,$16
sw $fp,40($4)#FP
sw $gp,44($4)#GP
move $2,$0
end;

24
rtl/mips/setjumph.inc Normal file
View File

@ -0,0 +1,24 @@
{******************************************************************************
This file is part of the Free Pascal run time library.
Copyright (c) 2000-2002 by Jonas Maebe and David Zhang
SetJmp/Longjmp declarations MIPS
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.
******************************************************************************}
type
jmp_buf=packed record
reg:array[1..12] of longint;
end;
Pjmp_buf=^jmp_buf;
function setjmp(var S:jmp_buf):longint;
procedure longjmp(var S:jmp_buf;value:longint);

16
rtl/mips/strings.inc Normal file
View File

@ -0,0 +1,16 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2000 by Jonas Maebe, member of the
Free Pascal development team
Processor dependent part of strings.pp, that can be shared with
sysutils unit.
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.
**********************************************************************}

17
rtl/mips/stringss.inc Normal file
View File

@ -0,0 +1,17 @@
{
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
Processor dependent part of strings.pp, not shared with
sysutils unit.
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.
**********************************************************************}