Browse Source

* new dummies

peter 22 years ago
parent
commit
1302e8e34c
5 changed files with 435 additions and 1 deletions
  1. 22 1
      rtl/sparc/math.inc
  2. 22 0
      rtl/sparc/mathu.inc
  3. 22 0
      rtl/sparc/mathuh.inc
  4. 99 0
      rtl/sparc/sysutilp.inc
  5. 270 0
      rtl/sparc/typinfo.inc

+ 22 - 1
rtl/sparc/math.inc

@@ -287,10 +287,31 @@ end{ ['R0','R3','F0','F1','F2','F3']};
       end;
       end;
 
 
 
 
+{****************************************************************************
+                         Int to real helpers
+ ****************************************************************************}
+
+function fpc_int64_to_double(i: int64): double; compilerproc;
+begin
+{$warning FIXME}
+  runerror(207);
+end;
+
+
+
+function fpc_qword_to_double(q: qword): double; compilerproc;
+begin
+{$warning FIXME}
+  runerror(207);
+end;
+
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2003-04-23 21:28:21  peter
+  Revision 1.5  2003-09-01 20:46:32  peter
+    * new dummies
+
+  Revision 1.4  2003/04/23 21:28:21  peter
     * fpc_round added, needed for int64 currency
     * fpc_round added, needed for int64 currency
 
 
   Revision 1.3  2003/01/22 20:45:15  mazen
   Revision 1.3  2003/01/22 20:45:15  mazen

+ 22 - 0
rtl/sparc/mathu.inc

@@ -0,0 +1,22 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    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.
+
+ **********************************************************************}
+{
+  $Log$
+  Revision 1.1  2003-09-01 20:46:32  peter
+    * new dummies
+
+  Revision 1.1  2003/04/24 09:14:22  florian
+    * initial implementation
+}

+ 22 - 0
rtl/sparc/mathuh.inc

@@ -0,0 +1,22 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    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.
+
+ **********************************************************************}
+{
+  $Log$
+  Revision 1.1  2003-09-01 20:46:32  peter
+    * new dummies
+
+  Revision 1.1  2003/04/24 09:14:22  florian
+    * initial implementation
+}

+ 99 - 0
rtl/sparc/sysutilp.inc

@@ -0,0 +1,99 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 2003 by Peter Vreman,
+    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.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+  This include contains cpu-specific routines
+  ---------------------------------------------------------------------}
+
+function InterLockedDecrement (var Target: integer) : Integer; assembler;
+asm
+{$warning FIXME}
+end;
+(*
+{ input:  address of target in r3 }
+{ output: target-1 in r3          }
+{ side-effect: target := target-1 }
+asm
+InterLockedDecLoop:
+        lwarx   r0,r0,r3
+        subi    r0,r0,1
+        stwcx.  r0,r0,r3
+        bne     InterLockedDecLoop
+        mr      r3,r0
+end;
+*)
+
+
+function InterLockedIncrement (var Target: integer) : Integer; assembler;
+asm
+{$warning FIXME}
+end;
+(*
+{ input:  address of target in r3 }
+{ output: target+1 in r3          }
+{ side-effect: target := target+1 }
+asm
+InterLockedIncLoop:
+        lwarx   r0,r0,r3
+        addi    r0,r0,1
+        stwcx.  r0,r0,r3
+        bne     InterLockedIncLoop
+        mr      r3,r0
+end;
+*)
+
+function InterLockedExchange (var Target: integer;Source : integer) : Integer; assembler;
+asm
+{$warning FIXME}
+end;
+(*
+{ input:  address of target in r3, source in r4 }
+{ output: target in r3                          }
+{ side-effect: target := source                 }
+asm
+InterLockedXchgLoop:
+        lwarx   r0,r0,r3
+        stwcx.  r4,r0,r3
+        bne     InterLockedXchgLoop
+        mr      r3,r0
+end;
+*)
+
+
+function InterLockedExchangeAdd (var Target: integer;Source : integer) : Integer; assembler;
+asm
+{$warning FIXME}
+end;
+(*
+{ input:  address of target in r3, source in r4 }
+{ output: target in r3                          }
+{ side-effect: target := target+source          }
+asm
+InterLockedXchgAddLoop:
+        lwarx   r0,r0,r3
+        add     r0,r0,r4
+        stwcx.  r0,r0,r3
+        bne     InterLockedXchgAddLoop
+        sub     r3,r0,r4
+end;
+*)
+
+{
+  $Log$
+  Revision 1.1  2003-09-01 20:46:32  peter
+    * new dummies
+
+}

+ 270 - 0
rtl/sparc/typinfo.inc

@@ -0,0 +1,270 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 2003 by Peter Vreman,
+    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.
+
+ **********************************************************************}
+
+{ This unit provides the same Functionality as the TypInfo Unit }
+{ of Delphi                                                     }
+{ ---------------------------------------------------------------------
+  This include contains cpu-specific Low-level calling of methods.
+  ---------------------------------------------------------------------}
+
+Function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     r3-r4: result  }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                      }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; Index,IValue : Longint) : Integer;assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     r3: result     }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                      }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Function CallSingleFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Single;assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     fr1: result    }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                      }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Function CallDoubleFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Double;assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     fr1: result    }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                      }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Function CallExtendedFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Extended;assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     fr1: result    }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                      }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:             }
+  {     r3: s          }
+  {     r4: address    }
+  {     r5: index      }
+  {     r6: ivalue     }
+  { output:            }
+  {     r3: result     }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                       }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0, oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
+                        Var Res: Shortstring);assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:                                       }
+  {     r3: address of shortstring result (temp) }
+  {     r4: s                                    }
+  {     r5: address                              }
+  {     r6: index                                }
+  {     r7: ivalue                               }
+  {     r8: res                                  }
+  { output:                                      }
+  {     none                                     }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r5
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                       }
+     mr        r5,r7
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+
+Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
+asm
+  {$warning FIXME}
+end;
+(*
+  { input:                                 }
+  {     r3: s                              }
+  {     r4: address                        }
+  {     r5: value (address of shortstring) }
+  {     r6: index                          }
+  {     r7: ivalue                         }
+  { output:                                }
+  {     none                               }
+  var
+    oldlr: pointer;
+  asm
+     { save current return address }
+     mflr      r0
+     stw       r0,oldlr
+     mtctr     r4
+     { always pass ivalue as second parameter, it doesn't matter if it }
+     { isn't used                                                       }
+     mr        r4,r6
+     bctrl
+     { restore return address }
+     lwz       r0,oldlr
+     mtlr      r0
+  end;
+*)
+
+{
+  $Log$
+  Revision 1.1  2003-09-01 20:46:32  peter
+    * new dummies
+
+}