add loongarch64 rtl support

rtl/inc/system.inc

@@ -354,6 +354,14 @@ function do_isdevice(handle:thandle):boolean;forward;
   {$define SYSPROCDEFINED}
 {$endif cpuwasm32}
 
+{$ifdef cpuloongarch64}
+  {$ifdef SYSPROCDEFINED}
+    {$Error Can't determine processor type !}
+  {$endif}
+  {$i loongarch64.inc}  { Case dependent, don't change }
+  {$define SYSPROCDEFINED}
+{$endif cpuloongarch64}
+
 {$ifndef SYSPROCDEFINED}
   {$Error Can't determine processor type !}
 {$endif}

rtl/inc/systemh.inc

@@ -409,6 +409,15 @@ Type
   FarPointer = Pointer;
 {$endif CPUWASM32}
 
+{$ifdef CPULOONGARCH64}
+  {$define DEFAULT_DOUBLE}
+
+  {$define SUPPORT_SINGLE}
+  {$define SUPPORT_DOUBLE}
+
+  ValReal = Double;
+{$endif CPULOONGARCH64}
+
 
 { By default enable a simple implementation of Random for 8/16 bit CPUs }
 {$if (defined(CPU16) or defined(CPU8)) and not defined(FPC_NO_SIMPLE_RANDOM)}
@@ -1124,10 +1133,10 @@ function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMI
 {$define FPC_HAS_INTERNAL_SAR_DWORD}
 { $endif defined(cpux86_64) or defined(cpui386) or defined(cpuarm) or defined(cpupowerpc) or defined(cpupowerpc64) or defined(cpumips) or defined(cpumipsel)}
 
-{$if defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64) or defined(cpuriscv64) or defined(cpuwasm32)}
+{$if defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64) or defined(cpuriscv64) or defined(cpuwasm32) or defined(cpuloongarch64)}
 {$define FPC_HAS_INTERNAL_SAR_QWORD}
 {$define FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
-{$endif defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64) or defined(cpuriscv64) or defined(cpuwasm32)}
+{$endif defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64) or defined(cpuriscv64) or defined(cpuwasm32) or defined(cpuloongarch64)}
 
 {$endif FPC_HAS_INTERNAL_SAR}
 

rtl/loongarch64/cpuh.inc

@@ -0,0 +1,25 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2016 by the Free Pascal development team.
+
+    CPU specific system unit header file
+
+    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 FPUFD}
+type
+  TNativeFPUControlWord = record
+    cw: dword;
+    rndmode: dword;
+  end;
+{$else}
+  {$define FPC_SYSTEM_FPUCW_IMMUTABLE}
+{$endif}

rtl/loongarch64/int64p.inc

@@ -0,0 +1,14 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 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.
+
+ **********************************************************************}

rtl/loongarch64/loongarch64.inc

@@ -0,0 +1,524 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    Processor dependent implementation for the system unit for
+    RiscV64
+
+    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.
+
+ **********************************************************************}
+
+const
+  fpu_i = 1 shl 0;
+  fpu_u = 1 shl 1;
+  fpu_o = 1 shl 2;
+  fpu_z = 1 shl 3;
+  fpu_v = 1 shl 4;
+
+
+function getrm: dword; nostackframe; assembler;
+  asm
+    movfcsr2gr $a0, $r3
+    srli.w $a0, $a0, 8
+  end;
+
+
+procedure __setrm(val: dword); nostackframe; assembler;
+  asm
+    slli.w $a0, $a0, 8
+    movgr2fcsr $r3, $a0
+  end;
+
+procedure setrm(val: dword);
+  begin
+    DefaultFPUControlWord.rndmode:=val;
+    __setrm(val);
+  end;
+
+
+function getenables: dword; nostackframe; assembler;
+  asm
+    movfcsr2gr $a0, $r1
+  end;
+
+
+procedure __setenables(enables : dword); nostackframe; assembler;
+    asm
+      movgr2fcsr $r1, $a0
+    end;
+
+
+procedure setenables(enables : dword);
+  begin
+    DefaultFPUControlWord.cw:=enables;
+    __setenables(enables);
+  end;
+
+
+function getcause: dword; nostackframe; assembler;
+  asm
+    movfcsr2gr $a0, $r2
+    srli.w $a0, $a0, 24
+  end;
+
+
+procedure setcause(cause : dword); nostackframe; assembler;
+  asm
+    slli.w $a0, $a0, 24
+    movgr2fcsr $r2, $a0
+  end;
+
+
+function GetNativeFPUControlWord: TNativeFPUControlWord;
+  begin
+    result.cw:=getenables;
+    result.rndmode:=getrm;
+  end;
+
+
+procedure SetNativeFPUControlWord(const cw: TNativeFPUControlWord);
+  begin
+    setenables(cw.cw);
+    setrm(cw.rndmode);
+  end;
+
+
+procedure RaisePendingExceptions;
+  var
+    cause : dword;
+    f: TFPUException;
+  begin
+    cause:=getcause;
+    if (cause and fpu_i) <> 0 then
+      float_raise(exPrecision);
+    if (cause and fpu_u) <> 0 then
+      float_raise(exUnderflow);
+    if (cause and fpu_o) <> 0 then
+      float_raise(exOverflow);
+    if (cause and fpu_z) <> 0 then
+      float_raise(exZeroDivide);
+    if (cause and fpu_v) <> 0 then
+      float_raise(exInvalidOp);
+    { now the soft float exceptions }
+    for f in softfloat_exception_flags do
+      float_raise(f);
+  end;
+
+
+procedure fpc_throwfpuexception;[public,alias:'FPC_THROWFPUEXCEPTION'];
+  var
+    cause : dword;
+  begin
+    cause:=getcause;
+    { check, if the exception is masked }
+    if ((cause and fpu_i) <> 0) and (exPrecision in softfloat_exception_mask) then
+      cause:=cause and not(fpu_i);
+    if ((cause and fpu_u) <> 0) and (exUnderflow in softfloat_exception_mask) then
+      cause:=cause and not(fpu_u);
+    if ((cause and fpu_o) <> 0) and (exOverflow in softfloat_exception_mask) then
+      cause:=cause and not(fpu_o);
+    if ((cause and fpu_z) <> 0) and (exZeroDivide in softfloat_exception_mask) then
+      cause:=cause and not(fpu_z);
+    if ((cause and fpu_v) <> 0) and (exInvalidOp in softfloat_exception_mask) then
+      cause:=cause and not(fpu_v);
+    setcause(cause);
+    if cause<>0 then
+      RaisePendingExceptions;
+  end;
+
+
+{$define FPC_SYSTEM_HAS_SYSINITFPU}
+procedure SysInitFPU;
+  begin
+    setrm(0);
+    setcause(0);
+    setenables(fpu_z or fpu_v);
+    softfloat_exception_mask:=[exPrecision,exUnderflow];
+    softfloat_exception_flags:=[];
+  end;
+
+
+{****************************************************************************
+                          Math Routines
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_SWAPENDIAN}
+{TODO It may be better to use the inline method}
+{signed 16bit}
+function SwapEndian(const AValue: SmallInt): SmallInt;assembler; nostackframe;
+  asm
+    revb.2h $a0, $a0
+    ext.w.h $a0, $a0
+  end;
+{unsigned 16bit}
+function SwapEndian(const AValue: Word): Word;assembler; nostackframe;
+  asm
+    revb.2h $a0, $a0
+    bstrpick.d $a0, $a0, 15, 0
+  end;
+
+{signed 32bit}
+function SwapEndian(const AValue: LongInt): LongInt; assembler; nostackframe;
+  asm
+    revb.2w $a0, $a0
+    addi.w $a0, $a0, 0
+  end;
+
+{unsigned 32bit}
+function SwapEndian(const AValue: DWord): DWord; assembler; nostackframe;
+  asm
+    revb.2w $a0, $a0
+    bstrpick.d $a0, $a0, 31, 0
+  end;
+
+{signed 64bit}
+function SwapEndian(const AValue: Int64): Int64; assembler; nostackframe;
+  asm
+    revb.d $a0, $a0
+  end;
+
+{unsigned 64bit}
+function SwapEndian(const AValue: QWord): QWord; assembler; nostackframe;
+  asm
+    revb.d $a0, $a0
+  end;
+{****************************************************************************
+                       stack frame related stuff
+****************************************************************************}
+
+{$IFNDEF INTERNAL_BACKTRACE}
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;nostackframe;
+  asm
+    ori $a0, $fp, 0
+  end;
+{$ENDIF not INTERNAL_BACKTRACE}
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+    ld.d $a0, $a0, -8
+  end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;
+  asm
+    ld.d $a0, $a0, -16
+  end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : pointer;assembler;nostackframe;
+  asm
+    ori $a0, $sp, 0
+  end;
+
+
+function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    addi.w $a1, $zero, -1
+    amadd_db.w $a2, $a1, $a0
+    add.w $a0, $a1, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.w $a1, $a0, 0
+    addi.w $a2, $a1, -1
+    sc.w $a2, $a0, 0
+    beqz $a2, .LLoop
+    addi.w $a0, $a1, -1
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    addi.w $a1, $zero, 1
+    amadd_db.w $a2, $a1, $a0
+    add.w $a0, $a1, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.w $a1, $a0, 0
+    addi.w $a2, $a1, 1
+    sc.w $a2, $a0, 0
+    beqz $a2, .LLoop
+    addi.w $a0, $a1, 1
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+    dbar 0
+  .LLoop:
+    ll.w $a3, $a0, 0
+    ori $a2, $a1, 0
+    sc.w $a2, $a0, 0
+    beqz $a2, .LLoop
+    ori $a0, $a3, 0
+    dbar 0
+  end;
+
+
+function InterLockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; nostackframe;
+  asm
+    dbar 0
+  .LLoop:
+    ll.w $a3, $a0, 0
+    bne $a3, $a2, .LFail
+    ori $a4, $a1, 0
+    sc.w $a4, $a0, 0
+    beqz $a4, .LLoop
+  .LFail:
+    ori $a0, $a3, 0
+    dbar 0
+  end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    amadd_db.w $a2, $a1, $a0
+    move $a0, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.w $a2, $a0, 0
+    add.w $a3, $a1, $a2
+    sc.w $a3, $a0, 0
+    beqz $a3, .LLoop
+    move $a0, $a2
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+
+function InterLockedDecrement64 (var Target: int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    addi.d $a1, $zero, -1
+    amadd_db.d $a2, $a1, $a0
+    add.d $a0, $a1, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.d $a1, $a0, 0
+    addi.d $a2, $a1, -1
+    sc.d $a2, $a0, 0
+    beqz $a2, .LLoop
+    addi.d $a0, $a1, -1
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+
+function InterLockedIncrement64 (var Target: int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    addi.d $a1, $zero, 1
+    amadd_db.d $a2, $a1, $a0
+    add.d $a0, $a1, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.d $a1, $a0, 0
+    addi.d $a2, $a1, 1
+    sc.d $a2, $a0, 0
+    beqz $a2, .LLoop
+    addi.d $a0, $a1, 1
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+
+function InterLockedExchange64 (var Target: int64;Source : int64) : int64; assembler; nostackframe;
+  asm
+    dbar 0
+  .LLoop:
+    ll.d $a3, $a0, 0
+    ori $a2, $a1, 0
+    sc.d $a2, $a0, 0
+    beqz $a2, .LLoop
+    ori $a0, $a3, 0
+    dbar 0
+  end;
+
+
+function InterLockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; assembler; nostackframe;
+  asm
+    dbar 0
+  .LLoop:
+    ll.d $a3, $a0, 0
+    bne $a3, $a2, .LFail
+    ori $a4, $a1, 0
+    sc.d $a4, $a0, 0
+    beqz $a4, .LLoop
+  .LFail:
+    ori $a0, $a3, 0
+    dbar 0
+  end;
+
+
+function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; assembler; nostackframe;
+  asm
+{$ifdef CPULOONGARCH_HAS_ATOMIC}
+    amadd_db.d $a2, $a1, $a0
+    add.d $a0, $a1, $a2
+{$else CPULOONGARCH_HAS_ATOMIC}
+    dbar 0
+  .LLoop:
+    ll.d $a2, $a0, 0
+    add.d $a3, $a1, $a2
+    sc.d $a3, $a0, 0
+    beqz $a3, .LLoop
+    add.d $a0, $a1, $a2
+    dbar 0
+{$endif CPULOONGARCH_HAS_ATOMIC}
+  end;
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+  function declocked(var l: longint) : boolean; inline;
+  begin
+    Result:=InterLockedDecrement(l) = 0;
+  end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+  procedure inclocked(var l: longint); inline;
+  begin
+    InterLockedIncrement(l);
+  end;
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
+function declocked(var l:int64):boolean;
+  begin
+    Result:=InterLockedDecrement64(l) = 0;
+  end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
+procedure inclocked(var l:int64);
+  begin
+    InterLockedIncrement64(l);
+  end;
+
+
+{$define FPC_SYSTEM_HAS_MEM_BARRIER}
+
+procedure ReadBarrier; assembler; nostackframe;
+  asm
+    dbar 0
+  end;
+
+
+procedure ReadDependencyBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
+  begin
+  end;
+
+procedure ReadWriteBarrier; assembler; nostackframe;
+  asm
+    dbar 0
+  end;
+
+procedure WriteBarrier; assembler; nostackframe;
+  asm
+    dbar 0
+  end;
+
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE']; assembler; nostackframe;
+  asm
+    blez $a2, .Lret
+    beq  $a0, $a1, .Lret
+
+    move $t0, $a0
+    add.d $t1, $a1, $a2
+    bgt $t0, $t1, .Lprefast_tail
+    sub.d $t1, $a1, $a2
+    blt $t0, $t1, .Lprefast_tail
+    bgt $a0, $a1, .Lgeneric_head
+
+    add.d $a0, $a0, $a2
+    add.d $a1, $a1, $a2
+  .Lgeneric_tail:
+    ld.b $t0, $a0, -1
+    st.b $t0, $a1, -1
+    addi.d $a0, $a0, -1
+    addi.d $a1, $a1, -1
+    addi.d $a2, $a2, -1
+    bgtz $a2, .Lgeneric_tail
+    b .Lret
+
+  .Lgeneric_head:
+    ld.b $t0, $a0, 0
+    st.b $t0, $a1, 0
+    addi.d $a0, $a0, 1
+    addi.d $a1, $a1, 1
+    addi.d $a2, $a2, -1
+    bgtz $a2, .Lgeneric_head
+    b .Lret
+
+  .Lprefast_tail:
+    add.d $a0, $a0, $a2
+    add.d $a1, $a1, $a2
+    ori $a3, $zero, 64
+    blt $a2, $a3, .Lgeneric_tail
+  .Lfast_tail:
+    ld.d $t0, $a0, -8
+    ld.d $t1, $a0, -16
+    ld.d $t2, $a0, -24
+    ld.d $t3, $a0, -32
+    ld.d $t4, $a0, -40
+    ld.d $t5, $a0, -48
+    ld.d $t6, $a0, -56
+    ld.d $t7, $a0, -64
+    st.d $t0, $a1, -8
+    st.d $t1, $a1, -16
+    st.d $t2, $a1, -24
+    st.d $t3, $a1, -32
+    st.d $t4, $a1, -40
+    st.d $t5, $a1, -48
+    st.d $t6, $a1, -56
+    st.d $t7, $a1, -64
+    addi.d $a0, $a0, -64
+    addi.d $a1, $a1, -64
+    addi.d $a2, $a2, -64
+    bge $a2, $a3, .Lfast_tail
+    bnez $a2, .Lgeneric_tail
+
+  .Lret:
+    jr $ra
+  end;
+
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ifdef FPUFD}
+var
+  cw: TNativeFPUControlWord;
+{$endif}
+begin
+  softfloat_exception_flags:=[];
+  softfloat_exception_mask:=[exPrecision,exUnderflow];
+{$ifdef FPUFD}
+  cw:=GetNativeFPUControlWord;
+  cw.cw:=0;
+  { round to nearest }
+  cw.rndmode:=0;
+  SetNativeFPUControlWord(cw);
+{$endif}
+end;

rtl/loongarch64/makefile.cpu

@@ -0,0 +1,6 @@
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=loongarch64 int64p math set setjump setjumph strings stringss
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))

rtl/loongarch64/math.inc

@@ -0,0 +1,46 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    Implementation of mathematical 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.
+
+ **********************************************************************}
+
+    {$define FPC_SYSTEM_HAS_INT}
+    function fpc_int_real(d : ValReal) : ValReal;assembler;nostackframe;compilerproc;
+      asm
+        movfcsr2gr $t0, $r3
+        li.d $t1, 0x100
+        movgr2fcsr $r3, $t1
+        frint.d $fa0, $fa0
+        movgr2fcsr $r3, $t0
+      end;
+
+    {$define FPC_SYSTEM_HAS_FRAC}
+    function fpc_frac_real(d : ValReal) : ValReal;assembler;nostackframe;compilerproc;
+      asm
+        movfr2gr.d $t0, $fa0
+        li.d $t1, 0x7ff0000000000000
+        and $t0, $t0, $t1
+        beq $t0, $t1, .LNaN
+        movfcsr2gr $t0, $r3
+        li.d $t1, 0x100
+        movgr2fcsr $r3, $t1
+        frint.d $fa1, $fa0
+        movgr2fcsr $r3, $t0
+        fsub.d $fa0, $fa0, $fa1
+        jr $ra
+      .LNaN:
+        fsub.d $fa0, $fa0, $fa0
+        movgr2fr.d $fa1, $zero
+        fdiv.d $fa0, $fa0, $fa1
+        // jr $ra
+      end;

rtl/loongarch64/mathu.inc

@@ -0,0 +1,133 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Jonas Maebe
+    member of the Free Pascal development team
+
+    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.
+
+**********************************************************************}
+
+
+function getcause: dword; nostackframe; assembler;
+  asm
+    movfcsr2gr $a0, $r2
+    srli.w $a0, $a0, 24
+  end;
+
+
+procedure clearcause; nostackframe; assembler;
+  asm
+    movgr2fcsr $r2, $zero
+  end;
+
+
+function GetRoundMode: TFPURoundingMode;
+  var
+    cw: TNativeFPUControlWord;
+  const
+    bits2rm: array[0..3] of TFPURoundingMode = (rmNearest,rmTruncate,rmUp,rmDown);
+  begin
+    cw:=GetNativeFPUControlWord;
+    result:=TFPURoundingMode(bits2rm[cw.rndmode])
+  end;
+
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+  var
+    cw: TNativeFPUControlWord;
+  const
+    rm2bits : array[TFPURoundingMode] of byte = (0,3,2,1);
+  begin
+    softfloat_rounding_mode:=RoundMode;
+    SetRoundMode:=GetRoundMode;
+    cw:=GetNativeFPUControlWord;
+    cw.rndmode:=rm2bits[RoundMode];
+    SetNativeFPUControlWord(cw);
+  end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+  begin
+    result:=pmDouble;
+  end;
+
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+  begin
+    result:=pmDouble;
+  end;
+
+const
+  fpu_i = 1 shl 0;
+  fpu_u = 1 shl 1;
+  fpu_o = 1 shl 2;
+  fpu_z = 1 shl 3;
+  fpu_v = 1 shl 4;
+
+
+function GetExceptionMask: TFPUExceptionMask;
+  begin
+    Result:=softfloat_exception_mask;
+  end;
+
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+  var
+    newenables: qword;
+    cw: TNativeFPUControlWord;
+  begin
+    { clear "exception happened" flags }
+    ClearExceptions(false);
+    result:=softfloat_exception_mask;
+    softfloat_exception_mask:=Mask;
+    newenables:=$1f;
+    if exPrecision in Mask then
+      newenables:=newenables and not(fpu_i);
+    if exUnderflow in Mask then
+      newenables:=newenables and not(fpu_u);
+    if exOverflow in Mask then
+      newenables:=newenables and not(fpu_o);
+    if exZeroDivide in Mask then
+      newenables:=newenables and not(fpu_z);
+    if exInvalidOp in Mask then
+      newenables:=newenables and not(fpu_v);
+    cw:=GetNativeFPUControlWord;
+    cw.cw:=newenables;
+    SetNativeFPUControlWord(cw);
+  end;
+
+
+procedure RaisePendingExceptions;
+  var
+    cause : dword;
+    f: TFPUException;
+  begin
+    cause:=getcause;
+    if (cause and fpu_i) <> 0 then
+      float_raise(exPrecision);
+    if (cause and fpu_u) <> 0 then
+      float_raise(exUnderflow);
+    if (cause and fpu_o) <> 0 then
+      float_raise(exOverflow);
+    if (cause and fpu_z) <> 0 then
+      float_raise(exZeroDivide);
+    if (cause and fpu_v) <> 0 then
+      float_raise(exInvalidOp);
+    { now the soft float exceptions }
+    for f in softfloat_exception_flags do
+      float_raise(f);
+  end;
+
+
+procedure ClearExceptions(RaisePending: Boolean);
+  begin
+    if raisepending then
+      RaisePendingExceptions;
+    softfloat_exception_flags:=[];
+    clearcause;
+  end;

rtl/loongarch64/set.inc

@@ -0,0 +1,15 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by 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.
+
+ **********************************************************************}

rtl/loongarch64/setjump.inc

@@ -0,0 +1,74 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by 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.
+
+ **********************************************************************}
+
+function fpc_setjmp(var S : jmp_buf) : longint;[Public, alias : 'FPC_SETJMP'];compilerproc;assembler;nostackframe;
+  asm
+    st.d $ra, $a0, 0
+    st.d $sp, $a0, 8
+    st.d $x, $a0, 16
+    st.d $fp, $a0, 24
+    st.d $s0, $a0, 32
+    st.d $s1, $a0, 40
+    st.d $s2, $a0, 48
+    st.d $s3, $a0, 56
+    st.d $s4, $a0, 64
+    st.d $s5, $a0, 72
+    st.d $s6, $a0, 80
+    st.d $s7, $a0, 88
+    st.d $s8, $a0, 96
+
+    fst.d $fs0, $a0, 104
+    fst.d $fs1, $a0, 112
+    fst.d $fs2, $a0, 120
+    fst.d $fs3, $a0, 128
+    fst.d $fs4, $a0, 136
+    fst.d $fs5, $a0, 144
+    fst.d $fs6, $a0, 152
+    fst.d $fs7, $a0, 160
+
+    ori $a0, $zero, 0
+  end;
+
+
+procedure fpc_longjmp(var S : jmp_buf;value : longint);[Public, alias : 'FPC_LONGJMP'];compilerproc;assembler;nostackframe;
+  asm
+    ld.d $ra, $a0, 0
+    ld.d $sp, $a0, 8
+    ld.d $x, $a0, 16
+    ld.d $fp, $a0, 24
+    ld.d $s0, $a0, 32
+    ld.d $s1, $a0, 40
+    ld.d $s2, $a0, 48
+    ld.d $s3, $a0, 56
+    ld.d $s4, $a0, 64
+    ld.d $s5, $a0, 72
+    ld.d $s6, $a0, 80
+    ld.d $s7, $a0, 88
+    ld.d $s8, $a0, 96
+
+    fld.d $fs0, $a0, 104
+    fld.d $fs1, $a0, 112
+    fld.d $fs2, $a0, 120
+    fld.d $fs3, $a0, 128
+    fld.d $fs4, $a0, 136
+    fld.d $fs5, $a0, 144
+    fld.d $fs6, $a0, 152
+    fld.d $fs7, $a0, 160
+
+    sltui $a0, $a1, 1
+    add.d $a0, $a0, $a1
+    jr $ra
+  end;

rtl/loongarch64/setjumph.inc

@@ -0,0 +1,25 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team.
+
+    SetJmp/Longjmp declarations
+
+    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
+    ra,sp,x,fp,s0,s1,s2,s3,s4,s5,s6,s7,s8,
+    fs0,fs1,fs2,fs3,fs4,fs5,fs6,fs7,fs8:qword;
+   end;
+   pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];
+procedure longjmp(var S : jmp_buf;value : longint);[external name 'FPC_LONGJMP'];

rtl/loongarch64/strings.inc

@@ -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.
+
+ **********************************************************************}

rtl/loongarch64/stringss.inc

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