* fixed some arm stuff

rtl/arm/sysutilp.inc

@@ -0,0 +1,57 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 2001 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.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+  This include contains cpu-specific routines
+  ---------------------------------------------------------------------}
+
+
+{ the ARM doesn't know multiprocessor system which would require locking }
+
+
+function InterLockedDecrement (var Target: integer) : Integer;
+  begin
+    dec(Target);
+    result:=target;
+  end;
+
+
+function InterLockedIncrement (var Target: integer) : Integer;
+  begin
+    inc(Target);
+    result:=target;
+  end;
+
+
+function InterLockedExchange (var Target: integer;Source : integer) : Integer;
+  begin
+    Result:=Target;
+    Target:=Source;
+  end;
+
+
+function InterLockedExchangeAdd (var Target: integer;Source : integer) : Integer;
+  begin
+    Result:=Target;
+    inc(Target,Source);
+  end;
+
+
+{
+  $Log$
+  Revision 1.1  2003-11-30 19:48:20  florian
+    * fixed some arm stuff
+}

rtl/arm/typinfo.inc

@@ -0,0 +1,224 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 2003 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.
+
+ **********************************************************************}
+
+{ 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a2: index      }
+  {     a3: ivalue     }
+  { output:            }
+  {     a1-a2: 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a3: index      }
+  {     a4: ivalue     }
+  { output:            }
+  {     a1: 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a3: index      }
+  {     a4: ivalue     }
+  { output:            }
+  {     f0: 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a3: index      }
+  {     a4: ivalue     }
+  { output:            }
+  {     f0: 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a3: index      }
+  {     a4: ivalue     }
+  { output:            }
+  {     f0: 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;
+  { input:             }
+  {     a1: s          }
+  {     a2: address    }
+  {     a3: index      }
+  {     a4: ivalue     }
+  { output:            }
+  {     a1: 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;
+  { input:                                       }
+  {     a1: address of shortstring result (temp) }
+  {     a2: s                                    }
+  {     a3: address                              }
+  {     a4: index                                }
+  {     stack: ivalue                            }
+  {     stack: 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;
+  { input:                                 }
+  {     a1: s                              }
+  {     a2: address                        }
+  {     a3: value (address of shortstring) }
+  {     a4: index                          }
+  {     stack: 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-11-30 19:48:20  florian
+    * fixed some arm stuff
+}

rtl/inc/objects.pp

@@ -703,19 +703,21 @@ type
 
 function PreviousFramePointer: FramePointer;assembler;
 {$undef FPC_PreviousFramePointer_Implemented}
-asm
 {$ifdef cpui386}
 {$define FPC_PreviousFramePointer_Implemented}
+asm
     movl (%ebp), %eax
 end ['EAX'];
 {$endif}
 {$ifdef cpum68k}
 {$define FPC_PreviousFramePointer_Implemented}
+asm
     move.l (a6),d0
 end ['D0'];
 {$endif}
 {$ifdef cpusparc}
 {$define FPC_PreviousFramePointer_Implemented}
+asm
     { we have first our own frame }
     ld [%fp],%i0
     ld [%i0],%i0
@@ -723,12 +725,20 @@ end;
 {$endif}
 {$ifdef cpupowerpc}
 {$define FPC_PreviousFramePointer_Implemented}
-    {$warning FIX ME !!!! }
-    { getting the previous stack frame is quite hard for the standard powerpc calling conventions
+{$warning FIX ME !!!! }
+asm
+    (* getting the previous stack frame is quite hard for the standard powerpc calling conventions
       because we don't know the size of the locals, it seems that we need some compiler magic for this
-    }
+    *)
 end;
-{$endif}
+{$endif cpupowerpc}
+{$ifdef cpuarm}
+{$define FPC_PreviousFramePointer_Implemented}
+{$warning FIX ME !!!! }
+asm
+   mov r0,fp
+end;
+{$endif cpuarm}
 {$ifndef FPC_PreviousFramePointer_Implemented}
 {$error PreviousFramePointer function not implemented}
 {$endif not FPC_PreviousFramePointer_Implemented}
@@ -2932,7 +2942,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.25  2003-11-03 17:46:37  peter
+  Revision 1.26  2003-11-30 19:48:20  florian
+    * fixed some arm stuff
+
+  Revision 1.25  2003/11/03 17:46:37  peter
     * fixed crash in bufstream.write
 
   Revision 1.24  2003/11/03 09:42:28  marco

rtl/inc/objpash.inc

@@ -223,7 +223,7 @@
       freed automatically. To avoid this, call this function.
       If within the exception object you decide that you don't need
       the exception after all, call @link(ReleaseExceptionObject).
-      Otherwise, if the reference count is > 0, the exception object 
+      Otherwise, if the reference count is > 0, the exception object
       goes into your "property" and you need to free it manually.
       The effect of this function is countered by re-raising an exception
       via "raise;", this zeroes the reference count again.
@@ -234,7 +234,7 @@
     { @abstract(decrease exception reference count)
       After calling @link(AcquireExceptionObject) you can call this method
       to decrease the exception reference count again.
-      If the reference count is > 0, the exception object 
+      If the reference count is > 0, the exception object
       goes into your "property" and you need to free it manually.
       Calling this method is only valid within an except block. }
     procedure ReleaseExceptionObject;
@@ -293,7 +293,10 @@
 
 {
   $Log$
-  Revision 1.18  2003-11-03 09:42:28  marco
+  Revision 1.19  2003-11-30 19:48:20  florian
+    * fixed some arm stuff
+
+  Revision 1.18  2003/11/03 09:42:28  marco
    * Peter's Cardinal<->Longint fixes patch
 
   Revision 1.17  2003/10/06 15:59:20  florian